From 46b6aa389f039b94d506e7887f89341c9f4b4da2 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sat, 21 Oct 2017 18:40:19 -0500 Subject: [PATCH] Change all text/source files to LF line endings. --- Asm.pas | 668 ++- CC.pas | 180 +- CC.rez | 15 +- CC.rez2 | 15 +- CCommon.asm | 81 +- CCommon.macros | 258 +- CCommon.pas | 970 +++- CGC.asm | 116 +- CGC.macros | 189 +- CGC.pas | 125 +- CGI.Comments | 799 +++- CGI.Debug | 369 +- CGI.pas | 1297 +++++- DAG.pas | 4735 +++++++++++++++++++- DAG2.pas | 266 +- Exp.macros | 165 +- Expression.asm | 389 +- Expression.pas | 3727 +++++++++++++++- Gen.pas | 5649 +++++++++++++++++++++++- Header.pas | 1944 +++++++- Header2.pas | 150 +- MM.asm | 116 +- MM.macros | 196 +- MM.pas | 233 +- Native.asm | 163 +- Native.macros | 119 +- Native.pas | 2317 +++++++++- Native2.pas | 1242 +++++- ObjOut.asm | 229 +- ObjOut.macros | 254 +- ObjOut.pas | 596 ++- ObjOut2.asm | 235 +- ObjOut2.pas | 596 ++- Parser.pas | 3937 ++++++++++++++++- Scanner.asm | 648 ++- Scanner.debug | 32 +- Scanner.macros | 532 ++- Scanner.pas | 4051 ++++++++++++++++- Symbol.Print | 104 +- Symbol.asm | 25 +- Symbol.macros | 119 +- Symbol.pas | 1536 ++++++- Table.asm | 877 +++- Table.macros | 25 +- Table.pas | 44 +- Tests/Conformance/C11.4.2.1.CC | 24 +- Tests/Conformance/C13.1.0.1.CC | 44 +- Tests/Conformance/C14.1.0.1.CC | 149 +- Tests/Conformance/C14.2.0.1.CC | 62 +- Tests/Conformance/C14.3.0.1.CC | 88 +- Tests/Conformance/C14.5.0.1.CC | 41 +- Tests/Conformance/C14.6.0.1.CC | 38 +- Tests/Conformance/C14.7.0.1.CC | 75 +- Tests/Conformance/C14.8.0.1.CC | 50 +- Tests/Conformance/C14.9.0.1.CC | 61 +- Tests/Conformance/C15.1.0.1.CC | 46 +- Tests/Conformance/C15.2.0.1.CC | 40 +- Tests/Conformance/C15.3.0.1.CC | 40 +- Tests/Conformance/C15.5.0.1.CC | 63 +- Tests/Conformance/C15.6.0.1.CC | 80 +- Tests/Conformance/C15.7.0.1.CC | 26 +- Tests/Conformance/C15.7.0.2.CC | 107 +- Tests/Conformance/C15.8.0.1.CC | 38 +- Tests/Conformance/C15.8.0.2.CC | 64 +- Tests/Conformance/C15.9.0.1.CC | 30 +- Tests/Conformance/C16.1.0.1.CC | 69 +- Tests/Conformance/C16.4.0.1.CC | 37 +- Tests/Conformance/C17.10.0.1.CC | 74 +- Tests/Conformance/C17.11.0.1.CC | 103 +- Tests/Conformance/C17.11.0.10.CC | 100 +- Tests/Conformance/C17.11.0.11.CC | 106 +- Tests/Conformance/C17.11.0.2.CC | 104 +- Tests/Conformance/C17.11.0.3.CC | 100 +- Tests/Conformance/C17.11.0.4.CC | 100 +- Tests/Conformance/C17.11.0.5.CC | 98 +- Tests/Conformance/C17.11.0.6.CC | 100 +- Tests/Conformance/C17.11.0.7.CC | 100 +- Tests/Conformance/C17.11.0.8.CC | 98 +- Tests/Conformance/C17.11.0.9.CC | 100 +- Tests/Conformance/C17.13.0.1.CC | 78 +- Tests/Conformance/C17.14.0.1.CC | 64 +- Tests/Conformance/C17.15.0.1.CC | 55 +- Tests/Conformance/C17.16.0.1.CC | 104 +- Tests/Conformance/C17.5.0.1.CC | 113 +- Tests/Conformance/C17.5.0.2.CC | 133 +- Tests/Conformance/C17.6.0.1.CC | 109 +- Tests/Conformance/C17.6.0.2.CC | 78 +- Tests/Conformance/C17.7.0.1.CC | 81 +- Tests/Conformance/C17.7.0.2.CC | 81 +- Tests/Conformance/C17.8.0.1.CC | 91 +- Tests/Conformance/C17.8.0.10.CC | 46 +- Tests/Conformance/C17.8.0.11.CC | 46 +- Tests/Conformance/C17.8.0.12.CC | 48 +- Tests/Conformance/C17.8.0.13.CC | 33 +- Tests/Conformance/C17.8.0.14.CC | 31 +- Tests/Conformance/C17.8.0.15.CC | 36 +- Tests/Conformance/C17.8.0.16.CC | 44 +- Tests/Conformance/C17.8.0.17.CC | 92 +- Tests/Conformance/C17.8.0.18.CC | 66 +- Tests/Conformance/C17.8.0.19.CC | 66 +- Tests/Conformance/C17.8.0.2.CC | 64 +- Tests/Conformance/C17.8.0.20.CC | 68 +- Tests/Conformance/C17.8.0.21.CC | 53 +- Tests/Conformance/C17.8.0.22.CC | 51 +- Tests/Conformance/C17.8.0.23.CC | 56 +- Tests/Conformance/C17.8.0.24.CC | 62 +- Tests/Conformance/C17.8.0.3.CC | 64 +- Tests/Conformance/C17.8.0.4.CC | 66 +- Tests/Conformance/C17.8.0.5.CC | 51 +- Tests/Conformance/C17.8.0.6.CC | 49 +- Tests/Conformance/C17.8.0.7.CC | 54 +- Tests/Conformance/C17.8.0.8.CC | 60 +- Tests/Conformance/C17.8.0.9.CC | 67 +- Tests/Conformance/C17.9.0.1.CC | 83 +- Tests/Conformance/C18.1.0.1.CC | 38 +- Tests/Conformance/C18.3.0.1.CC | 70 +- Tests/Conformance/C19.1.0.1.CC | 31 +- Tests/Conformance/C19.10.0.1.CC | 28 +- Tests/Conformance/C19.2.0.1.CC | 25 +- Tests/Conformance/C19.3.0.1.CC | 32 +- Tests/Conformance/C19.4.0.1.CC | 28 +- Tests/Conformance/C19.6.0.1.CC | 32 +- Tests/Conformance/C19.7.0.1.CC | 49 +- Tests/Conformance/C19.8.0.1.CC | 28 +- Tests/Conformance/C19.9.0.1.CC | 33 +- Tests/Conformance/C2.1.0.1.CC | 65 +- Tests/Conformance/C2.1.0.2.CC | 42 +- Tests/Conformance/C2.1.0.3.CC | 50 +- Tests/Conformance/C2.1.0.4.CC | 17 +- Tests/Conformance/C2.1.1.1.CC | 22 +- Tests/Conformance/C2.1.1.2.CC | 24 +- Tests/Conformance/C2.1.2.2.CC | 36 +- Tests/Conformance/C2.1.2.3.CC | 14 +- Tests/Conformance/C2.2.0.1.CC | 7 +- Tests/Conformance/C2.2.0.2.CC | 15 +- Tests/Conformance/C2.2.0.3.CC | 17 +- Tests/Conformance/C2.2.0.4.CC | 10 +- Tests/Conformance/C2.4.0.1.CC | 13 +- Tests/Conformance/C2.4.0.2.CC | 13 +- Tests/Conformance/C2.5.0.1.CC | 66 +- Tests/Conformance/C2.5.0.2.CC | 76 +- Tests/Conformance/C2.5.0.3.CC | 49 +- Tests/Conformance/C2.5.0.4.CC | 112 +- Tests/Conformance/C2.5.0.5.CC | 113 +- Tests/Conformance/C2.5.0.6.CC | 71 +- Tests/Conformance/C2.5.0.7.CC | 40 +- Tests/Conformance/C2.5.0.8.CC | 35 +- Tests/Conformance/C2.6.0.1.CC | 121 +- Tests/Conformance/C2.6.0.2.CC | 31 +- Tests/Conformance/C2.6.0.3.CC | 13 +- Tests/Conformance/C2.6.0.4.CC | 45 +- Tests/Conformance/C2.6.0.5.CC | 13 +- Tests/Conformance/C2.7.1.1.CC | 43 +- Tests/Conformance/C2.7.1.2.CC | 50 +- Tests/Conformance/C2.7.1.3.CC | 52 +- Tests/Conformance/C2.7.1.4.CC | 36 +- Tests/Conformance/C2.7.1.5.CC | 49 +- Tests/Conformance/C2.7.1.6.CC | 51 +- Tests/Conformance/C2.7.1.7.CC | 59 +- Tests/Conformance/C2.7.1.8.CC | 54 +- Tests/Conformance/C2.7.2.1.CC | 72 +- Tests/Conformance/C2.7.2.2.CC | 64 +- Tests/Conformance/C2.7.2.3.CC | 64 +- Tests/Conformance/C2.7.3.1.CC | 427 +- Tests/Conformance/C2.7.3.2.CC | 21 +- Tests/Conformance/C2.7.4.1.CC | 24 +- Tests/Conformance/C2.7.4.2.CC | 22 +- Tests/Conformance/C2.7.4.3.CC | 218 +- Tests/Conformance/C2.7.4.4.CC | 7 +- Tests/Conformance/C2.7.7.1.CC | 249 +- Tests/Conformance/C2.7.7.2.CC | 65 +- Tests/Conformance/C20.1.0.1.CC | 102 +- Tests/Conformance/C20.5.0.1.CC | 27 +- Tests/Conformance/C21.1.0.2.CC | 12 +- Tests/Conformance/C21.4.0.1.CC | 38 +- Tests/Conformance/C22.5.0.1.CC | 66 +- Tests/Conformance/C23.1.0.1.CC | 35 +- Tests/Conformance/C23.2.0.1.CC | 14 +- Tests/Conformance/C23.3.0.1.CC | 19 +- Tests/Conformance/C23.4.0.1.CC | 20 +- Tests/Conformance/C23.5.0.1.CC | 20 +- Tests/Conformance/C23.6.0.1.CC | 12 +- Tests/Conformance/C24.0.1.CC | 107 +- Tests/Conformance/C24.0.2.CC | 52 +- Tests/Conformance/C25.0.1.CC | 96 +- Tests/Conformance/C25.0.10.CC | 58 +- Tests/Conformance/C25.0.11.CC | 54 +- Tests/Conformance/C25.0.12.CC | 54 +- Tests/Conformance/C25.0.13.CC | 55 +- Tests/Conformance/C25.0.14.CC | 55 +- Tests/Conformance/C25.0.15.CC | 53 +- Tests/Conformance/C25.0.16.CC | 53 +- Tests/Conformance/C25.0.17.CC | 54 +- Tests/Conformance/C25.0.18.CC | 56 +- Tests/Conformance/C25.0.19.CC | 73 +- Tests/Conformance/C25.0.2.CC | 89 +- Tests/Conformance/C25.0.20.CC | 121 +- Tests/Conformance/C25.0.21.CC | 55 +- Tests/Conformance/C25.0.22.CC | 85 +- Tests/Conformance/C25.0.23.CC | 49 +- Tests/Conformance/C25.0.24.CC | 71 +- Tests/Conformance/C25.0.25.CC | 179 +- Tests/Conformance/C25.0.26.CC | 18 +- Tests/Conformance/C25.0.3.CC | 89 +- Tests/Conformance/C25.0.4.CC | 89 +- Tests/Conformance/C25.0.5.CC | 89 +- Tests/Conformance/C25.0.6.CC | 89 +- Tests/Conformance/C25.0.7.CC | 87 +- Tests/Conformance/C25.0.8.CC | 54 +- Tests/Conformance/C25.0.9.CC | 89 +- Tests/Conformance/C3.3.0.1.CC | 29 +- Tests/Conformance/C3.3.1.1.CC | 40 +- Tests/Conformance/C3.3.2.1.CC | 52 +- Tests/Conformance/C3.3.3.1.CC | 34 +- Tests/Conformance/C3.3.4.1.CC | 31 +- Tests/Conformance/C3.3.5.1.CC | 27 +- Tests/Conformance/C3.3.6.1.CC | 33 +- Tests/Conformance/C3.3.8.1.CC | 24 +- Tests/Conformance/C3.3.9.1.CC | 21 +- Tests/Conformance/C3.5.1.1.CC | 84 +- Tests/Conformance/C3.5.1.2.CC | 85 +- Tests/Conformance/C3.5.1.3.CC | 17 +- Tests/Conformance/C3.5.1.4.CC | 95 +- Tests/Conformance/C3.5.1.5.CC | 40 +- Tests/Conformance/C3.5.2.1.CC | 38 +- Tests/Conformance/C3.5.2.2.CC | 61 +- Tests/Conformance/C3.5.2.3.CC | 38 +- Tests/Conformance/C3.5.2.4.CC | 42 +- Tests/Conformance/C3.5.3.1.CC | 58 +- Tests/Conformance/C3.5.4.1.CC | 147 +- Tests/Conformance/C3.5.4.2.CC | 162 +- Tests/Conformance/C4.2.1.1.CC | 121 +- Tests/Conformance/C4.2.2.1.CC | 124 +- Tests/Conformance/C4.2.4.1.CC | 124 +- Tests/Conformance/C4.2.5.1.CC | 47 +- Tests/Conformance/C4.3.0.1.CC | 97 +- Tests/Conformance/C4.3.0.2.CC | 61 +- Tests/Conformance/C4.4.2.1.CC | 20 +- Tests/Conformance/C4.5.2.1.CC | 104 +- Tests/Conformance/C4.5.2.2.CC | 142 +- Tests/Conformance/C4.5.2.3.CC | 114 +- Tests/Conformance/C4.5.3.1.CC | 246 +- Tests/Conformance/C4.5.3.2.CC | 259 +- Tests/Conformance/C4.5.3.3.CC | 130 +- Tests/Conformance/C4.5.3.4.CC | 148 +- Tests/Conformance/C4.5.4.1.CC | 104 +- Tests/Conformance/C4.5.4.2.CC | 106 +- Tests/Conformance/C4.6.1.1.CC | 48 +- Tests/Conformance/C4.6.1.2.CC | 53 +- Tests/Conformance/C4.6.2.1.CC | 70 +- Tests/Conformance/C4.6.2.2.CC | 82 +- Tests/Conformance/C4.6.3.1.CC | 101 +- Tests/Conformance/C4.6.3.2.CC | 188 +- Tests/Conformance/C4.6.4.1.CC | 184 +- Tests/Conformance/C4.6.4.2.CC | 184 +- Tests/Conformance/C4.6.4.3.CC | 69 +- Tests/Conformance/C4.6.5.1.CC | 27 +- Tests/Conformance/C4.6.6.1.CC | 298 +- Tests/Conformance/C4.6.6.2.CC | 270 +- Tests/Conformance/C4.6.7.1.CC | 29 +- Tests/Conformance/C5.6.0.1.CC | 36 +- Tests/Conformance/C6.2.3.1.CC | 109 +- Tests/Conformance/C6.2.3.2.CC | 83 +- Tests/Conformance/C6.2.3.3.CC | 84 +- Tests/Conformance/C6.2.3.4.CC | 91 +- Tests/Conformance/C7.10.0.1.CC | 45 +- Tests/Conformance/C7.4.1.1.CC | 44 +- Tests/Conformance/C7.4.4.1.CC | 51 +- Tests/Conformance/C7.4.5.1.CC | 33 +- Tests/Conformance/C7.5.1.1.CC | 60 +- Tests/Conformance/C7.5.1.2.CC | 60 +- Tests/Conformance/C7.5.1.3.CC | 56 +- Tests/Conformance/C7.5.1.4.CC | 53 +- Tests/Conformance/C7.5.1.5.CC | 88 +- Tests/Conformance/C7.5.1.6.CC | 80 +- Tests/Conformance/C7.5.5.1.CC | 41 +- Tests/Conformance/C7.5.8.1.CC | 34 +- Tests/Conformance/C7.5.9.1.CC | 35 +- Tests/Conformance/C7.6.1.1.CC | 45 +- Tests/Conformance/C7.6.1.2.CC | 43 +- Tests/Conformance/C7.6.1.3.CC | 40 +- Tests/Conformance/C7.6.2.1.CC | 63 +- Tests/Conformance/C7.6.3.1.CC | 57 +- Tests/Conformance/C7.6.4.1.CC | 50 +- Tests/Conformance/C7.6.6.1.CC | 41 +- Tests/Conformance/C7.6.7.1.CC | 41 +- Tests/Conformance/C7.6.8.1.CC | 41 +- Tests/Conformance/C7.7.1.1.CC | 51 +- Tests/Conformance/C7.7.2.1.CC | 51 +- Tests/Conformance/C7.8.0.1.CC | 49 +- Tests/Conformance/C7.9.2.1.CC | 45 +- Tests/Conformance/C7.9.2.2.CC | 45 +- Tests/Conformance/C7.9.2.3.CC | 40 +- Tests/Conformance/C7.9.2.4.CC | 64 +- Tests/Conformance/C7.9.2.5.CC | 58 +- Tests/Conformance/C7.9.2.6.CC | 41 +- Tests/Conformance/C7.9.2.7.CC | 41 +- Tests/Conformance/C7.9.2.8.CC | 41 +- Tests/Conformance/C7.9.2.9.CC | 22 +- Tests/Conformance/C8.7.0.1.CC | 153 +- Tests/Conformance/C8.7.0.2.CC | 24 +- Tests/Conformance/C8.7.0.3.CC | 25 +- Tests/Conformance/C8.7.0.4.CC | 22 +- Tests/Conformance/C8.7.0.5.CC | 29 +- Tests/Conformance/C8.7.0.6.CC | 31 +- Tests/Conformance/C8.8.0.1.CC | 101 +- Tests/Conformance/C9.2.0.1.CC | 28 +- Tests/Conformance/C9.3.0.1.CC | 33 +- Tests/Conformance/C9.5.0.1.CC | 60 +- Tests/Conformance/C9.5.0.2.CC | 30 +- Tests/Conformance/C9.7.0.1.CC | 218 +- Tests/Conformance/TEST | 9 +- Tests/Conformance/TEST2 | 20 +- Tests/Conformance/c14.4.0.1.cc | 79 +- Tests/Conformance/c19.5.0.1.cc | 34 +- Tests/Conformance/c24.0.3.cc | 102 +- Tests/Conformance/c26.0.1.cc | 60 +- Tests/Conformance/c6.2.3.5.cc | 134 +- Tests/Conformance/doit | 270 +- Tests/Conformance/doit2 | 57 +- Tests/Deviance/D2.1.0.1.CC | 7 +- Tests/Deviance/D2.2.0.2.CC | 14 +- Tests/Deviance/D2.4.0.1.CC | 46 +- Tests/Deviance/D2.5.0.1.CC | 38 +- Tests/Deviance/D2.5.0.2.CC | 45 +- Tests/Deviance/D2.7.1.1.CC | 26 +- Tests/Deviance/D2.7.1.2.CC | 27 +- Tests/Deviance/D2.7.2.1.CC | 31 +- Tests/Deviance/D2.7.3.1.CC | 15 +- Tests/Deviance/D2.7.3.2.CC | 16 +- Tests/Deviance/D2.7.3.3.CC | 12 +- Tests/Deviance/D2.7.4.1.CC | 12 +- Tests/Deviance/D2.7.4.4.CC | 278 +- Tests/Deviance/D25.0.1.CC | 21 +- Tests/Deviance/D25.0.2.CC | 15 +- Tests/Deviance/D3.3.1.1.CC | 13 +- Tests/Deviance/D3.3.10.1.CC | 14 +- Tests/Deviance/D3.3.2.1.CC | 26 +- Tests/Deviance/D3.3.3.1.CC | 15 +- Tests/Deviance/D3.3.4.1.CC | 20 +- Tests/Deviance/D3.3.5.1.CC | 21 +- Tests/Deviance/D3.4.0.1.CC | 20 +- Tests/Deviance/D3.5.1.1.CC | 39 +- Tests/Deviance/D3.5.2.1.CC | 34 +- Tests/Deviance/D3.5.3.1.CC | 20 +- Tests/Deviance/D3.5.5.1.CC | 28 +- Tests/Deviance/D3401.DATA | 5 +- Tests/Deviance/D4.2.1.1.CC | 56 +- Tests/Deviance/D4.2.2.1.CC | 62 +- Tests/Deviance/D4.2.3.1.CC | 22 +- Tests/Deviance/D4.2.5.1.CC | 114 +- Tests/Deviance/D4.2.9.1.CC | 31 +- Tests/Deviance/D4.3.0.1.CC | 48 +- Tests/Deviance/D4.4.1.1.CC | 10 +- Tests/Deviance/D4.5.3.1.CC | 41 +- Tests/Deviance/D4.6.0.1.CC | 14 +- Tests/Deviance/D4.6.0.2.CC | 13 +- Tests/Deviance/D4.6.1.1.CC | 27 +- Tests/Deviance/D4.6.2.1.CC | 26 +- Tests/Deviance/D4.6.3.1.CC | 16 +- Tests/Deviance/D4.6.4.1.CC | 36 +- Tests/Deviance/D4.6.5.1.CC | 17 +- Tests/Deviance/D4.6.6.1.CC | 28 +- Tests/Deviance/D4.6.7.1.CC | 24 +- Tests/Deviance/D4.6.8.1.CC | 20 +- Tests/Deviance/D7.1.1.1.CC | 26 +- Tests/Deviance/D7.5.4.1.CC | 24 +- Tests/Deviance/D7.6.1.1.CC | 24 +- Tests/Deviance/D7.6.1.2.CC | 14 +- Tests/Deviance/D7.6.1.3.CC | 14 +- Tests/Deviance/D7.6.1.4.CC | 14 +- Tests/Deviance/D7.6.3.1.CC | 29 +- Tests/Deviance/D7.6.4.1.CC | 21 +- Tests/Deviance/D7.6.6.1.CC | 24 +- Tests/Deviance/D7.6.7.1.CC | 24 +- Tests/Deviance/D7.6.8.1.CC | 24 +- Tests/Deviance/D8.7.0.1.CC | 52 +- Tests/Deviance/D8.8.0.1.CC | 18 +- Tests/Deviance/D9.2.0.1.CC | 29 +- Tests/Deviance/DOIT | 59 +- Tests/Deviance/RUN.DEVIANCE | 116 +- Tests/Deviance/TEST | 8 +- Tests/Deviance/TEST2 | 8 +- Tests/Spec.Conform/CFILE1 | 3 +- Tests/Spec.Conform/LIBFILE2 | 8 +- Tests/Spec.Conform/SPC13.2.0.1.CC | 42 +- Tests/Spec.Conform/SPC13.4.0.1.CC | 74 +- Tests/Spec.Conform/SPC17.16.0.1.CC | 137 +- Tests/Spec.Conform/SPC17.2.0.1.CC | 167 +- Tests/Spec.Conform/SPC17.2.0.2.CC | 251 +- Tests/Spec.Conform/SPC17.2.0.3.CC | 203 +- Tests/Spec.Conform/SPC17.3.0.1.CC | 70 +- Tests/Spec.Conform/SPC17.3.0.2.CC | 69 +- Tests/Spec.Conform/SPC17.3.0.3.CC | 52 +- Tests/Spec.Conform/SPC17.3.0.4.CC | 73 +- Tests/Spec.Conform/SPC17.3.0.5.CC | 53 +- Tests/Spec.Conform/SPC17.6.0.1.CC | 243 +- Tests/Spec.Conform/SPC17.7.0.1.CC | 75 +- Tests/Spec.Conform/SPC2.1.0.1.CC | 16 +- Tests/Spec.Conform/SPC20.2.0.1.CC | 80 +- Tests/Spec.Conform/SPC21.1.0.1.CC | 14 +- Tests/Spec.Conform/SPC21.2.0.1.CC | 16 +- Tests/Spec.Conform/SPC22.1.0.1.CC | 38 +- Tests/Spec.Conform/SPC22.101.EXEC | 7 +- Tests/Spec.Conform/SPC23.2.0.1.CC | 23 +- Tests/Spec.Conform/SPC23.201.EXEC | 7 +- Tests/Spec.Conform/SPC25.0.1.CC | 94 +- Tests/Spec.Conform/SPC25.0.2.CC | 73 +- Tests/Spec.Conform/SPC25.1.1.CC | 115 +- Tests/Spec.Conform/SPC25.1.EXEC | 27 +- Tests/Spec.Conform/SPC25.1.H | 16 +- Tests/Spec.Conform/SPC25.2.1.CC | 54 +- Tests/Spec.Conform/SPC25.2.EXEC | 30 +- Tests/Spec.Conform/SPC3.3.4.1.CC | 14 +- Tests/Spec.Conform/SPC3.4.0.1.CC | 15 +- Tests/Spec.Conform/SPC3.4.0.2.CC | 8 +- Tests/Spec.Conform/SPC3.6.0.1.CC | 16 +- Tests/Spec.Conform/SPC3.6.0.2.CC | 24 +- Tests/Spec.Conform/SPC3.6.0.3.CC | 21 +- Tests/Spec.Conform/SPC3401.EXEC | 3 +- Tests/Spec.Conform/SPC34021 | 4 +- Tests/Spec.Conform/SPC34022 | 4 +- Tests/Spec.Conform/SPC34023 | 4 +- Tests/Spec.Conform/SPC34024 | 4 +- Tests/Spec.Conform/SPC34025 | 4 +- Tests/Spec.Conform/SPC34026 | 4 +- Tests/Spec.Conform/SPC34027 | 4 +- Tests/Spec.Conform/SPC34028 | 7 +- Tests/Spec.Conform/SPC4.3.0.1.CC | 91 +- Tests/Spec.Conform/SPC4.3.1.1.CC | 34 +- Tests/Spec.Conform/SPC4.4.1.1.CC | 61 +- Tests/Spec.Conform/SPC4.5.2.1.CC | 16 +- Tests/Spec.Conform/SPC4.5.3.1.CC | 41 +- Tests/Spec.Conform/SPC4.5.3.2.CC | 44 +- Tests/Spec.Conform/SPC4.6.3.1.CC | 327 +- Tests/Spec.Conform/SPC4.6.3.2.CC | 150 +- Tests/Spec.Conform/SPC4.6.3.3.CC | 144 +- Tests/Spec.Conform/SPC4.6.3.4.CC | 146 +- Tests/Spec.Conform/SPC4.6.3.5.CC | 23 +- Tests/Spec.Conform/SPC4.6.3.6.CC | 145 +- Tests/Spec.Conform/SPC4301.1.CC | 14 +- Tests/Spec.Conform/SPC4301.2.CC | 10 +- Tests/Spec.Conform/SPC4301.EXEC | 37 +- Tests/Spec.Conform/SPC4301.H | 9 +- Tests/Spec.Conform/SPC4311.1.CC | 20 +- Tests/Spec.Conform/SPC4311.EXEC | 31 +- Tests/Spec.Conform/SPC4411.1.CC | 14 +- Tests/Spec.Conform/SPC4521.1.CC | 124 +- Tests/Spec.Conform/SPC4521.EXEC | 30 +- Tests/Spec.Conform/SPC4521.H | 21 +- Tests/Spec.Conform/SPC4531.1.CC | 259 +- Tests/Spec.Conform/SPC4531.EXEC | 30 +- Tests/Spec.Conform/SPC4531.H | 26 +- Tests/Spec.Conform/SPC4532.1.CC | 127 +- Tests/Spec.Conform/SPC4532.EXEC | 30 +- Tests/Spec.Conform/SPC4532.H | 25 +- Tests/Spec.Conform/SPC4631.1.CC | 197 +- Tests/Spec.Conform/SPC4631.EXEC | 28 +- Tests/Spec.Conform/SPC4632.1.CC | 92 +- Tests/Spec.Conform/SPC4632.EXEC | 28 +- Tests/Spec.Conform/SPC4633.1.CC | 83 +- Tests/Spec.Conform/SPC4633.EXEC | 28 +- Tests/Spec.Conform/SPC4634.1.CC | 83 +- Tests/Spec.Conform/SPC4634.EXEC | 28 +- Tests/Spec.Conform/SPC4636.1.CC | 81 +- Tests/Spec.Conform/SPC4636.EXEC | 30 +- Tests/Spec.Conform/UFILE1 | 4 +- Tests/Spec.Conform/USERFILE2 | 4 +- Tests/Spec.Conform/spc21.3.0.1.cc | 57 +- Tests/Spec.Conform/spc21.3.0.2.cc | 57 +- Tests/Spec.Conform/spc21.3.0.3.cc | 57 +- Tests/Spec.Conform/spc4411.exec | 34 +- Tests/Spec.Deviance/DOIT | 16 +- Tests/Spec.Deviance/SPD17.2.0.1.CC | 20 +- Tests/Spec.Deviance/SPD17.2.0.2.CC | 20 +- Tests/Spec.Deviance/SPD17.2.0.3.CC | 20 +- Tests/Spec.Deviance/SPD17.2.0.4.CC | 21 +- Tests/Spec.Deviance/SPD17.2.0.5.CC | 21 +- Tests/Spec.Deviance/SPD17.2.0.7.CC | 21 +- Tests/Spec.Deviance/SPD17.3.0.1.CC | 22 +- Tests/Spec.Deviance/SPD17.3.0.2.CC | 36 +- Tests/Spec.Deviance/SPD17.3.0.3.CC | 29 +- Tests/Spec.Deviance/SPD17.5.0.1.CC | 28 +- Tests/Spec.Deviance/SPD17.5.0.2.CC | 24 +- Tests/Spec.Deviance/SPD17.6.0.1.CC | 22 +- Tests/Spec.Deviance/SPD17.6.0.2.CC | 22 +- Tests/Spec.Deviance/SPD17.6.0.3.CC | 23 +- Tests/Spec.Deviance/SPD17.7.0.1.CC | 24 +- Tests/Spec.Deviance/TEST | 5 +- backup | 34 +- bin/Libraries/ORCACDefs/ace.h | 47 +- bin/Libraries/ORCACDefs/adb.h | 110 +- bin/Libraries/ORCACDefs/appleshare.h | 214 +- bin/Libraries/ORCACDefs/assert.h | 24 +- bin/Libraries/ORCACDefs/control.h | 430 +- bin/Libraries/ORCACDefs/ctype.h | 62 +- bin/Libraries/ORCACDefs/desk.h | 113 +- bin/Libraries/ORCACDefs/dialog.h | 184 +- bin/Libraries/ORCACDefs/errno.h | 31 +- bin/Libraries/ORCACDefs/event.h | 120 +- bin/Libraries/ORCACDefs/fcntl.h | 41 +- bin/Libraries/ORCACDefs/finder.h | 460 +- bin/Libraries/ORCACDefs/float.h | 57 +- bin/Libraries/ORCACDefs/font.h | 112 +- bin/Libraries/ORCACDefs/gsbug.h | 27 +- bin/Libraries/ORCACDefs/gsos.h | 633 ++- bin/Libraries/ORCACDefs/hyperstudio.h | 220 +- bin/Libraries/ORCACDefs/hyperxcmd.h | 135 +- bin/Libraries/ORCACDefs/intmath.h | 105 +- bin/Libraries/ORCACDefs/limits.h | 34 +- bin/Libraries/ORCACDefs/lineedit.h | 99 +- bin/Libraries/ORCACDefs/list.h | 109 +- bin/Libraries/ORCACDefs/loader.h | 88 +- bin/Libraries/ORCACDefs/locator.h | 168 +- bin/Libraries/ORCACDefs/math.h | 46 +- bin/Libraries/ORCACDefs/mediacontrol.h | 215 +- bin/Libraries/ORCACDefs/memory.h | 84 +- bin/Libraries/ORCACDefs/menu.h | 227 +- bin/Libraries/ORCACDefs/midi.h | 122 +- bin/Libraries/ORCACDefs/midisynth.h | 204 +- bin/Libraries/ORCACDefs/misctool.h | 413 +- bin/Libraries/ORCACDefs/noteseq.h | 95 +- bin/Libraries/ORCACDefs/notesyn.h | 86 +- bin/Libraries/ORCACDefs/orca.h | 27 +- bin/Libraries/ORCACDefs/print.h | 160 +- bin/Libraries/ORCACDefs/prodos.h | 323 +- bin/Libraries/ORCACDefs/qdaux.h | 188 +- bin/Libraries/ORCACDefs/quickdraw.h | 391 +- bin/Libraries/ORCACDefs/resources.h | 228 +- bin/Libraries/ORCACDefs/sane.h | 273 +- bin/Libraries/ORCACDefs/scheduler.h | 31 +- bin/Libraries/ORCACDefs/scrap.h | 66 +- bin/Libraries/ORCACDefs/setjmp.h | 22 +- bin/Libraries/ORCACDefs/shell.h | 407 +- bin/Libraries/ORCACDefs/signal.h | 34 +- bin/Libraries/ORCACDefs/sound.h | 122 +- bin/Libraries/ORCACDefs/stdarg.h | 35 +- bin/Libraries/ORCACDefs/stddef.h | 32 +- bin/Libraries/ORCACDefs/stdfile.h | 125 +- bin/Libraries/ORCACDefs/stdio.h | 154 +- bin/Libraries/ORCACDefs/stdlib.h | 66 +- bin/Libraries/ORCACDefs/string.h | 52 +- bin/Libraries/ORCACDefs/textedit.h | 444 +- bin/Libraries/ORCACDefs/texttool.h | 100 +- bin/Libraries/ORCACDefs/time.h | 55 +- bin/Libraries/ORCACDefs/toollib.h | 194 +- bin/Libraries/ORCACDefs/types.h | 292 +- bin/Libraries/ORCACDefs/video.h | 123 +- bin/Libraries/ORCACDefs/window.h | 441 +- bin/OSSource/ORCALib/equates.asm | 114 +- bin/OSSource/ORCALib/stdio.asm | 5238 +++++++++++++++++++++- bin/cc.notes | 906 +++- cc.notes | 914 +++- count | 38 +- linkit | 19 +- linkit2 | 19 +- make | 192 +- make2 | 194 +- smake | 194 +- 559 files changed, 83353 insertions(+), 559 deletions(-) mode change 100755 => 100644 Asm.pas mode change 100755 => 100644 CC.pas mode change 100755 => 100644 CC.rez mode change 100755 => 100644 CC.rez2 mode change 100755 => 100644 CCommon.asm mode change 100755 => 100644 CCommon.macros mode change 100755 => 100644 CCommon.pas mode change 100755 => 100644 CGC.asm mode change 100755 => 100644 CGC.macros mode change 100755 => 100644 CGC.pas mode change 100755 => 100644 CGI.Comments mode change 100755 => 100644 CGI.Debug mode change 100755 => 100644 CGI.pas mode change 100755 => 100644 DAG.pas mode change 100755 => 100644 DAG2.pas mode change 100755 => 100644 Exp.macros mode change 100755 => 100644 Expression.asm mode change 100755 => 100644 Expression.pas mode change 100755 => 100644 Gen.pas mode change 100755 => 100644 Header.pas mode change 100755 => 100644 Header2.pas mode change 100755 => 100644 MM.asm mode change 100755 => 100644 MM.macros mode change 100755 => 100644 MM.pas mode change 100755 => 100644 Native.asm mode change 100755 => 100644 Native.macros mode change 100755 => 100644 Native.pas mode change 100755 => 100644 Native2.pas mode change 100755 => 100644 ObjOut.asm mode change 100755 => 100644 ObjOut.macros mode change 100755 => 100644 ObjOut.pas mode change 100755 => 100644 ObjOut2.asm mode change 100755 => 100644 ObjOut2.pas mode change 100755 => 100644 Parser.pas mode change 100755 => 100644 Scanner.asm mode change 100755 => 100644 Scanner.debug mode change 100755 => 100644 Scanner.macros mode change 100755 => 100644 Scanner.pas mode change 100755 => 100644 Symbol.Print mode change 100755 => 100644 Symbol.asm mode change 100755 => 100644 Symbol.macros mode change 100755 => 100644 Symbol.pas mode change 100755 => 100644 Table.asm mode change 100755 => 100644 Table.macros mode change 100755 => 100644 Table.pas mode change 100755 => 100644 Tests/Conformance/C11.4.2.1.CC mode change 100755 => 100644 Tests/Conformance/C13.1.0.1.CC mode change 100755 => 100644 Tests/Conformance/C14.1.0.1.CC mode change 100755 => 100644 Tests/Conformance/C14.2.0.1.CC mode change 100755 => 100644 Tests/Conformance/C14.3.0.1.CC mode change 100755 => 100644 Tests/Conformance/C14.5.0.1.CC mode change 100755 => 100644 Tests/Conformance/C14.6.0.1.CC mode change 100755 => 100644 Tests/Conformance/C14.7.0.1.CC mode change 100755 => 100644 Tests/Conformance/C14.8.0.1.CC mode change 100755 => 100644 Tests/Conformance/C14.9.0.1.CC mode change 100755 => 100644 Tests/Conformance/C15.1.0.1.CC mode change 100755 => 100644 Tests/Conformance/C15.2.0.1.CC mode change 100755 => 100644 Tests/Conformance/C15.3.0.1.CC mode change 100755 => 100644 Tests/Conformance/C15.5.0.1.CC mode change 100755 => 100644 Tests/Conformance/C15.6.0.1.CC mode change 100755 => 100644 Tests/Conformance/C15.7.0.1.CC mode change 100755 => 100644 Tests/Conformance/C15.7.0.2.CC mode change 100755 => 100644 Tests/Conformance/C15.8.0.1.CC mode change 100755 => 100644 Tests/Conformance/C15.8.0.2.CC mode change 100755 => 100644 Tests/Conformance/C15.9.0.1.CC mode change 100755 => 100644 Tests/Conformance/C16.1.0.1.CC mode change 100755 => 100644 Tests/Conformance/C16.4.0.1.CC mode change 100755 => 100644 Tests/Conformance/C17.10.0.1.CC mode change 100755 => 100644 Tests/Conformance/C17.11.0.1.CC mode change 100755 => 100644 Tests/Conformance/C17.11.0.10.CC mode change 100755 => 100644 Tests/Conformance/C17.11.0.11.CC mode change 100755 => 100644 Tests/Conformance/C17.11.0.2.CC mode change 100755 => 100644 Tests/Conformance/C17.11.0.3.CC mode change 100755 => 100644 Tests/Conformance/C17.11.0.4.CC mode change 100755 => 100644 Tests/Conformance/C17.11.0.5.CC mode change 100755 => 100644 Tests/Conformance/C17.11.0.6.CC mode change 100755 => 100644 Tests/Conformance/C17.11.0.7.CC mode change 100755 => 100644 Tests/Conformance/C17.11.0.8.CC mode change 100755 => 100644 Tests/Conformance/C17.11.0.9.CC mode change 100755 => 100644 Tests/Conformance/C17.13.0.1.CC mode change 100755 => 100644 Tests/Conformance/C17.14.0.1.CC mode change 100755 => 100644 Tests/Conformance/C17.15.0.1.CC mode change 100755 => 100644 Tests/Conformance/C17.16.0.1.CC mode change 100755 => 100644 Tests/Conformance/C17.5.0.1.CC mode change 100755 => 100644 Tests/Conformance/C17.5.0.2.CC mode change 100755 => 100644 Tests/Conformance/C17.6.0.1.CC mode change 100755 => 100644 Tests/Conformance/C17.6.0.2.CC mode change 100755 => 100644 Tests/Conformance/C17.7.0.1.CC mode change 100755 => 100644 Tests/Conformance/C17.7.0.2.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.1.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.10.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.11.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.12.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.13.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.14.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.15.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.16.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.17.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.18.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.19.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.2.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.20.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.21.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.22.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.23.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.24.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.3.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.4.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.5.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.6.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.7.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.8.CC mode change 100755 => 100644 Tests/Conformance/C17.8.0.9.CC mode change 100755 => 100644 Tests/Conformance/C17.9.0.1.CC mode change 100755 => 100644 Tests/Conformance/C18.1.0.1.CC mode change 100755 => 100644 Tests/Conformance/C18.3.0.1.CC mode change 100755 => 100644 Tests/Conformance/C19.1.0.1.CC mode change 100755 => 100644 Tests/Conformance/C19.10.0.1.CC mode change 100755 => 100644 Tests/Conformance/C19.2.0.1.CC mode change 100755 => 100644 Tests/Conformance/C19.3.0.1.CC mode change 100755 => 100644 Tests/Conformance/C19.4.0.1.CC mode change 100755 => 100644 Tests/Conformance/C19.6.0.1.CC mode change 100755 => 100644 Tests/Conformance/C19.7.0.1.CC mode change 100755 => 100644 Tests/Conformance/C19.8.0.1.CC mode change 100755 => 100644 Tests/Conformance/C19.9.0.1.CC mode change 100755 => 100644 Tests/Conformance/C2.1.0.1.CC mode change 100755 => 100644 Tests/Conformance/C2.1.0.2.CC mode change 100755 => 100644 Tests/Conformance/C2.1.0.3.CC mode change 100755 => 100644 Tests/Conformance/C2.1.0.4.CC mode change 100755 => 100644 Tests/Conformance/C2.1.1.1.CC mode change 100755 => 100644 Tests/Conformance/C2.1.1.2.CC mode change 100755 => 100644 Tests/Conformance/C2.1.2.2.CC mode change 100755 => 100644 Tests/Conformance/C2.1.2.3.CC mode change 100755 => 100644 Tests/Conformance/C2.2.0.1.CC mode change 100755 => 100644 Tests/Conformance/C2.2.0.2.CC mode change 100755 => 100644 Tests/Conformance/C2.2.0.3.CC mode change 100755 => 100644 Tests/Conformance/C2.2.0.4.CC mode change 100755 => 100644 Tests/Conformance/C2.4.0.1.CC mode change 100755 => 100644 Tests/Conformance/C2.4.0.2.CC mode change 100755 => 100644 Tests/Conformance/C2.5.0.1.CC mode change 100755 => 100644 Tests/Conformance/C2.5.0.2.CC mode change 100755 => 100644 Tests/Conformance/C2.5.0.3.CC mode change 100755 => 100644 Tests/Conformance/C2.5.0.4.CC mode change 100755 => 100644 Tests/Conformance/C2.5.0.5.CC mode change 100755 => 100644 Tests/Conformance/C2.5.0.6.CC mode change 100755 => 100644 Tests/Conformance/C2.5.0.7.CC mode change 100755 => 100644 Tests/Conformance/C2.5.0.8.CC mode change 100755 => 100644 Tests/Conformance/C2.6.0.1.CC mode change 100755 => 100644 Tests/Conformance/C2.6.0.2.CC mode change 100755 => 100644 Tests/Conformance/C2.6.0.3.CC mode change 100755 => 100644 Tests/Conformance/C2.6.0.4.CC mode change 100755 => 100644 Tests/Conformance/C2.6.0.5.CC mode change 100755 => 100644 Tests/Conformance/C2.7.1.1.CC mode change 100755 => 100644 Tests/Conformance/C2.7.1.2.CC mode change 100755 => 100644 Tests/Conformance/C2.7.1.3.CC mode change 100755 => 100644 Tests/Conformance/C2.7.1.4.CC mode change 100755 => 100644 Tests/Conformance/C2.7.1.5.CC mode change 100755 => 100644 Tests/Conformance/C2.7.1.6.CC mode change 100755 => 100644 Tests/Conformance/C2.7.1.7.CC mode change 100755 => 100644 Tests/Conformance/C2.7.1.8.CC mode change 100755 => 100644 Tests/Conformance/C2.7.2.1.CC mode change 100755 => 100644 Tests/Conformance/C2.7.2.2.CC mode change 100755 => 100644 Tests/Conformance/C2.7.2.3.CC mode change 100755 => 100644 Tests/Conformance/C2.7.3.1.CC mode change 100755 => 100644 Tests/Conformance/C2.7.3.2.CC mode change 100755 => 100644 Tests/Conformance/C2.7.4.1.CC mode change 100755 => 100644 Tests/Conformance/C2.7.4.2.CC mode change 100755 => 100644 Tests/Conformance/C2.7.4.3.CC mode change 100755 => 100644 Tests/Conformance/C2.7.4.4.CC mode change 100755 => 100644 Tests/Conformance/C2.7.7.1.CC mode change 100755 => 100644 Tests/Conformance/C2.7.7.2.CC mode change 100755 => 100644 Tests/Conformance/C20.1.0.1.CC mode change 100755 => 100644 Tests/Conformance/C20.5.0.1.CC mode change 100755 => 100644 Tests/Conformance/C21.1.0.2.CC mode change 100755 => 100644 Tests/Conformance/C21.4.0.1.CC mode change 100755 => 100644 Tests/Conformance/C22.5.0.1.CC mode change 100755 => 100644 Tests/Conformance/C23.1.0.1.CC mode change 100755 => 100644 Tests/Conformance/C23.2.0.1.CC mode change 100755 => 100644 Tests/Conformance/C23.3.0.1.CC mode change 100755 => 100644 Tests/Conformance/C23.4.0.1.CC mode change 100755 => 100644 Tests/Conformance/C23.5.0.1.CC mode change 100755 => 100644 Tests/Conformance/C23.6.0.1.CC mode change 100755 => 100644 Tests/Conformance/C24.0.1.CC mode change 100755 => 100644 Tests/Conformance/C24.0.2.CC mode change 100755 => 100644 Tests/Conformance/C25.0.1.CC mode change 100755 => 100644 Tests/Conformance/C25.0.10.CC mode change 100755 => 100644 Tests/Conformance/C25.0.11.CC mode change 100755 => 100644 Tests/Conformance/C25.0.12.CC mode change 100755 => 100644 Tests/Conformance/C25.0.13.CC mode change 100755 => 100644 Tests/Conformance/C25.0.14.CC mode change 100755 => 100644 Tests/Conformance/C25.0.15.CC mode change 100755 => 100644 Tests/Conformance/C25.0.16.CC mode change 100755 => 100644 Tests/Conformance/C25.0.17.CC mode change 100755 => 100644 Tests/Conformance/C25.0.18.CC mode change 100755 => 100644 Tests/Conformance/C25.0.19.CC mode change 100755 => 100644 Tests/Conformance/C25.0.2.CC mode change 100755 => 100644 Tests/Conformance/C25.0.20.CC mode change 100755 => 100644 Tests/Conformance/C25.0.21.CC mode change 100755 => 100644 Tests/Conformance/C25.0.22.CC mode change 100755 => 100644 Tests/Conformance/C25.0.23.CC mode change 100755 => 100644 Tests/Conformance/C25.0.24.CC mode change 100755 => 100644 Tests/Conformance/C25.0.25.CC mode change 100755 => 100644 Tests/Conformance/C25.0.26.CC mode change 100755 => 100644 Tests/Conformance/C25.0.3.CC mode change 100755 => 100644 Tests/Conformance/C25.0.4.CC mode change 100755 => 100644 Tests/Conformance/C25.0.5.CC mode change 100755 => 100644 Tests/Conformance/C25.0.6.CC mode change 100755 => 100644 Tests/Conformance/C25.0.7.CC mode change 100755 => 100644 Tests/Conformance/C25.0.8.CC mode change 100755 => 100644 Tests/Conformance/C25.0.9.CC mode change 100755 => 100644 Tests/Conformance/C3.3.0.1.CC mode change 100755 => 100644 Tests/Conformance/C3.3.1.1.CC mode change 100755 => 100644 Tests/Conformance/C3.3.2.1.CC mode change 100755 => 100644 Tests/Conformance/C3.3.3.1.CC mode change 100755 => 100644 Tests/Conformance/C3.3.4.1.CC mode change 100755 => 100644 Tests/Conformance/C3.3.5.1.CC mode change 100755 => 100644 Tests/Conformance/C3.3.6.1.CC mode change 100755 => 100644 Tests/Conformance/C3.3.8.1.CC mode change 100755 => 100644 Tests/Conformance/C3.3.9.1.CC mode change 100755 => 100644 Tests/Conformance/C3.5.1.1.CC mode change 100755 => 100644 Tests/Conformance/C3.5.1.2.CC mode change 100755 => 100644 Tests/Conformance/C3.5.1.3.CC mode change 100755 => 100644 Tests/Conformance/C3.5.1.4.CC mode change 100755 => 100644 Tests/Conformance/C3.5.1.5.CC mode change 100755 => 100644 Tests/Conformance/C3.5.2.1.CC mode change 100755 => 100644 Tests/Conformance/C3.5.2.2.CC mode change 100755 => 100644 Tests/Conformance/C3.5.2.3.CC mode change 100755 => 100644 Tests/Conformance/C3.5.2.4.CC mode change 100755 => 100644 Tests/Conformance/C3.5.3.1.CC mode change 100755 => 100644 Tests/Conformance/C3.5.4.1.CC mode change 100755 => 100644 Tests/Conformance/C3.5.4.2.CC mode change 100755 => 100644 Tests/Conformance/C4.2.1.1.CC mode change 100755 => 100644 Tests/Conformance/C4.2.2.1.CC mode change 100755 => 100644 Tests/Conformance/C4.2.4.1.CC mode change 100755 => 100644 Tests/Conformance/C4.2.5.1.CC mode change 100755 => 100644 Tests/Conformance/C4.3.0.1.CC mode change 100755 => 100644 Tests/Conformance/C4.3.0.2.CC mode change 100755 => 100644 Tests/Conformance/C4.4.2.1.CC mode change 100755 => 100644 Tests/Conformance/C4.5.2.1.CC mode change 100755 => 100644 Tests/Conformance/C4.5.2.2.CC mode change 100755 => 100644 Tests/Conformance/C4.5.2.3.CC mode change 100755 => 100644 Tests/Conformance/C4.5.3.1.CC mode change 100755 => 100644 Tests/Conformance/C4.5.3.2.CC mode change 100755 => 100644 Tests/Conformance/C4.5.3.3.CC mode change 100755 => 100644 Tests/Conformance/C4.5.3.4.CC mode change 100755 => 100644 Tests/Conformance/C4.5.4.1.CC mode change 100755 => 100644 Tests/Conformance/C4.5.4.2.CC mode change 100755 => 100644 Tests/Conformance/C4.6.1.1.CC mode change 100755 => 100644 Tests/Conformance/C4.6.1.2.CC mode change 100755 => 100644 Tests/Conformance/C4.6.2.1.CC mode change 100755 => 100644 Tests/Conformance/C4.6.2.2.CC mode change 100755 => 100644 Tests/Conformance/C4.6.3.1.CC mode change 100755 => 100644 Tests/Conformance/C4.6.3.2.CC mode change 100755 => 100644 Tests/Conformance/C4.6.4.1.CC mode change 100755 => 100644 Tests/Conformance/C4.6.4.2.CC mode change 100755 => 100644 Tests/Conformance/C4.6.4.3.CC mode change 100755 => 100644 Tests/Conformance/C4.6.5.1.CC mode change 100755 => 100644 Tests/Conformance/C4.6.6.1.CC mode change 100755 => 100644 Tests/Conformance/C4.6.6.2.CC mode change 100755 => 100644 Tests/Conformance/C4.6.7.1.CC mode change 100755 => 100644 Tests/Conformance/C5.6.0.1.CC mode change 100755 => 100644 Tests/Conformance/C6.2.3.1.CC mode change 100755 => 100644 Tests/Conformance/C6.2.3.2.CC mode change 100755 => 100644 Tests/Conformance/C6.2.3.3.CC mode change 100755 => 100644 Tests/Conformance/C6.2.3.4.CC mode change 100755 => 100644 Tests/Conformance/C7.10.0.1.CC mode change 100755 => 100644 Tests/Conformance/C7.4.1.1.CC mode change 100755 => 100644 Tests/Conformance/C7.4.4.1.CC mode change 100755 => 100644 Tests/Conformance/C7.4.5.1.CC mode change 100755 => 100644 Tests/Conformance/C7.5.1.1.CC mode change 100755 => 100644 Tests/Conformance/C7.5.1.2.CC mode change 100755 => 100644 Tests/Conformance/C7.5.1.3.CC mode change 100755 => 100644 Tests/Conformance/C7.5.1.4.CC mode change 100755 => 100644 Tests/Conformance/C7.5.1.5.CC mode change 100755 => 100644 Tests/Conformance/C7.5.1.6.CC mode change 100755 => 100644 Tests/Conformance/C7.5.5.1.CC mode change 100755 => 100644 Tests/Conformance/C7.5.8.1.CC mode change 100755 => 100644 Tests/Conformance/C7.5.9.1.CC mode change 100755 => 100644 Tests/Conformance/C7.6.1.1.CC mode change 100755 => 100644 Tests/Conformance/C7.6.1.2.CC mode change 100755 => 100644 Tests/Conformance/C7.6.1.3.CC mode change 100755 => 100644 Tests/Conformance/C7.6.2.1.CC mode change 100755 => 100644 Tests/Conformance/C7.6.3.1.CC mode change 100755 => 100644 Tests/Conformance/C7.6.4.1.CC mode change 100755 => 100644 Tests/Conformance/C7.6.6.1.CC mode change 100755 => 100644 Tests/Conformance/C7.6.7.1.CC mode change 100755 => 100644 Tests/Conformance/C7.6.8.1.CC mode change 100755 => 100644 Tests/Conformance/C7.7.1.1.CC mode change 100755 => 100644 Tests/Conformance/C7.7.2.1.CC mode change 100755 => 100644 Tests/Conformance/C7.8.0.1.CC mode change 100755 => 100644 Tests/Conformance/C7.9.2.1.CC mode change 100755 => 100644 Tests/Conformance/C7.9.2.2.CC mode change 100755 => 100644 Tests/Conformance/C7.9.2.3.CC mode change 100755 => 100644 Tests/Conformance/C7.9.2.4.CC mode change 100755 => 100644 Tests/Conformance/C7.9.2.5.CC mode change 100755 => 100644 Tests/Conformance/C7.9.2.6.CC mode change 100755 => 100644 Tests/Conformance/C7.9.2.7.CC mode change 100755 => 100644 Tests/Conformance/C7.9.2.8.CC mode change 100755 => 100644 Tests/Conformance/C7.9.2.9.CC mode change 100755 => 100644 Tests/Conformance/C8.7.0.1.CC mode change 100755 => 100644 Tests/Conformance/C8.7.0.2.CC mode change 100755 => 100644 Tests/Conformance/C8.7.0.3.CC mode change 100755 => 100644 Tests/Conformance/C8.7.0.4.CC mode change 100755 => 100644 Tests/Conformance/C8.7.0.5.CC mode change 100755 => 100644 Tests/Conformance/C8.7.0.6.CC mode change 100755 => 100644 Tests/Conformance/C8.8.0.1.CC mode change 100755 => 100644 Tests/Conformance/C9.2.0.1.CC mode change 100755 => 100644 Tests/Conformance/C9.3.0.1.CC mode change 100755 => 100644 Tests/Conformance/C9.5.0.1.CC mode change 100755 => 100644 Tests/Conformance/C9.5.0.2.CC mode change 100755 => 100644 Tests/Conformance/C9.7.0.1.CC mode change 100755 => 100644 Tests/Conformance/TEST mode change 100755 => 100644 Tests/Conformance/TEST2 mode change 100755 => 100644 Tests/Conformance/c14.4.0.1.cc mode change 100755 => 100644 Tests/Conformance/c19.5.0.1.cc mode change 100755 => 100644 Tests/Conformance/c24.0.3.cc mode change 100755 => 100644 Tests/Conformance/c26.0.1.cc mode change 100755 => 100644 Tests/Conformance/c6.2.3.5.cc mode change 100755 => 100644 Tests/Conformance/doit mode change 100755 => 100644 Tests/Conformance/doit2 mode change 100755 => 100644 Tests/Deviance/D2.1.0.1.CC mode change 100755 => 100644 Tests/Deviance/D2.2.0.2.CC mode change 100755 => 100644 Tests/Deviance/D2.4.0.1.CC mode change 100755 => 100644 Tests/Deviance/D2.5.0.1.CC mode change 100755 => 100644 Tests/Deviance/D2.5.0.2.CC mode change 100755 => 100644 Tests/Deviance/D2.7.1.1.CC mode change 100755 => 100644 Tests/Deviance/D2.7.1.2.CC mode change 100755 => 100644 Tests/Deviance/D2.7.2.1.CC mode change 100755 => 100644 Tests/Deviance/D2.7.3.1.CC mode change 100755 => 100644 Tests/Deviance/D2.7.3.2.CC mode change 100755 => 100644 Tests/Deviance/D2.7.3.3.CC mode change 100755 => 100644 Tests/Deviance/D2.7.4.1.CC mode change 100755 => 100644 Tests/Deviance/D2.7.4.4.CC mode change 100755 => 100644 Tests/Deviance/D25.0.1.CC mode change 100755 => 100644 Tests/Deviance/D25.0.2.CC mode change 100755 => 100644 Tests/Deviance/D3.3.1.1.CC mode change 100755 => 100644 Tests/Deviance/D3.3.10.1.CC mode change 100755 => 100644 Tests/Deviance/D3.3.2.1.CC mode change 100755 => 100644 Tests/Deviance/D3.3.3.1.CC mode change 100755 => 100644 Tests/Deviance/D3.3.4.1.CC mode change 100755 => 100644 Tests/Deviance/D3.3.5.1.CC mode change 100755 => 100644 Tests/Deviance/D3.4.0.1.CC mode change 100755 => 100644 Tests/Deviance/D3.5.1.1.CC mode change 100755 => 100644 Tests/Deviance/D3.5.2.1.CC mode change 100755 => 100644 Tests/Deviance/D3.5.3.1.CC mode change 100755 => 100644 Tests/Deviance/D3.5.5.1.CC mode change 100755 => 100644 Tests/Deviance/D3401.DATA mode change 100755 => 100644 Tests/Deviance/D4.2.1.1.CC mode change 100755 => 100644 Tests/Deviance/D4.2.2.1.CC mode change 100755 => 100644 Tests/Deviance/D4.2.3.1.CC mode change 100755 => 100644 Tests/Deviance/D4.2.5.1.CC mode change 100755 => 100644 Tests/Deviance/D4.2.9.1.CC mode change 100755 => 100644 Tests/Deviance/D4.3.0.1.CC mode change 100755 => 100644 Tests/Deviance/D4.4.1.1.CC mode change 100755 => 100644 Tests/Deviance/D4.5.3.1.CC mode change 100755 => 100644 Tests/Deviance/D4.6.0.1.CC mode change 100755 => 100644 Tests/Deviance/D4.6.0.2.CC mode change 100755 => 100644 Tests/Deviance/D4.6.1.1.CC mode change 100755 => 100644 Tests/Deviance/D4.6.2.1.CC mode change 100755 => 100644 Tests/Deviance/D4.6.3.1.CC mode change 100755 => 100644 Tests/Deviance/D4.6.4.1.CC mode change 100755 => 100644 Tests/Deviance/D4.6.5.1.CC mode change 100755 => 100644 Tests/Deviance/D4.6.6.1.CC mode change 100755 => 100644 Tests/Deviance/D4.6.7.1.CC mode change 100755 => 100644 Tests/Deviance/D4.6.8.1.CC mode change 100755 => 100644 Tests/Deviance/D7.1.1.1.CC mode change 100755 => 100644 Tests/Deviance/D7.5.4.1.CC mode change 100755 => 100644 Tests/Deviance/D7.6.1.1.CC mode change 100755 => 100644 Tests/Deviance/D7.6.1.2.CC mode change 100755 => 100644 Tests/Deviance/D7.6.1.3.CC mode change 100755 => 100644 Tests/Deviance/D7.6.1.4.CC mode change 100755 => 100644 Tests/Deviance/D7.6.3.1.CC mode change 100755 => 100644 Tests/Deviance/D7.6.4.1.CC mode change 100755 => 100644 Tests/Deviance/D7.6.6.1.CC mode change 100755 => 100644 Tests/Deviance/D7.6.7.1.CC mode change 100755 => 100644 Tests/Deviance/D7.6.8.1.CC mode change 100755 => 100644 Tests/Deviance/D8.7.0.1.CC mode change 100755 => 100644 Tests/Deviance/D8.8.0.1.CC mode change 100755 => 100644 Tests/Deviance/D9.2.0.1.CC mode change 100755 => 100644 Tests/Deviance/DOIT mode change 100755 => 100644 Tests/Deviance/RUN.DEVIANCE mode change 100755 => 100644 Tests/Deviance/TEST mode change 100755 => 100644 Tests/Deviance/TEST2 mode change 100755 => 100644 Tests/Spec.Conform/CFILE1 mode change 100755 => 100644 Tests/Spec.Conform/LIBFILE2 mode change 100755 => 100644 Tests/Spec.Conform/SPC13.2.0.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC13.4.0.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC17.16.0.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC17.2.0.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC17.2.0.2.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC17.2.0.3.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC17.3.0.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC17.3.0.2.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC17.3.0.3.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC17.3.0.4.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC17.3.0.5.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC17.6.0.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC17.7.0.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC2.1.0.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC20.2.0.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC21.1.0.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC21.2.0.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC22.1.0.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC22.101.EXEC mode change 100755 => 100644 Tests/Spec.Conform/SPC23.2.0.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC23.201.EXEC mode change 100755 => 100644 Tests/Spec.Conform/SPC25.0.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC25.0.2.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC25.1.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC25.1.EXEC mode change 100755 => 100644 Tests/Spec.Conform/SPC25.1.H mode change 100755 => 100644 Tests/Spec.Conform/SPC25.2.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC25.2.EXEC mode change 100755 => 100644 Tests/Spec.Conform/SPC3.3.4.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC3.4.0.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC3.4.0.2.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC3.6.0.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC3.6.0.2.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC3.6.0.3.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC3401.EXEC mode change 100755 => 100644 Tests/Spec.Conform/SPC34021 mode change 100755 => 100644 Tests/Spec.Conform/SPC34022 mode change 100755 => 100644 Tests/Spec.Conform/SPC34023 mode change 100755 => 100644 Tests/Spec.Conform/SPC34024 mode change 100755 => 100644 Tests/Spec.Conform/SPC34025 mode change 100755 => 100644 Tests/Spec.Conform/SPC34026 mode change 100755 => 100644 Tests/Spec.Conform/SPC34027 mode change 100755 => 100644 Tests/Spec.Conform/SPC34028 mode change 100755 => 100644 Tests/Spec.Conform/SPC4.3.0.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4.3.1.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4.4.1.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4.5.2.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4.5.3.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4.5.3.2.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4.6.3.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4.6.3.2.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4.6.3.3.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4.6.3.4.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4.6.3.5.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4.6.3.6.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4301.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4301.2.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4301.EXEC mode change 100755 => 100644 Tests/Spec.Conform/SPC4301.H mode change 100755 => 100644 Tests/Spec.Conform/SPC4311.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4311.EXEC mode change 100755 => 100644 Tests/Spec.Conform/SPC4411.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4521.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4521.EXEC mode change 100755 => 100644 Tests/Spec.Conform/SPC4521.H mode change 100755 => 100644 Tests/Spec.Conform/SPC4531.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4531.EXEC mode change 100755 => 100644 Tests/Spec.Conform/SPC4531.H mode change 100755 => 100644 Tests/Spec.Conform/SPC4532.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4532.EXEC mode change 100755 => 100644 Tests/Spec.Conform/SPC4532.H mode change 100755 => 100644 Tests/Spec.Conform/SPC4631.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4631.EXEC mode change 100755 => 100644 Tests/Spec.Conform/SPC4632.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4632.EXEC mode change 100755 => 100644 Tests/Spec.Conform/SPC4633.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4633.EXEC mode change 100755 => 100644 Tests/Spec.Conform/SPC4634.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4634.EXEC mode change 100755 => 100644 Tests/Spec.Conform/SPC4636.1.CC mode change 100755 => 100644 Tests/Spec.Conform/SPC4636.EXEC mode change 100755 => 100644 Tests/Spec.Conform/UFILE1 mode change 100755 => 100644 Tests/Spec.Conform/USERFILE2 mode change 100755 => 100644 Tests/Spec.Conform/spc21.3.0.1.cc mode change 100755 => 100644 Tests/Spec.Conform/spc21.3.0.2.cc mode change 100755 => 100644 Tests/Spec.Conform/spc21.3.0.3.cc mode change 100755 => 100644 Tests/Spec.Conform/spc4411.exec mode change 100755 => 100644 Tests/Spec.Deviance/DOIT mode change 100755 => 100644 Tests/Spec.Deviance/SPD17.2.0.1.CC mode change 100755 => 100644 Tests/Spec.Deviance/SPD17.2.0.2.CC mode change 100755 => 100644 Tests/Spec.Deviance/SPD17.2.0.3.CC mode change 100755 => 100644 Tests/Spec.Deviance/SPD17.2.0.4.CC mode change 100755 => 100644 Tests/Spec.Deviance/SPD17.2.0.5.CC mode change 100755 => 100644 Tests/Spec.Deviance/SPD17.2.0.7.CC mode change 100755 => 100644 Tests/Spec.Deviance/SPD17.3.0.1.CC mode change 100755 => 100644 Tests/Spec.Deviance/SPD17.3.0.2.CC mode change 100755 => 100644 Tests/Spec.Deviance/SPD17.3.0.3.CC mode change 100755 => 100644 Tests/Spec.Deviance/SPD17.5.0.1.CC mode change 100755 => 100644 Tests/Spec.Deviance/SPD17.5.0.2.CC mode change 100755 => 100644 Tests/Spec.Deviance/SPD17.6.0.1.CC mode change 100755 => 100644 Tests/Spec.Deviance/SPD17.6.0.2.CC mode change 100755 => 100644 Tests/Spec.Deviance/SPD17.6.0.3.CC mode change 100755 => 100644 Tests/Spec.Deviance/SPD17.7.0.1.CC mode change 100755 => 100644 Tests/Spec.Deviance/TEST mode change 100755 => 100644 backup mode change 100755 => 100644 bin/Libraries/ORCACDefs/stdio.h mode change 100755 => 100644 bin/OSSource/ORCALib/equates.asm mode change 100755 => 100644 bin/OSSource/ORCALib/stdio.asm mode change 100755 => 100644 bin/cc.notes mode change 100755 => 100644 cc.notes mode change 100755 => 100644 count mode change 100755 => 100644 linkit mode change 100755 => 100644 linkit2 mode change 100755 => 100644 make mode change 100755 => 100644 make2 mode change 100755 => 100644 smake diff --git a/Asm.pas b/Asm.pas old mode 100755 new mode 100644 index c714070..abdbfdc --- a/Asm.pas +++ b/Asm.pas @@ -1 +1,667 @@ -{$optimize 7} {---------------------------------------------------------------} { } { Asm } { } { This unit implements the built-in assembler and } { disassembler. } { } { External Subroutines: } { } { AsmFunction - assemble an assembly language function } { AsmStatement - assemble some in-line code } { InitAsm - initialize the assembler } { } {---------------------------------------------------------------} unit Asm; interface {$LibPrefix '0/obj/'} uses CCommon, Table, CGI, Scanner, Symbol, MM, Expression; {$segment 'cc'} procedure AsmFunction (variable: identPtr); { Assemble an assembly language function } { } { parameters: } { variable - pointer to the function variable } procedure AsmStatement; { Assemble some in-line code } procedure InitAsm; { Initialize the assembler } {---------------------------------------------------------------} implementation {---------------------------------------------------------------} var doingAsmFunction: boolean; {was AsmStatement called from AsmFunction?} {- Imported from the parser: -----------------------------------} procedure Match (kind: tokenEnum; err: integer); extern; { insure that the next token is of the specified type } { } { parameters: } { kind - expected token kind } { err - error number if the expected token is not found } {- Private routines --------------------------------------------} function FindLabel (name: stringPtr; definition: boolean): integer; { Find a label in the label list. If none exists, create one. } { } { parameters: } { name - name of the label } { definition - is this the defining point? } label 1; var lb: gotoPtr; {work pointer} lnum: integer; {label number} begin {FindLabel} lb := gotoList; {try to find an existing label} while lb <> nil do begin if lb^.name^ = name^ then begin lnum := lb^.lab; goto 1; end; lb := lb^.next; end; {while} lb := pointer(Malloc(sizeof(gotoRecord))); {no label record exists: create one} lb^.next := gotoList; gotoList := lb; lb^.name := name; lnum := GenLabel; lb^.lab := lnum; lb^.defined := false; 1: if definition then begin if lb^.defined then Error(77) else begin lb^.defined := true; Gen1(dc_lab, lb^.lab); end; {else} end; {if} FindLabel := lnum; end; {FindLabel} {- Global routines ---------------------------------------------} procedure AsmFunction {variable: identPtr}; { Assemble an assembly language function } { } { parameters: } { variable - pointer to the function variable } var tl: tempPtr; {work pointer} begin {AsmFunction} {process the statements} doingAsmFunction := true; AsmStatement; doingAsmFunction := false; {finish the subroutine} Gen0 (dc_enp); {finish the segment} CheckGotoList; {make sure all labels are declared} while tempList <> nil do begin {dump the local labels} tl := tempList; tempList := tl^.next; dispose(tl); end; {while} LInit; {dispose of the local memory pool} nameFound := false; {no pc_nam for the next function (yet)} doingFunction := false; {no longer doing a function} end; {AsmFunction} procedure AsmStatement; { Assemble some in-line code } label 1,2,3,99; var i: integer; {loop variable} lnum: integer; {label number} name: packed array[0..3] of char; {op code name} opc: opcode; {operation code enumeration} opname: tokenType; {operation code token} optype: operands; {operand type} {set by Exp} {----------} isConstant: boolean; {constant? (or identifier expression} operand: tokenType; {operand (if not isConstant)} operation: (plus,minus,none); {kind of operation} size: (directPage,absoluteaddress,longAddress); {size of the operand} value: longint; {expression value} procedure Skip; { An error was found: skip to the end & quit } begin {Skip} charKinds[ord('#')] := ch_pound; while not (token.kind in [rbracech,eofsy]) do NextToken; charKinds[ord('#')] := illegal; goto 99; end; {Skip} procedure Exp (stop: tokenSet; EOLallowed: boolean); { Parse an expression in an operand } { } { Parameters: } { stop - stop symbols } { EOLallowed - can the expression end with EOL? } { } { Outputs: } { isConstant - constant? (or identifier expression) } { operand - operand (if not isConstant) } { operation - kind of operation } { size - size of the operand } { value - expression value } var forced: boolean; {is the expression type forced?} i: 0..maxint; {loop/index variable} id: identPtr; {identifier} tcode: intermediate_code; {temp storage for code} begin {Exp} if token.kind in [ltch,barch,gtch] {allow for operand size forcing} then begin forced := true; if token.kind = ltch then size := directPage else if token.kind = barch then size := absoluteaddress else {if token.kind = gtch then} size := longAddress; NextToken; end {if} else forced := false; if EOLallowed then begin {handle expressions that can end at eol} reportEOL := true; stop := stop+[eolsy]; end; {if} if token.kind = ident then begin {handle expressions with an identifier} if not forced then size := absoluteaddress; isConstant := false; operand := token; id := FindSymbol(token, variableSpace, false, true); if id = nil then begin code^.llab := FindLabel(token.name, false); if (not forced) and (not smallMemoryModel) then size := longAddress; end {if} else begin operand.symbolPtr := id; if id^.storage in [stackFrame,parameter] then begin code^.slab := id^.lln; if not forced then size := directPage; end {if} else begin code^.lab := id^.name; if id^.itype^.kind = functionType then begin if id^.itype^.isPascal then begin code^.lab := pointer(Malloc(length(id^.name^)+1)); CopyString(pointer(code^.lab), pointer(id^.name)); for i := 1 to length(code^.lab^) do if code^.lab^[i] in ['a'..'z'] then code^.lab^[i] := chr(ord(code^.lab^[i]) & $5F); end; {if} end; {if} if (not forced) and (not smallMemoryModel) then size := longAddress; end; {else} end; {else} NextToken; if token.kind in [plusch,minusch] then begin if token.kind = plusch then operation := plus else operation := minus; NextToken; tcode := code^; Expression(arrayExpression, stop); code^ := tcode; value := expressionValue; if expressionType^.kind = scalarType then if expressionType^.baseType <= cgUWord then value := value & $0000FFFF; end {if} else begin operation := none; value := 0; end; {else} end {if token = ident} else begin {constant expression} operation := none; isConstant := true; tcode := code^; Expression(arrayExpression, stop); code^ := tcode; value := expressionValue; if expressionType^.kind = scalarType then if expressionType^.baseType <= cgUWord then value := value & $0000FFFF; if not forced then if long(value).msw = 0 then begin if long(value).lsw & $FF00 = 0 then size := directPage else size := absoluteaddress; end {if} else size := longAddress; end; {else} reportEOL := false; if token.kind = eolsy then NextToken; end; {Exp} function RegCompare (str: stringPtr; reg: char): boolean; { Compare a string to a register constant } { } { parameters: } { str - string pointer } { reg - register character } begin {RegCompare} RegCompare := false; if length(str^) = 1 then RegCompare := chr(ord(str^[1]) | $20) = reg; end; {RegCompare} procedure CheckForComment; { Handle an assembly language comment (ignore chars from ; to EOL) } begin {CheckForComment} while token.kind = semicolonch do begin while not (charKinds[ord(ch)] in [ch_eol,ch_eof]) do NextCh; NextCh; NextToken; end; {if} end; {CheckForComment} begin {AsmStatement} Match(lbracech,27); while not (token.kind in [rbracech,eofsy]) do begin {find the label and op-code} CheckForComment; charKinds[ord('#')] := ch_pound; {allow # as a token} if token.kind <> ident then begin {error if not an identifier} Error(9); Skip; end; {if} opname := token; NextToken; while token.kind = colonch do begin {define a label} lnum := FindLabel(opname.name, true); NextToken; CheckForComment; if token.kind <> ident then Skip; opname := token; NextToken; end; {while} charKinds[ord('#')] := illegal; {don't allow # as a token} {identify the op-code} if length(opname.name^) = 3 then begin name := opname.name^; for i := 1 to 3 do if name[i] in ['A'..'Z'] then name[i] := chr(ord(name[i]) | $20); for opc := o_adc to o_xce do if names[opc] = name then goto 1; end; {if} Error(95); Skip; 1: code^.q := 0; {default to no flags} {handle general operand instructions} if opc <= o_tsb then begin optype := op; if token.kind = lparench then begin NextToken; Exp([commach,rparench], false); if token.kind = commach then begin NextToken; if token.kind = ident then begin if RegCompare(token.name, 'x') then begin NextToken; Match(rparench,12); if size = directPage then optype := i_dp_x else if size = absoluteaddress then optype := i_op_x else Error(96); end {if} else if RegCompare(token.name, 's') then begin NextToken; Match(rparench,12); Match(commach,86); if token.kind = ident then begin if RegCompare(token.name, 'y') then NextToken else Error(97); end {if} else Error(97); if size = directPage then optype := i_dp_s_y else Error(96); end {else if} else Error(97); end {if token.kind = ident} else Error(97); end {if token.kind = commach} else if token.kind = rparench then begin NextToken; if token.kind = commach then begin NextToken; if token.kind = ident then begin if RegCompare(token.name, 'y') then NextToken else Error(97); end {if} else Error(97); if size = directPage then optype := i_dp_y else Error(96); end {if} else begin if size = directPage then optype := i_dp else if size = absoluteaddress then optype := i_op else Error(96); end; {else} end {else if token.kind = rparench} else Error(12); end {if} else if token.kind = lbrackch then begin NextToken; Exp([commach,rbrackch], false); Match(rbrackch,24); if token.kind = commach then begin NextToken; if token.kind = ident then begin if RegCompare(token.name, 'y') then NextToken else Error(97); end {if} else Error(97); if size = directPage then optype := li_dp_y else Error(96); end {if} else begin if size = directPage then optype := li_dp else if size = absoluteaddress then optype := i_la else Error(96); end; {else} end {else if} else if token.kind = poundch then begin optype := imm; NextToken; if token.kind = ltch then begin NextToken; Exp([semicolonch], true); end {if} else if token.kind = gtch then begin NextToken; Exp([semicolonch], true); if isConstant then value := value >> 8 else code^.q := shift8; end {else if} else if token.kind = carotch then begin NextToken; Exp([semicolonch], true); if isConstant then value := value >> 16 else code^.q := shift16; end {else if} else Exp([semicolonch], true); end {else if} else begin if token.kind = ident then if RegCompare(token.name, 'a') then begin optype := acc; NextToken; goto 2; end; {if} Exp([commach,semicolonch], true); if token.kind = commach then begin NextToken; if token.kind = ident then begin if RegCompare(token.name, 'x') then begin NextToken; if size = directPage then optype := dp_x else if size = absoluteaddress then optype := op_x else optype := long_x; end {if} else if RegCompare(token.name, 'y') then begin NextToken; if size = directPage then optype := dp_y else if size = absoluteaddress then optype := op_y else Error(96); end {else if} else if RegCompare(token.name, 's') then begin NextToken; if size = directPage then optype := dp_s else Error(96); end {else if} else Error(97); end {if token.kind = ident} else Error(97); end {if} else begin if size = directPage then optype := dp else if size = absoluteaddress then optype := op else optype := la; end; {else} end; {else} 2: {make sure the operand is valid} if nopcodes[opc,optype] = 0 then begin if optype = i_dp_x then optype := i_op_x else if optype = i_dp then optype := i_op else if optype = dp then optype := op else if optype = dp_x then optype := op_x else if optype = dp_y then optype := op_y; if nopcodes[opc,optype] = 0 then if optype = op then optype := la; if nopcodes[opc,optype] = 0 then Error(98); end; {if} code^.s := nopcodes[opc,optype]; if optype = acc then code^.r := ord(implied) else if optype = imm then code^.r := ord(imm) else if optype in [la,long_x] then code^.r := ord(longabsolute) else if optype in [op,op_x,op_y,i_op,i_op_x,i_la] then code^.r := ord(absolute) else code^.r := ord(direct); end {if opc <= o_tsb} {handle data declarations} else if opc <= o_dcl then begin Exp([semicolonch], true); code^.s := d_add; if opc = o_dcb then code^.r := ord(direct) else if opc = o_dcw then code^.r := ord(absolute) else code^.r := ord(longabsolute); end {if opc <= o_dcl} {handle the brk instruction} else if opc = o_brk then begin Exp([semicolonch], true); code^.r := ord(direct); code^.s := 0; end {if opc = o_brk} {handle moves} else if opc in [o_mvn,o_mvp] then begin if opc = o_mvn then code^.s := $54 else code^.s := $44; Gen0(pc_nat); code^.s := d_bmov; code^.r := ord(immediate); Exp([commach,semicolonch], false); if isConstant then begin code^.opnd := long(value).msw; code^.q := 0; end {if} else begin code^.opnd := value; code^.q := shift16; end; {else} Gen0(pc_nat); Match(commach,86); code^.s := d_bmov; code^.r := ord(immediate); Exp([semicolonch], true); if isConstant then begin code^.opnd := long(value).msw; code^.q := 0; end {if} else begin code^.opnd := value; code^.q := shift16; end; {else} goto 3; end {if opc in [o_mvn,o_mvp]} {handle relative branches} else if opc <= o_bvs then begin code^.s := ropcodes[opc]; if token.kind = ident then begin code^.llab := FindLabel(token.name, false); NextToken; code^.lab := nil; if opc in [o_brl,o_per] then code^.r := ord(longrelative) else code^.r := ord(relative); goto 3; end {if} else Error(97); end {else if opc <= o_bvs} {handle implied operand instructions} else begin code^.s := iopcodes[opc]; code^.r := ord(implied); end; {generate the code} if operation = minus then code^.opnd := -value else code^.opnd := value; 3: Gen0(pc_nat); CheckForComment; end; {while} 99: if doingAsmFunction then useGlobalPool := true; Match(rbracech,23); end; {AsmStatement} procedure InitAsm; { Initialize the assembler } begin {AsmInit} doingAsmFunction := false; end; {AsmInit} end. \ No newline at end of file +{$optimize 7} +{---------------------------------------------------------------} +{ } +{ Asm } +{ } +{ This unit implements the built-in assembler and } +{ disassembler. } +{ } +{ External Subroutines: } +{ } +{ AsmFunction - assemble an assembly language function } +{ AsmStatement - assemble some in-line code } +{ InitAsm - initialize the assembler } +{ } +{---------------------------------------------------------------} + +unit Asm; + +interface + +{$LibPrefix '0/obj/'} + +uses CCommon, Table, CGI, Scanner, Symbol, MM, Expression; + +{$segment 'cc'} + +procedure AsmFunction (variable: identPtr); + +{ Assemble an assembly language function } +{ } +{ parameters: } +{ variable - pointer to the function variable } + + +procedure AsmStatement; + +{ Assemble some in-line code } + + +procedure InitAsm; + +{ Initialize the assembler } + + +{---------------------------------------------------------------} + +implementation + +{---------------------------------------------------------------} + +var + doingAsmFunction: boolean; {was AsmStatement called from AsmFunction?} + +{- Imported from the parser: -----------------------------------} + +procedure Match (kind: tokenEnum; err: integer); extern; + +{ insure that the next token is of the specified type } +{ } +{ parameters: } +{ kind - expected token kind } +{ err - error number if the expected token is not found } + +{- Private routines --------------------------------------------} + +function FindLabel (name: stringPtr; definition: boolean): integer; + +{ Find a label in the label list. If none exists, create one. } +{ } +{ parameters: } +{ name - name of the label } +{ definition - is this the defining point? } + +label 1; + +var + lb: gotoPtr; {work pointer} + lnum: integer; {label number} + +begin {FindLabel} +lb := gotoList; {try to find an existing label} +while lb <> nil do begin + if lb^.name^ = name^ then begin + lnum := lb^.lab; + goto 1; + end; + lb := lb^.next; + end; {while} +lb := pointer(Malloc(sizeof(gotoRecord))); {no label record exists: create one} +lb^.next := gotoList; +gotoList := lb; +lb^.name := name; +lnum := GenLabel; +lb^.lab := lnum; +lb^.defined := false; +1: +if definition then begin + if lb^.defined then + Error(77) + else begin + lb^.defined := true; + Gen1(dc_lab, lb^.lab); + end; {else} + end; {if} +FindLabel := lnum; +end; {FindLabel} + +{- Global routines ---------------------------------------------} + +procedure AsmFunction {variable: identPtr}; + +{ Assemble an assembly language function } +{ } +{ parameters: } +{ variable - pointer to the function variable } + +var + tl: tempPtr; {work pointer} + +begin {AsmFunction} + +{process the statements} +doingAsmFunction := true; +AsmStatement; +doingAsmFunction := false; + +{finish the subroutine} +Gen0 (dc_enp); {finish the segment} +CheckGotoList; {make sure all labels are declared} +while tempList <> nil do begin {dump the local labels} + tl := tempList; + tempList := tl^.next; + dispose(tl); + end; {while} +LInit; {dispose of the local memory pool} +nameFound := false; {no pc_nam for the next function (yet)} +doingFunction := false; {no longer doing a function} +end; {AsmFunction} + + +procedure AsmStatement; + +{ Assemble some in-line code } + +label 1,2,3,99; + +var + i: integer; {loop variable} + lnum: integer; {label number} + name: packed array[0..3] of char; {op code name} + opc: opcode; {operation code enumeration} + opname: tokenType; {operation code token} + optype: operands; {operand type} + + {set by Exp} + {----------} + isConstant: boolean; {constant? (or identifier expression} + operand: tokenType; {operand (if not isConstant)} + operation: (plus,minus,none); {kind of operation} + size: (directPage,absoluteaddress,longAddress); {size of the operand} + value: longint; {expression value} + + + procedure Skip; + + { An error was found: skip to the end & quit } + + begin {Skip} + charKinds[ord('#')] := ch_pound; + while not (token.kind in [rbracech,eofsy]) do + NextToken; + charKinds[ord('#')] := illegal; + goto 99; + end; {Skip} + + + procedure Exp (stop: tokenSet; EOLallowed: boolean); + + { Parse an expression in an operand } + { } + { Parameters: } + { stop - stop symbols } + { EOLallowed - can the expression end with EOL? } + { } + { Outputs: } + { isConstant - constant? (or identifier expression) } + { operand - operand (if not isConstant) } + { operation - kind of operation } + { size - size of the operand } + { value - expression value } + + var + forced: boolean; {is the expression type forced?} + i: 0..maxint; {loop/index variable} + id: identPtr; {identifier} + tcode: intermediate_code; {temp storage for code} + + begin {Exp} + if token.kind in [ltch,barch,gtch] {allow for operand size forcing} + then begin + forced := true; + if token.kind = ltch then + size := directPage + else if token.kind = barch then + size := absoluteaddress + else {if token.kind = gtch then} + size := longAddress; + NextToken; + end {if} + else + forced := false; + + if EOLallowed then begin {handle expressions that can end at eol} + reportEOL := true; + stop := stop+[eolsy]; + end; {if} + if token.kind = ident then begin {handle expressions with an identifier} + if not forced then + size := absoluteaddress; + isConstant := false; + operand := token; + id := FindSymbol(token, variableSpace, false, true); + if id = nil then begin + code^.llab := FindLabel(token.name, false); + if (not forced) and (not smallMemoryModel) then + size := longAddress; + end {if} + else begin + operand.symbolPtr := id; + if id^.storage in [stackFrame,parameter] then begin + code^.slab := id^.lln; + if not forced then + size := directPage; + end {if} + else begin + code^.lab := id^.name; + if id^.itype^.kind = functionType then begin + if id^.itype^.isPascal then begin + code^.lab := pointer(Malloc(length(id^.name^)+1)); + CopyString(pointer(code^.lab), pointer(id^.name)); + for i := 1 to length(code^.lab^) do + if code^.lab^[i] in ['a'..'z'] then + code^.lab^[i] := chr(ord(code^.lab^[i]) & $5F); + end; {if} + end; {if} + if (not forced) and (not smallMemoryModel) then + size := longAddress; + end; {else} + end; {else} + NextToken; + if token.kind in [plusch,minusch] then begin + if token.kind = plusch then + operation := plus + else + operation := minus; + NextToken; + tcode := code^; + Expression(arrayExpression, stop); + code^ := tcode; + value := expressionValue; + if expressionType^.kind = scalarType then + if expressionType^.baseType <= cgUWord then + value := value & $0000FFFF; + end {if} + else begin + operation := none; + value := 0; + end; {else} + end {if token = ident} + else begin {constant expression} + operation := none; + isConstant := true; + tcode := code^; + Expression(arrayExpression, stop); + code^ := tcode; + value := expressionValue; + if expressionType^.kind = scalarType then + if expressionType^.baseType <= cgUWord then + value := value & $0000FFFF; + if not forced then + if long(value).msw = 0 then begin + if long(value).lsw & $FF00 = 0 then + size := directPage + else + size := absoluteaddress; + end {if} + else + size := longAddress; + end; {else} + + reportEOL := false; + if token.kind = eolsy then + NextToken; + end; {Exp} + + + function RegCompare (str: stringPtr; reg: char): boolean; + + { Compare a string to a register constant } + { } + { parameters: } + { str - string pointer } + { reg - register character } + + begin {RegCompare} + RegCompare := false; + if length(str^) = 1 then + RegCompare := chr(ord(str^[1]) | $20) = reg; + end; {RegCompare} + + + procedure CheckForComment; + + { Handle an assembly language comment (ignore chars from ; to EOL) } + + begin {CheckForComment} + while token.kind = semicolonch do begin + while not (charKinds[ord(ch)] in [ch_eol,ch_eof]) do + NextCh; + NextCh; + NextToken; + end; {if} + end; {CheckForComment} + + +begin {AsmStatement} +Match(lbracech,27); +while not (token.kind in [rbracech,eofsy]) do begin + + {find the label and op-code} + CheckForComment; + charKinds[ord('#')] := ch_pound; {allow # as a token} + if token.kind <> ident then begin {error if not an identifier} + Error(9); + Skip; + end; {if} + opname := token; + NextToken; + while token.kind = colonch do begin {define a label} + lnum := FindLabel(opname.name, true); + NextToken; + CheckForComment; + if token.kind <> ident then + Skip; + opname := token; + NextToken; + end; {while} + charKinds[ord('#')] := illegal; {don't allow # as a token} + + {identify the op-code} + if length(opname.name^) = 3 then begin + name := opname.name^; + for i := 1 to 3 do + if name[i] in ['A'..'Z'] then + name[i] := chr(ord(name[i]) | $20); + for opc := o_adc to o_xce do + if names[opc] = name then + goto 1; + end; {if} + Error(95); + Skip; + +1: code^.q := 0; {default to no flags} + + {handle general operand instructions} + if opc <= o_tsb then begin + optype := op; + if token.kind = lparench then begin + NextToken; + Exp([commach,rparench], false); + if token.kind = commach then begin + NextToken; + if token.kind = ident then begin + if RegCompare(token.name, 'x') then begin + NextToken; + Match(rparench,12); + if size = directPage then + optype := i_dp_x + else if size = absoluteaddress then + optype := i_op_x + else + Error(96); + end {if} + else if RegCompare(token.name, 's') then begin + NextToken; + Match(rparench,12); + Match(commach,86); + if token.kind = ident then begin + if RegCompare(token.name, 'y') then + NextToken + else + Error(97); + end {if} + else + Error(97); + if size = directPage then + optype := i_dp_s_y + else Error(96); + end {else if} + else + Error(97); + end {if token.kind = ident} + else Error(97); + end {if token.kind = commach} + else if token.kind = rparench then begin + NextToken; + if token.kind = commach then begin + NextToken; + if token.kind = ident then begin + if RegCompare(token.name, 'y') then + NextToken + else + Error(97); + end {if} + else Error(97); + if size = directPage then + optype := i_dp_y + else Error(96); + end {if} + else begin + if size = directPage then + optype := i_dp + else if size = absoluteaddress then + optype := i_op + else + Error(96); + end; {else} + end {else if token.kind = rparench} + else Error(12); + end {if} + + else if token.kind = lbrackch then begin + NextToken; + Exp([commach,rbrackch], false); + Match(rbrackch,24); + if token.kind = commach then begin + NextToken; + if token.kind = ident then begin + if RegCompare(token.name, 'y') then + NextToken + else + Error(97); + end {if} + else Error(97); + if size = directPage then + optype := li_dp_y + else Error(96); + end {if} + else begin + if size = directPage then + optype := li_dp + else if size = absoluteaddress then + optype := i_la + else + Error(96); + end; {else} + end {else if} + + else if token.kind = poundch then begin + optype := imm; + NextToken; + if token.kind = ltch then begin + NextToken; + Exp([semicolonch], true); + end {if} + else if token.kind = gtch then begin + NextToken; + Exp([semicolonch], true); + if isConstant then + value := value >> 8 + else + code^.q := shift8; + end {else if} + else if token.kind = carotch then begin + NextToken; + Exp([semicolonch], true); + if isConstant then + value := value >> 16 + else + code^.q := shift16; + end {else if} + else + Exp([semicolonch], true); + end {else if} + + else begin + if token.kind = ident then + if RegCompare(token.name, 'a') then begin + optype := acc; + NextToken; + goto 2; + end; {if} + Exp([commach,semicolonch], true); + if token.kind = commach then begin + NextToken; + if token.kind = ident then begin + if RegCompare(token.name, 'x') then begin + NextToken; + if size = directPage then + optype := dp_x + else if size = absoluteaddress then + optype := op_x + else + optype := long_x; + end {if} + else if RegCompare(token.name, 'y') then begin + NextToken; + if size = directPage then + optype := dp_y + else if size = absoluteaddress then + optype := op_y + else + Error(96); + end {else if} + else if RegCompare(token.name, 's') then begin + NextToken; + if size = directPage then + optype := dp_s + else Error(96); + end {else if} + else Error(97); + end {if token.kind = ident} + else Error(97); + end {if} + else begin + if size = directPage then + optype := dp + else if size = absoluteaddress then + optype := op + else + optype := la; + end; {else} + end; {else} + +2: {make sure the operand is valid} + if nopcodes[opc,optype] = 0 then begin + if optype = i_dp_x then + optype := i_op_x + else if optype = i_dp then + optype := i_op + else if optype = dp then + optype := op + else if optype = dp_x then + optype := op_x + else if optype = dp_y then + optype := op_y; + if nopcodes[opc,optype] = 0 then + if optype = op then + optype := la; + if nopcodes[opc,optype] = 0 then + Error(98); + end; {if} + + code^.s := nopcodes[opc,optype]; + + if optype = acc then + code^.r := ord(implied) + else if optype = imm then + code^.r := ord(imm) + else if optype in [la,long_x] then + code^.r := ord(longabsolute) + else if optype in [op,op_x,op_y,i_op,i_op_x,i_la] then + code^.r := ord(absolute) + else + code^.r := ord(direct); + end {if opc <= o_tsb} + + {handle data declarations} + else if opc <= o_dcl then begin + Exp([semicolonch], true); + code^.s := d_add; + if opc = o_dcb then + code^.r := ord(direct) + else if opc = o_dcw then + code^.r := ord(absolute) + else + code^.r := ord(longabsolute); + end {if opc <= o_dcl} + + {handle the brk instruction} + else if opc = o_brk then begin + Exp([semicolonch], true); + code^.r := ord(direct); + code^.s := 0; + end {if opc = o_brk} + + {handle moves} + else if opc in [o_mvn,o_mvp] then begin + if opc = o_mvn then + code^.s := $54 + else + code^.s := $44; + Gen0(pc_nat); + code^.s := d_bmov; + code^.r := ord(immediate); + Exp([commach,semicolonch], false); + if isConstant then begin + code^.opnd := long(value).msw; + code^.q := 0; + end {if} + else begin + code^.opnd := value; + code^.q := shift16; + end; {else} + Gen0(pc_nat); + Match(commach,86); + code^.s := d_bmov; + code^.r := ord(immediate); + Exp([semicolonch], true); + if isConstant then begin + code^.opnd := long(value).msw; + code^.q := 0; + end {if} + else begin + code^.opnd := value; + code^.q := shift16; + end; {else} + goto 3; + end {if opc in [o_mvn,o_mvp]} + + {handle relative branches} + else if opc <= o_bvs then begin + code^.s := ropcodes[opc]; + if token.kind = ident then begin + code^.llab := FindLabel(token.name, false); + NextToken; + code^.lab := nil; + if opc in [o_brl,o_per] then + code^.r := ord(longrelative) + else + code^.r := ord(relative); + goto 3; + end {if} + else Error(97); + end {else if opc <= o_bvs} + + {handle implied operand instructions} + else begin + code^.s := iopcodes[opc]; + code^.r := ord(implied); + end; + + {generate the code} + if operation = minus then + code^.opnd := -value + else + code^.opnd := value; +3: Gen0(pc_nat); + + CheckForComment; + end; {while} +99: +if doingAsmFunction then + useGlobalPool := true; +Match(rbracech,23); +end; {AsmStatement} + + +procedure InitAsm; + +{ Initialize the assembler } + +begin {AsmInit} +doingAsmFunction := false; +end; {AsmInit} + +end. diff --git a/CC.pas b/CC.pas old mode 100755 new mode 100644 index 6030074..a0fab8d --- a/CC.pas +++ b/CC.pas @@ -1 +1,179 @@ -{$optimize 7} {---------------------------------------------------------------} { } { ORCA/C } { } { A C compiler for the Apple IIGS. } { } { Copyright 1989,1990 } { Byte Works, Inc. } { } { Mike Westerfield } { } {---------------------------------------------------------------} {$stacksize $1800} program cc(output); {$LibPrefix '0/obj/'} uses CCommon, CGI, Scanner, Header, Symbol, MM, Expression, Parser, Asm; {$segment 'cc'} var i: 1..maxPath; {loop/index variable} vDCBGS: versionDCBGS; {for checking the version number} procedure DisposeAll (userID: integer); tool($02, $11); procedure SystemQuitFlags (flags: integer); extern; begin {cc} {make sure we quit with restart set} SystemQuitFlags($4000); {get the command line info} includeFileGS.maxSize := maxPath+4; includeFileGS.theString.size := 0; for i := 1 to maxPath do includeFileGS.theString.theString[i] := chr(0); outFileGS := includeFileGS; partialFileGS := includeFileGS; infoStringGS := includeFileGS; with liDCBGS do begin pCount := 11; sFile := @includeFileGS; dFile := @outFileGS; namesList := @partialFileGS; iString := @infoStringGS; end; {with} GetLInfoGS(liDCBGS); sourceFileGS := includeFileGS; doingPartial := partialFileGS.theString.size <> 0; with liDCBGS do begin enterEditor := pFlags & flag_e <> 0; {enter editor on terminal errors?} ignoreSymbols := mFlags & flag_i <> 0; {ignore symbol file?} list := pFlags & flag_l <> 0; {list the source file?} memoryCompile := pflags & flag_m <> 0; {memory based compile?} progress := mflags & flag_p = 0; {write progress info?} rebuildSymbols := mflags & flag_r <> 0; {rebuild symbol file?} printSymbols := pflags & flag_s <> 0; {print the symbol table?} terminalErrors := pFlags & flag_t <> 0; {all errors terminal?} wait := pFlags & flag_w <> 0; {wait when an error is found?} cLineOptimize := pFlags & flag_o <> 0; {turn optimizations on?} end; {liDCB} if list then {we don't need both...} progress := false; {check the version number} vDCBGS.pCount := 1; VersionGS(vDCBGS); if vDCBGS.version[1] < '2' then TermError(10); {write the header} if list or progress then begin writeln('ORCA/C ', versionStr); writeln; end; {if} {read the source file} ReadFile; languageNumber := long(ffDCBGS.auxType).lsw; {set the default language number} {initialize the various modules} LInit; {initialize the memory pools} GInit; useGlobalPool := true; InitCCommon; {initialize the common module} {initialize the scanner} InitScanner(bofPtr,pointer(ord4(bofPtr)+ffDCBGS.fileLength)); InitParser; {initialize the parser} InitExpression; {initialize the expression evaluator} InitSymbol; {initialize the symbol table handler} InitAsm; {initialize the assembler} CodeGenScalarInit; {initialize the code generator} with liDCBGS do {generate debug code?} if pFlags & flag_d <> 0 then begin debugFlag := true; profileFlag := true; end; {if} {compile the program} InitHeader(includeFileGS); {read any precompiled headers} NextToken; {get the first token in the program} while token.kind <> eofsy do begin {compile the program} if doingFunction then DoStatement else if (token.kind in [autosy,externsy,registersy,staticsy,typedefsy, unsignedsy,signedsy,intsy,longsy,charsy,shortsy, floatsy,doublesy,compsy,extendedsy,enumsy, structsy,unionsy,typedef,voidsy,volatilesy, constsy,ident,asmsy,pascalsy,asmsy,segmentsy]) then DoDeclaration(false) else begin Error(26); NextToken; end; {else} end; {while} if doingFunction then {check for unclosed function} Error(23); {init the code generator (if it needs it)} if not codegenStarted and (liDCBGS.kFlag <> 0) then begin CodeGenInit (@outFileGS, liDCBGS.kFlag, doingPartial); liDCBGS.kFlag := 3; codegenStarted := true; end; {if} DoGlobals; {create the ~GLOBALS and ~ARRAYS segments} {shut down the compiler} TermHeader; {make sure the compiled header file is closed} CheckStaticFunctions; {check for undefined functions} ffDCBGS.action := 7; {purge the source file} ffDCBGS.pcount := 14; ffDCBGS.pathName := @includeFileGS.theString; FastFileGS(ffDCBGS); if ToolError <> 0 then begin sourceFileGS := includeFileGS; TermError(2); end; {if} TermScanner; {shut down the scanner} StopSpin; if (numErrors <> 0) or list or progress then begin writeln; {write the number of errors} if numErrors = 1 then writeln('1 error found.') else writeln(numErrors:1, ' errors found.'); end; {if} if list or progress then {leave a blank line} writeln; if codegenStarted then {shut down the code generator} CodeGenFini; TermParser; {shut down the parser} if numErrors = 0 then begin {set up the return parameters} if not switchLanguages then begin if liDCBGS.kFlag = 0 then liDCBGS.lops := 0 else liDCBGS.lops := liDCBGS.lops & $FFFE; liDCBGS.sFile := @outFileGS; end; {if} end {if} else liDCBGS.lops := 0; MMQuit; {dispose of our memory pools} with liDCBGS do begin {return to the shell} sFile := pointer(ord4(sFile)+2); dFile := pointer(ord4(dFile)+2); namesList := pointer(ord4(namesList)+2); iString := pointer(ord4(iString)+2); end; {with} SetLInfoGS(liDCBGS); StopSpin; end. {cc} \ No newline at end of file +{$optimize 7} +{---------------------------------------------------------------} +{ } +{ ORCA/C } +{ } +{ A C compiler for the Apple IIGS. } +{ } +{ Copyright 1989,1990 } +{ Byte Works, Inc. } +{ } +{ Mike Westerfield } +{ } +{---------------------------------------------------------------} + +{$stacksize $1800} + +program cc(output); + +{$LibPrefix '0/obj/'} + +uses CCommon, CGI, Scanner, Header, Symbol, MM, Expression, Parser, Asm; + +{$segment 'cc'} + +var + i: 1..maxPath; {loop/index variable} + vDCBGS: versionDCBGS; {for checking the version number} + + +procedure DisposeAll (userID: integer); tool($02, $11); + +procedure SystemQuitFlags (flags: integer); extern; + + +begin {cc} +{make sure we quit with restart set} +SystemQuitFlags($4000); + +{get the command line info} +includeFileGS.maxSize := maxPath+4; +includeFileGS.theString.size := 0; +for i := 1 to maxPath do + includeFileGS.theString.theString[i] := chr(0); +outFileGS := includeFileGS; +partialFileGS := includeFileGS; +infoStringGS := includeFileGS; +with liDCBGS do begin + pCount := 11; + sFile := @includeFileGS; + dFile := @outFileGS; + namesList := @partialFileGS; + iString := @infoStringGS; + end; {with} +GetLInfoGS(liDCBGS); +sourceFileGS := includeFileGS; +doingPartial := partialFileGS.theString.size <> 0; +with liDCBGS do begin + enterEditor := pFlags & flag_e <> 0; {enter editor on terminal errors?} + ignoreSymbols := mFlags & flag_i <> 0; {ignore symbol file?} + list := pFlags & flag_l <> 0; {list the source file?} + memoryCompile := pflags & flag_m <> 0; {memory based compile?} + progress := mflags & flag_p = 0; {write progress info?} + rebuildSymbols := mflags & flag_r <> 0; {rebuild symbol file?} + printSymbols := pflags & flag_s <> 0; {print the symbol table?} + terminalErrors := pFlags & flag_t <> 0; {all errors terminal?} + wait := pFlags & flag_w <> 0; {wait when an error is found?} + cLineOptimize := pFlags & flag_o <> 0; {turn optimizations on?} + end; {liDCB} +if list then {we don't need both...} + progress := false; + +{check the version number} +vDCBGS.pCount := 1; +VersionGS(vDCBGS); +if vDCBGS.version[1] < '2' then + TermError(10); + +{write the header} +if list or progress then begin + writeln('ORCA/C ', versionStr); + writeln; + end; {if} + +{read the source file} +ReadFile; +languageNumber := long(ffDCBGS.auxType).lsw; {set the default language number} + +{initialize the various modules} +LInit; {initialize the memory pools} +GInit; +useGlobalPool := true; +InitCCommon; {initialize the common module} + {initialize the scanner} +InitScanner(bofPtr,pointer(ord4(bofPtr)+ffDCBGS.fileLength)); +InitParser; {initialize the parser} +InitExpression; {initialize the expression evaluator} +InitSymbol; {initialize the symbol table handler} +InitAsm; {initialize the assembler} +CodeGenScalarInit; {initialize the code generator} +with liDCBGS do {generate debug code?} + if pFlags & flag_d <> 0 then begin + debugFlag := true; + profileFlag := true; + end; {if} + +{compile the program} +InitHeader(includeFileGS); {read any precompiled headers} +NextToken; {get the first token in the program} +while token.kind <> eofsy do begin {compile the program} + if doingFunction then + DoStatement + else if (token.kind in [autosy,externsy,registersy,staticsy,typedefsy, + unsignedsy,signedsy,intsy,longsy,charsy,shortsy, + floatsy,doublesy,compsy,extendedsy,enumsy, + structsy,unionsy,typedef,voidsy,volatilesy, + constsy,ident,asmsy,pascalsy,asmsy,segmentsy]) + then + DoDeclaration(false) + else begin + Error(26); + NextToken; + end; {else} + end; {while} +if doingFunction then {check for unclosed function} + Error(23); +{init the code generator (if it needs it)} +if not codegenStarted and (liDCBGS.kFlag <> 0) then begin + CodeGenInit (@outFileGS, liDCBGS.kFlag, doingPartial); + liDCBGS.kFlag := 3; + codegenStarted := true; + end; {if} +DoGlobals; {create the ~GLOBALS and ~ARRAYS segments} + +{shut down the compiler} +TermHeader; {make sure the compiled header file is closed} +CheckStaticFunctions; {check for undefined functions} +ffDCBGS.action := 7; {purge the source file} +ffDCBGS.pcount := 14; +ffDCBGS.pathName := @includeFileGS.theString; +FastFileGS(ffDCBGS); +if ToolError <> 0 then begin + sourceFileGS := includeFileGS; + TermError(2); + end; {if} +TermScanner; {shut down the scanner} +StopSpin; +if (numErrors <> 0) or list or progress then begin + writeln; {write the number of errors} + if numErrors = 1 then + writeln('1 error found.') + else + writeln(numErrors:1, ' errors found.'); + end; {if} +if list or progress then {leave a blank line} + writeln; +if codegenStarted then {shut down the code generator} + CodeGenFini; +TermParser; {shut down the parser} +if numErrors = 0 then begin {set up the return parameters} + if not switchLanguages then begin + if liDCBGS.kFlag = 0 then + liDCBGS.lops := 0 + else + liDCBGS.lops := liDCBGS.lops & $FFFE; + liDCBGS.sFile := @outFileGS; + end; {if} + end {if} +else + liDCBGS.lops := 0; +MMQuit; {dispose of our memory pools} +with liDCBGS do begin {return to the shell} + sFile := pointer(ord4(sFile)+2); + dFile := pointer(ord4(dFile)+2); + namesList := pointer(ord4(namesList)+2); + iString := pointer(ord4(iString)+2); + end; {with} +SetLInfoGS(liDCBGS); +StopSpin; +end. {cc} diff --git a/CC.rez b/CC.rez old mode 100755 new mode 100644 index 89dc38c..2366cb3 --- a/CC.rez +++ b/CC.rez @@ -1 +1,14 @@ -#include "types.rez" resource rVersion(1) { { 2, /* Major revision */ 1, /* Minor revision */ 1, /* Bug version */ beta, /* Release stage */ 3, /* Non-final release # */ }, verUS, /* Region code */ "ORCA/C", /* Short version number */ "Copyright 1997, Byte Works, Inc." /* Long version number */ }; \ No newline at end of file +#include "types.rez" + +resource rVersion(1) { + { + 2, /* Major revision */ + 1, /* Minor revision */ + 1, /* Bug version */ + beta, /* Release stage */ + 3, /* Non-final release # */ + }, + verUS, /* Region code */ + "ORCA/C", /* Short version number */ + "Copyright 1997, Byte Works, Inc." /* Long version number */ + }; diff --git a/CC.rez2 b/CC.rez2 old mode 100755 new mode 100644 index 947b9bc..3ec67ed --- a/CC.rez2 +++ b/CC.rez2 @@ -1 +1,14 @@ -#include "types.rez" resource rVersion(1) { { 2, /* Major revision */ 0, /* Minor revision */ 3, /* Bug version */ release, /* Release stage */ 0, /* Non-final release # */ }, verUS, /* Region code */ "ORCA/C (small memory)", /* Short version number */ "Copyright 1994, Byte Works, Inc." /* Long version number */ }; \ No newline at end of file +#include "types.rez" + +resource rVersion(1) { + { + 2, /* Major revision */ + 0, /* Minor revision */ + 3, /* Bug version */ + release, /* Release stage */ + 0, /* Non-final release # */ + }, + verUS, /* Region code */ + "ORCA/C (small memory)", /* Short version number */ + "Copyright 1994, Byte Works, Inc." /* Long version number */ + }; diff --git a/CCommon.asm b/CCommon.asm old mode 100755 new mode 100644 index 8b311c6..39d495c --- a/CCommon.asm +++ b/CCommon.asm @@ -1 +1,80 @@ - mcopy ccommon.macros **************************************************************** * * CopyString - copy a string * * Inputs: * toPtr - location to copy to * fromPtr - location to copy from * **************************************************************** * CopyString start subroutine (4:toPtr,4:fromPtr),0 short I,M lda [fromPtr] sta [toPtr] tay lb1 lda [fromPtr],Y sta [toPtr],Y dey bne lb1 long I,M return end **************************************************************** * * Hash - find hash displacement * * Finds the displacement into an array of pointers using a * hash function. * * Inputs: * sPtr - points to string to find hash for * * Outputs: * Returns the disp into the hash table * **************************************************************** * Hash start hashSize equ 876 # hash buckets - 1 sum equ 0 hash length equ 2 length of string subroutine (4:sPtr),4 stz sum default to bucket 0 lda [sPtr] set the length of the string and #$00FF sta length ldy #1 start with char 1 lda [sPtr] if 1st char is '~', start with char 6 and #$FF00 cmp #'~'*256 bne lb1 ldy #6 lb1 lda [sPtr],Y get the value to add in and #$3F3F cpy length if there is only 1 char left then bne lb2 and #$00FF and out the high byte lb2 clc add it to the sum adc sum sta sum iny next char iny cpy length ble lb1 mod2 sum,#hashSize+1 return disp asl sum asl sum return 2:sum end \ No newline at end of file + mcopy ccommon.macros +**************************************************************** +* +* CopyString - copy a string +* +* Inputs: +* toPtr - location to copy to +* fromPtr - location to copy from +* +**************************************************************** +* +CopyString start + + subroutine (4:toPtr,4:fromPtr),0 + + short I,M + lda [fromPtr] + sta [toPtr] + tay +lb1 lda [fromPtr],Y + sta [toPtr],Y + dey + bne lb1 + long I,M + + return + end + +**************************************************************** +* +* Hash - find hash displacement +* +* Finds the displacement into an array of pointers using a +* hash function. +* +* Inputs: +* sPtr - points to string to find hash for +* +* Outputs: +* Returns the disp into the hash table +* +**************************************************************** +* +Hash start +hashSize equ 876 # hash buckets - 1 + +sum equ 0 hash +length equ 2 length of string + + subroutine (4:sPtr),4 + + stz sum default to bucket 0 + lda [sPtr] set the length of the string + and #$00FF + sta length + ldy #1 start with char 1 + lda [sPtr] if 1st char is '~', start with char 6 + and #$FF00 + cmp #'~'*256 + bne lb1 + ldy #6 + +lb1 lda [sPtr],Y get the value to add in + and #$3F3F + cpy length if there is only 1 char left then + bne lb2 + and #$00FF and out the high byte +lb2 clc add it to the sum + adc sum + sta sum + iny next char + iny + cpy length + ble lb1 + mod2 sum,#hashSize+1 return disp + asl sum + asl sum + + return 2:sum + end diff --git a/CCommon.macros b/CCommon.macros old mode 100755 new mode 100644 index 2b584a6..0880504 --- a/CCommon.macros +++ b/CCommon.macros @@ -1 +1,257 @@ - MACRO &lab subroutine &parms,&work &lab anop aif c:&work,.a lclc &work &work setc 0 .a gbla &totallen gbla &worklen &worklen seta &work &totallen seta 0 aif c:&parms=0,.e lclc &len lclc &p lcla &i &i seta c:&parms .b &p setc &parms(&i) &len amid &p,2,1 aif "&len"=":",.c &len amid &p,1,2 &p amid &p,4,l:&p-3 ago .d .c &len amid &p,1,1 &p amid &p,3,l:&p-2 .d &p equ &totallen+3+&work &totallen seta &totallen+&len &i seta &i-1 aif &i,^b .e tsc sec sbc #&work tcs inc a phd tcd mend MACRO &lab return &r &lab anop lclc &len aif c:&r,.a lclc &r &r setc 0 &len setc 0 ago .h .a &len amid &r,2,1 aif "&len"=":",.b &len amid &r,1,2 &r amid &r,4,l:&r-3 ago .c .b &len amid &r,1,1 &r amid &r,3,l:&r-2 .c aif &len<>2,.d ldy &r ago .h .d aif &len<>4,.e ldx &r+2 ldy &r ago .h .e aif &len<>10,.g aif &totallen=0,.f lda &worklen+1 sta &worklen+&totallen+1 lda &worklen sta &worklen+&totallen .f pld tsc clc adc #&worklen+&totallen tcs phb plx ply lda &r+8 pha lda &r+6 pha lda &r+4 pha lda &r+2 pha lda &r pha phy phx plb rtl mexit .g mnote 'Not a valid return length',16 mexit .h aif &totallen=0,.i lda &worklen+1 sta &worklen+&totallen+1 lda &worklen sta &worklen+&totallen .i pld tsc clc adc #&worklen+&totallen tcs aif &len=0,.j tya .j rtl mend MACRO &LAB MOD2 &N1,&N2,&N3 AIF C:&N3,.A LCLC &N3 &N3 SETC &N1 .A &LAB ~SETM LCLC &C &C AMID "&N2",1,1 AIF "{"="&C",.B AIF "["="&C",.B ~OP LDX,&N2 AGO .C .B ~LDA &N2 TAX .C ~LDA &N1 JSL ~MOD2 ~STA &N3 ~RESTM MEND MACRO &LAB ~SETM &LAB ANOP AIF C:&~LA,.B GBLB &~LA GBLB &~LI .B &~LA SETB S:LONGA &~LI SETB S:LONGI AIF S:LONGA.AND.S:LONGI,.A REP #32*(.NOT.&~LA)+16*(.NOT.&~LI) LONGA ON LONGI ON .A MEND MACRO &LAB ~RESTM &LAB ANOP AIF (&~LA+&~LI)=2,.I SEP #32*(.NOT.&~LA)+16*(.NOT.&~LI) AIF &~LA,.H LONGA OFF .H AIF &~LI,.I LONGI OFF .I MEND MACRO &LAB ~LDA &OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB LDA &OP MEND MACRO &LAB ~STA &OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB STA &OP MEND MACRO &LAB ~OP &OPC,&OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB &OPC &OP MEND MACRO &LAB BLE &BP &LAB BLT &BP BEQ &BP MEND MACRO &LAB LONG &A,&B LCLB &I LCLB &M &A AMID &A,1,1 &M SETB ("&A"="M").OR.("&A"="m") &I SETB ("&A"="I").OR.("&A"="i") AIF C:&B=0,.A &B AMID &B,1,1 &M SETB ("&B"="M").OR.("&B"="m").OR.&M &I SETB ("&B"="I").OR.("&B"="i").OR.&I .A &LAB REP #&M*32+&I*16 AIF .NOT.&M,.B LONGA ON .B AIF .NOT.&I,.C LONGI ON .C MEND MACRO &LAB SHORT &A,&B LCLB &I LCLB &M &A AMID &A,1,1 &M SETB ("&A"="M").OR.("&A"="m") &I SETB ("&A"="I").OR.("&A"="i") AIF C:&B=0,.A &B AMID &B,1,1 &M SETB ("&B"="M").OR.("&B"="m").OR.&M &I SETB ("&B"="I").OR.("&B"="i").OR.&I .A &LAB SEP #&M*32+&I*16 AIF .NOT.&M,.B LONGA OFF .B AIF .NOT.&I,.C LONGI OFF .C MEND \ No newline at end of file + MACRO +&lab subroutine &parms,&work +&lab anop + aif c:&work,.a + lclc &work +&work setc 0 +.a + gbla &totallen + gbla &worklen +&worklen seta &work +&totallen seta 0 + aif c:&parms=0,.e + lclc &len + lclc &p + lcla &i +&i seta c:&parms +.b +&p setc &parms(&i) +&len amid &p,2,1 + aif "&len"=":",.c +&len amid &p,1,2 +&p amid &p,4,l:&p-3 + ago .d +.c +&len amid &p,1,1 +&p amid &p,3,l:&p-2 +.d +&p equ &totallen+3+&work +&totallen seta &totallen+&len +&i seta &i-1 + aif &i,^b +.e + tsc + sec + sbc #&work + tcs + inc a + phd + tcd + mend + MACRO +&lab return &r +&lab anop + lclc &len + aif c:&r,.a + lclc &r +&r setc 0 +&len setc 0 + ago .h +.a +&len amid &r,2,1 + aif "&len"=":",.b +&len amid &r,1,2 +&r amid &r,4,l:&r-3 + ago .c +.b +&len amid &r,1,1 +&r amid &r,3,l:&r-2 +.c + aif &len<>2,.d + ldy &r + ago .h +.d + aif &len<>4,.e + ldx &r+2 + ldy &r + ago .h +.e + aif &len<>10,.g + aif &totallen=0,.f + lda &worklen+1 + sta &worklen+&totallen+1 + lda &worklen + sta &worklen+&totallen +.f + pld + tsc + clc + adc #&worklen+&totallen + tcs + phb + plx + ply + lda &r+8 + pha + lda &r+6 + pha + lda &r+4 + pha + lda &r+2 + pha + lda &r + pha + phy + phx + plb + rtl + mexit +.g + mnote 'Not a valid return length',16 + mexit +.h + aif &totallen=0,.i + lda &worklen+1 + sta &worklen+&totallen+1 + lda &worklen + sta &worklen+&totallen +.i + pld + tsc + clc + adc #&worklen+&totallen + tcs + aif &len=0,.j + tya +.j + rtl + mend + MACRO +&LAB MOD2 &N1,&N2,&N3 + AIF C:&N3,.A + LCLC &N3 +&N3 SETC &N1 +.A +&LAB ~SETM + LCLC &C +&C AMID "&N2",1,1 + AIF "{"="&C",.B + AIF "["="&C",.B + ~OP LDX,&N2 + AGO .C +.B + ~LDA &N2 + TAX +.C + ~LDA &N1 + JSL ~MOD2 + ~STA &N3 + ~RESTM + MEND + MACRO +&LAB ~SETM +&LAB ANOP + AIF C:&~LA,.B + GBLB &~LA + GBLB &~LI +.B +&~LA SETB S:LONGA +&~LI SETB S:LONGI + AIF S:LONGA.AND.S:LONGI,.A + REP #32*(.NOT.&~LA)+16*(.NOT.&~LI) + LONGA ON + LONGI ON +.A + MEND + MACRO +&LAB ~RESTM +&LAB ANOP + AIF (&~LA+&~LI)=2,.I + SEP #32*(.NOT.&~LA)+16*(.NOT.&~LI) + AIF &~LA,.H + LONGA OFF +.H + AIF &~LI,.I + LONGI OFF +.I + MEND + MACRO +&LAB ~LDA &OP + LCLC &C +&C AMID "&OP",1,1 + AIF "&C"<>"{",.B +&C AMID "&OP",L:&OP,1 + AIF "&C"="}",.A + MNOTE "Missing closing '}'",2 +&OP SETC &OP} +.A +&OP AMID "&OP",2,L:&OP-2 +&OP SETC (&OP) +.B +&LAB LDA &OP + MEND + MACRO +&LAB ~STA &OP + LCLC &C +&C AMID "&OP",1,1 + AIF "&C"<>"{",.B +&C AMID "&OP",L:&OP,1 + AIF "&C"="}",.A + MNOTE "Missing closing '}'",2 +&OP SETC &OP} +.A +&OP AMID "&OP",2,L:&OP-2 +&OP SETC (&OP) +.B +&LAB STA &OP + MEND + MACRO +&LAB ~OP &OPC,&OP + LCLC &C +&C AMID "&OP",1,1 + AIF "&C"<>"{",.B +&C AMID "&OP",L:&OP,1 + AIF "&C"="}",.A + MNOTE "Missing closing '}'",2 +&OP SETC &OP} +.A +&OP AMID "&OP",2,L:&OP-2 +&OP SETC (&OP) +.B +&LAB &OPC &OP + MEND + MACRO +&LAB BLE &BP +&LAB BLT &BP + BEQ &BP + MEND + MACRO +&LAB LONG &A,&B + LCLB &I + LCLB &M +&A AMID &A,1,1 +&M SETB ("&A"="M").OR.("&A"="m") +&I SETB ("&A"="I").OR.("&A"="i") + AIF C:&B=0,.A +&B AMID &B,1,1 +&M SETB ("&B"="M").OR.("&B"="m").OR.&M +&I SETB ("&B"="I").OR.("&B"="i").OR.&I +.A +&LAB REP #&M*32+&I*16 + AIF .NOT.&M,.B + LONGA ON +.B + AIF .NOT.&I,.C + LONGI ON +.C + MEND + MACRO +&LAB SHORT &A,&B + LCLB &I + LCLB &M +&A AMID &A,1,1 +&M SETB ("&A"="M").OR.("&A"="m") +&I SETB ("&A"="I").OR.("&A"="i") + AIF C:&B=0,.A +&B AMID &B,1,1 +&M SETB ("&B"="M").OR.("&B"="m").OR.&M +&I SETB ("&B"="I").OR.("&B"="i").OR.&I +.A +&LAB SEP #&M*32+&I*16 + AIF .NOT.&M,.B + LONGA OFF +.B + AIF .NOT.&I,.C + LONGI OFF +.C + MEND diff --git a/CCommon.pas b/CCommon.pas old mode 100755 new mode 100644 index 28cc2c0..aa89b34 --- a/CCommon.pas +++ b/CCommon.pas @@ -1 +1,969 @@ -{$optimize 7} {---------------------------------------------------------------} { } { CCommon } { } { Common declarations and global data for the compiler. } { } { Variables: } { } { bofPtr - pointer to the start of sourceFile } { chPtr - pointer to the next character in the file } { codegenStarted - have we started the code generator? } { debugType - line number debug types } { doingFunction - true if processing a function } { doingParameters - are we processing parm definitions? } { doingPartial - are we doing a partial compile? } { enterEditor - enter editor on terminal errors? } { expandMacros - should macros be expanded? } { firstPtr - points to first char in current line } { gotoList - list of goto labels } { includeFile - include file name (for return from includes) } { infoString - language specific command line info } { lastLine - last line number used by pc_nam } { liDCB - get/set LInfo DCB } { lineNumber - source line number } { lint - lint flags } { list - generate source listing? } { memoryCompile - memory based compile? } { nameFound - has a pc_nam been generated? } { numErrors - number of errors in the program } { objFile - object file name } { oldincludeFile - previous includeFile value } { partialFile - partial compile list } { sourceFile - source file name } { terminalErrors - are all errors terminal? } { traceBack - generate traceback code? } { useGlobalPool - use global (or local) string pool? } { wait - wait for keypress after errors? } { } { doDispose - dispose of the expression tree as we go? } { expressionValue - the expression evaluator returns the } { value of constant expressions in this variable } { expressionType - the type of the expression } { expressionTree - for non-constant initializers } { isConstant - is the initializer expression conastant? } { } { External Subroutines: } { } { CheckGotoList - Make sure all labels have been defined } { ClearHourGlass - Erase the hourglass from the screen } { CopyLongString - copy a long string } { CopyString - copy a string } { DrawHourGlass - Draw the hourglass on the screen } { ExitToEditor - do an error exit to the editor } { GetLocalLabel - get the next local label number } { Hash - find hash displacement } { InitCCommon - Initialize this module } { ReadFile - read a file } { Spin - Spin the spinner } { StopSpin - Stop the spinner } { SystemError - intercept run time compiler errors } { TermError - flag a terminal error } { typeSpec - type of the last type specifier evaluated by } { TypeSpecifier } { } {---------------------------------------------------------------} unit CCommon; interface const {hashsize appears in CCOMMON.ASM} hashSize = 876; {# hash buckets - 1} hashSize2 = 1753; {# hash buckets * 2 - 1} maxLine = 255; {max length of a line} maxPath = 255; {max length of a path name} {NOTE: maxPath is used in Scanner.asm} longstringlen = 4000; {max length of a string constant} minChar = 0; {min ordinal value of source character} maxChar = 255; {max ordinal value of source character} {lint masks} {----------} lintUndefFn = $0001; {flag use of undefined functions} lintNoFnType = $0002; {flag functions with no type} lintNotPrototyped = $0004; {flag functions with no prototypes} lintPragmas = $0008; {flag unknown prototypes} {bit masks for GetLInfo flags} {----------------------------} flag_d = $10000000; {generate debug code?} flag_e = $08000000; {abort to editor on terminal error?} flag_i = $00800000; {ignore symbol files?} flag_l = $00100000; {list source lines?} flag_m = $00080000; {memory based compile?} flag_o = $00020000; {optimize?} flag_p = $00010000; {print progress info?} flag_r = $00004000; {rebuild symbol files?} flag_s = $00002000; {list symbol tables?} flag_t = $00001000; {treat all errors as terminal?} flag_w = $00000200; {wait when an error is found?} versionStr = '2.1.1 B3'; {compiler version} type {Misc.} {-----} long = record lsw,msw: integer; end; {for extracting words from longints} cString = packed array [1..256] of char; {null terminated string} cStringPtr = ^cString; longString = record {long null terminated string} length: integer; str: packed array [1..longstringlen] of char; end; longStringPtr = ^longString; pString = packed array [0..maxLine] of char; {length string} stringPtr = ^pString; ptr = ^byte; {general purpose pointer} handle = ^ptr; {gereral purpose handle} gsosInString = record size: integer; theString: packed array [1..maxPath] of char; end; gsosInStringPtr = ^gsosInString; {GS/OS class 1 output string} gsosOutString = record maxSize: integer; theString: gsosInString; end; gsosOutStringPtr = ^gsosOutString; { The base types include two main categories. The values starting } { with cg are defined in the code generater, and may be passed to the } { code generator for resolution. The cc types are used internally in } { the compiler. Any values whose type is cc must be resulved to one } { of the cg types before the code generator is called. } baseTypeEnum = (cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong, cgReal,cgDouble,cgComp,cgExtended,cgString, cgVoid,ccPointer); {tokens} {------} {Note: tokenEnum is duplicated in } { Table.asm } tokenEnum = ( {enumeration of the tokens} ident, {identifiers} {constants} intconst,uintconst,longconst,ulongconst,doubleconst, stringconst, {reserved words} autosy,asmsy,breaksy,casesy,charsy, continuesy,constsy,compsy,defaultsy,dosy, doublesy,elsesy,enumsy,externsy,extendedsy, floatsy,forsy,gotosy,ifsy,intsy, inlinesy,longsy,pascalsy,registersy,returnsy, shortsy,sizeofsy,staticsy,structsy,switchsy, segmentsy,signedsy,typedefsy,unionsy,unsignedsy, voidsy,volatilesy,whilesy, {reserved symbols} excch,percentch,carotch,andch,asteriskch, minusch,plusch,eqch,tildech,barch, dotch,ltch,gtch,slashch,questionch, lparench,rparench,lbrackch,rbrackch,lbracech, rbracech,commach,semicolonch,colonch,poundch, minusgtop,plusplusop,minusminusop,ltltop,gtgtop, lteqop,gteqop,eqeqop,exceqop,andandop, barbarop,pluseqop,minuseqop,asteriskeqop,slasheqop, percenteqop,ltlteqop,gtgteqop,andeqop,caroteqop, bareqop,poundpoundop, eolsy,eofsy, {control characters} typedef, {user types} uminus,uand,uasterisk, {converted operations} parameteroper,castoper,opplusplus,opminusminus, macroParm); {macro language} {Note: this enumeration also } { appears in TABLE.ASM, } { SCANNER.asm } charEnum = {character kinds} (illegal,ch_special,ch_dash,ch_plus,ch_lt,ch_gt,ch_eq,ch_exc, ch_and,ch_bar,ch_dot,ch_white,ch_eol,ch_eof,ch_char,ch_string, ch_asterisk,ch_slash,ch_percent,ch_carot,ch_pound,letter,digit); tokenSet = set of tokenEnum; tokenClass = (reservedWord,reservedSymbol,identifier,intConstant,longConstant, doubleConstant,stringConstant,macroParameter); identPtr = ^identRecord; {^ to a symbol table entry} tokenType = record {a token} kind: tokenEnum; {kind of token} numString: stringPtr; {chars in number (macros only)} case class: tokenClass of {token info} reservedWord : (); reservedSymbol: (); identifier : (name: stringPtr; symbolPtr: identPtr); intConstant : (ival: integer); longConstant : (lval: longint); doubleConstant: (rval: double); stringConstant: (sval: longstringPtr; ispstring: boolean); macroParameter: (pnum: integer); end; {expressions} {-----------} expressionKind = ( {kinds of expressions} preprocessorExpression, {used by preprocessor commands} arrayExpression, {array subscripts, case labels, bit-field lengths, enum values} initializerExpression, {static variable initializers} autoInitializerExpression, {auto variable initializers} normalExpression); {for run-time evaluation} typePtr = ^typeRecord; tokenPtr = ^tokenRecord; tokenRecord = record {for operation, operand stacks} next: tokenPtr; {next token on the stack} left,middle,right: tokenPtr; {operand paths for operations} token: tokenType; {token at this node/leaf} case boolean of true : (id: identPtr;); {^symbol table entry for this operand} false: (castType: typePtr;); {cast type (for type casts only)} end; {goto label list} {---------------} gotoPtr = ^gotoRecord; gotoRecord = record {Note: if the size changes, see gotoSize} next: gotoPtr; name: stringPtr; lab: integer; defined: boolean; end; {symbol tables} {-------------} {classes of variables in the sym. tbl} spaceType = (tagSpace,variableSpace,allSpaces,fieldListSpace); parameterPtr = ^parameterRecord; {prototype parameter list} parameterRecord = record next: parameterPtr; parameter: identPtr; parameterType: typePtr; end; typeKind = (scalarType,arrayType,pointerType,functionType,enumType, enumConst,structType,unionType,definedType); typeRecord = record {type} size: longint; {size of the type in bytes} isConstant: boolean; {is the type a constant?} saveDisp: longint; {disp in symbol file} case kind: typeKind of {NOTE: aType,pType and fType must overlap} scalarType : (baseType: baseTypeEnum;); arrayType : (aType: typePtr; elements: longint; ); pointerType : (pType: typePtr;); functionType: (fType: typePtr; {return type} varargs, {are there a variable # of args?} prototyped: boolean; {is it prototyped?} overrideKR: boolean; {K&R overrides to prototypes?} parameterList: parameterPtr; {prototyped parameter list} isPascal: boolean; {pascal parameters?} toolNum: integer; {non-zero for tool functions} dispatcher: longint; {dispatch addr} ); enumConst : (eval: integer;); enumType : (); definedType : (dType: typePtr;); structType, unionType : (fieldList: identPtr; {field list} sName: stringPtr; {struct name; for forward refs} ); end; initializerPtr = ^initializerRecord; {initializers} initializerRecord = record next: initializerPtr; {next record in the chain} count: integer; {# of duplicate records} bitdisp: integer; {disp in byte (field lists only)} bitsize: integer; {width in bits; 0 for byte sizes} isStruct: boolean; {is this a struct initializer?} case isConstant: boolean of {is this a constant initializer?} false: (iTree: tokenPtr); true : ( case itype: baseTypeEnum of cgByte, cgUByte, cgWord, cgUWord, cgLong, cgULong : (iVal: longint); cgString : (sVal: longstringPtr); cgReal, cgDouble, cgComp, cgExtended: (rVal: double); cgVoid, ccPointer: ( pVal: longint; pPlus: boolean; case isName: boolean of true : (pName: stringPtr); false: (pStr : longstringPtr); ); ); end; storageType = (stackFrame,parameter,external,global,none,private); stateKind = (declared,defined,initialized); identRecord = record {identifier} next: identPtr; {next symbol in this hash bucket} saved: boolean; {has the symbol been saved (hashed) in the symbol file?} name: stringPtr; {symbol name} itype: typePtr; {symbol type} disp: longint; {disp past start of struct (field lists only)} bitDisp: integer; {disp in byte (field lists only)} {parameter number (K&R parms only)} bitsize: integer; {width in bits; 0 for byte sizes} state: stateKind; {state of the definition} iPtr: initializerPtr; {pointer to the first initializer} isForwardDeclared: boolean; {does this var use a forward declared type?} class: tokenEnum; {storage class} case storage: storageType of stackFrame: (lln: integer); {local label #} parameter: (pln: integer; {paramater label #} pdisp: integer; {disp of parameter} pnext: identPtr); {next parameter} external: (); global,private: (); none: (); end; {mini-assembler} {--------------} {opcodes} opcode = (o_adc,o_and,o_asl,o_bit,o_cmp,o_cop,o_cpx,o_cpy,o_dec,o_eor, o_inc,o_jml,o_jmp,o_jsl,o_jsr,o_lda,o_ldx,o_ldy,o_lsr,o_ora, o_pea,o_pei,o_rep,o_rol,o_ror,o_sbc,o_sep,o_sta,o_stx,o_sty, o_stz,o_trb,o_tsb, o_dcb,o_dcw,o_dcl, o_brk, o_mvn,o_mvp, o_bcc,o_bcs,o_beq,o_bmi,o_bne,o_bpl,o_bra,o_brl,o_per,o_bvc, o_bvs, o_clc,o_cld,o_cli,o_clv,o_dex,o_dey,o_inx,o_iny,o_nop,o_pha, o_phb,o_phd,o_phk,o_php,o_phx,o_phy,o_pla,o_plb,o_pld,o_plp, o_plx,o_ply,o_rti,o_rtl,o_rts,o_sec,o_sed,o_sei,o_stp,o_tax, o_tay,o_tcd,o_tcs,o_tdc,o_tsc,o_tsx,o_txa,o_txs,o_txy,o_tya, o_tyx,o_wai,o_xba,o_xce); {addressing modes} operands = (acc,imm,dp,dp_x,dp_y,op,op_x,op_y,i_dp_x,i_dp_y,dp_s,li_dp,la, i_dp,i_op,i_la,i_op_x,i_dp_s_y,li_dp_y,long_x); {work variables} {--------------} tempPtr = ^tempRecord; tempRecord = record last,next: tempPtr; {doubly linked list} labelNum: integer; {label number} size: integer; {size of the variable} end; {ORCA Shell and ProDOS} {---------------------} timeField = array[1..8] of byte; optionListRecord = record totalSize: integer; requiredSize: integer; fileSysID: integer; theData: packed array [1..100] of char; end; optionListPtr = ^optionListRecord; fastFileDCBGS = record pcount: integer; action: integer; index: integer; flags: integer; fileHandle: handle; pathName: gsosInStringPtr; access: integer; fileType: integer; auxType: longint; storageType: integer; createDate: timeField; modDate: timeField; option: optionListPtr; fileLength: longint; blocksUsed: longint; end; getLInfoDCBGS = record pcount: integer; sFile: gsosOutStringPtr; dFile: gsosOutStringPtr; namesList: gsosOutStringPtr; iString: gsosOutStringPtr; merr: byte; merrf: byte; lops: byte; kFlag: byte; mFlags: longint; pFlags: longint; org: longint; end; getPrefixOSDCB = record pcount: integer; prefixNum: integer; prefix: gsosOutStringPtr; end; versionDCBGS = record pcount: integer; version: packed array[1..4] of char; end; {---------------------------------------------------------------} var {misc} {----} bofPtr: ptr; {pointer to the start of sourceFile} chPtr: ptr; {pointer to the next character in the file} {debugType is also in SCANNER.ASM} debugType: (stop,break,autogo); {line number debug types} doingParameters: boolean; {are we processing parm definitions?} expandMacros: boolean; {should macros be expanded?} ffDCBGS: fastFileDCBGS; {fast file DCB} firstPtr: ptr; {points to first char in current line} gotoList: gotoPtr; {list of goto labels} includeFileGS: gsosOutString; {include file name (for return from includes)} infoStringGS: gsosOutString; {language specific command line info} intLabel: integer; {last used label number} languageNumber: integer; {our language number} lastLine: 0..maxint; {last line number used by pc_nam} liDCBGS: getLInfoDCBGS; {get/set LInfo DCB} lineNumber: 0..maxint; {source line number} nameFound: boolean; {has a pc_nam been generated?} nextLocalLabel: integer; {next available local data label number} numErrors: integer; {number of errors in the program} objFile: gsosOutString; {object file name} oldincludeFileGS: gsosOutString; {previous includeFile value} outFileGS: gsosOutString; {keep file name} partialFileGS: gsosOutString; {partial compile list} sourceFileGS: gsosOutString; {debug source file name} tempList: tempPtr; {list of temp work variables} {expression results} {------------------} doDispose: boolean; {dispose of the expression tree as we go?} realExpressionValue: double; {value of the last real constant expression} expressionValue: longint; {value of the last constant expression} expressionType: typePtr; {the type of the expression} initializerTree: tokenPtr; {for non-constant initializers} isConstant: boolean; {is the initializer expression conastant?} {type specifier results} {----------------------} typeSpec: typePtr; {type specifier} {flags} {-----} codegenStarted: boolean; {have we started the code generator?} doingFunction: boolean; {are we processing a function?} doingPartial: boolean; {are we doing a partial compile?} enterEditor: boolean; {enter editor on terminal errors?} foundFunction: boolean; {has a function been found?} lint: integer; {lint flags} list: boolean; {generate source listing?} ignoreSymbols: boolean; {ignore .sym file?} memoryCompile: boolean; {memory based compile?} printSymbols: boolean; {+s flag set?} progress: boolean; {write progress info?} rebuildSymbols: boolean; {rebuild .sym file?} switchLanguages: boolean; {switch languages on exit?} terminalErrors: boolean; {are all errors terminal?} traceBack: boolean; {generate traceback code?} unix_1: boolean; {is int 32 bits? (or 16 bits)} useGlobalPool: boolean; {use global (or local) string pool?} wait: boolean; {wait for keypress after errors?} {---------------------------------------------------------------} {ORCA Shell and ProDOS} {---------------------} procedure GetLInfoGS (var parms: getLInfoDCBGS); prodos ($0141); procedure FastFileGS (var parms: fastFileDCBGS); prodos ($014E); procedure SetLInfoGS (var parms: getLInfoDCBGS); prodos ($0142); procedure GetPrefixGS (var parms: getPrefixOSDCB); prodos ($200A); procedure VersionGS (var parms: versionDCBGS); prodos ($0147); {---------------------------------------------------------------} procedure CheckGotoList; { Make sure all labels have been defined } procedure ClearHourGlass; { Erase the hourglass from the screen } procedure CopyLongString (toPtr, fromPtr: longStringptr); { copy a long string } { } { parameters: } { toPtr - location to copy to } { fromPtr - location to copy from } procedure CopyString (toPtr, fromPtr: ptr); extern; { copy a string } { } { parameters: } { toPtr - location to copy to } { fromPtr - location to copy from } procedure DrawHourGlass; { Draw the hourglass on the screen } procedure ExitToEditor (msg: stringPtr; disp: longint); { do an error exit to the editor } { } { parameters: } { msg - pointer to the error message } { disp - displacement into the error file } { } { variables: } { includeFile - source file name } function GenLabel: integer; { generate the next local label, checking for too many } function GetLocalLabel: integer; { get the next local label number } function Hash (sPtr: stringPtr): integer; extern; { find hash displacement } { } { Finds the displacement into an array of pointers using a } { hash function. } { } { parameters: } { sPtr - points to string to find hash for } procedure InitCCommon; { Initialize this module } procedure ReadFile; { read a file } { } { variables: } { bofPtr - pointer to the start of the file } { ffDCB.file_length - length of the file } { includeFile - source file name } procedure Spin; { Spin the spinner } { } { Notes: Starts the spinner if it is not already in use } procedure StopSpin; { Stop the spinner } { } { Notes: The call is safe, and ignored, if the spinner is } procedure SystemError (errNo: integer); { intercept run time compiler errors } procedure TermError (errnum: integer); { flag a terminal error } {---------------------------------------------------------------} implementation const {Note: maxLabel is also defined in cgi.pas} maxLabel = 2400; {max # compiler generated labels} {spinner} {-------} spinSpeed = 8; {calls before one spinner move} type consoleOutDCBGS = record pcount: integer; ch: char; end; var {spinner} {-------} spinning: boolean; {are we spinning now?} spinDisp: integer; {disp to the spinner character} spinCount: integer; {spin loop counter} spinner: array[0..3] of char; {spinner characters} procedure Error (err: integer); extern; {in scanner.pas} { flag an error } { } { err - error number } {procedure Error2 (loc, err: integer); extern; {debug} {in scanner.pas} { flag an error } { } { loc - error location } { err - error number } procedure MMQuit; extern; {in mm.pas} { Dispose of memory allocated with private user IDs } procedure ConsoleOutGS (var parms: consoleOutDCBGS); prodos ($015A); {---------------------------------------------------------------} procedure CheckGotoList; { Make sure all labels have been defined } var gt: gotoPtr; {work pointer} msg: stringPtr; {work string} begin {CheckGotoList} gt := gotoList; while gt <> nil do begin if not gt^.defined then begin numErrors := numErrors+1; new(msg); msg^ := concat('Undefined label: ', gt^.name^); writeln(msg^); if terminalErrors then begin if enterEditor then ExitToEditor(msg, ord4(firstPtr)-ord4(bofPtr)) else TermError(0); end; {if} dispose(msg); end; {if} gt := gt^.next; end; {while} end; {CheckGotoList} procedure ClearHourGlass; { Erase the hourglass from the screen } var coRec: consoleOutDCBGS; {Console out record} begin {ClearHourGlass} coRec.pcount := 1; coRec.ch := ' '; ConsoleOutGS(coRec); coRec.ch := chr(8); ConsoleOutGS(coRec); end; {ClearHourGlass} procedure CopyLongString {toPtr, fromPtr: longStringPtr}; { copy a long string } { } { parameters: } { toPtr - location to copy to } { fromPtr - location to copy from } var i: integer; {loop variable} begin {CopyLongString} toPtr^.length := fromPtr^.length; {set the length} for i := 1 to fromPtr^.length do toPtr^.str[i] := fromPtr^.str[i]; end; {CopyLongString} procedure DrawHourGlass; { Draw the hourglass on the screen } var coRec: consoleOutDCBGS; {Console out record} begin {DrawHourGlass} coRec.pcount := 1; coRec.ch := chr(27); ConsoleOutGS(coRec); coRec.ch := chr(15); ConsoleOutGS(coRec); coRec.ch := 'C'; ConsoleOutGS(coRec); coRec.ch := chr(24); ConsoleOutGS(coRec); coRec.ch := chr(14); ConsoleOutGS(coRec); coRec.ch := chr(8); ConsoleOutGS(coRec); end; {DrawHourGlass} procedure ExitToEditor {msg: stringPtr; disp: longint}; { do an error exit to the editor } { } { parameters: } { msg - pointer to the error message } { disp - displacement into the error file } { } { variables: } { includeFile - source file name } var msgGS: gsosInString; {message} begin {ExitToEditor} msgGS.size := length(msg^); {set up the error message} msgGS.theString := msg^; liDCBGS.org := disp; {mark the error} liDCBGS.namesList := @msgGS; liDCBGS.lops := 0; {prevent re-entry} liDCBGS.merrf := 255; with liDCBGS do begin sFile := pointer(ord4(sFile)+2); dFile := pointer(ord4(dFile)+2); iString := pointer(ord4(iString)+2); end; {with} SetLInfoGS(liDCBGS); StopSpin; {stop the spinner} MMQuit; {dispose of the memory pools} halt(-1); {return to the shell} end; {ExitToEditor} function GenLabel{: integer}; { generate the next local label, checking for too many } begin {GenLabel} if intLabel < maxLabel then intLabel := intLabel+1 else begin intLabel := 0; Error(58); end; GenLabel := intLabel; end; {GenLabel} function GetLocalLabel{: integer}; { get the next local label number } begin {GetLocalLabel} GetLocalLabel := nextLocalLabel; nextLocalLabel := nextLocalLabel+1; end; {GetLocalLabel} procedure InitCCommon; { Initialize this module } begin {InitCCommon} spinning := false; {not spinning the spinner} spinDisp := 0; {start spinning with the first character} spinner[0] := '|'; {set up the spinner characters} spinner[1] := '/'; spinner[2] := '-'; spinner[3] := '\'; end; {InitCCommon} procedure ReadFile; { read a file } { } { variables: } { bofPtr - pointer to the start of the file } { ffDCB.file_length - length of the file } { includeFile - source file name } const SRC = $B0; {source file type} begin {ReadFile} with ffDCBGS do begin {read the source file} pCount := 14; action := 0; flags := $C000; pathName := @includeFileGS.theString; end; {with} FastFileGS(ffDCBGS); if ToolError <> 0 then begin sourceFileGS := includeFileGS; includeFileGS := oldincludeFileGS; TermError(1); end; {if} if ffDCBGS.fileType <> SRC then begin includeFileGS := oldincludeFileGS; TermError(6); end; {if} bofPtr := ffDCBGS.fileHandle^; {set beginning of file pointer} end; {ReadFile} procedure Spin; { Spin the spinner } { } { Notes: Starts the spinner if it is not already in use } var coRec: consoleOutDCBGS; {Console out record} begin {Spin} if not spinning then begin spinning := true; spinCount := spinSpeed; end; {if} spinCount := spinCount - 1; if spinCount = 0 then begin spinCount := spinSpeed; spinDisp := spinDisp - 1; if spinDisp < 0 then spinDisp := 3; coRec.pcount := 1; coRec.ch := spinner[spinDisp]; ConsoleOutGS(coRec); coRec.ch := chr(8); ConsoleOutGS(coRec); end; {if} end; {Spin} procedure StopSpin; { Stop the spinner } { } { Notes: The call is safe, and ignored, if the spinner is } { inactive. } var coRec: consoleOutDCBGS; {Console out record} begin {StopSpin} if spinning then begin spinning := false; coRec.pcount := 1; coRec.ch := ' '; ConsoleOutGS(coRec); coRec.ch := chr(8); ConsoleOutGS(coRec); end; {if} end; {StopSpin} procedure SystemError {errNo: integer}; { intercept run time compiler errors } begin {SystemError} if errNo = 5 then TermError(5) else TermError(3); end; {SystemError} procedure TermError {errnum: integer}; { flag a terminal error } var msg: pString; {terminal error message} begin {TermError} case errnum of {print the error} 0 : ; 1 : msg := concat('Error reading ', sourceFileGS.theString.theString); 2 : msg := concat('Error purging ', sourceFileGS.theString.theString); 3 : msg := 'terminal compiler error'; 4 : msg := 'user termination'; 5 : msg := 'out of memory'; 6 : msg := 'source files must have a file type of SRC'; 7 : msg := 'you cannot change languages with an include directive'; 8 : msg := 'you cannot change languages from an included file'; 9 : msg := concat('Error writing ', objFile.theString.theString); 10: msg := 'ORCA/C requires version 2.0 or later of the shell'; 11: msg := 'The program is too large to compile to memory -- use Compile to Disk'; otherwise: Error(57); end; {case} with ffDCBGS do begin {purge the source file} pCount := 5; action := 7; pathName := @includeFileGS.theString; end; {with} FastFileGS(ffDCBGS); writeln('Terminal error: ', msg); {write the error to stdout} if enterEditor then {error exit to editor} ExitToEditor(@msg, ord4(chPtr) - ord4(bofPtr)) else begin liDCBGS.lops := 0; {prevent re-entry} liDCBGS.merrf := 127; with liDCBGS do begin sFile := pointer(ord4(sFile)+2); dFile := pointer(ord4(dFile)+2); namesList := pointer(ord4(namesList)+2); iString := pointer(ord4(iString)+2); end; {with} SetLInfoGS(liDCBGS); StopSpin; {stop the spinner} MMQuit; {dispose of the memory pools} halt(-1); {return to the shell} end; {else} end; {TermError} end. {$append 'ccommon.asm'} \ No newline at end of file +{$optimize 7} +{---------------------------------------------------------------} +{ } +{ CCommon } +{ } +{ Common declarations and global data for the compiler. } +{ } +{ Variables: } +{ } +{ bofPtr - pointer to the start of sourceFile } +{ chPtr - pointer to the next character in the file } +{ codegenStarted - have we started the code generator? } +{ debugType - line number debug types } +{ doingFunction - true if processing a function } +{ doingParameters - are we processing parm definitions? } +{ doingPartial - are we doing a partial compile? } +{ enterEditor - enter editor on terminal errors? } +{ expandMacros - should macros be expanded? } +{ firstPtr - points to first char in current line } +{ gotoList - list of goto labels } +{ includeFile - include file name (for return from includes) } +{ infoString - language specific command line info } +{ lastLine - last line number used by pc_nam } +{ liDCB - get/set LInfo DCB } +{ lineNumber - source line number } +{ lint - lint flags } +{ list - generate source listing? } +{ memoryCompile - memory based compile? } +{ nameFound - has a pc_nam been generated? } +{ numErrors - number of errors in the program } +{ objFile - object file name } +{ oldincludeFile - previous includeFile value } +{ partialFile - partial compile list } +{ sourceFile - source file name } +{ terminalErrors - are all errors terminal? } +{ traceBack - generate traceback code? } +{ useGlobalPool - use global (or local) string pool? } +{ wait - wait for keypress after errors? } +{ } +{ doDispose - dispose of the expression tree as we go? } +{ expressionValue - the expression evaluator returns the } +{ value of constant expressions in this variable } +{ expressionType - the type of the expression } +{ expressionTree - for non-constant initializers } +{ isConstant - is the initializer expression conastant? } +{ } +{ External Subroutines: } +{ } +{ CheckGotoList - Make sure all labels have been defined } +{ ClearHourGlass - Erase the hourglass from the screen } +{ CopyLongString - copy a long string } +{ CopyString - copy a string } +{ DrawHourGlass - Draw the hourglass on the screen } +{ ExitToEditor - do an error exit to the editor } +{ GetLocalLabel - get the next local label number } +{ Hash - find hash displacement } +{ InitCCommon - Initialize this module } +{ ReadFile - read a file } +{ Spin - Spin the spinner } +{ StopSpin - Stop the spinner } +{ SystemError - intercept run time compiler errors } +{ TermError - flag a terminal error } +{ typeSpec - type of the last type specifier evaluated by } +{ TypeSpecifier } +{ } +{---------------------------------------------------------------} + +unit CCommon; + +interface + +const + {hashsize appears in CCOMMON.ASM} + hashSize = 876; {# hash buckets - 1} + hashSize2 = 1753; {# hash buckets * 2 - 1} + maxLine = 255; {max length of a line} + maxPath = 255; {max length of a path name} + {NOTE: maxPath is used in Scanner.asm} + longstringlen = 4000; {max length of a string constant} + + minChar = 0; {min ordinal value of source character} + maxChar = 255; {max ordinal value of source character} + + {lint masks} + {----------} + lintUndefFn = $0001; {flag use of undefined functions} + lintNoFnType = $0002; {flag functions with no type} + lintNotPrototyped = $0004; {flag functions with no prototypes} + lintPragmas = $0008; {flag unknown prototypes} + + {bit masks for GetLInfo flags} + {----------------------------} + flag_d = $10000000; {generate debug code?} + flag_e = $08000000; {abort to editor on terminal error?} + flag_i = $00800000; {ignore symbol files?} + flag_l = $00100000; {list source lines?} + flag_m = $00080000; {memory based compile?} + flag_o = $00020000; {optimize?} + flag_p = $00010000; {print progress info?} + flag_r = $00004000; {rebuild symbol files?} + flag_s = $00002000; {list symbol tables?} + flag_t = $00001000; {treat all errors as terminal?} + flag_w = $00000200; {wait when an error is found?} + + versionStr = '2.1.1 B3'; {compiler version} + +type + {Misc.} + {-----} + long = record lsw,msw: integer; end; {for extracting words from longints} + + cString = packed array [1..256] of char; {null terminated string} + cStringPtr = ^cString; + longString = record {long null terminated string} + length: integer; + str: packed array [1..longstringlen] of char; + end; + longStringPtr = ^longString; + pString = packed array [0..maxLine] of char; {length string} + stringPtr = ^pString; + ptr = ^byte; {general purpose pointer} + handle = ^ptr; {gereral purpose handle} + + gsosInString = record + size: integer; + theString: packed array [1..maxPath] of char; + end; + gsosInStringPtr = ^gsosInString; + + {GS/OS class 1 output string} + gsosOutString = record + maxSize: integer; + theString: gsosInString; + end; + gsosOutStringPtr = ^gsosOutString; + + { The base types include two main categories. The values starting } + { with cg are defined in the code generater, and may be passed to the } + { code generator for resolution. The cc types are used internally in } + { the compiler. Any values whose type is cc must be resulved to one } + { of the cg types before the code generator is called. } + + baseTypeEnum = (cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong, + cgReal,cgDouble,cgComp,cgExtended,cgString, + cgVoid,ccPointer); + + {tokens} + {------} + {Note: tokenEnum is duplicated in } + { Table.asm } + tokenEnum = ( {enumeration of the tokens} + ident, {identifiers} + {constants} + intconst,uintconst,longconst,ulongconst,doubleconst, + stringconst, + {reserved words} + autosy,asmsy,breaksy,casesy,charsy, + continuesy,constsy,compsy,defaultsy,dosy, + doublesy,elsesy,enumsy,externsy,extendedsy, + floatsy,forsy,gotosy,ifsy,intsy, + inlinesy,longsy,pascalsy,registersy,returnsy, + shortsy,sizeofsy,staticsy,structsy,switchsy, + segmentsy,signedsy,typedefsy,unionsy,unsignedsy, + voidsy,volatilesy,whilesy, + {reserved symbols} + excch,percentch,carotch,andch,asteriskch, + minusch,plusch,eqch,tildech,barch, + dotch,ltch,gtch,slashch,questionch, + lparench,rparench,lbrackch,rbrackch,lbracech, + rbracech,commach,semicolonch,colonch,poundch, + minusgtop,plusplusop,minusminusop,ltltop,gtgtop, + lteqop,gteqop,eqeqop,exceqop,andandop, + barbarop,pluseqop,minuseqop,asteriskeqop,slasheqop, + percenteqop,ltlteqop,gtgteqop,andeqop,caroteqop, + bareqop,poundpoundop, + eolsy,eofsy, {control characters} + typedef, {user types} + uminus,uand,uasterisk, {converted operations} + parameteroper,castoper,opplusplus,opminusminus, + macroParm); {macro language} + + {Note: this enumeration also } + { appears in TABLE.ASM, } + { SCANNER.asm } + charEnum = {character kinds} + (illegal,ch_special,ch_dash,ch_plus,ch_lt,ch_gt,ch_eq,ch_exc, + ch_and,ch_bar,ch_dot,ch_white,ch_eol,ch_eof,ch_char,ch_string, + ch_asterisk,ch_slash,ch_percent,ch_carot,ch_pound,letter,digit); + + tokenSet = set of tokenEnum; + tokenClass = (reservedWord,reservedSymbol,identifier,intConstant,longConstant, + doubleConstant,stringConstant,macroParameter); + identPtr = ^identRecord; {^ to a symbol table entry} + tokenType = record {a token} + kind: tokenEnum; {kind of token} + numString: stringPtr; {chars in number (macros only)} + case class: tokenClass of {token info} + reservedWord : (); + reservedSymbol: (); + identifier : (name: stringPtr; + symbolPtr: identPtr); + intConstant : (ival: integer); + longConstant : (lval: longint); + doubleConstant: (rval: double); + stringConstant: (sval: longstringPtr; + ispstring: boolean); + macroParameter: (pnum: integer); + end; + + {expressions} + {-----------} + expressionKind = ( {kinds of expressions} + preprocessorExpression, {used by preprocessor commands} + arrayExpression, {array subscripts, case labels, + bit-field lengths, enum values} + initializerExpression, {static variable initializers} + autoInitializerExpression, {auto variable initializers} + normalExpression); {for run-time evaluation} + typePtr = ^typeRecord; + tokenPtr = ^tokenRecord; + tokenRecord = record {for operation, operand stacks} + next: tokenPtr; {next token on the stack} + left,middle,right: tokenPtr; {operand paths for operations} + token: tokenType; {token at this node/leaf} + case boolean of + true : (id: identPtr;); {^symbol table entry for this operand} + false: (castType: typePtr;); {cast type (for type casts only)} + end; + + {goto label list} + {---------------} + gotoPtr = ^gotoRecord; + gotoRecord = record + {Note: if the size changes, see gotoSize} + next: gotoPtr; + name: stringPtr; + lab: integer; + defined: boolean; + end; + + {symbol tables} + {-------------} + {classes of variables in the sym. tbl} + spaceType = (tagSpace,variableSpace,allSpaces,fieldListSpace); + + parameterPtr = ^parameterRecord; {prototype parameter list} + parameterRecord = record + next: parameterPtr; + parameter: identPtr; + parameterType: typePtr; + end; + + typeKind = (scalarType,arrayType,pointerType,functionType,enumType, + enumConst,structType,unionType,definedType); + typeRecord = record {type} + size: longint; {size of the type in bytes} + isConstant: boolean; {is the type a constant?} + saveDisp: longint; {disp in symbol file} + case kind: typeKind of {NOTE: aType,pType and fType must overlap} + scalarType : (baseType: baseTypeEnum;); + arrayType : (aType: typePtr; + elements: longint; + ); + pointerType : (pType: typePtr;); + functionType: (fType: typePtr; {return type} + varargs, {are there a variable # of args?} + prototyped: boolean; {is it prototyped?} + overrideKR: boolean; {K&R overrides to prototypes?} + parameterList: parameterPtr; {prototyped parameter list} + isPascal: boolean; {pascal parameters?} + toolNum: integer; {non-zero for tool functions} + dispatcher: longint; {dispatch addr} + ); + enumConst : (eval: integer;); + enumType : (); + definedType : (dType: typePtr;); + structType, + unionType : (fieldList: identPtr; {field list} + sName: stringPtr; {struct name; for forward refs} + ); + end; + + initializerPtr = ^initializerRecord; {initializers} + initializerRecord = record + next: initializerPtr; {next record in the chain} + count: integer; {# of duplicate records} + bitdisp: integer; {disp in byte (field lists only)} + bitsize: integer; {width in bits; 0 for byte sizes} + isStruct: boolean; {is this a struct initializer?} + case isConstant: boolean of {is this a constant initializer?} + false: (iTree: tokenPtr); + true : ( + case itype: baseTypeEnum of + cgByte, + cgUByte, + cgWord, + cgUWord, + cgLong, + cgULong : (iVal: longint); + cgString : (sVal: longstringPtr); + cgReal, + cgDouble, + cgComp, + cgExtended: (rVal: double); + cgVoid, + ccPointer: ( + pVal: longint; + pPlus: boolean; + case isName: boolean of + true : (pName: stringPtr); + false: (pStr : longstringPtr); + ); + ); + end; + + storageType = (stackFrame,parameter,external,global,none,private); + stateKind = (declared,defined,initialized); + identRecord = record {identifier} + next: identPtr; {next symbol in this hash bucket} + saved: boolean; {has the symbol been saved (hashed) in the symbol file?} + name: stringPtr; {symbol name} + itype: typePtr; {symbol type} + disp: longint; {disp past start of struct (field lists only)} + bitDisp: integer; {disp in byte (field lists only)} + {parameter number (K&R parms only)} + bitsize: integer; {width in bits; 0 for byte sizes} + state: stateKind; {state of the definition} + iPtr: initializerPtr; {pointer to the first initializer} + isForwardDeclared: boolean; {does this var use a forward declared type?} + class: tokenEnum; {storage class} + case storage: storageType of + stackFrame: (lln: integer); {local label #} + parameter: (pln: integer; {paramater label #} + pdisp: integer; {disp of parameter} + pnext: identPtr); {next parameter} + external: (); + global,private: (); + none: (); + end; + + {mini-assembler} + {--------------} + {opcodes} + opcode = (o_adc,o_and,o_asl,o_bit,o_cmp,o_cop,o_cpx,o_cpy,o_dec,o_eor, + o_inc,o_jml,o_jmp,o_jsl,o_jsr,o_lda,o_ldx,o_ldy,o_lsr,o_ora, + o_pea,o_pei,o_rep,o_rol,o_ror,o_sbc,o_sep,o_sta,o_stx,o_sty, + o_stz,o_trb,o_tsb, + + o_dcb,o_dcw,o_dcl, + + o_brk, + + o_mvn,o_mvp, + + o_bcc,o_bcs,o_beq,o_bmi,o_bne,o_bpl,o_bra,o_brl,o_per,o_bvc, + o_bvs, + + o_clc,o_cld,o_cli,o_clv,o_dex,o_dey,o_inx,o_iny,o_nop,o_pha, + o_phb,o_phd,o_phk,o_php,o_phx,o_phy,o_pla,o_plb,o_pld,o_plp, + o_plx,o_ply,o_rti,o_rtl,o_rts,o_sec,o_sed,o_sei,o_stp,o_tax, + o_tay,o_tcd,o_tcs,o_tdc,o_tsc,o_tsx,o_txa,o_txs,o_txy,o_tya, + o_tyx,o_wai,o_xba,o_xce); + + {addressing modes} + operands = (acc,imm,dp,dp_x,dp_y,op,op_x,op_y,i_dp_x,i_dp_y,dp_s,li_dp,la, + i_dp,i_op,i_la,i_op_x,i_dp_s_y,li_dp_y,long_x); + + {work variables} + {--------------} + tempPtr = ^tempRecord; + tempRecord = record + last,next: tempPtr; {doubly linked list} + labelNum: integer; {label number} + size: integer; {size of the variable} + end; + + {ORCA Shell and ProDOS} + {---------------------} + timeField = array[1..8] of byte; + + optionListRecord = record + totalSize: integer; + requiredSize: integer; + fileSysID: integer; + theData: packed array [1..100] of char; + end; + optionListPtr = ^optionListRecord; + + fastFileDCBGS = record + pcount: integer; + action: integer; + index: integer; + flags: integer; + fileHandle: handle; + pathName: gsosInStringPtr; + access: integer; + fileType: integer; + auxType: longint; + storageType: integer; + createDate: timeField; + modDate: timeField; + option: optionListPtr; + fileLength: longint; + blocksUsed: longint; + end; + + getLInfoDCBGS = record + pcount: integer; + sFile: gsosOutStringPtr; + dFile: gsosOutStringPtr; + namesList: gsosOutStringPtr; + iString: gsosOutStringPtr; + merr: byte; + merrf: byte; + lops: byte; + kFlag: byte; + mFlags: longint; + pFlags: longint; + org: longint; + end; + + getPrefixOSDCB = record + pcount: integer; + prefixNum: integer; + prefix: gsosOutStringPtr; + end; + + versionDCBGS = record + pcount: integer; + version: packed array[1..4] of char; + end; + +{---------------------------------------------------------------} + +var + {misc} + {----} + bofPtr: ptr; {pointer to the start of sourceFile} + chPtr: ptr; {pointer to the next character in the file} + {debugType is also in SCANNER.ASM} + debugType: (stop,break,autogo); {line number debug types} + doingParameters: boolean; {are we processing parm definitions?} + expandMacros: boolean; {should macros be expanded?} + ffDCBGS: fastFileDCBGS; {fast file DCB} + firstPtr: ptr; {points to first char in current line} + gotoList: gotoPtr; {list of goto labels} + includeFileGS: gsosOutString; {include file name (for return from includes)} + infoStringGS: gsosOutString; {language specific command line info} + intLabel: integer; {last used label number} + languageNumber: integer; {our language number} + lastLine: 0..maxint; {last line number used by pc_nam} + liDCBGS: getLInfoDCBGS; {get/set LInfo DCB} + lineNumber: 0..maxint; {source line number} + nameFound: boolean; {has a pc_nam been generated?} + nextLocalLabel: integer; {next available local data label number} + numErrors: integer; {number of errors in the program} + objFile: gsosOutString; {object file name} + oldincludeFileGS: gsosOutString; {previous includeFile value} + outFileGS: gsosOutString; {keep file name} + partialFileGS: gsosOutString; {partial compile list} + sourceFileGS: gsosOutString; {debug source file name} + tempList: tempPtr; {list of temp work variables} + + {expression results} + {------------------} + doDispose: boolean; {dispose of the expression tree as we go?} + realExpressionValue: double; {value of the last real constant expression} + expressionValue: longint; {value of the last constant expression} + expressionType: typePtr; {the type of the expression} + initializerTree: tokenPtr; {for non-constant initializers} + isConstant: boolean; {is the initializer expression conastant?} + + {type specifier results} + {----------------------} + typeSpec: typePtr; {type specifier} + + {flags} + {-----} + codegenStarted: boolean; {have we started the code generator?} + doingFunction: boolean; {are we processing a function?} + doingPartial: boolean; {are we doing a partial compile?} + enterEditor: boolean; {enter editor on terminal errors?} + foundFunction: boolean; {has a function been found?} + lint: integer; {lint flags} + list: boolean; {generate source listing?} + ignoreSymbols: boolean; {ignore .sym file?} + memoryCompile: boolean; {memory based compile?} + printSymbols: boolean; {+s flag set?} + progress: boolean; {write progress info?} + rebuildSymbols: boolean; {rebuild .sym file?} + switchLanguages: boolean; {switch languages on exit?} + terminalErrors: boolean; {are all errors terminal?} + traceBack: boolean; {generate traceback code?} + unix_1: boolean; {is int 32 bits? (or 16 bits)} + useGlobalPool: boolean; {use global (or local) string pool?} + wait: boolean; {wait for keypress after errors?} + +{---------------------------------------------------------------} + + {ORCA Shell and ProDOS} + {---------------------} + +procedure GetLInfoGS (var parms: getLInfoDCBGS); prodos ($0141); + +procedure FastFileGS (var parms: fastFileDCBGS); prodos ($014E); + +procedure SetLInfoGS (var parms: getLInfoDCBGS); prodos ($0142); + +procedure GetPrefixGS (var parms: getPrefixOSDCB); prodos ($200A); + +procedure VersionGS (var parms: versionDCBGS); prodos ($0147); + +{---------------------------------------------------------------} + +procedure CheckGotoList; + +{ Make sure all labels have been defined } + + +procedure ClearHourGlass; + +{ Erase the hourglass from the screen } + + +procedure CopyLongString (toPtr, fromPtr: longStringptr); + +{ copy a long string } +{ } +{ parameters: } +{ toPtr - location to copy to } +{ fromPtr - location to copy from } + + +procedure CopyString (toPtr, fromPtr: ptr); extern; + +{ copy a string } +{ } +{ parameters: } +{ toPtr - location to copy to } +{ fromPtr - location to copy from } + + +procedure DrawHourGlass; + +{ Draw the hourglass on the screen } + + +procedure ExitToEditor (msg: stringPtr; disp: longint); + +{ do an error exit to the editor } +{ } +{ parameters: } +{ msg - pointer to the error message } +{ disp - displacement into the error file } +{ } +{ variables: } +{ includeFile - source file name } + + +function GenLabel: integer; + +{ generate the next local label, checking for too many } + + +function GetLocalLabel: integer; + +{ get the next local label number } + + +function Hash (sPtr: stringPtr): integer; extern; + +{ find hash displacement } +{ } +{ Finds the displacement into an array of pointers using a } +{ hash function. } +{ } +{ parameters: } +{ sPtr - points to string to find hash for } + + +procedure InitCCommon; + +{ Initialize this module } + + +procedure ReadFile; + +{ read a file } +{ } +{ variables: } +{ bofPtr - pointer to the start of the file } +{ ffDCB.file_length - length of the file } +{ includeFile - source file name } + + +procedure Spin; + +{ Spin the spinner } +{ } +{ Notes: Starts the spinner if it is not already in use } + + +procedure StopSpin; + +{ Stop the spinner } +{ } +{ Notes: The call is safe, and ignored, if the spinner is } + + +procedure SystemError (errNo: integer); + +{ intercept run time compiler errors } + + +procedure TermError (errnum: integer); + +{ flag a terminal error } + +{---------------------------------------------------------------} + +implementation + +const + {Note: maxLabel is also defined in cgi.pas} + maxLabel = 2400; {max # compiler generated labels} + + {spinner} + {-------} + spinSpeed = 8; {calls before one spinner move} + +type + consoleOutDCBGS = record + pcount: integer; + ch: char; + end; + +var + {spinner} + {-------} + + spinning: boolean; {are we spinning now?} + spinDisp: integer; {disp to the spinner character} + spinCount: integer; {spin loop counter} + + spinner: array[0..3] of char; {spinner characters} + + +procedure Error (err: integer); extern; {in scanner.pas} + +{ flag an error } +{ } +{ err - error number } + + +{procedure Error2 (loc, err: integer); extern; {debug} {in scanner.pas} + +{ flag an error } +{ } +{ loc - error location } +{ err - error number } + + +procedure MMQuit; extern; {in mm.pas} + +{ Dispose of memory allocated with private user IDs } + + +procedure ConsoleOutGS (var parms: consoleOutDCBGS); prodos ($015A); + +{---------------------------------------------------------------} + +procedure CheckGotoList; + +{ Make sure all labels have been defined } + +var + gt: gotoPtr; {work pointer} + msg: stringPtr; {work string} + +begin {CheckGotoList} +gt := gotoList; +while gt <> nil do begin + if not gt^.defined then begin + numErrors := numErrors+1; + new(msg); + msg^ := concat('Undefined label: ', gt^.name^); + writeln(msg^); + if terminalErrors then begin + if enterEditor then + ExitToEditor(msg, ord4(firstPtr)-ord4(bofPtr)) + else + TermError(0); + end; {if} + dispose(msg); + end; {if} + gt := gt^.next; + end; {while} +end; {CheckGotoList} + + +procedure ClearHourGlass; + +{ Erase the hourglass from the screen } + +var + coRec: consoleOutDCBGS; {Console out record} + +begin {ClearHourGlass} +coRec.pcount := 1; +coRec.ch := ' '; ConsoleOutGS(coRec); +coRec.ch := chr(8); ConsoleOutGS(coRec); +end; {ClearHourGlass} + + +procedure CopyLongString {toPtr, fromPtr: longStringPtr}; + +{ copy a long string } +{ } +{ parameters: } +{ toPtr - location to copy to } +{ fromPtr - location to copy from } + +var + i: integer; {loop variable} + +begin {CopyLongString} +toPtr^.length := fromPtr^.length; {set the length} +for i := 1 to fromPtr^.length do + toPtr^.str[i] := fromPtr^.str[i]; +end; {CopyLongString} + + +procedure DrawHourGlass; + +{ Draw the hourglass on the screen } + +var + coRec: consoleOutDCBGS; {Console out record} + +begin {DrawHourGlass} +coRec.pcount := 1; +coRec.ch := chr(27); ConsoleOutGS(coRec); +coRec.ch := chr(15); ConsoleOutGS(coRec); +coRec.ch := 'C'; ConsoleOutGS(coRec); +coRec.ch := chr(24); ConsoleOutGS(coRec); +coRec.ch := chr(14); ConsoleOutGS(coRec); +coRec.ch := chr(8); ConsoleOutGS(coRec); +end; {DrawHourGlass} + + +procedure ExitToEditor {msg: stringPtr; disp: longint}; + +{ do an error exit to the editor } +{ } +{ parameters: } +{ msg - pointer to the error message } +{ disp - displacement into the error file } +{ } +{ variables: } +{ includeFile - source file name } + +var + msgGS: gsosInString; {message} + +begin {ExitToEditor} +msgGS.size := length(msg^); {set up the error message} +msgGS.theString := msg^; +liDCBGS.org := disp; {mark the error} +liDCBGS.namesList := @msgGS; +liDCBGS.lops := 0; {prevent re-entry} +liDCBGS.merrf := 255; +with liDCBGS do begin + sFile := pointer(ord4(sFile)+2); + dFile := pointer(ord4(dFile)+2); + iString := pointer(ord4(iString)+2); + end; {with} +SetLInfoGS(liDCBGS); +StopSpin; {stop the spinner} +MMQuit; {dispose of the memory pools} +halt(-1); {return to the shell} +end; {ExitToEditor} + + +function GenLabel{: integer}; + +{ generate the next local label, checking for too many } + +begin {GenLabel} +if intLabel < maxLabel then + intLabel := intLabel+1 +else begin + intLabel := 0; + Error(58); + end; +GenLabel := intLabel; +end; {GenLabel} + + +function GetLocalLabel{: integer}; + +{ get the next local label number } + +begin {GetLocalLabel} +GetLocalLabel := nextLocalLabel; +nextLocalLabel := nextLocalLabel+1; +end; {GetLocalLabel} + + +procedure InitCCommon; + +{ Initialize this module } + +begin {InitCCommon} +spinning := false; {not spinning the spinner} +spinDisp := 0; {start spinning with the first character} +spinner[0] := '|'; {set up the spinner characters} +spinner[1] := '/'; +spinner[2] := '-'; +spinner[3] := '\'; +end; {InitCCommon} + + +procedure ReadFile; + +{ read a file } +{ } +{ variables: } +{ bofPtr - pointer to the start of the file } +{ ffDCB.file_length - length of the file } +{ includeFile - source file name } + +const + SRC = $B0; {source file type} + +begin {ReadFile} +with ffDCBGS do begin {read the source file} + pCount := 14; + action := 0; + flags := $C000; + pathName := @includeFileGS.theString; + end; {with} +FastFileGS(ffDCBGS); +if ToolError <> 0 then begin + sourceFileGS := includeFileGS; + includeFileGS := oldincludeFileGS; + TermError(1); + end; {if} +if ffDCBGS.fileType <> SRC then begin + includeFileGS := oldincludeFileGS; + TermError(6); + end; {if} +bofPtr := ffDCBGS.fileHandle^; {set beginning of file pointer} +end; {ReadFile} + + +procedure Spin; + +{ Spin the spinner } +{ } +{ Notes: Starts the spinner if it is not already in use } + +var + coRec: consoleOutDCBGS; {Console out record} + +begin {Spin} +if not spinning then begin + spinning := true; + spinCount := spinSpeed; + end; {if} +spinCount := spinCount - 1; +if spinCount = 0 then begin + spinCount := spinSpeed; + spinDisp := spinDisp - 1; + if spinDisp < 0 then + spinDisp := 3; + coRec.pcount := 1; + coRec.ch := spinner[spinDisp]; + ConsoleOutGS(coRec); + coRec.ch := chr(8); + ConsoleOutGS(coRec); + end; {if} +end; {Spin} + + +procedure StopSpin; + +{ Stop the spinner } +{ } +{ Notes: The call is safe, and ignored, if the spinner is } +{ inactive. } + +var + coRec: consoleOutDCBGS; {Console out record} + +begin {StopSpin} +if spinning then begin + spinning := false; + coRec.pcount := 1; + coRec.ch := ' '; + ConsoleOutGS(coRec); + coRec.ch := chr(8); + ConsoleOutGS(coRec); + end; {if} +end; {StopSpin} + + +procedure SystemError {errNo: integer}; + +{ intercept run time compiler errors } + +begin {SystemError} +if errNo = 5 then + TermError(5) +else + TermError(3); +end; {SystemError} + + +procedure TermError {errnum: integer}; + +{ flag a terminal error } + +var + msg: pString; {terminal error message} + +begin {TermError} +case errnum of {print the error} + 0 : ; + 1 : msg := concat('Error reading ', sourceFileGS.theString.theString); + 2 : msg := concat('Error purging ', sourceFileGS.theString.theString); + 3 : msg := 'terminal compiler error'; + 4 : msg := 'user termination'; + 5 : msg := 'out of memory'; + 6 : msg := 'source files must have a file type of SRC'; + 7 : msg := 'you cannot change languages with an include directive'; + 8 : msg := 'you cannot change languages from an included file'; + 9 : msg := concat('Error writing ', objFile.theString.theString); + 10: msg := 'ORCA/C requires version 2.0 or later of the shell'; + 11: msg := 'The program is too large to compile to memory -- use Compile to Disk'; + otherwise: Error(57); + end; {case} +with ffDCBGS do begin {purge the source file} + pCount := 5; + action := 7; + pathName := @includeFileGS.theString; + end; {with} +FastFileGS(ffDCBGS); +writeln('Terminal error: ', msg); {write the error to stdout} +if enterEditor then {error exit to editor} + ExitToEditor(@msg, ord4(chPtr) - ord4(bofPtr)) +else begin + liDCBGS.lops := 0; {prevent re-entry} + liDCBGS.merrf := 127; + with liDCBGS do begin + sFile := pointer(ord4(sFile)+2); + dFile := pointer(ord4(dFile)+2); + namesList := pointer(ord4(namesList)+2); + iString := pointer(ord4(iString)+2); + end; {with} + SetLInfoGS(liDCBGS); + StopSpin; {stop the spinner} + MMQuit; {dispose of the memory pools} + halt(-1); {return to the shell} + end; {else} +end; {TermError} + +end. + +{$append 'ccommon.asm'} diff --git a/CGC.asm b/CGC.asm old mode 100755 new mode 100644 index 7e5043f..890a4b3 --- a/CGC.asm +++ b/CGC.asm @@ -1 +1,115 @@ - mcopy cgc.macros **************************************************************** * * CnvSX - Convert floating point to SANE extended * * Inputs: * rec - pointer to a record * **************************************************************** * CnvSX start rec equ 4 record containing values rec_real equ 0 disp to real value rec_ext equ 8 disp to extended (SANE) value tsc set up DP phd tcd ph4 rec push addr of real number clc push addr of SANE number lda rec adc #rec_ext tax lda rec+2 adc #0 pha phx fd2x convert TOS to extended move4 0,4 return pld pla pla rtl end **************************************************************** * * CnvSC - Convert floating point to SANE comp * * Inputs: * rec - pointer to a record * **************************************************************** * CnvSC start rec equ 4 record containing values rec_real equ 0 disp to real value rec_ext equ 8 disp to extended (SANE) value rec_cmp equ 18 disp to comp (SANE) value tsc set up DP phd tcd ph4 rec push addr of real number clc push addr of SANE number lda rec adc #rec_ext tax lda rec+2 adc #0 pha phx fd2x convert TOS to extended clc push addr of SANE number lda rec adc #rec_ext tax lda rec+2 adc #0 pha phx clc push addr of COMP number lda rec adc #rec_cmp tax lda rec+2 adc #0 pha phx fx2c convert TOS to extended move4 0,4 return pld pla pla rtl end **************************************************************** * * InitLabels - initialize the labels array * * Outputs: * labelTab - initialized * intLabel - initialized * **************************************************************** * InitLabels start maxLabel equ 2400 ! with labelTab[0] do begin lda #-1 val := -1; sta labelTab+6 sta labelTab+8 stz labelTab defined := false; stz labelTab+2 chain := nil; stz labelTab+4 ! end; {with} ldx #labelTab for i := 1 to maxLabel do ldy #labelTab+10 labelTab[i] := labelTab[0]; lda #maxLabel*10-1 mvn labelTab,labelTab stz intLabel intLabel := 0; rtl end \ No newline at end of file + mcopy cgc.macros +**************************************************************** +* +* CnvSX - Convert floating point to SANE extended +* +* Inputs: +* rec - pointer to a record +* +**************************************************************** +* +CnvSX start +rec equ 4 record containing values +rec_real equ 0 disp to real value +rec_ext equ 8 disp to extended (SANE) value + + tsc set up DP + phd + tcd + ph4 rec push addr of real number + clc push addr of SANE number + lda rec + adc #rec_ext + tax + lda rec+2 + adc #0 + pha + phx + fd2x convert TOS to extended + move4 0,4 return + pld + pla + pla + rtl + end + +**************************************************************** +* +* CnvSC - Convert floating point to SANE comp +* +* Inputs: +* rec - pointer to a record +* +**************************************************************** +* +CnvSC start +rec equ 4 record containing values +rec_real equ 0 disp to real value +rec_ext equ 8 disp to extended (SANE) value +rec_cmp equ 18 disp to comp (SANE) value + + tsc set up DP + phd + tcd + ph4 rec push addr of real number + clc push addr of SANE number + lda rec + adc #rec_ext + tax + lda rec+2 + adc #0 + pha + phx + fd2x convert TOS to extended + clc push addr of SANE number + lda rec + adc #rec_ext + tax + lda rec+2 + adc #0 + pha + phx + clc push addr of COMP number + lda rec + adc #rec_cmp + tax + lda rec+2 + adc #0 + pha + phx + fx2c convert TOS to extended + move4 0,4 return + pld + pla + pla + rtl + end + +**************************************************************** +* +* InitLabels - initialize the labels array +* +* Outputs: +* labelTab - initialized +* intLabel - initialized +* +**************************************************************** +* +InitLabels start +maxLabel equ 2400 + +! with labelTab[0] do begin + lda #-1 val := -1; + sta labelTab+6 + sta labelTab+8 + stz labelTab defined := false; + stz labelTab+2 chain := nil; + stz labelTab+4 +! end; {with} + ldx #labelTab for i := 1 to maxLabel do + ldy #labelTab+10 labelTab[i] := labelTab[0]; + lda #maxLabel*10-1 + mvn labelTab,labelTab + stz intLabel intLabel := 0; + rtl + end diff --git a/CGC.macros b/CGC.macros old mode 100755 new mode 100644 index cf7e582..2a32ccc --- a/CGC.macros +++ b/CGC.macros @@ -1 +1,188 @@ - macro &l move4 &m1,&m2 lclb &yistwo &l ~setm ~lda &m1 ~sta &m2 ~lda.h &m1 ~sta.h &m2 ~restm mend macro &l ph4 &n1 aif "&n1"="*",.f lclc &c &l anop &c amid &n1,1,1 aif "&c"="#",.d aif s:longa=1,.a rep #%00100000 .a aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 ldy #2 lda (&n1),y pha lda (&n1) pha ago .e .b aif "&c"<>"[",.c ldy #2 lda &n1,y pha lda &n1 pha ago .e .c aif "&c"<>"<",.c1 &n1 amid &n1,2,l:&n1-1 pei &n1+2 pei &n1 ago .e .c1 lda &n1+2 pha lda &n1 pha ago .e .d &n1 amid &n1,2,l:&n1-1 pea +(&n1)|-16 pea &n1 ago .f .e aif s:longa=1,.f sep #%00100000 .f mexit .g mnote "Missing closing '}'",16 mend macro &l ~lda &op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l lda &op mend macro &l ~lda.h &op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" lda &op mexit .d aif "&c"<>"#",.e &op amid "&op",2,l:&op-1 &op setc "#^&op" lda &op mexit .e lda 2+&op mend macro &l ~restm &l anop aif (&~la+&~li)=2,.i sep #32*(.not.&~la)+16*(.not.&~li) aif &~la,.h longa off .h aif &~li,.i longi off .i mend macro &l ~setm &l anop aif c:&~la,.b gblb &~la gblb &~li .b &~la setb s:longa &~li setb s:longi aif s:longa.and.s:longi,.a rep #32*(.not.&~la)+16*(.not.&~li) longa on longi on .a mend macro &l ~sta &op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l sta &op mend macro &l ~sta.h &op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" sta &op mexit .d sta 2+&op mend MACRO &LAB FD2X &LAB PEA $010E LDX #$090A JSL $E10000 MEND MACRO &LAB FX2C &LAB PEA $0510 LDX #$090A JSL $E10000 MEND \ No newline at end of file + macro +&l move4 &m1,&m2 + lclb &yistwo +&l ~setm + ~lda &m1 + ~sta &m2 + ~lda.h &m1 + ~sta.h &m2 + ~restm + mend + macro +&l ph4 &n1 + aif "&n1"="*",.f + lclc &c +&l anop +&c amid &n1,1,1 + aif "&c"="#",.d + aif s:longa=1,.a + rep #%00100000 +.a + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + ldy #2 + lda (&n1),y + pha + lda (&n1) + pha + ago .e +.b + aif "&c"<>"[",.c + ldy #2 + lda &n1,y + pha + lda &n1 + pha + ago .e +.c + aif "&c"<>"<",.c1 +&n1 amid &n1,2,l:&n1-1 + pei &n1+2 + pei &n1 + ago .e +.c1 + lda &n1+2 + pha + lda &n1 + pha + ago .e +.d +&n1 amid &n1,2,l:&n1-1 + pea +(&n1)|-16 + pea &n1 + ago .f +.e + aif s:longa=1,.f + sep #%00100000 +.f + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l ~lda &op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l lda &op + mend + macro +&l ~lda.h &op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + lda &op + mexit +.d + aif "&c"<>"#",.e +&op amid "&op",2,l:&op-1 +&op setc "#^&op" + lda &op + mexit +.e + lda 2+&op + mend + macro +&l ~restm +&l anop + aif (&~la+&~li)=2,.i + sep #32*(.not.&~la)+16*(.not.&~li) + aif &~la,.h + longa off +.h + aif &~li,.i + longi off +.i + mend + macro +&l ~setm +&l anop + aif c:&~la,.b + gblb &~la + gblb &~li +.b +&~la setb s:longa +&~li setb s:longi + aif s:longa.and.s:longi,.a + rep #32*(.not.&~la)+16*(.not.&~li) + longa on + longi on +.a + mend + macro +&l ~sta &op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l sta &op + mend + macro +&l ~sta.h &op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + sta &op + mexit +.d + sta 2+&op + mend + MACRO +&LAB FD2X +&LAB PEA $010E + LDX #$090A + JSL $E10000 + MEND + MACRO +&LAB FX2C +&LAB PEA $0510 + LDX #$090A + JSL $E10000 + MEND diff --git a/CGC.pas b/CGC.pas old mode 100755 new mode 100644 index 2428523..89f9e82 --- a/CGC.pas +++ b/CGC.pas @@ -1 +1,124 @@ -{$optimize 7} {---------------------------------------------------------------} { } { ORCA Code Generator Common } { } { This unit contains the command constants, types, } { variables and procedures used throughout the code } { generator, but which are not available to the compiler. } { } {---------------------------------------------------------------} { } { These routines are defined in the compiler, but used from } { the code generator. } { } { Error - flag an error } { CMalloc - Clear and allocate memory from a pool. } { Malloc - Allocate memory from a pool. } { } {---------------------------------------------------------------} unit CGC; interface {$LibPrefix '0/obj/'} uses CCommon, CGI; {$segment 'cg'} type {pcode code generation} {---------------------} realrec = record {used to convert from real to in-SANE} itsReal: double; inSANE: packed array[1..10] of byte; inCOMP: packed array[1..8] of byte; end; var {msc} {---} blkcnt: integer; {number of bytes in current segment} {buffers} {-------} cbufflen: 0..maxcbuff; {number of bytes now in cbuff} segDisp: integer; {disp in the current segment} {-- Global subroutines -----------------------------------------} procedure CnvSC (rec: realrec); extern; { convert a real number to SANE comp format } { } { parameters: } { rec - record containing the value to convert; also } { has space for the result } procedure CnvSX (rec: realrec); extern; { convert a real number to SANE extended format } { } { parameters: } { rec - record containing the value to convert; also } { has space for the result } procedure InitLabels; extern; { initialize the labels array for a procedure } { } { Note: also defined in CGI.pas } {-- These routines are defined in the compiler, but used from cg --} function Calloc (bytes: integer): ptr; extern; { Allocate memory from a pool and clear it. } { } { Parameters: } { bytes - number of bytes to allocate } { ptr - points to the first byte of the allocated memory } { } { Globals: } { useGlobalPool - should the memory come from the global } { (or local) pool } procedure Error (err: integer); extern; { flag an error } { } { err - error number } {procedure Error2 (loc, err: integer); extern; {debug} {in scanner.pas} { flag an error } { } { loc - error location } { err - error number } function Malloc (bytes: integer): ptr; extern; { Allocate memory from a pool. } { } { Parameters: } { bytes - number of bytes to allocate } { ptr - points to the first byte of the allocated memory } { } { Globals: } { useGlobalPool - should the memory come from the global } { (or local) pool } {---------------------------------------------------------------} implementation end. {$append 'CGC.asm'} \ No newline at end of file +{$optimize 7} +{---------------------------------------------------------------} +{ } +{ ORCA Code Generator Common } +{ } +{ This unit contains the command constants, types, } +{ variables and procedures used throughout the code } +{ generator, but which are not available to the compiler. } +{ } +{---------------------------------------------------------------} +{ } +{ These routines are defined in the compiler, but used from } +{ the code generator. } +{ } +{ Error - flag an error } +{ CMalloc - Clear and allocate memory from a pool. } +{ Malloc - Allocate memory from a pool. } +{ } +{---------------------------------------------------------------} + +unit CGC; + +interface + +{$LibPrefix '0/obj/'} + +uses CCommon, CGI; + +{$segment 'cg'} + +type + {pcode code generation} + {---------------------} + realrec = record {used to convert from real to in-SANE} + itsReal: double; + inSANE: packed array[1..10] of byte; + inCOMP: packed array[1..8] of byte; + end; + +var + {msc} + {---} + blkcnt: integer; {number of bytes in current segment} + + {buffers} + {-------} + cbufflen: 0..maxcbuff; {number of bytes now in cbuff} + segDisp: integer; {disp in the current segment} + +{-- Global subroutines -----------------------------------------} + +procedure CnvSC (rec: realrec); extern; + +{ convert a real number to SANE comp format } +{ } +{ parameters: } +{ rec - record containing the value to convert; also } +{ has space for the result } + + +procedure CnvSX (rec: realrec); extern; + +{ convert a real number to SANE extended format } +{ } +{ parameters: } +{ rec - record containing the value to convert; also } +{ has space for the result } + + +procedure InitLabels; extern; + +{ initialize the labels array for a procedure } +{ } +{ Note: also defined in CGI.pas } + +{-- These routines are defined in the compiler, but used from cg --} + +function Calloc (bytes: integer): ptr; extern; + +{ Allocate memory from a pool and clear it. } +{ } +{ Parameters: } +{ bytes - number of bytes to allocate } +{ ptr - points to the first byte of the allocated memory } +{ } +{ Globals: } +{ useGlobalPool - should the memory come from the global } +{ (or local) pool } + + +procedure Error (err: integer); extern; + +{ flag an error } +{ } +{ err - error number } + + +{procedure Error2 (loc, err: integer); extern; {debug} {in scanner.pas} + +{ flag an error } +{ } +{ loc - error location } +{ err - error number } + + +function Malloc (bytes: integer): ptr; extern; + +{ Allocate memory from a pool. } +{ } +{ Parameters: } +{ bytes - number of bytes to allocate } +{ ptr - points to the first byte of the allocated memory } +{ } +{ Globals: } +{ useGlobalPool - should the memory come from the global } +{ (or local) pool } + +{---------------------------------------------------------------} + +implementation + +end. + +{$append 'CGC.asm'} diff --git a/CGI.Comments b/CGI.Comments old mode 100755 new mode 100644 index 44272e3..133ccf0 --- a/CGI.Comments +++ b/CGI.Comments @@ -1 +1,798 @@ -{-- Misc. pcodes -----------------------------------------------} { } { dc_cns - generate a constant value } { } { GenL1(dc_cns, lval, count); } { GenR1t(dc_cns, rval, count, type); } { Gen2t(dc_cns, ival, count, type); } { GenS(dc_cns, sptr); } { } { Creates COUNT occurrances of the constant lval, rval or } { ival, based on the type. In Gen2t can accept byte or word } { types. In the case of GenS, the operand is a string } { constant, and no repeat count is allowed. } { } { } { dc_glb - generate global label } { } { Gen2Name(dc_glb, r, q, lab) } { } { Creates a global label in the current segment with the name } { LAB^. If Q is 1, the label is marked as private to the } { current segment, otherwise it is marked as public. R bytes } { of space are reserved. } { } { } { dc_dst - generate global storage } { } { Gen1(dc_dst, q) } { } { Creates q bytes of storage (initialized to 0) at the } { current location. } { } { } { pc_lnm - line number } { } { Gen2(pc_lnm, lc, flag) } { } { Sets the current line number for the traceback facility and } { debugger. This p-code should only be generated after the } { pc_ent and pc_nam (if any), and should not be generated } { outside of a subroutine. Lc is the line number, while flag } { indicates the type of debugging action on this line: } { } { 0 - step/trace } { 1 - break point } { 2 - auto-go } { } { } { pc_mov - move memory } { } { Gen2(pc_mov, banks, bytes) } { } { The top of stack contains a source address, and TOS-1 has a } { destination address. The destination address is removed, } { and BYTES bytes are moved from the source to the } { destination. BANKS is the number of full banks to move; it } { is used when 64K or more must be moved. The memory areas } { must not overlap. } { } { } { pc_nam - subroutine name } { } { GenS(pc_nam, str) } { } { Sets the subroutine name for the traceback facility, } { debugger, and profiler. Str is a pointer to the subroutine } { name. The following global variables should be set to } { appropriate values when this p-code is used: } { } { debugFlag - are we generating debug code? } { profileFlag - are we profiling? } { traceBack - are we doing tracebacks? } { sourceFile - current source file name } { } { } { pc_nat - native code generation } { } { Gen0(pc_nat) } { } { Generate a native code instruction. The parameters are set } { in a special section in asm.pas. } { } { s - operation code } { q - operand value } { r - addressing mode } { lab - label name } { flags - shift flags } { } {-- Pcodes involved expressions --------------------------------} { } { pc_adi - integer addition } { pc_adl - long addition } { pc_adr - real addition } { } { Gen0(pc_adi) cgByte,cgUByte,cgWord,cgUWord } { Gen0(pc_adl) cgLong,cgULong } { Gen0(pc_adr) cgReal,cgDouble,cgComp,cgExtended } { } { The two values on the top of the evaluation stack are } { removed and added. The result is placed back on the stack. } { } { } { pc_and - logical and } { pc_lnd - long logical and } { } { Gen0(pc_and) cgByte,cgUByte,cgWord,cgUWord } { Gen0(pc_lnd) cgLong,cgULong } { } { The two values on the top of the evaluation stack are } { removed and anded. The result is placed back on the stack. } { Zero is treated as false, and any other value as true. The } { and is a logical and. See pc_bnd for a bitwise and. } { } { If the first operand is false, the second operand is not } { evaluated. } { } { } { pc_bnd - bitwise and } { pc_bal - long bitwise and } { } { Gen0(pc_bnd) cgByte,cgUByte,cgWord,cgUWord } { Gen0(pc_bal) cgLong,cgULong } { } { The two values on the top of the evaluation stack are } { removed and anded. The result is placed back on the stack. } { } { } { pc_bno - binary operand no-operation } { } { Gen0t(pc_bno, type) } { } { The left operand is evaluated and discarded, followed by } { the evaluation of the right operand. The type is the type } { of the right operand; it is used in case a pc_pop is } { attached to remove a result left on the stack. This } { instruction is used by C for the comma operator and for } { parameter lists for function and procedure calls, and by } { pc_tri to hold the two expressions. } { } { } { pc_bnt - bitwise negation } { pc_bnl - long bitwise negation } { } { Gen0(pc_bnt) cgByte,cgUByte,cgWord,cgUWord } { Gen0(pc_bnl) cgLong,cgULong } { } { The value on the top of the evaluation stack is removed, } { exclusive ored with $FFFF, and replaced. (One's compliment.)} { } { } { pc_bor - bitwise or } { pc_blr - long bitwise or } { } { Gen0(pc_bor) cgByte,cgUByte,cgWord,cgUWord } { Gen0(pc_blr) cgLong,cgULong } { } { The two values on the top of the evaluation stack are } { removed and ored. The result is placed back on the stack. } { } { } { pc_bxr - exclusive or } { pc_blx - long exclusive or } { } { Gen0(pc_bxr) cgByte,cgUByte,cgWord,cgUWord } { Gen0(pc_blx) cgLong,cgULong } { } { The two values on the top of the evaluation stack are } { removed and exclusive ored. The result is placed back on } { the stack. } { } { } { pc_cbf - copy bit field } { } { Gen2t(pc_cbf, disp, size, type) } { } { An integer is removed from the top of the evaluation stack } { and saved at the address on the evaluation stack. The } { address is removed, but the integer remains intact. The } { value is saved DISP bits past the address, and is treated as } { a SIZE bit value. Extra bits are dropped. } { } { } { pc_cop - copy to a local variable } { } { Gen2t(pc_cop, label, disp, type) } { } { Saves the value on the top of the evaluation stack to DISP } { bytes past the local label LABEL. TYPE is the type of the } { value being saved. } { } { } { pc_cnv - convert from one scalar type to another } { pc_cnn - convert from one scalar type to another } { } { Gen2(pc_cnv, from, to) } { Gen2(pc_cnn, from, to) } { } { Converts from one scalar type to another. The from and to } { parameters are ordinal values of type baseTypeEnum. The } { table below shows what from values (along the left edge) and } { to values (along the top) are allowed, and what action is } { taken for each combination. CgDouble, cgComp or cgExtended } { may be used anywhere that cgReal is used, with the same } { results. } { } { The pc_cnn form converts the value at tos-1. The value at } { tos is assumed to be the same size as the result type. } { } { cgByte cgUByte cgWord cgUWord cgLong cgULong cgReal } { cgByte extend extend float } { cgUByte padd padd float } { cgWord extend extend float } { cgUWord extend extend float } { cgLong discard discard discard discard float } { cgULong discard discard discard discard float } { cgReal trunc trunc trunc trunc trunc trunc } { } { The meaning of the operationd shown in the table is: } { } { (blank) No action is taken, but the instruction is } { accepted by the code generator. } { extend The value is sign extended to the proper length.} { padd The value is padded on the left with zero bits } { to extend it to the proper length. } { discard Extra bits are discarded to reach the proper } { length, starting with the most significant bit. } { float An integer value is converted to a real value. } { trunc A real value is converted to the largest } { integer value that is less than or equal to the } { real value. } { } { } { pc_cpi - copy indirect } { } { Gen0t(pc_cpi, type) } { } { Two values are removed from the evaluation stack. The first } { is of type TYPE, while the second is a pointer. The first } { value is stored at the location pointed to by the pointer. } { The value is then placed back on the stack. } { } { } { pc_cpo - copy to a global variable } { } { Gen1tName (pc_cpo, disp, type, name) } { } { Saves the value on the top of the evaluation stack to the } { global label NAME. DISP is a fixed displacement past the } { names label to load from. (Used for records.) TYPE is } { the type of the value being loaded. } { } { } { pc_dec - decrement } { } { Gen1t(pc_dec, val, type) } { } { The value on the top of the stack is removed, decremented by } { VAL and returned to the stack. Type may be cgByte, cgUByte, } { cgWord, cgUWord, cgLong or cgULong. In all cases, the } { amount to decrement by is a positive signed integer. } { } { } { pc_dvi - integer divide } { pc_udi - unsigned integer divide } { pc_dvl - long integer divide } { pc_udl - unsigned long divide } { pc_dvr - real divide } { } { Gen0(pc_dvi) cgByte,cgWord } { Gen0(pc_udi) cgUByte,cgUWord } { Gen0(pc_dvl) cgLong } { Gen0(pc_udl) cgULong } { Gen0(pc_dvr) cgReal,cgDouble,cgComp,cgExtended } { } { The two values on the top of the evaluation stack are } { removed and divided. The result is placed back on the } { stack. The result type is the same as the argument type. } { } { } { pc_equ,pc_geq,pc_grt,pc_leq,pc_les,pc_neq - compares } { } { Gen0t(pc_equ, type) } { } { The two values on the top of the evaluation stack are } { removed and compared. A boolean result is placed back on } { the stack. } { } { } { pc_gil - increment and load from a global variable } { pc_gli - load a global variable, then inc the original } { pc_gdl - decrement and load from a global variable } { pc_gld - load a global variable, then dec the original } { } { Gen2tName (pc_gli, inc, disp, type, name) } { } { Loads a value from the global label NAME and places it on } { the evaluation stack. DISP is a fixed displacement past the } { names label to load from. (Used for records.) TYPE is } { the type of the value being loaded. } { } { In addition to loading the value, these instructions also } { increment or decrement the value, as indicated in the } { comment by the instruction name. The operand is incremented } { or decremented by INC. INC must be 1 for one and two byte } { operands. } { } { } { pc_iil - increment and load indirect } { pc_ili - load indirect, then inc the original } { pc_idl - decrement and load indirect } { pc_ild - load indirect, then dec the original } { } { Gen0t (pc_ili, type) } { } { Loads a value from the indirect address on the top of the } { stack, performing either an increment or decrement in the } { process. TYPE may be cgByte, cgUByte, cgWord or cgUWord. } { } { } { pc_inc - increment } { } { Gen1t(pc_inc, val, type) } { } { The value on the top of the stack is removed, incremented by } { VAL and returned to the stack. Type may be cgByte, cgUByte, } { cgWord, cgUWord, cgLong or cgULong. In all cases, the } { amount to increment by is a positive signed integer. } { } { } { pc_ind - load indirect } { } { Gen1t (pc_ind, disp, type) } { } { A value of type TYPE is loaded from DISP bytes past the } { address that is on the evaluation stack. The address is } { removed from the stack and replaced with the value. } { } { } { pc_ior - logical or } { pc_lor - long logical or } { } { Gen0(pc_ior) cgByte,cgUByte,cgWord,cgUWord } { Gen0(pc_lor) cgLong,cgULong } { } { The two values on the top of the evaluation stack are } { removed and ored. The result is placed back on the stack. } { Zero is treated as false, and any other value as true. The } { or is a logical or. See pc_bor for a bitwise or. } { } { } { pc_ixa - integer indexed address } { } { Gen0t(pc_ixa, type) } { } { TOS is an integer, which is added to TOS-1, which is a long } { integer. This instruction is generally used for computing } { short array indexes. } { } { TYPE can be cgWord or cgUWord; the type indicates whether } { the addition is signed or unsigned. } { } { } { pc_lad - load the address of a subroutine } { } { Gen0Name(pc_lad, name); } { } { Loads the address of the subroutine NAME. } { } { } { pc_lao - load a global address } { } { Gen1Name(pc_lao, disp, name); } { } { Loads the address of DISP bytes past the global variable } { NAME onto the stack. } { } { } { pc_lbf - load bit field } { pc_lbu - load unsigned bit field } { } { Gen2t(pc_lbf, disp, size, type) } { Gen2t(pc_lbu, disp, size, type) } { } { A bit field SIZE bits wide is loaded from DISP bits past the } { address on the top of the evaluation stack. The address is } { removed from the evaluation stack in the process. pc_lbf } { loads a signed value, while pc_lbu loads an unsigned value. } { } { } { pc_lca - load a string constant address } { } { GenS(pc_lca, str) } { } { Loads the address of a string onto the stack. Str is a } { pointer to a string constant. } { } { } { pc_lda - load a local address } { } { Gen2(pc_lda, label, disp) } { } { Loads the address of DISP bytes past the local label LABEL. } { } { } { pc_ldc - load a constant } { } { Gen1t(pc_ldc, val, type) } { GenLdcLong(val) } { GenLdcReal(val) } { } { Loads a constant value. Special calls for long and real } { values are provided due to the unique parameter requirements.} { } { } { pc_ldo - load from a global variable } { } { Gen1tName (pc_ldo, disp, type, name) } { } { Loads a value from the global label NAME and places it on } { the evaluation stack. DISP is a fixed displacement past the } { names label to load from. (Used for records.) TYPE is } { the type of the value being loaded. } { } { } { pc_lil - increment and load from a local variable } { pc_lli - load a local variable, then inc the original } { pc_ldl - decrement and load from a local variable } { pc_lld - load a local variable, then dec the original } { } { Gen2t(pc_lli, label, inc, type) } { } { Loads a value from the local label LABEL and places it on } { the evaluation stack. TYPE is the type of the value being } { loaded. INC is the number to increment or decrement by. } { } { In addition to loading the value, these instructions also } { increment or decrement the value, as indicated in the } { comment by the instruction name. The operand is incremented } { or decremented by INC. INC must be 1 for one and two byte } { operands. } { } { } { pc_lod - load from a local variable } { } { Gen2t(pc_lod, label, disp, type) } { } { Loads a value from DISP bytes past the local label LABEL and } { places it on the evaluation stack. TYPE is the type is the } { value being loaded. } { } { } { pc_mod - integer modulus } { pc_uim - unsigned integer modulus } { pc_mdl - long modulus } { pc_ulm - unsigned long modulus } { } { Gen0(pc_mod) cgByte,cgWord } { Gen0(pc_uim) cgUByte,cgUWord } { Gen0(pc_mdl) cgLong } { Gen0(pc_ulm) cgULong } { } { The two values on the top of the evaluation stack are } { removed and a molulus operation is performed. The result is } { placed back on the stack. The result, like the arguments, } { is an integer. } { } { } { pc_mpi - integer multiply } { pc_umi - unsigned integer multiply } { pc_mpl - long integer multiply } { pc_uml - unsigned long multiply } { pc_mpr - real multiply } { } { Gen0(pc_mpi) cgByte,cgWord } { Gen0(pc_umi) cgUByte,cgUWord } { Gen0(pc_mpl) cgLong } { Gen0(pc_uml) cgULong } { Gen0(pc_mpr) cgReal,cgDouble,cgComp,cgExtended } { } { The two values on the top of the evaluation stack are } { removed and multiplied. The result is placed back on the } { stack. The result type is the same as the argument type. } { } { } { pc_ngi - integer negation } { pc_ngl - long negation } { pc_ngr - real negation } { } { Gen0(pc_ngi) cgByte,cgUByte,cgWord,cgUWord } { Gen0(pc_ngl) cgLong,cgULong } { Gen0(pc_ngr) cgReal,cgDouble,cgComp,cgExtended } { } { The value on the top of the evaluation stack is removed, } { subtracted from 0, and replaced. (Two's compliment.) } { } { } { Gen0(pc_nop) } { } { This operand is a leaf node. It does nothing. It is used } { to create a null expression tree for functions and } { procedures that have no parameters. } { } { } { pc_not - logical negation } { } { Gen0(pc_not) } { } { The value on the top of the evaluation stack is removed, } { logically negated, and replaced. } { } { } { pc_pop - pop a value from the stack } { } { Gen0t(pc_pop, type) } { } { The value on the top of the evaluation stack is removed. } { } { } { pc_psh - push bytes on the stack } { } { Gen0(pc_psh) } { } { Removes the size (a word) and the source address (a long) } { from the evaluation stack, and pushes size bytes from the } { source address onto the stack. } { } { } { pc_sbf - save bit field } { } { Gen2t(pc_sbf, disp, size, type) } { } { An integer is removed from the top of the evaluation stack } { and saved at the address on the evaluation stack. The } { value is saved DISP bits past the address, and is treated as } { a SIZE bit value. Extra bits are dropped. } { } { } { pc_sbi - integer subtraction } { pc_sbl - long subtraction } { pc_sbr - real subtraction } { } { Gen0(pc_sbi) cgByte,cgUByte,cgWord,cgUWord } { Gen0(pc_sbl) cgLong,cgULong } { Gen0(pc_sbr) cgReal,cgDouble,cgComp,cgExtended } { } { The two values on the top of the evaluation stack are } { removed. TOS-1 - TOS is placed back on the stack. } { } { } { pc_shl - shift left } { pc_sll - shift left long } { } { Gen0(pc_shl) cgByte,cgUByte,cgWord,cgUWord } { Gen0(pc_sll) cgLong,cgULong } { } { The value at tos-1 is shifted left by the number of bits } { specified by tos. The result is an integer, which replaces } { the operands on the stack. The right bit positions are } { filled with zeros. } { } { } { pc_shr - shift right } { pc_usr - unsigned shift right } { pc_slr - long shift right } { pc_vsr - unsigned long shift right } { } { Gen0(pc_shr) cgByte,cgWord } { Gen0(pc_usr) cgUByte,cgUWord } { Gen0(pc_slr) cgLong } { Gen0(pc_vsr) cgULong } { } { The value at tos-1 is shifted right by the number of bits } { specified by tos. The result is an integer, which replaces } { the operands on the stack. This is a signed shift: the } { leftmost bit position is filled in with a copy of the } { orignial leftmost bit. } { } { Pc_usr is the unsigned form. The operation is the same, } { except that the leftmost bit is replaced with a zero. } { Pc_vsr is used for unsigned long operations. } { } { pc_stk - stack an operand } { } { Gen0t(pc_stk, type) } { } { The value on top of the evaluation stack is to be left there } { as a parameter to a subsequent procedure or function call. } { This p-code "caps" the expression tree, giving the code } { generator something to do with the expression result. } { } { } { pc_sro - store to a global variable } { } { Gen1tName (pc_sro, disp, type, name) } { } { Saves the value from the top of the evaluation stack to the } { global label NAME. DISP is a fixed displacement past the } { names label to load from. (Used for records.) TYPE is } { the type of the value being loaded. } { } { } { pc_sto - store indirect } { } { Gen0t(pc_sto, type) } { } { Two values are removed from the evaluation stack. TOS is of } { type TYPE, while TOS-1 is a pointer. The value is stored at } { the location pointed to by the pointer. } { } { } { pc_str - store to a local variable } { } { Gen2t(pc_str, label, disp, type) } { } { Saves the value on the top of the evaluation stack to DISP } { bytes past the local label LABEL. TYPE is the type of the } { value being saved. } { } { } { pc_tri - C trinary operator } { } { Gen0t(pc_tri, type) } { } { Implements the C trinary operator. TOS is the false } { expression, TOS-1 the true expression, and TOS-2 the } { condition expression. The condition expression is } { evaluated. If it is non-zero, the true expression is } { evaluated. If it is zero, the false expression is } { evaluated. The result type of the true and false } { expressions must be the same. } { } { Internally, pc_bno is used for the right operand; the } { operands for pc_bno are the two expressions. } { } {-- Flow of control --------------------------------------------} { } { dc_lab - define a label } { } { Gen1(pc_lab, lab) } { } { Defines label number lab at the current location. } { } { } { pc_add - address } { } { Gen1(pc_add, lab) } { } { Generates a two-byte address that points to the label lab. } { This is used to create branch tables for pc_xjp } { instructions. } { } { } { pc_fjp - jump if false } { } { Gen1(pc_fjp, lab) } { } { A boolean value is removed from the top of the evaluation } { stack. If the value is false, execution continues with the } { instruction after the label lab; otherwise execution } { continues with the instruction after this one. } { } { } { pc_tjp - jump if true } { } { Gen1(pc_tjp, lab) } { } { A boolean value is removed from the top of the evaluation } { stack. If the value is true, execution continues with the } { instruction after the label lab; otherwise execution } { continues with the instruction after this one. } { } { } { pc_ujp - jump } { } { Gen1(pc_ujp, lab) } { } { Execution continues with the instruction after the label lab.} { } { } { pc_xjp - indexed jump } { } { Gen1(pc_xjp, val) } { } { The top of stack contains an integer, which is removed. If } { it is less than zero or greater than VAL, it is replaced by } { VAL. The result is then used to index into a jump table, } { formed using pc_add instructions, which follows immediately } { after the pc_xjp instruction. } { } {-- Pcodes involved with calling and defining procedures -------} { } { dc_str - start a segment } { } { Gen2Name(dc_str, p1, p2, name) } { } { Starts a new object segment with the name name^. P1 is the } { segment kind, while p2 is the length code (1 for data, 0 for } { code segments). } { } { } { dc_pin - procedure entry point } { } { Gen0(dc_pin) } { } { A code segment does not have to be entered at the first byte } { when called. This directive is used one time in each code } { segment to indicate the actual entry point. } { } { } { dc_enp - end a segment } { } { Gen0(dc_enp) } { } { This directive closes the current segment. } { } { } { pc_ent - enter a subroutine } { } { Gen0(pc_ent) } { } { This pcode is used at the beginning of every subroutine. It } { marks the beginning of a new stack frame definition. } { Subsequent dc_loc and dc_prm cause space to be allocated } { from this stack frame. } { } { } { pc_ret - return from a subroutine } { } { Gen0t(pc_ret, type) } { } { This pcode is used to return from a function or a procedure. } { The type is the type of the function, and is used to tell } { the code generator what type of value to return. The value } { to return is assumed to be stored defaultStackSize bytes } { into the stack frame. } { } { } { pc_cui - call user procedure, indirect } { } { Gen1t(pc_cui, repair, ftype) } { } { Calls a user procedure or function through the address on } { the top of the evaluation stack. FTYPE is the return type. } { Repair is 1 if stack repair should be forced, and 0 if not. } { } { } { pc_cup - call user procedure } { } { Gen1tName(pc_cup, repair, name, ftype) } { } { Calls a user procedure or function. Ftype is the type. } { Repair is 1 if stack repair should be forced, and 0 if not. } { NAME is the name of the procedure. } { } { } { dc_loc - define local label } { } { Gen2(dc_loc, label, size) } { } { Defines a local label using the label parameter as a label } { number. Size bytes are reserved on the stack frame. Label } { numbers should be assigned by the compiler, starting with } { number 1. Label 0 is reserved for refering to the return } { value of a function (if any). } { } { } { dc_prm - define parameter } { } { Gen3(dc_prm, label, size, disp) } { } { Defines a label used to refer to a parameter. See dc_loc } { for a discussion of the label and size parameters. The disp } { parameter is the number of bytes of parameter that will be } { pushed after this one; i.e., the disp from the return addr } { to this parameter. } { } { } { pc_tl1 - call a tool } { } { GenTool(pc_tl1, toolNum, retSize, dispatcher) } { } { Calls a tool. The tool number is toolNum; the tool is } { called at location dispatcher. The tool returns a result } { that is retSize bytes long. } { } { } { dc_sym - generate a symbol table } { } { Gen1Name(dc_sym, doGLobals, pointer(table) } { } { Generates a symbol table for the debugger. TABLE is the } { address of the sybol table, which will be passed back to a } { subroutine called GenSymbols, which must be supplied by the } { compiler. DOGLOBALS is a flag the compiler can set for its } { own purposes. C uses the flag to note that the symbol } { table being created is for main, so global symbols should be } { included. } { } \ No newline at end of file +{-- Misc. pcodes -----------------------------------------------} +{ } +{ dc_cns - generate a constant value } +{ } +{ GenL1(dc_cns, lval, count); } +{ GenR1t(dc_cns, rval, count, type); } +{ Gen2t(dc_cns, ival, count, type); } +{ GenS(dc_cns, sptr); } +{ } +{ Creates COUNT occurrances of the constant lval, rval or } +{ ival, based on the type. In Gen2t can accept byte or word } +{ types. In the case of GenS, the operand is a string } +{ constant, and no repeat count is allowed. } +{ } +{ } +{ dc_glb - generate global label } +{ } +{ Gen2Name(dc_glb, r, q, lab) } +{ } +{ Creates a global label in the current segment with the name } +{ LAB^. If Q is 1, the label is marked as private to the } +{ current segment, otherwise it is marked as public. R bytes } +{ of space are reserved. } +{ } +{ } +{ dc_dst - generate global storage } +{ } +{ Gen1(dc_dst, q) } +{ } +{ Creates q bytes of storage (initialized to 0) at the } +{ current location. } +{ } +{ } +{ pc_lnm - line number } +{ } +{ Gen2(pc_lnm, lc, flag) } +{ } +{ Sets the current line number for the traceback facility and } +{ debugger. This p-code should only be generated after the } +{ pc_ent and pc_nam (if any), and should not be generated } +{ outside of a subroutine. Lc is the line number, while flag } +{ indicates the type of debugging action on this line: } +{ } +{ 0 - step/trace } +{ 1 - break point } +{ 2 - auto-go } +{ } +{ } +{ pc_mov - move memory } +{ } +{ Gen2(pc_mov, banks, bytes) } +{ } +{ The top of stack contains a source address, and TOS-1 has a } +{ destination address. The destination address is removed, } +{ and BYTES bytes are moved from the source to the } +{ destination. BANKS is the number of full banks to move; it } +{ is used when 64K or more must be moved. The memory areas } +{ must not overlap. } +{ } +{ } +{ pc_nam - subroutine name } +{ } +{ GenS(pc_nam, str) } +{ } +{ Sets the subroutine name for the traceback facility, } +{ debugger, and profiler. Str is a pointer to the subroutine } +{ name. The following global variables should be set to } +{ appropriate values when this p-code is used: } +{ } +{ debugFlag - are we generating debug code? } +{ profileFlag - are we profiling? } +{ traceBack - are we doing tracebacks? } +{ sourceFile - current source file name } +{ } +{ } +{ pc_nat - native code generation } +{ } +{ Gen0(pc_nat) } +{ } +{ Generate a native code instruction. The parameters are set } +{ in a special section in asm.pas. } +{ } +{ s - operation code } +{ q - operand value } +{ r - addressing mode } +{ lab - label name } +{ flags - shift flags } +{ } +{-- Pcodes involved expressions --------------------------------} +{ } +{ pc_adi - integer addition } +{ pc_adl - long addition } +{ pc_adr - real addition } +{ } +{ Gen0(pc_adi) cgByte,cgUByte,cgWord,cgUWord } +{ Gen0(pc_adl) cgLong,cgULong } +{ Gen0(pc_adr) cgReal,cgDouble,cgComp,cgExtended } +{ } +{ The two values on the top of the evaluation stack are } +{ removed and added. The result is placed back on the stack. } +{ } +{ } +{ pc_and - logical and } +{ pc_lnd - long logical and } +{ } +{ Gen0(pc_and) cgByte,cgUByte,cgWord,cgUWord } +{ Gen0(pc_lnd) cgLong,cgULong } +{ } +{ The two values on the top of the evaluation stack are } +{ removed and anded. The result is placed back on the stack. } +{ Zero is treated as false, and any other value as true. The } +{ and is a logical and. See pc_bnd for a bitwise and. } +{ } +{ If the first operand is false, the second operand is not } +{ evaluated. } +{ } +{ } +{ pc_bnd - bitwise and } +{ pc_bal - long bitwise and } +{ } +{ Gen0(pc_bnd) cgByte,cgUByte,cgWord,cgUWord } +{ Gen0(pc_bal) cgLong,cgULong } +{ } +{ The two values on the top of the evaluation stack are } +{ removed and anded. The result is placed back on the stack. } +{ } +{ } +{ pc_bno - binary operand no-operation } +{ } +{ Gen0t(pc_bno, type) } +{ } +{ The left operand is evaluated and discarded, followed by } +{ the evaluation of the right operand. The type is the type } +{ of the right operand; it is used in case a pc_pop is } +{ attached to remove a result left on the stack. This } +{ instruction is used by C for the comma operator and for } +{ parameter lists for function and procedure calls, and by } +{ pc_tri to hold the two expressions. } +{ } +{ } +{ pc_bnt - bitwise negation } +{ pc_bnl - long bitwise negation } +{ } +{ Gen0(pc_bnt) cgByte,cgUByte,cgWord,cgUWord } +{ Gen0(pc_bnl) cgLong,cgULong } +{ } +{ The value on the top of the evaluation stack is removed, } +{ exclusive ored with $FFFF, and replaced. (One's compliment.)} +{ } +{ } +{ pc_bor - bitwise or } +{ pc_blr - long bitwise or } +{ } +{ Gen0(pc_bor) cgByte,cgUByte,cgWord,cgUWord } +{ Gen0(pc_blr) cgLong,cgULong } +{ } +{ The two values on the top of the evaluation stack are } +{ removed and ored. The result is placed back on the stack. } +{ } +{ } +{ pc_bxr - exclusive or } +{ pc_blx - long exclusive or } +{ } +{ Gen0(pc_bxr) cgByte,cgUByte,cgWord,cgUWord } +{ Gen0(pc_blx) cgLong,cgULong } +{ } +{ The two values on the top of the evaluation stack are } +{ removed and exclusive ored. The result is placed back on } +{ the stack. } +{ } +{ } +{ pc_cbf - copy bit field } +{ } +{ Gen2t(pc_cbf, disp, size, type) } +{ } +{ An integer is removed from the top of the evaluation stack } +{ and saved at the address on the evaluation stack. The } +{ address is removed, but the integer remains intact. The } +{ value is saved DISP bits past the address, and is treated as } +{ a SIZE bit value. Extra bits are dropped. } +{ } +{ } +{ pc_cop - copy to a local variable } +{ } +{ Gen2t(pc_cop, label, disp, type) } +{ } +{ Saves the value on the top of the evaluation stack to DISP } +{ bytes past the local label LABEL. TYPE is the type of the } +{ value being saved. } +{ } +{ } +{ pc_cnv - convert from one scalar type to another } +{ pc_cnn - convert from one scalar type to another } +{ } +{ Gen2(pc_cnv, from, to) } +{ Gen2(pc_cnn, from, to) } +{ } +{ Converts from one scalar type to another. The from and to } +{ parameters are ordinal values of type baseTypeEnum. The } +{ table below shows what from values (along the left edge) and } +{ to values (along the top) are allowed, and what action is } +{ taken for each combination. CgDouble, cgComp or cgExtended } +{ may be used anywhere that cgReal is used, with the same } +{ results. } +{ } +{ The pc_cnn form converts the value at tos-1. The value at } +{ tos is assumed to be the same size as the result type. } +{ } +{ cgByte cgUByte cgWord cgUWord cgLong cgULong cgReal } +{ cgByte extend extend float } +{ cgUByte padd padd float } +{ cgWord extend extend float } +{ cgUWord extend extend float } +{ cgLong discard discard discard discard float } +{ cgULong discard discard discard discard float } +{ cgReal trunc trunc trunc trunc trunc trunc } +{ } +{ The meaning of the operationd shown in the table is: } +{ } +{ (blank) No action is taken, but the instruction is } +{ accepted by the code generator. } +{ extend The value is sign extended to the proper length.} +{ padd The value is padded on the left with zero bits } +{ to extend it to the proper length. } +{ discard Extra bits are discarded to reach the proper } +{ length, starting with the most significant bit. } +{ float An integer value is converted to a real value. } +{ trunc A real value is converted to the largest } +{ integer value that is less than or equal to the } +{ real value. } +{ } +{ } +{ pc_cpi - copy indirect } +{ } +{ Gen0t(pc_cpi, type) } +{ } +{ Two values are removed from the evaluation stack. The first } +{ is of type TYPE, while the second is a pointer. The first } +{ value is stored at the location pointed to by the pointer. } +{ The value is then placed back on the stack. } +{ } +{ } +{ pc_cpo - copy to a global variable } +{ } +{ Gen1tName (pc_cpo, disp, type, name) } +{ } +{ Saves the value on the top of the evaluation stack to the } +{ global label NAME. DISP is a fixed displacement past the } +{ names label to load from. (Used for records.) TYPE is } +{ the type of the value being loaded. } +{ } +{ } +{ pc_dec - decrement } +{ } +{ Gen1t(pc_dec, val, type) } +{ } +{ The value on the top of the stack is removed, decremented by } +{ VAL and returned to the stack. Type may be cgByte, cgUByte, } +{ cgWord, cgUWord, cgLong or cgULong. In all cases, the } +{ amount to decrement by is a positive signed integer. } +{ } +{ } +{ pc_dvi - integer divide } +{ pc_udi - unsigned integer divide } +{ pc_dvl - long integer divide } +{ pc_udl - unsigned long divide } +{ pc_dvr - real divide } +{ } +{ Gen0(pc_dvi) cgByte,cgWord } +{ Gen0(pc_udi) cgUByte,cgUWord } +{ Gen0(pc_dvl) cgLong } +{ Gen0(pc_udl) cgULong } +{ Gen0(pc_dvr) cgReal,cgDouble,cgComp,cgExtended } +{ } +{ The two values on the top of the evaluation stack are } +{ removed and divided. The result is placed back on the } +{ stack. The result type is the same as the argument type. } +{ } +{ } +{ pc_equ,pc_geq,pc_grt,pc_leq,pc_les,pc_neq - compares } +{ } +{ Gen0t(pc_equ, type) } +{ } +{ The two values on the top of the evaluation stack are } +{ removed and compared. A boolean result is placed back on } +{ the stack. } +{ } +{ } +{ pc_gil - increment and load from a global variable } +{ pc_gli - load a global variable, then inc the original } +{ pc_gdl - decrement and load from a global variable } +{ pc_gld - load a global variable, then dec the original } +{ } +{ Gen2tName (pc_gli, inc, disp, type, name) } +{ } +{ Loads a value from the global label NAME and places it on } +{ the evaluation stack. DISP is a fixed displacement past the } +{ names label to load from. (Used for records.) TYPE is } +{ the type of the value being loaded. } +{ } +{ In addition to loading the value, these instructions also } +{ increment or decrement the value, as indicated in the } +{ comment by the instruction name. The operand is incremented } +{ or decremented by INC. INC must be 1 for one and two byte } +{ operands. } +{ } +{ } +{ pc_iil - increment and load indirect } +{ pc_ili - load indirect, then inc the original } +{ pc_idl - decrement and load indirect } +{ pc_ild - load indirect, then dec the original } +{ } +{ Gen0t (pc_ili, type) } +{ } +{ Loads a value from the indirect address on the top of the } +{ stack, performing either an increment or decrement in the } +{ process. TYPE may be cgByte, cgUByte, cgWord or cgUWord. } +{ } +{ } +{ pc_inc - increment } +{ } +{ Gen1t(pc_inc, val, type) } +{ } +{ The value on the top of the stack is removed, incremented by } +{ VAL and returned to the stack. Type may be cgByte, cgUByte, } +{ cgWord, cgUWord, cgLong or cgULong. In all cases, the } +{ amount to increment by is a positive signed integer. } +{ } +{ } +{ pc_ind - load indirect } +{ } +{ Gen1t (pc_ind, disp, type) } +{ } +{ A value of type TYPE is loaded from DISP bytes past the } +{ address that is on the evaluation stack. The address is } +{ removed from the stack and replaced with the value. } +{ } +{ } +{ pc_ior - logical or } +{ pc_lor - long logical or } +{ } +{ Gen0(pc_ior) cgByte,cgUByte,cgWord,cgUWord } +{ Gen0(pc_lor) cgLong,cgULong } +{ } +{ The two values on the top of the evaluation stack are } +{ removed and ored. The result is placed back on the stack. } +{ Zero is treated as false, and any other value as true. The } +{ or is a logical or. See pc_bor for a bitwise or. } +{ } +{ } +{ pc_ixa - integer indexed address } +{ } +{ Gen0t(pc_ixa, type) } +{ } +{ TOS is an integer, which is added to TOS-1, which is a long } +{ integer. This instruction is generally used for computing } +{ short array indexes. } +{ } +{ TYPE can be cgWord or cgUWord; the type indicates whether } +{ the addition is signed or unsigned. } +{ } +{ } +{ pc_lad - load the address of a subroutine } +{ } +{ Gen0Name(pc_lad, name); } +{ } +{ Loads the address of the subroutine NAME. } +{ } +{ } +{ pc_lao - load a global address } +{ } +{ Gen1Name(pc_lao, disp, name); } +{ } +{ Loads the address of DISP bytes past the global variable } +{ NAME onto the stack. } +{ } +{ } +{ pc_lbf - load bit field } +{ pc_lbu - load unsigned bit field } +{ } +{ Gen2t(pc_lbf, disp, size, type) } +{ Gen2t(pc_lbu, disp, size, type) } +{ } +{ A bit field SIZE bits wide is loaded from DISP bits past the } +{ address on the top of the evaluation stack. The address is } +{ removed from the evaluation stack in the process. pc_lbf } +{ loads a signed value, while pc_lbu loads an unsigned value. } +{ } +{ } +{ pc_lca - load a string constant address } +{ } +{ GenS(pc_lca, str) } +{ } +{ Loads the address of a string onto the stack. Str is a } +{ pointer to a string constant. } +{ } +{ } +{ pc_lda - load a local address } +{ } +{ Gen2(pc_lda, label, disp) } +{ } +{ Loads the address of DISP bytes past the local label LABEL. } +{ } +{ } +{ pc_ldc - load a constant } +{ } +{ Gen1t(pc_ldc, val, type) } +{ GenLdcLong(val) } +{ GenLdcReal(val) } +{ } +{ Loads a constant value. Special calls for long and real } +{ values are provided due to the unique parameter requirements.} +{ } +{ } +{ pc_ldo - load from a global variable } +{ } +{ Gen1tName (pc_ldo, disp, type, name) } +{ } +{ Loads a value from the global label NAME and places it on } +{ the evaluation stack. DISP is a fixed displacement past the } +{ names label to load from. (Used for records.) TYPE is } +{ the type of the value being loaded. } +{ } +{ } +{ pc_lil - increment and load from a local variable } +{ pc_lli - load a local variable, then inc the original } +{ pc_ldl - decrement and load from a local variable } +{ pc_lld - load a local variable, then dec the original } +{ } +{ Gen2t(pc_lli, label, inc, type) } +{ } +{ Loads a value from the local label LABEL and places it on } +{ the evaluation stack. TYPE is the type of the value being } +{ loaded. INC is the number to increment or decrement by. } +{ } +{ In addition to loading the value, these instructions also } +{ increment or decrement the value, as indicated in the } +{ comment by the instruction name. The operand is incremented } +{ or decremented by INC. INC must be 1 for one and two byte } +{ operands. } +{ } +{ } +{ pc_lod - load from a local variable } +{ } +{ Gen2t(pc_lod, label, disp, type) } +{ } +{ Loads a value from DISP bytes past the local label LABEL and } +{ places it on the evaluation stack. TYPE is the type is the } +{ value being loaded. } +{ } +{ } +{ pc_mod - integer modulus } +{ pc_uim - unsigned integer modulus } +{ pc_mdl - long modulus } +{ pc_ulm - unsigned long modulus } +{ } +{ Gen0(pc_mod) cgByte,cgWord } +{ Gen0(pc_uim) cgUByte,cgUWord } +{ Gen0(pc_mdl) cgLong } +{ Gen0(pc_ulm) cgULong } +{ } +{ The two values on the top of the evaluation stack are } +{ removed and a molulus operation is performed. The result is } +{ placed back on the stack. The result, like the arguments, } +{ is an integer. } +{ } +{ } +{ pc_mpi - integer multiply } +{ pc_umi - unsigned integer multiply } +{ pc_mpl - long integer multiply } +{ pc_uml - unsigned long multiply } +{ pc_mpr - real multiply } +{ } +{ Gen0(pc_mpi) cgByte,cgWord } +{ Gen0(pc_umi) cgUByte,cgUWord } +{ Gen0(pc_mpl) cgLong } +{ Gen0(pc_uml) cgULong } +{ Gen0(pc_mpr) cgReal,cgDouble,cgComp,cgExtended } +{ } +{ The two values on the top of the evaluation stack are } +{ removed and multiplied. The result is placed back on the } +{ stack. The result type is the same as the argument type. } +{ } +{ } +{ pc_ngi - integer negation } +{ pc_ngl - long negation } +{ pc_ngr - real negation } +{ } +{ Gen0(pc_ngi) cgByte,cgUByte,cgWord,cgUWord } +{ Gen0(pc_ngl) cgLong,cgULong } +{ Gen0(pc_ngr) cgReal,cgDouble,cgComp,cgExtended } +{ } +{ The value on the top of the evaluation stack is removed, } +{ subtracted from 0, and replaced. (Two's compliment.) } +{ } +{ } +{ Gen0(pc_nop) } +{ } +{ This operand is a leaf node. It does nothing. It is used } +{ to create a null expression tree for functions and } +{ procedures that have no parameters. } +{ } +{ } +{ pc_not - logical negation } +{ } +{ Gen0(pc_not) } +{ } +{ The value on the top of the evaluation stack is removed, } +{ logically negated, and replaced. } +{ } +{ } +{ pc_pop - pop a value from the stack } +{ } +{ Gen0t(pc_pop, type) } +{ } +{ The value on the top of the evaluation stack is removed. } +{ } +{ } +{ pc_psh - push bytes on the stack } +{ } +{ Gen0(pc_psh) } +{ } +{ Removes the size (a word) and the source address (a long) } +{ from the evaluation stack, and pushes size bytes from the } +{ source address onto the stack. } +{ } +{ } +{ pc_sbf - save bit field } +{ } +{ Gen2t(pc_sbf, disp, size, type) } +{ } +{ An integer is removed from the top of the evaluation stack } +{ and saved at the address on the evaluation stack. The } +{ value is saved DISP bits past the address, and is treated as } +{ a SIZE bit value. Extra bits are dropped. } +{ } +{ } +{ pc_sbi - integer subtraction } +{ pc_sbl - long subtraction } +{ pc_sbr - real subtraction } +{ } +{ Gen0(pc_sbi) cgByte,cgUByte,cgWord,cgUWord } +{ Gen0(pc_sbl) cgLong,cgULong } +{ Gen0(pc_sbr) cgReal,cgDouble,cgComp,cgExtended } +{ } +{ The two values on the top of the evaluation stack are } +{ removed. TOS-1 - TOS is placed back on the stack. } +{ } +{ } +{ pc_shl - shift left } +{ pc_sll - shift left long } +{ } +{ Gen0(pc_shl) cgByte,cgUByte,cgWord,cgUWord } +{ Gen0(pc_sll) cgLong,cgULong } +{ } +{ The value at tos-1 is shifted left by the number of bits } +{ specified by tos. The result is an integer, which replaces } +{ the operands on the stack. The right bit positions are } +{ filled with zeros. } +{ } +{ } +{ pc_shr - shift right } +{ pc_usr - unsigned shift right } +{ pc_slr - long shift right } +{ pc_vsr - unsigned long shift right } +{ } +{ Gen0(pc_shr) cgByte,cgWord } +{ Gen0(pc_usr) cgUByte,cgUWord } +{ Gen0(pc_slr) cgLong } +{ Gen0(pc_vsr) cgULong } +{ } +{ The value at tos-1 is shifted right by the number of bits } +{ specified by tos. The result is an integer, which replaces } +{ the operands on the stack. This is a signed shift: the } +{ leftmost bit position is filled in with a copy of the } +{ orignial leftmost bit. } +{ } +{ Pc_usr is the unsigned form. The operation is the same, } +{ except that the leftmost bit is replaced with a zero. } +{ Pc_vsr is used for unsigned long operations. } +{ } +{ pc_stk - stack an operand } +{ } +{ Gen0t(pc_stk, type) } +{ } +{ The value on top of the evaluation stack is to be left there } +{ as a parameter to a subsequent procedure or function call. } +{ This p-code "caps" the expression tree, giving the code } +{ generator something to do with the expression result. } +{ } +{ } +{ pc_sro - store to a global variable } +{ } +{ Gen1tName (pc_sro, disp, type, name) } +{ } +{ Saves the value from the top of the evaluation stack to the } +{ global label NAME. DISP is a fixed displacement past the } +{ names label to load from. (Used for records.) TYPE is } +{ the type of the value being loaded. } +{ } +{ } +{ pc_sto - store indirect } +{ } +{ Gen0t(pc_sto, type) } +{ } +{ Two values are removed from the evaluation stack. TOS is of } +{ type TYPE, while TOS-1 is a pointer. The value is stored at } +{ the location pointed to by the pointer. } +{ } +{ } +{ pc_str - store to a local variable } +{ } +{ Gen2t(pc_str, label, disp, type) } +{ } +{ Saves the value on the top of the evaluation stack to DISP } +{ bytes past the local label LABEL. TYPE is the type of the } +{ value being saved. } +{ } +{ } +{ pc_tri - C trinary operator } +{ } +{ Gen0t(pc_tri, type) } +{ } +{ Implements the C trinary operator. TOS is the false } +{ expression, TOS-1 the true expression, and TOS-2 the } +{ condition expression. The condition expression is } +{ evaluated. If it is non-zero, the true expression is } +{ evaluated. If it is zero, the false expression is } +{ evaluated. The result type of the true and false } +{ expressions must be the same. } +{ } +{ Internally, pc_bno is used for the right operand; the } +{ operands for pc_bno are the two expressions. } +{ } +{-- Flow of control --------------------------------------------} +{ } +{ dc_lab - define a label } +{ } +{ Gen1(pc_lab, lab) } +{ } +{ Defines label number lab at the current location. } +{ } +{ } +{ pc_add - address } +{ } +{ Gen1(pc_add, lab) } +{ } +{ Generates a two-byte address that points to the label lab. } +{ This is used to create branch tables for pc_xjp } +{ instructions. } +{ } +{ } +{ pc_fjp - jump if false } +{ } +{ Gen1(pc_fjp, lab) } +{ } +{ A boolean value is removed from the top of the evaluation } +{ stack. If the value is false, execution continues with the } +{ instruction after the label lab; otherwise execution } +{ continues with the instruction after this one. } +{ } +{ } +{ pc_tjp - jump if true } +{ } +{ Gen1(pc_tjp, lab) } +{ } +{ A boolean value is removed from the top of the evaluation } +{ stack. If the value is true, execution continues with the } +{ instruction after the label lab; otherwise execution } +{ continues with the instruction after this one. } +{ } +{ } +{ pc_ujp - jump } +{ } +{ Gen1(pc_ujp, lab) } +{ } +{ Execution continues with the instruction after the label lab.} +{ } +{ } +{ pc_xjp - indexed jump } +{ } +{ Gen1(pc_xjp, val) } +{ } +{ The top of stack contains an integer, which is removed. If } +{ it is less than zero or greater than VAL, it is replaced by } +{ VAL. The result is then used to index into a jump table, } +{ formed using pc_add instructions, which follows immediately } +{ after the pc_xjp instruction. } +{ } +{-- Pcodes involved with calling and defining procedures -------} +{ } +{ dc_str - start a segment } +{ } +{ Gen2Name(dc_str, p1, p2, name) } +{ } +{ Starts a new object segment with the name name^. P1 is the } +{ segment kind, while p2 is the length code (1 for data, 0 for } +{ code segments). } +{ } +{ } +{ dc_pin - procedure entry point } +{ } +{ Gen0(dc_pin) } +{ } +{ A code segment does not have to be entered at the first byte } +{ when called. This directive is used one time in each code } +{ segment to indicate the actual entry point. } +{ } +{ } +{ dc_enp - end a segment } +{ } +{ Gen0(dc_enp) } +{ } +{ This directive closes the current segment. } +{ } +{ } +{ pc_ent - enter a subroutine } +{ } +{ Gen0(pc_ent) } +{ } +{ This pcode is used at the beginning of every subroutine. It } +{ marks the beginning of a new stack frame definition. } +{ Subsequent dc_loc and dc_prm cause space to be allocated } +{ from this stack frame. } +{ } +{ } +{ pc_ret - return from a subroutine } +{ } +{ Gen0t(pc_ret, type) } +{ } +{ This pcode is used to return from a function or a procedure. } +{ The type is the type of the function, and is used to tell } +{ the code generator what type of value to return. The value } +{ to return is assumed to be stored defaultStackSize bytes } +{ into the stack frame. } +{ } +{ } +{ pc_cui - call user procedure, indirect } +{ } +{ Gen1t(pc_cui, repair, ftype) } +{ } +{ Calls a user procedure or function through the address on } +{ the top of the evaluation stack. FTYPE is the return type. } +{ Repair is 1 if stack repair should be forced, and 0 if not. } +{ } +{ } +{ pc_cup - call user procedure } +{ } +{ Gen1tName(pc_cup, repair, name, ftype) } +{ } +{ Calls a user procedure or function. Ftype is the type. } +{ Repair is 1 if stack repair should be forced, and 0 if not. } +{ NAME is the name of the procedure. } +{ } +{ } +{ dc_loc - define local label } +{ } +{ Gen2(dc_loc, label, size) } +{ } +{ Defines a local label using the label parameter as a label } +{ number. Size bytes are reserved on the stack frame. Label } +{ numbers should be assigned by the compiler, starting with } +{ number 1. Label 0 is reserved for refering to the return } +{ value of a function (if any). } +{ } +{ } +{ dc_prm - define parameter } +{ } +{ Gen3(dc_prm, label, size, disp) } +{ } +{ Defines a label used to refer to a parameter. See dc_loc } +{ for a discussion of the label and size parameters. The disp } +{ parameter is the number of bytes of parameter that will be } +{ pushed after this one; i.e., the disp from the return addr } +{ to this parameter. } +{ } +{ } +{ pc_tl1 - call a tool } +{ } +{ GenTool(pc_tl1, toolNum, retSize, dispatcher) } +{ } +{ Calls a tool. The tool number is toolNum; the tool is } +{ called at location dispatcher. The tool returns a result } +{ that is retSize bytes long. } +{ } +{ } +{ dc_sym - generate a symbol table } +{ } +{ Gen1Name(dc_sym, doGLobals, pointer(table) } +{ } +{ Generates a symbol table for the debugger. TABLE is the } +{ address of the sybol table, which will be passed back to a } +{ subroutine called GenSymbols, which must be supplied by the } +{ compiler. DOGLOBALS is a flag the compiler can set for its } +{ own purposes. C uses the flag to note that the symbol } +{ table being created is for main, so global symbols should be } +{ included. } +{ } diff --git a/CGI.Debug b/CGI.Debug old mode 100755 new mode 100644 index 6a7b4d5..82fcc08 --- a/CGI.Debug +++ b/CGI.Debug @@ -1 +1,368 @@ -procedure InitWriteCode; {debug} { initialize the intermediate code opcode table } begin {InitWriteCode} opt[pc_adi] := 'adi'; opt[pc_adr] := 'adr'; opt[pc_psh] := 'psh'; opt[pc_and] := 'and'; opt[pc_dvi] := 'dvi'; opt[pc_dvr] := 'dvr'; opt[pc_cnn] := 'cnn'; opt[pc_cnv] := 'cnv'; opt[pc_ior] := 'ior'; opt[pc_mod] := 'mod'; opt[pc_mpi] := 'mpi'; opt[pc_mpr] := 'mpr'; opt[pc_ngi] := 'ngi'; opt[pc_ngr] := 'ngr'; opt[pc_not] := 'not'; opt[pc_sbi] := 'sbi'; opt[pc_sbr] := 'sbr'; opt[pc_sto] := 'sto'; opt[pc_dec] := 'dec'; opt[dc_loc] := 'LOC'; opt[pc_ent] := 'ent'; opt[pc_fjp] := 'fjp'; opt[pc_inc] := 'inc'; opt[pc_ind] := 'ind'; opt[pc_ixa] := 'ixa'; opt[pc_lao] := 'lao'; opt[pc_lca] := 'lca'; opt[pc_ldo] := 'ldo'; opt[pc_mov] := 'mov'; opt[pc_ret] := 'ret'; opt[pc_sro] := 'sro'; opt[pc_xjp] := 'xjp'; opt[pc_cup] := 'cup'; opt[pc_equ] := 'equ'; opt[pc_geq] := 'geq'; opt[pc_grt] := 'grt'; opt[pc_lda] := 'lda'; opt[pc_ldc] := 'ldc'; opt[pc_ldl] := 'ldl'; opt[pc_leq] := 'leq'; opt[pc_les] := 'les'; opt[pc_lil] := 'lil'; opt[pc_lld] := 'lld'; opt[pc_lli] := 'lli'; opt[pc_lod] := 'lod'; opt[pc_neq] := 'neq'; opt[pc_str] := 'str'; opt[pc_ujp] := 'ujp'; opt[pc_add] := 'add'; opt[pc_lnm] := 'lnm'; opt[pc_nam] := 'nam'; opt[pc_cui] := 'cui'; opt[pc_lad] := 'lad'; opt[pc_tjp] := 'tjp'; opt[dc_lab] := 'LAB'; opt[pc_usr] := 'usr'; opt[pc_umi] := 'umi'; opt[pc_udi] := 'udi'; opt[pc_uim] := 'uim'; opt[dc_enp] := 'ENP'; opt[pc_stk] := 'stk'; opt[dc_glb] := 'GLB'; opt[dc_dst] := 'DST'; opt[dc_str] := 'STR'; opt[pc_cop] := 'cop'; opt[pc_cpo] := 'cpo'; opt[pc_tl1] := 'tl1'; opt[dc_pin] := 'PIN'; opt[pc_shl] := 'shl'; opt[pc_shr] := 'shr'; opt[pc_bnd] := 'bnd'; opt[pc_bor] := 'bor'; opt[pc_bxr] := 'bxr'; opt[pc_bnt] := 'bnt'; opt[pc_bnl] := 'bnl'; opt[pc_mpl] := 'mpl'; opt[pc_dvl] := 'dvl'; opt[pc_mdl] := 'mdl'; opt[pc_sll] := 'sll'; opt[pc_slr] := 'slr'; opt[pc_bal] := 'bal'; opt[pc_ngl] := 'ngl'; opt[pc_adl] := 'adl'; opt[pc_sbl] := 'sbl'; opt[pc_blr] := 'blr'; opt[pc_blx] := 'blx'; opt[dc_sym] := 'SYM'; opt[pc_lnd] := 'lnd'; opt[pc_lor] := 'lor'; opt[pc_vsr] := 'vsr'; opt[pc_uml] := 'uml'; opt[pc_udl] := 'udl'; opt[pc_ulm] := 'ulm'; opt[pc_pop] := 'pop'; opt[pc_gil] := 'gil'; opt[pc_gli] := 'gli'; opt[pc_gdl] := 'gdl'; opt[pc_gld] := 'gld'; opt[pc_iil] := 'iil'; opt[pc_ili] := 'ili'; opt[pc_idl] := 'idl'; opt[pc_ild] := 'ild'; opt[pc_cpi] := 'cpi'; opt[pc_tri] := 'tri'; opt[pc_lbu] := 'lbu'; opt[pc_lbf] := 'lbf'; opt[pc_sbf] := 'sbf'; opt[pc_cbf] := 'cbf'; opt[dc_cns] := 'CNS'; opt[dc_prm] := 'PRM'; opt[pc_nat] := 'nat'; opt[pc_bno] := 'bno'; opt[pc_nop] := 'nop'; end; {InitWriteCode} procedure PrintDAG (tag: stringPtr; code: icptr); { print a DAG } { } { parameters: } { tag - label for lines } { code - first node in DAG } begin {PrintDAG} while code <> nil do begin PrintDAG(tag, code^.left); PrintDAG(tag, code^.right); write(tag^); WriteCode(code); code := code^.next; end; {while} end; {PrintDAG} procedure PrintBlocks {tag: stringPtr; bp: blockPtr}; {debug} { print a series of basic blocks } { } { parameters: } { tag - label for lines } { bp - first block to print } procedure PrintDOM (dp: blockListPtr); { print a list of dominators } { } { parameters: } { dp - list to print } begin {PrintDOM} while dp <> nil do begin write(dp^.dfn:1); if dp^.next <> nil then write(','); dp := dp^.next; end; {while} end; {PrintDOM} procedure PrintList (tag: stringPtr; lp: iclist); { print an operation list } { } { parameters: } { tag - label for lines } { lp - list to print } procedure PrintTree (tag: stringPtr; op: icptr); { print an operation tree } { } { parameters: } { tag - label for lines } { op - operation tree to print } begin {PrintTree} if op^.left <> nil then printTree(@'>> : ', op^.left); if op^.right <> nil then printTree(@'>> : ', op^.right); write(tag^); WriteCode(op); end; {PrintTree} begin {PrintList} while lp <> nil do begin PrintTree(tag, lp^.op); lp := lp^.next; end; {while} end; {PrintList} begin {PrintBlocks} while bp <> nil do begin write(tag^, 'BLOCK(', bp^.dfn:1, ') ['); PrintDOM(bp^.dom); writeln(']'); PrintList(@'>>In : ', bp^.c_in); PrintList(@'>>Out : ', bp^.c_out); PrintList(@'>>Gen : ', bp^.c_gen); PrintDAG(tag, bp^.code); bp := bp^.next; end; {while} end; {PrintBlocks} procedure WriteCode {code: icptr}; {debug} { print an intermediate code instruction } { } { Parameters: } { code - intermediate code instruction to write } var i: integer; {work variable} procedure WriteType(tp: baseTypeEnum); { print the operand type } { } { parameters: } { tp - type } begin {WriteType} case tp of cgByte: write('b'); cgUByte: write('ub'); cgWord: write('i'); cgUWord: write('u'); cgLong: write('l'); cgULong: write('ul'); cgReal: write('r'); cgDouble: write('d'); cgComp: write('c'); cgExtended: write('e'); cgString: write('s'); cgVoid: write('void'); ccPointer: write('p'); otherwise: write('(', ord(tp):1, ')'); end; {case} end; {WriteType} begin {WriteCode} write(opt[code^.opcode]); with code^ do case opcode of dc_enp,dc_pin,dc_sym,pc_adl,pc_bal,pc_dvl,pc_ent,pc_mpl,pc_sbl, pc_uml,pc_adr,pc_dvr,pc_mpr,pc_adi,pc_sbi,pc_mpi,pc_dvi, pc_umi,pc_shl,pc_nop,pc_and,pc_lnd,pc_bnd,pc_lor,pc_ior,pc_bxr, pc_bnt,pc_blx,pc_bnl,pc_ngi,pc_ngl,pc_ngr,pc_ixa,pc_mdl, pc_udi,pc_udl: ; dc_prm: write(' ', q:1, ':', r:1, ':', s:1); pc_equ,pc_neq,pc_geq,pc_leq,pc_grt,pc_les,pc_pop,pc_ret,pc_bno, pc_cpi,pc_sto,pc_tri,pc_stk,pc_idl,pc_iil,pc_ili,pc_ild: WriteType(optype); pc_cnv,pc_cnn: begin write(' '); i := (q>>4) & 15; WriteType(baseTypeEnum(i)); write(':'); i := q & 15; WriteType(baseTypeEnum(i)); end; pc_lil,pc_lli,pc_ldl,pc_lld: begin WriteType(optype); write(' ', q:1, ',', r:1); end; pc_lod,pc_str,pc_cop: begin WriteType(optype); write(' ', r:1, ':', q:1); end; dc_loc,pc_lda,pc_mov: write(' ', r:1, ':', q:1); pc_ind,pc_inc,pc_dec: begin WriteType(optype); write(' ', q:1); end; dc_lab,pc_fjp,pc_tjp,pc_ujp,pc_add: write(' ', q:1); pc_ldc: begin WriteType(optype); if optype in [cgByte,cgUByte,cgWord,cgUWord] then write(' ', q:1) else if optype in [cgLong,cgULong] then write(' ', lval:1) else if optype in [cgReal,cgDouble,cgComp,cgExtended] then write(' ', rval:1) else write('***'); end; pc_cup,pc_lad: begin WriteType(optype); write(' ', lab^); end; pc_cpo,pc_lao,pc_ldo,pc_sro: begin WriteType(optype); write(' ', q:1, ':', lab^); end; dc_str,dc_glb,pc_gli,pc_gld,pc_gil,pc_gdl: write(' ', r:1, ':', q:1, ':', lab^); dc_cns: begin WriteType(optype); write(' ', q:1, ':'); case optype of cgByte,cgUByte,cgWord,cgUWord: write(r:1); cgLong,cgULong: write(lval:1); cgReal,cgDouble,cgComp,cgExtended: write('***'); cgString: begin write(''''); for i := 1 to q do write(str^.str[i]); write(''''); end; ccPointer: if lab = nil then write('***') else write(lab^, '+', pval:1); end; {case} end; pc_lca: begin WriteType(optype); write(' '); if optype = cgString then begin write(''''); for i := 1 to q do write(str^.str[i]); write(''''); end {if} else write('***'); end; otherwise: write(' ***'); end; {case} writeln; end; {WriteCode} \ No newline at end of file +procedure InitWriteCode; {debug} + +{ initialize the intermediate code opcode table } + +begin {InitWriteCode} +opt[pc_adi] := 'adi'; +opt[pc_adr] := 'adr'; +opt[pc_psh] := 'psh'; +opt[pc_and] := 'and'; +opt[pc_dvi] := 'dvi'; +opt[pc_dvr] := 'dvr'; +opt[pc_cnn] := 'cnn'; +opt[pc_cnv] := 'cnv'; +opt[pc_ior] := 'ior'; +opt[pc_mod] := 'mod'; +opt[pc_mpi] := 'mpi'; +opt[pc_mpr] := 'mpr'; +opt[pc_ngi] := 'ngi'; +opt[pc_ngr] := 'ngr'; +opt[pc_not] := 'not'; +opt[pc_sbi] := 'sbi'; +opt[pc_sbr] := 'sbr'; +opt[pc_sto] := 'sto'; +opt[pc_dec] := 'dec'; +opt[dc_loc] := 'LOC'; +opt[pc_ent] := 'ent'; +opt[pc_fjp] := 'fjp'; +opt[pc_inc] := 'inc'; +opt[pc_ind] := 'ind'; +opt[pc_ixa] := 'ixa'; +opt[pc_lao] := 'lao'; +opt[pc_lca] := 'lca'; +opt[pc_ldo] := 'ldo'; +opt[pc_mov] := 'mov'; +opt[pc_ret] := 'ret'; +opt[pc_sro] := 'sro'; +opt[pc_xjp] := 'xjp'; +opt[pc_cup] := 'cup'; +opt[pc_equ] := 'equ'; +opt[pc_geq] := 'geq'; +opt[pc_grt] := 'grt'; +opt[pc_lda] := 'lda'; +opt[pc_ldc] := 'ldc'; +opt[pc_ldl] := 'ldl'; +opt[pc_leq] := 'leq'; +opt[pc_les] := 'les'; +opt[pc_lil] := 'lil'; +opt[pc_lld] := 'lld'; +opt[pc_lli] := 'lli'; +opt[pc_lod] := 'lod'; +opt[pc_neq] := 'neq'; +opt[pc_str] := 'str'; +opt[pc_ujp] := 'ujp'; +opt[pc_add] := 'add'; +opt[pc_lnm] := 'lnm'; +opt[pc_nam] := 'nam'; +opt[pc_cui] := 'cui'; +opt[pc_lad] := 'lad'; +opt[pc_tjp] := 'tjp'; +opt[dc_lab] := 'LAB'; +opt[pc_usr] := 'usr'; +opt[pc_umi] := 'umi'; +opt[pc_udi] := 'udi'; +opt[pc_uim] := 'uim'; +opt[dc_enp] := 'ENP'; +opt[pc_stk] := 'stk'; +opt[dc_glb] := 'GLB'; +opt[dc_dst] := 'DST'; +opt[dc_str] := 'STR'; +opt[pc_cop] := 'cop'; +opt[pc_cpo] := 'cpo'; +opt[pc_tl1] := 'tl1'; +opt[dc_pin] := 'PIN'; +opt[pc_shl] := 'shl'; +opt[pc_shr] := 'shr'; +opt[pc_bnd] := 'bnd'; +opt[pc_bor] := 'bor'; +opt[pc_bxr] := 'bxr'; +opt[pc_bnt] := 'bnt'; +opt[pc_bnl] := 'bnl'; +opt[pc_mpl] := 'mpl'; +opt[pc_dvl] := 'dvl'; +opt[pc_mdl] := 'mdl'; +opt[pc_sll] := 'sll'; +opt[pc_slr] := 'slr'; +opt[pc_bal] := 'bal'; +opt[pc_ngl] := 'ngl'; +opt[pc_adl] := 'adl'; +opt[pc_sbl] := 'sbl'; +opt[pc_blr] := 'blr'; +opt[pc_blx] := 'blx'; +opt[dc_sym] := 'SYM'; +opt[pc_lnd] := 'lnd'; +opt[pc_lor] := 'lor'; +opt[pc_vsr] := 'vsr'; +opt[pc_uml] := 'uml'; +opt[pc_udl] := 'udl'; +opt[pc_ulm] := 'ulm'; +opt[pc_pop] := 'pop'; +opt[pc_gil] := 'gil'; +opt[pc_gli] := 'gli'; +opt[pc_gdl] := 'gdl'; +opt[pc_gld] := 'gld'; +opt[pc_iil] := 'iil'; +opt[pc_ili] := 'ili'; +opt[pc_idl] := 'idl'; +opt[pc_ild] := 'ild'; +opt[pc_cpi] := 'cpi'; +opt[pc_tri] := 'tri'; +opt[pc_lbu] := 'lbu'; +opt[pc_lbf] := 'lbf'; +opt[pc_sbf] := 'sbf'; +opt[pc_cbf] := 'cbf'; +opt[dc_cns] := 'CNS'; +opt[dc_prm] := 'PRM'; +opt[pc_nat] := 'nat'; +opt[pc_bno] := 'bno'; +opt[pc_nop] := 'nop'; +end; {InitWriteCode} + + +procedure PrintDAG (tag: stringPtr; code: icptr); + +{ print a DAG } +{ } +{ parameters: } +{ tag - label for lines } +{ code - first node in DAG } + +begin {PrintDAG} +while code <> nil do begin + PrintDAG(tag, code^.left); + PrintDAG(tag, code^.right); + write(tag^); + WriteCode(code); + code := code^.next; + end; {while} +end; {PrintDAG} + + +procedure PrintBlocks {tag: stringPtr; bp: blockPtr}; {debug} + +{ print a series of basic blocks } +{ } +{ parameters: } +{ tag - label for lines } +{ bp - first block to print } + + + procedure PrintDOM (dp: blockListPtr); + + { print a list of dominators } + { } + { parameters: } + { dp - list to print } + + begin {PrintDOM} + while dp <> nil do begin + write(dp^.dfn:1); + if dp^.next <> nil then + write(','); + dp := dp^.next; + end; {while} + end; {PrintDOM} + + + procedure PrintList (tag: stringPtr; lp: iclist); + + { print an operation list } + { } + { parameters: } + { tag - label for lines } + { lp - list to print } + + + procedure PrintTree (tag: stringPtr; op: icptr); + + { print an operation tree } + { } + { parameters: } + { tag - label for lines } + { op - operation tree to print } + + begin {PrintTree} + if op^.left <> nil then + printTree(@'>> : ', op^.left); + if op^.right <> nil then + printTree(@'>> : ', op^.right); + write(tag^); + WriteCode(op); + end; {PrintTree} + + + begin {PrintList} + while lp <> nil do begin + PrintTree(tag, lp^.op); + lp := lp^.next; + end; {while} + end; {PrintList} + + +begin {PrintBlocks} +while bp <> nil do begin + write(tag^, 'BLOCK(', bp^.dfn:1, ') ['); + PrintDOM(bp^.dom); + writeln(']'); + PrintList(@'>>In : ', bp^.c_in); + PrintList(@'>>Out : ', bp^.c_out); + PrintList(@'>>Gen : ', bp^.c_gen); + PrintDAG(tag, bp^.code); + bp := bp^.next; + end; {while} +end; {PrintBlocks} + + +procedure WriteCode {code: icptr}; {debug} + +{ print an intermediate code instruction } +{ } +{ Parameters: } +{ code - intermediate code instruction to write } + +var + i: integer; {work variable} + + + procedure WriteType(tp: baseTypeEnum); + + { print the operand type } + { } + { parameters: } + { tp - type } + + begin {WriteType} + case tp of + cgByte: write('b'); + cgUByte: write('ub'); + cgWord: write('i'); + cgUWord: write('u'); + cgLong: write('l'); + cgULong: write('ul'); + cgReal: write('r'); + cgDouble: write('d'); + cgComp: write('c'); + cgExtended: write('e'); + cgString: write('s'); + cgVoid: write('void'); + ccPointer: write('p'); + otherwise: write('(', ord(tp):1, ')'); + end; {case} + end; {WriteType} + + +begin {WriteCode} +write(opt[code^.opcode]); +with code^ do + case opcode of + dc_enp,dc_pin,dc_sym,pc_adl,pc_bal,pc_dvl,pc_ent,pc_mpl,pc_sbl, + pc_uml,pc_adr,pc_dvr,pc_mpr,pc_adi,pc_sbi,pc_mpi,pc_dvi, + pc_umi,pc_shl,pc_nop,pc_and,pc_lnd,pc_bnd,pc_lor,pc_ior,pc_bxr, + pc_bnt,pc_blx,pc_bnl,pc_ngi,pc_ngl,pc_ngr,pc_ixa,pc_mdl, + pc_udi,pc_udl: ; + + dc_prm: + write(' ', q:1, ':', r:1, ':', s:1); + + pc_equ,pc_neq,pc_geq,pc_leq,pc_grt,pc_les,pc_pop,pc_ret,pc_bno, + pc_cpi,pc_sto,pc_tri,pc_stk,pc_idl,pc_iil,pc_ili,pc_ild: + WriteType(optype); + + pc_cnv,pc_cnn: begin + write(' '); + i := (q>>4) & 15; + WriteType(baseTypeEnum(i)); + write(':'); + i := q & 15; + WriteType(baseTypeEnum(i)); + end; + + pc_lil,pc_lli,pc_ldl,pc_lld: begin + WriteType(optype); + write(' ', q:1, ',', r:1); + end; + + pc_lod,pc_str,pc_cop: begin + WriteType(optype); + write(' ', r:1, ':', q:1); + end; + + dc_loc,pc_lda,pc_mov: + write(' ', r:1, ':', q:1); + + pc_ind,pc_inc,pc_dec: begin + WriteType(optype); + write(' ', q:1); + end; + + dc_lab,pc_fjp,pc_tjp,pc_ujp,pc_add: + write(' ', q:1); + + pc_ldc: begin + WriteType(optype); + if optype in [cgByte,cgUByte,cgWord,cgUWord] then + write(' ', q:1) + else if optype in [cgLong,cgULong] then + write(' ', lval:1) + else if optype in [cgReal,cgDouble,cgComp,cgExtended] then + write(' ', rval:1) + else + write('***'); + end; + + pc_cup,pc_lad: begin + WriteType(optype); + write(' ', lab^); + end; + + pc_cpo,pc_lao,pc_ldo,pc_sro: begin + WriteType(optype); + write(' ', q:1, ':', lab^); + end; + + dc_str,dc_glb,pc_gli,pc_gld,pc_gil,pc_gdl: + write(' ', r:1, ':', q:1, ':', lab^); + + dc_cns: begin + WriteType(optype); + write(' ', q:1, ':'); + case optype of + cgByte,cgUByte,cgWord,cgUWord: + write(r:1); + cgLong,cgULong: + write(lval:1); + cgReal,cgDouble,cgComp,cgExtended: + write('***'); + cgString: begin + write(''''); + for i := 1 to q do + write(str^.str[i]); + write(''''); + end; + ccPointer: + if lab = nil then + write('***') + else + write(lab^, '+', pval:1); + end; {case} + end; + + pc_lca: begin + WriteType(optype); + write(' '); + if optype = cgString then begin + write(''''); + for i := 1 to q do + write(str^.str[i]); + write(''''); + end {if} + else + write('***'); + end; + + otherwise: + write(' ***'); + + end; {case} +writeln; +end; {WriteCode} diff --git a/CGI.pas b/CGI.pas old mode 100755 new mode 100644 index 610e679..6eb3561 --- a/CGI.pas +++ b/CGI.pas @@ -1 +1,1296 @@ -{$optimize 7} {---------------------------------------------------------------} { } { ORCA Code Generator Interface } { } { This unit serves as the glue code attaching a compiler } { to the code generator. It provides subroutines in a } { format that is convinient for the compiler during } { semantic analysis, and produces intermediate code records } { as output. These intermediate code records are then } { passed on to the code generator for optimization and } { native code generation. } { } {$copy 'cgi.comments'} {---------------------------------------------------------------} unit CodeGeneratorInterface; interface {$segment 'cg'} {$LibPrefix '0/obj/'} uses CCommon; const {Error interface: these constants map } {code generator error numbers into the } {numbers used by the compiler's Error } {subroutine. } {--------------------------------------} cge1 = 57; {compiler error} cge2 = 58; {implementation restriction: too many local labels} cge3 = 60; {implementation restriction: string space exhausted} {65816 native code generation} {----------------------------} {instruction modifier flags} shift8 = 1; {shift operand left 8 bits} shift16 = 2; {shift operand left 16 bits} toolCall = 4; {generate a tool call} stringReference = 8; {generate a string reference} isPrivate = 32; {is the label private?} constantOpnd = 64; {the absolute operand is a constant} localLab = 128; {the operand is a local lab} m_adc_abs = $6D; {op code #s for 65816 instructions} m_adc_dir = $65; m_adc_imm = $69; m_adc_s = $63; m_and_abs = $2D; m_and_dir = $25; m_and_imm = $29; m_and_s = $23; m_asl_a = $0A; m_bcc = $90; m_bcs = $B0; m_beq = $F0; m_bit_imm = $89; m_bmi = $30; m_bne = $D0; m_bpl = $10; m_bra = $80; m_brl = $82; m_bvs = $70; m_clc = $18; m_cmp_abs = $CD; m_cmp_dir = $C5; m_cmp_dirX = $D5; m_cmp_imm = $C9; m_cmp_long = $CF; m_cmp_s = $C3; m_cop = $02; m_cpx_abs = 236; m_cpx_dir = 228; m_cpx_imm = 224; m_dea = 58; m_dec_abs = 206; m_dec_absX = $DE; m_dec_dir = 198; m_dec_dirX = 214; m_dex = 202; m_dey = 136; m_eor_abs = 77; m_eor_dir = 69; m_eor_imm = 73; m_eor_s = 67; m_ina = 26; m_inc_abs = 238; m_inc_absX = $FE; m_inc_dir = 230; m_inc_dirX = 246; m_inx = 232; m_iny = 200; m_jml = 92; m_jsl = 34; m_lda_abs = 173; m_lda_absx = 189; m_lda_dir = 165; m_lda_dirx = 181; m_lda_imm = 169; m_lda_indl = 167; m_lda_indly = 183; m_lda_long = 175; m_lda_longx = 191; m_lda_s = 163; m_ldx_abs = 174; m_ldx_dir = 166; m_ldx_imm = 162; m_ldy_abs = 172; m_ldy_absX = 188; m_ldy_dir = 164; m_ldy_dirX = 180; m_ldy_imm = 160; m_lsr_a = 74; m_mvn = 84; m_ora_abs = 13; m_ora_dir = 5; m_ora_dirX = 21; m_ora_imm = 9; m_ora_longX = 31; m_ora_s = 3; m_pea = 244; m_pei_dir = 212; m_pha = 72; m_phb = 139; m_phd = 11; m_phx = 218; m_phy = 90; m_php = 8; m_pla = 104; m_plb = 171; m_pld = 43; m_plx = 250; m_ply = 122; m_plp = 40; m_rep = 194; m_rtl = 107; m_rts = 96; m_sbc_abs = 237; m_sbc_dir = 229; m_sbc_imm = 233; m_sbc_s = 227; m_sec = 56; m_sep = 226; m_sta_abs = 141; m_sta_absX = 157; m_sta_dir = 133; m_sta_dirX = 149; m_sta_indl = 135; m_sta_indlY = 151; m_sta_long = 143; m_sta_longX = 159; m_sta_s = 131; m_stx_dir = 134; m_stx_abs = 142; m_sty_abs = 140; m_sty_dir = 132; m_sty_dirX = 148; m_stz_abs = 156; m_stz_absX = 158; m_stz_dir = 100; m_stz_dirX = 116; m_tax = 170; m_tay = 168; m_tcd = 91; m_tcs = 27; m_tdc = 123; m_tsx = $BA; m_txa = 138; m_txs = $9A; m_txy = 155; m_tya = 152; m_tyx = 187; m_tsb_dir = $04; m_tsb_abs = $0C; m_tsc = 59; m_xba = $EB; d_lab = 256; d_end = 257; d_bmov = 258; d_add = 259; d_pin = 260; d_wrd = 261; d_sym = 262; d_cns = 263; max_opcode = 263; {Code Generation} {---------------} maxCBuff = 191; {length of constant buffer} {Note: maxlabel is also defined in CCommon.pas} {Note: maxlabel is also defined in objout.asm} maxLabel = 2400; {max # of internal labels} maxLocalLabel = 200; {max # local variables} maxString = 8000; {max # chars in string space} {size of internal types} {----------------------} cgByteSize = 1; cgWordSize = 2; cgLongSize = 4; cgPointerSize = 4; cgRealSize = 4; cgDoubleSize = 8; cgCompSize = 8; cgExtendedSize = 10; type segNameType = packed array[1..10] of char; {segment name} {p code} {------} pcodes = {pcode names} (pc_adi,pc_adr,pc_and,pc_dvi,pc_dvr,pc_cnn,pc_cnv,pc_ior,pc_mod,pc_mpi, pc_mpr,pc_ngi,pc_ngr,pc_not,pc_sbi,pc_sbr,pc_sto,pc_dec,dc_loc,pc_ent, pc_fjp,pc_inc,pc_ind,pc_ixa,pc_lao,pc_lca,pc_ldo,pc_mov,pc_ret,pc_sro, pc_xjp,pc_cup,pc_equ,pc_geq,pc_grt,pc_lda,pc_ldc,pc_ldl,pc_leq,pc_les, pc_lil,pc_lld,pc_lli,pc_lod,pc_neq,pc_str,pc_ujp,pc_add,pc_lnm,pc_nam, pc_cui,pc_lad,pc_tjp,dc_lab,pc_usr,pc_umi,pc_udi, pc_uim,dc_enp,pc_stk,dc_glb,dc_dst,dc_str,pc_cop,pc_cpo,pc_tl1, dc_pin,pc_shl,pc_shr,pc_bnd,pc_bor,pc_bxr,pc_bnt,pc_bnl,pc_mpl,pc_dvl, pc_mdl,pc_sll,pc_slr,pc_bal,pc_ngl,pc_adl,pc_sbl,pc_blr,pc_blx, dc_sym,pc_lnd,pc_lor,pc_vsr,pc_uml,pc_udl,pc_ulm,pc_pop,pc_gil, pc_gli,pc_gdl,pc_gld,pc_cpi,pc_tri,pc_lbu,pc_lbf,pc_sbf,pc_cbf,dc_cns, dc_prm,pc_nat,pc_bno,pc_nop,pc_psh,pc_ili,pc_iil,pc_ild,pc_idl); {intermediate code} {-----------------} icptr = ^intermediate_code; intermediate_code = record {intermediate code record} opcode: pcodes; {operation code} q,r,s: integer; {operands} lab: stringPtr; {named label pointer} next: icptr; {ptr to next statement} left, right: icptr; {leaves for trees} parents: integer; {number of parents} case optype: baseTypeEnum of cgByte, cgUByte, cgWord, cgUWord : (opnd: longint; llab,slab: integer); cgLong, cgULong : (lval: longint); cgReal, cgDouble, cgComp, cgExtended : (rval: double); cgString : (str: longStringPtr); cgVoid, ccPointer : (pval: longint; pstr: longStringPtr); end; {basic blocks} {------------} iclist = ^iclistRecord; {used to form lists of records} iclistRecord = record next: iclist; op: icptr; end; blockPtr = ^block; {basic block edges} blockListPtr = ^blockListRecord; {lists of blocks} block = record last, next: blockPtr; {for doubly linked list of blocks} dfn: integer; {depth first order index} visited: boolean; {has this node been visited?} code: icptr; {code in the block} c_in: iclist; {list of reaching definitions} c_out: iclist; {valid definitions on exit} c_gen: iclist; {generated definitions} dom: blockListPtr; {dominators of this block} end; blockListRecord = record {lists of blocks} next, last: blockListPtr; dfn: integer; end; {65816 native code generation} {----------------------------} addressingMode = (implied,immediate, {65816 addressing modes} longabs,longrelative,relative,absolute,direct,gnrLabel,gnrSpace, gnrConstant,genaddress,special,longabsolute); var {current instruction info} {------------------------} isJSL: boolean; {is the current opcode a jsl?} {65816 native code generation} {----------------------------} longA,longI: boolean; {register sizes} {variables used to control the } {quality or characteristics of } {code } {------------------------------} checkStack: boolean; {check stack for stack errors?} cLineOptimize: boolean; {+o flag set?} code: icptr; {current intermediate code record} codeGeneration: boolean; {is code generation on?} commonSubexpression: boolean; {do common subexpression removal?} currentSegment,defaultSegment: segNameType; {current & default seg names} segmentKind: integer; {kind field of segment (ored with start/data)} debugFlag: boolean; {generate debugger calls?} dataBank: boolean; {save, restore data bank?} floatCard: integer; {0 -> SANE; 1 -> FPE} floatSlot: integer; {FPE slot} loopOptimizations: boolean; {do loop optimizations?} noroot: boolean; {prevent creation of .root file?} npeephole: boolean; {do native code peephole optimizations?} peephole: boolean; {do peephole optimization?} profileFlag: boolean; {generate profiling code?} rangeCheck: boolean; {generate range checks?} registers: boolean; {do register optimizations?} rtl: boolean; {return with an rtl?} saveStack: boolean; {save, restore caller's stack reg?} smallMemoryModel: boolean; {is the small model in use?} stackSize: integer; {amount of stack space to reserve} strictVararg: boolean; {repair stack around vararg calls?} stringsize: 0..maxstring; {amount of string space left} stringspace: packed array[1..maxstring] of char; {string table} symLength: integer; {length of debug symbol table} toolParms: boolean; {generate tool format paramaters?} volatile: boolean; {has a volatile qualifier been used?} {desk accessory variables} {------------------------} isNewDeskAcc: boolean; {is this a new desk acc?} isClassicDeskAcc: boolean; {is this a classic desk acc?} isCDev: boolean; {is this a control panel device?} isNBA: boolean; {is this a new button action?} isXCMD: boolean; {is this an XCMD?} openName,closeName,actionName, {names of the required procedures} initName: stringPtr; refreshPeriod: integer; {refresh period} eventMask: integer; {event mask} menuLine: pString; {name in menu bar} {DAG construction} {----------------} DAGhead: icPtr; {1st ic in DAG list} DAGblocks: blockPtr; {list of basic blocks} {---------------------------------------------------------------} procedure CodeGenFini; { terminal processing } procedure CodeGenInit (keepName: gsosOutStringPtr; keepFlag: integer; partial: boolean); { code generator initialization } { } { parameters: } { keepName - name of the output file } { keepFlag - keep status: } { 0 - don't keep the output } { 1 - create a new object module } { 2 - a .root already exists } { 3 - at least on .letter file exists } { partial - is this a partial compile? } procedure CodeGenScalarInit; { initialize codegen scalars } {procedure InitWriteCode; {debug} { initialize the intermediate code opcode table } procedure Gen0 (fop: pcodes); { generate an implied operand instruction } { } { parameters: } { fop - operation code } procedure Gen1 (fop: pcodes; fp2: integer); { generate an instruction with one numeric operand } { } { parameters: } { fop - operation code } { fp2 - operand } procedure Gen2 (fop: pcodes; fp1, fp2: integer); { generate an instruction with two numeric operands } { } { parameters: } { fop - operation code } { fp1 - first operand } { fp2 - second operand } procedure Gen3 (fop: pcodes; fp1, fp2, fp3: integer); { generate an instruction with three numeric operands } { } { parameters: } { fop - operation code } { fp1 - first operand } { fp2 - second operand } { fp3 - third operand } procedure Gen0Name (fop: pcodes; name: stringPtr); { generate a p-code with a name } { } { parameters: } { fop - operation code } { name - named label } procedure Gen1Name (fop: pcodes; fp1: integer; name: stringPtr); { generate a one operand p-code with a name } { } { parameters: } { fop - operation code } { fp1 - first operand } { name - named label } procedure Gen2Name (fop: pcodes; fp1, fp2: integer; name: stringPtr); { generate a two operand p-code with a name } { } { parameters: } { fop - operation code } { fp1 - first operand } { fp2 - second operand } { name - named label } procedure Gen0tName (fop: pcodes; tp: baseTypeEnum; name: stringPtr); { generate a typed zero operand p-code with a name } { } { parameters: } { fop - operation code } { tp - base type } { name - named label } procedure Gen1tName (fop: pcodes; fp1: integer; tp: baseTypeEnum; name: stringPtr); { generate a typed one operand p-code with a name } { } { parameters: } { fop - operation code } { fp1 - first operand } { tp - base type } { name - named label } procedure Gen2tName (fop: pcodes; fp1, fp2: integer; tp: baseTypeEnum; name: stringPtr); { generate a typed two operand p-code with a name } { } { parameters: } { fop - operation code } { fp1 - first operand } { fp2 - second operand } { tp - base type } { name - named label } procedure Gen0t (fop: pcodes; tp: baseTypeEnum); { generate a typed implied operand instruction } { } { parameters: } { fop - operation code } { tp - base type } procedure Gen1t (fop: pcodes; fp1: integer; tp: baseTypeEnum); { generate a typed instruction with two numeric operands } { } { parameters: } { fop - operation code } { fp1 - operand } { tp - base type } procedure Gen2t (fop: pcodes; fp1, fp2: integer; tp: baseTypeEnum); { generate a typed instruction with two numeric operands } { } { parameters: } { fop - operation code } { fp1 - first operand } { fp2 - second operand } { tp - base type } procedure Gen3t (fop: pcodes; fp1, fp2, fp3: integer; tp: baseTypeEnum); { generate a typed instruction with three numeric operands } { } { parameters: } { fop - operation code } { fp1 - first operand } { fp2 - second operand } { fp3 - second operand } { tp - base type } procedure GenPS (fop: pcodes; str: stringPtr); { generate an instruction that uses a p-string operand } { } { parameters: } { fop - operation code } { str - pointer to string } procedure GenS (fop: pcodes; str: longstringPtr); { generate an instruction that uses a string operand } { } { parameters: } { fop - operation code } { str - pointer to string } procedure GenL1 (fop: pcodes; lval: longint; fp1: integer); { generate an instruction that uses a longint and an int } { } { parameters: } { lval - longint parameter } { fp1 - integer parameter } procedure GenR1t (fop: pcodes; rval: double; fp1: integer; tp: baseTypeEnum); { generate an instruction that uses a real and an int } { } { parameters: } { rval - real parameter } { fp1 - integer parameter } { tp - base type } procedure GenLdcLong (lval: longint); { load a long constant } { } { parameters: } { lval - value to load } procedure GenLdcReal (rval: double); { load a real constant } { } { parameters: } { rval - value to load } procedure GenTool (fop: pcodes; fp1, fp2: integer; dispatcher: longint); { generate a tool call } { } { parameters: } { fop - operation code } { fp1 - tool number } { fp2 - return size } { dispatcher - tool entry point } {procedure PrintBlocks (tag: stringPtr; bp: blockPtr); {debug} { print a series of basic blocks } { } { parameters: } { tag - label for lines } { bp - first block to print } function TypeSize (tp: baseTypeEnum): integer; { Find the size, in bytes, of a variable } { } { parameters: } { tp - base type of the variable } {procedure WriteCode (code: icptr); {debug} { print an intermediate code instruction } { } { Parameters: } { code - intermediate code instruction to write } {------------------------------------------------------------------------------} implementation {var opt: array[pcodes] of packed array[1..3] of char; {debug} {Imported from CGC.pas:} function Calloc (bytes: integer): ptr; extern; { Allocate memory from a pool and clear it. } { } { Parameters: } { bytes - number of bytes to allocate } { ptr - points to the first byte of the allocated memory } { } { Globals: } { useGlobalPool - should the memory come from the global } { (or local) pool } procedure Error (err: integer); extern; {in scanner.pas} { flag an error } { } { err - error number } function Malloc (bytes: integer): ptr; extern; { Allocate memory from a pool. } { } { Parameters: } { bytes - number of bytes to allocate } { ptr - points to the first byte of the allocated memory } { } { Globals: } { useGlobalPool - should the memory come from the global } { (or local) pool } procedure InitLabels; extern; { initialize the labels array for a procedure } {Imported from ObjOut.pas:} procedure CloseObj; extern; { close the current obj file } {Imported from Native.pas:} procedure InitFile (keepName: gsosOutStringPtr; keepFlag: integer; partial: boolean); extern; { Set up the object file } { } { parameters: } { keepName - name of the output file } { keepFlag - keep status: } { 0 - don't keep the output } { 1 - create a new object module } { 2 - a .root already exists } { 3 - at least on .letter file exists } { partial - is this a partial compile? } {Imported from DAG.pas:} procedure DAG (code: icptr); extern; { place an op code in a DAG or tree } { } { parameters: } { code - opcode } {------------------------------------------------------------------------------} { copy 'cgi.debug'} {debug} procedure CodeGenInit {keepName: gsosOutStringPtr; keepFlag: integer; partial: boolean}; { code generator initialization } { } { parameters: } { keepName - name of the output file } { keepFlag - keep status: } { 0 - don't keep the output } { 1 - create a new object module } { 2 - a .root already exists } { 3 - at least on .letter file exists } { partial - is this a partial compile? } begin {CodeGenInit} {initialize the debug tables {debug} {InitWriteCode; {debug} {initialize the label table} InitLabels; codeGeneration := true; {turn on code generation} {set up the DAG variables} DAGhead := nil; {no ics in DAG list} InitFile(keepName, keepFlag, partial); {open the interface file} end; {CodeGenInit} procedure CodeGenFini; { terminal processing } begin {CodeGenFini} CloseObj; {close the open object file} end; {CodeGenFini} procedure CodeGenScalarInit; { initialize codegen scalars } begin {CodeGenScalarInit} isJSL := false; {the current opcode is not a jsl} isNewDeskAcc := false; {assume a normal program} isCDev := false; isClassicDeskAcc := false; isNBA := false; isXCMD := false; codeGeneration := false; {code generation is not turned on yet} currentSegment := ' '; {start with the blank segment} defaultSegment := ' '; smallMemoryModel := true; {small memory model} dataBank := false; {don't save/restore data bank} strictVararg := not cLineOptimize; {save/restore caller's stack around vararg} saveStack := not cLineOptimize; {save/restore caller's stack reg} checkStack := false; {don't check stack for stack errors} stackSize := 0; {default to the launcher's stack size} toolParms := false; {generate tool format parameters?} noroot := false; {create a .root segment} rtl := false; {return with a ~QUIT} floatCard := 0; {use SANE} floatSlot := 0; {default to slot 0} stringSize := 0; {no strings, yet} rangeCheck := false; {don't generate range checks} profileFlag := false; {don't generate profiling code} debugFlag := false; {don't generate debug code} traceBack := false; {don't generate traceback code} volatile := false; {no volatile quialifiers found} registers := cLineOptimize; {don't do register optimizations} peepHole := cLineOptimize; {not doing peephole optimization (yet)} npeepHole := cLineOptimize; commonSubexpression := cLineOptimize; {not doing common subexpression elimination} loopOptimizations := cLineOptimize; {not doing loop optimizations, yet} {allocate the initial p-code} code := pointer(Calloc(sizeof(intermediate_code))); code^.optype := cgWord; end; {CodeGenScalarInit} procedure Gen0 {fop: pcodes}; { generate an implied operand instruction } { } { parameters: } { fop - operation code } begin {Gen0} if codeGeneration then begin {generate the intermediate code instruction} code^.opcode := fop; { if printSymbols then {debug} { WriteCode(code); {debug} DAG(code); {generate the code} {initialize volitile variables for next intermediate code} code := pointer(Calloc(sizeof(intermediate_code))); {code^.lab := nil;} code^.optype := cgWord; end; {if} end; {Gen0} procedure Gen1 {fop: pcodes; fp2: integer}; { generate an instruction with one numeric operand } { } { parameters: } { fop - operation code } { fp2 - operand } begin {Gen1} if codeGeneration then begin if fop = pc_ret then code^.optype := cgVoid; code^.q := fp2; Gen0(fop); end; {if} end; {Gen1} procedure Gen2 {fop: pcodes; fp1, fp2: integer}; { generate an instruction with two numeric operands } { } { parameters: } { fop - operation code } { fp1 - first operand } { fp2 - second operand } label 1; var lcode: icptr; {local copy of code} begin {Gen2} if codeGeneration then begin lcode := code; case fop of pc_lnm,pc_tl1,pc_lda,dc_loc,pc_mov: begin lcode^.r := fp1; lcode^.q := fp2; end; pc_cnn,pc_cnv: if fp1 = fp2 then goto 1 else if (baseTypeEnum(fp1) in [cgReal,cgDouble,cgComp,cgExtended]) and (baseTypeEnum(fp2) in [cgReal,cgDouble,cgComp,cgExtended]) then goto 1 else if (baseTypeEnum(fp1) in [cgUByte,cgWord,cgUWord]) and (baseTypeEnum(fp2) in [cgWord,cgUWord]) then goto 1 else if (baseTypeEnum(fp1) in [cgByte,cgUByte]) and (baseTypeEnum(fp2) in [cgByte,cgUByte]) then goto 1 else lcode^.q := (fp1 << 4) | fp2; otherwise: Error(cge1); end; {case} Gen0(fop); end; {if} 1: end; {Gen2} procedure Gen3 {fop: pcodes; fp1, fp2, fp3: integer}; { generate an instruction with three numeric operands } { } { parameters: } { fop - operation code } { fp1 - first operand } { fp2 - second operand } { fp3 - third operand } var lcode: icptr; {local copy of code} begin {Gen3} if codeGeneration then begin lcode := code; lcode^.s := fp1; lcode^.q := fp2; lcode^.r := fp3; Gen0(fop); end; {if} end; {Gen3} procedure Gen0Name {fop: pcodes; name: stringPtr}; { generate a p-code with a name } { } { parameters: } { fop - operation code } { name - named label } begin {Gen0Name} if codeGeneration then begin code^.lab := name; Gen0(fop); end; {if} end; {Gen0Name} procedure Gen1Name {fop: pcodes; fp1: integer; name: stringPtr}; { generate a one operand p-code with a name } { } { parameters: } { fop - operation code } { fp1 - first operand } { name - named label } var lcode: icptr; {local copy of code} begin {Gen1Name} if codeGeneration then begin lcode := code; lcode^.q := fp1; lcode^.lab := name; Gen0(fop); end; {if} end; {Gen1Name} procedure Gen2Name {fop: pcodes; fp1, fp2: integer; name: stringPtr}; { generate a two operand p-code with a name } { } { parameters: } { fop - operation code } { fp1 - first operand } { fp2 - second operand } { name - named label } var lcode: icptr; {local copy of code} begin {Gen2Name} if codeGeneration then begin lcode := code; lcode^.q := fp2; lcode^.r := fp1; lcode^.lab := name; Gen0(fop); end; {if} end; {Gen2Name} procedure Gen0tName {fop: pcodes; tp: baseTypeEnum; name: stringPtr}; { generate a typed zero operand p-code with a name } { } { parameters: } { fop - operation code } { tp - base type } { name - named label } var lcode: icptr; {local copy of code} begin {Gen0tName} if codeGeneration then begin lcode := code; lcode^.lab := name; lcode^.optype := tp; Gen0(fop); end; {if} end; {Gen0tName} procedure Gen1tName {fop: pcodes; fp1: integer; tp: baseTypeEnum; name: stringPtr}; { generate a typed one operand p-code with a name } { } { parameters: } { fop - operation code } { fp1 - first operand } { tp - base type } { name - named label } var lcode: icptr; {local copy of code} begin {Gen1tName} if codeGeneration then begin lcode := code; lcode^.q := fp1; lcode^.lab := name; lcode^.optype := tp; Gen0(fop); end; {if} end; {Gen1tName} procedure Gen2tName {fop: pcodes; fp1, fp2: integer; tp: baseTypeEnum; name: stringPtr}; { generate a typed two operand p-code with a name } { } { parameters: } { fop - operation code } { fp1 - first operand } { fp2 - second operand } { tp - base type } { name - named label } var lcode: icptr; {local copy of code} begin {Gen2tName} if codeGeneration then begin lcode := code; lcode^.r := fp1; lcode^.q := fp2; lcode^.lab := name; lcode^.optype := tp; Gen0(fop); end; {if} end; {Gen2tName} procedure Gen0t {fop: pcodes; tp: baseTypeEnum}; { generate a typed implied operand instruction } { } { parameters: } { fop - operation code } { tp - base type } begin {Gen0t} if codeGeneration then begin code^.optype := tp; Gen0(fop); end; {if} end; {Gen0t} procedure Gen1t {fop: pcodes; fp1: integer; tp: baseTypeEnum}; { generate a typed instruction with one numeric operand } { } { parameters: } { fop - operation code } { fp1 - operand } { tp - base type } var lcode: icptr; {local copy of code} begin {Gen1t} if codeGeneration then begin lcode := code; lcode^.optype := tp; lcode^.q := fp1; Gen0(fop); end; {if} end; {Gen1t} procedure Gen2t {fop: pcodes; fp1, fp2: integer; tp: baseTypeEnum}; { generate a typed instruction with two numeric operands } { } { parameters: } { fop - operation code } { fp1 - first operand } { fp2 - second operand } { tp - base type } var lcode: icptr; {local copy of code} begin {Gen2t} if codeGeneration then begin lcode := code; lcode^.optype := tp; lcode^.r := fp1; lcode^.q := fp2; Gen0(fop); end; {if} end; {Gen2t} procedure Gen3t {fop: pcodes; fp1, fp2, fp3: integer; tp: baseTypeEnum}; { generate a typed instruction with three numeric operands } { } { parameters: } { fop - operation code } { fp1 - first operand } { fp2 - second operand } { fp3 - second operand } { tp - base type } var lcode: icptr; {local copy of code} begin {Gen3t} if codeGeneration then begin lcode := code; lcode^.optype := tp; lcode^.s := fp1; lcode^.q := fp2; lcode^.r := fp3; Gen0(fop); end; {if} end; {Gen3t} procedure GenPS {fop: pcodes; str: stringPtr}; { generate an instruction that uses a p-string operand } { } { parameters: } { fop - operation code } { str - pointer to string } var lcode: icptr; {local copy of code} begin {GenPS} if codeGeneration then begin lcode := code; lcode^.optype := cgString; lcode^.q := length(str^); lcode^.str := pointer(ord4(str)-1); Gen0(fop); end; {if} end; {GenPS} procedure GenS {fop: pcodes; str: longstringPtr}; { generate an instruction that uses a string operand } { } { parameters: } { fop - operation code } { str - pointer to string } var lcode: icptr; {local copy of code} begin {GenS} if codeGeneration then begin lcode := code; lcode^.optype := cgString; lcode^.q := str^.length; lcode^.str := str; Gen0(fop); end; {if} end; {GenS} procedure GenL1 {fop: pcodes; lval: longint; fp1: integer}; { generate an instruction that uses a longint and an int } { } { parameters: } { lval - longint parameter } { fp1 - integer parameter } var lcode: icptr; {local copy of code} begin {GenL1} if codeGeneration then begin lcode := code; lcode^.optype := cgLong; lcode^.lval := lval; lcode^.q := fp1; Gen0(fop); end; {if} end; {GenL1} procedure GenR1t {fop: pcodes; rval: double; fp1: integer; tp: baseTypeEnum}; { generate an instruction that uses a real and an int } { } { parameters: } { rval - real parameter } { fp1 - integer parameter } { tp - base type } var lcode: icptr; {local copy of code} begin {GenR1t} if codeGeneration then begin lcode := code; lcode^.optype := tp; lcode^.rval := rval; lcode^.q := fp1; Gen0(fop); end; {if} end; {GenR1t} procedure GenLdcLong {lval: longint}; { load a long constant } { } { parameters: } { lval - value to load } var lcode: icptr; {local copy of code} begin {GenLdcLong} if codeGeneration then begin lcode := code; lcode^.optype := cgLong; lcode^.lval := lval; Gen0(pc_ldc); end; {if} end; {GenLdcLong} procedure GenTool {fop: pcodes; fp1, fp2: integer; dispatcher: longint}; { generate a tool call } { } { parameters: } { fop - operation code } { fp1 - tool number } { fp2 - return size } { dispatcher - tool entry point } var lcode: icptr; {local copy of code} begin {GenTool} if codeGeneration then begin lcode := code; lcode^.q := fp1; lcode^.r := fp2; lcode^.optype := cgLong; lcode^.lval := dispatcher; Gen0(fop); end; {if} end; {GenTool} procedure GenLdcReal {rval: double}; { load a real constant } { } { parameters: } { rval - value to load } var lcode: icptr; {local copy of code} begin {GenLdcReal} if codeGeneration then begin lcode := code; lcode^.optype := cgReal; lcode^.rval := rval; Gen0(pc_ldc); end; {if} end; {GenLdcReal} function TypeSize {tp: baseTypeEnum): integer}; { Find the size, in bytes, of a variable } { } { parameters: } { tp - base type of the variable } begin {TypeSize} case tp of cgByte,cgUByte: TypeSize := cgByteSize; cgWord,cgUWord: TypeSize := cgWordSize; cgLong,cgULong: TypeSize := cgLongSize; cgReal: TypeSize := cgRealSize; cgDouble: TypeSize := cgDoubleSize; cgComp: TypeSize := cgCompSize; cgExtended: TypeSize := cgExtendedSize; cgString: TypeSize := cgByteSize; cgVoid,ccPointer: TypeSize := cgLongSize; end; {case} end; {TypeSize} end. \ No newline at end of file +{$optimize 7} +{---------------------------------------------------------------} +{ } +{ ORCA Code Generator Interface } +{ } +{ This unit serves as the glue code attaching a compiler } +{ to the code generator. It provides subroutines in a } +{ format that is convinient for the compiler during } +{ semantic analysis, and produces intermediate code records } +{ as output. These intermediate code records are then } +{ passed on to the code generator for optimization and } +{ native code generation. } +{ } +{$copy 'cgi.comments'} +{---------------------------------------------------------------} + +unit CodeGeneratorInterface; + +interface + +{$segment 'cg'} + +{$LibPrefix '0/obj/'} + +uses CCommon; + +const + {Error interface: these constants map } + {code generator error numbers into the } + {numbers used by the compiler's Error } + {subroutine. } + {--------------------------------------} + cge1 = 57; {compiler error} + cge2 = 58; {implementation restriction: too many local labels} + cge3 = 60; {implementation restriction: string space exhausted} + + {65816 native code generation} + {----------------------------} + {instruction modifier flags} + shift8 = 1; {shift operand left 8 bits} + shift16 = 2; {shift operand left 16 bits} + toolCall = 4; {generate a tool call} + stringReference = 8; {generate a string reference} + isPrivate = 32; {is the label private?} + constantOpnd = 64; {the absolute operand is a constant} + localLab = 128; {the operand is a local lab} + + m_adc_abs = $6D; {op code #s for 65816 instructions} + m_adc_dir = $65; + m_adc_imm = $69; + m_adc_s = $63; + m_and_abs = $2D; + m_and_dir = $25; + m_and_imm = $29; + m_and_s = $23; + m_asl_a = $0A; + m_bcc = $90; + m_bcs = $B0; + m_beq = $F0; + m_bit_imm = $89; + m_bmi = $30; + m_bne = $D0; + m_bpl = $10; + m_bra = $80; + m_brl = $82; + m_bvs = $70; + m_clc = $18; + m_cmp_abs = $CD; + m_cmp_dir = $C5; + m_cmp_dirX = $D5; + m_cmp_imm = $C9; + m_cmp_long = $CF; + m_cmp_s = $C3; + m_cop = $02; + m_cpx_abs = 236; + m_cpx_dir = 228; + m_cpx_imm = 224; + m_dea = 58; + m_dec_abs = 206; + m_dec_absX = $DE; + m_dec_dir = 198; + m_dec_dirX = 214; + m_dex = 202; + m_dey = 136; + m_eor_abs = 77; + m_eor_dir = 69; + m_eor_imm = 73; + m_eor_s = 67; + m_ina = 26; + m_inc_abs = 238; + m_inc_absX = $FE; + m_inc_dir = 230; + m_inc_dirX = 246; + m_inx = 232; + m_iny = 200; + m_jml = 92; + m_jsl = 34; + m_lda_abs = 173; + m_lda_absx = 189; + m_lda_dir = 165; + m_lda_dirx = 181; + m_lda_imm = 169; + m_lda_indl = 167; + m_lda_indly = 183; + m_lda_long = 175; + m_lda_longx = 191; + m_lda_s = 163; + m_ldx_abs = 174; + m_ldx_dir = 166; + m_ldx_imm = 162; + m_ldy_abs = 172; + m_ldy_absX = 188; + m_ldy_dir = 164; + m_ldy_dirX = 180; + m_ldy_imm = 160; + m_lsr_a = 74; + m_mvn = 84; + m_ora_abs = 13; + m_ora_dir = 5; + m_ora_dirX = 21; + m_ora_imm = 9; + m_ora_longX = 31; + m_ora_s = 3; + m_pea = 244; + m_pei_dir = 212; + m_pha = 72; + m_phb = 139; + m_phd = 11; + m_phx = 218; + m_phy = 90; + m_php = 8; + m_pla = 104; + m_plb = 171; + m_pld = 43; + m_plx = 250; + m_ply = 122; + m_plp = 40; + m_rep = 194; + m_rtl = 107; + m_rts = 96; + m_sbc_abs = 237; + m_sbc_dir = 229; + m_sbc_imm = 233; + m_sbc_s = 227; + m_sec = 56; + m_sep = 226; + m_sta_abs = 141; + m_sta_absX = 157; + m_sta_dir = 133; + m_sta_dirX = 149; + m_sta_indl = 135; + m_sta_indlY = 151; + m_sta_long = 143; + m_sta_longX = 159; + m_sta_s = 131; + m_stx_dir = 134; + m_stx_abs = 142; + m_sty_abs = 140; + m_sty_dir = 132; + m_sty_dirX = 148; + m_stz_abs = 156; + m_stz_absX = 158; + m_stz_dir = 100; + m_stz_dirX = 116; + m_tax = 170; + m_tay = 168; + m_tcd = 91; + m_tcs = 27; + m_tdc = 123; + m_tsx = $BA; + m_txa = 138; + m_txs = $9A; + m_txy = 155; + m_tya = 152; + m_tyx = 187; + m_tsb_dir = $04; + m_tsb_abs = $0C; + m_tsc = 59; + m_xba = $EB; + + d_lab = 256; + d_end = 257; + d_bmov = 258; + d_add = 259; + d_pin = 260; + d_wrd = 261; + d_sym = 262; + d_cns = 263; + + max_opcode = 263; + + {Code Generation} + {---------------} + maxCBuff = 191; {length of constant buffer} + {Note: maxlabel is also defined in CCommon.pas} + {Note: maxlabel is also defined in objout.asm} + maxLabel = 2400; {max # of internal labels} + maxLocalLabel = 200; {max # local variables} + maxString = 8000; {max # chars in string space} + + {size of internal types} + {----------------------} + cgByteSize = 1; + cgWordSize = 2; + cgLongSize = 4; + cgPointerSize = 4; + cgRealSize = 4; + cgDoubleSize = 8; + cgCompSize = 8; + cgExtendedSize = 10; + +type + segNameType = packed array[1..10] of char; {segment name} + + {p code} + {------} + pcodes = {pcode names} + (pc_adi,pc_adr,pc_and,pc_dvi,pc_dvr,pc_cnn,pc_cnv,pc_ior,pc_mod,pc_mpi, + pc_mpr,pc_ngi,pc_ngr,pc_not,pc_sbi,pc_sbr,pc_sto,pc_dec,dc_loc,pc_ent, + pc_fjp,pc_inc,pc_ind,pc_ixa,pc_lao,pc_lca,pc_ldo,pc_mov,pc_ret,pc_sro, + pc_xjp,pc_cup,pc_equ,pc_geq,pc_grt,pc_lda,pc_ldc,pc_ldl,pc_leq,pc_les, + pc_lil,pc_lld,pc_lli,pc_lod,pc_neq,pc_str,pc_ujp,pc_add,pc_lnm,pc_nam, + pc_cui,pc_lad,pc_tjp,dc_lab,pc_usr,pc_umi,pc_udi, + pc_uim,dc_enp,pc_stk,dc_glb,dc_dst,dc_str,pc_cop,pc_cpo,pc_tl1, + dc_pin,pc_shl,pc_shr,pc_bnd,pc_bor,pc_bxr,pc_bnt,pc_bnl,pc_mpl,pc_dvl, + pc_mdl,pc_sll,pc_slr,pc_bal,pc_ngl,pc_adl,pc_sbl,pc_blr,pc_blx, + dc_sym,pc_lnd,pc_lor,pc_vsr,pc_uml,pc_udl,pc_ulm,pc_pop,pc_gil, + pc_gli,pc_gdl,pc_gld,pc_cpi,pc_tri,pc_lbu,pc_lbf,pc_sbf,pc_cbf,dc_cns, + dc_prm,pc_nat,pc_bno,pc_nop,pc_psh,pc_ili,pc_iil,pc_ild,pc_idl); + + {intermediate code} + {-----------------} + icptr = ^intermediate_code; + intermediate_code = record {intermediate code record} + opcode: pcodes; {operation code} + q,r,s: integer; {operands} + lab: stringPtr; {named label pointer} + next: icptr; {ptr to next statement} + left, right: icptr; {leaves for trees} + parents: integer; {number of parents} + case optype: baseTypeEnum of + cgByte, + cgUByte, + cgWord, + cgUWord : (opnd: longint; llab,slab: integer); + cgLong, + cgULong : (lval: longint); + cgReal, + cgDouble, + cgComp, + cgExtended : (rval: double); + cgString : (str: longStringPtr); + cgVoid, + ccPointer : (pval: longint; pstr: longStringPtr); + end; + + {basic blocks} + {------------} + iclist = ^iclistRecord; {used to form lists of records} + iclistRecord = record + next: iclist; + op: icptr; + end; + + blockPtr = ^block; {basic block edges} + blockListPtr = ^blockListRecord; {lists of blocks} + block = record + last, next: blockPtr; {for doubly linked list of blocks} + dfn: integer; {depth first order index} + visited: boolean; {has this node been visited?} + code: icptr; {code in the block} + c_in: iclist; {list of reaching definitions} + c_out: iclist; {valid definitions on exit} + c_gen: iclist; {generated definitions} + dom: blockListPtr; {dominators of this block} + end; + + blockListRecord = record {lists of blocks} + next, last: blockListPtr; + dfn: integer; + end; + + {65816 native code generation} + {----------------------------} + addressingMode = (implied,immediate, {65816 addressing modes} + longabs,longrelative,relative,absolute,direct,gnrLabel,gnrSpace, + gnrConstant,genaddress,special,longabsolute); + +var + {current instruction info} + {------------------------} + isJSL: boolean; {is the current opcode a jsl?} + + {65816 native code generation} + {----------------------------} + longA,longI: boolean; {register sizes} + + {variables used to control the } + {quality or characteristics of } + {code } + {------------------------------} + checkStack: boolean; {check stack for stack errors?} + cLineOptimize: boolean; {+o flag set?} + code: icptr; {current intermediate code record} + codeGeneration: boolean; {is code generation on?} + commonSubexpression: boolean; {do common subexpression removal?} + currentSegment,defaultSegment: segNameType; {current & default seg names} + segmentKind: integer; {kind field of segment (ored with start/data)} + debugFlag: boolean; {generate debugger calls?} + dataBank: boolean; {save, restore data bank?} + floatCard: integer; {0 -> SANE; 1 -> FPE} + floatSlot: integer; {FPE slot} + loopOptimizations: boolean; {do loop optimizations?} + noroot: boolean; {prevent creation of .root file?} + npeephole: boolean; {do native code peephole optimizations?} + peephole: boolean; {do peephole optimization?} + profileFlag: boolean; {generate profiling code?} + rangeCheck: boolean; {generate range checks?} + registers: boolean; {do register optimizations?} + rtl: boolean; {return with an rtl?} + saveStack: boolean; {save, restore caller's stack reg?} + smallMemoryModel: boolean; {is the small model in use?} + stackSize: integer; {amount of stack space to reserve} + strictVararg: boolean; {repair stack around vararg calls?} + stringsize: 0..maxstring; {amount of string space left} + stringspace: packed array[1..maxstring] of char; {string table} + symLength: integer; {length of debug symbol table} + toolParms: boolean; {generate tool format paramaters?} + volatile: boolean; {has a volatile qualifier been used?} + + {desk accessory variables} + {------------------------} + isNewDeskAcc: boolean; {is this a new desk acc?} + isClassicDeskAcc: boolean; {is this a classic desk acc?} + isCDev: boolean; {is this a control panel device?} + isNBA: boolean; {is this a new button action?} + isXCMD: boolean; {is this an XCMD?} + openName,closeName,actionName, {names of the required procedures} + initName: stringPtr; + refreshPeriod: integer; {refresh period} + eventMask: integer; {event mask} + menuLine: pString; {name in menu bar} + + {DAG construction} + {----------------} + DAGhead: icPtr; {1st ic in DAG list} + DAGblocks: blockPtr; {list of basic blocks} + +{---------------------------------------------------------------} + +procedure CodeGenFini; + +{ terminal processing } + + +procedure CodeGenInit (keepName: gsosOutStringPtr; keepFlag: integer; + partial: boolean); + +{ code generator initialization } +{ } +{ parameters: } +{ keepName - name of the output file } +{ keepFlag - keep status: } +{ 0 - don't keep the output } +{ 1 - create a new object module } +{ 2 - a .root already exists } +{ 3 - at least on .letter file exists } +{ partial - is this a partial compile? } + + +procedure CodeGenScalarInit; + +{ initialize codegen scalars } + + +{procedure InitWriteCode; {debug} + +{ initialize the intermediate code opcode table } + + +procedure Gen0 (fop: pcodes); + +{ generate an implied operand instruction } +{ } +{ parameters: } +{ fop - operation code } + + +procedure Gen1 (fop: pcodes; fp2: integer); + +{ generate an instruction with one numeric operand } +{ } +{ parameters: } +{ fop - operation code } +{ fp2 - operand } + + +procedure Gen2 (fop: pcodes; fp1, fp2: integer); + +{ generate an instruction with two numeric operands } +{ } +{ parameters: } +{ fop - operation code } +{ fp1 - first operand } +{ fp2 - second operand } + + +procedure Gen3 (fop: pcodes; fp1, fp2, fp3: integer); + +{ generate an instruction with three numeric operands } +{ } +{ parameters: } +{ fop - operation code } +{ fp1 - first operand } +{ fp2 - second operand } +{ fp3 - third operand } + + +procedure Gen0Name (fop: pcodes; name: stringPtr); + +{ generate a p-code with a name } +{ } +{ parameters: } +{ fop - operation code } +{ name - named label } + + +procedure Gen1Name (fop: pcodes; fp1: integer; name: stringPtr); + +{ generate a one operand p-code with a name } +{ } +{ parameters: } +{ fop - operation code } +{ fp1 - first operand } +{ name - named label } + + +procedure Gen2Name (fop: pcodes; fp1, fp2: integer; name: stringPtr); + +{ generate a two operand p-code with a name } +{ } +{ parameters: } +{ fop - operation code } +{ fp1 - first operand } +{ fp2 - second operand } +{ name - named label } + + +procedure Gen0tName (fop: pcodes; tp: baseTypeEnum; name: stringPtr); + +{ generate a typed zero operand p-code with a name } +{ } +{ parameters: } +{ fop - operation code } +{ tp - base type } +{ name - named label } + + +procedure Gen1tName (fop: pcodes; fp1: integer; tp: baseTypeEnum; + name: stringPtr); + +{ generate a typed one operand p-code with a name } +{ } +{ parameters: } +{ fop - operation code } +{ fp1 - first operand } +{ tp - base type } +{ name - named label } + + +procedure Gen2tName (fop: pcodes; fp1, fp2: integer; tp: baseTypeEnum; + name: stringPtr); + +{ generate a typed two operand p-code with a name } +{ } +{ parameters: } +{ fop - operation code } +{ fp1 - first operand } +{ fp2 - second operand } +{ tp - base type } +{ name - named label } + + +procedure Gen0t (fop: pcodes; tp: baseTypeEnum); + +{ generate a typed implied operand instruction } +{ } +{ parameters: } +{ fop - operation code } +{ tp - base type } + + +procedure Gen1t (fop: pcodes; fp1: integer; tp: baseTypeEnum); + +{ generate a typed instruction with two numeric operands } +{ } +{ parameters: } +{ fop - operation code } +{ fp1 - operand } +{ tp - base type } + + +procedure Gen2t (fop: pcodes; fp1, fp2: integer; tp: baseTypeEnum); + +{ generate a typed instruction with two numeric operands } +{ } +{ parameters: } +{ fop - operation code } +{ fp1 - first operand } +{ fp2 - second operand } +{ tp - base type } + + +procedure Gen3t (fop: pcodes; fp1, fp2, fp3: integer; tp: baseTypeEnum); + +{ generate a typed instruction with three numeric operands } +{ } +{ parameters: } +{ fop - operation code } +{ fp1 - first operand } +{ fp2 - second operand } +{ fp3 - second operand } +{ tp - base type } + + +procedure GenPS (fop: pcodes; str: stringPtr); + +{ generate an instruction that uses a p-string operand } +{ } +{ parameters: } +{ fop - operation code } +{ str - pointer to string } + + +procedure GenS (fop: pcodes; str: longstringPtr); + +{ generate an instruction that uses a string operand } +{ } +{ parameters: } +{ fop - operation code } +{ str - pointer to string } + + +procedure GenL1 (fop: pcodes; lval: longint; fp1: integer); + +{ generate an instruction that uses a longint and an int } +{ } +{ parameters: } +{ lval - longint parameter } +{ fp1 - integer parameter } + + +procedure GenR1t (fop: pcodes; rval: double; fp1: integer; tp: baseTypeEnum); + +{ generate an instruction that uses a real and an int } +{ } +{ parameters: } +{ rval - real parameter } +{ fp1 - integer parameter } +{ tp - base type } + + +procedure GenLdcLong (lval: longint); + +{ load a long constant } +{ } +{ parameters: } +{ lval - value to load } + + +procedure GenLdcReal (rval: double); + +{ load a real constant } +{ } +{ parameters: } +{ rval - value to load } + + +procedure GenTool (fop: pcodes; fp1, fp2: integer; dispatcher: longint); + +{ generate a tool call } +{ } +{ parameters: } +{ fop - operation code } +{ fp1 - tool number } +{ fp2 - return size } +{ dispatcher - tool entry point } + + +{procedure PrintBlocks (tag: stringPtr; bp: blockPtr); {debug} + +{ print a series of basic blocks } +{ } +{ parameters: } +{ tag - label for lines } +{ bp - first block to print } + + +function TypeSize (tp: baseTypeEnum): integer; + +{ Find the size, in bytes, of a variable } +{ } +{ parameters: } +{ tp - base type of the variable } + + +{procedure WriteCode (code: icptr); {debug} + +{ print an intermediate code instruction } +{ } +{ Parameters: } +{ code - intermediate code instruction to write } + +{------------------------------------------------------------------------------} + +implementation + +{var + opt: array[pcodes] of packed array[1..3] of char; {debug} + +{Imported from CGC.pas:} + +function Calloc (bytes: integer): ptr; extern; + +{ Allocate memory from a pool and clear it. } +{ } +{ Parameters: } +{ bytes - number of bytes to allocate } +{ ptr - points to the first byte of the allocated memory } +{ } +{ Globals: } +{ useGlobalPool - should the memory come from the global } +{ (or local) pool } + + +procedure Error (err: integer); extern; {in scanner.pas} + +{ flag an error } +{ } +{ err - error number } + + +function Malloc (bytes: integer): ptr; extern; + +{ Allocate memory from a pool. } +{ } +{ Parameters: } +{ bytes - number of bytes to allocate } +{ ptr - points to the first byte of the allocated memory } +{ } +{ Globals: } +{ useGlobalPool - should the memory come from the global } +{ (or local) pool } + + +procedure InitLabels; extern; + +{ initialize the labels array for a procedure } + + +{Imported from ObjOut.pas:} + +procedure CloseObj; extern; + +{ close the current obj file } + +{Imported from Native.pas:} + +procedure InitFile (keepName: gsosOutStringPtr; keepFlag: integer; partial: boolean); +extern; + +{ Set up the object file } +{ } +{ parameters: } +{ keepName - name of the output file } +{ keepFlag - keep status: } +{ 0 - don't keep the output } +{ 1 - create a new object module } +{ 2 - a .root already exists } +{ 3 - at least on .letter file exists } +{ partial - is this a partial compile? } + + +{Imported from DAG.pas:} + +procedure DAG (code: icptr); extern; + +{ place an op code in a DAG or tree } +{ } +{ parameters: } +{ code - opcode } + +{------------------------------------------------------------------------------} + + +{ copy 'cgi.debug'} {debug} + +procedure CodeGenInit {keepName: gsosOutStringPtr; keepFlag: integer; + partial: boolean}; + +{ code generator initialization } +{ } +{ parameters: } +{ keepName - name of the output file } +{ keepFlag - keep status: } +{ 0 - don't keep the output } +{ 1 - create a new object module } +{ 2 - a .root already exists } +{ 3 - at least on .letter file exists } +{ partial - is this a partial compile? } + +begin {CodeGenInit} +{initialize the debug tables {debug} +{InitWriteCode; {debug} + +{initialize the label table} +InitLabels; + +codeGeneration := true; {turn on code generation} + +{set up the DAG variables} +DAGhead := nil; {no ics in DAG list} + +InitFile(keepName, keepFlag, partial); {open the interface file} +end; {CodeGenInit} + + +procedure CodeGenFini; + +{ terminal processing } + +begin {CodeGenFini} +CloseObj; {close the open object file} +end; {CodeGenFini} + + +procedure CodeGenScalarInit; + +{ initialize codegen scalars } + +begin {CodeGenScalarInit} +isJSL := false; {the current opcode is not a jsl} +isNewDeskAcc := false; {assume a normal program} +isCDev := false; +isClassicDeskAcc := false; +isNBA := false; +isXCMD := false; +codeGeneration := false; {code generation is not turned on yet} +currentSegment := ' '; {start with the blank segment} +defaultSegment := ' '; +smallMemoryModel := true; {small memory model} +dataBank := false; {don't save/restore data bank} +strictVararg := not cLineOptimize; {save/restore caller's stack around vararg} +saveStack := not cLineOptimize; {save/restore caller's stack reg} +checkStack := false; {don't check stack for stack errors} +stackSize := 0; {default to the launcher's stack size} +toolParms := false; {generate tool format parameters?} +noroot := false; {create a .root segment} +rtl := false; {return with a ~QUIT} +floatCard := 0; {use SANE} +floatSlot := 0; {default to slot 0} +stringSize := 0; {no strings, yet} + +rangeCheck := false; {don't generate range checks} +profileFlag := false; {don't generate profiling code} +debugFlag := false; {don't generate debug code} +traceBack := false; {don't generate traceback code} +volatile := false; {no volatile quialifiers found} + +registers := cLineOptimize; {don't do register optimizations} +peepHole := cLineOptimize; {not doing peephole optimization (yet)} +npeepHole := cLineOptimize; +commonSubexpression := cLineOptimize; {not doing common subexpression elimination} +loopOptimizations := cLineOptimize; {not doing loop optimizations, yet} + +{allocate the initial p-code} +code := pointer(Calloc(sizeof(intermediate_code))); +code^.optype := cgWord; +end; {CodeGenScalarInit} + + +procedure Gen0 {fop: pcodes}; + +{ generate an implied operand instruction } +{ } +{ parameters: } +{ fop - operation code } + +begin {Gen0} +if codeGeneration then begin + + {generate the intermediate code instruction} + code^.opcode := fop; +{ if printSymbols then {debug} +{ WriteCode(code); {debug} + DAG(code); {generate the code} + + {initialize volitile variables for next intermediate code} + code := pointer(Calloc(sizeof(intermediate_code))); + {code^.lab := nil;} + code^.optype := cgWord; + end; {if} +end; {Gen0} + + +procedure Gen1 {fop: pcodes; fp2: integer}; + +{ generate an instruction with one numeric operand } +{ } +{ parameters: } +{ fop - operation code } +{ fp2 - operand } + +begin {Gen1} +if codeGeneration then begin + if fop = pc_ret then + code^.optype := cgVoid; + code^.q := fp2; + Gen0(fop); + end; {if} +end; {Gen1} + + +procedure Gen2 {fop: pcodes; fp1, fp2: integer}; + +{ generate an instruction with two numeric operands } +{ } +{ parameters: } +{ fop - operation code } +{ fp1 - first operand } +{ fp2 - second operand } + +label 1; + +var + lcode: icptr; {local copy of code} + +begin {Gen2} +if codeGeneration then begin + lcode := code; + case fop of + + pc_lnm,pc_tl1,pc_lda,dc_loc,pc_mov: begin + lcode^.r := fp1; + lcode^.q := fp2; + end; + + pc_cnn,pc_cnv: + if fp1 = fp2 then + goto 1 + else if (baseTypeEnum(fp1) in [cgReal,cgDouble,cgComp,cgExtended]) + and (baseTypeEnum(fp2) in [cgReal,cgDouble,cgComp,cgExtended]) then + goto 1 + else if (baseTypeEnum(fp1) in [cgUByte,cgWord,cgUWord]) + and (baseTypeEnum(fp2) in [cgWord,cgUWord]) then + goto 1 + else if (baseTypeEnum(fp1) in [cgByte,cgUByte]) + and (baseTypeEnum(fp2) in [cgByte,cgUByte]) then + goto 1 + else + lcode^.q := (fp1 << 4) | fp2; + + otherwise: + Error(cge1); + end; {case} + + Gen0(fop); + end; {if} +1: +end; {Gen2} + + +procedure Gen3 {fop: pcodes; fp1, fp2, fp3: integer}; + +{ generate an instruction with three numeric operands } +{ } +{ parameters: } +{ fop - operation code } +{ fp1 - first operand } +{ fp2 - second operand } +{ fp3 - third operand } + +var + lcode: icptr; {local copy of code} + +begin {Gen3} +if codeGeneration then begin + lcode := code; + lcode^.s := fp1; + lcode^.q := fp2; + lcode^.r := fp3; + Gen0(fop); + end; {if} +end; {Gen3} + + +procedure Gen0Name {fop: pcodes; name: stringPtr}; + +{ generate a p-code with a name } +{ } +{ parameters: } +{ fop - operation code } +{ name - named label } + +begin {Gen0Name} +if codeGeneration then begin + code^.lab := name; + Gen0(fop); + end; {if} +end; {Gen0Name} + + +procedure Gen1Name {fop: pcodes; fp1: integer; name: stringPtr}; + +{ generate a one operand p-code with a name } +{ } +{ parameters: } +{ fop - operation code } +{ fp1 - first operand } +{ name - named label } + +var + lcode: icptr; {local copy of code} + +begin {Gen1Name} +if codeGeneration then begin + lcode := code; + lcode^.q := fp1; + lcode^.lab := name; + Gen0(fop); + end; {if} +end; {Gen1Name} + + +procedure Gen2Name {fop: pcodes; fp1, fp2: integer; name: stringPtr}; + +{ generate a two operand p-code with a name } +{ } +{ parameters: } +{ fop - operation code } +{ fp1 - first operand } +{ fp2 - second operand } +{ name - named label } + +var + lcode: icptr; {local copy of code} + +begin {Gen2Name} +if codeGeneration then begin + lcode := code; + lcode^.q := fp2; + lcode^.r := fp1; + lcode^.lab := name; + Gen0(fop); + end; {if} +end; {Gen2Name} + + +procedure Gen0tName {fop: pcodes; tp: baseTypeEnum; name: stringPtr}; + +{ generate a typed zero operand p-code with a name } +{ } +{ parameters: } +{ fop - operation code } +{ tp - base type } +{ name - named label } + +var + lcode: icptr; {local copy of code} + +begin {Gen0tName} +if codeGeneration then begin + lcode := code; + lcode^.lab := name; + lcode^.optype := tp; + Gen0(fop); + end; {if} +end; {Gen0tName} + + +procedure Gen1tName {fop: pcodes; fp1: integer; tp: baseTypeEnum; + name: stringPtr}; + +{ generate a typed one operand p-code with a name } +{ } +{ parameters: } +{ fop - operation code } +{ fp1 - first operand } +{ tp - base type } +{ name - named label } + +var + lcode: icptr; {local copy of code} + +begin {Gen1tName} +if codeGeneration then begin + lcode := code; + lcode^.q := fp1; + lcode^.lab := name; + lcode^.optype := tp; + Gen0(fop); + end; {if} +end; {Gen1tName} + + +procedure Gen2tName {fop: pcodes; fp1, fp2: integer; tp: baseTypeEnum; + name: stringPtr}; + +{ generate a typed two operand p-code with a name } +{ } +{ parameters: } +{ fop - operation code } +{ fp1 - first operand } +{ fp2 - second operand } +{ tp - base type } +{ name - named label } + +var + lcode: icptr; {local copy of code} + +begin {Gen2tName} +if codeGeneration then begin + lcode := code; + lcode^.r := fp1; + lcode^.q := fp2; + lcode^.lab := name; + lcode^.optype := tp; + Gen0(fop); + end; {if} +end; {Gen2tName} + + +procedure Gen0t {fop: pcodes; tp: baseTypeEnum}; + +{ generate a typed implied operand instruction } +{ } +{ parameters: } +{ fop - operation code } +{ tp - base type } + +begin {Gen0t} +if codeGeneration then begin + code^.optype := tp; + Gen0(fop); + end; {if} +end; {Gen0t} + + +procedure Gen1t {fop: pcodes; fp1: integer; tp: baseTypeEnum}; + +{ generate a typed instruction with one numeric operand } +{ } +{ parameters: } +{ fop - operation code } +{ fp1 - operand } +{ tp - base type } + +var + lcode: icptr; {local copy of code} + +begin {Gen1t} +if codeGeneration then begin + lcode := code; + lcode^.optype := tp; + lcode^.q := fp1; + Gen0(fop); + end; {if} +end; {Gen1t} + + +procedure Gen2t {fop: pcodes; fp1, fp2: integer; tp: baseTypeEnum}; + +{ generate a typed instruction with two numeric operands } +{ } +{ parameters: } +{ fop - operation code } +{ fp1 - first operand } +{ fp2 - second operand } +{ tp - base type } + +var + lcode: icptr; {local copy of code} + +begin {Gen2t} +if codeGeneration then begin + lcode := code; + lcode^.optype := tp; + lcode^.r := fp1; + lcode^.q := fp2; + Gen0(fop); + end; {if} +end; {Gen2t} + + +procedure Gen3t {fop: pcodes; fp1, fp2, fp3: integer; tp: baseTypeEnum}; + +{ generate a typed instruction with three numeric operands } +{ } +{ parameters: } +{ fop - operation code } +{ fp1 - first operand } +{ fp2 - second operand } +{ fp3 - second operand } +{ tp - base type } + +var + lcode: icptr; {local copy of code} + +begin {Gen3t} +if codeGeneration then begin + lcode := code; + lcode^.optype := tp; + lcode^.s := fp1; + lcode^.q := fp2; + lcode^.r := fp3; + Gen0(fop); + end; {if} +end; {Gen3t} + + +procedure GenPS {fop: pcodes; str: stringPtr}; + +{ generate an instruction that uses a p-string operand } +{ } +{ parameters: } +{ fop - operation code } +{ str - pointer to string } + +var + lcode: icptr; {local copy of code} + +begin {GenPS} +if codeGeneration then begin + lcode := code; + lcode^.optype := cgString; + lcode^.q := length(str^); + lcode^.str := pointer(ord4(str)-1); + Gen0(fop); + end; {if} +end; {GenPS} + + +procedure GenS {fop: pcodes; str: longstringPtr}; + +{ generate an instruction that uses a string operand } +{ } +{ parameters: } +{ fop - operation code } +{ str - pointer to string } + +var + lcode: icptr; {local copy of code} + +begin {GenS} +if codeGeneration then begin + lcode := code; + lcode^.optype := cgString; + lcode^.q := str^.length; + lcode^.str := str; + Gen0(fop); + end; {if} +end; {GenS} + + +procedure GenL1 {fop: pcodes; lval: longint; fp1: integer}; + +{ generate an instruction that uses a longint and an int } +{ } +{ parameters: } +{ lval - longint parameter } +{ fp1 - integer parameter } + +var + lcode: icptr; {local copy of code} + +begin {GenL1} +if codeGeneration then begin + lcode := code; + lcode^.optype := cgLong; + lcode^.lval := lval; + lcode^.q := fp1; + Gen0(fop); + end; {if} +end; {GenL1} + + +procedure GenR1t {fop: pcodes; rval: double; fp1: integer; tp: baseTypeEnum}; + +{ generate an instruction that uses a real and an int } +{ } +{ parameters: } +{ rval - real parameter } +{ fp1 - integer parameter } +{ tp - base type } + +var + lcode: icptr; {local copy of code} + +begin {GenR1t} +if codeGeneration then begin + lcode := code; + lcode^.optype := tp; + lcode^.rval := rval; + lcode^.q := fp1; + Gen0(fop); + end; {if} +end; {GenR1t} + + +procedure GenLdcLong {lval: longint}; + +{ load a long constant } +{ } +{ parameters: } +{ lval - value to load } + +var + lcode: icptr; {local copy of code} + +begin {GenLdcLong} +if codeGeneration then begin + lcode := code; + lcode^.optype := cgLong; + lcode^.lval := lval; + Gen0(pc_ldc); + end; {if} +end; {GenLdcLong} + + +procedure GenTool {fop: pcodes; fp1, fp2: integer; dispatcher: longint}; + +{ generate a tool call } +{ } +{ parameters: } +{ fop - operation code } +{ fp1 - tool number } +{ fp2 - return size } +{ dispatcher - tool entry point } + +var + lcode: icptr; {local copy of code} + +begin {GenTool} +if codeGeneration then begin + lcode := code; + lcode^.q := fp1; + lcode^.r := fp2; + lcode^.optype := cgLong; + lcode^.lval := dispatcher; + Gen0(fop); + end; {if} +end; {GenTool} + + +procedure GenLdcReal {rval: double}; + +{ load a real constant } +{ } +{ parameters: } +{ rval - value to load } + +var + lcode: icptr; {local copy of code} + +begin {GenLdcReal} +if codeGeneration then begin + lcode := code; + lcode^.optype := cgReal; + lcode^.rval := rval; + Gen0(pc_ldc); + end; {if} +end; {GenLdcReal} + + +function TypeSize {tp: baseTypeEnum): integer}; + +{ Find the size, in bytes, of a variable } +{ } +{ parameters: } +{ tp - base type of the variable } + +begin {TypeSize} +case tp of + cgByte,cgUByte: TypeSize := cgByteSize; + cgWord,cgUWord: TypeSize := cgWordSize; + cgLong,cgULong: TypeSize := cgLongSize; + cgReal: TypeSize := cgRealSize; + cgDouble: TypeSize := cgDoubleSize; + cgComp: TypeSize := cgCompSize; + cgExtended: TypeSize := cgExtendedSize; + cgString: TypeSize := cgByteSize; + cgVoid,ccPointer: TypeSize := cgLongSize; + end; {case} +end; {TypeSize} + +end. diff --git a/DAG.pas b/DAG.pas old mode 100755 new mode 100644 index 95e0699..e3600e6 --- a/DAG.pas +++ b/DAG.pas @@ -1 +1,4734 @@ -{$optimize 7} {---------------------------------------------------------------} { } { DAG Creation } { } { Places intermediate codes into DAGs and trees. } { } {---------------------------------------------------------------} unit DAG; interface {$segment 'cg'} {$LibPrefix '0/obj/'} uses CCommon, CGI, CGC, Gen; {---------------------------------------------------------------} procedure DAG (code: icptr); { place an op code in a DAG or tree } { } { parameters: } { code - opcode } {---------------------------------------------------------------} implementation var c_ind: iclist; {vars that can be changed by indirect stores} maxLoc: integer; {max local label number used by compiler} memberOp: icptr; {operation found by Member} optimizations: array[pcodes] of integer; {starting indexes into peeptable} peepTablesInitialized: boolean; {have the peephole tables been initialized?} rescan: boolean; {redo the optimization pass?} {-- External unsigned math routines; imported from Expression.pas --} function udiv (x,y: longint): longint; extern; function umod (x,y: longint): longint; extern; function umul (x,y: longint): longint; extern; {---------------------------------------------------------------} function CodesMatch (op1, op2: icptr; exact: boolean): boolean; { Check to see if the trees op1 and op2 are equivalent } { } { parameters: } { op1, op2 - trees to check } { exact - is an exact match of operands required? } { } { Returns: True if trees are equivalent, else false. } function LongStrCmp (s1, s2: longStringPtr): boolean; { Are the strings s1 amd s2 equal? } { } { parameters: } { s1, s2 - strings to compare } { } { Returns: True if the strings are equal, else false } label 1; var i: integer; {loop/index variable} begin {LongStrCmp} LongStrCmp := false; if s1^.length = s2^.length then begin for i := 1 to s1^.length do if s1^.str[i] <> s2^.str[i] then goto 1; LongStrCmp := true; end; {if} 1: end; {LongStrCmp} function OpsEqual (op1, op2: icptr): boolean; { See if the operands are equal } { } { parameters: } { op1, op2 - operations to check } { } { Returns: True if the operands are equivalent, else } { false. } var result: boolean; {temp result} begin {OpsEqual} result := false; case op1^.opcode of pc_cup, pc_cui, pc_tl1, pc_bno: {this rule prevents optimizations from removing sensitive operations} ; pc_adi, pc_adl, pc_adr, pc_and, pc_lnd, pc_bnd, pc_bal, pc_bor, pc_blr, pc_bxr, pc_blx, pc_equ, pc_neq, pc_ior, pc_lor, pc_mpi, pc_umi, pc_mpl, pc_uml, pc_mpr: begin if op1^.left = op2^.left then if op1^.right = op2^.right then result := true; if not result then if op1^.left = op2^.right then if op1^.right = op2^.left then result := true; if not result then if not exact then if CodesMatch(op1^.left, op2^.left, false) then if CodesMatch(op1^.right, op2^.right, false) then result := true; if not result then if not exact then if CodesMatch(op1^.left, op2^.right, false) then if CodesMatch(op1^.right, op2^.left, false) then result := true; end; otherwise: begin if op1^.left = op2^.left then if op1^.right = op2^.right then result := true; if not result then if not exact then if CodesMatch(op1^.left, op2^.left, false) then if CodesMatch(op1^.right, op2^.right, false) then result := true; end; end; {case} OpsEqual := result; end; {OpsEqual} begin {CodesMatch} CodesMatch := false; if op1 = op2 then CodesMatch := true else if (op1 <> nil) and (op2 <> nil) then if op1^.opcode = op2^.opcode then if op1^.q = op2^.q then if op1^.r = op2^.r then if op1^.s = op2^.s then if op1^.lab^ = op2^.lab^ then if OpsEqual(op1, op2) then if op1^.optype = op2^.optype then case op1^.optype of cgByte, cgUByte, cgWord, cgUWord: if op1^.opnd = op2^.opnd then if op1^.llab = op2^.llab then if op1^.slab = op2^.slab then CodesMatch := true; cgLong, cgULong: if op1^.lval = op2^.lval then CodesMatch := true; cgReal, cgDouble, cgComp, cgExtended: if op1^.rval = op2^.rval then CodesMatch := true; cgString: CodesMatch := LongStrCmp(op1^.str, op2^.str); cgVoid, ccPointer: if op1^.pval = op2^.pval then CodesMatch := LongStrCmp(op1^.str, op2^.str); end; {case} end; {CodesMatch} {- Peephole Optimization ---------------------------------------} function Base (val: longint): integer; { Assuming val is a power of 2, find ln(val) base 2 } { } { parameters: } { val - value for which to find the base } { } { Returns: ln(val), base 2 } var i: integer; {base counter} begin {Base} i := 0; while not odd(val) do begin val := val >> 1; i := i+1; end; {while} Base := i; end; {Base} procedure BinOps (var op1, op2: icptr); { Make sure the operands are of the same type } { } { parameters: } { op1, op2: two pc_ldc operands } var opt1, opt2: baseTypeEnum; {temp operand types} begin {BinOps} opt1 := op1^.optype; opt2 := op2^.optype; if opt1 = cgByte then begin op1^.optype := cgWord; opt1 := cgWord; end {if} else if opt1 = cgUByte then begin op1^.optype := cgUWord; opt1 := cgUWord; end {else if} else if opt1 in [cgReal, cgDouble, cgComp] then begin op1^.optype := cgExtended; opt1 := cgExtended; end; {else if} if opt2 = cgByte then begin op2^.optype := cgWord; opt2 := cgWord; end {if} else if opt2 = cgUByte then begin op2^.optype := cgUWord; opt2 := cgUWord; end {else if} else if opt2 in [cgReal, cgDouble, cgComp] then begin op2^.optype := cgExtended; opt2 := cgExtended; end; {else if} if opt1 <> opt2 then begin case opt1 of cgWord: case opt2 of cgUWord: op1^.optype := cgUWord; cgLong, cgULong: begin op1^.lval := op1^.q; op1^.optype := opt2; end; cgExtended: begin op1^.rval := op1^.q; op1^.optype := cgExtended; end; otherwise: ; end; {case} cgUWord: case opt2 of cgWord: op2^.optype := cgUWord; cgLong, cgULong: begin op1^.lval := ord4(op1^.q) & $0000FFFF; op1^.optype := opt2; end; cgExtended: begin op1^.rval := ord4(op1^.q) & $0000FFFF; op1^.optype := cgExtended; end; otherwise: ; end; {case} cgLong: case opt2 of cgWord: begin op2^.lval := op2^.q; op2^.optype := cgLong; end; cgUWord: begin op2^.lval := ord4(op2^.q) & $0000FFFF; op2^.optype := cgLong; end; cgULong: op1^.optype := cgULong; cgExtended: begin op1^.rval := op1^.lval; op1^.optype := cgExtended; end; otherwise: ; end; {case} cgULong: case opt2 of cgWord: begin op2^.lval := op2^.q; op2^.optype := cgLong; end; cgUWord: begin op2^.lval := ord4(op2^.q) & $0000FFFF; op2^.optype := cgLong; end; cgLong: op2^.optype := cgULong; cgExtended: begin op1^.rval := op1^.lval; if op1^.rval < 0.0 then op1^.rval := 4294967296.0 + op1^.rval; op1^.optype := cgExtended; end; otherwise: ; end; {case} cgExtended: begin case opt2 of cgWord: op2^.rval := op2^.q; cgUWord: op2^.rval := ord4(op2^.q) & $0000FFFF; cgLong: op2^.rval := op2^.lval; cgULong: begin op2^.rval := op2^.lval; if op2^.rval < 0.0 then op2^.rval := 4294967296.0 + op2^.rval; end; otherwise: ; end; {case} op2^.optype := cgExtended; end; otherwise: ; end; {case} end; {if} end; {BinOps} procedure CheckLabels; { remove unused dc_lab labels } var lop: icptr; {predecessor of op} op: icptr; {used to trace the opcode list} function Used (lab: integer): boolean; { see if a label is used } { } { parameters: } { lab - label number to check } { } { Returns: True if the label is used, else false. } var found: boolean; {was the label found?} op: icptr; {used to trace the opcode list} begin {Used} found := false; op := DAGhead; while (not found) and (op <> nil) do begin if op^.opcode in [pc_add, pc_fjp, pc_tjp, pc_ujp] then found := op^.q = lab else if op^.opcode = pc_nat then found := true; op := op^.next; end; {while} Used := found; end; {Used} begin {CheckLabels} op := DAGhead; while op^.next <> nil do begin lop := op; op := op^.next; if op^.opcode = dc_lab then if not Used(op^.q) then begin lop^.next := op^.next; op := lop; rescan := true; end; {if} end; {while} end; {CheckLabels} procedure RemoveDeadCode (op: icptr); { remove dead code following an unconditional branch } { } { parameters: } { op - unconditional branch opcode } begin {RemoveDeadCode} while not (op^.next^.opcode in [dc_lab, dc_enp, dc_cns, dc_glb, dc_dst, dc_str, dc_pin, pc_ent, dc_loc, dc_prm, dc_sym]) do begin op^.next := op^.next^.next; rescan := true; end; {while} end; {RemoveDeadCode} function NoFunctions (op: icptr): boolean; { are there any function calls? } { } { parameters: } { op - operation tree to search } { } { returns: True if there are no pc_cup or pc_cui operations } { in the tree, else false. } begin {NoFunctions} if op = nil then NoFunctions := true else if op^.opcode in [pc_cup,pc_cui,pc_tl1] then NoFunctions := false else NoFunctions := NoFunctions(op^.left) or NoFunctions(op^.right); end; {NoFunctions} function OneBit (val: longint): boolean; { See if there is exactly one bit set in val } { } { parameters: } { val - value to check } { } { Returns: True if exactly one bit is set, else false } begin {OneBit} if val = 0 then OneBit := false else begin while not odd(val) do val := val >> 1; OneBit := val = 1; end; {else} end; {OneBit} procedure PeepHoleOptimization (var opv: icptr); { do peephole optimization on a list of opcodes } { } { parameters: } { opv - pointer to the first opcode } { } { Notes: } { 1. Many optimizations assume the children have already } { been optimized. In particular, many optimizations } { depend on pc_ldc operands being on a specific side of } { a child's expression tree. (e.g. pc_fjp and pc_equ) } var done: boolean; {optimization done test} doit: boolean; {should we do the optimization?} lq, lval: longint; {temps for long calculations} op2,op3: icptr; {temp opcodes} op: icptr; {copy of op (for efficiency)} opcode: pcodes; {temp opcode} optype: baseTypeEnum; {temp optype} q: integer; {temp for integer calculations} rval: double; {temp for real calculations} fromtype, totype, firstType: record {for converting numbers to optypes} case boolean of true: (i: integer); false: (optype: baseTypeEnum); end; function SideEffects (op: icptr): boolean; { Check a tree for operations that have side effects } { } { parameters: } { op - tree to check } var result: boolean; {temp result} begin {SideEffects} if (op = nil) or volatile then SideEffects := false else if op^.opcode in [pc_mov,pc_cbf,pc_cop,pc_cpi,pc_cpo,pc_gil,pc_gli,pc_gdl, pc_gld,pc_iil,pc_ili,pc_idl,pc_ild,pc_lil,pc_lli,pc_ldl, pc_lld,pc_sbf,pc_sro,pc_sto,pc_str,pc_cui,pc_cup,pc_tl1] then SideEffects := true else SideEffects := SideEffects(op^.left) or SideEffects(op^.right); end; {SideEffects} procedure JumpOptimizations (op: icptr; newOpcode: pcodes); { handle common code for jump optimizations } { } { parameters: } { op - jump opcode } { newOpcode - opcode to use if the jump sense is reversed } var done: boolean; {optimization done test} topcode: pcodes; {temp opcode} begin {JumpOptimizations} topcode := op^.left^.opcode; if topcode = pc_not then begin op^.left := op^.left^.left; op^.opcode := newOpcode; PeepHoleOptimization(opv); end {else if} else if topcode in [pc_neq,pc_equ] then begin with op^.left^.right^ do if opcode = pc_ldc then if optype in [cgByte,cgUByte,cgWord,cgUWord] then if q = 0 then begin op^.left := op^.left^.left; if topcode = pc_equ then op^.opcode := newOpcode; end; {if} end; {else if} if op^.next^.opcode = dc_lab then if op^.next^.q = op^.q then if not SideEffects(op^.left) then begin rescan := true; opv := op^.next; end; {else if} end; {JumpOptimizations} procedure RealStoreOptimizations (op, opl: icptr); { do strength reductions associated with stores of reals } { } { parameters: } { op - real store to optimize } { opl - load operand for the store operation } var disp: 0..9; {disp to the word to change} same: boolean; {are the operands the same?} op2: icptr; {new opcode} opt: icptr; {temp opcode} cnvrl: record {for stuffing a real in a long space} case boolean of true: (lval: longint); false: (rval: real); end; begin {RealStoreOptimizations} if opl^.opcode = pc_ngr then begin same := false; with opl^.left^ do if op^.opcode = pc_sro then begin if opcode = pc_ldo then if q = op^.q then if optype = op^.optype then if lab^ = op^.lab^ then same := true; end {if} else {if op^.opcode = pc_str then} if opcode = pc_lod then if q = op^.q then if r = op^.r then if optype = op^.optype then same := true; if same then begin case op^.optype of cgReal: disp := 3; cgDouble: disp := 7; cgExtended: disp := 9; cgComp: disp := 11; end; {case} opl^.left^.optype := cgWord; opl^.left^.q := opl^.left^.q + disp; op^.optype := cgWord; op^.q := op^.q + disp; op2 := pointer(Calloc(sizeof(intermediate_code))); op2^.opcode := pc_ldc; op2^.optype := cgWord; op2^.q := $0080; opl^.right := op2; opl^.opcode := pc_bxr; end {if} else if op^.optype = cgReal then begin opt := opl^.left; if opt^.opcode in [pc_ind,pc_ldo,pc_lod] then if opt^.optype = cgReal then begin opt^.optype := cgLong; op^.optype := cgLong; op2 := pointer(Calloc(sizeof(intermediate_code))); op2^.opcode := pc_ldc; op2^.optype := cgLong; op2^.lval := $80000000; opl^.right := op2; opl^.opcode := pc_blx; end; {if} end; {else if} end {if} else if op^.optype = cgReal then begin if opl^.opcode = pc_ldc then begin cnvrl.rval := opl^.rval; opl^.lval := cnvrl.lval; opl^.optype := cgLong; op^.optype := cgLong; end {if} else if opl^.opcode in [pc_ind,pc_ldo,pc_lod] then if opl^.optype = cgReal then begin opl^.optype := cgLong; op^.optype := cgLong; end; {if} end; {if} end; {RealStoreOptimizations} procedure ReplaceLoads (ldop, stop, tree: icptr); { Replace any pc_lod operations in tree that load from the } { location stored to by the pc_str operation stop by ldop } { } { parameters: } { ldop - operation to replace the pc_lods with } { stop - pc_str operation } { tree - tree to check for pc_lod operations } { } { Notes: ldop must be an instruction, not a tree } begin {ReplaceLoads} if tree^.left <> nil then ReplaceLoads(ldop, stop, tree^.left); if tree^.right <> nil then ReplaceLoads(ldop, stop, tree^.right); if tree^.opcode = pc_lod then if tree^.optype = stop^.optype then if tree^.q = stop^.q then if tree^.r = stop^.r then tree^ := ldop^; end; {ReplaceLoads} procedure ReverseChildren (op: icptr); { reverse the children of a node } { } { parameters: } { op - node for which to reverse the children } var opt: icptr; {temp opcode pointer} begin {ReverseChildren} opt := op^.right; op^.right := op^.left; op^.left := opt; end; {ReverseChildren} procedure ZeroIntermediateCode (op: icptr); { Set all fields in the record to 0, nil, etc. } { } { Parameters: } { op - intermediate code record to clear } begin {ZeroIntermediateCode} op^.q := 0; op^.r := 0; op^.s := 0; op^.lab := nil; op^.next := nil; op^.left := nil; op^.right := nil; op^.optype := cgWord; op^.opnd := 0; op^.llab := 0; op^.slab := 0; end; {ZeroIntermediateCode} begin {PeepHoleOptimization} {if printSymbols then begin write('Optimize: '); WriteCode(opv); end; {debug} op := opv; {copy for efficiency} if op^.left <> nil then {optimize the children} PeepHoleOptimization(op^.left); if op^.right <> nil then PeepHoleOptimization(op^.right); case op^.opcode of {check for optimizations of this node} pc_add: begin {pc_add} if op^.next^.opcode <> pc_add then RemoveDeadCode(op); end; {case pc_add} pc_adi: begin {pc_adi} if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin op^.left^.q := op^.left^.q + op^.right^.q; opv := op^.left; end {if} else begin if op^.left^.opcode = pc_ldc then ReverseChildren(op); if op^.right^.opcode = pc_ldc then begin q := op^.right^.q; if q = 0 then opv := op^.left else if q > 0 then begin op^.opcode := pc_inc; op^.q := q; op^.right := nil; end {else if} else {if q < 0 then} begin op^.opcode := pc_dec; op^.q := -q; op^.right := nil; end; {else if} end {if} else if CodesMatch(op^.left, op^.right, false) then begin if NoFunctions(op^.left) then begin ZeroIntermediateCode(op^.right); with op^.right^ do begin opcode := pc_ldc; q := 1; optype := cgWord; end; {with} op^.opcode := pc_shl; PeepHoleOptimization(opv); end; {if} end {else if} else if op^.left^.opcode in [pc_inc,pc_dec] then begin if op^.right^.opcode in [pc_inc,pc_dec] then begin op2 := op^.left; if op2^.opcode = pc_inc then q := op2^.q else q := -op2^.q; if op^.right^.opcode = pc_inc then q := q + op^.right^.q else q := q - op^.right^.q; if q >= 0 then begin op2^.opcode := pc_inc; op2^.q := q; end {if} else begin op2^.opcode := pc_dec; op2^.q := -q; end; {else} op^.left := op^.left^.left; op^.right := op^.right^.left; op2^.left := op; opv := op2; PeepHoleOptimization(opv); end; {if} end; {else if} end; {else} end; {case pc_adi} pc_adl: begin {pc_adl} if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin op^.left^.lval := op^.left^.lval + op^.right^.lval; opv := op^.left; end {if} else begin if op^.left^.opcode = pc_ldc then ReverseChildren(op); if op^.right^.opcode = pc_ldc then begin lval := op^.right^.lval; if lval = 0 then opv := op^.left else if (lval >= 0) and (lval <= maxint) then begin op^.opcode := pc_inc; op^.optype := cgLong; op^.q := ord(lval); op^.right := nil; end {else if} else if (lval > -maxint) and (lval < 0) then begin op^.opcode := pc_dec; op^.optype := cgLong; op^.q := -ord(lval); op^.right := nil; end; {else if} end {if} else if CodesMatch(op^.left, op^.right, false) then if NoFunctions(op^.left) then begin ZeroIntermediateCode(op^.right); with op^.right^ do begin opcode := pc_ldc; lval := 1; optype := cgLong; end; {with} op^.opcode := pc_sll; end; {if} if op^.right^.opcode in [pc_lao,pc_lda,pc_ixa] then ReverseChildren(op); if op^.left^.opcode in [pc_lao,pc_lda,pc_ixa] then if op^.right^.opcode = pc_sll then begin if op^.right^.right^.opcode = pc_ldc then if (op^.right^.right^.lval & $FFFF8000) = 0 then if op^.right^.left^.opcode = pc_cnv then begin fromtype.i := (op^.right^.left^.q & $00F0) >> 4; if fromType.optype in [cgByte,cgUByte,cgWord,cgUWord] then begin if fromType.optype = cgByte then op^.right^.left^.q := $02 else if fromType.optype = cgUByte then op^.right^.left^.q := $13 else op^.right^.left := op^.right^.left^.left; with op^.right^.right^ do begin lq := lval; lval := 0; q := long(lq).lsw; optype := cgUWord; end; {with} op^.right^.opcode := pc_shl; op^.opcode := pc_ixa; PeepHoleOptimization(opv); end; {if} end; {if} end {if} else if op^.right^.opcode = pc_cnv then begin fromtype.i := (op^.right^.q & $00F0) >> 4; if fromtype.optype in [cgByte,cgUByte,cgWord,cgUWord] then begin if fromType.optype = cgByte then op^.right^.q := $02 else if fromType.optype = cgUByte then op^.right^.q := $13 else op^.right := op^.right^.left; op^.opcode := pc_ixa; PeepHoleOptimization(opv); end; {if} end; {else if} end; {else} end; {case pc_adl} pc_adr: begin {pc_adr} if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin op^.left^.rval := op^.left^.rval + op^.right^.rval; opv := op^.left; end {if} else begin if op^.left^.opcode = pc_ldc then ReverseChildren(op); if op^.right^.opcode = pc_ldc then begin if op^.right^.rval = 0.0 then opv := op^.left; end; {if} end; {else} end; {case pc_adr} pc_and: begin {pc_and} if op^.right^.opcode = pc_ldc then begin if op^.left^.opcode = pc_ldc then begin op^.left^.q := ord((op^.left^.q <> 0) and (op^.right^.q <> 0)); opv := op^.left; end {if} else begin if op^.right^.q = 0 then if not SideEffects(op^.left) then opv := op^.right; end {else} end {if} else if op^.left^.opcode = pc_ldc then if op^.left^.q = 0 then opv := op^.left; end; {case pc_and} pc_bal: begin {pc_bal} if op^.left^.opcode = pc_ldc then ReverseChildren(op); if op^.left^.opcode = pc_ldc then begin op^.left^.lval := op^.left^.lval & op^.right^.lval; opv := op^.left; end {if} else if op^.right^.opcode = pc_ldc then begin if op^.right^.lval = 0 then opv := op^.right else if op^.right^.lval = -1 then opv := op^.left; end; {else if} end; {case pc_bal} pc_blr: begin {pc_blr} if op^.left^.opcode = pc_ldc then ReverseChildren(op); if op^.left^.opcode = pc_ldc then begin op^.left^.lval := op^.left^.lval | op^.right^.lval; opv := op^.left; end {if} else if op^.right^.opcode = pc_ldc then begin if op^.right^.lval = -1 then opv := op^.right else if op^.right^.lval = 0 then opv := op^.left; end; {else if} end; {case pc_blr} pc_blx: begin {pc_blx} if op^.left^.opcode = pc_ldc then ReverseChildren(op); if op^.left^.opcode = pc_ldc then begin op^.left^.lval := op^.left^.lval ! op^.right^.lval; opv := op^.left; end {if} else if op^.right^.opcode = pc_ldc then begin if op^.right^.lval = 0 then opv := op^.left else if op^.right^.lval = -1 then begin op^.opcode := pc_bnl; op^.right := nil; end; {else if} end; {else if} end; {case pc_blx} pc_bnd: begin {pc_bnd} if op^.left^.opcode = pc_ldc then ReverseChildren(op); if op^.left^.opcode = pc_ldc then begin op^.left^.q := op^.left^.q & op^.right^.q; opv := op^.left; end {if} else if op^.right^.opcode = pc_ldc then begin if op^.right^.q = 0 then opv := op^.right else if op^.right^.q = -1 then opv := op^.left; end; {else if} end; {case pc_bnd} pc_bnl: begin {pc_bnl} if op^.left^.opcode = pc_ldc then begin op^.left^.lval := op^.left^.lval ! $FFFFFFFF; opv := op^.left; end; {if} end; {case pc_bnl} pc_bno: begin {pc_bno} if op^.left^.opcode = pc_str then if op^.left^.left^.opcode in [pc_lda,pc_lao] then begin ReplaceLoads(op^.left^.left, op^.left, op^.right); opv := op^.right; end; {if} end; {case pc_bno} pc_bnt: begin {pc_bnt} if op^.left^.opcode = pc_ldc then begin op^.left^.q := op^.left^.q ! $FFFF; opv := op^.left; end; {if} end; {case pc_bnt} pc_bor: begin {pc_bor} if op^.left^.opcode = pc_ldc then ReverseChildren(op); if op^.left^.opcode = pc_ldc then begin op^.left^.q := op^.left^.q | op^.right^.q; opv := op^.left; end {if} else if op^.right^.opcode = pc_ldc then begin if op^.right^.q = -1 then opv := op^.right else if op^.right^.q = 0 then opv := op^.left; end; {else if} end; {case pc_bor} pc_bxr: begin {pc_bxr} if op^.left^.opcode = pc_ldc then ReverseChildren(op); if op^.left^.opcode = pc_ldc then begin op^.left^.q := op^.left^.q ! op^.right^.q; opv := op^.left; end {if} else if op^.right^.opcode = pc_ldc then begin if op^.right^.q = 0 then opv := op^.left else if op^.right^.q = -1 then begin op^.opcode := pc_bnt; op^.right := nil; end; {else if} end; {else if} end; {case pc_bxr} pc_cnv: begin {pc_cnv} fromtype.i := (op^.q & $00F0) >> 4; totype.i := op^.q & $000F; if op^.left^.opcode = pc_ldc then begin case fromtype.optype of cgByte,cgWord: case totype.optype of cgByte,cgUByte,cgWord,cgUWord: ; cgLong,cgULong: begin lval := op^.left^.q; op^.left^.q := 0; op^.left^.lval := lval; end; cgReal,cgDouble,cgComp,cgExtended: begin rval := op^.left^.q; op^.left^.q := 0; op^.left^.rval := rval; end; otherwise: ; end; {case} cgUByte,cgUWord: case totype.optype of cgByte,cgUByte,cgWord,cgUWord: ; cgLong,cgULong: begin lval := ord4(op^.left^.q) & $0000FFFF; op^.left^.q := 0; op^.left^.lval := lval; end; cgReal,cgDouble,cgComp,cgExtended: begin rval := ord4(op^.left^.q) & $0000FFFF; op^.left^.q := 0; op^.left^.rval := rval; end; otherwise: ; end; {case} cgLong: case totype.optype of cgByte,cgUByte,cgWord,cgUWord: begin q := long(op^.left^.lval).lsw; op^.left^.lval := 0; op^.left^.q := q; end; cgLong, cgULong: ; cgReal,cgDouble,cgComp,cgExtended: begin rval := op^.left^.lval; op^.left^.lval := 0; op^.left^.rval := rval; end; otherwise: ; end; {case} cgULong: case totype.optype of cgByte,cgUByte,cgWord,cgUWord: begin q := long(op^.left^.lval).lsw; op^.left^.lval := 0; op^.left^.q := q; end; cgLong, cgULong: ; cgReal,cgDouble,cgComp,cgExtended: begin lval := op^.left^.lval; op^.left^.lval := 0; if lval >= 0 then rval := lval else rval := (lval & $7FFFFFFF) + 2147483648.0; op^.left^.rval := rval; end; otherwise: ; end; {case} cgReal,cgDouble,cgComp,cgExtended: begin rval := op^.left^.rval; case totype.optype of cgByte: begin if rval < -128.0 then q := -128 else if rval > 127.0 then q := 127 else q := trunc(rval); op^.left^.rval := 0.0; op^.left^.q := q; end; cgUByte: begin if rval < 0.0 then q := 0 else if rval > 255.0 then q := 255 else q := trunc(rval); op^.left^.rval := 0.0; op^.left^.q := q; end; cgWord: begin if rval < -32768.0 then lval := -32768 else if rval > 32767.0 then lval := 32767 else lval := trunc(rval); op^.left^.rval := 0.0; op^.left^.q := long(lval).lsw; end; cgUWord: begin if rval < 0.0 then lval := 0 else if rval > 65535.0 then lval := 65535 else begin rval := trunc4(rval); lval := round4(rval); end; {else} op^.left^.rval := 0.0; op^.left^.q := long(lval).lsw; end; cgLong,cgULong: begin rval := op^.left^.rval; if totype.optype = cgULong then begin if rval < 0 then rval := 0 else if rval > 2147483647.0 then rval := rval - 4294967296.0 end; {if} if rval < -2147483648.0 then lval := $80000000 else if rval > 2147483647.0 then lval := 2147483647 else begin rval := trunc4(rval); lval := round4(rval); end; {else} op^.left^.rval := 0.0; op^.left^.lval := lval; end; cgReal,cgDouble,cgComp,cgExtended: ; otherwise: ; end; end; {case} otherwise: ; end; {case} if fromtype.optype in [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgReal,cgDouble, cgComp,cgExtended] then if totype.optype in [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgReal,cgDouble, cgComp,cgExtended] then begin op^.left^.optype := totype.optype; opv := op^.left; end; {if} end {if} else if op^.left^.opcode = pc_cnv then begin doit := false; firsttype.i := (op^.q & $00F0) >> 4; if fromType.optype in [cgReal,cgDouble,cgComp,cgExtended] then begin if toType.optype in [cgReal,cgDouble,cgComp,cgExtended] then doit := true; end {if} else begin if firstType.optype in [cgByte,cgWord,cgLong] then if fromType.optype in [cgByte,cgWord,cgLong] then if toType.optype in [cgByte,cgWord,cgLong] then doit := true; if firstType.optype in [cgUByte,cgUWord,cgULong] then if fromType.optype in [cgUByte,cgUWord,cgULong] then if toType.optype in [cgUByte,cgUWord,cgLong] then doit := true; if TypeSize(firstType.optype) = TypeSize(fromType.optype) then if TypeSize(firstType.optype) = TypeSize(toType.optype) then doit := true; end; {else} if doit then begin op^.q := (op^.left^.q & $00F0) | (op^.q & $000F); op^.left := op^.left^.left; PeepHoleOptimization(opv); end; {if} end {else if} else if op^.left^.opcode in [pc_lod,pc_ldo,pc_ind] then begin if fromtype.optype in [cgWord,cgUWord] then if totype.optype in [cgByte,cgUByte,cgWord,cgUWord] then begin op^.left^.optype := totype.optype; opv := op^.left; end; {if} if fromtype.optype in [cgLong,cgULong] then if totype.optype in [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong] then begin op^.left^.optype := totype.optype; opv := op^.left; end; {if} end {else if} else if op^.q in [$40,$41,$50,$51] then begin {any long type to byte type} with op^.left^ do if opcode = pc_bal then if right^.opcode = pc_ldc then if right^.lval = 255 then begin op^.left := op^.left^.left; PeepHoleOptimization(opv); end; {if} with op^.left^ do if opcode in [pc_slr,pc_vsr] then if right^.opcode = pc_ldc then if left^.opcode in [pc_lod,pc_ldo,pc_ind] then begin lq := right^.lval; if long(lq).msw = 0 then if long(lq).lsw in [8,16,24] then begin lq := lq div 8; left^.q := left^.q + long(lq).lsw; op^.left := left; PeepHoleOptimization(opv); end; {if} end; {if} end; {else if} end; {case pc_cnv} pc_dec: begin {pc_dec} if op^.q = 0 then opv := op^.left else begin opcode := op^.left^.opcode; if opcode = pc_dec then begin if ord4(op^.left^.q) + ord4(op^.q) < ord4(maxint) then begin op^.q := op^.q + op^.left^.q; op^.left := op^.left^.left; end; {if} end {if} else if opcode = pc_inc then begin q := op^.q - op^.left^.q; if q < 0 then begin q := -q; op^.opcode := pc_inc; end; {if} op^.q := q; op^.left := op^.left^.left; PeepHoleOptimization(opv); end {else if} else if opcode = pc_ldc then begin if op^.optype in [cgLong, cgULong] then begin op^.left^.lval := op^.left^.lval - op^.q; opv := op^.left; end {if} else if op^.optype in [cgUByte, cgByte, cgUWord, cgWord] then begin op^.left^.q := op^.left^.q - op^.q; opv := op^.left; end; {else if} end; {else if} end; {else} end; {case pc_dec} pc_dvi: begin {pc_dvi} if op^.right^.opcode = pc_ldc then begin if op^.left^.opcode = pc_ldc then begin if op^.right^.q <> 0 then begin op^.left^.q := op^.left^.q div op^.right^.q; opv := op^.left; end; {if} end {if} else if op^.right^.q = 1 then opv := op^.left; end; {if} end; {case pc_dvi} pc_dvl: begin {pc_dvl} if op^.right^.opcode = pc_ldc then begin if op^.left^.opcode = pc_ldc then begin if op^.right^.lval <> 0 then begin op^.left^.lval := op^.left^.lval div op^.right^.lval; opv := op^.left; end; {if} end {if} else if op^.right^.lval = 1 then opv := op^.left; end; {if} end; {case pc_dvl} pc_dvr: begin {pc_dvr} if op^.right^.opcode = pc_ldc then begin if op^.left^.opcode = pc_ldc then begin if op^.right^.rval <> 0.0 then begin op^.left^.rval := op^.left^.rval/op^.right^.rval; opv := op^.left; end; {if} end {if} else if op^.right^.rval = 1.0 then opv := op^.left; end; {if} end; {case pc_dvr} pc_equ: begin {pc_equ} if op^.left^.opcode = pc_ldc then ReverseChildren(op); if op^.right^.opcode = pc_ldc then begin if op^.left^.opcode = pc_ldc then begin BinOps(op^.left, op^.right); case op^.left^.optype of cgByte,cgUByte,cgWord,cgUWord: begin op^.opcode := pc_ldc; op^.q := ord(op^.left^.q = op^.right^.q); op^.left := nil; op^.right := nil; end; cgLong,cgULong: begin op^.opcode := pc_ldc; op^.q := ord(op^.left^.lval = op^.right^.lval); op^.left := nil; op^.right := nil; end; cgReal,cgDouble,cgComp,cgExtended: begin op^.opcode := pc_ldc; op^.q := ord(op^.left^.rval = op^.right^.rval); op^.left := nil; op^.right := nil; end; cgVoid,ccPointer: begin op^.opcode := pc_ldc; op^.q := ord(op^.left^.pval = op^.right^.pval); op^.left := nil; op^.right := nil; end; end; {case} end {if} else if op^.right^.optype in [cgByte, cgUByte, cgWord, cgUWord] then begin if op^.right^.q <> 0 then if op^.left^.opcode in [pc_and,pc_ior,pc_neq,pc_equ,pc_geq,pc_leq,pc_les,pc_grt] then begin opv := op^.left; opv^.next := op^.next; end; {if} end {else if} else if op^.right^.optype in [cgLong, cgULong] then begin if op^.right^.lval <> 0 then if op^.left^.opcode in [pc_and,pc_ior,pc_neq,pc_equ,pc_geq,pc_leq,pc_les,pc_grt] then begin opv := op^.left; opv^.next := op^.next; end; {if} end; {else if} end; {if} end; {case pc_equ} pc_fjp: begin {pc_fjp} opcode := op^.left^.opcode; if opcode = pc_ldc then begin if op^.left^.optype in [cgByte, cgUByte, cgWord, cgUWord] then begin if op^.left^.q <> 0 then begin opv := op^.next; rescan := true; end {if} else begin op^.opcode := pc_ujp; op^.left := nil; PeepHoleOptimization(opv); end; {else} end {if} end {if} else if opcode = pc_and then begin op2 := op^.left; op2^.next := op^.next; op^.next := op2; op^.left := op2^.left; op2^.left := op2^.right; op2^.right := nil; op2^.opcode := pc_fjp; op2^.q := op^.q; PeepHoleOptimization(opv); end {else if} else if opcode = pc_ior then begin op2 := op^.left; op2^.next := op^.next; op^.next := op2; op^.left := op2^.left; op2^.left := op2^.right; op2^.right := nil; op2^.opcode := pc_fjp; op2^.q := op^.q; op^.opcode := pc_tjp; op3 := pointer(Calloc(sizeof(intermediate_code))); op3^.opcode := dc_lab; op3^.optype := cgWord; op3^.q := GenLabel; op3^.next := op2^.next; op2^.next := op3; op^.q := op3^.q; PeepHoleOptimization(opv); end {else if} else JumpOptimizations(op, pc_tjp); end; {case pc_fjp} pc_inc: begin {pc_inc} if op^.q = 0 then opv := op^.left else begin opcode := op^.left^.opcode; if opcode = pc_inc then begin if ord4(op^.left^.q) + ord4(op^.q) < ord4(maxint) then begin op^.q := op^.q + op^.left^.q; op^.left := op^.left^.left; end; {if} end {if} else if opcode = pc_dec then begin q := op^.q - op^.left^.q; if q < 0 then begin q := -q; op^.opcode := pc_dec; end; {if} op^.q := q; op^.left := op^.left^.left; PeepHoleOptimization(opv); end {else if} else if opcode = pc_ldc then begin if op^.optype in [cgLong, cgULong] then begin op^.left^.lval := op^.left^.lval + op^.q; opv := op^.left; end {if} else if op^.optype in [cgUByte, cgByte, cgUWord, cgWord] then begin op^.left^.q := op^.left^.q + op^.q; opv := op^.left; end; {else if} end {else if} else if opcode in [pc_lao,pc_lda] then begin op^.left^.q := op^.left^.q + op^.q; opv := op^.left; end; {else if} end; {else} end; {case pc_inc} pc_ind: begin {pc_ind} opcode := op^.left^.opcode; if opcode = pc_lda then begin op^.left^.opcode := pc_lod; op^.left^.optype := op^.optype; op^.left^.q := op^.left^.q + op^.q; opv := op^.left; end {if} else if opcode = pc_lao then begin op^.left^.opcode := pc_ldo; op^.left^.optype := op^.optype; op^.left^.q := op^.left^.q + op^.q; opv := op^.left; end; {else if} end; {case pc_ind} pc_ior: begin {pc_ior} if op^.right^.opcode = pc_ldc then begin if op^.left^.opcode = pc_ldc then begin op^.left^.q := ord((op^.left^.q <> 0) or (op^.right^.q <> 0)); opv := op^.left; end {if} else begin if op^.right^.q <> 0 then begin if not SideEffects(op^.left) then begin op^.right^.q := 1; opv := op^.right; end; {if} end {if} else op^.opcode := pc_neq; end {if} end {if} else if op^.left^.opcode = pc_ldc then if op^.left^.q <> 0 then begin op^.left^.q := 1; opv := op^.left; end; {if} end; {case pc_ior} pc_ixa: begin {pc_ixa} if op^.right^.opcode = pc_ldc then begin optype := op^.right^.optype; if optype in [cgUByte, cgByte, cgUWord, cgWord] then begin lval := op^.right^.q; if optype = cgUByte then lval := lval & $000000FF else if optype = cgUWord then lval := lval & $0000FFFF; done := false; if op^.left^.opcode in [pc_lao, pc_lda] then begin lq := op^.left^.q + lval; if (lq >= 0) and (lq < maxint) then begin done := true; op^.left^.q := ord(lq); opv := op^.left; end; {if} end; {if} if not done then begin op^.right^.lval := lval; op^.right^.optype := cgLong; op^.opcode := pc_adl; PeepHoleOptimization(opv); end; {if} end; {if} end {if} else if op^.left^.opcode = pc_lao then begin if op^.right^.opcode = pc_inc then begin lq := ord4(op^.right^.q) + ord4(op^.left^.q); if lq < maxint then begin op^.left^.q := ord(lq); op^.right := op^.right^.left; end; {if} PeepHoleOptimization(opv); end; {if} end {else if} else if op^.left^.opcode = pc_ixa then begin op2 := op^.left; op^.left := op^.left^.left; op2^.left := op^.right; op2^.opcode := pc_adi; op^.right := op2; end; {else if} end; {case pc_ixa} pc_leq: begin {pc_leq} if op^.optype in [cgWord,cgUWord] then if op^.right^.opcode = pc_ldc then if op^.right^.q < maxint then begin op^.right^.q := op^.right^.q + 1; op^.opcode := pc_les; end; {if} end; {case pc_lnm} pc_lnd: begin {pc_lnd} if op^.right^.opcode = pc_ldc then begin if op^.left^.opcode = pc_ldc then begin op^.left^.q := ord((op^.left^.lval <> 0) and (op^.right^.lval <> 0)); op^.left^.optype := cgWord; opv := op^.left; end {if} else begin if op^.right^.lval = 0 then begin if not SideEffects(op^.left) then begin with op^.right^ do begin lval := 0; optype := cgWord; q := 0; end; {with} opv := op^.right; end; {if} end {if} else op^.opcode := pc_neq; end; {if} end {if} else if op^.left^.opcode = pc_ldc then if op^.left^.lval = 0 then begin with op^.left^ do begin lval := 0; optype := cgWord; q := 0; end; {with} opv := op^.left; end; {if} end; {case pc_lnd} pc_lnm: begin {pc_lnm} if op^.next^.opcode = pc_lnm then begin opv := op^.next; rescan := true; end; {if} end; {case pc_lnm} pc_lor: begin {pc_lor} if op^.right^.opcode = pc_ldc then begin if op^.left^.opcode = pc_ldc then begin op^.left^.q := ord((op^.left^.lval <> 0) or (op^.right^.lval <> 0)); optype := cgWord; opv := op^.left; end {if} else begin if op^.right^.lval <> 0 then begin if not SideEffects(op^.left) then begin op^.right^.lval := 0; op^.right^.q := 1; op^.right^.optype := cgWord; opv := op^.right; end; {if} end {if} else begin op^.opcode := pc_neq; op^.optype := cgLong; end; {else} end; {if} end {if} else if op^.left^.opcode = pc_ldc then if op^.left^.lval <> 0 then begin op^.left^.lval := 0; op^.left^.q := 1; op^.left^.optype := cgWord; opv := op^.left; end; {if} end; {case pc_lor} pc_mdl: begin {pc_mdl} if op^.right^.opcode = pc_ldc then if op^.left^.opcode = pc_ldc then if op^.right^.lval <> 0 then begin op^.left^.lval := op^.left^.lval mod op^.right^.lval; opv := op^.left; end; {if} end; {case pc_mdl} pc_mod: begin {pc_mod} if op^.right^.opcode = pc_ldc then if op^.left^.opcode = pc_ldc then if op^.right^.q <> 0 then begin op^.left^.q := op^.left^.q mod op^.right^.q; opv := op^.left; end; {if} end; {case pc_mod} pc_mpi, pc_umi: begin {pc_mpi, pc_umi} if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin if op^.opcode = pc_mpi then op^.left^.q := op^.left^.q*op^.right^.q else {if op^.opcode = pc_umi then} begin lval := umul(op^.left^.q & $0000FFFF, op^.right^.q & $0000FFFF); op^.left^.q := long(lval).lsw; end; {else} opv := op^.left; end {if} else begin if op^.left^.opcode = pc_ldc then ReverseChildren(op); if op^.right^.opcode = pc_ldc then begin q := op^.right^.q; if q = 1 then opv := op^.left else if q = 0 then begin if NoFunctions(op^.left) then opv := op^.right; end {else if} else if (q = -1) and (op^.opcode = pc_mpi) then begin op^.opcode := pc_ngi; op^.right := nil; end {else if} else if OneBit(q) then begin op^.right^.q := Base(q); op^.opcode := pc_shl; PeepHoleOptimization(opv); end; {else if} end; {if} end; {else} end; {case pc_mpi, pc_umi} pc_mpl, pc_uml: begin {pc_mpl, pc_uml} if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin if op^.opcode = pc_mpl then op^.left^.lval := op^.left^.lval*op^.right^.lval else {if op^.opcode = pc_uml then} op^.left^.lval := umul(op^.left^.lval, op^.right^.lval); opv := op^.left; end {if} else begin if op^.left^.opcode = pc_ldc then ReverseChildren(op); if op^.right^.opcode = pc_ldc then begin lval := op^.right^.lval; if lval = 1 then opv := op^.left else if lval = 0 then begin if NoFunctions(op^.left) then opv := op^.right; end {else if} else if (lval = -1) and (op^.opcode = pc_mpl) then begin op^.opcode := pc_ngl; op^.right := nil; end {else if} else if OneBit(lval) then begin op^.right^.lval := Base(lval); op^.opcode := pc_sll; end; {else if} end; {if} end; {else} end; {case pc_mpl, pc_uml} pc_mpr: begin {pc_mpr} if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin op^.left^.rval := op^.left^.rval*op^.right^.rval; opv := op^.left; end {if} else begin if op^.left^.opcode = pc_ldc then ReverseChildren(op); if op^.right^.opcode = pc_ldc then begin rval := op^.right^.rval; if rval = 1.0 then opv := op^.left else if rval = 0.0 then if NoFunctions(op^.left) then opv := op^.right; end; {if} end; {else} end; {case pc_mpr} pc_neq: begin {pc_neq} if op^.left^.opcode = pc_ldc then ReverseChildren(op); if op^.right^.opcode = pc_ldc then begin if op^.left^.opcode = pc_ldc then begin BinOps(op^.left, op^.right); case op^.left^.optype of cgByte,cgUByte,cgWord,cgUWord: begin op^.opcode := pc_ldc; op^.q := ord(op^.left^.q <> op^.right^.q); op^.left := nil; op^.right := nil; end; cgLong,cgULong: begin op^.opcode := pc_ldc; op^.q := ord(op^.left^.lval <> op^.right^.lval); op^.left := nil; op^.right := nil; end; cgReal,cgDouble,cgComp,cgExtended: begin op^.opcode := pc_ldc; op^.q := ord(op^.left^.rval <> op^.right^.rval); op^.left := nil; op^.right := nil; end; cgVoid,ccPointer: begin op^.opcode := pc_ldc; op^.q := ord(op^.left^.pval <> op^.right^.pval); op^.left := nil; op^.right := nil; end; end; {case} end {if} else if op^.right^.optype in [cgByte, cgUByte, cgWord, cgUWord] then begin if op^.right^.q = 0 then if op^.left^.opcode in [pc_and,pc_ior,pc_neq,pc_equ,pc_geq,pc_leq,pc_les,pc_grt] then begin opv := op^.left; opv^.next := op^.next; end; {if} end {else if} else if op^.right^.optype in [cgLong, cgULong] then begin if op^.right^.lval = 0 then if op^.left^.opcode in [pc_and,pc_ior,pc_neq,pc_equ,pc_geq,pc_leq,pc_les,pc_grt] then begin opv := op^.left; opv^.next := op^.next; end; {if} end; {else if} end; {if} end; {case pc_neq} pc_ngi: begin {pc_ngi} if op^.left^.opcode = pc_ldc then begin op^.left^.q := -op^.left^.q; opv := op^.left; end; {if} end; {case pc_ngi} pc_ngl: begin {pc_ngl} if op^.left^.opcode = pc_ldc then begin op^.left^.lval := -op^.left^.lval; opv := op^.left; end; {if} end; {case pc_ngl} pc_ngr: begin {pc_ngr} if op^.left^.opcode = pc_ldc then begin op^.left^.rval := -op^.left^.rval; opv := op^.left; end; {if} end; {case pc_ngr} pc_not: begin {pc_not} opcode := op^.left^.opcode; if opcode = pc_ldc then begin if op^.left^.optype in [cgByte,cgUByte,cgWord,cgUWord] then begin op^.left^.q := ord(op^.left^.q = 0); opv := op^.left; end {if} else if op^.left^.optype in [cgLong,cgULong] then begin q := ord(op^.left^.lval = 0); lval := 0; op^.left^.q := q; op^.left^.optype := cgWord; opv := op^.left; end; {else if} end {if} else if opcode = pc_equ then begin op^.left^.opcode := pc_neq; opv := op^.left; end {else if} else if opcode = pc_neq then begin op^.left^.opcode := pc_equ; opv := op^.left; end {else if} else if opcode = pc_geq then begin op^.left^.opcode := pc_les; opv := op^.left; end {else if} else if opcode = pc_grt then begin op^.left^.opcode := pc_leq; opv := op^.left; end {else if} else if opcode = pc_les then begin op^.left^.opcode := pc_geq; opv := op^.left; end {else if} else if opcode = pc_leq then begin op^.left^.opcode := pc_grt; opv := op^.left; end; {else if} end; {case pc_not} pc_pop: begin {pc_pop} if op^.left^.opcode = pc_cnv then op^.left := op^.left^.left; opcode := op^.left^.opcode; if opcode = pc_cop then begin op^.left^.opcode := pc_str; opv := op^.left; opv^.next := op^.next; PeepHoleOptimization(opv); end {if} else if opcode = pc_cpi then begin op^.left^.opcode := pc_sto; opv := op^.left; opv^.next := op^.next; PeepHoleOptimization(opv); end {else if} else if opcode = pc_cbf then begin op^.left^.opcode := pc_sbf; opv := op^.left; opv^.next := op^.next; end {else if} else if opcode = pc_cpo then begin op^.left^.opcode := pc_sro; opv := op^.left; opv^.next := op^.next; PeepHoleOptimization(opv); end {else if} else if opcode in [pc_inc,pc_dec] then op^.left := op^.left^.left; end; {case pc_pop} pc_ret: begin {pc_ret} RemoveDeadCode(op); end; {case pc_ret} pc_sbi: begin {pc_sbi} if op^.left^.opcode = pc_ldc then begin if op^.right^.opcode = pc_ldc then begin op^.left^.q := op^.left^.q - op^.right^.q; opv := op^.left; end {if} else if op^.left^.q = 0 then begin op^.opcode := pc_ngi; op^.left := op^.right; op^.right := nil; end; {else if} end {if} else if op^.right^.opcode = pc_ldc then begin q := op^.right^.q; if q = 0 then opv := op^.left else if (q > 0) then begin op^.opcode := pc_dec; op^.q := q; op^.right := nil; end {else if} else {if q < 0) then} begin op^.opcode := pc_inc; op^.q := -q; op^.right := nil; end; {else if} end {if} else if op^.left^.opcode in [pc_inc,pc_dec] then if op^.right^.opcode in [pc_inc,pc_dec] then begin op2 := op^.left; if op^.left^.opcode = pc_inc then q := op^.left^.q else q := -op^.left^.q; if op^.right^.opcode = pc_inc then q := q - op^.right^.q else q := q + op^.right^.q; if q >= 0 then begin op2^.opcode := pc_inc; op2^.q := q; end {if} else begin op2^.opcode := pc_dec; op2^.q := -q; end; {else} op^.left := op^.left^.left; op^.right := op^.right^.left; op2^.left := op; opv := op2; PeepHoleOptimization(opv); end; {if} end; {case pc_sbi} pc_sbl: begin {pc_sbl} if op^.left^.opcode = pc_ldc then begin if op^.right^.opcode = pc_ldc then begin op^.left^.lval := op^.left^.lval - op^.right^.lval; opv := op^.left; end {if} else if op^.left^.lval = 0 then begin op^.opcode := pc_ngl; op^.left := op^.right; op^.right := nil; end; {else if} end {if} else if op^.right^.opcode = pc_ldc then begin lval := op^.right^.lval; if lval = 0 then opv := op^.left else if (lval > 0) and (lval <= maxint) then begin op^.opcode := pc_dec; op^.q := ord(lval); op^.right := nil; op^.optype := cgLong; end {else if} else if (lval > -maxint) and (lval < 0) then begin op^.opcode := pc_inc; op^.q := -ord(lval); op^.right := nil; op^.optype := cgLong; end; {else if} end; {if} end; {case pc_sbl} pc_sbr: begin {pc_sbr} if op^.left^.opcode = pc_ldc then begin if op^.right^.opcode = pc_ldc then begin op^.left^.rval := op^.left^.rval - op^.right^.rval; opv := op^.left; end {if} else if op^.left^.rval = 0.0 then begin op^.opcode := pc_ngr; op^.left := op^.right; op^.right := nil; end; {else if} end {if} else if op^.right^.opcode = pc_ldc then begin if op^.right^.rval = 0.0 then opv := op^.left; end; {if} end; {case pc_sbr} pc_shl: begin {pc_shl} if op^.right^.opcode = pc_ldc then begin opcode := op^.left^.opcode; if opcode = pc_shl then begin if op^.left^.right^.opcode = pc_ldc then begin op^.right^.q := op^.right^.q + op^.left^.right^.q; op^.left := op^.left^.left; end; {if} end {if} else if opcode = pc_inc then begin op2 := op^.left; op^.left := op2^.left; op2^.q := op2^.q << op^.right^.q; op2^.left := op; opv := op2; PeepHoleOptimization(op2^.left); end; {else if} end; {if} end; {case pc_shl} pc_sro, pc_str: begin {pc_sro, pc_str} if op^.optype in [cgReal,cgDouble,cgExtended] then RealStoreOptimizations(op, op^.left); end; {case pc_sro, pc_str} pc_sto: begin {pc_sto} if op^.optype in [cgReal,cgDouble,cgExtended] then RealStoreOptimizations(op, op^.right); if op^.left^.opcode = pc_lao then begin op^.q := op^.left^.q; op^.lab := op^.left^.lab; op^.opcode := pc_sro; op^.left := op^.right; op^.right := nil; end {if} else if op^.left^.opcode = pc_lda then begin op^.q := op^.left^.q; op^.r := op^.left^.r; op^.opcode := pc_str; op^.left := op^.right; op^.right := nil; end; {if} end; {case pc_sto} pc_tjp: begin {pc_tjp} opcode := op^.left^.opcode; if opcode = pc_ldc then begin if op^.left^.optype in [cgByte, cgUByte, cgWord, cgUWord] then if op^.left^.q = 0 then begin opv := op^.next; rescan := true; end {if} else begin op^.opcode := pc_ujp; op^.left := nil; PeepHoleOptimization(opv); end; {else} end {if} else if opcode = pc_ior then begin op2 := op^.left; op2^.next := op^.next; op^.next := op2; op^.left := op2^.left; op2^.left := op2^.right; op2^.right := nil; op2^.opcode := pc_tjp; op2^.q := op^.q; PeepHoleOptimization(opv); end {else if} else if opcode = pc_and then begin op2 := op^.left; op2^.next := op^.next; op^.next := op2; op^.left := op2^.left; op2^.left := op2^.right; op2^.right := nil; op2^.opcode := pc_tjp; op2^.q := op^.q; op^.opcode := pc_fjp; op3 := pointer(Calloc(sizeof(intermediate_code))); op3^.opcode := dc_lab; op3^.optype := cgWord; op3^.q := GenLabel; op3^.next := op2^.next; op2^.next := op3; op^.q := op3^.q; PeepHoleOptimization(opv); end {else if} else JumpOptimizations(op, pc_fjp); end; {case pc_tjp} pc_tri: begin {pc_tri} opcode := op^.left^.opcode; if opcode = pc_not then begin ReverseChildren(op^.right); op^.left := op^.left^.left; PeepHoleOptimization(opv); end {if} else if opcode in [pc_equ, pc_neq] then begin with op^.left^.right^ do if opcode = pc_ldc then if optype in [cgByte,cgUByte,cgWord,cgUWord] then if q = 0 then begin if op^.left^.opcode = pc_equ then ReverseChildren(op^.right); op^.left := op^.left^.left; end; {if} end; {else if} end; {case pc_tri} pc_udi: begin {pc_udi} if op^.right^.opcode = pc_ldc then begin q := op^.right^.q; if op^.left^.opcode = pc_ldc then begin if q <> 0 then begin op^.left^.q := ord(udiv(op^.left^.q & $0000FFFF, q & $0000FFFF)); opv := op^.left; end; {if} end {if} else if q = 1 then opv := op^.left else if OneBit(q) then begin op^.right^.q := Base(q); op^.opcode := pc_usr; end; {else if} end; {if} end; {case pc_udi} pc_udl: begin {pc_udl} if op^.right^.opcode = pc_ldc then begin lq := op^.right^.lval; if op^.left^.opcode = pc_ldc then begin if lq <> 0 then begin op^.left^.lval := udiv(op^.left^.lval, lq); opv := op^.left; end; {if} end {if} else if lq = 1 then opv := op^.left else if OneBit(lq) then begin op^.right^.lval := Base(lq); op^.opcode := pc_vsr; end; {else if} end; {if} end; {case pc_udl} pc_uim: begin {pc_uim} if op^.right^.opcode = pc_ldc then if op^.left^.opcode = pc_ldc then if op^.right^.q <> 0 then begin op^.left^.q := ord(umod(op^.left^.q & $0000FFFF, op^.right^.q & $0000FFFF)); opv := op^.left; end; {if} end; {case pc_uim} pc_ujp: begin {pc_ujp} RemoveDeadCode(op); if op^.next^.opcode = dc_lab then begin if op^.q = op^.next^.q then begin opv := op^.next; rescan := true; end {if} else if op^.next^.next^.opcode = dc_lab then if op^.next^.next^.q = op^.q then begin opv := op^.next; rescan := true; end; {if} end; {if} end; {case pc_ujp} pc_ulm: begin {pc_ulm} if op^.right^.opcode = pc_ldc then if op^.left^.opcode = pc_ldc then if op^.right^.lval <> 0 then begin op^.left^.lval := umod(op^.left^.lval, op^.right^.lval); opv := op^.left; end; {if} end; {case pc_ulm} otherwise: ; end; {case} end; {PeepHoleOptimization} {- Common Subexpression Elimination ----------------------------} function MatchLoc (op1, op2: icptr): boolean; { See if two loads, stores or copies refer to the same } { location } { } { parameters: } { op1, op2 - operations to check } { } { Returns: True if they do, false if they don't. } begin {MatchLoc} MatchLoc := false; if (op1^.opcode in [pc_str,pc_cop,pc_lod,pc_lli,pc_lil,pc_lld,pc_ldl,pc_lda]) and (op2^.opcode in [pc_str,pc_cop,pc_lod,pc_lli,pc_lil,pc_lld,pc_ldl,pc_lda]) then begin if op1^.r = op2^.r then MatchLoc := true; end {if} else if (op1^.opcode in [pc_sro,pc_cpo,pc_ldo,pc_gli,pc_gil,pc_gld,pc_gdl,pc_lao]) and (op2^.opcode in [pc_sro,pc_cpo,pc_ldo,pc_gli,pc_gil,pc_gld,pc_gdl,pc_lao]) then if op1^.lab^ = op2^.lab^ then MatchLoc := true; end; {MatchLoc} function Member (op: icptr; list: iclist): boolean; { See if the operand of a load is referenced in a list } { } { parameters: } { op - load to check } { list - list to check } { } { Returns: True if op is in list, else false. } { } { Notes: As a side effect, this subroutine sets memberOp to } { point to any matching member; memberOp is undefined if } { there is no matching member. } begin {Member} Member := false; while list <> nil do begin if MatchLoc(op, list^.op) then begin Member := true; memberOp := list^.op; list := nil; end {if} else list := list^.next; end; {while} end; {Member} function TypeOf (op: icptr): baseTypeEnum; { find the type for the expression tree } { } { parameters: } { op - tree for which to find the type } { } { Returns: base type } begin {TypeOf} case op^.opcode of pc_gil, pc_gli, pc_gdl, pc_gld, pc_iil, pc_ili, pc_idl, pc_ild, pc_ldc, pc_ldo, pc_lil, pc_lli, pc_ldl, pc_lld, pc_lod, pc_dec, pc_inc, pc_ind, pc_lbf, pc_lbu, pc_cop, pc_cbf, pc_cpi, pc_cpo, pc_tri: TypeOf := op^.optype; pc_lad, pc_lao, pc_lca, pc_lda, pc_psh, pc_ixa: TypeOf := cgULong; pc_nop, pc_bnt, pc_ngi, pc_not, pc_adi, pc_and, pc_lnd, pc_bnd, pc_bor, pc_bxr, pc_dvi, pc_equ, pc_geq, pc_grt, pc_leq, pc_les, pc_neq, pc_ior, pc_lor, pc_mod, pc_mpi, pc_sbi, pc_shl, pc_shr: TypeOf := cgWord; pc_udi, pc_uim, pc_umi, pc_usr: TypeOf := cgUWord; pc_bnl, pc_ngl, pc_adl, pc_bal, pc_blr, pc_blx, pc_dvl, pc_mdl, pc_mpl, pc_sbl, pc_sll, pc_slr: TypeOf := cgLong; pc_udl, pc_ulm, pc_uml, pc_vsr: TypeOf := cgULong; pc_ngr, pc_adr, pc_dvr, pc_mpr, pc_sbr: TypeOf := cgExtended; pc_cnn, pc_cnv: TypeOf := baseTypeEnum(op^.q & $000F); pc_stk: TypeOf := TypeOf(op^.left); pc_bno: TypeOf := TypeOf(op^.right); otherwise: Error(cge1); end; {case} end; {TypeOf} procedure CommonSubexpressionElimination; { Remove common subexpressions } type localPtr = ^localRecord; {list of local temp variables} localRecord = record next: localPtr; {next label in list} inUse: boolean; {is this temp already in use?} size: integer; {size of the temp area} lab: integer; {label number} end; var bb: blockPtr; {used to trace basic block lists} done: boolean; {for loop termination tests} op: icptr; {used to trace operation lists, trees} lop: icptr; {predecessor of op} temps: localPtr; {list of temp variables} procedure DisposeTemps; { dispose of the list of temp variables } var tp: localPtr; {temp pointer} begin {DisposeTemps} while temps <> nil do begin tp := temps; temps := tp^.next; dispose(tp); end; {while} end; {DisposeTemps} function GetTemp (bb: blockPtr; size: integer): integer; { Allocate a temp storage location } { } { parameters: } { bb - block in which the temp is allocated } { size - size of the temp } { } { Returns: local label number for the temp } var lab: integer; {label number} loc: icptr; {for dc_loc instruction} tp: localPtr; {used to trace lists, allocate new items} begin {GetTemp} lab := 0; {no label found, yet} tp := temps; {try for a temp of the exact size} while tp <> nil do begin if not tp^.inUse then if tp^.size = size then begin lab := tp^.lab; tp^.inUse := true; tp := nil; end; {if} if tp <> nil then tp := tp^.next; end; {while} if lab = 0 then begin {try for a larger temp} tp := temps; while tp <> nil do begin if not tp^.inUse then if tp^.size > size then begin lab := tp^.lab; tp^.inUse := true; tp := nil; end; {if} if tp <> nil then tp := tp^.next; end; {while} end; {if} if lab = 0 then begin {allocate a new temp} loc := pointer(Calloc(sizeof(intermediate_code))); loc^.opcode := dc_loc; loc^.optype := cgWord; maxLoc := maxLoc + 1; loc^.r := maxLoc; lab := maxLoc; loc^.q := size; if bb^.code = nil then begin loc^.next := nil; bb^.code := loc; end {if} else begin loc^.next := bb^.code^.next; bb^.code^.next := loc; end; {else} new(tp); tp^.next := temps; temps := tp; tp^.inUse := true; tp^.size := loc^.q; tp^.lab := lab; end; {if} GetTemp := lab; {return the temp label number} end; {GetTemp} procedure ResetTemps; { Mark all temps as available } var tp: localPtr; {temp pointer} begin {ResetTemps} tp := temps; while tp <> nil do begin tp^.inUse := false; tp := tp^.next; end; {while} end; {ResetTemps} procedure CheckForBlocks (op: icptr); { Scan a tree for blocked instructions } { } { parameters: } { op - tree to check } { } { Notes: Some code takes less time to execute than saving } { and storing the intermediate value. This subroutine } { identifies such patterns. } function Block (op: icptr): boolean; { See if the pattern should be blocked } { } { parameters: } { op - pattern to check } { } { Returns: True if the pattern should be blocked, else } { false. } var opcode: pcodes; {temp opcode} begin {Block} Block := false; opcode := op^.opcode; if opcode = pc_ixa then begin if op^.left^.opcode in [pc_lao,pc_lca,pc_lda] then Block := true; end {else if} else if opcode = pc_shl then begin if op^.right^.opcode = pc_ldc then if op^.right^.q = 1 then if op^.parents <= 3 then Block := true; end {else if} else if opcode = pc_stk then Block := true else if opcode = pc_cnv then if op^.q & $000F = ord(cgVoid) then Block := true; end; {Block} function Max (a, b: integer): integer; { Return the larger of two integers } { } { parameters: } { a, b - integers to check } { } { Returns: a if a > b, else b } begin {Max} if a > b then Max := a else Max := b; end; {Max} begin {CheckForBlocks} if Block(op) then begin if op^.left <> nil then {handle a blocked instruction} op^.left^.parents := op^.left^.parents + Max(op^.parents - 1, 0); if op^.right <> nil then op^.right^.parents := op^.right^.parents + Max(op^.parents - 1, 0); op^.parents := 1; end; {if} if op^.left <> nil then {check the children} CheckForBlocks(op^.left); if op^.right <> nil then CheckForBlocks(op^.right); end; {CheckForBlocks} procedure CheckTree (var op: icptr; bb: blockPtr); { check the trees used by op for common subexpressions } { } { parameters: } { op - operation to check } { bb - start of the current BASIC block } var op2: icptr; {result from Match calls} op3: icptr; {used to trace the codes in a block} function Match (var op: icptr; tree: icptr): icptr; { Check for matches to op in tree } { } { parameters: } { op - operation to check } { tree - tree to examine for matches } { } { Returns: pointer to matching node or nil if none found } var op2: icptr; {result from recursive Match calls} kill, start, stop: boolean; {used by Scan} skip: boolean; {used to see if children should be scanned} procedure Combine (var op1, op2: icptr); { Op2 is a save or copy of the same value as op1; use a copy } { for op2. } { } { parameters: } { op1 - first copy or save } { op2 - copy or save to optimize } var op3: icptr; {work pointer} begin {Combine} done := false; {force another labeling pass} op3 := op2; {remove op2 from the list} if op3^.opcode in [pc_str,pc_sro] then begin if op3^.opcode = pc_str then op3^.opcode := pc_cop else op3^.opcode := pc_cpo; op2 := op3^.next; op3^.next := nil; end {if} else op2 := op3^.left; op1^.left := op3; {place in the new location} end; {Combine} function SameTree (list, op1, op2: icptr): boolean; { Are op1 and op2 in the same expression tree? } { } { parameters: } { list - list of expression trees } { op1, op2 - operations to check } function InTree (tree, op: icptr): boolean; { See if op is in the tree } { } { parameters: } { tree - expression tree to check } { op - operatio to look for } begin {InTree} if tree = nil then InTree := false else if tree = op then InTree := true else InTree := InTree(tree^.left, op) or InTree(tree^.right, op); end; {InTree} begin {SameTree} SameTree := false; while list <> nil do if InTree(list, op1) then begin SameTree := InTree(list, op2); list := nil; end {if} else list := list^.next; end; {SameTree} procedure Scan (list, op1, op2: icptr); { Check to see if any operation between op1 and op2 kills the } { optimization } { } { parameters: } { list - instruction stream } { op1 - starting operation } { op2 - ending operation } { } { globals: } { kill - set to true if the optimization must be blocked, } { or false if it can be performed } { start - has op1 been found? (initialize to false) } { stop - has kill been set? (initialize to false) } begin {Scan} if not start then {see if it is time to start} if list = op1 then start := true; if list^.left <> nil then {scan the children} Scan(list^.left, op1, op2); if not stop then if list^.right <> nil then Scan(list^.right, op1, op2); if start then {check for a kill or termination} if not stop then if list = op2 then begin kill := false; stop := true; end {if} else if list^.opcode in [pc_str,pc_sro,pc_cop,pc_cpo,pc_lli,pc_lil, pc_lld,pc_ldl,pc_gli,pc_gil,pc_gld,pc_gdl] then begin if MatchLoc(list, op2) then begin kill := true; stop := true; end {if} end {else if} else if list^.opcode in [pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild, pc_cup,pc_cui,pc_tl1] then if Member(op1, c_ind) then begin kill := true; stop := true; end; {if} if not stop then {scan forward in the stream} if list^.next <> nil then Scan(list^.next, op1, op2); end; {Scan} begin {Match} op2 := nil; {check for an exact match} skip := false; if CodesMatch(op, tree, true) then begin if op = tree then op2 := tree else begin start := false; stop := false; Scan(bb^.code, tree, op); if not kill then op2 := tree; end; {else} end {if} {check for stores of a common value} else if op^.opcode in [pc_str,pc_sro,pc_cop,pc_cpo] then if tree^.opcode in [pc_str,pc_sro,pc_cop,pc_cpo] then if op^.left = tree^.left then begin start := false; stop := false; Scan(bb^.code, tree, op); if not kill then if not SameTree(bb^.code, op, tree) then if (op^.left^.opcode <> pc_ldc) or ((op^.left^.optype in [cgByte,cgUByte,cgWord,cgUWord]) and (op^.left^.q <> 0)) or ((op^.left^.optype in [cgLong,cgULong]) and (op^.left^.lval <> 0)) or (not (op^.left^.optype in [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong])) then begin Combine(tree, op); skip := true; end; {if} end; {if} if not skip then begin {check for matches in the children} if op2 = nil then if tree^.left <> nil then op2 := Match(op, tree^.left); if op2 = nil then if tree^.right <> nil then op2 := Match(op, tree^.right); end; {if} Match := op2; end; {Match} begin {CheckTree} op^.parents := 0; {zero the parent counter} if op^.left <> nil then {check the children} CheckTree(op^.left, bb); if op^.right <> nil then CheckTree(op^.right, bb); if op^.next = nil then {look for a match to the current code} if not (op^.opcode in [pc_cup,pc_cui,pc_tl1,pc_bno]) then begin op2 := nil; op3 := bb^.code; while (op2 = nil) and (op3 <> nil) do begin op2 := Match(op, op3); if op2 <> nil then if op2^.next = nil then begin op := op2; bb := nil; op3 := nil; end ;{if} if op3 <> nil then op3 := op3^.next; end; {while} end; {if} end; {CheckTree} procedure CountParents (op: icptr); { increment the parent counter for all children of this node } { } { parameters: } { op - node for which to check the children } begin {CountParents} if op^.parents = 0 then begin if op^.left <> nil then begin CountParents(op^.left); op^.left^.parents := op^.left^.parents + 1; end; {if} if op^.right <> nil then begin CountParents(op^.right); op^.right^.parents := op^.right^.parents + 1; end; {if} end; {if} end; {CountParents} procedure CreateTemps (var op: icptr; bb: blockPtr; var lop: icptr); { create temps for nodes with multiple parents } { } { parameters: } { op - node for which to create temps } { bb - current basic block } { lop - predecessor to op } var children: boolean; {does this node have children?} llab: integer; {local label number; for temp} op2, str: icptr; {new opcodes} optype: baseTypeEnum; {type of the temp variable} begin {CreateTemps} children := false; {create temps for the children} if op^.left <> nil then begin children := true; CreateTemps(op^.left, bb, lop); end; {if} if op^.right <> nil then begin children := true; CreateTemps(op^.right, bb, lop); end; {if} if children then if op^.parents > 1 then begin optype := TypeOf(op); {create a temp label} llab := GetTemp(bb, TypeSize(optype)); {make a copy of the duplicated tree} op2 := pointer(Calloc(sizeof(intermediate_code))); op2^ := op^; op^.opcode := pc_lod; {substitute a load of the temp} op^.optype := optype; op^.parents := 1; op^.r := llab; op^.q := 0; op^.left := nil; op^.right := nil; {store the temp result} str := pointer(Calloc(sizeof(intermediate_code))); str^.opcode := pc_str; str^.optype := optype; str^.r := llab; str^.q := 0; str^.left := op2; if lop = nil then begin {insert the store in the basic block} str^.next := bb^.code; bb^.code := str; end {if} else begin str^.next := lop^.next; lop^.next := str; end; {else} lop := str; end; {if} end; {CreateTemps} begin {CommonSubexpressionElimination} temps := nil; {no temps allocated, yet} repeat {identify common parts} done := true; bb := DAGblocks; while bb <> nil do begin Spin; op := bb^.code; if op <> nil then begin CheckTree(bb^.code, bb); while op^.next <> nil do begin CheckTree(op^.next, bb); if op^.next <> nil then op := op^.next; end; {while} end; {if} bb := bb^.next; end; {while} until done; bb := DAGblocks; {count the number of parents} while bb <> nil do begin op := bb^.code; Spin; while op <> nil do begin CountParents(op); op := op^.next; end; {while} bb := bb^.next; end; {while} bb := DAGblocks; {check for blocked instructions} while bb <> nil do begin op := bb^.code; Spin; while op <> nil do begin CheckForBlocks(op); op := op^.next; end; {while} bb := bb^.next; end; {while} bb := DAGblocks; {create temps for common subexpressions} while bb <> nil do begin op := bb^.code; lop := nil; ResetTemps; Spin; while op <> nil do begin CreateTemps(op, bb, lop); lop := op; op := op^.next; end; {while} bb := bb^.next; end; {while} DisposeTemps; {get rid of the temp variable list} end; {CommonSubexpressionElimination} {- Loop Optimizations ------------------------------------------} procedure AddOperation (op: icptr; var lp: iclist); { Add an operation to an operation list } { } { parameters: } { op - operation to add } { lp - list to add the operation to } var inList: boolean; {is op already in the list?} llp: iclist; {work pointer} begin {AddOperation} llp := lp; inList := false; while llp <> nil do if MatchLoc(llp^.op, op) then begin inList := true; llp := nil; end {if} else llp := llp^.next; if not inList then begin new(llp); llp^.next := lp; lp := llp; llp^.op := op; end; {if} end; {AddOperation} procedure DisposeBlkList (var blk: blockListPtr); { dispose of all entries in the block list } { } { parameters: } { blk - list of blocks to dispose of } var bk1, bk2: blockListPtr; {work pointers} begin {DisposeBlkList} bk1 := blk; blk := nil; while bk1 <> nil do begin bk2 := bk1; bk1 := bk2^.next; dispose(bk2); end; {while} end; {DisposeBlkList} procedure DisposeOpList (var oplist: iclist); { dispose of all entries in the list } { } { parameters: } { oplist - operation list to dispose of } var op1, op2: iclist; {work pointers} begin {DisposeOpList} op1 := oplist; oplist := nil; while op1 <> nil do begin op2 := op1; op1 := op2^.next; dispose(op2); end; {while} end; {DisposeOpList} procedure DumpLoopLists; { dispose of lists created by ReachingDefinitions and Dominators} var bb: blockPtr; {used to trace basic block list} dom: blockListPtr; {used to dispose of a dominator} begin {DumpLoopLists} bb := DAGBlocks; while bb <> nil do begin DisposeOpList(bb^.c_in); {dump the reaching definition lists} DisposeOpList(bb^.c_out); DisposeOpList(bb^.c_gen); DisposeBlkList(bb^.dom); while bb^.dom <> nil do begin {dump the dominator lists} dom := bb^.dom; bb^.dom := dom^.next; dispose(dom); end; {while} bb := bb^.next; end; {while} end; {DumpLoopLists} procedure AddLoads (jp: icptr; var lp: iclist); { Add any load addresses from the children of this } { operation } { } { parameters: } { jp - operation to check } { lp - list to add the loads to } begin {AddLoads} if jp^.opcode in [pc_lda,pc_lao,pc_lod,pc_lod] then AddOperation(jp, lp) else begin if jp^.left <> nil then AddLoads(jp^.left, lp); if jp^.right <> nil then AddLoads(jp^.right, lp); end {else} end; {AddLoads} procedure FlagIndirectUses; { Find all variables that could be changed by an indirect } { access. } var bb: blockPtr; {used to trace block list} procedure Check (op: icptr; doingInd: boolean); { Check op and its children & followers for dangerous } { references } { } { parameters: } { op - operation to check } { doingInd - are we doing a pc_ind? If so, pc_lda's } { are safe } var lDoingInd: boolean; {local doingInd} begin {Check} while op <> nil do begin if op^.opcode = pc_ind then lDoingInd := true else lDoingInd := doingInd; if op^.left <> nil then Check(op^.left, lDoingInd); if op^.right <> nil then Check(op^.right, lDoingInd); if op^.opcode in [pc_lao,pc_cpo,pc_ldo,pc_sro,pc_gil,pc_gli, pc_gdl,pc_gld] then AddOperation(op, c_ind) else if op^.opcode = pc_ind then begin if op^.left^.opcode = pc_ind then AddLoads(op^.left^.left, c_ind); end {else if} else if op^.opcode = pc_lda then if not doingInd then AddOperation(op, c_ind); op := op^.next; end; {while} end; {Check} begin {FlagIndirectUses} c_ind := nil; bb := DAGBlocks; while bb <> nil do begin Check(bb^.code, false); bb := bb^.next; end; {while} end; {FlagIndirectUses} procedure DoLoopOptimization; { Perform optimizations related to loops and data flow } type dftptr = ^dftrecord; {depth first tree edges} dftrecord = record next: dftptr; from, dest: blockPtr; end; var backEdge: dftptr; {list of back edges} dft: dftptr; {depth first tree} dft2: dftptr; {work pointer} function DFN (i: integer): blockPtr; { find the basic block with dfn index of i } { } { parameters: } { i - index to look for } { } { Returns: block pointer, or nil if there is none } var bb: blockPtr; {used to trace block list} begin {DFN} bb := DAGBlocks; DFN := nil; while bb <> nil do begin if bb^.dfn = i then begin DFN := bb; bb := nil; end else bb := bb^.next; end; {while} end; {DFN} function MemberDFNList (dfn: integer; bl: blockListPtr): boolean; { See if dfn is a member of the list bl } { } { parameters: } { dfn - block number to check } { bl - list of block numbers to check } { } { Returns: True if dfn is in bl, else false. } begin {MemberDFNList} MemberDFNList := false; while bl <> nil do if bl^.dfn = dfn then begin MemberDFNList := true; bl := nil; end {if} else bl := bl^.next; end; {MemberDFNList} function FindDAG (q: integer): blockPtr; { Find the DAG containing label q } { } { parameters: } { q - label to find } { } { Returns: pointer to the proper basic block } var bb: blockPtr; {used to trace basic block list} begin {FindDAG} bb := DAGBlocks; FindDAG := nil; while bb <> nil do begin if bb^.code^.opcode = dc_lab then if bb^.code^.q = q then begin FindDAG := bb; bb := nil; end; {if} if bb <> nil then bb := bb^.next; end; {while} end; {FindDAG} procedure DepthFirstOrder; { Number the DAG for depth first order } var bb: blockPtr; {used to trace basic block lists} i: integer; {dfn index} procedure Search (bb: blockPtr); { Search this block } { } { parameters: } { bb - basic block to search } var blk: blockPtr; {work block} ndft: dftptr; {for new tree entries} op: icptr; {used to trace operation list} function NotUnconditional: boolean; { See if the block ends with something other than an } { unconditional jump } { } { Returns: True if the block ends with something other } { than pc_ujp or pc_add, else false } var op: icptr; {used to trace the list} begin {NotUnconditional} NotUnconditional := true; op := bb^.code; if op <> nil then begin while op^.next <> nil do op := op^.next; if op^.opcode in [pc_add,pc_ujp] then NotUnconditional := false; end; {if} end; {NotUnconditional} begin {Search} Spin; if bb <> nil then if not bb^.visited then begin bb^.visited := true; if NotUnconditional then if bb^.next <> nil then begin new(ndft); ndft^.next := dft; dft := ndft; ndft^.from := bb; ndft^.dest := bb^.next; Search(bb^.next); end; {if} op := bb^.code; while op <> nil do begin if op^.opcode in [pc_ujp, pc_fjp, pc_tjp, pc_add] then begin blk := FindDAG(op^.q); new(ndft); if blk^.visited then begin ndft^.next := backEdge; backEdge := ndft; end {if} else begin ndft^.next := dft; dft := ndft; Search(blk); end; {else} ndft^.from := bb; ndft^.dest := blk; end; {if} op := op^.next; end; {while} bb^.dfn := i; i := i-1; end; {if} end; {Search} begin {DepthFirstOrder} dft := nil; backEdge := nil; i := 0; bb := DAGblocks; while bb <> nil do begin bb^.visited := false; i := i+1; bb := bb^.next; end; {while} Search(DAGBlocks); end; {DepthFirstOrder} procedure Dominators; { Find a list of dominators for each node } var bb: blockPtr; {used to trace the block list} change: boolean; {for loop termination test} i, j: integer; {loop variables} maxdfn, mindfn: integer; {max and min dfn values used} procedure Add (var dom: blockListPtr; dfn: integer); { Add dfn to the list of dominators } { } { parameters: } { dom - dominator list } { dfn - new dominator number } var dp: blockListPtr; {new node} begin {Add} new(dp); dp^.last := nil; dp^.next := dom; dom^.last := dp; dom := dp; dp^.dfn := dfn; end; {Add} procedure CheckPredecessors (bb: blockPtr; bl: dftptr); { Eliminate nodes that don't dominate a predecessor } { } { parameters: } { bb - block being checked } { bl - list of edges to check for predecessors } var dp: blockListPtr; {list of dominator numbers} tdp: blockListPtr; {used to remove a dominator entry} begin {CheckPredecessors} while bl <> nil do begin if bl^.dest = bb then begin dp := bb^.dom; while dp <> nil do if dp^.dfn <> bb^.dfn then if not MemberDFNList(dp^.dfn, bl^.from^.dom) then begin change := true; tdp := dp; if tdp^.last = nil then bb^.dom := tdp^.next else tdp^.last^.next := tdp^.next; if tdp^.next <> nil then tdp^.next^.last := tdp^.last; dp := tdp^.next; dispose(tdp); end {if} else dp := dp^.next else dp := dp^.next; end; {if} bl := bl^.next; end; {while} end; {CheckPredecessors} begin {Dominators} Spin; maxdfn := 0; {find the largest dfn} bb := DAGBlocks; while bb <> nil do begin if bb^.dfn > maxdfn then maxdfn := bb^.dfn; bb := bb^.next; end; {while} Add(DAGBlocks^.dom, DAGBlocks^.dfn); {the first node is it's own dominator} mindfn := DAGBlocks^.dfn; {assume all other nodes are dominated by every other node} for i := mindfn+1 to maxdfn do begin bb := DFN(i); if bb <> nil then for j := mindfn to maxdfn do Add(bb^.dom, j); end; {for} repeat {iterate to the true set of dominators} change := false; for i := mindfn+1 to maxdfn do begin bb := DFN(i); CheckPredecessors(bb, dft); CheckPredecessors(bb, backEdge); end; {for} until not change; end; {Dominators} procedure ReachingDefinitions; { find the list of reaching definitions for each basic block } var bb: blockPtr; {block being scanned} change: boolean; {loop termination test} i: integer; {node index number} newIn: iclist; {list of inputs} function Gen (op: icptr): iclist; { find a list of generated values } { } { parameters: } { op - list of intermediate codes to scan } { } { Returns: list of generated definitions } var gp: iclist; {list of generated definitions} indFound: boolean; {has an indirect store been found?} procedure Check (ip: icptr); { Add any result from ip to gp } { } { parameters: } { ip - instruction to check } var lc_ind: iclist; {used to trace the c_ind list} begin {Check} if ip^.left <> nil then Check(ip^.left); if ip^.right <> nil then Check(ip^.right); if ip^.opcode in [pc_str,pc_sro,pc_cop,pc_cpo,pc_lli,pc_lil,pc_lld,pc_ldl, pc_gli,pc_gil,pc_gld,pc_gdl] then AddOperation(ip, gp) else if ip^.opcode in [pc_mov,pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild] then AddLoads(ip, gp); if not indFound then if ip^.opcode in [pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild,pc_cup,pc_cui,pc_tl1] then begin lc_ind := c_ind; while lc_ind <> nil do begin AddOperation(lc_ind^.op, gp); lc_ind := lc_ind^.next; end; {while} indFound := true; end; {if} end; {Check} begin {Gen} indFound := false; gp := nil; while op <> nil do begin Check(op); op := op^.next; end; {while} Gen := gp; end; {Gen} function EqualSets (l1, l2: iclist): boolean; { See if two sets of stores and copies are equivalent } { } { parameters: } { l1, l2 - lists of copies and stores } { } { Returns: True if the lists are equivalent, else false } { } { Notes: The members of each list are assumed to be } { unique within that list. } var c1, c2: integer; {number of elements in the sets} l3: iclist; {used to trace the lists} matchFound: boolean; {was a match found?} begin {EqualSets} EqualSets := false; {assume they are not equal} c1 := 0; {count the elements of l1} l3 := l1; while l3 <> nil do begin c1 := c1+1; l3 := l3^.next; end; {while} c2 := 0; {count the elements of l2} l3 := l2; while l3 <> nil do begin c2 := c2+1; l3 := l3^.next; end; {while} if c1 = c2 then begin {make sure each member of l1 is in l2} EqualSets := true; while l1 <> nil do begin matchFound := false; l3 := l2; while l3 <> nil do begin if MatchLoc(l1^.op, l3^.op) then begin l3 := nil; matchFound := true; end {if} else l3 := l3^.next; end; {while} if not matchFound then begin EqualSets := false; l1 := nil; end {if} else l1 := l1^.next; end; {while} end; {if} end; {EqualSets} function Union (l1, l2: iclist): iclist; { Returns a list that is the union of two input lists } { } { parameters: } { l1, l2 - lists } { } { Returns: New, dynamically allocated list that includes } { all of the members in l1 and l2. } { } { Notes: } { 1. If there are duplicates, the member from l1 is } { returned. } { 2. It is assumed that all members of l1 and l2 are } { unique within their own list. } { 3. The original lists are not disturbed. } { 4. The caller is responsible for disposing of the } { memory used by the list. } var lp: iclist; {new list pointer} np: iclist; {new list member pointer} tp: iclist; {temp list pointer} begin {Union} lp := nil; tp := l1; while tp <> nil do begin new(np); np^.next := lp; lp := np; np^.op := tp^.op; tp := tp^.next; end; {while} while l2 <> nil do begin if not Member(l2^.op, l1) then begin new(np); np^.next := lp; lp := np; np^.op := l2^.op; end; {if} l2 := l2^.next; end; {while} Union := lp; end; {Union} function UnionOfPredecessors (bptr: blockPtr): iclist; { create a union of the outputs of predecessors to bptr } { } { parameters: } { bptr - block for which to look for predecessors } { } { Returns: Resulting set } var bp: dftptr; {used to trace edge lists} plist: iclist; {result list} tlist: iclist; {temp result list} begin {UnionOfPredecessors} plist := nil; bp := dft; while bp <> nil do begin if bp^.dest = bptr then begin tlist := Union(plist, bp^.from^.c_out); DisposeOpList(plist); plist := tlist; end; {if} bp := bp^.next; end; {while} bp := backEdge; while bp <> nil do begin if bp^.dest = bptr then begin tlist := Union(plist, bp^.from^.c_out); DisposeOpList(plist); plist := tlist; end; {if} bp := bp^.next; end; {while} UnionOfPredecessors := plist; end; {UnionOfPredecessors} begin {ReachingDefinitions} i := 1; {initialize the lists} repeat bb := DFN(i); if bb <> nil then begin bb^.c_in := nil; bb^.c_gen := Gen(bb^.code); bb^.c_out := Union(nil, bb^.c_gen); end; {if} i := i+1; until bb = nil; repeat {iterate to a solution} change := false; i := 1; repeat Spin; bb := DFN(i); if bb <> nil then begin newIn := UnionOfPredecessors(bb); if not EqualSets(bb^.c_in, newIn) then begin {IN[n] := newIn} DisposeOpList(bb^.c_in); bb^.c_in := newIn; newIn := nil; {OUT[n] := IN[n] - KILL[n] U GEN[n]} DisposeOpList(bb^.c_out); bb^.c_out := Union(bb^.c_in, nil); change := true; end; {if} DisposeOpList(newIn); end; {if} i := i+1; until bb = nil; until not change; end; {ReachingDefinitions} procedure LoopInvariantRemoval; { Remove all loop invariant computations } type loopPtr = ^loopRecord; {blocks in a list} loopRecord = record next: loopPtr; {next entry} block: blockPtr; {code block} exit: boolean; {is this a loop exit?} end; loopListPtr = ^loopListRecord; {list of loop lists} loopListRecord = record next: loopListPtr; loop: loopPtr; end; var icount: integer; {order invariant found} loops: loopListPtr; {list of loops} lp: loopPtr; {used to trace loop lists} llp: loopListPtr; {used to trace the list of loops} procedure FindLoops; { Create a list of the natural loops } var blk: blockPtr; {target block for a jump} bp: dftptr; {used to trace the back edges} lp, lp2: loopPtr; {used to reverse the list} llp: loopListPtr; {loop list header entry} llp2: loopListPtr; {used to reverse the list} op: icptr; {used to trace the opcode list} procedure Add (block: blockPtr); { Add a block to the current loop list } { } { parameters: } { block - block to add } var lp: loopPtr; {new loop entry} begin {Add} new(lp); lp^.next := llp^.loop; llp^.loop := lp; lp^.block := block; lp^.exit := false; end; {Add} function InLoop (blk: blockPtr; lp: loopPtr): boolean; { See if the block is in the loop } { } { parameters: } { blk - block to check for } { lp - loop list } { } { Returns: True if blk is in the list, else false } begin {InLoop} InLoop := false; while lp <> nil do begin if lp^.block = blk then begin lp := nil; InLoop := true; end {if} else lp := lp^.next; end; {while} end; {InLoop} procedure Insert (block: blockPtr); { Insert a block into the loop list } { } { parameters: } { block - block to add } procedure AddPredecessors (block: blockPtr; bl: dftptr); { add any predecessors to the loop } { } { parameters: } { block - block for which to check for } { predecessors } { bl - list of edges to check } begin {AddPredecessors} while bl <> nil do begin if bl^.dest = block then Insert(bl^.from); bl := bl^.next; end; {while} end; {AddPredecessors} function InLoop (block: blockPtr; lp: loopPtr): boolean; { See if a block is in the loop } { } { parameters: } { block - block to check } { lp - list of blocks in the loop } { } { Returns: True if the block is in the loop, else false } begin {InLoop} InLoop := false; while lp <> nil do if lp^.block = block then begin InLoop := true; lp := nil; end {if} else lp := lp^.next; end; {InLoop} begin {Insert} if not InLoop(block, llp^.loop) then begin Add(block); AddPredecessors(block, dft); AddPredecessors(block, backEdge); end; {if} end; {Insert} begin {FindLoops} loops := nil; bp := backEdge; {scan the back edges} while bp <> nil do begin if MemberDFNList(bp^.dest^.dfn, bp^.from^.dom) then begin new(llp); {create a new loop list entry} llp^.next := loops; loops := llp; llp^.loop := nil; Add(bp^.dest); Insert(bp^.from); lp := llp^.loop; {reverse the list} llp^.loop := nil; while lp <> nil do begin lp2 := lp; lp := lp2^.next; lp2^.next := llp^.loop; llp^.loop := lp2; end; {while} lp := llp^.loop; {mark the exits} while lp <> nil do begin op := lp^.block^.code; while op <> nil do begin if op^.opcode in [pc_ujp, pc_fjp, pc_tjp, pc_add] then begin blk := FindDAG(op^.q); if not InLoop(blk, llp^.loop) then lp^.exit := true; if op^.opcode in [pc_fjp,pc_tjp] then if not InLoop(lp^.block^.next, llp^.loop) then lp^.exit := true; end; {if} op := op^.next; end; {while} lp := lp^.next; end; {while} end; {if} bp := bp^.next; end; {while} llp := loops; {reverse the loop list} loops := nil; while llp <> nil do begin llp2 := llp; llp := llp2^.next; llp2^.next := loops; loops := llp2; end; {while} end; {FindLoops} function MarkInvariants (lp: loopPtr): boolean; { Make a pass over the opcodes, marking those that are } { invariant. } { } { parameters: } { lp - loop to scan } { } { Returns: True if any new nodes were marked, else false. } var count: integer; {number of generating blocks} indirectStores: boolean; {does the loop contain indirect stores or function calls?} inhibit: boolean; {inhibit stores?} lp2: loopPtr; {used to trace the loop} op: icptr; {used to trace the instruction list} opcode: pcodes; {op^.opcode; for efficiency} procedure Check (op: icptr; olp: loopPtr); { See if this node or its children is invariant } { } { parameters: } { op - node to check } { olp - loop entry for the block containing the store } var invariant: boolean; {are the operands invariant?} function IndirectInhibit (op: icptr): boolean; { See if a store should be inhibited due to indirect } { accesses } { } { parameters: } { op - instruction to check } { } { Returns: True if the instruction should be inhibited, } { else false. } begin {IndirectInhibit} IndirectInhibit := false; if indirectStores then if Member(op, c_ind) then IndirectInhibit := true; end; {IndirectInhibit} function NoOtherStoresOrUses (lp, olp: loopPtr; op: icptr): boolean; { Check for invalid stores } { } { parameters: } { lp - loop to check } { olp - loop entry for the block containing the store } { op - store to check } { } { Returns: True if the store is valid, false if not. } { } { Notes: Specifically, these two rules are inforced: } { 1. No other stores to the same location appear in the } { loop. } { 2. All uses of the value in the loop can be reached } { only by the assign. } var lp2: loopPtr; {used to trace the loop list} op2: icptr; {used to trace code list} function SafeLoad (sop, lop: icptr; sbk, lbk: blockPtr): boolean; { See if a load is in a safe position } { } { parameters: } { sop - save opcode that may need to be left in loop } { lop - load operation that may inhibit the save } { sbk - block containing the save } { lbk - block containing the load } function First (op1, op2, stream: icptr): icptr; { See which operation comes first } { } { parmeters: } { op1, op2 - instructions to check } { stream - start of block containing the instructions } { } { Returns: First operation found, or nil if missing } var op: icptr; {temp opcode} begin {First} if stream = op1 then First := op1 else if stream = op2 then First := op2 else begin op := nil; if stream^.left <> nil then op := First(op1, op2, stream^.left); if op = nil then if stream^.right <> nil then op := First(op1, op2, stream^.right); if op = nil then if stream^.next <> nil then op := First(op1, op2, stream^.next); First := op; end; {else} end; {First} begin {SafeLoad} if sbk = lbk then SafeLoad := First(sop, lop, sbk^.code) = sop else SafeLoad := MemberDFNList(sbk^.dfn, lbk^.dom); end; {SafeLoad} function MatchStores (op, tree: icptr; opbk, treebk: blockPtr): boolean; { Check the tree for stores to the same location as op } { } { parameters: } { op - store to check for } { tree - operation tree to check } { opbk - block containing op } { treebk - block containing tree } { } { Returns: True if there are matching stores, else false } var result: boolean; {function result} begin {MatchStores} result := false; if tree^.opcode in [pc_lli,pc_lil,pc_lld,pc_ldl,pc_str,pc_cop, pc_sro,pc_cpo,pc_gli,pc_gil,pc_gld,pc_gdl] then begin if tree <> op then result := MatchLoc(op, tree); end {if} else if tree^.opcode in [pc_ldo,pc_lod] then if MatchLoc(op, tree) then result := not SafeLoad(op, tree, opbk, treebk); if not result then if tree^.left <> nil then result := MatchStores(op, tree^.left, opbk, treebk); if not result then if tree^.right <> nil then result := MatchStores(op, tree^.right, opbk, treebk); MatchStores := result; end; {MatchStores} begin {NoOtherStoresOrUses} NoOtherStoresOrUses := true; lp2 := lp; while lp2 <> nil do begin op2 := lp2^.block^.code; while op2 <> nil do if MatchStores(op, op2, olp^.block, lp2^.block) then begin op2 := nil; lp2 := nil; NoOtherStoresOrUses := false; end {if} else op2 := op2^.next; if lp2 <> nil then lp2 := lp2^.next; end; {while} end; {NoOtherStoresOrUses} function NumberOfGens (op: icptr; lp: loopPtr): integer; { Count the number of nodes that generate op } { } { parameters: } { op - instruction to check } { lp - loop to check } var count: integer; {number of generators} begin {NumberOfGens} count := 0; while lp <> nil do begin if Member(op, lp^.block^.c_gen) then count := count+1; lp := lp^.next; end; {while} NumberOfGens := count; end; {NumberOfGens} function PreviousStore (op, list: icptr): boolean; { See if the last save was invariant } { } { parameters: } { op - load operation } { list - block containing the load } { } { Returns: True if the previous store was invariant, else } { false. } var indop: icptr; {any indirect operation after strop} strop: icptr; {last matching store before op} procedure Check (lop: icptr); { Stop if this is lop; save if it is a matching store } { } { parameters: } { lop - check this operation and it's children } begin {Check} if lop^.left <> nil then Check(lop^.left); if list <> nil then if lop^.right <> nil then Check(lop^.right); if list <> nil then if lop = op then list := nil else if (lop^.opcode in [pc_str,pc_cop,pc_str,pc_cop]) and MatchLoc(op, lop) then begin strop := lop; indop := nil; end {else if} else if op^.opcode in [pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild,pc_cup,pc_cui,pc_tl1] then indop := op; end; {Check} function Inhibit (indop, op: icptr): boolean; { See if op should be inhibited due to indirect stores } { } { parameters: } { indop - inhibiting indirect store or nil } { op - instruction to check } begin {Inhibit} Inhibit := false; if indop <> nil then if Member(op, c_ind) then Inhibit := true; end; {Inhibit} begin {PreviousStore} indop := nil; strop := nil; while list <> nil do begin Check(list); if list <> nil then list := list^.next; end; {while} PreviousStore := false; if strop <> nil then if strop^.parents <> 0 then if not Inhibit(indop, op) then PreviousStore := true; end; {PreviousStore} begin {Check} if op^.parents = 0 then begin invariant := true; if op^.left <> nil then begin Check(op^.left, olp); if op^.left^.parents = 0 then invariant := false; end; {if} if op^.right <> nil then begin Check(op^.right, olp); if op^.right^.parents = 0 then invariant := false; end; {if} if invariant then begin opcode := op^.opcode; if opcode in [pc_adi,pc_adl,pc_adr,pc_and,pc_lnd,pc_bnd,pc_bal, pc_bnt,pc_bnl,pc_bor,pc_blr,pc_bxr,pc_blx,pc_bno, pc_dec,pc_dvi,pc_udi,pc_dvl,pc_udl,pc_dvr,pc_equ,pc_neq, pc_grt,pc_les,pc_geq,pc_leq,pc_inc,pc_ind,pc_ior,pc_lor, pc_ixa,pc_lad,pc_lao,pc_lca,pc_lda,pc_ldc,pc_mod,pc_uim, pc_mdl,pc_ulm,pc_mpi,pc_umi,pc_mpl,pc_uml,pc_mpr,pc_ngi, pc_ngl,pc_ngr,pc_not,pc_pop,pc_sbf,pc_sbi,pc_sbl,pc_sbr, pc_shl,pc_sll,pc_shr,pc_usr,pc_slr,pc_vsr,pc_tri] then begin op^.parents := icount; icount := icount+1; end {if} else if opcode = pc_cnv then begin if op^.q & $000F <> ord(cgVoid) then begin op^.parents := icount; icount := icount+1; end; {if} end {else if} else if opcode in [pc_sro,pc_sto,pc_str,pc_cop,pc_cpo,pc_cpi,pc_cbf] then begin if not inhibit then if not IndirectInhibit(op) then if NoOtherStoresOrUses(lp, olp, op) then begin op^.parents := icount; icount := icount+1; end; {if} end {else if} else if opcode in [pc_ldo,pc_lod] then begin {invariant if there is an immediately preceeding invariant store} if PreviousStore(op, lp2^.block^.code) then begin op^.parents := icount; icount := icount+1; end {if} else if not Member(op, lp2^.block^.c_gen) then begin {invariant if there are no generators in the loop} count := NumberOfGens(op, lp); if count = 0 then begin op^.parents := icount; icount := icount+1; end {if} else if count = 1 then begin {invariant if there is one generator AND the generator} {is not in the current block AND no reaching } {definitions for the loop AND generating statement is } {invariant } if memberOp^.parents <> 0 then if not Member(op, lp^.block^.c_in) then begin op^.parents := icount; icount := icount+1; end; {if} end; {else if} end; {else} end {else if} end; {if} if op^.parents <> 0 then MarkInvariants := true; end; {if} end; {Check} function CheckForIndirectStores (lp: loopPtr): boolean; { See if there are any indirect stores or function calls in } { the loop } { } { parameters: } { lp - loop to check } { } { Returns: True if there are indirect stores or function } { calls, else false. } function CheckOps (op: icptr): boolean; { Check this operation list } { } { parameters: } { op - operation list to check } { } { Returns: True if an indirect store or function call is } { found, else false. } var result: boolean; {value to return} begin {CheckOps} result := false; while op <> nil do begin if op^.opcode in [pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild,pc_cup,pc_cui, pc_tl1,pc_mov] then begin result := true; op := nil; end {if} else begin if op^.left <> nil then result := CheckOps(op^.left); if not result then if op^.right <> nil then result := CheckOps(op^.right); if result then op := nil; end; {if} if op <> nil then op := op^.next; end; {while} CheckOps := result; end; {CheckOps} begin {CheckForIndirectStores} CheckForIndirectStores := false; while lp <> nil do if CheckOps(lp^.block^.code) then begin CheckForIndirectStores := true; lp := nil; end {if} else lp := lp^.next; end; {CheckForIndirectStores} function DominatesExits (dfn: integer; lp: loopPtr): boolean; { See if this block dominates all loop exits } { } { parameters: } { dfn - block that must dominate exits } { lp - loop list } { } { Returns: True if the block dominates all exits, else false. } var dom: blockListPtr; {used to trace dominator list} begin {DominatesExits} DominatesExits := true; while lp <> nil do begin if lp^.exit then begin dom := lp^.block^.dom; while dom <> nil do if dom^.dfn = dfn then dom := nil else begin dom := dom^.next; if dom = nil then begin lp := nil; DominatesExits := false; end; {if} end; {else} end; {if} if lp <> nil then lp := lp^.next; end; {while} end; {DominatesExits} begin {MarkInvariants} MarkInvariants := false; lp2 := lp; while lp2 <> nil do begin inhibit := not DominatesExits(lp2^.block^.dfn, lp); indirectStores := CheckForIndirectStores(lp); op := lp2^.block^.code; while op <> nil do begin Check(op, lp2); op := op^.next; end; {while} lp2 := lp2^.next; end; {while} end; {MarkInvariants} procedure RemoveInvariants (llp: loopListPtr); { Remove loop invariant calculations } { } { parameters: } { llp - pointer to the loop entry to process } var icount, oldIcount: integer; {invariant order counters} nhp: blockPtr; {new loop hedaer pointer} op1, op2, op3: icptr; {used to reverse the code list} procedure CreateHeader; { Create the new loop header } { } { Notes: As a side effect, CreateHeader sets nhp to point to } { the new loop header. } var lp: loopPtr; {new loop list entry} ohp: blockPtr; {old loop hedaer pointer} begin {CreateHeader} nhp := pointer(Calloc(sizeof(block))); {create the new block} ohp := llp^.loop^.block; {insert it in the block list} nhp^.last := ohp^.last; if nhp^.last <> nil then nhp^.last^.next := nhp; nhp^.next := ohp; ohp^.last := nhp; new(lp); {add it to the loop list} lp^.next := llp^.loop; llp^.loop := lp; lp^.block := nhp; lp^.exit := false; end; {CreateHeader} function FindInvariant (ic: integer): integer; { Find the next invariant calculation } { } { parameters: } { ic - base count; the new count must exceed this } { } { Returns: count for the invariant record to remove } var lp: loopPtr; {used to trace loop list} op: icptr; {used to trace code list} nic: integer; {lowest count > ic} procedure Check (op: icptr); { See if op or its children represent a newer invariant } { calculation than the one numbered nic } { } { parameters: } { op - instruction to check } { } { Notes: Rejecting pc_bno here is rather odd, but it allows } { expressions _containing_ pc_bno to be removed without } { messing up pc_tri operations by allowing pc_bno to be } { removed as the top level of an expression. } begin {Check} if op^.parents = 0 then begin if op^.left <> nil then Check(op^.left); if op^.right <> nil then Check(op^.right); end {if} else begin if op^.parents < nic then if op^.parents > ic then if op^.opcode <> pc_bno then nic := op^.parents; end; {else} end; {Check} begin {FindInvariant} nic := maxint; lp := llp^.loop; while (lp <> nil) and (nic <> ic+1) do begin op := lp^.block^.code; while op <> nil do begin Check(op); op := op^.next; end; {while} lp := lp^.next; end; {while} FindInvariant := nic; end; {FindInvariant} procedure RemoveInvariant (ic: integer); { Move the invariant calculation to the header } { } { parameters: } { ic - index number for instruction to remove } var done: boolean; {loop termination test} lp: loopPtr; {used to trace loop list} op: icptr; {used to trace code list} procedure Check (op: icptr); { See if a child of op is the target instruction to move } { (If so, move it.) } { } { parameters: } { op - instruction to check } procedure Remove (var op: icptr); { Move a calculation to the loop header } { } { parameters: } { op - invariant calculation to move } var loc, op2, str: icptr; {new opcodes} optype: baseTypeEnum; {type of the temp variable} begin {Remove} if (op^.left <> nil) or (op^.right <> nil) then begin optype := TypeOf(op); {create a temp label} loc := pointer(Calloc(sizeof(intermediate_code))); loc^.opcode := dc_loc; loc^.optype := cgWord; maxLoc := maxLoc + 1; loc^.r := maxLoc; loc^.q := TypeSize(optype); loc^.next := nhp^.code; nhp^.code := loc; {make a copy of the tree} op2 := pointer(Malloc(sizeof(intermediate_code))); op2^ := op^; op^.opcode := pc_lod; {substitute a load of the temp} op^.optype := optype; op^.r := loc^.r; op^.q := 0; op^.left := nil; op^.right := nil; {store the temp result} str := pointer(Calloc(sizeof(intermediate_code))); str^.opcode := pc_str; str^.optype := optype; str^.r := loc^.r; str^.q := 0; str^.left := op2; str^.next := loc^.next; {insert the store in the basic block} loc^.next := str; end; {if} done := true; end; {Remove} begin {Check} if op^.left <> nil then begin if op^.left^.parents = ic then Remove(op^.left); if not done then Check(op^.left); end; {if} if not done then if op^.right <> nil then begin if op^.right^.parents = ic then Remove(op^.right); if not done then Check(op^.right); end; {if} end; {Check} procedure RemoveTop (var op: icptr); { Move a top-level instruction to the header } { } { parameters: } { op - top level instruction to remove } var op2: icptr; {temp operation} begin {RemoveTop} op2 := op; op := op^.next; op2^.next := nhp^.code; nhp^.code := op2; end; {RemoveTop} begin {RemoveInvariant} lp := llp^.loop; done := false; while not done do begin op := lp^.block^.code; if op <> nil then if op^.parents = ic then begin RemoveTop(lp^.block^.code); done := true; end {if} else begin Check(op); while (op^.next <> nil) and (not done) do begin if op^.next^.parents = ic then begin RemoveTop(op^.next); done := true; end {if} else Check(op^.next); if op^.next <> nil then op := op^.next; end; {while} end; {else} lp := lp^.next; if lp = nil then done := true; end; {while} end; {RemoveInvariant} begin {RemoveInvariants} CreateHeader; {create a loop header block} icount := 0; {find & remove all invariants} repeat oldIcount := icount; icount := FindInvariant (icount); if icount <> maxint then RemoveInvariant(icount); until icount = maxint; op1 := nhp^.code; {reverse the new code list} op2 := nil; while op1 <> nil do begin op3 := op1; op1 := op1^.next; op3^.next := op2; op2 := op3; end; {while} nhp^.code := op2; end; {RemoveInvariants} procedure ZeroParents (lp: loopPtr); { Zero the parents field in all nodes } { } { parameters: } { lp - loop for which to zero the parents } var op: icptr; {used to trace the opcode list} procedure Zero (op: icptr); { Zero the parents field for this node and its } { children. } { } { parameters: } { op - node to zero } begin {Zero} op^.parents := 0; if op^.left <> nil then Zero(op^.left); if op^.right <> nil then Zero(op^.right); end; {Zero} begin {ZeroParents} while lp <> nil do begin op := lp^.block^.code; while op <> nil do begin Zero(op); op := op^.next; end; {while} lp := lp^.next; end; {while} end; {ZeroParents} begin {LoopInvariantRemoval} Spin; FindLoops; {find a list of natural loops} llp := loops; {scan the loops...} icount := 1; while llp <> nil do begin Spin; ZeroParents(llp^.loop); {set the parents field to zero} while MarkInvariants(llp^.loop) do {mark the loop invariant computations} ; if icount <> 1 then RemoveInvariants(llp); {remove loop invariant calculations} llp := llp^.next; end; {while} while loops <> nil do begin {dispose of the loop lists} while loops^.loop <> nil do begin lp := loops^.loop; loops^.loop := lp^.next; dispose(lp); end; {while} llp := loops; loops := llp^.next; dispose(llp); end; {while} end; {LoopInvariantRemoval} begin {DoLoopOptimization} DepthFirstOrder; {create the depth first tree} ReachingDefinitions; {find reaching definitions} Dominators; {find the lists of dominators} LoopInvariantRemoval; {remove loop invariant computations} while dft <> nil do begin {dispose of the depth first tree} dft2 := dft; dft := dft2^.next; dispose(dft2); end; {while} while backEdge <> nil do begin {dispose of the back edge list} dft2 := backEdge; backEdge := dft2^.next; dispose(dft2); end; {while} end; {DoLoopOptimization} {---------------------------------------------------------------} procedure DAG {code: icptr}; { place an op code in a DAG or tree } { } { parameters: } { code - opcode } var temp: icptr; {temp node} procedure Generate; { generate the code for the current procedure } var op: icptr; {temp opcode pointers} procedure BasicBlocks; { Break the code up into basic blocks } var blast: blockPtr; {last block pointer} bp: blockPtr; {current block pointer} cb: icptr; {last code in block pointer} cp: icptr; {current code pointer} begin {BasicBlocks} cp := DAGhead; DAGblocks := nil; if cp <> nil then begin bp := pointer(Calloc(sizeof(block))); DAGblocks := bp; blast := bp; bp^.code := cp; cb := cp; cp := cp^.next; cb^.next := nil; while cp <> nil do {labels start a new block} if cp^.opcode = dc_lab then begin Spin; bp := pointer(Calloc(sizeof(block))); bp^.last := blast; blast^.next := bp; blast := bp; bp^.code := cp; cb := cp; cp := cp^.next; cb^.next := nil; end {if} {conditionals are followed by a new block} else if cp^.opcode in [pc_fjp, pc_tjp, pc_ujp, pc_ret, pc_xjp] then begin Spin; while cp^.next^.opcode = pc_add do begin cb^.next := cp; cb := cp; cp := cp^.next; cb^.next := nil; end; {while} cb^.next := cp; cb := cp; cp := cp^.next; cb^.next := nil; bp := pointer(Calloc(sizeof(block))); bp^.last := blast; blast^.next := bp; blast := bp; bp^.code := cp; cb := cp; cp := cp^.next; cb^.next := nil; end {else if} else begin {all other statements get added to a block} cb^.next := cp; cb := cp; cp := cp^.next; cb^.next := nil; end; {else} end; {if} end; {BasicBlocks} begin {Generate} if peepHole then {peephole optimization} repeat rescan := false; PeepHoleOptimization(DAGhead); op := DAGHead; while op^.next <> nil do begin Spin; PeepHoleOptimization(op^.next); op := op^.next; end; {while} CheckLabels; until not rescan; BasicBlocks; {build the basic blocks} if commonSubexpression or loopOptimizations then if not volatile then FlagIndirectUses; {create a list of all indirect uses} if commonSubexpression then {common sub-expression removal} if not volatile then CommonSubexpressionElimination; if loopOptimizations then {loop optimizations} if not volatile then DoLoopOptimization; { if printSymbols then {debug} { PrintBlocks(@'DAG: ', DAGblocks); {debug} if commonSubexpression or loopOptimizations then if not volatile then DisposeOpList(c_ind); {dispose of indirect use list} Gen(DAGblocks); {generate native code} if loopOptimizations then {dump and dynamic space} if not volatile then DumpLoopLists; DAGhead := nil; {reset the DAG pointers} end; {Generate} procedure Push (code: icptr); { place a node on the operation stack } { } { parameters: } { code - node } begin {Push} code^.next := DAGhead; DAGhead := code; end; {Push} function Pop: icptr; { pop a node from the operation stack } { } { returns: node pointer or nil } var node: icptr; {node poped} tn: icptr; {temp node} begin {Pop} node := DAGhead; if node = nil then Error(cge1) else begin DAGhead := node^.next; node^.next := nil; end; {else} if node^.opcode = dc_loc then begin tn := node; node := Pop; Push(tn); end; {if} Pop := node; end; {Pop} procedure Reverse; { Reverse the operation stack } var list, temp: icptr; {work pointers} begin {Reverse} list := nil; while DAGhead <> nil do begin temp := DAGhead; DAGhead := temp^.next; temp^.next := list; list := temp; end; {while} DAGhead := list; end; {Reverse} begin {DAG} case code^.opcode of pc_bnt, pc_bnl, pc_cnv, pc_dec, pc_inc, pc_ind, pc_lbf, pc_lbu, pc_ngi, pc_ngl, pc_ngr, pc_not, pc_stk, pc_cop, pc_cpo, pc_tl1, pc_sro, pc_str, pc_fjp, pc_tjp, pc_xjp, pc_cup, pc_pop, pc_iil, pc_ili, pc_idl, pc_ild: begin code^.left := Pop; Push(code); end; pc_adi, pc_adl, pc_adr, pc_and, pc_lnd, pc_bnd, pc_bal, pc_bno, pc_bor, pc_blr, pc_bxr, pc_blx, pc_cbf, pc_cpi, pc_dvi, pc_mov, pc_udi, pc_dvl, pc_udl, pc_dvr, pc_equ, pc_geq, pc_grt, pc_leq, pc_les, pc_neq, pc_ior, pc_lor, pc_ixa, pc_mod, pc_uim, pc_mdl, pc_ulm, pc_mpi, pc_umi, pc_mpl, pc_uml, pc_mpr, pc_psh, pc_sbi, pc_sbl, pc_sbr, pc_shl, pc_sll, pc_shr, pc_usr, pc_slr, pc_vsr, pc_tri, pc_sbf, pc_sto, pc_cui: begin code^.right := Pop; code^.left := Pop; Push(code); end; pc_gil, pc_gli, pc_gdl, pc_gld, pc_lil, pc_lli, pc_ldl, pc_lld, pc_lad, pc_lao, pc_lca, pc_lda, pc_ldc, pc_ldo, pc_lod, pc_nop, dc_cns, dc_glb, dc_dst, pc_lnm, pc_nam, pc_nat, dc_lab, pc_add, pc_ujp, dc_pin, pc_ent, pc_ret, dc_sym: Push(code); pc_cnn: begin code^.opcode := pc_cnv; temp := Pop; code^.left := Pop; Push(code); Push(temp); end; dc_loc: begin Push(code); if code^.r > maxLoc then maxLoc := code^.r; end; dc_prm: begin Push(code); if code^.s > maxLoc then maxLoc := code^.s; end; dc_str: begin Push(code); maxLoc := 0; end; dc_enp: begin Push(code); Reverse; Generate; end; otherwise: Error(cge1); {invalid opcode} end; {case} end; {DAG} end. \ No newline at end of file +{$optimize 7} +{---------------------------------------------------------------} +{ } +{ DAG Creation } +{ } +{ Places intermediate codes into DAGs and trees. } +{ } +{---------------------------------------------------------------} + +unit DAG; + +interface + +{$segment 'cg'} + +{$LibPrefix '0/obj/'} + +uses CCommon, CGI, CGC, Gen; + +{---------------------------------------------------------------} + +procedure DAG (code: icptr); + +{ place an op code in a DAG or tree } +{ } +{ parameters: } +{ code - opcode } + +{---------------------------------------------------------------} + +implementation + +var + c_ind: iclist; {vars that can be changed by indirect stores} + maxLoc: integer; {max local label number used by compiler} + memberOp: icptr; {operation found by Member} + optimizations: array[pcodes] of integer; {starting indexes into peeptable} + peepTablesInitialized: boolean; {have the peephole tables been initialized?} + rescan: boolean; {redo the optimization pass?} + +{-- External unsigned math routines; imported from Expression.pas --} + +function udiv (x,y: longint): longint; extern; + +function umod (x,y: longint): longint; extern; + +function umul (x,y: longint): longint; extern; + +{---------------------------------------------------------------} + +function CodesMatch (op1, op2: icptr; exact: boolean): boolean; + +{ Check to see if the trees op1 and op2 are equivalent } +{ } +{ parameters: } +{ op1, op2 - trees to check } +{ exact - is an exact match of operands required? } +{ } +{ Returns: True if trees are equivalent, else false. } + + + function LongStrCmp (s1, s2: longStringPtr): boolean; + + { Are the strings s1 amd s2 equal? } + { } + { parameters: } + { s1, s2 - strings to compare } + { } + { Returns: True if the strings are equal, else false } + + label 1; + + var + i: integer; {loop/index variable} + + begin {LongStrCmp} + LongStrCmp := false; + if s1^.length = s2^.length then begin + for i := 1 to s1^.length do + if s1^.str[i] <> s2^.str[i] then + goto 1; + LongStrCmp := true; + end; {if} +1: + end; {LongStrCmp} + + + function OpsEqual (op1, op2: icptr): boolean; + + { See if the operands are equal } + { } + { parameters: } + { op1, op2 - operations to check } + { } + { Returns: True if the operands are equivalent, else } + { false. } + + var + result: boolean; {temp result} + + begin {OpsEqual} + result := false; + case op1^.opcode of + pc_cup, pc_cui, pc_tl1, pc_bno: + {this rule prevents optimizations from removing sensitive operations} + ; + + pc_adi, pc_adl, pc_adr, pc_and, pc_lnd, pc_bnd, pc_bal, pc_bor, + pc_blr, pc_bxr, pc_blx, pc_equ, pc_neq, pc_ior, pc_lor, pc_mpi, + pc_umi, pc_mpl, pc_uml, pc_mpr: begin + if op1^.left = op2^.left then + if op1^.right = op2^.right then + result := true; + if not result then + if op1^.left = op2^.right then + if op1^.right = op2^.left then + result := true; + if not result then + if not exact then + if CodesMatch(op1^.left, op2^.left, false) then + if CodesMatch(op1^.right, op2^.right, false) then + result := true; + if not result then + if not exact then + if CodesMatch(op1^.left, op2^.right, false) then + if CodesMatch(op1^.right, op2^.left, false) then + result := true; + end; + + otherwise: begin + if op1^.left = op2^.left then + if op1^.right = op2^.right then + result := true; + if not result then + if not exact then + if CodesMatch(op1^.left, op2^.left, false) then + if CodesMatch(op1^.right, op2^.right, false) then + result := true; + end; + end; {case} + OpsEqual := result; + end; {OpsEqual} + + +begin {CodesMatch} +CodesMatch := false; +if op1 = op2 then + CodesMatch := true +else if (op1 <> nil) and (op2 <> nil) then + if op1^.opcode = op2^.opcode then + if op1^.q = op2^.q then + if op1^.r = op2^.r then + if op1^.s = op2^.s then + if op1^.lab^ = op2^.lab^ then + if OpsEqual(op1, op2) then + if op1^.optype = op2^.optype then + case op1^.optype of + cgByte, cgUByte, cgWord, cgUWord: + if op1^.opnd = op2^.opnd then + if op1^.llab = op2^.llab then + if op1^.slab = op2^.slab then + CodesMatch := true; + cgLong, cgULong: + if op1^.lval = op2^.lval then + CodesMatch := true; + cgReal, cgDouble, cgComp, cgExtended: + if op1^.rval = op2^.rval then + CodesMatch := true; + cgString: + CodesMatch := LongStrCmp(op1^.str, op2^.str); + cgVoid, ccPointer: + if op1^.pval = op2^.pval then + CodesMatch := LongStrCmp(op1^.str, op2^.str); + end; {case} +end; {CodesMatch} + +{- Peephole Optimization ---------------------------------------} + +function Base (val: longint): integer; + +{ Assuming val is a power of 2, find ln(val) base 2 } +{ } +{ parameters: } +{ val - value for which to find the base } +{ } +{ Returns: ln(val), base 2 } + +var + i: integer; {base counter} + +begin {Base} +i := 0; +while not odd(val) do begin + val := val >> 1; + i := i+1; + end; {while} +Base := i; +end; {Base} + + +procedure BinOps (var op1, op2: icptr); + +{ Make sure the operands are of the same type } +{ } +{ parameters: } +{ op1, op2: two pc_ldc operands } + +var + opt1, opt2: baseTypeEnum; {temp operand types} + +begin {BinOps} +opt1 := op1^.optype; +opt2 := op2^.optype; +if opt1 = cgByte then begin + op1^.optype := cgWord; + opt1 := cgWord; + end {if} +else if opt1 = cgUByte then begin + op1^.optype := cgUWord; + opt1 := cgUWord; + end {else if} +else if opt1 in [cgReal, cgDouble, cgComp] then begin + op1^.optype := cgExtended; + opt1 := cgExtended; + end; {else if} +if opt2 = cgByte then begin + op2^.optype := cgWord; + opt2 := cgWord; + end {if} +else if opt2 = cgUByte then begin + op2^.optype := cgUWord; + opt2 := cgUWord; + end {else if} +else if opt2 in [cgReal, cgDouble, cgComp] then begin + op2^.optype := cgExtended; + opt2 := cgExtended; + end; {else if} + +if opt1 <> opt2 then begin + case opt1 of + cgWord: + case opt2 of + cgUWord: + op1^.optype := cgUWord; + cgLong, cgULong: begin + op1^.lval := op1^.q; + op1^.optype := opt2; + end; + cgExtended: begin + op1^.rval := op1^.q; + op1^.optype := cgExtended; + end; + otherwise: ; + end; {case} + cgUWord: + case opt2 of + cgWord: + op2^.optype := cgUWord; + cgLong, cgULong: begin + op1^.lval := ord4(op1^.q) & $0000FFFF; + op1^.optype := opt2; + end; + cgExtended: begin + op1^.rval := ord4(op1^.q) & $0000FFFF; + op1^.optype := cgExtended; + end; + otherwise: ; + end; {case} + cgLong: + case opt2 of + cgWord: begin + op2^.lval := op2^.q; + op2^.optype := cgLong; + end; + cgUWord: begin + op2^.lval := ord4(op2^.q) & $0000FFFF; + op2^.optype := cgLong; + end; + cgULong: + op1^.optype := cgULong; + cgExtended: begin + op1^.rval := op1^.lval; + op1^.optype := cgExtended; + end; + otherwise: ; + end; {case} + cgULong: + case opt2 of + cgWord: begin + op2^.lval := op2^.q; + op2^.optype := cgLong; + end; + cgUWord: begin + op2^.lval := ord4(op2^.q) & $0000FFFF; + op2^.optype := cgLong; + end; + cgLong: + op2^.optype := cgULong; + cgExtended: begin + op1^.rval := op1^.lval; + if op1^.rval < 0.0 then + op1^.rval := 4294967296.0 + op1^.rval; + op1^.optype := cgExtended; + end; + otherwise: ; + end; {case} + cgExtended: begin + case opt2 of + cgWord: + op2^.rval := op2^.q; + cgUWord: + op2^.rval := ord4(op2^.q) & $0000FFFF; + cgLong: + op2^.rval := op2^.lval; + cgULong: begin + op2^.rval := op2^.lval; + if op2^.rval < 0.0 then + op2^.rval := 4294967296.0 + op2^.rval; + end; + otherwise: ; + end; {case} + op2^.optype := cgExtended; + end; + otherwise: ; + end; {case} + end; {if} +end; {BinOps} + + +procedure CheckLabels; + +{ remove unused dc_lab labels } + +var + lop: icptr; {predecessor of op} + op: icptr; {used to trace the opcode list} + + + function Used (lab: integer): boolean; + + { see if a label is used } + { } + { parameters: } + { lab - label number to check } + { } + { Returns: True if the label is used, else false. } + + var + found: boolean; {was the label found?} + op: icptr; {used to trace the opcode list} + + begin {Used} + found := false; + op := DAGhead; + while (not found) and (op <> nil) do begin + if op^.opcode in [pc_add, pc_fjp, pc_tjp, pc_ujp] then + found := op^.q = lab + else if op^.opcode = pc_nat then + found := true; + op := op^.next; + end; {while} + Used := found; + end; {Used} + + +begin {CheckLabels} +op := DAGhead; +while op^.next <> nil do begin + lop := op; + op := op^.next; + if op^.opcode = dc_lab then + if not Used(op^.q) then begin + lop^.next := op^.next; + op := lop; + rescan := true; + end; {if} + end; {while} +end; {CheckLabels} + + +procedure RemoveDeadCode (op: icptr); + +{ remove dead code following an unconditional branch } +{ } +{ parameters: } +{ op - unconditional branch opcode } + +begin {RemoveDeadCode} +while not (op^.next^.opcode in [dc_lab, dc_enp, dc_cns, dc_glb, + dc_dst, dc_str, dc_pin, pc_ent, dc_loc, dc_prm, dc_sym]) do begin + op^.next := op^.next^.next; + rescan := true; + end; {while} +end; {RemoveDeadCode} + + +function NoFunctions (op: icptr): boolean; + +{ are there any function calls? } +{ } +{ parameters: } +{ op - operation tree to search } +{ } +{ returns: True if there are no pc_cup or pc_cui operations } +{ in the tree, else false. } + +begin {NoFunctions} +if op = nil then + NoFunctions := true +else if op^.opcode in [pc_cup,pc_cui,pc_tl1] then + NoFunctions := false +else + NoFunctions := NoFunctions(op^.left) or NoFunctions(op^.right); +end; {NoFunctions} + + +function OneBit (val: longint): boolean; + +{ See if there is exactly one bit set in val } +{ } +{ parameters: } +{ val - value to check } +{ } +{ Returns: True if exactly one bit is set, else false } + +begin {OneBit} +if val = 0 then + OneBit := false +else begin + while not odd(val) do + val := val >> 1; + OneBit := val = 1; + end; {else} +end; {OneBit} + + +procedure PeepHoleOptimization (var opv: icptr); + +{ do peephole optimization on a list of opcodes } +{ } +{ parameters: } +{ opv - pointer to the first opcode } +{ } +{ Notes: } +{ 1. Many optimizations assume the children have already } +{ been optimized. In particular, many optimizations } +{ depend on pc_ldc operands being on a specific side of } +{ a child's expression tree. (e.g. pc_fjp and pc_equ) } + +var + done: boolean; {optimization done test} + doit: boolean; {should we do the optimization?} + lq, lval: longint; {temps for long calculations} + op2,op3: icptr; {temp opcodes} + op: icptr; {copy of op (for efficiency)} + opcode: pcodes; {temp opcode} + optype: baseTypeEnum; {temp optype} + q: integer; {temp for integer calculations} + rval: double; {temp for real calculations} + + fromtype, totype, firstType: record {for converting numbers to optypes} + case boolean of + true: (i: integer); + false: (optype: baseTypeEnum); + end; + + + function SideEffects (op: icptr): boolean; + + { Check a tree for operations that have side effects } + { } + { parameters: } + { op - tree to check } + + var + result: boolean; {temp result} + + begin {SideEffects} + if (op = nil) or volatile then + SideEffects := false + else if op^.opcode in + [pc_mov,pc_cbf,pc_cop,pc_cpi,pc_cpo,pc_gil,pc_gli,pc_gdl, + pc_gld,pc_iil,pc_ili,pc_idl,pc_ild,pc_lil,pc_lli,pc_ldl, + pc_lld,pc_sbf,pc_sro,pc_sto,pc_str,pc_cui,pc_cup,pc_tl1] then + SideEffects := true + else + SideEffects := SideEffects(op^.left) or SideEffects(op^.right); + end; {SideEffects} + + + procedure JumpOptimizations (op: icptr; newOpcode: pcodes); + + { handle common code for jump optimizations } + { } + { parameters: } + { op - jump opcode } + { newOpcode - opcode to use if the jump sense is reversed } + + var + done: boolean; {optimization done test} + topcode: pcodes; {temp opcode} + + begin {JumpOptimizations} + topcode := op^.left^.opcode; + if topcode = pc_not then begin + op^.left := op^.left^.left; + op^.opcode := newOpcode; + PeepHoleOptimization(opv); + end {else if} + else if topcode in [pc_neq,pc_equ] then begin + with op^.left^.right^ do + if opcode = pc_ldc then + if optype in [cgByte,cgUByte,cgWord,cgUWord] then + if q = 0 then begin + op^.left := op^.left^.left; + if topcode = pc_equ then + op^.opcode := newOpcode; + end; {if} + end; {else if} + if op^.next^.opcode = dc_lab then + if op^.next^.q = op^.q then + if not SideEffects(op^.left) then begin + rescan := true; + opv := op^.next; + end; {else if} + end; {JumpOptimizations} + + + procedure RealStoreOptimizations (op, opl: icptr); + + { do strength reductions associated with stores of reals } + { } + { parameters: } + { op - real store to optimize } + { opl - load operand for the store operation } + + var + disp: 0..9; {disp to the word to change} + same: boolean; {are the operands the same?} + op2: icptr; {new opcode} + opt: icptr; {temp opcode} + + cnvrl: record {for stuffing a real in a long space} + case boolean of + true: (lval: longint); + false: (rval: real); + end; + + begin {RealStoreOptimizations} + if opl^.opcode = pc_ngr then begin + same := false; + with opl^.left^ do + if op^.opcode = pc_sro then begin + if opcode = pc_ldo then + if q = op^.q then + if optype = op^.optype then + if lab^ = op^.lab^ then + same := true; + end {if} + else {if op^.opcode = pc_str then} + if opcode = pc_lod then + if q = op^.q then + if r = op^.r then + if optype = op^.optype then + same := true; + if same then begin + case op^.optype of + cgReal: disp := 3; + cgDouble: disp := 7; + cgExtended: disp := 9; + cgComp: disp := 11; + end; {case} + opl^.left^.optype := cgWord; + opl^.left^.q := opl^.left^.q + disp; + op^.optype := cgWord; + op^.q := op^.q + disp; + op2 := pointer(Calloc(sizeof(intermediate_code))); + op2^.opcode := pc_ldc; + op2^.optype := cgWord; + op2^.q := $0080; + opl^.right := op2; + opl^.opcode := pc_bxr; + end {if} + else if op^.optype = cgReal then begin + opt := opl^.left; + if opt^.opcode in [pc_ind,pc_ldo,pc_lod] then + if opt^.optype = cgReal then begin + opt^.optype := cgLong; + op^.optype := cgLong; + op2 := pointer(Calloc(sizeof(intermediate_code))); + op2^.opcode := pc_ldc; + op2^.optype := cgLong; + op2^.lval := $80000000; + opl^.right := op2; + opl^.opcode := pc_blx; + end; {if} + end; {else if} + end {if} + else if op^.optype = cgReal then begin + if opl^.opcode = pc_ldc then begin + cnvrl.rval := opl^.rval; + opl^.lval := cnvrl.lval; + opl^.optype := cgLong; + op^.optype := cgLong; + end {if} + else if opl^.opcode in [pc_ind,pc_ldo,pc_lod] then + if opl^.optype = cgReal then begin + opl^.optype := cgLong; + op^.optype := cgLong; + end; {if} + end; {if} + end; {RealStoreOptimizations} + + + procedure ReplaceLoads (ldop, stop, tree: icptr); + + { Replace any pc_lod operations in tree that load from the } + { location stored to by the pc_str operation stop by ldop } + { } + { parameters: } + { ldop - operation to replace the pc_lods with } + { stop - pc_str operation } + { tree - tree to check for pc_lod operations } + { } + { Notes: ldop must be an instruction, not a tree } + + begin {ReplaceLoads} + if tree^.left <> nil then + ReplaceLoads(ldop, stop, tree^.left); + if tree^.right <> nil then + ReplaceLoads(ldop, stop, tree^.right); + if tree^.opcode = pc_lod then + if tree^.optype = stop^.optype then + if tree^.q = stop^.q then + if tree^.r = stop^.r then + tree^ := ldop^; + end; {ReplaceLoads} + + + procedure ReverseChildren (op: icptr); + + { reverse the children of a node } + { } + { parameters: } + { op - node for which to reverse the children } + + var + opt: icptr; {temp opcode pointer} + + begin {ReverseChildren} + opt := op^.right; + op^.right := op^.left; + op^.left := opt; + end; {ReverseChildren} + + + procedure ZeroIntermediateCode (op: icptr); + + { Set all fields in the record to 0, nil, etc. } + { } + { Parameters: } + { op - intermediate code record to clear } + + begin {ZeroIntermediateCode} + op^.q := 0; + op^.r := 0; + op^.s := 0; + op^.lab := nil; + op^.next := nil; + op^.left := nil; + op^.right := nil; + op^.optype := cgWord; + op^.opnd := 0; + op^.llab := 0; + op^.slab := 0; + end; {ZeroIntermediateCode} + + +begin {PeepHoleOptimization} +{if printSymbols then begin write('Optimize: '); WriteCode(opv); end; {debug} +op := opv; {copy for efficiency} +if op^.left <> nil then {optimize the children} + PeepHoleOptimization(op^.left); +if op^.right <> nil then + PeepHoleOptimization(op^.right); +case op^.opcode of {check for optimizations of this node} + pc_add: begin {pc_add} + if op^.next^.opcode <> pc_add then + RemoveDeadCode(op); + end; {case pc_add} + + pc_adi: begin {pc_adi} + if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin + op^.left^.q := op^.left^.q + op^.right^.q; + opv := op^.left; + end {if} + else begin + if op^.left^.opcode = pc_ldc then + ReverseChildren(op); + if op^.right^.opcode = pc_ldc then begin + q := op^.right^.q; + if q = 0 then + opv := op^.left + else if q > 0 then begin + op^.opcode := pc_inc; + op^.q := q; + op^.right := nil; + end {else if} + else {if q < 0 then} begin + op^.opcode := pc_dec; + op^.q := -q; + op^.right := nil; + end; {else if} + end {if} + else if CodesMatch(op^.left, op^.right, false) then begin + if NoFunctions(op^.left) then begin + ZeroIntermediateCode(op^.right); + with op^.right^ do begin + opcode := pc_ldc; + q := 1; + optype := cgWord; + end; {with} + op^.opcode := pc_shl; + PeepHoleOptimization(opv); + end; {if} + end {else if} + else if op^.left^.opcode in [pc_inc,pc_dec] then begin + if op^.right^.opcode in [pc_inc,pc_dec] then begin + op2 := op^.left; + if op2^.opcode = pc_inc then + q := op2^.q + else + q := -op2^.q; + if op^.right^.opcode = pc_inc then + q := q + op^.right^.q + else + q := q - op^.right^.q; + if q >= 0 then begin + op2^.opcode := pc_inc; + op2^.q := q; + end {if} + else begin + op2^.opcode := pc_dec; + op2^.q := -q; + end; {else} + op^.left := op^.left^.left; + op^.right := op^.right^.left; + op2^.left := op; + opv := op2; + PeepHoleOptimization(opv); + end; {if} + end; {else if} + end; {else} + end; {case pc_adi} + + pc_adl: begin {pc_adl} + if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin + op^.left^.lval := op^.left^.lval + op^.right^.lval; + opv := op^.left; + end {if} + else begin + if op^.left^.opcode = pc_ldc then + ReverseChildren(op); + if op^.right^.opcode = pc_ldc then begin + lval := op^.right^.lval; + if lval = 0 then + opv := op^.left + else if (lval >= 0) and (lval <= maxint) then begin + op^.opcode := pc_inc; + op^.optype := cgLong; + op^.q := ord(lval); + op^.right := nil; + end {else if} + else if (lval > -maxint) and (lval < 0) then begin + op^.opcode := pc_dec; + op^.optype := cgLong; + op^.q := -ord(lval); + op^.right := nil; + end; {else if} + end {if} + else if CodesMatch(op^.left, op^.right, false) then + if NoFunctions(op^.left) then begin + ZeroIntermediateCode(op^.right); + with op^.right^ do begin + opcode := pc_ldc; + lval := 1; + optype := cgLong; + end; {with} + op^.opcode := pc_sll; + end; {if} + if op^.right^.opcode in [pc_lao,pc_lda,pc_ixa] then + ReverseChildren(op); + if op^.left^.opcode in [pc_lao,pc_lda,pc_ixa] then + if op^.right^.opcode = pc_sll then begin + if op^.right^.right^.opcode = pc_ldc then + if (op^.right^.right^.lval & $FFFF8000) = 0 then + if op^.right^.left^.opcode = pc_cnv then begin + fromtype.i := (op^.right^.left^.q & $00F0) >> 4; + if fromType.optype in [cgByte,cgUByte,cgWord,cgUWord] then + begin + if fromType.optype = cgByte then + op^.right^.left^.q := $02 + else if fromType.optype = cgUByte then + op^.right^.left^.q := $13 + else + op^.right^.left := op^.right^.left^.left; + with op^.right^.right^ do begin + lq := lval; + lval := 0; + q := long(lq).lsw; + optype := cgUWord; + end; {with} + op^.right^.opcode := pc_shl; + op^.opcode := pc_ixa; + PeepHoleOptimization(opv); + end; {if} + end; {if} + end {if} + else if op^.right^.opcode = pc_cnv then begin + fromtype.i := (op^.right^.q & $00F0) >> 4; + if fromtype.optype in [cgByte,cgUByte,cgWord,cgUWord] then begin + if fromType.optype = cgByte then + op^.right^.q := $02 + else if fromType.optype = cgUByte then + op^.right^.q := $13 + else + op^.right := op^.right^.left; + op^.opcode := pc_ixa; + PeepHoleOptimization(opv); + end; {if} + end; {else if} + end; {else} + end; {case pc_adl} + + pc_adr: begin {pc_adr} + if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin + op^.left^.rval := op^.left^.rval + op^.right^.rval; + opv := op^.left; + end {if} + else begin + if op^.left^.opcode = pc_ldc then + ReverseChildren(op); + if op^.right^.opcode = pc_ldc then begin + if op^.right^.rval = 0.0 then + opv := op^.left; + end; {if} + end; {else} + end; {case pc_adr} + + pc_and: begin {pc_and} + if op^.right^.opcode = pc_ldc then begin + if op^.left^.opcode = pc_ldc then begin + op^.left^.q := ord((op^.left^.q <> 0) and (op^.right^.q <> 0)); + opv := op^.left; + end {if} + else begin + if op^.right^.q = 0 then + if not SideEffects(op^.left) then + opv := op^.right; + end {else} + end {if} + else if op^.left^.opcode = pc_ldc then + if op^.left^.q = 0 then + opv := op^.left; + end; {case pc_and} + + pc_bal: begin {pc_bal} + if op^.left^.opcode = pc_ldc then + ReverseChildren(op); + if op^.left^.opcode = pc_ldc then begin + op^.left^.lval := op^.left^.lval & op^.right^.lval; + opv := op^.left; + end {if} + else if op^.right^.opcode = pc_ldc then begin + if op^.right^.lval = 0 then + opv := op^.right + else if op^.right^.lval = -1 then + opv := op^.left; + end; {else if} + end; {case pc_bal} + + pc_blr: begin {pc_blr} + if op^.left^.opcode = pc_ldc then + ReverseChildren(op); + if op^.left^.opcode = pc_ldc then begin + op^.left^.lval := op^.left^.lval | op^.right^.lval; + opv := op^.left; + end {if} + else if op^.right^.opcode = pc_ldc then begin + if op^.right^.lval = -1 then + opv := op^.right + else if op^.right^.lval = 0 then + opv := op^.left; + end; {else if} + end; {case pc_blr} + + pc_blx: begin {pc_blx} + if op^.left^.opcode = pc_ldc then + ReverseChildren(op); + if op^.left^.opcode = pc_ldc then begin + op^.left^.lval := op^.left^.lval ! op^.right^.lval; + opv := op^.left; + end {if} + else if op^.right^.opcode = pc_ldc then begin + if op^.right^.lval = 0 then + opv := op^.left + else if op^.right^.lval = -1 then begin + op^.opcode := pc_bnl; + op^.right := nil; + end; {else if} + end; {else if} + end; {case pc_blx} + + pc_bnd: begin {pc_bnd} + if op^.left^.opcode = pc_ldc then + ReverseChildren(op); + if op^.left^.opcode = pc_ldc then begin + op^.left^.q := op^.left^.q & op^.right^.q; + opv := op^.left; + end {if} + else if op^.right^.opcode = pc_ldc then begin + if op^.right^.q = 0 then + opv := op^.right + else if op^.right^.q = -1 then + opv := op^.left; + end; {else if} + end; {case pc_bnd} + + pc_bnl: begin {pc_bnl} + if op^.left^.opcode = pc_ldc then begin + op^.left^.lval := op^.left^.lval ! $FFFFFFFF; + opv := op^.left; + end; {if} + end; {case pc_bnl} + + pc_bno: begin {pc_bno} + if op^.left^.opcode = pc_str then + if op^.left^.left^.opcode in [pc_lda,pc_lao] then begin + ReplaceLoads(op^.left^.left, op^.left, op^.right); + opv := op^.right; + end; {if} + end; {case pc_bno} + + pc_bnt: begin {pc_bnt} + if op^.left^.opcode = pc_ldc then begin + op^.left^.q := op^.left^.q ! $FFFF; + opv := op^.left; + end; {if} + end; {case pc_bnt} + + pc_bor: begin {pc_bor} + if op^.left^.opcode = pc_ldc then + ReverseChildren(op); + if op^.left^.opcode = pc_ldc then begin + op^.left^.q := op^.left^.q | op^.right^.q; + opv := op^.left; + end {if} + else if op^.right^.opcode = pc_ldc then begin + if op^.right^.q = -1 then + opv := op^.right + else if op^.right^.q = 0 then + opv := op^.left; + end; {else if} + end; {case pc_bor} + + pc_bxr: begin {pc_bxr} + if op^.left^.opcode = pc_ldc then + ReverseChildren(op); + if op^.left^.opcode = pc_ldc then begin + op^.left^.q := op^.left^.q ! op^.right^.q; + opv := op^.left; + end {if} + else if op^.right^.opcode = pc_ldc then begin + if op^.right^.q = 0 then + opv := op^.left + else if op^.right^.q = -1 then begin + op^.opcode := pc_bnt; + op^.right := nil; + end; {else if} + end; {else if} + end; {case pc_bxr} + + pc_cnv: begin {pc_cnv} + fromtype.i := (op^.q & $00F0) >> 4; + totype.i := op^.q & $000F; + if op^.left^.opcode = pc_ldc then begin + case fromtype.optype of + cgByte,cgWord: + case totype.optype of + cgByte,cgUByte,cgWord,cgUWord: ; + cgLong,cgULong: begin + lval := op^.left^.q; + op^.left^.q := 0; + op^.left^.lval := lval; + end; + cgReal,cgDouble,cgComp,cgExtended: begin + rval := op^.left^.q; + op^.left^.q := 0; + op^.left^.rval := rval; + end; + otherwise: ; + end; {case} + cgUByte,cgUWord: + case totype.optype of + cgByte,cgUByte,cgWord,cgUWord: ; + cgLong,cgULong: begin + lval := ord4(op^.left^.q) & $0000FFFF; + op^.left^.q := 0; + op^.left^.lval := lval; + end; + cgReal,cgDouble,cgComp,cgExtended: begin + rval := ord4(op^.left^.q) & $0000FFFF; + op^.left^.q := 0; + op^.left^.rval := rval; + end; + otherwise: ; + end; {case} + cgLong: + case totype.optype of + cgByte,cgUByte,cgWord,cgUWord: begin + q := long(op^.left^.lval).lsw; + op^.left^.lval := 0; + op^.left^.q := q; + end; + cgLong, cgULong: ; + cgReal,cgDouble,cgComp,cgExtended: begin + rval := op^.left^.lval; + op^.left^.lval := 0; + op^.left^.rval := rval; + end; + otherwise: ; + end; {case} + cgULong: + case totype.optype of + cgByte,cgUByte,cgWord,cgUWord: begin + q := long(op^.left^.lval).lsw; + op^.left^.lval := 0; + op^.left^.q := q; + end; + cgLong, cgULong: ; + cgReal,cgDouble,cgComp,cgExtended: begin + lval := op^.left^.lval; + op^.left^.lval := 0; + if lval >= 0 then + rval := lval + else + rval := (lval & $7FFFFFFF) + 2147483648.0; + op^.left^.rval := rval; + end; + otherwise: ; + end; {case} + cgReal,cgDouble,cgComp,cgExtended: begin + rval := op^.left^.rval; + case totype.optype of + cgByte: begin + if rval < -128.0 then + q := -128 + else if rval > 127.0 then + q := 127 + else + q := trunc(rval); + op^.left^.rval := 0.0; + op^.left^.q := q; + end; + cgUByte: begin + if rval < 0.0 then + q := 0 + else if rval > 255.0 then + q := 255 + else + q := trunc(rval); + op^.left^.rval := 0.0; + op^.left^.q := q; + end; + cgWord: begin + if rval < -32768.0 then + lval := -32768 + else if rval > 32767.0 then + lval := 32767 + else + lval := trunc(rval); + op^.left^.rval := 0.0; + op^.left^.q := long(lval).lsw; + end; + cgUWord: begin + if rval < 0.0 then + lval := 0 + else if rval > 65535.0 then + lval := 65535 + else begin + rval := trunc4(rval); + lval := round4(rval); + end; {else} + op^.left^.rval := 0.0; + op^.left^.q := long(lval).lsw; + end; + cgLong,cgULong: begin + rval := op^.left^.rval; + if totype.optype = cgULong then begin + if rval < 0 then + rval := 0 + else if rval > 2147483647.0 then + rval := rval - 4294967296.0 + end; {if} + if rval < -2147483648.0 then + lval := $80000000 + else if rval > 2147483647.0 then + lval := 2147483647 + else begin + rval := trunc4(rval); + lval := round4(rval); + end; {else} + op^.left^.rval := 0.0; + op^.left^.lval := lval; + end; + cgReal,cgDouble,cgComp,cgExtended: ; + otherwise: ; + end; + end; {case} + otherwise: ; + end; {case} + if fromtype.optype in + [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgReal,cgDouble, + cgComp,cgExtended] then + if totype.optype in + [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgReal,cgDouble, + cgComp,cgExtended] then begin + op^.left^.optype := totype.optype; + opv := op^.left; + end; {if} + end {if} + else if op^.left^.opcode = pc_cnv then begin + doit := false; + firsttype.i := (op^.q & $00F0) >> 4; + if fromType.optype in [cgReal,cgDouble,cgComp,cgExtended] then begin + if toType.optype in [cgReal,cgDouble,cgComp,cgExtended] then + doit := true; + end {if} + else begin + if firstType.optype in [cgByte,cgWord,cgLong] then + if fromType.optype in [cgByte,cgWord,cgLong] then + if toType.optype in [cgByte,cgWord,cgLong] then + doit := true; + if firstType.optype in [cgUByte,cgUWord,cgULong] then + if fromType.optype in [cgUByte,cgUWord,cgULong] then + if toType.optype in [cgUByte,cgUWord,cgLong] then + doit := true; + if TypeSize(firstType.optype) = TypeSize(fromType.optype) then + if TypeSize(firstType.optype) = TypeSize(toType.optype) then + doit := true; + end; {else} + if doit then begin + op^.q := (op^.left^.q & $00F0) | (op^.q & $000F); + op^.left := op^.left^.left; + PeepHoleOptimization(opv); + end; {if} + end {else if} + else if op^.left^.opcode in [pc_lod,pc_ldo,pc_ind] then begin + if fromtype.optype in [cgWord,cgUWord] then + if totype.optype in [cgByte,cgUByte,cgWord,cgUWord] then begin + op^.left^.optype := totype.optype; + opv := op^.left; + end; {if} + if fromtype.optype in [cgLong,cgULong] then + if totype.optype in [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong] + then begin + op^.left^.optype := totype.optype; + opv := op^.left; + end; {if} + end {else if} + else if op^.q in [$40,$41,$50,$51] then begin + {any long type to byte type} + with op^.left^ do + if opcode = pc_bal then + if right^.opcode = pc_ldc then + if right^.lval = 255 then begin + op^.left := op^.left^.left; + PeepHoleOptimization(opv); + end; {if} + with op^.left^ do + if opcode in [pc_slr,pc_vsr] then + if right^.opcode = pc_ldc then + if left^.opcode in [pc_lod,pc_ldo,pc_ind] then begin + lq := right^.lval; + if long(lq).msw = 0 then + if long(lq).lsw in [8,16,24] then begin + lq := lq div 8; + left^.q := left^.q + long(lq).lsw; + op^.left := left; + PeepHoleOptimization(opv); + end; {if} + end; {if} + end; {else if} + end; {case pc_cnv} + + pc_dec: begin {pc_dec} + if op^.q = 0 then + opv := op^.left + else begin + opcode := op^.left^.opcode; + if opcode = pc_dec then begin + if ord4(op^.left^.q) + ord4(op^.q) < ord4(maxint) then begin + op^.q := op^.q + op^.left^.q; + op^.left := op^.left^.left; + end; {if} + end {if} + else if opcode = pc_inc then begin + q := op^.q - op^.left^.q; + if q < 0 then begin + q := -q; + op^.opcode := pc_inc; + end; {if} + op^.q := q; + op^.left := op^.left^.left; + PeepHoleOptimization(opv); + end {else if} + else if opcode = pc_ldc then begin + if op^.optype in [cgLong, cgULong] then begin + op^.left^.lval := op^.left^.lval - op^.q; + opv := op^.left; + end {if} + else if op^.optype in [cgUByte, cgByte, cgUWord, cgWord] then begin + op^.left^.q := op^.left^.q - op^.q; + opv := op^.left; + end; {else if} + end; {else if} + end; {else} + end; {case pc_dec} + + pc_dvi: begin {pc_dvi} + if op^.right^.opcode = pc_ldc then begin + if op^.left^.opcode = pc_ldc then begin + if op^.right^.q <> 0 then begin + op^.left^.q := op^.left^.q div op^.right^.q; + opv := op^.left; + end; {if} + end {if} + else if op^.right^.q = 1 then + opv := op^.left; + end; {if} + end; {case pc_dvi} + + pc_dvl: begin {pc_dvl} + if op^.right^.opcode = pc_ldc then begin + if op^.left^.opcode = pc_ldc then begin + if op^.right^.lval <> 0 then begin + op^.left^.lval := op^.left^.lval div op^.right^.lval; + opv := op^.left; + end; {if} + end {if} + else if op^.right^.lval = 1 then + opv := op^.left; + end; {if} + end; {case pc_dvl} + + pc_dvr: begin {pc_dvr} + if op^.right^.opcode = pc_ldc then begin + if op^.left^.opcode = pc_ldc then begin + if op^.right^.rval <> 0.0 then begin + op^.left^.rval := op^.left^.rval/op^.right^.rval; + opv := op^.left; + end; {if} + end {if} + else if op^.right^.rval = 1.0 then + opv := op^.left; + end; {if} + end; {case pc_dvr} + + pc_equ: begin {pc_equ} + if op^.left^.opcode = pc_ldc then + ReverseChildren(op); + if op^.right^.opcode = pc_ldc then begin + if op^.left^.opcode = pc_ldc then begin + BinOps(op^.left, op^.right); + case op^.left^.optype of + cgByte,cgUByte,cgWord,cgUWord: begin + op^.opcode := pc_ldc; + op^.q := ord(op^.left^.q = op^.right^.q); + op^.left := nil; + op^.right := nil; + end; + cgLong,cgULong: begin + op^.opcode := pc_ldc; + op^.q := ord(op^.left^.lval = op^.right^.lval); + op^.left := nil; + op^.right := nil; + end; + cgReal,cgDouble,cgComp,cgExtended: begin + op^.opcode := pc_ldc; + op^.q := ord(op^.left^.rval = op^.right^.rval); + op^.left := nil; + op^.right := nil; + end; + cgVoid,ccPointer: begin + op^.opcode := pc_ldc; + op^.q := ord(op^.left^.pval = op^.right^.pval); + op^.left := nil; + op^.right := nil; + end; + end; {case} + end {if} + else if op^.right^.optype in [cgByte, cgUByte, cgWord, cgUWord] then begin + if op^.right^.q <> 0 then + if op^.left^.opcode in + [pc_and,pc_ior,pc_neq,pc_equ,pc_geq,pc_leq,pc_les,pc_grt] + then begin + opv := op^.left; + opv^.next := op^.next; + end; {if} + end {else if} + else if op^.right^.optype in [cgLong, cgULong] then begin + if op^.right^.lval <> 0 then + if op^.left^.opcode in + [pc_and,pc_ior,pc_neq,pc_equ,pc_geq,pc_leq,pc_les,pc_grt] + then begin + opv := op^.left; + opv^.next := op^.next; + end; {if} + end; {else if} + end; {if} + end; {case pc_equ} + + pc_fjp: begin {pc_fjp} + opcode := op^.left^.opcode; + if opcode = pc_ldc then begin + if op^.left^.optype in [cgByte, cgUByte, cgWord, cgUWord] then begin + if op^.left^.q <> 0 then begin + opv := op^.next; + rescan := true; + end {if} + else begin + op^.opcode := pc_ujp; + op^.left := nil; + PeepHoleOptimization(opv); + end; {else} + end {if} + end {if} + else if opcode = pc_and then begin + op2 := op^.left; + op2^.next := op^.next; + op^.next := op2; + op^.left := op2^.left; + op2^.left := op2^.right; + op2^.right := nil; + op2^.opcode := pc_fjp; + op2^.q := op^.q; + PeepHoleOptimization(opv); + end {else if} + else if opcode = pc_ior then begin + op2 := op^.left; + op2^.next := op^.next; + op^.next := op2; + op^.left := op2^.left; + op2^.left := op2^.right; + op2^.right := nil; + op2^.opcode := pc_fjp; + op2^.q := op^.q; + op^.opcode := pc_tjp; + op3 := pointer(Calloc(sizeof(intermediate_code))); + op3^.opcode := dc_lab; + op3^.optype := cgWord; + op3^.q := GenLabel; + op3^.next := op2^.next; + op2^.next := op3; + op^.q := op3^.q; + PeepHoleOptimization(opv); + end {else if} + else + JumpOptimizations(op, pc_tjp); + end; {case pc_fjp} + + pc_inc: begin {pc_inc} + if op^.q = 0 then + opv := op^.left + else begin + opcode := op^.left^.opcode; + if opcode = pc_inc then begin + if ord4(op^.left^.q) + ord4(op^.q) < ord4(maxint) then begin + op^.q := op^.q + op^.left^.q; + op^.left := op^.left^.left; + end; {if} + end {if} + else if opcode = pc_dec then begin + q := op^.q - op^.left^.q; + if q < 0 then begin + q := -q; + op^.opcode := pc_dec; + end; {if} + op^.q := q; + op^.left := op^.left^.left; + PeepHoleOptimization(opv); + end {else if} + else if opcode = pc_ldc then begin + if op^.optype in [cgLong, cgULong] then begin + op^.left^.lval := op^.left^.lval + op^.q; + opv := op^.left; + end {if} + else if op^.optype in [cgUByte, cgByte, cgUWord, cgWord] then begin + op^.left^.q := op^.left^.q + op^.q; + opv := op^.left; + end; {else if} + end {else if} + else if opcode in [pc_lao,pc_lda] then begin + op^.left^.q := op^.left^.q + op^.q; + opv := op^.left; + end; {else if} + end; {else} + end; {case pc_inc} + + pc_ind: begin {pc_ind} + opcode := op^.left^.opcode; + if opcode = pc_lda then begin + op^.left^.opcode := pc_lod; + op^.left^.optype := op^.optype; + op^.left^.q := op^.left^.q + op^.q; + opv := op^.left; + end {if} + else if opcode = pc_lao then begin + op^.left^.opcode := pc_ldo; + op^.left^.optype := op^.optype; + op^.left^.q := op^.left^.q + op^.q; + opv := op^.left; + end; {else if} + end; {case pc_ind} + + pc_ior: begin {pc_ior} + if op^.right^.opcode = pc_ldc then begin + if op^.left^.opcode = pc_ldc then begin + op^.left^.q := ord((op^.left^.q <> 0) or (op^.right^.q <> 0)); + opv := op^.left; + end {if} + else begin + if op^.right^.q <> 0 then begin + if not SideEffects(op^.left) then begin + op^.right^.q := 1; + opv := op^.right; + end; {if} + end {if} + else + op^.opcode := pc_neq; + end {if} + end {if} + else if op^.left^.opcode = pc_ldc then + if op^.left^.q <> 0 then begin + op^.left^.q := 1; + opv := op^.left; + end; {if} + end; {case pc_ior} + + pc_ixa: begin {pc_ixa} + if op^.right^.opcode = pc_ldc then begin + optype := op^.right^.optype; + if optype in [cgUByte, cgByte, cgUWord, cgWord] then begin + lval := op^.right^.q; + if optype = cgUByte then + lval := lval & $000000FF + else if optype = cgUWord then + lval := lval & $0000FFFF; + done := false; + if op^.left^.opcode in [pc_lao, pc_lda] then begin + lq := op^.left^.q + lval; + if (lq >= 0) and (lq < maxint) then begin + done := true; + op^.left^.q := ord(lq); + opv := op^.left; + end; {if} + end; {if} + if not done then begin + op^.right^.lval := lval; + op^.right^.optype := cgLong; + op^.opcode := pc_adl; + PeepHoleOptimization(opv); + end; {if} + end; {if} + end {if} + else if op^.left^.opcode = pc_lao then begin + if op^.right^.opcode = pc_inc then begin + lq := ord4(op^.right^.q) + ord4(op^.left^.q); + if lq < maxint then begin + op^.left^.q := ord(lq); + op^.right := op^.right^.left; + end; {if} + PeepHoleOptimization(opv); + end; {if} + end {else if} + else if op^.left^.opcode = pc_ixa then begin + op2 := op^.left; + op^.left := op^.left^.left; + op2^.left := op^.right; + op2^.opcode := pc_adi; + op^.right := op2; + end; {else if} + end; {case pc_ixa} + + pc_leq: begin {pc_leq} + if op^.optype in [cgWord,cgUWord] then + if op^.right^.opcode = pc_ldc then + if op^.right^.q < maxint then begin + op^.right^.q := op^.right^.q + 1; + op^.opcode := pc_les; + end; {if} + end; {case pc_lnm} + + pc_lnd: begin {pc_lnd} + if op^.right^.opcode = pc_ldc then begin + if op^.left^.opcode = pc_ldc then begin + op^.left^.q := ord((op^.left^.lval <> 0) and (op^.right^.lval <> 0)); + op^.left^.optype := cgWord; + opv := op^.left; + end {if} + else begin + if op^.right^.lval = 0 then begin + if not SideEffects(op^.left) then begin + with op^.right^ do begin + lval := 0; + optype := cgWord; + q := 0; + end; {with} + opv := op^.right; + end; {if} + end {if} + else + op^.opcode := pc_neq; + end; {if} + end {if} + else if op^.left^.opcode = pc_ldc then + if op^.left^.lval = 0 then begin + with op^.left^ do begin + lval := 0; + optype := cgWord; + q := 0; + end; {with} + opv := op^.left; + end; {if} + end; {case pc_lnd} + + pc_lnm: begin {pc_lnm} + if op^.next^.opcode = pc_lnm then begin + opv := op^.next; + rescan := true; + end; {if} + end; {case pc_lnm} + + pc_lor: begin {pc_lor} + if op^.right^.opcode = pc_ldc then begin + if op^.left^.opcode = pc_ldc then begin + op^.left^.q := ord((op^.left^.lval <> 0) or (op^.right^.lval <> 0)); + optype := cgWord; + opv := op^.left; + end {if} + else begin + if op^.right^.lval <> 0 then begin + if not SideEffects(op^.left) then begin + op^.right^.lval := 0; + op^.right^.q := 1; + op^.right^.optype := cgWord; + opv := op^.right; + end; {if} + end {if} + else begin + op^.opcode := pc_neq; + op^.optype := cgLong; + end; {else} + end; {if} + end {if} + else if op^.left^.opcode = pc_ldc then + if op^.left^.lval <> 0 then begin + op^.left^.lval := 0; + op^.left^.q := 1; + op^.left^.optype := cgWord; + opv := op^.left; + end; {if} + end; {case pc_lor} + + pc_mdl: begin {pc_mdl} + if op^.right^.opcode = pc_ldc then + if op^.left^.opcode = pc_ldc then + if op^.right^.lval <> 0 then begin + op^.left^.lval := op^.left^.lval mod op^.right^.lval; + opv := op^.left; + end; {if} + end; {case pc_mdl} + + pc_mod: begin {pc_mod} + if op^.right^.opcode = pc_ldc then + if op^.left^.opcode = pc_ldc then + if op^.right^.q <> 0 then begin + op^.left^.q := op^.left^.q mod op^.right^.q; + opv := op^.left; + end; {if} + end; {case pc_mod} + + pc_mpi, pc_umi: begin {pc_mpi, pc_umi} + if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin + if op^.opcode = pc_mpi then + op^.left^.q := op^.left^.q*op^.right^.q + else {if op^.opcode = pc_umi then} begin + lval := umul(op^.left^.q & $0000FFFF, op^.right^.q & $0000FFFF); + op^.left^.q := long(lval).lsw; + end; {else} + opv := op^.left; + end {if} + else begin + if op^.left^.opcode = pc_ldc then + ReverseChildren(op); + if op^.right^.opcode = pc_ldc then begin + q := op^.right^.q; + if q = 1 then + opv := op^.left + else if q = 0 then begin + if NoFunctions(op^.left) then + opv := op^.right; + end {else if} + else if (q = -1) and (op^.opcode = pc_mpi) then begin + op^.opcode := pc_ngi; + op^.right := nil; + end {else if} + else if OneBit(q) then begin + op^.right^.q := Base(q); + op^.opcode := pc_shl; + PeepHoleOptimization(opv); + end; {else if} + end; {if} + end; {else} + end; {case pc_mpi, pc_umi} + + pc_mpl, pc_uml: begin {pc_mpl, pc_uml} + if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin + if op^.opcode = pc_mpl then + op^.left^.lval := op^.left^.lval*op^.right^.lval + else {if op^.opcode = pc_uml then} + op^.left^.lval := umul(op^.left^.lval, op^.right^.lval); + opv := op^.left; + end {if} + else begin + if op^.left^.opcode = pc_ldc then + ReverseChildren(op); + if op^.right^.opcode = pc_ldc then begin + lval := op^.right^.lval; + if lval = 1 then + opv := op^.left + else if lval = 0 then begin + if NoFunctions(op^.left) then + opv := op^.right; + end {else if} + else if (lval = -1) and (op^.opcode = pc_mpl) then begin + op^.opcode := pc_ngl; + op^.right := nil; + end {else if} + else if OneBit(lval) then begin + op^.right^.lval := Base(lval); + op^.opcode := pc_sll; + end; {else if} + end; {if} + end; {else} + end; {case pc_mpl, pc_uml} + + pc_mpr: begin {pc_mpr} + if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin + op^.left^.rval := op^.left^.rval*op^.right^.rval; + opv := op^.left; + end {if} + else begin + if op^.left^.opcode = pc_ldc then + ReverseChildren(op); + if op^.right^.opcode = pc_ldc then begin + rval := op^.right^.rval; + if rval = 1.0 then + opv := op^.left + else if rval = 0.0 then + if NoFunctions(op^.left) then + opv := op^.right; + end; {if} + end; {else} + end; {case pc_mpr} + + pc_neq: begin {pc_neq} + if op^.left^.opcode = pc_ldc then + ReverseChildren(op); + if op^.right^.opcode = pc_ldc then begin + if op^.left^.opcode = pc_ldc then begin + BinOps(op^.left, op^.right); + case op^.left^.optype of + cgByte,cgUByte,cgWord,cgUWord: begin + op^.opcode := pc_ldc; + op^.q := ord(op^.left^.q <> op^.right^.q); + op^.left := nil; + op^.right := nil; + end; + cgLong,cgULong: begin + op^.opcode := pc_ldc; + op^.q := ord(op^.left^.lval <> op^.right^.lval); + op^.left := nil; + op^.right := nil; + end; + cgReal,cgDouble,cgComp,cgExtended: begin + op^.opcode := pc_ldc; + op^.q := ord(op^.left^.rval <> op^.right^.rval); + op^.left := nil; + op^.right := nil; + end; + cgVoid,ccPointer: begin + op^.opcode := pc_ldc; + op^.q := ord(op^.left^.pval <> op^.right^.pval); + op^.left := nil; + op^.right := nil; + end; + end; {case} + end {if} + else if op^.right^.optype in [cgByte, cgUByte, cgWord, cgUWord] then begin + if op^.right^.q = 0 then + if op^.left^.opcode in + [pc_and,pc_ior,pc_neq,pc_equ,pc_geq,pc_leq,pc_les,pc_grt] + then begin + opv := op^.left; + opv^.next := op^.next; + end; {if} + end {else if} + else if op^.right^.optype in [cgLong, cgULong] then begin + if op^.right^.lval = 0 then + if op^.left^.opcode in + [pc_and,pc_ior,pc_neq,pc_equ,pc_geq,pc_leq,pc_les,pc_grt] + then begin + opv := op^.left; + opv^.next := op^.next; + end; {if} + end; {else if} + end; {if} + end; {case pc_neq} + + pc_ngi: begin {pc_ngi} + if op^.left^.opcode = pc_ldc then begin + op^.left^.q := -op^.left^.q; + opv := op^.left; + end; {if} + end; {case pc_ngi} + + pc_ngl: begin {pc_ngl} + if op^.left^.opcode = pc_ldc then begin + op^.left^.lval := -op^.left^.lval; + opv := op^.left; + end; {if} + end; {case pc_ngl} + + pc_ngr: begin {pc_ngr} + if op^.left^.opcode = pc_ldc then begin + op^.left^.rval := -op^.left^.rval; + opv := op^.left; + end; {if} + end; {case pc_ngr} + + pc_not: begin {pc_not} + opcode := op^.left^.opcode; + if opcode = pc_ldc then begin + if op^.left^.optype in [cgByte,cgUByte,cgWord,cgUWord] then begin + op^.left^.q := ord(op^.left^.q = 0); + opv := op^.left; + end {if} + else if op^.left^.optype in [cgLong,cgULong] then begin + q := ord(op^.left^.lval = 0); + lval := 0; + op^.left^.q := q; + op^.left^.optype := cgWord; + opv := op^.left; + end; {else if} + end {if} + else if opcode = pc_equ then begin + op^.left^.opcode := pc_neq; + opv := op^.left; + end {else if} + else if opcode = pc_neq then begin + op^.left^.opcode := pc_equ; + opv := op^.left; + end {else if} + else if opcode = pc_geq then begin + op^.left^.opcode := pc_les; + opv := op^.left; + end {else if} + else if opcode = pc_grt then begin + op^.left^.opcode := pc_leq; + opv := op^.left; + end {else if} + else if opcode = pc_les then begin + op^.left^.opcode := pc_geq; + opv := op^.left; + end {else if} + else if opcode = pc_leq then begin + op^.left^.opcode := pc_grt; + opv := op^.left; + end; {else if} + end; {case pc_not} + + pc_pop: begin {pc_pop} + if op^.left^.opcode = pc_cnv then + op^.left := op^.left^.left; + opcode := op^.left^.opcode; + if opcode = pc_cop then begin + op^.left^.opcode := pc_str; + opv := op^.left; + opv^.next := op^.next; + PeepHoleOptimization(opv); + end {if} + else if opcode = pc_cpi then begin + op^.left^.opcode := pc_sto; + opv := op^.left; + opv^.next := op^.next; + PeepHoleOptimization(opv); + end {else if} + else if opcode = pc_cbf then begin + op^.left^.opcode := pc_sbf; + opv := op^.left; + opv^.next := op^.next; + end {else if} + else if opcode = pc_cpo then begin + op^.left^.opcode := pc_sro; + opv := op^.left; + opv^.next := op^.next; + PeepHoleOptimization(opv); + end {else if} + else if opcode in [pc_inc,pc_dec] then + op^.left := op^.left^.left; + end; {case pc_pop} + + pc_ret: begin {pc_ret} + RemoveDeadCode(op); + end; {case pc_ret} + + pc_sbi: begin {pc_sbi} + if op^.left^.opcode = pc_ldc then begin + if op^.right^.opcode = pc_ldc then begin + op^.left^.q := op^.left^.q - op^.right^.q; + opv := op^.left; + end {if} + else if op^.left^.q = 0 then begin + op^.opcode := pc_ngi; + op^.left := op^.right; + op^.right := nil; + end; {else if} + end {if} + else if op^.right^.opcode = pc_ldc then begin + q := op^.right^.q; + if q = 0 then + opv := op^.left + else if (q > 0) then begin + op^.opcode := pc_dec; + op^.q := q; + op^.right := nil; + end {else if} + else {if q < 0) then} begin + op^.opcode := pc_inc; + op^.q := -q; + op^.right := nil; + end; {else if} + end {if} + else if op^.left^.opcode in [pc_inc,pc_dec] then + if op^.right^.opcode in [pc_inc,pc_dec] then begin + op2 := op^.left; + if op^.left^.opcode = pc_inc then + q := op^.left^.q + else + q := -op^.left^.q; + if op^.right^.opcode = pc_inc then + q := q - op^.right^.q + else + q := q + op^.right^.q; + if q >= 0 then begin + op2^.opcode := pc_inc; + op2^.q := q; + end {if} + else begin + op2^.opcode := pc_dec; + op2^.q := -q; + end; {else} + op^.left := op^.left^.left; + op^.right := op^.right^.left; + op2^.left := op; + opv := op2; + PeepHoleOptimization(opv); + end; {if} + end; {case pc_sbi} + + pc_sbl: begin {pc_sbl} + if op^.left^.opcode = pc_ldc then begin + if op^.right^.opcode = pc_ldc then begin + op^.left^.lval := op^.left^.lval - op^.right^.lval; + opv := op^.left; + end {if} + else if op^.left^.lval = 0 then begin + op^.opcode := pc_ngl; + op^.left := op^.right; + op^.right := nil; + end; {else if} + end {if} + else if op^.right^.opcode = pc_ldc then begin + lval := op^.right^.lval; + if lval = 0 then + opv := op^.left + else if (lval > 0) and (lval <= maxint) then begin + op^.opcode := pc_dec; + op^.q := ord(lval); + op^.right := nil; + op^.optype := cgLong; + end {else if} + else if (lval > -maxint) and (lval < 0) then begin + op^.opcode := pc_inc; + op^.q := -ord(lval); + op^.right := nil; + op^.optype := cgLong; + end; {else if} + end; {if} + end; {case pc_sbl} + + pc_sbr: begin {pc_sbr} + if op^.left^.opcode = pc_ldc then begin + if op^.right^.opcode = pc_ldc then begin + op^.left^.rval := op^.left^.rval - op^.right^.rval; + opv := op^.left; + end {if} + else if op^.left^.rval = 0.0 then begin + op^.opcode := pc_ngr; + op^.left := op^.right; + op^.right := nil; + end; {else if} + end {if} + else if op^.right^.opcode = pc_ldc then begin + if op^.right^.rval = 0.0 then + opv := op^.left; + end; {if} + end; {case pc_sbr} + + pc_shl: begin {pc_shl} + if op^.right^.opcode = pc_ldc then begin + opcode := op^.left^.opcode; + if opcode = pc_shl then begin + if op^.left^.right^.opcode = pc_ldc then begin + op^.right^.q := op^.right^.q + op^.left^.right^.q; + op^.left := op^.left^.left; + end; {if} + end {if} + else if opcode = pc_inc then begin + op2 := op^.left; + op^.left := op2^.left; + op2^.q := op2^.q << op^.right^.q; + op2^.left := op; + opv := op2; + PeepHoleOptimization(op2^.left); + end; {else if} + end; {if} + end; {case pc_shl} + + pc_sro, pc_str: begin {pc_sro, pc_str} + if op^.optype in [cgReal,cgDouble,cgExtended] then + RealStoreOptimizations(op, op^.left); + end; {case pc_sro, pc_str} + + pc_sto: begin {pc_sto} + if op^.optype in [cgReal,cgDouble,cgExtended] then + RealStoreOptimizations(op, op^.right); + if op^.left^.opcode = pc_lao then begin + op^.q := op^.left^.q; + op^.lab := op^.left^.lab; + op^.opcode := pc_sro; + op^.left := op^.right; + op^.right := nil; + end {if} + else if op^.left^.opcode = pc_lda then begin + op^.q := op^.left^.q; + op^.r := op^.left^.r; + op^.opcode := pc_str; + op^.left := op^.right; + op^.right := nil; + end; {if} + end; {case pc_sto} + + pc_tjp: begin {pc_tjp} + opcode := op^.left^.opcode; + if opcode = pc_ldc then begin + if op^.left^.optype in [cgByte, cgUByte, cgWord, cgUWord] then + if op^.left^.q = 0 then begin + opv := op^.next; + rescan := true; + end {if} + else begin + op^.opcode := pc_ujp; + op^.left := nil; + PeepHoleOptimization(opv); + end; {else} + end {if} + else if opcode = pc_ior then begin + op2 := op^.left; + op2^.next := op^.next; + op^.next := op2; + op^.left := op2^.left; + op2^.left := op2^.right; + op2^.right := nil; + op2^.opcode := pc_tjp; + op2^.q := op^.q; + PeepHoleOptimization(opv); + end {else if} + else if opcode = pc_and then begin + op2 := op^.left; + op2^.next := op^.next; + op^.next := op2; + op^.left := op2^.left; + op2^.left := op2^.right; + op2^.right := nil; + op2^.opcode := pc_tjp; + op2^.q := op^.q; + op^.opcode := pc_fjp; + op3 := pointer(Calloc(sizeof(intermediate_code))); + op3^.opcode := dc_lab; + op3^.optype := cgWord; + op3^.q := GenLabel; + op3^.next := op2^.next; + op2^.next := op3; + op^.q := op3^.q; + PeepHoleOptimization(opv); + end {else if} + else + JumpOptimizations(op, pc_fjp); + end; {case pc_tjp} + + pc_tri: begin {pc_tri} + opcode := op^.left^.opcode; + if opcode = pc_not then begin + ReverseChildren(op^.right); + op^.left := op^.left^.left; + PeepHoleOptimization(opv); + end {if} + else if opcode in [pc_equ, pc_neq] then begin + with op^.left^.right^ do + if opcode = pc_ldc then + if optype in [cgByte,cgUByte,cgWord,cgUWord] then + if q = 0 then begin + if op^.left^.opcode = pc_equ then + ReverseChildren(op^.right); + op^.left := op^.left^.left; + end; {if} + end; {else if} + end; {case pc_tri} + + pc_udi: begin {pc_udi} + if op^.right^.opcode = pc_ldc then begin + q := op^.right^.q; + if op^.left^.opcode = pc_ldc then begin + if q <> 0 then begin + op^.left^.q := ord(udiv(op^.left^.q & $0000FFFF, q & $0000FFFF)); + opv := op^.left; + end; {if} + end {if} + else if q = 1 then + opv := op^.left + else if OneBit(q) then begin + op^.right^.q := Base(q); + op^.opcode := pc_usr; + end; {else if} + end; {if} + end; {case pc_udi} + + pc_udl: begin {pc_udl} + if op^.right^.opcode = pc_ldc then begin + lq := op^.right^.lval; + if op^.left^.opcode = pc_ldc then begin + if lq <> 0 then begin + op^.left^.lval := udiv(op^.left^.lval, lq); + opv := op^.left; + end; {if} + end {if} + else if lq = 1 then + opv := op^.left + else if OneBit(lq) then begin + op^.right^.lval := Base(lq); + op^.opcode := pc_vsr; + end; {else if} + end; {if} + end; {case pc_udl} + + pc_uim: begin {pc_uim} + if op^.right^.opcode = pc_ldc then + if op^.left^.opcode = pc_ldc then + if op^.right^.q <> 0 then begin + op^.left^.q := + ord(umod(op^.left^.q & $0000FFFF, op^.right^.q & $0000FFFF)); + opv := op^.left; + end; {if} + end; {case pc_uim} + + pc_ujp: begin {pc_ujp} + RemoveDeadCode(op); + if op^.next^.opcode = dc_lab then begin + if op^.q = op^.next^.q then begin + opv := op^.next; + rescan := true; + end {if} + else if op^.next^.next^.opcode = dc_lab then + if op^.next^.next^.q = op^.q then begin + opv := op^.next; + rescan := true; + end; {if} + end; {if} + end; {case pc_ujp} + + pc_ulm: begin {pc_ulm} + if op^.right^.opcode = pc_ldc then + if op^.left^.opcode = pc_ldc then + if op^.right^.lval <> 0 then begin + op^.left^.lval := umod(op^.left^.lval, op^.right^.lval); + opv := op^.left; + end; {if} + end; {case pc_ulm} + + otherwise: ; + end; {case} +end; {PeepHoleOptimization} + +{- Common Subexpression Elimination ----------------------------} + +function MatchLoc (op1, op2: icptr): boolean; + +{ See if two loads, stores or copies refer to the same } +{ location } +{ } +{ parameters: } +{ op1, op2 - operations to check } +{ } +{ Returns: True if they do, false if they don't. } + +begin {MatchLoc} +MatchLoc := false; +if (op1^.opcode in [pc_str,pc_cop,pc_lod,pc_lli,pc_lil,pc_lld,pc_ldl,pc_lda]) + and (op2^.opcode in [pc_str,pc_cop,pc_lod,pc_lli,pc_lil,pc_lld,pc_ldl,pc_lda]) then begin + if op1^.r = op2^.r then + MatchLoc := true; + end {if} +else if (op1^.opcode in [pc_sro,pc_cpo,pc_ldo,pc_gli,pc_gil,pc_gld,pc_gdl,pc_lao]) + and (op2^.opcode in [pc_sro,pc_cpo,pc_ldo,pc_gli,pc_gil,pc_gld,pc_gdl,pc_lao]) then + if op1^.lab^ = op2^.lab^ then + MatchLoc := true; +end; {MatchLoc} + + +function Member (op: icptr; list: iclist): boolean; + +{ See if the operand of a load is referenced in a list } +{ } +{ parameters: } +{ op - load to check } +{ list - list to check } +{ } +{ Returns: True if op is in list, else false. } +{ } +{ Notes: As a side effect, this subroutine sets memberOp to } +{ point to any matching member; memberOp is undefined if } +{ there is no matching member. } + +begin {Member} +Member := false; +while list <> nil do begin + if MatchLoc(op, list^.op) then begin + Member := true; + memberOp := list^.op; + list := nil; + end {if} + else + list := list^.next; + end; {while} +end; {Member} + + +function TypeOf (op: icptr): baseTypeEnum; + +{ find the type for the expression tree } +{ } +{ parameters: } +{ op - tree for which to find the type } +{ } +{ Returns: base type } + +begin {TypeOf} +case op^.opcode of + pc_gil, pc_gli, pc_gdl, pc_gld, pc_iil, pc_ili, pc_idl, pc_ild, + pc_ldc, pc_ldo, pc_lil, pc_lli, pc_ldl, pc_lld, pc_lod, pc_dec, + pc_inc, pc_ind, pc_lbf, pc_lbu, pc_cop, pc_cbf, pc_cpi, pc_cpo, + pc_tri: + TypeOf := op^.optype; + + pc_lad, pc_lao, pc_lca, pc_lda, pc_psh, pc_ixa: + TypeOf := cgULong; + + pc_nop, pc_bnt, pc_ngi, pc_not, pc_adi, pc_and, pc_lnd, pc_bnd, + pc_bor, pc_bxr, pc_dvi, pc_equ, pc_geq, pc_grt, pc_leq, pc_les, + pc_neq, pc_ior, pc_lor, pc_mod, pc_mpi, pc_sbi, pc_shl, pc_shr: + TypeOf := cgWord; + + pc_udi, pc_uim, pc_umi, pc_usr: + TypeOf := cgUWord; + + pc_bnl, pc_ngl, pc_adl, pc_bal, pc_blr, pc_blx, pc_dvl, pc_mdl, + pc_mpl, pc_sbl, pc_sll, pc_slr: + TypeOf := cgLong; + + pc_udl, pc_ulm, pc_uml, pc_vsr: + TypeOf := cgULong; + + pc_ngr, pc_adr, pc_dvr, pc_mpr, pc_sbr: + TypeOf := cgExtended; + + pc_cnn, pc_cnv: + TypeOf := baseTypeEnum(op^.q & $000F); + + pc_stk: + TypeOf := TypeOf(op^.left); + + pc_bno: + TypeOf := TypeOf(op^.right); + + otherwise: Error(cge1); + end; {case} +end; {TypeOf} + + +procedure CommonSubexpressionElimination; + +{ Remove common subexpressions } + +type + localPtr = ^localRecord; {list of local temp variables} + localRecord = record + next: localPtr; {next label in list} + inUse: boolean; {is this temp already in use?} + size: integer; {size of the temp area} + lab: integer; {label number} + end; + +var + bb: blockPtr; {used to trace basic block lists} + done: boolean; {for loop termination tests} + op: icptr; {used to trace operation lists, trees} + lop: icptr; {predecessor of op} + temps: localPtr; {list of temp variables} + + + procedure DisposeTemps; + + { dispose of the list of temp variables } + + var + tp: localPtr; {temp pointer} + + begin {DisposeTemps} + while temps <> nil do begin + tp := temps; + temps := tp^.next; + dispose(tp); + end; {while} + end; {DisposeTemps} + + + function GetTemp (bb: blockPtr; size: integer): integer; + + { Allocate a temp storage location } + { } + { parameters: } + { bb - block in which the temp is allocated } + { size - size of the temp } + { } + { Returns: local label number for the temp } + + var + lab: integer; {label number} + loc: icptr; {for dc_loc instruction} + tp: localPtr; {used to trace lists, allocate new items} + + begin {GetTemp} + lab := 0; {no label found, yet} + tp := temps; {try for a temp of the exact size} + while tp <> nil do begin + if not tp^.inUse then + if tp^.size = size then begin + lab := tp^.lab; + tp^.inUse := true; + tp := nil; + end; {if} + if tp <> nil then + tp := tp^.next; + end; {while} + if lab = 0 then begin {try for a larger temp} + tp := temps; + while tp <> nil do begin + if not tp^.inUse then + if tp^.size > size then begin + lab := tp^.lab; + tp^.inUse := true; + tp := nil; + end; {if} + if tp <> nil then + tp := tp^.next; + end; {while} + end; {if} + if lab = 0 then begin {allocate a new temp} + loc := pointer(Calloc(sizeof(intermediate_code))); + loc^.opcode := dc_loc; + loc^.optype := cgWord; + maxLoc := maxLoc + 1; + loc^.r := maxLoc; + lab := maxLoc; + loc^.q := size; + if bb^.code = nil then begin + loc^.next := nil; + bb^.code := loc; + end {if} + else begin + loc^.next := bb^.code^.next; + bb^.code^.next := loc; + end; {else} + new(tp); + tp^.next := temps; + temps := tp; + tp^.inUse := true; + tp^.size := loc^.q; + tp^.lab := lab; + end; {if} + GetTemp := lab; {return the temp label number} + end; {GetTemp} + + + procedure ResetTemps; + + { Mark all temps as available } + + var + tp: localPtr; {temp pointer} + + begin {ResetTemps} + tp := temps; + while tp <> nil do begin + tp^.inUse := false; + tp := tp^.next; + end; {while} + end; {ResetTemps} + + + procedure CheckForBlocks (op: icptr); + + { Scan a tree for blocked instructions } + { } + { parameters: } + { op - tree to check } + { } + { Notes: Some code takes less time to execute than saving } + { and storing the intermediate value. This subroutine } + { identifies such patterns. } + + + function Block (op: icptr): boolean; + + { See if the pattern should be blocked } + { } + { parameters: } + { op - pattern to check } + { } + { Returns: True if the pattern should be blocked, else } + { false. } + + var + opcode: pcodes; {temp opcode} + + begin {Block} + Block := false; + opcode := op^.opcode; + if opcode = pc_ixa then begin + if op^.left^.opcode in [pc_lao,pc_lca,pc_lda] then + Block := true; + end {else if} + else if opcode = pc_shl then begin + if op^.right^.opcode = pc_ldc then + if op^.right^.q = 1 then + if op^.parents <= 3 then + Block := true; + end {else if} + else if opcode = pc_stk then + Block := true + else if opcode = pc_cnv then + if op^.q & $000F = ord(cgVoid) then + Block := true; + end; {Block} + + + function Max (a, b: integer): integer; + + { Return the larger of two integers } + { } + { parameters: } + { a, b - integers to check } + { } + { Returns: a if a > b, else b } + + begin {Max} + if a > b then + Max := a + else + Max := b; + end; {Max} + + + begin {CheckForBlocks} + if Block(op) then begin + if op^.left <> nil then {handle a blocked instruction} + op^.left^.parents := op^.left^.parents + Max(op^.parents - 1, 0); + if op^.right <> nil then + op^.right^.parents := op^.right^.parents + Max(op^.parents - 1, 0); + op^.parents := 1; + end; {if} + if op^.left <> nil then {check the children} + CheckForBlocks(op^.left); + if op^.right <> nil then + CheckForBlocks(op^.right); + end; {CheckForBlocks} + + + procedure CheckTree (var op: icptr; bb: blockPtr); + + { check the trees used by op for common subexpressions } + { } + { parameters: } + { op - operation to check } + { bb - start of the current BASIC block } + + var + op2: icptr; {result from Match calls} + op3: icptr; {used to trace the codes in a block} + + + function Match (var op: icptr; tree: icptr): icptr; + + { Check for matches to op in tree } + { } + { parameters: } + { op - operation to check } + { tree - tree to examine for matches } + { } + { Returns: pointer to matching node or nil if none found } + + var + op2: icptr; {result from recursive Match calls} + kill, start, stop: boolean; {used by Scan} + skip: boolean; {used to see if children should be scanned} + + + procedure Combine (var op1, op2: icptr); + + { Op2 is a save or copy of the same value as op1; use a copy } + { for op2. } + { } + { parameters: } + { op1 - first copy or save } + { op2 - copy or save to optimize } + + var + op3: icptr; {work pointer} + + begin {Combine} + done := false; {force another labeling pass} + op3 := op2; {remove op2 from the list} + if op3^.opcode in [pc_str,pc_sro] then begin + if op3^.opcode = pc_str then + op3^.opcode := pc_cop + else + op3^.opcode := pc_cpo; + op2 := op3^.next; + op3^.next := nil; + end {if} + else + op2 := op3^.left; + op1^.left := op3; {place in the new location} + end; {Combine} + + + function SameTree (list, op1, op2: icptr): boolean; + + { Are op1 and op2 in the same expression tree? } + { } + { parameters: } + { list - list of expression trees } + { op1, op2 - operations to check } + + + function InTree (tree, op: icptr): boolean; + + { See if op is in the tree } + { } + { parameters: } + { tree - expression tree to check } + { op - operatio to look for } + + begin {InTree} + if tree = nil then + InTree := false + else if tree = op then + InTree := true + else + InTree := InTree(tree^.left, op) or InTree(tree^.right, op); + end; {InTree} + + + begin {SameTree} + SameTree := false; + while list <> nil do + if InTree(list, op1) then begin + SameTree := InTree(list, op2); + list := nil; + end {if} + else + list := list^.next; + end; {SameTree} + + + procedure Scan (list, op1, op2: icptr); + + { Check to see if any operation between op1 and op2 kills the } + { optimization } + { } + { parameters: } + { list - instruction stream } + { op1 - starting operation } + { op2 - ending operation } + { } + { globals: } + { kill - set to true if the optimization must be blocked, } + { or false if it can be performed } + { start - has op1 been found? (initialize to false) } + { stop - has kill been set? (initialize to false) } + + begin {Scan} + if not start then {see if it is time to start} + if list = op1 then + start := true; + if list^.left <> nil then {scan the children} + Scan(list^.left, op1, op2); + if not stop then + if list^.right <> nil then + Scan(list^.right, op1, op2); + if start then {check for a kill or termination} + if not stop then + if list = op2 then begin + kill := false; + stop := true; + end {if} + else if list^.opcode in [pc_str,pc_sro,pc_cop,pc_cpo,pc_lli,pc_lil, + pc_lld,pc_ldl,pc_gli,pc_gil,pc_gld,pc_gdl] then begin + if MatchLoc(list, op2) then begin + kill := true; + stop := true; + end {if} + end {else if} + else if list^.opcode in [pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild, + pc_cup,pc_cui,pc_tl1] then + if Member(op1, c_ind) then begin + kill := true; + stop := true; + end; {if} + if not stop then {scan forward in the stream} + if list^.next <> nil then + Scan(list^.next, op1, op2); + end; {Scan} + + + begin {Match} + op2 := nil; {check for an exact match} + skip := false; + if CodesMatch(op, tree, true) then begin + if op = tree then + op2 := tree + else begin + start := false; + stop := false; + Scan(bb^.code, tree, op); + if not kill then + op2 := tree; + end; {else} + end {if} + {check for stores of a common value} + else if op^.opcode in [pc_str,pc_sro,pc_cop,pc_cpo] then + if tree^.opcode in [pc_str,pc_sro,pc_cop,pc_cpo] then + if op^.left = tree^.left then begin + start := false; + stop := false; + Scan(bb^.code, tree, op); + if not kill then + if not SameTree(bb^.code, op, tree) then + if (op^.left^.opcode <> pc_ldc) + or ((op^.left^.optype in [cgByte,cgUByte,cgWord,cgUWord]) + and (op^.left^.q <> 0)) + or ((op^.left^.optype in [cgLong,cgULong]) + and (op^.left^.lval <> 0)) + or (not (op^.left^.optype in [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong])) + then begin + Combine(tree, op); + skip := true; + end; {if} + end; {if} + if not skip then begin {check for matches in the children} + if op2 = nil then + if tree^.left <> nil then + op2 := Match(op, tree^.left); + if op2 = nil then + if tree^.right <> nil then + op2 := Match(op, tree^.right); + end; {if} + Match := op2; + end; {Match} + + + begin {CheckTree} + op^.parents := 0; {zero the parent counter} + if op^.left <> nil then {check the children} + CheckTree(op^.left, bb); + if op^.right <> nil then + CheckTree(op^.right, bb); + if op^.next = nil then {look for a match to the current code} + if not (op^.opcode in [pc_cup,pc_cui,pc_tl1,pc_bno]) then begin + op2 := nil; + op3 := bb^.code; + while (op2 = nil) and (op3 <> nil) do begin + op2 := Match(op, op3); + if op2 <> nil then + if op2^.next = nil then begin + op := op2; + bb := nil; + op3 := nil; + end ;{if} + if op3 <> nil then + op3 := op3^.next; + end; {while} + end; {if} + end; {CheckTree} + + + procedure CountParents (op: icptr); + + { increment the parent counter for all children of this node } + { } + { parameters: } + { op - node for which to check the children } + + begin {CountParents} + if op^.parents = 0 then begin + if op^.left <> nil then begin + CountParents(op^.left); + op^.left^.parents := op^.left^.parents + 1; + end; {if} + if op^.right <> nil then begin + CountParents(op^.right); + op^.right^.parents := op^.right^.parents + 1; + end; {if} + end; {if} + end; {CountParents} + + + procedure CreateTemps (var op: icptr; bb: blockPtr; var lop: icptr); + + { create temps for nodes with multiple parents } + { } + { parameters: } + { op - node for which to create temps } + { bb - current basic block } + { lop - predecessor to op } + + var + children: boolean; {does this node have children?} + llab: integer; {local label number; for temp} + op2, str: icptr; {new opcodes} + optype: baseTypeEnum; {type of the temp variable} + + begin {CreateTemps} + children := false; {create temps for the children} + if op^.left <> nil then begin + children := true; + CreateTemps(op^.left, bb, lop); + end; {if} + if op^.right <> nil then begin + children := true; + CreateTemps(op^.right, bb, lop); + end; {if} + if children then + if op^.parents > 1 then begin + optype := TypeOf(op); {create a temp label} + llab := GetTemp(bb, TypeSize(optype)); + {make a copy of the duplicated tree} + op2 := pointer(Calloc(sizeof(intermediate_code))); + op2^ := op^; + op^.opcode := pc_lod; {substitute a load of the temp} + op^.optype := optype; + op^.parents := 1; + op^.r := llab; + op^.q := 0; + op^.left := nil; + op^.right := nil; + {store the temp result} + str := pointer(Calloc(sizeof(intermediate_code))); + str^.opcode := pc_str; + str^.optype := optype; + str^.r := llab; + str^.q := 0; + str^.left := op2; + if lop = nil then begin {insert the store in the basic block} + str^.next := bb^.code; + bb^.code := str; + end {if} + else begin + str^.next := lop^.next; + lop^.next := str; + end; {else} + lop := str; + end; {if} + end; {CreateTemps} + + +begin {CommonSubexpressionElimination} +temps := nil; {no temps allocated, yet} +repeat {identify common parts} + done := true; + bb := DAGblocks; + while bb <> nil do begin + Spin; + op := bb^.code; + if op <> nil then begin + CheckTree(bb^.code, bb); + while op^.next <> nil do begin + CheckTree(op^.next, bb); + if op^.next <> nil then + op := op^.next; + end; {while} + end; {if} + bb := bb^.next; + end; {while} +until done; +bb := DAGblocks; {count the number of parents} +while bb <> nil do begin + op := bb^.code; + Spin; + while op <> nil do begin + CountParents(op); + op := op^.next; + end; {while} + bb := bb^.next; + end; {while} +bb := DAGblocks; {check for blocked instructions} +while bb <> nil do begin + op := bb^.code; + Spin; + while op <> nil do begin + CheckForBlocks(op); + op := op^.next; + end; {while} + bb := bb^.next; + end; {while} +bb := DAGblocks; {create temps for common subexpressions} +while bb <> nil do begin + op := bb^.code; + lop := nil; + ResetTemps; + Spin; + while op <> nil do begin + CreateTemps(op, bb, lop); + lop := op; + op := op^.next; + end; {while} + bb := bb^.next; + end; {while} +DisposeTemps; {get rid of the temp variable list} +end; {CommonSubexpressionElimination} + +{- Loop Optimizations ------------------------------------------} + +procedure AddOperation (op: icptr; var lp: iclist); + +{ Add an operation to an operation list } +{ } +{ parameters: } +{ op - operation to add } +{ lp - list to add the operation to } + +var + inList: boolean; {is op already in the list?} + llp: iclist; {work pointer} + +begin {AddOperation} +llp := lp; +inList := false; +while llp <> nil do + if MatchLoc(llp^.op, op) then begin + inList := true; + llp := nil; + end {if} + else + llp := llp^.next; +if not inList then begin + new(llp); + llp^.next := lp; + lp := llp; + llp^.op := op; + end; {if} +end; {AddOperation} + + +procedure DisposeBlkList (var blk: blockListPtr); + +{ dispose of all entries in the block list } +{ } +{ parameters: } +{ blk - list of blocks to dispose of } + +var + bk1, bk2: blockListPtr; {work pointers} + +begin {DisposeBlkList} +bk1 := blk; +blk := nil; +while bk1 <> nil do begin + bk2 := bk1; + bk1 := bk2^.next; + dispose(bk2); + end; {while} +end; {DisposeBlkList} + + +procedure DisposeOpList (var oplist: iclist); + +{ dispose of all entries in the list } +{ } +{ parameters: } +{ oplist - operation list to dispose of } + +var + op1, op2: iclist; {work pointers} + +begin {DisposeOpList} +op1 := oplist; +oplist := nil; +while op1 <> nil do begin + op2 := op1; + op1 := op2^.next; + dispose(op2); + end; {while} +end; {DisposeOpList} + + +procedure DumpLoopLists; + +{ dispose of lists created by ReachingDefinitions and Dominators} + +var + bb: blockPtr; {used to trace basic block list} + dom: blockListPtr; {used to dispose of a dominator} + +begin {DumpLoopLists} +bb := DAGBlocks; +while bb <> nil do begin + DisposeOpList(bb^.c_in); {dump the reaching definition lists} + DisposeOpList(bb^.c_out); + DisposeOpList(bb^.c_gen); + DisposeBlkList(bb^.dom); + while bb^.dom <> nil do begin {dump the dominator lists} + dom := bb^.dom; + bb^.dom := dom^.next; + dispose(dom); + end; {while} + bb := bb^.next; + end; {while} +end; {DumpLoopLists} + + +procedure AddLoads (jp: icptr; var lp: iclist); + +{ Add any load addresses from the children of this } +{ operation } +{ } +{ parameters: } +{ jp - operation to check } +{ lp - list to add the loads to } + +begin {AddLoads} +if jp^.opcode in [pc_lda,pc_lao,pc_lod,pc_lod] then + AddOperation(jp, lp) +else begin + if jp^.left <> nil then + AddLoads(jp^.left, lp); + if jp^.right <> nil then + AddLoads(jp^.right, lp); + end {else} +end; {AddLoads} + + +procedure FlagIndirectUses; + +{ Find all variables that could be changed by an indirect } +{ access. } + +var + bb: blockPtr; {used to trace block list} + + + procedure Check (op: icptr; doingInd: boolean); + + { Check op and its children & followers for dangerous } + { references } + { } + { parameters: } + { op - operation to check } + { doingInd - are we doing a pc_ind? If so, pc_lda's } + { are safe } + + var + lDoingInd: boolean; {local doingInd} + + begin {Check} + while op <> nil do begin + if op^.opcode = pc_ind then + lDoingInd := true + else + lDoingInd := doingInd; + if op^.left <> nil then + Check(op^.left, lDoingInd); + if op^.right <> nil then + Check(op^.right, lDoingInd); + if op^.opcode in [pc_lao,pc_cpo,pc_ldo,pc_sro,pc_gil,pc_gli, + pc_gdl,pc_gld] then + AddOperation(op, c_ind) + else if op^.opcode = pc_ind then begin + if op^.left^.opcode = pc_ind then + AddLoads(op^.left^.left, c_ind); + end {else if} + else if op^.opcode = pc_lda then + if not doingInd then + AddOperation(op, c_ind); + op := op^.next; + end; {while} + end; {Check} + + +begin {FlagIndirectUses} +c_ind := nil; +bb := DAGBlocks; +while bb <> nil do begin + Check(bb^.code, false); + bb := bb^.next; + end; {while} +end; {FlagIndirectUses} + + +procedure DoLoopOptimization; + +{ Perform optimizations related to loops and data flow } + +type + dftptr = ^dftrecord; {depth first tree edges} + dftrecord = record + next: dftptr; + from, dest: blockPtr; + end; + +var + backEdge: dftptr; {list of back edges} + dft: dftptr; {depth first tree} + dft2: dftptr; {work pointer} + + + function DFN (i: integer): blockPtr; + + { find the basic block with dfn index of i } + { } + { parameters: } + { i - index to look for } + { } + { Returns: block pointer, or nil if there is none } + + var + bb: blockPtr; {used to trace block list} + + begin {DFN} + bb := DAGBlocks; + DFN := nil; + while bb <> nil do begin + if bb^.dfn = i then begin + DFN := bb; + bb := nil; + end + else + bb := bb^.next; + end; {while} + end; {DFN} + + + function MemberDFNList (dfn: integer; bl: blockListPtr): boolean; + + { See if dfn is a member of the list bl } + { } + { parameters: } + { dfn - block number to check } + { bl - list of block numbers to check } + { } + { Returns: True if dfn is in bl, else false. } + + begin {MemberDFNList} + MemberDFNList := false; + while bl <> nil do + if bl^.dfn = dfn then begin + MemberDFNList := true; + bl := nil; + end {if} + else + bl := bl^.next; + end; {MemberDFNList} + + + function FindDAG (q: integer): blockPtr; + + { Find the DAG containing label q } + { } + { parameters: } + { q - label to find } + { } + { Returns: pointer to the proper basic block } + + var + bb: blockPtr; {used to trace basic block list} + + begin {FindDAG} + bb := DAGBlocks; + FindDAG := nil; + while bb <> nil do begin + if bb^.code^.opcode = dc_lab then + if bb^.code^.q = q then begin + FindDAG := bb; + bb := nil; + end; {if} + if bb <> nil then + bb := bb^.next; + end; {while} + end; {FindDAG} + + + procedure DepthFirstOrder; + + { Number the DAG for depth first order } + + var + bb: blockPtr; {used to trace basic block lists} + i: integer; {dfn index} + + + procedure Search (bb: blockPtr); + + { Search this block } + { } + { parameters: } + { bb - basic block to search } + + var + blk: blockPtr; {work block} + ndft: dftptr; {for new tree entries} + op: icptr; {used to trace operation list} + + + function NotUnconditional: boolean; + + { See if the block ends with something other than an } + { unconditional jump } + { } + { Returns: True if the block ends with something other } + { than pc_ujp or pc_add, else false } + + var + op: icptr; {used to trace the list} + + begin {NotUnconditional} + NotUnconditional := true; + op := bb^.code; + if op <> nil then begin + while op^.next <> nil do + op := op^.next; + if op^.opcode in [pc_add,pc_ujp] then + NotUnconditional := false; + end; {if} + end; {NotUnconditional} + + + begin {Search} + Spin; + if bb <> nil then + if not bb^.visited then begin + bb^.visited := true; + if NotUnconditional then + if bb^.next <> nil then begin + new(ndft); + ndft^.next := dft; + dft := ndft; + ndft^.from := bb; + ndft^.dest := bb^.next; + Search(bb^.next); + end; {if} + op := bb^.code; + while op <> nil do begin + if op^.opcode in [pc_ujp, pc_fjp, pc_tjp, pc_add] then begin + blk := FindDAG(op^.q); + new(ndft); + if blk^.visited then begin + ndft^.next := backEdge; + backEdge := ndft; + end {if} + else begin + ndft^.next := dft; + dft := ndft; + Search(blk); + end; {else} + ndft^.from := bb; + ndft^.dest := blk; + end; {if} + op := op^.next; + end; {while} + bb^.dfn := i; + i := i-1; + end; {if} + end; {Search} + + + begin {DepthFirstOrder} + dft := nil; + backEdge := nil; + i := 0; + bb := DAGblocks; + while bb <> nil do begin + bb^.visited := false; + i := i+1; + bb := bb^.next; + end; {while} + Search(DAGBlocks); + end; {DepthFirstOrder} + + + procedure Dominators; + + { Find a list of dominators for each node } + + var + bb: blockPtr; {used to trace the block list} + change: boolean; {for loop termination test} + i, j: integer; {loop variables} + maxdfn, mindfn: integer; {max and min dfn values used} + + + procedure Add (var dom: blockListPtr; dfn: integer); + + { Add dfn to the list of dominators } + { } + { parameters: } + { dom - dominator list } + { dfn - new dominator number } + + var + dp: blockListPtr; {new node} + + begin {Add} + new(dp); + dp^.last := nil; + dp^.next := dom; + dom^.last := dp; + dom := dp; + dp^.dfn := dfn; + end; {Add} + + + procedure CheckPredecessors (bb: blockPtr; bl: dftptr); + + { Eliminate nodes that don't dominate a predecessor } + { } + { parameters: } + { bb - block being checked } + { bl - list of edges to check for predecessors } + + var + dp: blockListPtr; {list of dominator numbers} + tdp: blockListPtr; {used to remove a dominator entry} + + begin {CheckPredecessors} + while bl <> nil do begin + if bl^.dest = bb then begin + dp := bb^.dom; + while dp <> nil do + if dp^.dfn <> bb^.dfn then + if not MemberDFNList(dp^.dfn, bl^.from^.dom) then begin + change := true; + tdp := dp; + if tdp^.last = nil then + bb^.dom := tdp^.next + else + tdp^.last^.next := tdp^.next; + if tdp^.next <> nil then + tdp^.next^.last := tdp^.last; + dp := tdp^.next; + dispose(tdp); + end {if} + else + dp := dp^.next + else + dp := dp^.next; + end; {if} + bl := bl^.next; + end; {while} + end; {CheckPredecessors} + + + begin {Dominators} + Spin; + maxdfn := 0; {find the largest dfn} + bb := DAGBlocks; + while bb <> nil do begin + if bb^.dfn > maxdfn then + maxdfn := bb^.dfn; + bb := bb^.next; + end; {while} + Add(DAGBlocks^.dom, DAGBlocks^.dfn); {the first node is it's own dominator} + mindfn := DAGBlocks^.dfn; {assume all other nodes are dominated by every other node} + for i := mindfn+1 to maxdfn do begin + bb := DFN(i); + if bb <> nil then + for j := mindfn to maxdfn do + Add(bb^.dom, j); + end; {for} + repeat {iterate to the true set of dominators} + change := false; + for i := mindfn+1 to maxdfn do begin + bb := DFN(i); + CheckPredecessors(bb, dft); + CheckPredecessors(bb, backEdge); + end; {for} + until not change; + end; {Dominators} + + + procedure ReachingDefinitions; + + { find the list of reaching definitions for each basic block } + + var + bb: blockPtr; {block being scanned} + change: boolean; {loop termination test} + i: integer; {node index number} + newIn: iclist; {list of inputs} + + + function Gen (op: icptr): iclist; + + { find a list of generated values } + { } + { parameters: } + { op - list of intermediate codes to scan } + { } + { Returns: list of generated definitions } + + var + gp: iclist; {list of generated definitions} + indFound: boolean; {has an indirect store been found?} + + + procedure Check (ip: icptr); + + { Add any result from ip to gp } + { } + { parameters: } + { ip - instruction to check } + + var + lc_ind: iclist; {used to trace the c_ind list} + + begin {Check} + if ip^.left <> nil then + Check(ip^.left); + if ip^.right <> nil then + Check(ip^.right); + if ip^.opcode in + [pc_str,pc_sro,pc_cop,pc_cpo,pc_lli,pc_lil,pc_lld,pc_ldl, + pc_gli,pc_gil,pc_gld,pc_gdl] then + AddOperation(ip, gp) + else if ip^.opcode in [pc_mov,pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild] then + AddLoads(ip, gp); + if not indFound then + if ip^.opcode in + [pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild,pc_cup,pc_cui,pc_tl1] + then begin + lc_ind := c_ind; + while lc_ind <> nil do begin + AddOperation(lc_ind^.op, gp); + lc_ind := lc_ind^.next; + end; {while} + indFound := true; + end; {if} + end; {Check} + + + begin {Gen} + indFound := false; + gp := nil; + while op <> nil do begin + Check(op); + op := op^.next; + end; {while} + Gen := gp; + end; {Gen} + + + function EqualSets (l1, l2: iclist): boolean; + + { See if two sets of stores and copies are equivalent } + { } + { parameters: } + { l1, l2 - lists of copies and stores } + { } + { Returns: True if the lists are equivalent, else false } + { } + { Notes: The members of each list are assumed to be } + { unique within that list. } + + var + c1, c2: integer; {number of elements in the sets} + l3: iclist; {used to trace the lists} + matchFound: boolean; {was a match found?} + + begin {EqualSets} + EqualSets := false; {assume they are not equal} + c1 := 0; {count the elements of l1} + l3 := l1; + while l3 <> nil do begin + c1 := c1+1; + l3 := l3^.next; + end; {while} + c2 := 0; {count the elements of l2} + l3 := l2; + while l3 <> nil do begin + c2 := c2+1; + l3 := l3^.next; + end; {while} + if c1 = c2 then begin {make sure each member of l1 is in l2} + EqualSets := true; + while l1 <> nil do begin + matchFound := false; + l3 := l2; + while l3 <> nil do begin + if MatchLoc(l1^.op, l3^.op) then begin + l3 := nil; + matchFound := true; + end {if} + else + l3 := l3^.next; + end; {while} + if not matchFound then begin + EqualSets := false; + l1 := nil; + end {if} + else + l1 := l1^.next; + end; {while} + end; {if} + end; {EqualSets} + + + function Union (l1, l2: iclist): iclist; + + { Returns a list that is the union of two input lists } + { } + { parameters: } + { l1, l2 - lists } + { } + { Returns: New, dynamically allocated list that includes } + { all of the members in l1 and l2. } + { } + { Notes: } + { 1. If there are duplicates, the member from l1 is } + { returned. } + { 2. It is assumed that all members of l1 and l2 are } + { unique within their own list. } + { 3. The original lists are not disturbed. } + { 4. The caller is responsible for disposing of the } + { memory used by the list. } + + var + lp: iclist; {new list pointer} + np: iclist; {new list member pointer} + tp: iclist; {temp list pointer} + + begin {Union} + lp := nil; + tp := l1; + while tp <> nil do begin + new(np); + np^.next := lp; + lp := np; + np^.op := tp^.op; + tp := tp^.next; + end; {while} + while l2 <> nil do begin + if not Member(l2^.op, l1) then begin + new(np); + np^.next := lp; + lp := np; + np^.op := l2^.op; + end; {if} + l2 := l2^.next; + end; {while} + Union := lp; + end; {Union} + + + function UnionOfPredecessors (bptr: blockPtr): iclist; + + { create a union of the outputs of predecessors to bptr } + { } + { parameters: } + { bptr - block for which to look for predecessors } + { } + { Returns: Resulting set } + + var + bp: dftptr; {used to trace edge lists} + plist: iclist; {result list} + tlist: iclist; {temp result list} + + begin {UnionOfPredecessors} + plist := nil; + bp := dft; + while bp <> nil do begin + if bp^.dest = bptr then begin + tlist := Union(plist, bp^.from^.c_out); + DisposeOpList(plist); + plist := tlist; + end; {if} + bp := bp^.next; + end; {while} + bp := backEdge; + while bp <> nil do begin + if bp^.dest = bptr then begin + tlist := Union(plist, bp^.from^.c_out); + DisposeOpList(plist); + plist := tlist; + end; {if} + bp := bp^.next; + end; {while} + UnionOfPredecessors := plist; + end; {UnionOfPredecessors} + + + begin {ReachingDefinitions} + i := 1; {initialize the lists} + repeat + bb := DFN(i); + if bb <> nil then begin + bb^.c_in := nil; + bb^.c_gen := Gen(bb^.code); + bb^.c_out := Union(nil, bb^.c_gen); + end; {if} + i := i+1; + until bb = nil; + repeat {iterate to a solution} + change := false; + i := 1; + repeat + Spin; + bb := DFN(i); + if bb <> nil then begin + newIn := UnionOfPredecessors(bb); + if not EqualSets(bb^.c_in, newIn) then begin + {IN[n] := newIn} + DisposeOpList(bb^.c_in); + bb^.c_in := newIn; + newIn := nil; + {OUT[n] := IN[n] - KILL[n] U GEN[n]} + DisposeOpList(bb^.c_out); + bb^.c_out := Union(bb^.c_in, nil); + change := true; + end; {if} + DisposeOpList(newIn); + end; {if} + i := i+1; + until bb = nil; + until not change; + end; {ReachingDefinitions} + + + procedure LoopInvariantRemoval; + + { Remove all loop invariant computations } + + type + loopPtr = ^loopRecord; {blocks in a list} + loopRecord = record + next: loopPtr; {next entry} + block: blockPtr; {code block} + exit: boolean; {is this a loop exit?} + end; + + loopListPtr = ^loopListRecord; {list of loop lists} + loopListRecord = record + next: loopListPtr; + loop: loopPtr; + end; + + var + icount: integer; {order invariant found} + loops: loopListPtr; {list of loops} + lp: loopPtr; {used to trace loop lists} + llp: loopListPtr; {used to trace the list of loops} + + + + procedure FindLoops; + + { Create a list of the natural loops } + + var + blk: blockPtr; {target block for a jump} + bp: dftptr; {used to trace the back edges} + lp, lp2: loopPtr; {used to reverse the list} + llp: loopListPtr; {loop list header entry} + llp2: loopListPtr; {used to reverse the list} + op: icptr; {used to trace the opcode list} + + + procedure Add (block: blockPtr); + + { Add a block to the current loop list } + { } + { parameters: } + { block - block to add } + + var + lp: loopPtr; {new loop entry} + + begin {Add} + new(lp); + lp^.next := llp^.loop; + llp^.loop := lp; + lp^.block := block; + lp^.exit := false; + end; {Add} + + + function InLoop (blk: blockPtr; lp: loopPtr): boolean; + + { See if the block is in the loop } + { } + { parameters: } + { blk - block to check for } + { lp - loop list } + { } + { Returns: True if blk is in the list, else false } + + begin {InLoop} + InLoop := false; + while lp <> nil do begin + if lp^.block = blk then begin + lp := nil; + InLoop := true; + end {if} + else + lp := lp^.next; + end; {while} + end; {InLoop} + + + procedure Insert (block: blockPtr); + + { Insert a block into the loop list } + { } + { parameters: } + { block - block to add } + + + procedure AddPredecessors (block: blockPtr; bl: dftptr); + + { add any predecessors to the loop } + { } + { parameters: } + { block - block for which to check for } + { predecessors } + { bl - list of edges to check } + + begin {AddPredecessors} + while bl <> nil do begin + if bl^.dest = block then + Insert(bl^.from); + bl := bl^.next; + end; {while} + end; {AddPredecessors} + + + function InLoop (block: blockPtr; lp: loopPtr): boolean; + + { See if a block is in the loop } + { } + { parameters: } + { block - block to check } + { lp - list of blocks in the loop } + { } + { Returns: True if the block is in the loop, else false } + + begin {InLoop} + InLoop := false; + while lp <> nil do + if lp^.block = block then begin + InLoop := true; + lp := nil; + end {if} + else + lp := lp^.next; + end; {InLoop} + + + begin {Insert} + if not InLoop(block, llp^.loop) then begin + Add(block); + AddPredecessors(block, dft); + AddPredecessors(block, backEdge); + end; {if} + end; {Insert} + + + begin {FindLoops} + loops := nil; + bp := backEdge; {scan the back edges} + while bp <> nil do begin + if MemberDFNList(bp^.dest^.dfn, bp^.from^.dom) then begin + new(llp); {create a new loop list entry} + llp^.next := loops; + loops := llp; + llp^.loop := nil; + Add(bp^.dest); + Insert(bp^.from); + lp := llp^.loop; {reverse the list} + llp^.loop := nil; + while lp <> nil do begin + lp2 := lp; + lp := lp2^.next; + lp2^.next := llp^.loop; + llp^.loop := lp2; + end; {while} + lp := llp^.loop; {mark the exits} + while lp <> nil do begin + op := lp^.block^.code; + while op <> nil do begin + if op^.opcode in [pc_ujp, pc_fjp, pc_tjp, pc_add] then begin + blk := FindDAG(op^.q); + if not InLoop(blk, llp^.loop) then + lp^.exit := true; + if op^.opcode in [pc_fjp,pc_tjp] then + if not InLoop(lp^.block^.next, llp^.loop) then + lp^.exit := true; + end; {if} + op := op^.next; + end; {while} + lp := lp^.next; + end; {while} + end; {if} + bp := bp^.next; + end; {while} + llp := loops; {reverse the loop list} + loops := nil; + while llp <> nil do begin + llp2 := llp; + llp := llp2^.next; + llp2^.next := loops; + loops := llp2; + end; {while} + end; {FindLoops} + + + function MarkInvariants (lp: loopPtr): boolean; + + { Make a pass over the opcodes, marking those that are } + { invariant. } + { } + { parameters: } + { lp - loop to scan } + { } + { Returns: True if any new nodes were marked, else false. } + + var + count: integer; {number of generating blocks} + indirectStores: boolean; {does the loop contain indirect stores or function calls?} + inhibit: boolean; {inhibit stores?} + lp2: loopPtr; {used to trace the loop} + op: icptr; {used to trace the instruction list} + opcode: pcodes; {op^.opcode; for efficiency} + + + procedure Check (op: icptr; olp: loopPtr); + + { See if this node or its children is invariant } + { } + { parameters: } + { op - node to check } + { olp - loop entry for the block containing the store } + + var + invariant: boolean; {are the operands invariant?} + + + function IndirectInhibit (op: icptr): boolean; + + { See if a store should be inhibited due to indirect } + { accesses } + { } + { parameters: } + { op - instruction to check } + { } + { Returns: True if the instruction should be inhibited, } + { else false. } + + begin {IndirectInhibit} + IndirectInhibit := false; + if indirectStores then + if Member(op, c_ind) then + IndirectInhibit := true; + end; {IndirectInhibit} + + + function NoOtherStoresOrUses (lp, olp: loopPtr; op: icptr): boolean; + + { Check for invalid stores } + { } + { parameters: } + { lp - loop to check } + { olp - loop entry for the block containing the store } + { op - store to check } + { } + { Returns: True if the store is valid, false if not. } + { } + { Notes: Specifically, these two rules are inforced: } + { 1. No other stores to the same location appear in the } + { loop. } + { 2. All uses of the value in the loop can be reached } + { only by the assign. } + + var + lp2: loopPtr; {used to trace the loop list} + op2: icptr; {used to trace code list} + + + function SafeLoad (sop, lop: icptr; sbk, lbk: blockPtr): boolean; + + { See if a load is in a safe position } + { } + { parameters: } + { sop - save opcode that may need to be left in loop } + { lop - load operation that may inhibit the save } + { sbk - block containing the save } + { lbk - block containing the load } + + + function First (op1, op2, stream: icptr): icptr; + + { See which operation comes first } + { } + { parmeters: } + { op1, op2 - instructions to check } + { stream - start of block containing the instructions } + { } + { Returns: First operation found, or nil if missing } + + var + op: icptr; {temp opcode} + + begin {First} + if stream = op1 then + First := op1 + else if stream = op2 then + First := op2 + else begin + op := nil; + if stream^.left <> nil then + op := First(op1, op2, stream^.left); + if op = nil then + if stream^.right <> nil then + op := First(op1, op2, stream^.right); + if op = nil then + if stream^.next <> nil then + op := First(op1, op2, stream^.next); + First := op; + end; {else} + end; {First} + + + begin {SafeLoad} + if sbk = lbk then + SafeLoad := First(sop, lop, sbk^.code) = sop + else + SafeLoad := MemberDFNList(sbk^.dfn, lbk^.dom); + end; {SafeLoad} + + + function MatchStores (op, tree: icptr; opbk, treebk: blockPtr): + boolean; + + { Check the tree for stores to the same location as op } + { } + { parameters: } + { op - store to check for } + { tree - operation tree to check } + { opbk - block containing op } + { treebk - block containing tree } + { } + { Returns: True if there are matching stores, else false } + + var + result: boolean; {function result} + + begin {MatchStores} + result := false; + if tree^.opcode in [pc_lli,pc_lil,pc_lld,pc_ldl,pc_str,pc_cop, + pc_sro,pc_cpo,pc_gli,pc_gil,pc_gld,pc_gdl] then begin + if tree <> op then + result := MatchLoc(op, tree); + end {if} + else if tree^.opcode in [pc_ldo,pc_lod] then + if MatchLoc(op, tree) then + result := not SafeLoad(op, tree, opbk, treebk); + if not result then + if tree^.left <> nil then + result := MatchStores(op, tree^.left, opbk, treebk); + if not result then + if tree^.right <> nil then + result := MatchStores(op, tree^.right, opbk, treebk); + MatchStores := result; + end; {MatchStores} + + + begin {NoOtherStoresOrUses} + NoOtherStoresOrUses := true; + lp2 := lp; + while lp2 <> nil do begin + op2 := lp2^.block^.code; + while op2 <> nil do + if MatchStores(op, op2, olp^.block, lp2^.block) then begin + op2 := nil; + lp2 := nil; + NoOtherStoresOrUses := false; + end {if} + else + op2 := op2^.next; + if lp2 <> nil then + lp2 := lp2^.next; + end; {while} + end; {NoOtherStoresOrUses} + + + function NumberOfGens (op: icptr; lp: loopPtr): integer; + + { Count the number of nodes that generate op } + { } + { parameters: } + { op - instruction to check } + { lp - loop to check } + + var + count: integer; {number of generators} + + begin {NumberOfGens} + count := 0; + while lp <> nil do begin + if Member(op, lp^.block^.c_gen) then + count := count+1; + lp := lp^.next; + end; {while} + NumberOfGens := count; + end; {NumberOfGens} + + + function PreviousStore (op, list: icptr): boolean; + + { See if the last save was invariant } + { } + { parameters: } + { op - load operation } + { list - block containing the load } + { } + { Returns: True if the previous store was invariant, else } + { false. } + + var + indop: icptr; {any indirect operation after strop} + strop: icptr; {last matching store before op} + + + procedure Check (lop: icptr); + + { Stop if this is lop; save if it is a matching store } + { } + { parameters: } + { lop - check this operation and it's children } + + begin {Check} + if lop^.left <> nil then + Check(lop^.left); + if list <> nil then + if lop^.right <> nil then + Check(lop^.right); + if list <> nil then + if lop = op then + list := nil + else if (lop^.opcode in [pc_str,pc_cop,pc_str,pc_cop]) + and MatchLoc(op, lop) then begin + strop := lop; + indop := nil; + end {else if} + else if op^.opcode in + [pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild,pc_cup,pc_cui,pc_tl1] + then + indop := op; + end; {Check} + + + function Inhibit (indop, op: icptr): boolean; + + { See if op should be inhibited due to indirect stores } + { } + { parameters: } + { indop - inhibiting indirect store or nil } + { op - instruction to check } + + begin {Inhibit} + Inhibit := false; + if indop <> nil then + if Member(op, c_ind) then + Inhibit := true; + end; {Inhibit} + + + begin {PreviousStore} + indop := nil; + strop := nil; + while list <> nil do begin + Check(list); + if list <> nil then + list := list^.next; + end; {while} + PreviousStore := false; + if strop <> nil then + if strop^.parents <> 0 then + if not Inhibit(indop, op) then + PreviousStore := true; + end; {PreviousStore} + + + begin {Check} + if op^.parents = 0 then begin + invariant := true; + if op^.left <> nil then begin + Check(op^.left, olp); + if op^.left^.parents = 0 then + invariant := false; + end; {if} + if op^.right <> nil then begin + Check(op^.right, olp); + if op^.right^.parents = 0 then + invariant := false; + end; {if} + if invariant then begin + opcode := op^.opcode; + if opcode in + [pc_adi,pc_adl,pc_adr,pc_and,pc_lnd,pc_bnd,pc_bal, + pc_bnt,pc_bnl,pc_bor,pc_blr,pc_bxr,pc_blx,pc_bno, + pc_dec,pc_dvi,pc_udi,pc_dvl,pc_udl,pc_dvr,pc_equ,pc_neq, + pc_grt,pc_les,pc_geq,pc_leq,pc_inc,pc_ind,pc_ior,pc_lor, + pc_ixa,pc_lad,pc_lao,pc_lca,pc_lda,pc_ldc,pc_mod,pc_uim, + pc_mdl,pc_ulm,pc_mpi,pc_umi,pc_mpl,pc_uml,pc_mpr,pc_ngi, + pc_ngl,pc_ngr,pc_not,pc_pop,pc_sbf,pc_sbi,pc_sbl,pc_sbr, + pc_shl,pc_sll,pc_shr,pc_usr,pc_slr,pc_vsr,pc_tri] + then begin + op^.parents := icount; + icount := icount+1; + end {if} + else if opcode = pc_cnv then begin + if op^.q & $000F <> ord(cgVoid) then begin + op^.parents := icount; + icount := icount+1; + end; {if} + end {else if} + else if opcode + in [pc_sro,pc_sto,pc_str,pc_cop,pc_cpo,pc_cpi,pc_cbf] + then begin + if not inhibit then + if not IndirectInhibit(op) then + if NoOtherStoresOrUses(lp, olp, op) then begin + op^.parents := icount; + icount := icount+1; + end; {if} + end {else if} + else if opcode in [pc_ldo,pc_lod] then begin + {invariant if there is an immediately preceeding invariant store} + if PreviousStore(op, lp2^.block^.code) then begin + op^.parents := icount; + icount := icount+1; + end {if} + else if not Member(op, lp2^.block^.c_gen) then begin + {invariant if there are no generators in the loop} + count := NumberOfGens(op, lp); + if count = 0 then begin + op^.parents := icount; + icount := icount+1; + end {if} + else if count = 1 then begin + {invariant if there is one generator AND the generator} + {is not in the current block AND no reaching } + {definitions for the loop AND generating statement is } + {invariant } + if memberOp^.parents <> 0 then + if not Member(op, lp^.block^.c_in) then begin + op^.parents := icount; + icount := icount+1; + end; {if} + end; {else if} + end; {else} + end {else if} + end; {if} + if op^.parents <> 0 then + MarkInvariants := true; + end; {if} + end; {Check} + + + function CheckForIndirectStores (lp: loopPtr): boolean; + + { See if there are any indirect stores or function calls in } + { the loop } + { } + { parameters: } + { lp - loop to check } + { } + { Returns: True if there are indirect stores or function } + { calls, else false. } + + + function CheckOps (op: icptr): boolean; + + { Check this operation list } + { } + { parameters: } + { op - operation list to check } + { } + { Returns: True if an indirect store or function call is } + { found, else false. } + + var + result: boolean; {value to return} + + begin {CheckOps} + result := false; + while op <> nil do begin + if op^.opcode in + [pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild,pc_cup,pc_cui, + pc_tl1,pc_mov] + then begin + result := true; + op := nil; + end {if} + else begin + if op^.left <> nil then + result := CheckOps(op^.left); + if not result then + if op^.right <> nil then + result := CheckOps(op^.right); + if result then + op := nil; + end; {if} + if op <> nil then + op := op^.next; + end; {while} + CheckOps := result; + end; {CheckOps} + + + begin {CheckForIndirectStores} + CheckForIndirectStores := false; + while lp <> nil do + if CheckOps(lp^.block^.code) then begin + CheckForIndirectStores := true; + lp := nil; + end {if} + else + lp := lp^.next; + end; {CheckForIndirectStores} + + + function DominatesExits (dfn: integer; lp: loopPtr): boolean; + + { See if this block dominates all loop exits } + { } + { parameters: } + { dfn - block that must dominate exits } + { lp - loop list } + { } + { Returns: True if the block dominates all exits, else false. } + + var + dom: blockListPtr; {used to trace dominator list} + + begin {DominatesExits} + DominatesExits := true; + while lp <> nil do begin + if lp^.exit then begin + dom := lp^.block^.dom; + while dom <> nil do + if dom^.dfn = dfn then + dom := nil + else begin + dom := dom^.next; + if dom = nil then begin + lp := nil; + DominatesExits := false; + end; {if} + end; {else} + end; {if} + if lp <> nil then + lp := lp^.next; + end; {while} + end; {DominatesExits} + + + begin {MarkInvariants} + MarkInvariants := false; + lp2 := lp; + while lp2 <> nil do begin + inhibit := not DominatesExits(lp2^.block^.dfn, lp); + indirectStores := CheckForIndirectStores(lp); + op := lp2^.block^.code; + while op <> nil do begin + Check(op, lp2); + op := op^.next; + end; {while} + lp2 := lp2^.next; + end; {while} + end; {MarkInvariants} + + + procedure RemoveInvariants (llp: loopListPtr); + + { Remove loop invariant calculations } + { } + { parameters: } + { llp - pointer to the loop entry to process } + + var + icount, oldIcount: integer; {invariant order counters} + nhp: blockPtr; {new loop hedaer pointer} + op1, op2, op3: icptr; {used to reverse the code list} + + + procedure CreateHeader; + + { Create the new loop header } + { } + { Notes: As a side effect, CreateHeader sets nhp to point to } + { the new loop header. } + + var + lp: loopPtr; {new loop list entry} + ohp: blockPtr; {old loop hedaer pointer} + + begin {CreateHeader} + nhp := pointer(Calloc(sizeof(block))); {create the new block} + ohp := llp^.loop^.block; {insert it in the block list} + nhp^.last := ohp^.last; + if nhp^.last <> nil then + nhp^.last^.next := nhp; + nhp^.next := ohp; + ohp^.last := nhp; + new(lp); {add it to the loop list} + lp^.next := llp^.loop; + llp^.loop := lp; + lp^.block := nhp; + lp^.exit := false; + end; {CreateHeader} + + + function FindInvariant (ic: integer): integer; + + { Find the next invariant calculation } + { } + { parameters: } + { ic - base count; the new count must exceed this } + { } + { Returns: count for the invariant record to remove } + + var + lp: loopPtr; {used to trace loop list} + op: icptr; {used to trace code list} + nic: integer; {lowest count > ic} + + + procedure Check (op: icptr); + + { See if op or its children represent a newer invariant } + { calculation than the one numbered nic } + { } + { parameters: } + { op - instruction to check } + { } + { Notes: Rejecting pc_bno here is rather odd, but it allows } + { expressions _containing_ pc_bno to be removed without } + { messing up pc_tri operations by allowing pc_bno to be } + { removed as the top level of an expression. } + + begin {Check} + if op^.parents = 0 then begin + if op^.left <> nil then + Check(op^.left); + if op^.right <> nil then + Check(op^.right); + end {if} + else begin + if op^.parents < nic then + if op^.parents > ic then + if op^.opcode <> pc_bno then + nic := op^.parents; + end; {else} + end; {Check} + + + begin {FindInvariant} + nic := maxint; + lp := llp^.loop; + while (lp <> nil) and (nic <> ic+1) do begin + op := lp^.block^.code; + while op <> nil do begin + Check(op); + op := op^.next; + end; {while} + lp := lp^.next; + end; {while} + FindInvariant := nic; + end; {FindInvariant} + + + procedure RemoveInvariant (ic: integer); + + { Move the invariant calculation to the header } + { } + { parameters: } + { ic - index number for instruction to remove } + + var + done: boolean; {loop termination test} + lp: loopPtr; {used to trace loop list} + op: icptr; {used to trace code list} + + + procedure Check (op: icptr); + + { See if a child of op is the target instruction to move } + { (If so, move it.) } + { } + { parameters: } + { op - instruction to check } + + + procedure Remove (var op: icptr); + + { Move a calculation to the loop header } + { } + { parameters: } + { op - invariant calculation to move } + + var + loc, op2, str: icptr; {new opcodes} + optype: baseTypeEnum; {type of the temp variable} + + begin {Remove} + if (op^.left <> nil) or (op^.right <> nil) then begin + optype := TypeOf(op); {create a temp label} + loc := pointer(Calloc(sizeof(intermediate_code))); + loc^.opcode := dc_loc; + loc^.optype := cgWord; + maxLoc := maxLoc + 1; + loc^.r := maxLoc; + loc^.q := TypeSize(optype); + loc^.next := nhp^.code; + nhp^.code := loc; + {make a copy of the tree} + op2 := pointer(Malloc(sizeof(intermediate_code))); + op2^ := op^; + op^.opcode := pc_lod; {substitute a load of the temp} + op^.optype := optype; + op^.r := loc^.r; + op^.q := 0; + op^.left := nil; + op^.right := nil; + {store the temp result} + str := pointer(Calloc(sizeof(intermediate_code))); + str^.opcode := pc_str; + str^.optype := optype; + str^.r := loc^.r; + str^.q := 0; + str^.left := op2; + str^.next := loc^.next; {insert the store in the basic block} + loc^.next := str; + end; {if} + done := true; + end; {Remove} + + + begin {Check} + if op^.left <> nil then begin + if op^.left^.parents = ic then + Remove(op^.left); + if not done then + Check(op^.left); + end; {if} + if not done then + if op^.right <> nil then begin + if op^.right^.parents = ic then + Remove(op^.right); + if not done then + Check(op^.right); + end; {if} + end; {Check} + + + procedure RemoveTop (var op: icptr); + + { Move a top-level instruction to the header } + { } + { parameters: } + { op - top level instruction to remove } + + var + op2: icptr; {temp operation} + + begin {RemoveTop} + op2 := op; + op := op^.next; + op2^.next := nhp^.code; + nhp^.code := op2; + end; {RemoveTop} + + + begin {RemoveInvariant} + lp := llp^.loop; + done := false; + while not done do begin + op := lp^.block^.code; + if op <> nil then + if op^.parents = ic then begin + RemoveTop(lp^.block^.code); + done := true; + end {if} + else begin + Check(op); + while (op^.next <> nil) and (not done) do begin + if op^.next^.parents = ic then begin + RemoveTop(op^.next); + done := true; + end {if} + else + Check(op^.next); + if op^.next <> nil then + op := op^.next; + end; {while} + end; {else} + lp := lp^.next; + if lp = nil then + done := true; + end; {while} + end; {RemoveInvariant} + + + begin {RemoveInvariants} + CreateHeader; {create a loop header block} + icount := 0; {find & remove all invariants} + repeat + oldIcount := icount; + icount := FindInvariant (icount); + if icount <> maxint then + RemoveInvariant(icount); + until icount = maxint; + op1 := nhp^.code; {reverse the new code list} + op2 := nil; + while op1 <> nil do begin + op3 := op1; + op1 := op1^.next; + op3^.next := op2; + op2 := op3; + end; {while} + nhp^.code := op2; + end; {RemoveInvariants} + + + procedure ZeroParents (lp: loopPtr); + + { Zero the parents field in all nodes } + { } + { parameters: } + { lp - loop for which to zero the parents } + + var + op: icptr; {used to trace the opcode list} + + + procedure Zero (op: icptr); + + { Zero the parents field for this node and its } + { children. } + { } + { parameters: } + { op - node to zero } + + begin {Zero} + op^.parents := 0; + if op^.left <> nil then + Zero(op^.left); + if op^.right <> nil then + Zero(op^.right); + end; {Zero} + + + begin {ZeroParents} + while lp <> nil do begin + op := lp^.block^.code; + while op <> nil do begin + Zero(op); + op := op^.next; + end; {while} + lp := lp^.next; + end; {while} + end; {ZeroParents} + + + begin {LoopInvariantRemoval} + Spin; + FindLoops; {find a list of natural loops} + + llp := loops; {scan the loops...} + icount := 1; + while llp <> nil do begin + Spin; + ZeroParents(llp^.loop); {set the parents field to zero} + while MarkInvariants(llp^.loop) do {mark the loop invariant computations} + ; + if icount <> 1 then + RemoveInvariants(llp); {remove loop invariant calculations} + llp := llp^.next; + end; {while} + + + while loops <> nil do begin {dispose of the loop lists} + while loops^.loop <> nil do begin + lp := loops^.loop; + loops^.loop := lp^.next; + dispose(lp); + end; {while} + llp := loops; + loops := llp^.next; + dispose(llp); + end; {while} + end; {LoopInvariantRemoval} + + +begin {DoLoopOptimization} +DepthFirstOrder; {create the depth first tree} +ReachingDefinitions; {find reaching definitions} +Dominators; {find the lists of dominators} +LoopInvariantRemoval; {remove loop invariant computations} +while dft <> nil do begin {dispose of the depth first tree} + dft2 := dft; + dft := dft2^.next; + dispose(dft2); + end; {while} +while backEdge <> nil do begin {dispose of the back edge list} + dft2 := backEdge; + backEdge := dft2^.next; + dispose(dft2); + end; {while} +end; {DoLoopOptimization} + +{---------------------------------------------------------------} + +procedure DAG {code: icptr}; + +{ place an op code in a DAG or tree } +{ } +{ parameters: } +{ code - opcode } + +var + temp: icptr; {temp node} + + + procedure Generate; + + { generate the code for the current procedure } + + var + op: icptr; {temp opcode pointers} + + + procedure BasicBlocks; + + { Break the code up into basic blocks } + + var + blast: blockPtr; {last block pointer} + bp: blockPtr; {current block pointer} + cb: icptr; {last code in block pointer} + cp: icptr; {current code pointer} + + begin {BasicBlocks} + cp := DAGhead; + DAGblocks := nil; + if cp <> nil then begin + bp := pointer(Calloc(sizeof(block))); + DAGblocks := bp; + blast := bp; + bp^.code := cp; + cb := cp; + cp := cp^.next; + cb^.next := nil; + while cp <> nil do + {labels start a new block} + if cp^.opcode = dc_lab then begin + Spin; + bp := pointer(Calloc(sizeof(block))); + bp^.last := blast; + blast^.next := bp; + blast := bp; + bp^.code := cp; + cb := cp; + cp := cp^.next; + cb^.next := nil; + end {if} + {conditionals are followed by a new block} + else if cp^.opcode in [pc_fjp, pc_tjp, pc_ujp, pc_ret, pc_xjp] then + begin + Spin; + while cp^.next^.opcode = pc_add do begin + cb^.next := cp; + cb := cp; + cp := cp^.next; + cb^.next := nil; + end; {while} + cb^.next := cp; + cb := cp; + cp := cp^.next; + cb^.next := nil; + bp := pointer(Calloc(sizeof(block))); + bp^.last := blast; + blast^.next := bp; + blast := bp; + bp^.code := cp; + cb := cp; + cp := cp^.next; + cb^.next := nil; + end {else if} + else begin {all other statements get added to a block} + cb^.next := cp; + cb := cp; + cp := cp^.next; + cb^.next := nil; + end; {else} + end; {if} + end; {BasicBlocks} + + + begin {Generate} + if peepHole then {peephole optimization} + repeat + rescan := false; + PeepHoleOptimization(DAGhead); + op := DAGHead; + while op^.next <> nil do begin + Spin; + PeepHoleOptimization(op^.next); + op := op^.next; + end; {while} + CheckLabels; + until not rescan; + BasicBlocks; {build the basic blocks} + if commonSubexpression or loopOptimizations then + if not volatile then + FlagIndirectUses; {create a list of all indirect uses} + if commonSubexpression then {common sub-expression removal} + if not volatile then + CommonSubexpressionElimination; + if loopOptimizations then {loop optimizations} + if not volatile then + DoLoopOptimization; +{ if printSymbols then {debug} +{ PrintBlocks(@'DAG: ', DAGblocks); {debug} + if commonSubexpression or loopOptimizations then + if not volatile then + DisposeOpList(c_ind); {dispose of indirect use list} + Gen(DAGblocks); {generate native code} + if loopOptimizations then {dump and dynamic space} + if not volatile then + DumpLoopLists; + DAGhead := nil; {reset the DAG pointers} + end; {Generate} + + + procedure Push (code: icptr); + + { place a node on the operation stack } + { } + { parameters: } + { code - node } + + begin {Push} + code^.next := DAGhead; + DAGhead := code; + end; {Push} + + + function Pop: icptr; + + { pop a node from the operation stack } + { } + { returns: node pointer or nil } + + var + node: icptr; {node poped} + tn: icptr; {temp node} + + begin {Pop} + node := DAGhead; + if node = nil then + Error(cge1) + else begin + DAGhead := node^.next; + node^.next := nil; + end; {else} + if node^.opcode = dc_loc then begin + tn := node; + node := Pop; + Push(tn); + end; {if} + Pop := node; + end; {Pop} + + + procedure Reverse; + + { Reverse the operation stack } + + var + list, temp: icptr; {work pointers} + + begin {Reverse} + list := nil; + while DAGhead <> nil do begin + temp := DAGhead; + DAGhead := temp^.next; + temp^.next := list; + list := temp; + end; {while} + DAGhead := list; + end; {Reverse} + + +begin {DAG} +case code^.opcode of + + pc_bnt, pc_bnl, pc_cnv, pc_dec, pc_inc, pc_ind, pc_lbf, pc_lbu, + pc_ngi, pc_ngl, pc_ngr, pc_not, pc_stk, pc_cop, pc_cpo, pc_tl1, + pc_sro, pc_str, pc_fjp, pc_tjp, pc_xjp, pc_cup, pc_pop, pc_iil, + pc_ili, pc_idl, pc_ild: + begin + code^.left := Pop; + Push(code); + end; + + pc_adi, pc_adl, pc_adr, pc_and, pc_lnd, pc_bnd, pc_bal, pc_bno, + pc_bor, pc_blr, pc_bxr, pc_blx, pc_cbf, pc_cpi, pc_dvi, pc_mov, + pc_udi, pc_dvl, pc_udl, pc_dvr, pc_equ, pc_geq, pc_grt, pc_leq, + pc_les, pc_neq, pc_ior, pc_lor, pc_ixa, pc_mod, pc_uim, pc_mdl, + pc_ulm, pc_mpi, pc_umi, pc_mpl, pc_uml, pc_mpr, pc_psh, pc_sbi, + pc_sbl, pc_sbr, pc_shl, pc_sll, pc_shr, pc_usr, pc_slr, pc_vsr, + pc_tri, pc_sbf, pc_sto, pc_cui: + begin + code^.right := Pop; + code^.left := Pop; + Push(code); + end; + + pc_gil, pc_gli, pc_gdl, pc_gld, pc_lil, pc_lli, pc_ldl, pc_lld, + pc_lad, pc_lao, pc_lca, pc_lda, pc_ldc, pc_ldo, pc_lod, pc_nop, + dc_cns, dc_glb, dc_dst, pc_lnm, pc_nam, pc_nat, dc_lab, pc_add, + pc_ujp, dc_pin, pc_ent, pc_ret, dc_sym: + Push(code); + + pc_cnn: + begin + code^.opcode := pc_cnv; + temp := Pop; + code^.left := Pop; + Push(code); + Push(temp); + end; + + dc_loc: begin + Push(code); + if code^.r > maxLoc then + maxLoc := code^.r; + end; + + dc_prm: begin + Push(code); + if code^.s > maxLoc then + maxLoc := code^.s; + end; + + dc_str: begin + Push(code); + maxLoc := 0; + end; + + dc_enp: begin + Push(code); + Reverse; + Generate; + end; + + otherwise: Error(cge1); {invalid opcode} + end; {case} +end; {DAG} + +end. diff --git a/DAG2.pas b/DAG2.pas old mode 100755 new mode 100644 index a0096b7..3764ef2 --- a/DAG2.pas +++ b/DAG2.pas @@ -1 +1,265 @@ -{$optimize 7} {---------------------------------------------------------------} { } { DAG Creation } { } { Places intermediate codes into DAGs and trees. } { } {---------------------------------------------------------------} unit DAG; interface {$segment 'cg'} {$LibPrefix '0/obj/'} uses CCommon, CGI, CGC, Gen; {---------------------------------------------------------------} procedure DAG (code: icptr); { place an op code in a DAG or tree } { } { parameters: } { code - opcode } {---------------------------------------------------------------} implementation var maxLoc: integer; {max local label number used by compiler} {-- External unsigned math routines; imported from Expression.pas --} function udiv (x,y: longint): longint; extern; function umod (x,y: longint): longint; extern; function umul (x,y: longint): longint; extern; {---------------------------------------------------------------} procedure DAG {code: icptr}; { place an op code in a DAG or tree } { } { parameters: } { code - opcode } var temp: icptr; {temp node} procedure Generate; { generate the code for the current procedure } var op: icptr; {temp opcode pointers} procedure BasicBlocks; { Break the code up into basic blocks } var blast: blockPtr; {last block pointer} bp: blockPtr; {current block pointer} cb: icptr; {last code in block pointer} cp: icptr; {current code pointer} begin {BasicBlocks} cp := DAGhead; DAGblocks := nil; if cp <> nil then begin bp := pointer(Calloc(sizeof(block))); DAGblocks := bp; blast := bp; bp^.code := cp; cb := cp; cp := cp^.next; cb^.next := nil; while cp <> nil do {labels start a new block} if cp^.opcode = dc_lab then begin Spin; bp := pointer(Calloc(sizeof(block))); bp^.last := blast; blast^.next := bp; blast := bp; bp^.code := cp; cb := cp; cp := cp^.next; cb^.next := nil; end {if} {conditionals are followed by a new block} else if cp^.opcode in [pc_fjp, pc_tjp, pc_ujp, pc_ret, pc_xjp] then begin Spin; while cp^.next^.opcode = pc_add do begin cb^.next := cp; cb := cp; cp := cp^.next; cb^.next := nil; end; {while} cb^.next := cp; cb := cp; cp := cp^.next; cb^.next := nil; bp := pointer(Calloc(sizeof(block))); bp^.last := blast; blast^.next := bp; blast := bp; bp^.code := cp; cb := cp; cp := cp^.next; cb^.next := nil; end {else if} else begin {all other statements get added to a block} cb^.next := cp; cb := cp; cp := cp^.next; cb^.next := nil; end; {else} end; {if} end; {BasicBlocks} begin {Generate} BasicBlocks; {build the basic blocks} Gen(DAGblocks); {generate native code} DAGhead := nil; {reset the DAG pointers} end; {Generate} procedure Push (code: icptr); { place a node on the operation stack } { } { parameters: } { code - node } begin {Push} code^.next := DAGhead; DAGhead := code; end; {Push} function Pop: icptr; { pop a node from the operation stack } { } { returns: node pointer or nil } var node: icptr; {node poped} tn: icptr; {temp node} begin {Pop} node := DAGhead; if node = nil then Error(cge1) else begin DAGhead := node^.next; node^.next := nil; end; {else} if node^.opcode = dc_loc then begin tn := node; node := Pop; Push(tn); end; {if} Pop := node; end; {Pop} procedure Reverse; { Reverse the operation stack } var list, temp: icptr; {work pointers} begin {Reverse} list := nil; while DAGhead <> nil do begin temp := DAGhead; DAGhead := temp^.next; temp^.next := list; list := temp; end; {while} DAGhead := list; end; {Reverse} begin {DAG} case code^.opcode of pc_bnt, pc_bnl, pc_cnv, pc_dec, pc_inc, pc_ind, pc_lbf, pc_lbu, pc_ngi, pc_ngl, pc_ngr, pc_not, pc_stk, pc_cop, pc_cpo, pc_tl1, pc_sro, pc_str, pc_fjp, pc_tjp, pc_xjp, pc_cup, pc_pop, pc_iil, pc_ili, pc_idl, pc_ild: begin code^.left := Pop; Push(code); end; pc_adi, pc_adl, pc_adr, pc_and, pc_lnd, pc_bnd, pc_bal, pc_bno, pc_bor, pc_blr, pc_bxr, pc_blx, pc_cbf, pc_cpi, pc_dvi, pc_mov, pc_udi, pc_dvl, pc_udl, pc_dvr, pc_equ, pc_geq, pc_grt, pc_leq, pc_les, pc_neq, pc_ior, pc_lor, pc_ixa, pc_mod, pc_uim, pc_mdl, pc_ulm, pc_mpi, pc_umi, pc_mpl, pc_uml, pc_mpr, pc_psh, pc_sbi, pc_sbl, pc_sbr, pc_shl, pc_sll, pc_shr, pc_usr, pc_slr, pc_vsr, pc_tri, pc_sbf, pc_sto, pc_cui: begin code^.right := Pop; code^.left := Pop; Push(code); end; pc_gil, pc_gli, pc_gdl, pc_gld, pc_lil, pc_lli, pc_ldl, pc_lld, pc_lad, pc_lao, pc_lca, pc_lda, pc_ldc, pc_ldo, pc_lod, pc_nop, dc_cns, dc_glb, dc_dst, pc_lnm, pc_nam, pc_nat, dc_lab, pc_add, pc_ujp, dc_pin, pc_ent, pc_ret, dc_sym: Push(code); pc_cnn: begin code^.opcode := pc_cnv; temp := Pop; code^.left := Pop; Push(code); Push(temp); end; dc_loc: begin Push(code); if code^.r > maxLoc then maxLoc := code^.r; end; dc_prm: begin Push(code); if code^.s > maxLoc then maxLoc := code^.s; end; dc_str: begin Push(code); maxLoc := 0; end; dc_enp: begin Push(code); Reverse; Generate; end; otherwise: Error(cge1); {invalid opcode} end; {case} end; {DAG} end. \ No newline at end of file +{$optimize 7} +{---------------------------------------------------------------} +{ } +{ DAG Creation } +{ } +{ Places intermediate codes into DAGs and trees. } +{ } +{---------------------------------------------------------------} + +unit DAG; + +interface + +{$segment 'cg'} + +{$LibPrefix '0/obj/'} + +uses CCommon, CGI, CGC, Gen; + +{---------------------------------------------------------------} + +procedure DAG (code: icptr); + +{ place an op code in a DAG or tree } +{ } +{ parameters: } +{ code - opcode } + +{---------------------------------------------------------------} + +implementation + +var + maxLoc: integer; {max local label number used by compiler} + +{-- External unsigned math routines; imported from Expression.pas --} + +function udiv (x,y: longint): longint; extern; + +function umod (x,y: longint): longint; extern; + +function umul (x,y: longint): longint; extern; + +{---------------------------------------------------------------} + +procedure DAG {code: icptr}; + +{ place an op code in a DAG or tree } +{ } +{ parameters: } +{ code - opcode } + +var + temp: icptr; {temp node} + + + procedure Generate; + + { generate the code for the current procedure } + + var + op: icptr; {temp opcode pointers} + + + procedure BasicBlocks; + + { Break the code up into basic blocks } + + var + blast: blockPtr; {last block pointer} + bp: blockPtr; {current block pointer} + cb: icptr; {last code in block pointer} + cp: icptr; {current code pointer} + + begin {BasicBlocks} + cp := DAGhead; + DAGblocks := nil; + if cp <> nil then begin + bp := pointer(Calloc(sizeof(block))); + DAGblocks := bp; + blast := bp; + bp^.code := cp; + cb := cp; + cp := cp^.next; + cb^.next := nil; + while cp <> nil do + {labels start a new block} + if cp^.opcode = dc_lab then begin + Spin; + bp := pointer(Calloc(sizeof(block))); + bp^.last := blast; + blast^.next := bp; + blast := bp; + bp^.code := cp; + cb := cp; + cp := cp^.next; + cb^.next := nil; + end {if} + {conditionals are followed by a new block} + else if cp^.opcode in [pc_fjp, pc_tjp, pc_ujp, pc_ret, pc_xjp] then + begin + Spin; + while cp^.next^.opcode = pc_add do begin + cb^.next := cp; + cb := cp; + cp := cp^.next; + cb^.next := nil; + end; {while} + cb^.next := cp; + cb := cp; + cp := cp^.next; + cb^.next := nil; + bp := pointer(Calloc(sizeof(block))); + bp^.last := blast; + blast^.next := bp; + blast := bp; + bp^.code := cp; + cb := cp; + cp := cp^.next; + cb^.next := nil; + end {else if} + else begin {all other statements get added to a block} + cb^.next := cp; + cb := cp; + cp := cp^.next; + cb^.next := nil; + end; {else} + end; {if} + end; {BasicBlocks} + + + begin {Generate} + BasicBlocks; {build the basic blocks} + Gen(DAGblocks); {generate native code} + DAGhead := nil; {reset the DAG pointers} + end; {Generate} + + + procedure Push (code: icptr); + + { place a node on the operation stack } + { } + { parameters: } + { code - node } + + begin {Push} + code^.next := DAGhead; + DAGhead := code; + end; {Push} + + + function Pop: icptr; + + { pop a node from the operation stack } + { } + { returns: node pointer or nil } + + var + node: icptr; {node poped} + tn: icptr; {temp node} + + begin {Pop} + node := DAGhead; + if node = nil then + Error(cge1) + else begin + DAGhead := node^.next; + node^.next := nil; + end; {else} + if node^.opcode = dc_loc then begin + tn := node; + node := Pop; + Push(tn); + end; {if} + Pop := node; + end; {Pop} + + + procedure Reverse; + + { Reverse the operation stack } + + var + list, temp: icptr; {work pointers} + + begin {Reverse} + list := nil; + while DAGhead <> nil do begin + temp := DAGhead; + DAGhead := temp^.next; + temp^.next := list; + list := temp; + end; {while} + DAGhead := list; + end; {Reverse} + + +begin {DAG} +case code^.opcode of + + pc_bnt, pc_bnl, pc_cnv, pc_dec, pc_inc, pc_ind, pc_lbf, pc_lbu, + pc_ngi, pc_ngl, pc_ngr, pc_not, pc_stk, pc_cop, pc_cpo, pc_tl1, + pc_sro, pc_str, pc_fjp, pc_tjp, pc_xjp, pc_cup, pc_pop, pc_iil, + pc_ili, pc_idl, pc_ild: + begin + code^.left := Pop; + Push(code); + end; + + pc_adi, pc_adl, pc_adr, pc_and, pc_lnd, pc_bnd, pc_bal, pc_bno, + pc_bor, pc_blr, pc_bxr, pc_blx, pc_cbf, pc_cpi, pc_dvi, pc_mov, + pc_udi, pc_dvl, pc_udl, pc_dvr, pc_equ, pc_geq, pc_grt, pc_leq, + pc_les, pc_neq, pc_ior, pc_lor, pc_ixa, pc_mod, pc_uim, pc_mdl, + pc_ulm, pc_mpi, pc_umi, pc_mpl, pc_uml, pc_mpr, pc_psh, pc_sbi, + pc_sbl, pc_sbr, pc_shl, pc_sll, pc_shr, pc_usr, pc_slr, pc_vsr, + pc_tri, pc_sbf, pc_sto, pc_cui: + begin + code^.right := Pop; + code^.left := Pop; + Push(code); + end; + + pc_gil, pc_gli, pc_gdl, pc_gld, pc_lil, pc_lli, pc_ldl, pc_lld, + pc_lad, pc_lao, pc_lca, pc_lda, pc_ldc, pc_ldo, pc_lod, pc_nop, + dc_cns, dc_glb, dc_dst, pc_lnm, pc_nam, pc_nat, dc_lab, pc_add, + pc_ujp, dc_pin, pc_ent, pc_ret, dc_sym: + Push(code); + + pc_cnn: + begin + code^.opcode := pc_cnv; + temp := Pop; + code^.left := Pop; + Push(code); + Push(temp); + end; + + dc_loc: begin + Push(code); + if code^.r > maxLoc then + maxLoc := code^.r; + end; + + dc_prm: begin + Push(code); + if code^.s > maxLoc then + maxLoc := code^.s; + end; + + dc_str: begin + Push(code); + maxLoc := 0; + end; + + dc_enp: begin + Push(code); + Reverse; + Generate; + end; + + otherwise: Error(cge1); {invalid opcode} + end; {case} +end; {DAG} + +end. diff --git a/Exp.macros b/Exp.macros old mode 100755 new mode 100644 index 1d5e674..8d451b7 --- a/Exp.macros +++ b/Exp.macros @@ -1 +1,164 @@ - MACRO &lab subroutine &parms,&work &lab anop aif c:&work,.a lclc &work &work setc 0 .a gbla &totallen gbla &worklen &worklen seta &work &totallen seta 0 aif c:&parms=0,.e lclc &len lclc &p lcla &i &i seta c:&parms .b &p setc &parms(&i) &len amid &p,2,1 aif "&len"=":",.c &len amid &p,1,2 &p amid &p,4,l:&p-3 ago .d .c &len amid &p,1,1 &p amid &p,3,l:&p-2 .d &p equ &totallen+3+&work &totallen seta &totallen+&len &i seta &i-1 aif &i,^b .e tsc sec sbc #&work tcs inc a phd tcd mend MACRO &lab return &r &lab anop lclc &len aif c:&r,.a lclc &r &r setc 0 &len setc 0 ago .h .a &len amid &r,2,1 aif "&len"=":",.b &len amid &r,1,2 &r amid &r,4,l:&r-3 ago .c .b &len amid &r,1,1 &r amid &r,3,l:&r-2 .c aif &len<>2,.d ldy &r ago .h .d aif &len<>4,.e ldx &r+2 ldy &r ago .h .e aif &len<>10,.g aif &totallen=0,.f lda &worklen+1 sta &worklen+&totallen+1 lda &worklen sta &worklen+&totallen .f pld tsc clc adc #&worklen+&totallen tcs phb plx ply lda &r+8 pha lda &r+6 pha lda &r+4 pha lda &r+2 pha lda &r pha phy phx plb rtl mexit .g mnote 'Not a valid return length',16 mexit .h aif &totallen=0,.i lda &worklen+1 sta &worklen+&totallen+1 lda &worklen sta &worklen+&totallen .i pld tsc clc adc #&worklen+&totallen tcs aif &len=0,.j tya .j rtl mend MACRO &LAB BGT &BP &LAB BEQ *+4 BGE &BP MEND MACRO &LAB BLE &BP &LAB BLT &BP BEQ &BP MEND MACRO &LAB MOVE4 &F,&T &LAB ~SETM LDA 2+&F STA 2+&T LDA &F STA &T ~RESTM MEND MACRO &LAB ~SETM &LAB ANOP AIF C:&~LA,.B GBLB &~LA GBLB &~LI .B &~LA SETB S:LONGA &~LI SETB S:LONGI AIF S:LONGA.AND.S:LONGI,.A REP #32*(.NOT.&~LA)+16*(.NOT.&~LI) LONGA ON LONGI ON .A MEND MACRO &LAB ~RESTM &LAB ANOP AIF (&~LA+&~LI)=2,.I SEP #32*(.NOT.&~LA)+16*(.NOT.&~LI) AIF &~LA,.H LONGA OFF .H AIF &~LI,.I LONGI OFF .I MEND \ No newline at end of file + MACRO +&lab subroutine &parms,&work +&lab anop + aif c:&work,.a + lclc &work +&work setc 0 +.a + gbla &totallen + gbla &worklen +&worklen seta &work +&totallen seta 0 + aif c:&parms=0,.e + lclc &len + lclc &p + lcla &i +&i seta c:&parms +.b +&p setc &parms(&i) +&len amid &p,2,1 + aif "&len"=":",.c +&len amid &p,1,2 +&p amid &p,4,l:&p-3 + ago .d +.c +&len amid &p,1,1 +&p amid &p,3,l:&p-2 +.d +&p equ &totallen+3+&work +&totallen seta &totallen+&len +&i seta &i-1 + aif &i,^b +.e + tsc + sec + sbc #&work + tcs + inc a + phd + tcd + mend + MACRO +&lab return &r +&lab anop + lclc &len + aif c:&r,.a + lclc &r +&r setc 0 +&len setc 0 + ago .h +.a +&len amid &r,2,1 + aif "&len"=":",.b +&len amid &r,1,2 +&r amid &r,4,l:&r-3 + ago .c +.b +&len amid &r,1,1 +&r amid &r,3,l:&r-2 +.c + aif &len<>2,.d + ldy &r + ago .h +.d + aif &len<>4,.e + ldx &r+2 + ldy &r + ago .h +.e + aif &len<>10,.g + aif &totallen=0,.f + lda &worklen+1 + sta &worklen+&totallen+1 + lda &worklen + sta &worklen+&totallen +.f + pld + tsc + clc + adc #&worklen+&totallen + tcs + phb + plx + ply + lda &r+8 + pha + lda &r+6 + pha + lda &r+4 + pha + lda &r+2 + pha + lda &r + pha + phy + phx + plb + rtl + mexit +.g + mnote 'Not a valid return length',16 + mexit +.h + aif &totallen=0,.i + lda &worklen+1 + sta &worklen+&totallen+1 + lda &worklen + sta &worklen+&totallen +.i + pld + tsc + clc + adc #&worklen+&totallen + tcs + aif &len=0,.j + tya +.j + rtl + mend + MACRO +&LAB BGT &BP +&LAB BEQ *+4 + BGE &BP + MEND + MACRO +&LAB BLE &BP +&LAB BLT &BP + BEQ &BP + MEND + MACRO +&LAB MOVE4 &F,&T +&LAB ~SETM + LDA 2+&F + STA 2+&T + LDA &F + STA &T + ~RESTM + MEND + MACRO +&LAB ~SETM +&LAB ANOP + AIF C:&~LA,.B + GBLB &~LA + GBLB &~LI +.B +&~LA SETB S:LONGA +&~LI SETB S:LONGI + AIF S:LONGA.AND.S:LONGI,.A + REP #32*(.NOT.&~LA)+16*(.NOT.&~LI) + LONGA ON + LONGI ON +.A + MEND + MACRO +&LAB ~RESTM +&LAB ANOP + AIF (&~LA+&~LI)=2,.I + SEP #32*(.NOT.&~LA)+16*(.NOT.&~LI) + AIF &~LA,.H + LONGA OFF +.H + AIF &~LI,.I + LONGI OFF +.I + MEND diff --git a/Expression.asm b/Expression.asm old mode 100755 new mode 100644 index dbf8ed1..a8500aa --- a/Expression.asm +++ b/Expression.asm @@ -1 +1,388 @@ - mcopy exp.macros **************************************************************** * * function lshr(x,y: longint): longint; * * Inputs: * num1 - number to shift * num2 - # bits to shift by * * Outputs: * A - result * **************************************************************** * lshr start subroutine (4:num1,4:num2),0 lda num2+2 if num2 < 0 then bpl lb2 cmp #$FFFF shift left bne zero ldx num2 cpx #-34 blt zero lb1 asl num1 rol num1+2 inx bne lb1 bra lb4 zero stz num1 (result is zero) stz num1+2 bra lb4 lb2 bne zero else shift right ldx num2 beq lb4 cpx #33 bge zero lb3 lsr num1+2 ror num1 dex bne lb3 lb4 lda 0 fix stack and return sta num2 lda 2 sta num2+2 return 4:num1 end **************************************************************** * * function udiv(x,y: longint): longint; * * Inputs: * num1 - numerator * num2 - denominator * * Outputs: * ans - result * **************************************************************** * udiv start ans equ 0 answer rem equ 4 remainder subroutine (4:num1,4:num2),8 ; ; Initialize ; stz rem rem = 0 stz rem+2 move4 num1,ans ans = num1 lda num2 check for division by zero ora num2+2 beq dv9 lda num2+2 do 16 bit divides separately ora ans+2 beq dv5 ; ; 32 bit divide ; ldy #32 32 bits to go dv3 asl ans roll up the next number rol ans+2 rol ans+4 rol ans+6 sec subtract for this digit lda ans+4 sbc num1 tax lda ans+6 sbc num2+2 bcc dv4 branch if minus stx ans+4 turn the bit on sta ans+6 inc ans dv4 dey next bit bne dv3 bra dv9 go do the sign ; ; 16 bit divide ; dv5 lda #0 initialize the remainder ldy #16 16 bits to go dv6 asl ans roll up the next number rol a sec subtract the digit sbc num2 bcs dv7 adc num2 digit is 0 dey bne dv6 bra dv8 dv7 inc ans digit is 1 dey bne dv6 dv8 sta ans+4 save the remainder ; ; Return the result ; dv9 return 4:ans move answer end **************************************************************** * * function uge(x,y: longint): cboolean; * **************************************************************** * uge start result equ 0 subroutine (4:x,4:y),4 stz result stz result+2 lda x+2 cmp y+2 bne lb1 lda x cmp y lb1 blt lb2 dec result dec result+2 lb2 return 2:result end **************************************************************** * * function ugt(x,y: longint): cboolean; * **************************************************************** * ugt start result equ 0 subroutine (4:x,4:y),4 stz result stz result+2 lda x+2 cmp y+2 bne lb1 lda x cmp y lb1 ble lb2 dec result dec result+2 lb2 return 2:result end **************************************************************** * * function ule(x,y: longint): cboolean; * **************************************************************** * ule start result equ 0 subroutine (4:x,4:y),4 stz result stz result+2 lda x+2 cmp y+2 bne lb1 lda x cmp y lb1 bgt lb2 dec result dec result+2 lb2 return 2:result end **************************************************************** * * function ult(x,y: longint): cboolean; * **************************************************************** * ult start result equ 0 subroutine (4:x,4:y),4 stz result stz result+2 lda x+2 cmp y+2 bne lb1 lda x cmp y lb1 bge lb2 dec result dec result+2 lb2 return 2:result end **************************************************************** * * function umod(x,y: longint): longint; * * Inputs: * num1 - numerator * num2 - denominator * * Outputs: * ans+4 - result * **************************************************************** * umod start ans equ 0 answer rem equ 4 remainder subroutine (4:num1,4:num2),8 ; ; Initialize ; stz rem rem = 0 stz rem+2 move4 num1,ans ans = num1 lda num2 check for division by zero ora num2+2 beq dv9 lda num2+2 do 16 bit divides separately ora ans+2 beq dv5 ; ; 32 bit divide ; ldy #32 32 bits to go dv3 asl ans roll up the next number rol ans+2 rol ans+4 rol ans+6 sec subtract for this digit lda ans+4 sbc num1 tax lda ans+6 sbc num2+2 bcc dv4 branch if minus stx ans+4 turn the bit on sta ans+6 inc ans dv4 dey next bit bne dv3 bra dv9 go do the sign ; ; 16 bit divide ; dv5 lda #0 initialize the remainder ldy #16 16 bits to go dv6 asl ans roll up the next number rol a sec subtract the digit sbc num2 bcs dv7 adc num2 digit is 0 dey bne dv6 bra dv8 dv7 inc ans digit is 1 dey bne dv6 dv8 sta ans+4 save the remainder ; ; Return the result ; dv9 return 4:ans+4 move answer end **************************************************************** * * function umul(x,y: longint): longint; * * Inputs: * num2,num1 - operands * * Outputs: * ans - result * **************************************************************** * umul start ans equ 0 answer subroutine (4:num1,4:num2),8 ; ; Initialize the sign and split on precision. ; stz ans+4 set up the multiplier stz ans+6 lda num1 sta ans lda num1+2 sta ans+2 beq ml3 branch if the multiplier is 16 bit ; ; Do a 32 bit by 32 bit multiply. ; ldy #32 32 bit multiply jsr ml1 brl ml7 ml1 lda ans SYSS1*SYSS1+2+SYSS1+2 -> SYSS1,SYSS1+2 lsr a bcc ml2 clc add multiplicand to the partial product lda ans+4 adc num2 sta ans+4 lda ans+6 adc num2+2 sta ans+6 ml2 ror ans+6 shift the interem result ror ans+4 ror ans+2 ror ans dey loop til done bne ml1 rts ; ; Do and 16 bit by 32 bit multiply. ; ml3 lda num2+2 branch if 16x16 is possible beq ml4 ldy #16 set up for 16 bits jsr ml1 do the multiply lda ans+2 move the answer sta ans lda ans+4 sta ans+2 bra ml7 ; ; Do a 16 bit by 16 bit multiply. ; ml4 ldy #16 set the 16 bit counter ldx ans move the low word stx ans+2 ml5 lsr ans+2 test the bit bcc ml6 branch if the bit is off clc adc num2 ml6 ror a shift the answer ror ans dey loop bne ml5 sta ans+2 save the high word ; ; Return the result. ; ml7 return 4:ans fix the stack end \ No newline at end of file + mcopy exp.macros +**************************************************************** +* +* function lshr(x,y: longint): longint; +* +* Inputs: +* num1 - number to shift +* num2 - # bits to shift by +* +* Outputs: +* A - result +* +**************************************************************** +* +lshr start + + subroutine (4:num1,4:num2),0 + + lda num2+2 if num2 < 0 then + bpl lb2 + cmp #$FFFF shift left + bne zero + ldx num2 + cpx #-34 + blt zero +lb1 asl num1 + rol num1+2 + inx + bne lb1 + bra lb4 +zero stz num1 (result is zero) + stz num1+2 + bra lb4 +lb2 bne zero else shift right + ldx num2 + beq lb4 + cpx #33 + bge zero +lb3 lsr num1+2 + ror num1 + dex + bne lb3 + +lb4 lda 0 fix stack and return + sta num2 + lda 2 + sta num2+2 + + return 4:num1 + end + +**************************************************************** +* +* function udiv(x,y: longint): longint; +* +* Inputs: +* num1 - numerator +* num2 - denominator +* +* Outputs: +* ans - result +* +**************************************************************** +* +udiv start +ans equ 0 answer +rem equ 4 remainder + + subroutine (4:num1,4:num2),8 +; +; Initialize +; + stz rem rem = 0 + stz rem+2 + move4 num1,ans ans = num1 + lda num2 check for division by zero + ora num2+2 + beq dv9 + + lda num2+2 do 16 bit divides separately + ora ans+2 + beq dv5 +; +; 32 bit divide +; + ldy #32 32 bits to go +dv3 asl ans roll up the next number + rol ans+2 + rol ans+4 + rol ans+6 + sec subtract for this digit + lda ans+4 + sbc num1 + tax + lda ans+6 + sbc num2+2 + bcc dv4 branch if minus + stx ans+4 turn the bit on + sta ans+6 + inc ans +dv4 dey next bit + bne dv3 + bra dv9 go do the sign +; +; 16 bit divide +; +dv5 lda #0 initialize the remainder + ldy #16 16 bits to go +dv6 asl ans roll up the next number + rol a + sec subtract the digit + sbc num2 + bcs dv7 + adc num2 digit is 0 + dey + bne dv6 + bra dv8 +dv7 inc ans digit is 1 + dey + bne dv6 + +dv8 sta ans+4 save the remainder +; +; Return the result +; +dv9 return 4:ans move answer + end + +**************************************************************** +* +* function uge(x,y: longint): cboolean; +* +**************************************************************** +* +uge start +result equ 0 + + subroutine (4:x,4:y),4 + + stz result + stz result+2 + lda x+2 + cmp y+2 + bne lb1 + lda x + cmp y +lb1 blt lb2 + dec result + dec result+2 + +lb2 return 2:result + end + +**************************************************************** +* +* function ugt(x,y: longint): cboolean; +* +**************************************************************** +* +ugt start +result equ 0 + + subroutine (4:x,4:y),4 + + stz result + stz result+2 + lda x+2 + cmp y+2 + bne lb1 + lda x + cmp y +lb1 ble lb2 + dec result + dec result+2 + +lb2 return 2:result + end + +**************************************************************** +* +* function ule(x,y: longint): cboolean; +* +**************************************************************** +* +ule start +result equ 0 + + subroutine (4:x,4:y),4 + + stz result + stz result+2 + lda x+2 + cmp y+2 + bne lb1 + lda x + cmp y +lb1 bgt lb2 + dec result + dec result+2 + +lb2 return 2:result + end + +**************************************************************** +* +* function ult(x,y: longint): cboolean; +* +**************************************************************** +* +ult start +result equ 0 + + subroutine (4:x,4:y),4 + + stz result + stz result+2 + lda x+2 + cmp y+2 + bne lb1 + lda x + cmp y +lb1 bge lb2 + dec result + dec result+2 + +lb2 return 2:result + end + +**************************************************************** +* +* function umod(x,y: longint): longint; +* +* Inputs: +* num1 - numerator +* num2 - denominator +* +* Outputs: +* ans+4 - result +* +**************************************************************** +* +umod start +ans equ 0 answer +rem equ 4 remainder + + subroutine (4:num1,4:num2),8 +; +; Initialize +; + stz rem rem = 0 + stz rem+2 + move4 num1,ans ans = num1 + lda num2 check for division by zero + ora num2+2 + beq dv9 + + lda num2+2 do 16 bit divides separately + ora ans+2 + beq dv5 +; +; 32 bit divide +; + ldy #32 32 bits to go +dv3 asl ans roll up the next number + rol ans+2 + rol ans+4 + rol ans+6 + sec subtract for this digit + lda ans+4 + sbc num1 + tax + lda ans+6 + sbc num2+2 + bcc dv4 branch if minus + stx ans+4 turn the bit on + sta ans+6 + inc ans +dv4 dey next bit + bne dv3 + bra dv9 go do the sign +; +; 16 bit divide +; +dv5 lda #0 initialize the remainder + ldy #16 16 bits to go +dv6 asl ans roll up the next number + rol a + sec subtract the digit + sbc num2 + bcs dv7 + adc num2 digit is 0 + dey + bne dv6 + bra dv8 +dv7 inc ans digit is 1 + dey + bne dv6 + +dv8 sta ans+4 save the remainder +; +; Return the result +; +dv9 return 4:ans+4 move answer + end + +**************************************************************** +* +* function umul(x,y: longint): longint; +* +* Inputs: +* num2,num1 - operands +* +* Outputs: +* ans - result +* +**************************************************************** +* +umul start +ans equ 0 answer + + subroutine (4:num1,4:num2),8 +; +; Initialize the sign and split on precision. +; + stz ans+4 set up the multiplier + stz ans+6 + lda num1 + sta ans + lda num1+2 + sta ans+2 + beq ml3 branch if the multiplier is 16 bit +; +; Do a 32 bit by 32 bit multiply. +; + ldy #32 32 bit multiply + jsr ml1 + brl ml7 + +ml1 lda ans SYSS1*SYSS1+2+SYSS1+2 -> SYSS1,SYSS1+2 + lsr a + bcc ml2 + clc add multiplicand to the partial product + lda ans+4 + adc num2 + sta ans+4 + lda ans+6 + adc num2+2 + sta ans+6 +ml2 ror ans+6 shift the interem result + ror ans+4 + ror ans+2 + ror ans + dey loop til done + bne ml1 + rts +; +; Do and 16 bit by 32 bit multiply. +; +ml3 lda num2+2 branch if 16x16 is possible + beq ml4 + + ldy #16 set up for 16 bits + jsr ml1 do the multiply + lda ans+2 move the answer + sta ans + lda ans+4 + sta ans+2 + bra ml7 +; +; Do a 16 bit by 16 bit multiply. +; +ml4 ldy #16 set the 16 bit counter + ldx ans move the low word + stx ans+2 +ml5 lsr ans+2 test the bit + bcc ml6 branch if the bit is off + clc + adc num2 +ml6 ror a shift the answer + ror ans + dey loop + bne ml5 + sta ans+2 save the high word +; +; Return the result. +; +ml7 return 4:ans fix the stack + end diff --git a/Expression.pas b/Expression.pas old mode 100755 new mode 100644 index 1970ff8..86b3581 --- a/Expression.pas +++ b/Expression.pas @@ -1 +1,3726 @@ -{$optimize 1} {---------------------------------------------------------------} { } { Expression } { } { Evaluate expressions } { } { Note: The expression evaluator uses the scanner to fetch } { tokens, but IT IS ALSO USED BY THE SCANNER to evaluate } { expressions in preprocessor commands. This circular } { dependency is handle by defining all of the expression } { evaluator's external types, constants, and variables in the } { CCOMMON module. The only procedure from this module used by } { the scanner is Expression, which is declared as an external } { procedure in the scanner. } { } { External Variables: } { } { startExpression - tokens that may start an expression } { bitDisp,bitSize - bit field disp, size } { unsigned - is the bit field unsigned? } { isBitField - is the field a bit field? } { } { External Subroutines: } { } { AssignmentConversion - do type checking and conversions for } { assignment statements } { CompareToZero - Compare the result on tos to zero. } { DisposeTree - dispose of an expression tree } { DoSelection - Find the displacement & type for a } { selection operation } { Expression - handle an expression } { FreeTemp - place a temporary label in the available label } { list } { GenerateCode - generate code from a fully formed expression } { tree } { GetTemp - find a temporary work variable } { InitExpression - initlialize the expression handler } { UsualBinaryConversions - performs the usual binary } { conversions } { UsualUnaryConversions - performs the usual unary conversions } { } {---------------------------------------------------------------} unit Expression; {$LibPrefix '0/obj/'} interface uses CCommon, Table, CGI, Scanner, Symbol, MM; {$segment 'exp'} var startExpression: tokenSet; {tokens that can start an expression} {set by DoSelection} {------------------} bitDisp,bitSize: integer; {bit field disp, size} unsigned: boolean; {is the bit field unsigned?} isBitField: boolean; {is the field a bit field?} {misc} {----} lastwasconst: boolean; {did the last GenerateCode result in an integer constant?} lastconst: longint; {last integer constant from GenerateCode} {---------------------------------------------------------------} procedure AssignmentConversion (t1, t2: typePtr; isConstant: boolean; value: longint; genCode, checkConst: boolean); { TOS is of type t2, and is about to be stored to a variable of } { type t1 by an assignment or a return statement. Make sure } { this is legal, and do any necessary type conversions on t2, } { which is on the top of the evaluation stack. Flag an error } { if the conversion is illegal. } { } { parameters: } { t1 - type of the variable } { t2 - type of the expression } { isConstant - is the rhs a constant? } { value - if isConstant = true, then this is the value } { genCode - should conversion code be generated? } { checkConst - check for assignments to constants? } procedure CompareToZero(op: pcodes); { Compare the result on tos to zero. } { } { This procedure is used by the logical statements to compare } { _any_ scalar result to zero, giving a boolean result. } { } { parameters: } { op - operation to use on the compare } procedure DisposeTree (tree: tokenPtr); { dispose of an expression tree } { } { parameters: } { tree - head of the expression tree to dispose of } procedure DoSelection (lType: typePtr; tree: tokenPtr; var size: longint); { Find the displacement & type for a selection operation } { } { parameters: } { lType - structure/union type } { id - tag field name } { size - disp into the structure/union } { } { returned in non-local variables: } { bitDisp - displacement to bit field } { bitSize - size of bit field } { unsigned - is the bit field unsigned? } { isBitField - is the field a bit field? } { } { varaibles: } { expressionType - set to the type of the field } procedure Expression (kind: expressionKind; stopSym: tokenSet); { handle an expression } { } { parameters: } { kind - Kind of expression; determines what operations } { and what kind of operands are allowed. } { stopSym - Set of symbols that can mark the end of an } { expression; used to skip tokens after syntax } { errors and to block certain operations. For } { example, the comma operator is not allowed in } { an expression when evaluating a function } { parameter list. } { } { variables: } { realExpressionValue - value of a real constant } { expression } { expressionValue - value of a constant expression } { expressionType - type of the constant expression } procedure FreeTemp(labelNum, size: integer); { place a temporary label in the available label list } { } { parameters: } { labelNum - number of the label to free } { size - size of the variable } { } { variables: } { tempList - list of free labels } procedure GenerateCode (tree: tokenPtr); { generate code from a fully formed expression tree } { } { parameters: } { tree - top of the expression tree to generate code from } { } { variables: } { expressionType - result type of the expression } function GetTemp(size: integer): integer; { find a temporary work variable } { } { parameters: } { size - size of the variable } { } { variables: } { tempList - list of free labels } { } { Returns the label number. } procedure InitExpression; { initialize the expression handler } function UsualBinaryConversions (lType: typePtr): baseTypeEnum; { performs the usual binary conversions } { } { inputs: } { lType - type of the left operand } { expressionType - type of the right operand } { } { result: } { The base type of the operation to perform is } { returned. Any conversion code necessary has been } { generated. } { } { outputs: } { expressionType - set to result type } function UsualUnaryConversions: baseTypeEnum; { performs the usual unary conversions } { } { inputs: } { expressionType - type of the operand } { } { result: } { The base type of the operation to perform is returned. } { Any conversion code necessary has been generated. } { } { outputs: } { expressionType - set to result type } {---------------------------------------------------------------} implementation const {notAnOperation is also used in TABLE.ASM} notAnOperation = 200; {used as the icp for non-operation tokens} var {structured constants} {--------------------} startTerm: tokenSet; {tokens that can start a term} {misc} {----} errorFound: boolean; {was there are error during generation?} {-- Procedures imported from the parser ------------------------} procedure Match (kind: tokenEnum; err: integer); extern; { insure that the next token is of the specified type } { } { parameters: } { kind - expected token kind } { err - error number if the expected token is not found } procedure TypeSpecifier (doingFieldList,isConstant: boolean); extern; { handle a type specifier } { } { parameters: } { doingFieldList - are we processing a field list? } { isConstant - did we already find a constsy? } {-- External unsigned math routines ----------------------------} function lshr (x,y: longint): longint; extern; function udiv (x,y: longint): longint; extern; function uge (x,y: longint): longint; extern; function ugt (x,y: longint): longint; extern; function ule (x,y: longint): longint; extern; function ult (x,y: longint): longint; extern; function umod (x,y: longint): longint; extern; function umul (x,y: longint): longint; extern; {---------------------------------------------------------------} function Unary(tp: baseTypeEnum): baseTypeEnum; { usual unary conversions } { } { This function returns the base type actually loaded on the } { stack for a particular data type. This corresponds to C's } { usual unary conversions. } { } { parameter: } { tp - data type } { } { result: } { Stack type. } begin {Unary} if tp in [cgByte,cgUByte,cgReal,cgDouble,cgComp] then if tp = cgByte then tp := cgWord else if tp = cgUByte then tp := cgUWord else {if tp in [cgReal,cgDouble,cgComp] then} tp := cgExtended; Unary := tp; end; {Unary} function UsualBinaryConversions {lType: typePtr): baseTypeEnum}; { performs the usual binary conversions } { } { inputs: } { lType - type of the left operand } { expressionType - type of the right operand } { } { result: } { The base type of the operation to perform is } { returned. Any conversion code necessary has been } { generated. } { } { outputs: } { expressionType - set to result type } var rType: typePtr; {right type} lt,rt: baseTypeEnum; {work variables} begin {UsualBinaryConversions} UsualBinaryConversions := cgULong; if lType^.kind = pointerType then lType := uLongPtr else if lType^.kind = scalarType then if lType^.baseType = cgVoid then lType := uLongPtr; rType := expressionType; if rType^.kind = pointerType then rType := uLongPtr else if rType^.kind = scalarType then if rType^.baseType = cgVoid then rType := uLongPtr; if (lType^.kind = scalarType) and (rType^.kind = scalarType) then begin lt := Unary(lType^.baseType); rt := Unary(rType^.baseType); if lt <> rt then begin if lt = cgExtended then begin if rt in [cgWord,cgUWord,cgLong,cgULong] then Gen2(pc_cnv, ord(rt), ord(cgExtended)); UsualBinaryConversions := cgExtended; expressionType := extendedPtr; end {if} else if rt = cgExtended then begin if lt in [cgWord,cgUWord,cgLong,cgULong] then Gen2(pc_cnn, ord(lt), ord(cgExtended)); UsualBinaryConversions := cgExtended; expressionType := extendedPtr; end {else if} else if lt = cgULong then begin if rt in [cgWord,cgUWord] then Gen2(pc_cnv, ord(rt), ord(cgULong)); UsualBinaryConversions := cgULong; expressionType := uLongPtr; end {else if} else if rt = cgULong then begin if lt in [cgWord,cgUWord] then Gen2(pc_cnn, ord(lt), ord(cgULong)); UsualBinaryConversions := cgULong; expressionType := uLongPtr; end {else if} else if lt = cgLong then begin if rt in [cgWord,cgUWord] then Gen2(pc_cnv, ord(rt), ord(cgLong)); UsualBinaryConversions := cgLong; expressionType := longPtr; end {else if} else if rt = cgLong then begin if lt in [cgWord,cgUWord] then Gen2(pc_cnn, ord(lt), ord(cgLong)); UsualBinaryConversions := cgLong; expressionType := longPtr; end {else if} else {one operand is unsigned in and the other is int} begin UsualBinaryConversions := cgUWord; expressionType := uWordPtr; end; {else} end {if} else {types are the same} UsualBinaryConversions := lt; end {if} else Error(66); end; {UsualBinaryConversions} function UsualUnaryConversions{: baseTypeEnum}; { performs the usual unary conversions } { } { inputs: } { expressionType - type of the operand } { } { result: } { The base type of the operation to perform is returned. } { Any conversion code necessary has been generated. } { } { outputs: } { expressionType - set to result type } var lt,rt: baseTypeEnum; {work variables} begin {UsualUnaryConversions} UsualUnaryConversions := cgULong; if expressionType^.kind = scalarType then UsualUnaryConversions := Unary(expressionType^.baseType) {else if expressionType^.kind in [arrayType,pointerType] then UsualUnaryConversions := cgULong}; end; {UsualUnaryConversions} procedure DisposeTree {tree: tokenPtr}; { dispose of an expression tree } { } { parameters: } { tree - head of the expression tree to dispose of } begin {DisposeTree} if tree <> nil then begin DisposeTree(tree^.left); DisposeTree(tree^.middle); DisposeTree(tree^.right); dispose(tree); end; {if} end; {DisposeTree} procedure AssignmentConversion {t1, t2: typePtr; isConstant: boolean; value: longint; genCode, checkConst: boolean}; { TOS is of type t2, and is about to be stored to a variable of } { type t1 by an assignment or a return statement. Make sure } { this is legal, and do any necessary type conversions on t2, } { which is on the top of the evaluation stack. Flag an error } { if the conversion is illegal. } { } { parameters: } { t1 - type of the variable } { t2 - type of the expression } { isConstant - is the rhs a constant? } { value - if isConstant = true, then this is the value } { genCode - should conversion code be generated? } { checkConst - check for assignments to constants? } var baseType1,baseType2: baseTypeEnum; {temp variables (for speed)} kind1,kind2: typeKind; {temp variables (for speed)} begin {AssignmentConversion} kind1 := t1^.kind; kind2 := t2^.kind; if t1^.isConstant then if genCode then if checkConst then Error(93); if kind2 = definedType then AssignmentConversion(t1, t2^.dType, false, 0, genCode, checkConst) else if kind1 = definedType then AssignmentConversion(t1^.dType, t2, false, 0, genCode, checkConst) else if kind2 in [scalarType,pointerType,enumType,structType,unionType,arrayType,functionType] then case kind1 of scalarType: begin baseType1 := t1^.baseType; if baseType1 = cgString then Error(64) else if baseType1 = cgVoid then Error(65) else if kind2 = enumType then begin if genCode then Gen2(pc_cnv, ord(cgWord), ord(baseType1)); end {else if} else if kind2 = scalarType then begin baseType2 := t2^.baseType; if baseType2 in [cgString,cgVoid] then Error(47) else if genCode then Gen2(pc_cnv, ord(baseType2), ord(baseType1)); end {else if} else Error(47); end; arrayType: ; {any errors are handled elsewhere} functionType,enumConst: Error(47); pointerType: begin if kind2 = pointerType then begin if not CompTypes(t1, t2) then Error(47); end {if} else if kind2 = arrayType then begin if not CompTypes(t1^.ptype, t2^.atype) then if t1^.ptype^.baseType <> cgVoid then Error(47); end {if} else if kind2 = scalarType then begin if isConstant and (value = 0) then begin if genCode then Gen2(pc_cnv, ord(t2^.baseType), ord(cgULong)); end {if} else Error(47); end {else if} else Error(47); end; enumType: begin if kind2 = scalarType then begin baseType2 := t2^.baseType; if baseType2 in [cgString,cgVoid] then Error(47) else if genCode then Gen2(pc_cnv, ord(baseType2), ord(cgWord)); end {if} else if kind2 <> enumType then Error(47); end; definedType: AssignmentConversion(t1^.dType, t2, isConstant, value, genCode, checkConst); structType,unionType: if not CompTypes(t1, t2) then Error(47); otherwise: Error(57); end; {case T1^.kind} expressionType := t1; {set the type of the expression} end; {AssignmentConversion} function ExpressionTree (kind: expressionKind; stopSym: tokenSet): tokenPtr; { generate an expression tree } { } { Returns a pointer to the generated tree. The pointer is } { nil, and the variable errorFound is set to true, if an } { error is found. } { } { parameters: } { kind - Kind of expression; determines what operations } { and what kind of operands are allowed. } { stopSym - Set of symbols that can mark the end of an } { expression; used to skip tokens after syntax } { errors and to block certain operations. For } { example, the comma operator is not allowed in } { an expression when evaluating a function } { parameter list. } label 1,2; var done,done2: boolean; {for loop termination} doingSizeof: boolean; {used to test for a sizeof operator} expectingTerm: boolean; {should the next token be a term?} opStack: tokenPtr; {operation stack} parenCount: integer; {# of open parenthesis} stack: tokenPtr; {operand stack} op,sp: tokenPtr; {work pointers} procedure ComplexTerm; { handle complex terms } var done: boolean; {for loop termination} namePtr: stringPtr; {name of struct/union fields} sp,tp,tm: tokenPtr; {work pointers} begin {ComplexTerm} while token.kind in [lbrackch,lparench,dotch,minusgtop,plusplusop,minusminusop] do begin case token.kind of lbrackch: begin {subscripting} NextToken; {skip the '['} new(sp); {evaluate the subscript} sp^.token.kind := plusch; sp^.token.class := reservedSymbol; sp^.left := stack; stack := stack^.next; sp^.middle := nil; sp^.right := ExpressionTree(normalExpression, [rbrackch]); sp^.next := stack; stack := sp; Match(rbrackch,24); {skip the ']'} new(sp); {resolve the pointer} sp^.token.kind := uasterisk; sp^.token.class := reservedSymbol; sp^.left := stack; sp^.middle := nil; sp^.right := nil; sp^.next := stack^.next; stack := sp; end; lparench: begin {function call} NextToken; new(sp); {create a parameter list terminator} sp^.token.kind := parameteroper; sp^.token.class := reservedSymbol; sp^.left := nil; sp^.middle := nil; sp^.right := nil; sp^.next := stack; stack := sp; if token.kind <> rparench {evaluate the parameters} then begin done := false; repeat if token.kind in [rparench,eofsy] then begin done := true; Error(35); end {if} else begin new(sp); sp^.token.kind := parameteroper; sp^.token.class := reservedSymbol; sp^.left := nil; sp^.middle := ExpressionTree(normalExpression, [rparench,commach]); sp^.right := stack; sp^.next := stack^.next; stack := sp; if token.kind = commach then NextToken else done := true; end; {else} until done; end; {if} sp := stack; stack := sp^.next; sp^.left := stack; sp^.next := stack^.next; stack := sp; Match(rparench,12); end; dotch,minusgtop: begin {direct and indirect selection} if token.kind = minusgtop then begin new(sp); {e->name == (*e).name} sp^.token.kind := uasterisk; sp^.token.class := reservedSymbol; sp^.left := stack; sp^.middle := nil; sp^.right := nil; sp^.next := stack^.next; stack := sp; token.kind := dotch; token.class := reservedSymbol; end; {if} new(sp); {create a record for the selection operator} sp^.token := token; sp^.left := stack; stack := stack^.next; sp^.middle := nil; sp^.right := nil; sp^.next := stack; stack := sp; NextToken; {skip the operator} if token.kind in [ident,typedef] then begin namePtr := token.name; {record the name} new(sp); {record the selection field} sp^.token := token; sp^.left := nil; sp^.middle := nil; sp^.right := nil; stack^.right := sp; {this becomes the right opnd} NextToken; {skip the field name} end {if} else Error(9); end; plusplusop: begin {postfix ++} NextToken; new(sp); sp^.token.kind := opplusplus; sp^.token.class := reservedSymbol; sp^.left := stack; stack := stack^.next; sp^.middle := nil; sp^.right := nil; sp^.next := stack; stack := sp; end; minusminusop: begin {postfix --} NextToken; new(sp); sp^.token.kind := opminusminus; sp^.token.class := reservedSymbol; sp^.left := stack; stack := stack^.next; sp^.middle := nil; sp^.right := nil; sp^.next := stack; stack := sp; end; otherwise: Error(57); end; {case} end; {while} end; {ComplexTerm} procedure DoOperand; { process an operand } label 1,2; var fnPtr: typePtr; {for defining functions on the fly} fToken: tokenType; {used to save function name token} id: identPtr; {pointer to an id's symbol table entry} np: stringPtr; {for forming global names} sp: tokenPtr; {work pointer} begin {DoOperand} {create an operand on the stack} new(sp); sp^.token := token; sp^.next := stack; sp^.left := nil; sp^.middle := nil; sp^.right := nil; stack := sp; {handle the preprocessor 'defined' function} if kind = preprocessorExpression then if token.name^ = 'defined' then begin expandMacros := false; NextToken; sp^.token.kind := intconst; sp^.token.class := intConstant; if token.kind in [ident,typedef] then begin sp^.token.ival := ord(IsDefined(token.name)); NextToken; end {if} else begin Match(lparench, 13); if token.kind in [ident,typedef] then begin sp^.token.ival := ord(IsDefined(token.name)); NextToken; end {if} else begin Error(9); sp^.token.ival := 0; end; {else} Match(rparench, 12); end; {else} expandMacros := true; goto 1; end; {if} {check for illegal use} id := FindSymbol(token, variableSpace, false, true); if not (kind in [normalExpression,initializerExpression,autoInitializerExpression]) then begin if id <> nil then if id^.itype^.kind = enumConst then goto 2; if kind <> preprocessorExpression then begin op := opStack; while op <> nil do begin if op^.token.kind = sizeofsy then goto 2; op := op^.next; end; {while} Error(41); errorFound := true; end; {if} end; {if} 2: {skip the name} fToken := token; NextToken; {if the id is not declared, create a function returning integer} if id = nil then begin if token.kind = lparench then begin fnPtr := pointer(GCalloc(sizeof(typeRecord))); {fnPtr^.size := 0;} {fnPtr^.saveDisp := 0;} {fnPtr^.isConstant := false;} fnPtr^.kind := functionType; fnPtr^.fType := wordPtr; {fnPtr^.varargs := false;} {fnPtr^.prototyped := false;} {fnPtr^.overrideKR := false;} {fnPtr^.parameterList := nil;} {fnPtr^.isPascal := false;} {fnPtr^.toolNum := 0;} {fnPtr^.dispatcher := 0;} np := pointer(GMalloc(length(fToken.name^)+1)); CopyString(pointer(np), pointer(fToken.name)); id := NewSymbol(np, fnPtr, ident, variableSpace, declared); if (lint & lintUndefFn) <> 0 then Error(51); end {if} else if kind = preprocessorExpression then begin stack^.token.kind := intconst; stack^.token.ival := 0; end {else if} else begin Error(31); errorFound := true; end; {else} end {if id = nill} else if id^.itype^.kind = enumConst then begin stack^.token.kind := intconst; stack^.token.ival := id^.itype^.eval; end; {else if} stack^.id := id; {save the identifier} ComplexTerm; {handle subscripts, selection, etc.} 1: end; {DoOperand} procedure Operation; { do an operation } label 1; var baseType: baseTypeEnum; {base type of value to cast} class: tokenClass; {class of cast token} ekind: tokenEnum; {kind of constant expression} kindLeft, kindRight: tokenEnum; {kinds of operands} lCodeGeneration: boolean; {local copy of codeGeneration} op: tokenPtr; {work pointer} op1,op2: longint; {for evaluating constant expressions} rop1,rop2: double; {for evaluating double expressions} tp: typePtr; {cast type} unsigned, unsigned1: boolean; {is the term unsigned?} function Pop: tokenPtr; { pop an operand, returning its pointer } begin {Pop} if stack = nil then begin Error(36); errorFound := true; Pop := nil; end {if} else begin Pop := stack; stack := stack^.next; end; {else} end; {Pop} function RealVal (token: tokenType): double; { convert an operand to a real value } begin {RealVal} if token.kind = intconst then RealVal := token.ival else if token.kind = uintconst then begin if token.ival < 0 then RealVal := (token.ival & $7FFF) + 32768.0 else RealVal := token.ival; end {else if} else if token.kind = longconst then RealVal := token.lval else if token.kind = ulongconst then begin if token.lval < 0 then RealVal := (token.lval & $7FFFFFFF) + 2147483648.0 else RealVal := token.lval; end {else if} else RealVal := token.rval; end; {RealVal} function IntVal (token: tokenType): longint; { convert an operand to a longint value } begin {IntVal} if token.kind = intconst then IntVal := token.ival else if token.kind = uintconst then begin IntVal := token.ival & $0000FFFF; unsigned := true; end {else if} else if token.kind = longconst then begin IntVal := token.lval; ekind := longconst; end {else if} else begin IntVal := token.lval; ekind := longconst; unsigned := true; end; {else} end; {IntVal} begin {Operation} op := opStack; {pop the operation} opStack := op^.next; case op^.token.kind of commach: begin {,} op^.right := Pop; op^.left := Pop; end; eqch, {=} pluseqop, {+=} minuseqop, {-=} asteriskeqop, {*=} slasheqop, {/=} percenteqop, {%=} ltlteqop, {<<=} gtgteqop, {>>=} andeqop, {&=} caroteqop, {^=} bareqop: begin {|=} op^.right := Pop; op^.left := Pop; end; colonch: begin {? :} op^.right := Pop; op^.middle := Pop; op^.left := Pop; if op^.right^.token.kind in [intconst,uintconst,longconst,ulongconst] then if op^.left^.token.kind in [intconst,uintconst,longconst,ulongconst] then if op^.middle^.token.kind in [intconst,uintconst,longconst,ulongconst] then begin if IntVal(op^.left^.token) <> 0 then op^.token := op^.middle^.token else op^.token := op^.right^.token; dispose(op^.left); dispose(op^.right); dispose(op^.middle); op^.left := nil; op^.right := nil; op^.middle := nil; end; {if} end; questionch: begin {error -> ? should not be unmatched} Error(29); errorFound := true; end; barbarop, {||} andandop, {&&} carotch, {^} barch, {|} andch, {&} eqeqop, {==} exceqop, {!=} ltch, {<} gtch, {>} lteqop, {<=} gteqop, {>=} ltltop, {<<} gtgtop, {>>} plusch, {+} minusch, {-} asteriskch, {*} slashch, {/} percentch: begin {%} op^.right := Pop; op^.left := Pop; kindRight := op^.right^.token.kind; kindLeft := op^.left^.token.kind; if kindRight in [intconst,uintconst,longconst,ulongconst] then begin if kindLeft in [intconst,uintconst,longconst,ulongconst] then begin {do the usual binary conversions} if (kindRight = ulongconst) or (kindLeft = ulongconst) then ekind := ulongconst else if (kindRight = longconst) or (kindLeft = longconst) then ekind := longconst else if (kindRight = uintconst) or (kindLeft = uintconst) then ekind := uintconst else ekind := intconst; {evaluate a constant operation} unsigned := false; op1 := IntVal(op^.left^.token); unsigned1 := unsigned; unsigned := false; op2 := IntVal(op^.right^.token); unsigned := unsigned or unsigned1; dispose(op^.right); op^.right := nil; dispose(op^.left); op^.left := nil; case op^.token.kind of barbarop : {||} op1 := ord((op1 <> 0) or (op2 <> 0)); andandop : {&&} op1 := ord((op1 <> 0) and (op2 <> 0)); carotch : op1 := op1 ! op2; {^} barch : op1 := op1 | op2; {|} andch : op1 := op1 & op2; {&} eqeqop : begin {==} op1 := ord(op1 = op2); ekind := intconst; end; exceqop : begin {!=} op1 := ord(op1 <> op2); ekind := intconst; end; ltch : begin {<} if unsigned then op1 := ult(op1,op2) else op1 := ord(op1 < op2); ekind := intconst; end; gtch : begin {>} if unsigned then op1 := ugt(op1,op2) else op1 := ord(op1 > op2); ekind := intconst; end; lteqop : begin {<=} if unsigned then op1 := ule(op1,op2) else op1 := ord(op1 <= op2); ekind := intconst; end; gteqop : begin {>=} if unsigned then op1 := uge(op1,op2) else op1 := ord(op1 >= op2); ekind := intconst; end; ltltop : op1 := op1 << op2; {<<} gtgtop : if unsigned1 then {>>} op1 := lshr(op1,op2) else op1 := op1 >> op2; plusch : op1 := op1 + op2; {+} minusch : op1 := op1 - op2; {-} asteriskch : if unsigned then {*} op1 := umul(op1,op2) else op1 := op1 * op2; slashch : begin {/} if op2 = 0 then begin Error(109); op2 := 1; end; {if} if unsigned then op1 := udiv(op1,op2) else op1 := op1 div op2; end; percentch : begin {%} if op2 <= 0 then begin Error(109); op2 := 1; end; {if} if unsigned then op1 := umod(op1,op2) else op1 := op1 mod op2; end; otherwise: Error(57); end; {case} op^.token.kind := ekind; if ekind in [longconst,ulongconst] then begin op^.token.lval := op1; op^.token.class := longConstant; end {if} else begin op^.token.ival := long(op1).lsw; op^.token.class := intConstant; end; {else} goto 1; end; {if} end; {if} if op^.right^.token.kind in [intconst,uintconst,longconst,ulongconst,doubleconst] then if op^.left^.token.kind in [intconst,uintconst,longconst,ulongconst,doubleconst] then begin ekind := doubleconst; {evaluate a constant operation} rop1 := RealVal(op^.left^.token); rop2 := RealVal(op^.right^.token); dispose(op^.right); op^.right := nil; dispose(op^.left); op^.left := nil; case op^.token.kind of barbarop : {||} rop1 := ord((rop1 <> 0.0) or (rop2 <> 0.0)); andandop : {&&} rop1 := ord((rop1 <> 0.0) and (rop2 <> 0.0)); eqeqop : begin {==} op1 := ord(rop1 = rop2); ekind := intconst; end; exceqop : begin {!=} op1 := ord(rop1 <> rop2); ekind := intconst; end; ltch : begin {<} op1 := ord(rop1 < rop2); ekind := intconst; end; gtch : begin {>} op1 := ord(rop1 > rop2); ekind := intconst; end; lteqop : begin {<=} op1 := ord(rop1 <= rop2); ekind := intconst; end; gteqop : begin {>=} op1 := ord(rop1 >= rop2); ekind := intconst; end; plusch : rop1 := rop1 + rop2; {+} minusch : rop1 := rop1 - rop2; {-} asteriskch : rop1 := rop1 * rop2; {*} slashch : begin {/} if rop2 = 0.0 then begin Error(109); rop2 := 1.0; end; {if} rop1 := rop1 / rop2; end; otherwise : Error(66); {illegal operation} end; {case} if ekind = intconst then begin op^.token.ival := long(op1).lsw; op^.token.class := intConstant; op^.token.kind := intConst; end {if} else begin op^.token.rval := rop1; op^.token.class := doubleConstant; op^.token.kind := doubleConst; end; {else} end; {if} 1: end; plusplusop, {prefix ++} minusminusop, {prefix --} opplusplus, {postfix ++} opminusminus, {postfix --} sizeofsy, {sizeof} castoper, {(type)} typedef, {(type-name)} tildech, {~} excch, {!} uminus, {unary -} uand, {unary &} uasterisk: begin {unary *} op^.left := Pop; if op^.token.kind = sizeofsy then begin op^.token.kind := longConst; op^.token.class := longConstant; if op^.left^.token.kind = stringConst then op^.token.lval := op^.left^.token.sval^.length+1 else begin lCodeGeneration := codeGeneration; codeGeneration := false; GenerateCode(op^.left); codeGeneration := lCodeGeneration and (numErrors = 0); op^.token.lval := expressionType^.size; with expressionType^ do if kind = arrayType then if (elements = 0) or (size = 0) then Error(49); end; {else} op^.left := nil; end {if sizeofsy} else if op^.token.kind = castoper then begin class := op^.left^.token.class; if class in [intConstant,longConstant,doubleConstant] then begin tp := op^.castType; while tp^.kind = definedType do tp := tp^.dType; if tp^.kind = scalarType then begin baseType := tp^.baseType; if baseType < cgString then begin if class = doubleConstant then begin rop1 := RealVal(op^.left^.token); op1 := trunc(rop1); end {if} else {if class in [intConstant,longConstant] then} begin op1 := IntVal(op^.left^.token); if op1 >= 0 then rop1 := op1 else if op^.left^.token.kind = uintConst then rop1 := (op1 & $7FFF) + 32768.0 else if op^.left^.token.kind = ulongConst then rop1 := (op1 & $7FFFFFFF) + 2147483648.0 else rop1 := op1; end; {else if} dispose(op^.left); op^.left := nil; if baseType in [cgByte,cgWord] then begin op^.token.kind := intConst; op^.token.class := intConstant; op^.token.ival := long(op1).lsw; if baseType = cgByte then with op^.token do begin ival := ival & $00FF; if (ival & $0080) <> 0 then ival := ival | $FF00; end; {with} end {if} else if baseType in [cgUByte,cgUWord] then begin op^.token.kind := uintConst; op^.token.class := intConstant; op^.token.ival := long(op1).lsw; if baseType = cgUByte then op^.token.ival := op^.token.ival & $00FF; end {else if} else if baseType = cgLong then begin op^.token.kind := longConst; op^.token.class := longConstant; op^.token.lval := op1; end {else if} else if baseType = cgULong then begin op^.token.kind := ulongConst; op^.token.class := longConstant; op^.token.lval := op1; end {else if} else begin op^.token.kind := doubleConst; op^.token.class := doubleConstant; op^.token.rval := rop1; end; {else if} end; {if} end; {if} end; {if} end {else if castoper} else if not (op^.token.kind in [typedef,plusplusop,minusminusop,opplusplus,opminusminus,uand]) then begin if (op^.left^.token.kind in [intconst,uintconst,longconst,ulongconst]) then begin {evaluate a constant operation} ekind := op^.left^.token.kind; op1 := IntVal(op^.left^.token); dispose(op^.left); op^.left := nil; case op^.token.kind of opplusplus, {posfix ++} plusplusop : op1 := op1+1; {prefix ++} opminusminus, {postfix --} minusminusop: op1 := op1-1; {prefix --} tildech : op1 := ~op1; {~} excch : begin {!} op1 := ord(op1 = 0); ekind := intconst; end; uminus : op1 := -op1; {unary -} uand : op1 := 0; {unary &} uasterisk : op1 := 0; {unary *} otherwise: Error(57); end; {case} op^.token.kind := ekind; if ekind in [longconst,ulongconst] then begin op^.token.class := longConstant; op^.token.lval := op1; end {if} else begin op^.token.class := intConstant; op^.token.ival := long(op1).lsw; end; {else} end {if} else if op^.left^.token.kind = doubleconst then begin ekind := doubleconst; {evaluate a constant operation} rop1 := RealVal(op^.left^.token); dispose(op^.left); op^.left := nil; case op^.token.kind of uminus : begin {unary -} op^.token.class := doubleConstant; op^.token.kind := doubleConst; op^.token.rval := -rop1; end; otherwise : begin {illegal operation} Error(66); op^.token.class := doubleConstant; op^.token.kind := doubleConst; op^.token.rval := rop1; end; end; {case} end; {if} end; {if} end; otherwise: Error(57); end; {case} op^.next := stack; {place the operation on the operand stack} stack := op; end; {Operation} procedure Skip; { skip all tokens in the reminader of the expression } begin {Skip} while not (token.kind in stopSym+[eofsy]) do NextToken; errorFound := true; end; {Skip} procedure TypeName; { find the type (used for casts and sizeof) } { } { outputs: } { typeSpec - pointer to the type } var tl,tp: typePtr; {for creating/reversing the type list} procedure AbstractDeclarator; { process an abstract declarator } { } { abstract-declarator: } { empty-abstract-declarator } { nonempty-abstract-declarator } procedure NonEmptyAbstractDeclarator; { process a nonempty abstract declarator } { } { nonempty-abstract-declarator: } { ( nonempty-abstract-declarator ) } { abstract-declarator ( ) } { abstract-declaraotr [ expression OPT ] } { * abstract-declarator } var pcount: integer; {paren counter} tp: typePtr; {work pointer} begin {NonEmptyAbstractDeclarator} if token.kind = lparench then begin NextToken; if token.kind = rparench then begin {create a function type} tp := pointer(Calloc(sizeof(typeRecord))); {tp^.size := 0;} {tp^.saveDisp := 0;} {tp^.isConstant := false;} tp^.kind := functionType; {tp^.varargs := false;} {tp^.prototyped := false;} {tp^.overrideKR := false;} {tp^.parameterList := nil;} {tp^.isPascal := false;} {tp^.toolNum := 0;} {tp^.dispatcher := 0;} tp^.fType := tl; tl := tp; NextToken; end {if} else begin {handle a perenthesized type} if not (token.kind in [lparench,asteriskch,lbrackch]) then begin Error(82); while not (token.kind in [eofsy,lparench,asteriskch,lbrackch,rparench]) do NextToken; errorFound := true; end; {if} if token.kind in [lparench,asteriskch,lbrackch] then NonEmptyAbstractDeclarator; Match(rparench,12); end; {else} end {if token.kind = lparench} else if token.kind = asteriskch then begin {create a pointer type} NextToken; AbstractDeclarator; tp := pointer(Malloc(sizeof(typeRecord))); tp^.size := cgLongSize; tp^.saveDisp := 0; tp^.isConstant := false; tp^.kind := pointerType; tp^.fType := tl; tl := tp; end {else if token.kind = asteriskch} else {if token.kind = lbrackch then} begin {create an array type} NextToken; if token.kind = rbrackch then expressionValue := 0 else begin Expression(arrayExpression, [rbrackch]); if expressionValue <= 0 then begin Error(45); expressionValue := 1; end; {if} end; {else} tp := pointer(Malloc(sizeof(typeRecord))); tp^.saveDisp := 0; tp^.kind := arrayType; tp^.elements := expressionValue; tp^.fType := tl; tl := tp; Match(rbrackch,24); end; {else} if token.kind = lparench then begin {create a function type} NextToken; pcount := 1; while (token.kind <> eofsy) and (pcount <> 0) do begin if token.kind = rparench then pcount := pcount-1 else if token.kind = lparench then pcount := pcount+1; NextToken; end; {while} tp := pointer(Calloc(sizeof(typeRecord))); {tp^.size := 0;} {tp.saveDisp := 0;} {tp^.isConstant := false;} tp^.kind := functionType; {tp^.varargs := false;} {tp^.prototyped := false;} {tp^.overrideKR := false;} {tp^.parameterList := nil;} {tp^.isPascal := false;} {tp^.toolNum := 0;} {tp^.dispatcher := 0;} tp^.fType := tl; tl := tp; end; {if} end; {NonEmptyAbstractDeclarator} begin {AbstractDeclarator} while token.kind in [lparench,asteriskch,lbrackch] do NonEmptyAbstractDeclarator; end; {AbstractDeclarator} begin {TypeName} {read and process the type specifier} typeSpec := wordPtr; TypeSpecifier(false,false); {handle the abstract-declarator part} tl := nil; {no types so far} AbstractDeclarator; {create the type list} while tl <> nil do begin {reverse the list & compute array sizes} tp := tl^.aType; {NOTE: assumes aType, pType and fType overlap in typeRecord} tl^.aType := typeSpec; if tl^.kind = arrayType then tl^.size := tl^.elements * typeSpec^.size; typeSpec := tl; tl := tp; end; {while} end; {TypeName} begin {ExpressionTree} opStack := nil; stack := nil; if token.kind = typedef then {handle typedefs that are hidden} if FindSymbol(token,allSpaces,false,true) <> nil then if token.symbolPtr^.class <> typedefsy then token.kind := ident; if token.kind in startExpression then begin expressionValue := 0; {initialize the expression value} expectingTerm := true; {the first item should be a term} done := false; {convert the expression to postfix form} parenCount := 0; repeat {scan the token list...} if token.kind in startTerm then begin {we must expect a term or unary operand} if not expectingTerm then begin Error(36); Skip; goto 1; end; {if} if token.kind = ident then {handle a complex operand} DoOperand else begin {handle a constant operand} new(sp); sp^.token := token; sp^.next := stack; sp^.left := nil; sp^.middle := nil; sp^.right := nil; stack := sp; if kind in [preprocessorExpression,arrayExpression] then if token.kind in [stringconst,doubleconst] then begin Error(41); errorFound := true; end; {if} NextToken; ComplexTerm; end; {else} expectingTerm := false; {the next thing should be an operation} end {else} {handle a closing parenthesis} else if (token.kind = rparench) and (parenCount > 0) then begin if expectingTerm then begin {make sure it is in a legal spot} Error(37); Skip; goto 1; end; {if} while opStack^.token.kind <> lparench do Operation; {do pending operations} op := opStack; opStack := op^.next; dispose(op); parenCount := parenCount-1; NextToken; {skip the ')'} ComplexTerm; {handle subscripts, selection, etc.} end {else} else if token.kind = lparench then begin {handle open paren and type casts} if not expectingTerm then begin Error(38); Skip; goto 1; end; {if} NextToken; if token.kind in [unsignedsy,intsy,longsy,charsy,shortsy,floatsy, doublesy,compsy,extendedsy,voidsy,enumsy,structsy,unionsy, typedef,constsy,volatilesy,signedsy] then begin doingSizeof := false; if opStack <> nil then if opStack^.token.kind = sizeofsy then doingSizeof := true; TypeName; if doingSizeof then begin {handle a sizeof operator} op := opStack; opStack := op^.next; dispose(op); new(sp); sp^.next := stack; sp^.left := nil; sp^.middle := nil; sp^.right := nil; sp^.token.kind := longconst; sp^.token.class := longConstant; sp^.token.lval := typeSpec^.size; if typeSpec^.kind = arrayType then if (typeSpec^.elements = 0) or (typeSpec^.size = 0) then Error(49); sp^.next := stack; stack := sp; expectingTerm := false; end {if} else {doing a cast} begin {handle a type cast} new(op); {stack the cast operator} op^.left := nil; op^.middle := nil; op^.right := nil; op^.castType := typeSpec; op^.token.kind := castoper; op^.token.class := reservedWord; op^.next := opStack; opStack := op; end; {else} Match(rparench,12); end {if} else begin new(op); {record the '('} op^.next := opStack; op^.left := nil; op^.middle := nil; op^.right := nil; opStack := op; op^.token.kind := lparench; op^.token.class := reservedSymbol; parenCount := parenCount+1; end; end {else if} else begin {handle an operation...} if expectingTerm then {convert unary operators to separate tokens} if token.kind in [asteriskch,minusch,plusch,andch] then case token.kind of asteriskch: token.kind := uasterisk; minusch : token.kind := uminus; andch : token.kind := uand; plusch : begin NextToken; goto 2; end; otherwise : Error(57); end; {case} if icp[token.kind] = notAnOperation then done := true {end of expression found...} else if (token.kind in stopSym) and (parenCount = 0) then done := true else begin if not (kind in [normalExpression, autoInitializerExpression]) then if (token.kind in [plusplusop,minusminusop,eqch,pluseqop,minuseqop, opplusplus,opminusminus, asteriskeqop,slasheqop,percenteqop,ltlteqop, gtgteqop,caroteqop,bareqop,commach]) or ((kind = preprocessorExpression) and (token.kind = sizeofsy)) or ((kind <> initializerExpression) and (token.kind = uand)) then begin Error(40); errorFound := true; end; {if} if token.kind in {make sure we get what we want} [plusplusop,minusminusop,sizeofsy,tildech,excch, uasterisk,uminus,uand] then begin if not expectingTerm then begin Error(38); Skip; goto 1; end; {if} end {if} else begin if expectingTerm then begin Error(37); Skip; goto 1; end; {if} expectingTerm := true; {handle 2nd half of ternary operator} if token.kind = colonch then begin done2 := false; {do pending operations} repeat if opStack = nil then done2 := true else if opStack^.token.kind <> questionch then Operation else done2 := true; until done2; if (opStack = nil) or (opStack^.token.kind <> questionch) then begin Error(39); Skip; goto 1; end; {if} op := opStack; opStack := op^.next; dispose(op); end {if} else begin done2 := false; {do operations with less precidence} repeat if opStack = nil then done2 := true else if isp[opStack^.token.kind] >= icp[token.kind] then Operation else done2 := true; until done2; end; {else} end; {else} new(op); {record the operation} op^.next := opStack; op^.left := nil; op^.middle := nil; op^.right := nil; opStack := op; op^.token := token; NextToken; end; {else} end; {else} 2: until done; if parenCount > 0 then begin Error(12); errorFound := true; end {if} else begin while opStack <> nil do {do pending operations} Operation; {there should be exactly one operand left} if (stack = nil) or (stack^.next <> nil) then begin Error(36); errorFound := true; end; {if} end; {else} end {if} else begin {the start of an expression was not found} Error(35); if not (token.kind in stopSym) then NextToken; Skip; end; {else} 1: if errorFound then begin while opStack <> nil do begin op := opStack; opStack := op^.next; dispose(op); end; {while} while stack <> nil do begin sp := stack; stack := sp^.next; DisposeTree(sp); end; {while} ExpressionTree := nil; end {if} else ExpressionTree := stack; end; {ExpressionTree} procedure CompareToZero {op: pcodes}; { Compare the result on tos to zero. } { } { This procedure is used by the logical statements to compare } { _any_ scalar result to zero, giving a boolean result. } { } { parameters: } { op - operation to use on the compare } var bt: baseTypeEnum; {base type of loaded value} begin {CompareToZero} if expressionType^.kind = pointerType then expressionType := uLongPtr; if expressionType^.kind = scalarType then begin bt := UsualUnaryConversions; case bt of cgByte,cgUByte,cgWord,cgUWord: Gen1t(pc_ldc, 0, cgWord); cgLong,cgULong: GenLdcLong(0); cgReal,cgDouble,cgComp,cgExtended: GenLdcReal(0.0); otherwise: Error(47); end; {case} expressionType := wordPtr; Gen0t(op, bt); end {if} else Error(47); end; {CompareToZero} procedure FreeTemp{labelNum, size: integer}; { place a temporary label in the available label list } { } { parameters: } { labelNum - number of the label to free } { size - size of the variable } { } { variables: } { tempList - list of free labels } var tl: tempPtr; {work pointer} begin {FreeTemp} new(tl); tl^.next := tempList; tl^.last := nil; tl^.labelNum := labelNum; tl^.size := size; if tempList <> nil then tempList^.last := tl; tempList := tl; end; {FreeTemp} function GetTemp{size: integer): integer}; { find a temporary work variable } { } { parameters: } { size - size of the variable } { } { variables: } { tempList - list of free labels } { } { Returns the label number. } label 1; var lcodeGeneration: boolean; {local copy of codeGeneration} ln: integer; {label number} tl: tempPtr; {work pointer} begin {GetTemp} {try to find a temp from the existing list} tl := tempList; while tl <> nil do begin if tl^.size = size then begin {found an old one - use it} if tl^.last = nil then tempList := tl^.next else tl^.last^.next := tl^.next; if tl^.next <> nil then tl^.next^.last := tl^.last; GetTemp := tl^.labelNum; goto 1; end; {if} tl := tl^.next; end; {while} {none found - get a new one} ln := GetLocalLabel; GetTemp := ln; lcodeGeneration := codeGeneration; codeGeneration := true; Gen2(dc_loc, ln, size); codeGeneration := lCodeGeneration and (numErrors = 0); 1: end; {GetTemp} procedure LoadScalar (id: identPtr); { Load a scalar value. } { } { parameters: } { id - ident for value to load } var tp: baseTypeEnum; {base type} begin {LoadScalar} if id^.itype^.kind = pointerType then tp := cgULong else tp := id^.itype^.baseType; case id^.storage of stackFrame, parameter: Gen2t(pc_lod, id^.lln, 0, tp); external, global, private: Gen1tName(pc_ldo, 0, tp, id^.name); otherwise: ; end; {case} end; {LoadScalar} procedure Cast(tp: typePtr); { Cast the current expression to the stated type } { } { parameters: } { tp - type to cast to } { } { inputs: } { expressionType - type of the expression to cast } { } { outputs: } { expressionType - set to result type } var et,rt: baseTypeEnum; {work variables} begin {Cast} if (tp^.kind = scalarType) and (expressionType^.kind = scalarType) then begin rt := tp^.baseType; et := expressionType^.baseType; if rt <> et then Gen2(pc_cnv, ord(et), ord(rt)); end {if} else if (tp^.kind = enumType) and (expressionType^.kind = scalarType) then begin rt := cgWord; et := Unary(expressionType^.baseType); if rt <> et then Gen2(pc_cnv, ord(et), ord(rt)); end {if} else if (tp^.kind = scalarType) and (expressionType^.kind = enumType) then begin rt := Unary(tp^.baseType); et := cgWord; if rt <> et then Gen2(pc_cnv, ord(et), ord(rt)); end {if} else if tp^.kind = pointerType then begin case expressionType^.kind of scalarType: if expressionType^.baseType in [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong] then Gen2(pc_cnv, ord(Unary(expressionType^.baseType)), ord(cgULong)) else if doDispose then Error(40); arrayType,pointerType: ; functionType,enumConst,enumType,definedType,structType,unionType: if doDispose then Error(40); otherwise: Error(57); end; {case} end {else if} else if expressionType^.kind in [pointerType,arrayType] then begin case tp^.kind of scalarType: if tp^.baseType in [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong] then Gen2(pc_cnv, ord(cgULong), ord(Unary(tp^.baseType))) else if tp^.baseType = cgVoid then Gen0t(pc_pop, UsualUnaryConversions) else Error(40); otherwise: Error(40); end; {case} end {else if} else if expressionType^.kind in [structType,unionType] then begin if tp^.kind = scalarType then if tp^.baseType = cgVoid then Gen0t(pc_pop, UsualUnaryConversions) else Error(40) else Error(40); end {else if} else Error(40); expressionType := tp; end; {Cast} procedure DoSelection {lType: typePtr; tree: tokenPtr; var size: longint}; { Find the displacement & type for a selection operation } { } { parameters: } { lType - structure/union type } { tree - right-hand tree } { size - disp into the structure/union } { } { returned in non-local variables: } { bitDisp - displacement to bit field } { bitSize - size of bit field } { unsigned - is the bit field unsigned? } { isBitField - is the field a bit field? } { } { varaibles: } { expressionType - set to the type of the field } label 1; var ip: identPtr; {for scanning for the field} begin {DoSelection} expressionType := wordPtr; {set defaults in case there is an error} size := 0; if tree^.token.class = identifier then begin while lType^.kind = definedType do lType := lType^.dType; if lType^.kind in [structType,unionType] then begin ip := lType^.fieldList; {find a matching field} while ip <> nil do begin if ip^.name^ = tree^.token.name^ then begin if ip^.isForwardDeclared then ResolveForwardReference(ip); size := ip^.disp; {match found - record parameters} expressionType := ip^.itype; bitDisp := ip^.bitDisp; bitSize := ip^.bitSize; isBitField := (bitSize+bitDisp) <> 0; unsigned := ip^.itype^.baseType in [cgUByte,cgUWord,cgULong]; goto 1; end; {if} ip := ip^.next; end; {while} Error(81); end {if} else Error(80); end; {if} 1: end; {DoSelection} procedure L_Value(tree: tokenPtr); { Check for an l-value } { } { parameters: } { tree - expression tree to check } var kind: tokenEnum; {for efficiency} begin {L_Value} kind := tree^.token.kind; {A variable identifier is an l-value unless it is a function or } {non-parameter array } if kind = ident then begin if tree^.id^.itype^.kind = arrayType then begin if tree^.id^.storage <> parameter then if doDispose then {prevent spurious errors} Error(78); end {if} else if tree^.id^.itype^.kind in [functionType,enumConst,enumType] then if doDispose then {prevent spurious errors} Error(78); end {if} {e.field is an l-value if and only if e is an l-value} else if kind = dotch then L_Value(tree^.left) {Bypass cast operators } {following test removed to flag bug for: } { int *p; long l; } { (long) p = l; } {else if kind = castoper then L_Value(tree^.left)} {The result of an array subscript (a[i]), indirect selection, } {or the indirection operator all show up as the uasterisk } {operator at this point. All are l-values, but nothing else } {not already allowed is an l-value. } else if kind <> uasterisk then if doDispose then {prevent spurious errors} Error(78); end; {L_Value} procedure ChangePointer (op: pcodes; size: longint; tp: baseTypeEnum); { Add or subtract an integer to a pointer } { } { The stack has a pointer and an integer (integer on TOS). } { The integer is removed, multiplied by size, and either } { added to or subtracted from the pointer; the result } { replaces the pointer on the stack } { } { parameters: } { op - operation (pc_adl or pc_sbl) } { size - size of one pointer element } { tp - type of the integer operand } begin {ChangePointer} case tp of cgByte,cgUByte,cgWord,cgUWord: begin if (size = long(size).lsw) and (op = pc_adl) and smallMemoryModel and (tp in [cgUByte,cgUWord]) then begin Gen1t(pc_ldc, long(size).lsw, cgWord); Gen0(pc_umi); Gen0t(pc_ixa, cgUWord); end {if} else if smallMemoryModel and (size = long(size).lsw) then begin Gen1t(pc_ldc, long(size).lsw, cgWord); Gen0(pc_mpi); Gen2(pc_cnv, ord(tp), ord(cgLong)); Gen0(op); end {else if} else begin Gen2(pc_cnv, ord(tp), ord(cgLong)); GenLdcLong(size); Gen0(pc_mpl); Gen0(op); end; end; cgLong,cgULong: begin GenLdcLong(size); if tp = cgLong then Gen0(pc_mpl) else Gen0(pc_uml); Gen0(op); end; otherwise: Error(66); end; {case} end; {ChangePointer} procedure GenerateCode {tree: tokenPtr}; { generate code from a fully formed expression tree } { } { parameters: } { tree - top of the expression tree to generate code from } { } { variables: } { expressionType - result type of the expression } var doingScalar: boolean; {temp; for assignment operators} et: baseTypeEnum; {temp storage for a base type} i: integer; {loop variable} isString: boolean; {was the ? : a string?} lType: typePtr; {type of operands} kind: typeKind; {temp type kind} size: longint; {size of an array element} t1: integer; {temporary work space label number} tlastwasconst: boolean; {temp lastwasconst} tlastconst: longint; {temp lastconst} tp: tokenPtr; {work pointer} tType: typePtr; {temp type of operand} lbitDisp,lbitSize: integer; {for temp storage} lisBitField: boolean; function ExpressionKind (tree: tokenPtr): typeKind; { returns the type of an expression } { } { This subroutine is used to see if + and - operarions } { should do pointer addition. } { } { parameters: } { tree - top of the expression tree to check } var ldoDispose: boolean; {local copy of doDispose} lcodeGeneration: boolean; {local copy of codeGeneration} lexpressionType: typePtr; {local copy of expressionType} begin {ExpressionKind} ldoDispose := doDispose; {inhibit disposing of the tree} doDispose := false; lcodeGeneration := codeGeneration; {inhibit code generation} codeGeneration := false; lexpressionType := expressionType; {save the expression type} GenerateCode(tree); {get the type} ExpressionKind := expressionType^.kind; doDispose := ldoDispose; {resore the volitile variables} codeGeneration := lCodeGeneration and (numErrors = 0); expressionType := lexpressionType; end; {ExpressionKind} procedure LoadAddress (tree: tokenPtr); { load the address of an l-value } { } { parameters: } { tree - top of the expression tree to load the } { address of } { } { variables: } { expressionType - result type of the expression } { isBitField - this variable is set to false so that } { it can be used to see if DoSelection was called } { and located a bit field } label 1; var eType: typePtr; {work pointer} i: integer; {loop variable} size: longint; {disp in record} tname: stringPtr; {temp name pointer} begin {LoadAddress} isBitField := false; if tree^.token.kind = ident then begin {load the address of an identifier} with tree^.id^ do begin tname := name; if itype^.kind = functionType then begin if itype^.isPascal then begin tname := pointer(Malloc(length(name^)+1)); CopyString(pointer(tname), pointer(name)); for i := 1 to length(tname^) do if tname^[i] in ['a'..'z'] then tname^[i] := chr(ord(tname^[i]) & $5F); end; {if} end; {if} case storage of stackFrame: Gen2(pc_lda, lln, 0); parameter: if itype^.kind = arrayType then Gen2t(pc_lod, pln, 0, cgULong) else Gen2(pc_lda, pln, 0); external, global, private: Gen1Name(pc_lao, 0, tname); otherwise: ; end; {case} eType := pointer(Malloc(sizeof(typeRecord))); eType^.size := cgLongSize; eType^.saveDisp := 0; eType^.isConstant := false; eType^.kind := pointerType; eType^.pType := iType; expressionType := eType; end; {with} end {if} else if tree^.token.kind = uasterisk then begin {load the address of the item pointed to by the pointer} GenerateCode(tree^.left); end {else if} else if tree^.token.kind = dotch then begin {load the address of a field of a record} LoadAddress(tree^.left); eType := expressionType; if eType^.kind in [arrayType,pointerType] then begin if eType^.kind = arrayType then eType := eType^.aType else if eType^.kind = pointerType then eType := eType^.pType; DoSelection(eType, tree^.right, size); if size <> 0 then if size & $00007FFF = size then Gen1t(pc_inc, long(size).lsw, cgULong) else begin GenLdcLong(size); Gen0(pc_adl); end; {else} eType := pointer(Malloc(sizeof(typeRecord))); eType^.size := cgLongSize; eType^.saveDisp := 0; eType^.isConstant := false; eType^.kind := pointerType; eType^.pType := expressionType; expressionType := eType; end {if} else Error(79); end {else if} else if tree^.token.kind = castoper then begin {load the address of a field of a record} LoadAddress(tree^.left); expressionType := tree^.castType; if expressionType^.kind <> arrayType then begin eType := pointer(Malloc(sizeof(typeRecord))); eType^.size := cgLongSize; eType^.saveDisp := 0; eType^.isConstant := false; eType^.kind := pointerType; eType^.pType := expressionType; expressionType := eType; end; {if} end {else if} else if ExpressionKind(tree) in [arrayType,pointerType] then GenerateCode(tree) else if doDispose then {prevent spurious errors} Error(78); 1: end; {LoadAddress} procedure DoIncDec (tree: tokenPtr; pc_l, pc_g, pc_i: pcodes); { do ++ and -- } { } { parameters: } { tree - tree to generate the instruction for } { pc_l - op code for a local ++ or -- } { pc_g - op code for a global ++ or -- } { pc_i - op code for an indirect ++ or -- } label 1; var baseType: baseTypeEnum; {type of operation} lSize: longint; {number to inc or dec by} iSize: integer; {number to inc or dec by} tp: baseTypeEnum; {type of operand} procedure IncOrDec (inc: boolean); { Increment or decrement a number on TOS } { } { parameters: } { inc - increment the number? } begin {IncOrDec} case expressionType^.kind of scalarType: case tp of cgByte,cgUByte,cgWord,cgUWord: begin Gen1t(pc_ldc, 1, cgWord); if inc then Gen0(pc_adi) else Gen0(pc_sbi); end; cgLong,cgULong: begin GenLdcLong(1); if inc then Gen0(pc_adl) else Gen0(pc_sbl); end; cgReal,cgDouble,cgComp,cgExtended: begin GenLdcReal(1.0); if inc then Gen0(pc_adr) else Gen0(pc_sbr); end; otherwise: Error(57); end; {case} pointerType,arrayType: begin GenldcLong(expressionType^.pType^.size); if inc then Gen0(pc_adl) else Gen0(pc_sbl); end; otherwise: ; end; {case} end; {IncOrDec} begin {DoIncDec} L_Value(tree); with tree^.id^ do if (tree^.token.kind = ident) and ((iType^.kind in [scalarType,pointerType]) or ((iType^.kind = arrayType) and (storage = parameter))) then begin {check for ++ or -- of a constant} if iType^.isConstant then Error(93); {do an efficient ++ or -- on a named location} if iType^.kind = scalarType then begin iSize := 1; baseType := iType^.baseType; if baseType in [cgReal,cgDouble,cgComp,cgExtended] then begin {do real inc or dec} LoadScalar(tree^.id); {load the value} tp := baseType; expressionType := iType; IncOrDec(pc_l in [pc_lli,pc_lil]); {do the ++ or --} case storage of {save the result} stackFrame, parameter: Gen2t(pc_cop, lln, 0, baseType); external, global, private: Gen1tName(pc_cpo, 0, baseType, name); otherwise: ; end; {case} {correct the value for postfix ops} if pc_l in [pc_lli,pc_lld] then IncOrDec(pc_l = pc_lld); expressionType := doublePtr; goto 1; end; {if} end {if} else {if iType^.kind = pointerType then} begin lSize := iType^.pType^.size; if long(lSize).msw <> 0 then begin {handle inc/dec of >64K} LoadScalar(tree^.id); GenLdcLong(lSize); if pc_l in [pc_lli,pc_lil] then Gen0(pc_adl) else Gen0(pc_sbl); with tree^.left^.id^ do case storage of stackFrame, parameter: Gen2t(pc_cop, lln, 0, cgULong); external, global, private: Gen1tName(pc_cpo, 0, cgULong, name); otherwise: ; end; {case} if pc_l in [pc_lli,pc_lld] then begin GenLdcLong(lSize); if pc_l = pc_lld then Gen0(pc_adl) else Gen0(pc_sbl); end; {if} goto 1; end; {if} baseType := cgULong; iSize := long(lSize).lsw; end; {else} case storage of stackFrame, parameter: Gen2t(pc_l, lln, iSize, baseType); external, global, private: Gen2tName(pc_g, iSize, 0, baseType, name); otherwise: ; end; {case} expressionType := itype; end {if} else begin {do an indirect ++ or --} LoadAddress(tree); {get the address to save to} if expressionType^.kind = arrayType then expressionType := expressionType^.aType else if expressionType^.kind = pointerType then expressionType := expressionType^.pType; if expressionType^.kind = scalarType then if expressionType^.baseType in [cgByte,cgUByte,cgWord,cgUWord] then tp := expressionType^.baseType else tp := UsualUnaryConversions else tp := UsualUnaryConversions; if tp in [cgByte,cgUByte,cgWord,cgUword] then Gen0t(pc_i, tp) {do indirect inc/dec} else begin t1 := GetTemp(cgLongSize); Gen2t(pc_str, t1, 0, cgULong); Gen2t(pc_lod, t1, 0, cgULong); Gen2t(pc_lod, t1, 0, cgULong); FreeTemp(t1, cgLongSize); Gen1t(pc_ind, 0, tp); {load the value} IncOrDec(pc_l in [pc_lli,pc_lil]); {do the ++ or --} if isBitField then {copy the value} if bitDisp+bitSize > 16 then begin Gen2t(pc_cbf, bitDisp, bitSize, cgLong); Gen0t(pc_bno, cgLong); end {if} else begin Gen2t(pc_cbf, bitDisp, bitSize, cgWord); Gen0t(pc_bno, cgWord); end {else} else begin Gen0t(pc_cpi, tp); Gen0t(pc_bno, tp); end; {else} if pc_l in [pc_lli,pc_lld] then {correct the value for postfix ops} IncOrDec(pc_l = pc_lld); end; {else} end; {else} 1: end; {DoIncDec} procedure FunctionCall (tree: tokenPtr); { generate the actual function call } var fName: stringPtr; {uppercase file name} fntype: typePtr; {temp function type} ftree: tokenPtr; {function address tree} ftype: typePtr; {function type} i: integer; {loop variable} indirect: boolean; {is this an indirect call?} ldoDispose: boolean; {local copy of doDispose} lcodeGeneration: boolean; {local copy of codeGeneration} procedure FunctionParms (parms: tokenPtr; fType: typePtr); { Generate a function call. } { } { parameters: } { parms - parameter list } { fType - function type } var kind: typeKind; {for expression kinds} ldoDispose: boolean; {local copy of doDispose} lnumErrors: integer; {number of errors before type check} numParms: integer; {# of parameters generated} parameters: parameterPtr; {next prototyped parameter} pCount: integer; {# of parameters prototyped} prototype: boolean; {is the function prototyped?} tp,ltp: tokenPtr; {work pointers} procedure Reverse; { Reverse the parameter list } var p1,p2,p3: tokenPtr; {work pointers} begin {Reverse} p3 := parms; {remove the last entry} p1 := parms; p2 := nil; while p3^.right <> nil do begin p2 := p3; p3 := p3^.right; end; {while} if p2 <> nil then p2^.right := nil else p1 := nil; while p1 <> nil do begin {reverse the remaining parms} p2 := p1; p1 := p1^.right; p2^.right := p3; p3 := p2; end; {while} parms := p3; end; {Reverse} begin {FunctionParms} {check the validity of the parameter list} if ftype^.isPascal then {reverse parms for pascal calls} Reverse; tp := parms; {set up to check types} prototype := ftype^.prototyped; parameters := ftype^.parameterList; pCount := 1; while parameters <> nil do begin {count the prototypes} pCount := pCount+1; parameters := parameters^.next; end; {while} parameters := ftype^.parameterList; if prototype then begin {check for wrong # of parms} while tp <> nil do begin {count the parms} pCount := pCount-1; tp := tp^.right; end; {while} tp := parms; if (pCount > 0) or ((pCount <> 0) and not ftype^.varargs) then Error(85); end; {if} {generate the parameters} numParms := 0; lDoDispose := doDispose; doDispose := false; while tp <> nil do begin if tp^.middle <> nil then begin lnumErrors := numErrors; kind := ExpressionKind(tp^.middle); if numErrors = lnumErrors then if kind in [structType,unionType] then begin GenerateCode(tp^.middle); if expressionType^.size & $FFFF8000 <> 0 then Error(61); Gen1t(pc_ldc, long(expressionType^.size).lsw, cgWord); Gen0(pc_psh); end {else if} else GenerateCode(tp^.middle); if prototype then begin if pCount = 0 then begin if parameters <> nil then begin AssignmentConversion(parameters^.parameterType, expressionType, lastWasConst, lastConst, true, true); end; {if} parameters := parameters^.next; end {if} else pCount := pCount+1; end; {if} Gen0t(pc_stk, UsualUnaryConversions); if numParms <> 0 then Gen0t(pc_bno, UsualUnaryConversions); numParms := numParms+1; end; {if} ltp := tp; tp := tp^.right; end; {while} doDispose := lDoDispose; if numParms = 0 then Gen0(pc_nop); if ftype^.isPascal then {restore parm order} Reverse; if doDispose then begin {dispose of leaf nodes} DisposeTree(parms^.middle); DisposeTree(parms^.right); end; {if} end; {FunctionParms} begin {FunctionCall} {find the type of the function} indirect := true; {assume an indirect call} ftree := tree^.left; {get the function tree} if ftree^.token.kind = ident then {check for direct calls} if ftree^.id^.itype^.kind = functionType then begin indirect := false; fType := ftree^.id^.itype; {get the function type} end; {if} if indirect then begin {get type for indirect call} ldoDispose := doDispose; doDispose := false; lcodeGeneration := codeGeneration; codeGeneration := false; GenerateCode(ftree); doDispose := ldoDispose; codeGeneration := lCodeGeneration and (numErrors = 0); ftype := expressionType; while ftype^.kind in [pointerType,arrayType] do ftype := ftype^.ptype; end; {if} {make sure the identifier is really a function} if ftype^.kind <> functionType then Error(114) else begin {generate function parameters} FunctionParms (tree, fType); {generate the function call} expressionType := ftype^.fType; if expressionType^.kind in [structType,unionType] then expressionType := uLongPtr; if (ftype^.toolNum = 0) and (ftype^.dispatcher = 0) then begin if indirect then begin fntype := expressionType; GenerateCode(ftree); expressionType := fntype; Gen1t(pc_cui, ord(fType^.varargs and strictVararg), UsualUnaryConversions); end {if} else begin fname := ftree^.id^.name; if ftype^.isPascal then begin fname := pointer(Malloc(length(fname^)+1)); CopyString(pointer(fname), pointer(ftree^.id^.name)); for i := 1 to length(fname^) do if fName^[i] in ['a'..'z'] then fName^[i] := chr(ord(fName^[i]) & $5F); end; {if} Gen1tName(pc_cup, ord(fType^.varargs and strictVararg), UsualUnaryConversions, fname); end; {else} end {if} else GenTool(pc_tl1, ftype^.toolNum, long(ftype^.ftype^.size).lsw, ftype^.dispatcher); expressionType := ftype^.fType; lastWasConst := false; end; {else} end; {FunctionCall} procedure CompareCompatible (var t1,t2: typePtr); { Make sure that it is legal to compare t1 to t2 } begin {CompareCompatible} if (t1^.kind = functionType) or (t2^.kind = functionType) then begin if not CompTypes(t1, t2) then Error(47); end {if} else if t1^.kind in [pointerType,arrayType] then begin if t2^.kind in [pointerType,arrayType] then begin if (t1^.ptype = voidPtr) or (t2^.ptype = voidPtr) then else if t1^.kind = t2^.kind then begin if not CompTypes(t1, t2) then Error(47); end {if} else if not CompTypes(t1^.ptype, t2^.ptype) then Error(47); t2 := ulongPtr; end {if} else if (not lastwasconst) or (lastconst <> 0) then Error(47); t1 := ulongPtr; end {if} else if expressionType^.kind in [pointerType,arrayType] then begin if (not tlastwasconst) or (tlastconst <> 0) then Error(47); t2 := ulongPtr; end; {else if} end; {CompareCompatible} begin {GenerateCode} lastwasconst := false; case tree^.token.kind of parameterOper: FunctionCall(tree); ident: begin case tree^.id^.itype^.kind of scalarType: begin LoadScalar(tree^.id); expressionType := tree^.id^.itype; end; pointerType: begin LoadScalar(tree^.id); expressionType := tree^.id^.itype; end; arrayType: begin LoadAddress(tree); expressionType := expressionType^.ptype; end; functionType: LoadAddress(tree); structType, unionType: begin LoadAddress(tree); if expressionType^.kind = pointerType then expressionType := expressionType^.ptype; end; enumConst: begin Gen1t(pc_ldc, tree^.id^.itype^.eval, cgWord); expressionType := wordPtr; end; otherwise: ; end; {case} end; intConst,uintConst: begin Gen1t(pc_ldc, tree^.token.ival, cgWord); lastwasconst := true; lastconst := tree^.token.ival; if tree^.token.kind = intConst then expressionType := wordPtr else expressionType := uwordPtr; end; {case intConst} longConst,ulongConst: begin GenLdcLong(tree^.token.lval); if tree^.token.kind = longConst then expressionType := longPtr else expressionType := ulongPtr; lastwasconst := true; lastconst := tree^.token.lval; end; {case longConst} doubleConst: begin GenLdcReal(tree^.token.rval); expressionType := doublePtr; end; {case doubleConst} stringConst: begin GenS(pc_lca, tree^.token.sval); expressionType := stringTypePtr; end; {case stringConst} eqch: begin {=} L_Value(tree^.left); with tree^.left^ do begin if token.kind = ident then kind := id^.itype^.kind else kind := definedType; if kind = arrayType then if id^.storage = parameter then kind := pointerType; if (token.kind = ident) and (kind in [scalarType,pointerType]) then begin GenerateCode(tree^.right); with tree^.left^.id^ do begin if itype^.kind in [pointerType,arrayType] then lType := uLongPtr else lType := itype; AssignmentConversion(itype, expressionType, lastWasConst, lastConst, true, true); case storage of stackFrame, parameter: Gen2t(pc_cop, lln, 0, lType^.baseType); external, global, private: Gen1tName(pc_cpo, 0, lType^.baseType, name); otherwise: ; end; {case} end; {with} end {if} else begin LoadAddress(tree^.left); lType := expressionType; lisBitField := isBitField; lbitDisp := bitDisp; lbitSize := bitSize; if lType^.kind = arrayType then lType := lType^.aType else if lType^.kind = pointerType then lType := lType^.pType; GenerateCode(tree^.right); AssignmentConversion(lType, expressionType, lastWasConst, lastConst, true, true); case lType^.kind of scalarType: if lisBitField then Gen2t(pc_cbf, lbitDisp, lbitSize, lType^.baseType) else Gen0t(pc_cpi, lType^.baseType); pointerType: Gen0t(pc_cpi, cgULong); structType,unionType: Gen2(pc_mov, long(lType^.size).msw, long(lType^.size).lsw); otherwise: Error(47); end; {case} end; {else} end; {with} end; {=} pluseqop, {+=} minuseqop, {-=} asteriskeqop, {*=} slasheqop, {/=} percenteqop, {%=} ltlteqop, {<<=} gtgteqop, {>>=} andeqop, {&=} caroteqop, {^=} bareqop: with tree^.left^ do {|=} begin L_Value(tree^.left); if (token.kind = ident) and (id^.itype^.kind in [scalarType,pointerType]) then begin doingScalar := true; LoadScalar(id); lType := id^.itype; end {if} else begin doingScalar := false; LoadAddress(tree^.left); lisBitField := isBitField; lbitDisp := bitDisp; lbitSize := bitSize; t1 := GetTemp(cgLongSize); Gen2t(pc_str, t1, 0, cgULong); Gen2t(pc_lod, t1, 0, cgULong); Gen2t(pc_lod, t1, 0, cgULong); FreeTemp(t1, cgLongSize); lType := expressionType^.pType; if isBitField then begin if unsigned then Gen2t(pc_lbu, bitDisp, bitSize, lType^.baseType) else Gen2t(pc_lbf, bitDisp, bitSize, lType^.baseType); end {if} else if lType^.kind = pointerType then Gen1t(pc_ind, 0, cgULong) else Gen1t(pc_ind, 0, lType^.baseType); end; {else} if lType^.isConstant then Error(93); GenerateCode(tree^.right); if lType^.kind <> pointerType then et := UsualBinaryConversions(lType); case tree^.token.kind of pluseqop: if lType^.kind = pointerType then begin ChangePointer(pc_adl, lType^.pType^.size, UsualUnaryConversions); expressionType := lType; end else if et in [cgWord,cgUWord] then Gen0(pc_adi) else if et in [cgLong,cgULong] then Gen0(pc_adl) else if et = cgExtended then Gen0(pc_adr) else Error(66); minuseqop: if lType^.kind = pointerType then begin ChangePointer(pc_sbl, lType^.pType^.size, UsualUnaryConversions); expressionType := lType; end else if et in [cgWord,cgUWord] then Gen0(pc_sbi) else if et in [cgLong,cgULong] then Gen0(pc_sbl) else if et = cgExtended then Gen0(pc_sbr) else Error(66); asteriskeqop: if et = cgWord then Gen0(pc_mpi) else if et = cgUWord then Gen0(pc_umi) else if et = cgLong then Gen0(pc_mpl) else if et = cgULong then Gen0(pc_uml) else if et = cgExtended then Gen0(pc_mpr) else Error(66); slasheqop: if et = cgWord then Gen0(pc_dvi) else if et = cgUWord then Gen0(pc_udi) else if et = cgLong then Gen0(pc_dvl) else if et = cgULong then Gen0(pc_udl) else if et = cgExtended then Gen0(pc_dvr) else Error(66); percenteqop: if et = cgWord then Gen0(pc_mod) else if et = cgUWord then Gen0(pc_uim) else if et = cgLong then Gen0(pc_mdl) else if et = cgULong then Gen0(pc_ulm) else Error(66); ltlteqop: if et in [cgWord,cgUWord] then Gen0(pc_shl) else if et in [cgLong,cgULong] then Gen0(pc_sll) else Error(66); gtgteqop: if et = cgWord then Gen0(pc_shr) else if et = cgUWord then Gen0(pc_usr) else if et = cgLong then Gen0(pc_slr) else if et = cgULong then Gen0(pc_vsr) else Error(66); andeqop: if et in [cgWord,cgUWord] then Gen0(pc_bnd) else if et in [cgLong,cgULong] then Gen0(pc_bal) else Error(66); caroteqop: if et in [cgWord,cgUWord] then Gen0(pc_bxr) else if et in [cgLong,cgULong] then Gen0(pc_blx) else Error(66); bareqop: if et in [cgWord,cgUWord] then Gen0(pc_bor) else if et in [cgLong,cgULong] then Gen0(pc_blr) else Error(66); otherwise: Error(57); end; {case} AssignmentConversion(lType,expressionType,false,0,true,true); if doingScalar then begin if lType^.kind = pointerType then lType := uLongPtr; case id^.storage of stackFrame, parameter: Gen2t(pc_cop, id^.lln, 0, lType^.baseType); external, global, private: Gen1tName(pc_cpo, 0, lType^.baseType, id^.name); otherwise: ; end; {case} end {if} else begin if lisBitField then Gen2t(pc_cbf, lbitDisp, lbitSize, lType^.baseType) else begin if ltype^.kind in [pointerType,arrayType] then lType := uLongPtr; Gen0t(pc_cpi, lType^.baseType); end; {else} Gen0t(pc_bno, lType^.baseType); end; {else} end; {with} commach: begin {,} GenerateCode(tree^.left); if expressionType^.baseType <> cgVoid then Gen0t(pc_pop, UsualUnaryConversions); GenerateCode(tree^.right); Gen0t(pc_bno, UsualUnaryConversions); {result type is already in expressionType} end; {case commach} barbarop: begin {||} GenerateCode(tree^.left); if expressionType^.kind = pointerType then expressionType := uLongPtr else if UsualUnaryConversions = cgExtended then begin GenLdcReal(0.0); Gen0t(pc_neq, cgExtended); expressionType := wordPtr; end; {if} lType := expressionType; GenerateCode(tree^.right); if expressionType^.kind = pointerType then expressionType := uLongPtr else if UsualUnaryConversions = cgExtended then begin GenLdcReal(0.0); Gen0t(pc_neq, cgExtended); expressionType := wordPtr; end; {if} case UsualBinaryConversions(lType) of cgByte,cgUByte,cgWord,cgUWord: Gen0(pc_ior); cgLong,cgULong: Gen0(pc_lor); otherwise: error(66); end; {case} expressionType := wordPtr; end; {case barbarop} andandop: begin {&&} GenerateCode(tree^.left); if expressionType^.kind = pointerType then expressionType := uLongPtr else if UsualUnaryConversions = cgExtended then begin GenLdcReal(0.0); Gen0t(pc_neq, cgExtended); expressionType := wordPtr; end; {if} lType := expressionType; GenerateCode(tree^.right); if expressionType^.kind = pointerType then expressionType := uLongPtr else if UsualUnaryConversions = cgExtended then begin GenLdcReal(0.0); Gen0t(pc_neq, cgExtended); expressionType := wordPtr; end; {if} case UsualBinaryConversions(lType) of cgByte,cgUByte,cgWord,cgUWord: Gen0(pc_and); cgLong,cgULong: Gen0(pc_lnd); otherwise: error(66); end; {case} expressionType := wordPtr; end; {case andandop} carotch: begin {^} GenerateCode(tree^.left); lType := expressionType; GenerateCode(tree^.right); case UsualBinaryConversions(lType) of cgByte,cgUByte,cgWord,cgUWord: Gen0(pc_bxr); cgLong,cgULong: Gen0(pc_blx); otherwise: error(66); end; {case} end; {case carotch} barch: begin {|} GenerateCode(tree^.left); lType := expressionType; GenerateCode(tree^.right); case UsualBinaryConversions(lType) of cgByte,cgUByte,cgWord,cgUWord: Gen0(pc_bor); cgLong,cgULong: Gen0(pc_blr); otherwise: error(66); end; {case} end; {case barch} andch: begin {&} GenerateCode(tree^.left); lType := expressionType; GenerateCode(tree^.right); case UsualBinaryConversions(lType) of cgByte,cgUByte,cgWord,cgUWord: Gen0(pc_bnd); cgLong,cgULong: Gen0(pc_bal); otherwise: error(66); end; {case} end; {case andch} ltltop: begin {<<} GenerateCode(tree^.left); lType := expressionType; GenerateCode(tree^.right); case UsualBinaryConversions(lType) of cgByte,cgUByte,cgWord,cgUWord: Gen0(pc_shl); cgLong,cgULong: Gen0(pc_sll); otherwise: error(66); end; {case} end; {case ltltop} gtgtop: begin {>>} GenerateCode(tree^.left); lType := expressionType; GenerateCode(tree^.right); case UsualBinaryConversions(lType) of cgByte,cgWord: Gen0(pc_shr); cgUByte,cgUWord: Gen0(pc_usr); cgLong: Gen0(pc_slr); cgULong: Gen0(pc_vsr); otherwise: error(66); end; {case} end; {case gtgtop} plusch: begin {+} if ExpressionKind(tree^.right) in [arrayType,pointerType] then begin tree^.middle := tree^.right; tree^.right := tree^.left; tree^.left := tree^.middle; end; {if} GenerateCode(tree^.left); lType := expressionType; GenerateCode(tree^.right); if lType^.kind in [arrayType,pointerType] then begin {pointer addition} et := UsualUnaryConversions; expressionType := lType; if lType^.kind = arrayType then lType := lType^.aType else lType := lType^.pType; ChangePointer(pc_adl, lType^.size, et); end {if} else begin {scalar addition} case UsualBinaryConversions(lType) of cgByte,cgUByte,cgWord,cgUWord: Gen0(pc_adi); cgLong,cgULong: Gen0(pc_adl); cgExtended: Gen0(pc_adr); otherwise: error(66); end; {case} end; {else} end; {case plusch} minusch: begin {-} GenerateCode(tree^.left); lType := expressionType; GenerateCode(tree^.right); if lType^.kind in [pointerType,arrayType] then begin if lType^.kind = arrayType then size := lType^.aType^.size else size := lType^.pType^.size; if expressionType^.kind in [arrayType,pointerType] then begin {subtraction of two pointers} Gen0(pc_sbl); if size <> 1 then begin GenLdcLong(size); Gen0(pc_dvl); end; {if} lType := longPtr; end {if} else {subtract a scalar from a pointer} ChangePointer(pc_sbl, size, UsualUnaryConversions); expressionType := lType; end {if} else begin {scalar subtraction} case UsualBinaryConversions(lType) of cgByte,cgUByte,cgWord,cgUWord: Gen0(pc_sbi); cgLong,cgULong: Gen0(pc_sbl); cgExtended: Gen0(pc_sbr); otherwise: error(66); end; {case} end; {else} end; {case minusch} asteriskch: begin {*} GenerateCode(tree^.left); lType := expressionType; GenerateCode(tree^.right); case UsualBinaryConversions(lType) of cgByte,cgWord: Gen0(pc_mpi); cgUByte,cgUWord: Gen0(pc_umi); cgLong: Gen0(pc_mpl); cgULong: Gen0(pc_uml); cgExtended: Gen0(pc_mpr); otherwise: error(66); end; {case} end; {case asteriskch} slashch: begin {/} GenerateCode(tree^.left); lType := expressionType; GenerateCode(tree^.right); case UsualBinaryConversions(lType) of cgByte,cgWord: Gen0(pc_dvi); cgUByte,cgUWord: Gen0(pc_udi); cgLong: Gen0(pc_dvl); cgULong: Gen0(pc_udl); cgExtended: Gen0(pc_dvr); otherwise: error(66); end; {case} end; {case slashch} percentch: begin {%} GenerateCode(tree^.left); lType := expressionType; GenerateCode(tree^.right); case UsualBinaryConversions(lType) of cgByte,cgWord: Gen0(pc_mod); cgUByte,cgUWord: Gen0(pc_uim); cgLong: Gen0(pc_mdl); cgULong: Gen0(pc_ulm); otherwise: error(66); end; {case} end; {case percentch} eqeqop, {==} exceqop: begin {!=} GenerateCode(tree^.left); lType := expressionType; tlastwasconst := lastwasconst; tlastconst := lastconst; GenerateCode(tree^.right); CompareCompatible(ltype, expressionType); if tree^.token.kind = eqeqop then Gen0t(pc_equ, UsualBinaryConversions(lType)) else Gen0t(pc_neq, UsualBinaryConversions(lType)); expressionType := wordPtr; end; {case exceqop,eqeqop} lteqop, {<=} gteqop, {>=} ltch, {<} gtch: begin {>} GenerateCode(tree^.left); lType := expressionType; GenerateCode(tree^.right); CompareCompatible(ltype, expressionType); if tree^.token.kind = lteqop then Gen0t(pc_leq, UsualBinaryConversions(lType)) else if tree^.token.kind = gteqop then Gen0t(pc_geq, UsualBinaryConversions(lType)) else if tree^.token.kind = ltch then Gen0t(pc_les, UsualBinaryConversions(lType)) else {if tree^.token.kind = gtch then} Gen0t(pc_grt, UsualBinaryConversions(lType)); expressionType := wordPtr; end; {case lteqop,gteqop,ltch,gtch} uminus: begin {unary -} GenerateCode(tree^.left); case UsualUnaryConversions of cgByte,cgUByte,cgWord,cgUWord: Gen0(pc_ngi); cgLong,cgULong: Gen0(pc_ngl); cgExtended: Gen0(pc_ngr); otherwise: error(66); end; {case} end; {case uminus} tildech: begin {~} GenerateCode(tree^.left); case UsualUnaryConversions of cgByte,cgUByte,cgWord,cgUWord: Gen0(pc_bnt); cgLong,cgULong: Gen0(pc_bnl); otherwise: error(66); end; {case} end; {case tildech} excch: begin {!} GenerateCode(tree^.left); if expressionType^.kind = pointerType then expressionType := uLongPtr; case UsualUnaryConversions of cgByte,cgUByte,cgWord,cgUWord: Gen0(pc_not); cgLong,cgULong: begin GenLdcLong(0); Gen0t(pc_equ, cgLong); end; cgExtended: begin GenLdcReal(0.0); Gen0t(pc_equ, cgExtended); end; otherwise: error(66); end; {case} expressionType := wordPtr; end; {case excch} plusplusop: {prefix ++} DoIncDec(tree^.left, pc_lil, pc_gil, pc_iil); opplusplus: {postfix ++} DoIncDec(tree^.left, pc_lli, pc_gli, pc_ili); minusminusop: {prefix --} DoIncDec(tree^.left, pc_ldl, pc_gdl, pc_idl); opminusminus: {postfix --} DoIncDec(tree^.left, pc_lld, pc_gld, pc_ild); uand: {unary & (address operator)} LoadAddress(tree^.left); uasterisk: begin {unary * (indirection)} GenerateCode(tree^.left); lType := expressionType; if lType^.kind in [functiontype,arrayType,pointerType] then begin if lType^.kind = arrayType then lType := lType^.aType else if lType^.kind = pointerType then lType := lType^.pType; expressionType := lType; if lType^.kind = scalarType then if lType^.baseType = cgVoid then Gen1t(pc_ind, 0, cgULong) else Gen1t(pc_ind, 0, lType^.baseType) else if lType^.kind = pointerType then Gen1t(pc_ind, 0, cgULong) else if not (lType^.kind in [functionType,arrayType,structType,unionType]) then Error(79); end {if} else if not (lType^.kind in [structType,unionType]) then Error(79); end; {case uasterisk} dotch: begin {.} LoadAddress(tree^.left); lType := expressionType; if lType^.kind in [arrayType,pointerType] then begin if lType^.kind = arrayType then lType := lType^.aType else if lType^.kind = pointerType then lType := lType^.pType; DoSelection(lType, tree^.right, size); if (size & $00007FFF) <> size then begin GenLdcLong(size); Gen0(pc_adl); size := 0; end; {else} kind := expressionType^.kind; if kind = scalarType then begin et := expressionType^.baseType; if isBitField then begin GenLdcLong(size); Gen0(pc_adl); if unsigned then Gen2t(pc_lbu, bitDisp, bitSize, et) else Gen2t(pc_lbf, bitDisp, bitSize, et); end {if} else Gen1t(pc_ind, long(size).lsw, et); end {if} else if kind = pointerType then Gen1t(pc_ind, long(size).lsw, cgULong) else if kind = enumType then Gen1t(pc_ind, long(size).lsw, cgWord) else if size <> 0 then Gen1t(pc_inc, long(size).lsw, cgULong); end {if} else Error(79); end; {case dotch} colonch: begin {? :} GenerateCode(tree^.left); {evaluate the condition} CompareToZero(pc_neq); GenerateCode(tree^.middle); {evaluate true expression} lType := expressionType; tlastwasconst := lastwasconst; tlastconst := lastconst; GenerateCode(tree^.right); {evaluate false expression} isString := false; {handle string operands} if lType^.kind in [arrayType,pointerType] then if lType^.aType^.baseType = cgUByte then begin with expressionType^ do if kind in [arrayType,pointerType] then begin if aType^.baseType = cgUByte then isString := true else if (kind = pointerType) and (CompTypes(lType,expressionType)) then {it's all OK} else Error(47) end {if} else if (kind = scalarType) and lastWasConst and (lastConst = 0) then et := UsualBinaryConversions(lType) {it's all OK} else Error(47); lType := voidPtrPtr; expressionType := voidPtrPtr; end; {if} with expressionType^ do if kind in [arrayType,pointerType] then if aType^.baseType in [cgByte,cgUByte] then begin if kind = pointerType then begin if tlastwasconst and (tlastconst = 0) then {it's all OK} else if CompTypes(lType, expressionType) then {it's all OK} else Error(47); end {if} else Error(47); et := UsualBinaryConversions(lType); lType := voidPtrPtr; expressionType := voidPtrPtr; end; {if} {generate the operation} if lType^.kind in [structType, unionType, arrayType] then begin if not CompTypes(lType, expressionType) then Error(47); Gen0(pc_bno); Gen0t(pc_tri, cgULong); end {if} else begin if expressionType^.kind = pointerType then tType := expressionType else tType := lType; et := UsualBinaryConversions(lType); Gen0(pc_bno); Gen0t(pc_tri, et); end; {else} if isString then {set the type for strings} expressionType := stringTypePtr; end; {case colonch} castoper: begin {(cast)} GenerateCode(tree^.left); Cast(tree^.castType); end; {case castoper} otherwise: Error(57); end; {case} if doDispose then dispose(tree); end; {GenerateCode} procedure Expression {kind: expressionKind; stopSym: tokenSet}; { handle an expression } { } { parameters: } { kind - Kind of expression; determines what operations } { and what kind of operands are allowed. } { stopSym - Set of symbols that can mark the end of an } { expression; used to skip tokens after syntax } { errors and to block certain operations. For } { example, the comma operator is not allowed in } { an expression when evaluating a function } { parameter list. } { } { variables: } { realExpressionValue - value of a real constant } { expression } { expressionValue - value of a constant expression } { expressionType - type of the constant expression } label 1; var lcodeGeneration: boolean; {local copy of codeGeneration} ldoDispose: boolean; {local copy of doDispose} tree: tokenPtr; {expression tree} castValue: tokenPtr; {element being type cast} begin {Expression} errorFound := false; {no error so far} tree := ExpressionTree(kind, stopSym); {create the expression tree} if kind = normalExpression then begin {generate code from the expression tree} if not errorFound then begin doDispose := true; GenerateCode(tree); end; {if} end {if} else begin {record the expression for an initializer} initializerTree := tree; isConstant := false; if errorFound then begin DisposeTree(initializerTree); initializerTree := nil; end {if} else begin ldoDispose := doDispose; {find the expression type} doDispose := false; lcodeGeneration := codeGeneration; codeGeneration := false; GenerateCode(tree); doDispose := ldoDispose; codeGeneration := lCodeGeneration and (numErrors = 0); {record the expression} if tree^.token.kind = castoper then begin castValue := tree^.left; while castValue^.token.kind = castoper do castValue := castValue^.left; if castValue^.token.kind in [intconst,uintconst] then begin expressionValue := castValue^.token.ival; isConstant := true; expressionType := tree^.castType; if (castValue^.token.kind = uintconst) or (expressionType^.kind = pointerType) then expressionValue := expressionValue & $0000FFFF; goto 1; end; {if} if castValue^.token.kind in [longconst,ulongconst] then begin expressionValue := castValue^.token.lval; isConstant := true; expressionType := tree^.castType; goto 1; end; {if} end; {if} if tree^.token.kind = intconst then begin expressionValue := tree^.token.ival; expressionType := wordPtr; isConstant := true; end {else if} else if tree^.token.kind = uintconst then begin expressionValue := tree^.token.ival; expressionType := uwordPtr; isConstant := true; end {else if} else if tree^.token.kind = longconst then begin expressionValue := tree^.token.lval; expressionType := longPtr; isConstant := true; end {else if} else if tree^.token.kind = ulongconst then begin expressionValue := tree^.token.lval; expressionType := ulongPtr; isConstant := true; end {else if} else if tree^.token.kind = doubleconst then begin realExpressionValue := tree^.token.rval; expressionType := extendedPtr; isConstant := true; if kind in [arrayExpression,preprocessorExpression] then begin expressionType := wordPtr; expressionValue := 1; Error(47); end; {if} end {else if} else if tree^.token.kind = stringconst then begin expressionValue := ord4(tree^.token.sval); expressionType := stringTypePtr; isConstant := true; if kind in [arrayExpression,preprocessorExpression] then begin expressionType := wordPtr; expressionValue := 1; Error(47); end; {if} end {else if} else if kind in [arrayExpression,preprocessorExpression] then begin DisposeTree(initializerTree); expressionValue := 1; end; {else if} end; {else} end; {else} 1: end; {Expression} procedure InitExpression; { initialize the expression handler } begin {InitExpression} startTerm := [ident,intconst,uintconst,longconst,ulongconst,doubleconst, stringconst]; startExpression:= startTerm + [lparench,asteriskch,andch,plusch,minusch,excch,tildech,sizeofsy, plusplusop,minusminusop,typedef]; end; {InitExpression} end. {$append 'expression.asm'} \ No newline at end of file +{$optimize 1} +{---------------------------------------------------------------} +{ } +{ Expression } +{ } +{ Evaluate expressions } +{ } +{ Note: The expression evaluator uses the scanner to fetch } +{ tokens, but IT IS ALSO USED BY THE SCANNER to evaluate } +{ expressions in preprocessor commands. This circular } +{ dependency is handle by defining all of the expression } +{ evaluator's external types, constants, and variables in the } +{ CCOMMON module. The only procedure from this module used by } +{ the scanner is Expression, which is declared as an external } +{ procedure in the scanner. } +{ } +{ External Variables: } +{ } +{ startExpression - tokens that may start an expression } +{ bitDisp,bitSize - bit field disp, size } +{ unsigned - is the bit field unsigned? } +{ isBitField - is the field a bit field? } +{ } +{ External Subroutines: } +{ } +{ AssignmentConversion - do type checking and conversions for } +{ assignment statements } +{ CompareToZero - Compare the result on tos to zero. } +{ DisposeTree - dispose of an expression tree } +{ DoSelection - Find the displacement & type for a } +{ selection operation } +{ Expression - handle an expression } +{ FreeTemp - place a temporary label in the available label } +{ list } +{ GenerateCode - generate code from a fully formed expression } +{ tree } +{ GetTemp - find a temporary work variable } +{ InitExpression - initlialize the expression handler } +{ UsualBinaryConversions - performs the usual binary } +{ conversions } +{ UsualUnaryConversions - performs the usual unary conversions } +{ } +{---------------------------------------------------------------} + +unit Expression; + +{$LibPrefix '0/obj/'} + +interface + +uses CCommon, Table, CGI, Scanner, Symbol, MM; + +{$segment 'exp'} + +var + startExpression: tokenSet; {tokens that can start an expression} + + {set by DoSelection} + {------------------} + bitDisp,bitSize: integer; {bit field disp, size} + unsigned: boolean; {is the bit field unsigned?} + isBitField: boolean; {is the field a bit field?} + + {misc} + {----} + lastwasconst: boolean; {did the last GenerateCode result in an integer constant?} + lastconst: longint; {last integer constant from GenerateCode} +{---------------------------------------------------------------} + +procedure AssignmentConversion (t1, t2: typePtr; isConstant: boolean; + value: longint; genCode, checkConst: boolean); + +{ TOS is of type t2, and is about to be stored to a variable of } +{ type t1 by an assignment or a return statement. Make sure } +{ this is legal, and do any necessary type conversions on t2, } +{ which is on the top of the evaluation stack. Flag an error } +{ if the conversion is illegal. } +{ } +{ parameters: } +{ t1 - type of the variable } +{ t2 - type of the expression } +{ isConstant - is the rhs a constant? } +{ value - if isConstant = true, then this is the value } +{ genCode - should conversion code be generated? } +{ checkConst - check for assignments to constants? } + + +procedure CompareToZero(op: pcodes); + +{ Compare the result on tos to zero. } +{ } +{ This procedure is used by the logical statements to compare } +{ _any_ scalar result to zero, giving a boolean result. } +{ } +{ parameters: } +{ op - operation to use on the compare } + + +procedure DisposeTree (tree: tokenPtr); + +{ dispose of an expression tree } +{ } +{ parameters: } +{ tree - head of the expression tree to dispose of } + + +procedure DoSelection (lType: typePtr; tree: tokenPtr; var size: longint); + +{ Find the displacement & type for a selection operation } +{ } +{ parameters: } +{ lType - structure/union type } +{ id - tag field name } +{ size - disp into the structure/union } +{ } +{ returned in non-local variables: } +{ bitDisp - displacement to bit field } +{ bitSize - size of bit field } +{ unsigned - is the bit field unsigned? } +{ isBitField - is the field a bit field? } +{ } +{ varaibles: } +{ expressionType - set to the type of the field } + + +procedure Expression (kind: expressionKind; stopSym: tokenSet); + +{ handle an expression } +{ } +{ parameters: } +{ kind - Kind of expression; determines what operations } +{ and what kind of operands are allowed. } +{ stopSym - Set of symbols that can mark the end of an } +{ expression; used to skip tokens after syntax } +{ errors and to block certain operations. For } +{ example, the comma operator is not allowed in } +{ an expression when evaluating a function } +{ parameter list. } +{ } +{ variables: } +{ realExpressionValue - value of a real constant } +{ expression } +{ expressionValue - value of a constant expression } +{ expressionType - type of the constant expression } + + +procedure FreeTemp(labelNum, size: integer); + +{ place a temporary label in the available label list } +{ } +{ parameters: } +{ labelNum - number of the label to free } +{ size - size of the variable } +{ } +{ variables: } +{ tempList - list of free labels } + + +procedure GenerateCode (tree: tokenPtr); + +{ generate code from a fully formed expression tree } +{ } +{ parameters: } +{ tree - top of the expression tree to generate code from } +{ } +{ variables: } +{ expressionType - result type of the expression } + + +function GetTemp(size: integer): integer; + +{ find a temporary work variable } +{ } +{ parameters: } +{ size - size of the variable } +{ } +{ variables: } +{ tempList - list of free labels } +{ } +{ Returns the label number. } + + +procedure InitExpression; + +{ initialize the expression handler } + + +function UsualBinaryConversions (lType: typePtr): baseTypeEnum; + +{ performs the usual binary conversions } +{ } +{ inputs: } +{ lType - type of the left operand } +{ expressionType - type of the right operand } +{ } +{ result: } +{ The base type of the operation to perform is } +{ returned. Any conversion code necessary has been } +{ generated. } +{ } +{ outputs: } +{ expressionType - set to result type } + + +function UsualUnaryConversions: baseTypeEnum; + +{ performs the usual unary conversions } +{ } +{ inputs: } +{ expressionType - type of the operand } +{ } +{ result: } +{ The base type of the operation to perform is returned. } +{ Any conversion code necessary has been generated. } +{ } +{ outputs: } +{ expressionType - set to result type } + +{---------------------------------------------------------------} + +implementation + +const + {notAnOperation is also used in TABLE.ASM} + notAnOperation = 200; {used as the icp for non-operation tokens} + +var + {structured constants} + {--------------------} + startTerm: tokenSet; {tokens that can start a term} + + {misc} + {----} + errorFound: boolean; {was there are error during generation?} + +{-- Procedures imported from the parser ------------------------} + +procedure Match (kind: tokenEnum; err: integer); extern; + +{ insure that the next token is of the specified type } +{ } +{ parameters: } +{ kind - expected token kind } +{ err - error number if the expected token is not found } + + +procedure TypeSpecifier (doingFieldList,isConstant: boolean); extern; + +{ handle a type specifier } +{ } +{ parameters: } +{ doingFieldList - are we processing a field list? } +{ isConstant - did we already find a constsy? } + +{-- External unsigned math routines ----------------------------} + +function lshr (x,y: longint): longint; extern; + +function udiv (x,y: longint): longint; extern; + +function uge (x,y: longint): longint; extern; + +function ugt (x,y: longint): longint; extern; + +function ule (x,y: longint): longint; extern; + +function ult (x,y: longint): longint; extern; + +function umod (x,y: longint): longint; extern; + +function umul (x,y: longint): longint; extern; + +{---------------------------------------------------------------} + +function Unary(tp: baseTypeEnum): baseTypeEnum; + +{ usual unary conversions } +{ } +{ This function returns the base type actually loaded on the } +{ stack for a particular data type. This corresponds to C's } +{ usual unary conversions. } +{ } +{ parameter: } +{ tp - data type } +{ } +{ result: } +{ Stack type. } + +begin {Unary} +if tp in [cgByte,cgUByte,cgReal,cgDouble,cgComp] then + if tp = cgByte then + tp := cgWord + else if tp = cgUByte then + tp := cgUWord + else {if tp in [cgReal,cgDouble,cgComp] then} + tp := cgExtended; +Unary := tp; +end; {Unary} + + +function UsualBinaryConversions {lType: typePtr): baseTypeEnum}; + +{ performs the usual binary conversions } +{ } +{ inputs: } +{ lType - type of the left operand } +{ expressionType - type of the right operand } +{ } +{ result: } +{ The base type of the operation to perform is } +{ returned. Any conversion code necessary has been } +{ generated. } +{ } +{ outputs: } +{ expressionType - set to result type } + +var + rType: typePtr; {right type} + lt,rt: baseTypeEnum; {work variables} + +begin {UsualBinaryConversions} +UsualBinaryConversions := cgULong; +if lType^.kind = pointerType then + lType := uLongPtr +else if lType^.kind = scalarType then + if lType^.baseType = cgVoid then + lType := uLongPtr; +rType := expressionType; +if rType^.kind = pointerType then + rType := uLongPtr +else if rType^.kind = scalarType then + if rType^.baseType = cgVoid then + rType := uLongPtr; +if (lType^.kind = scalarType) and (rType^.kind = scalarType) then begin + lt := Unary(lType^.baseType); + rt := Unary(rType^.baseType); + if lt <> rt then begin + if lt = cgExtended then begin + if rt in [cgWord,cgUWord,cgLong,cgULong] then + Gen2(pc_cnv, ord(rt), ord(cgExtended)); + UsualBinaryConversions := cgExtended; + expressionType := extendedPtr; + end {if} + else if rt = cgExtended then begin + if lt in [cgWord,cgUWord,cgLong,cgULong] then + Gen2(pc_cnn, ord(lt), ord(cgExtended)); + UsualBinaryConversions := cgExtended; + expressionType := extendedPtr; + end {else if} + else if lt = cgULong then begin + if rt in [cgWord,cgUWord] then + Gen2(pc_cnv, ord(rt), ord(cgULong)); + UsualBinaryConversions := cgULong; + expressionType := uLongPtr; + end {else if} + else if rt = cgULong then begin + if lt in [cgWord,cgUWord] then + Gen2(pc_cnn, ord(lt), ord(cgULong)); + UsualBinaryConversions := cgULong; + expressionType := uLongPtr; + end {else if} + else if lt = cgLong then begin + if rt in [cgWord,cgUWord] then + Gen2(pc_cnv, ord(rt), ord(cgLong)); + UsualBinaryConversions := cgLong; + expressionType := longPtr; + end {else if} + else if rt = cgLong then begin + if lt in [cgWord,cgUWord] then + Gen2(pc_cnn, ord(lt), ord(cgLong)); + UsualBinaryConversions := cgLong; + expressionType := longPtr; + end {else if} + else {one operand is unsigned in and the other is int} begin + UsualBinaryConversions := cgUWord; + expressionType := uWordPtr; + end; {else} + end {if} + else {types are the same} + UsualBinaryConversions := lt; + end {if} +else + Error(66); +end; {UsualBinaryConversions} + + +function UsualUnaryConversions{: baseTypeEnum}; + +{ performs the usual unary conversions } +{ } +{ inputs: } +{ expressionType - type of the operand } +{ } +{ result: } +{ The base type of the operation to perform is returned. } +{ Any conversion code necessary has been generated. } +{ } +{ outputs: } +{ expressionType - set to result type } + +var + lt,rt: baseTypeEnum; {work variables} + +begin {UsualUnaryConversions} +UsualUnaryConversions := cgULong; +if expressionType^.kind = scalarType then + UsualUnaryConversions := Unary(expressionType^.baseType) +{else if expressionType^.kind in [arrayType,pointerType] then + UsualUnaryConversions := cgULong}; +end; {UsualUnaryConversions} + + +procedure DisposeTree {tree: tokenPtr}; + +{ dispose of an expression tree } +{ } +{ parameters: } +{ tree - head of the expression tree to dispose of } + +begin {DisposeTree} +if tree <> nil then begin + DisposeTree(tree^.left); + DisposeTree(tree^.middle); + DisposeTree(tree^.right); + dispose(tree); + end; {if} +end; {DisposeTree} + + +procedure AssignmentConversion {t1, t2: typePtr; isConstant: boolean; + value: longint; genCode, checkConst: boolean}; + +{ TOS is of type t2, and is about to be stored to a variable of } +{ type t1 by an assignment or a return statement. Make sure } +{ this is legal, and do any necessary type conversions on t2, } +{ which is on the top of the evaluation stack. Flag an error } +{ if the conversion is illegal. } +{ } +{ parameters: } +{ t1 - type of the variable } +{ t2 - type of the expression } +{ isConstant - is the rhs a constant? } +{ value - if isConstant = true, then this is the value } +{ genCode - should conversion code be generated? } +{ checkConst - check for assignments to constants? } + +var + baseType1,baseType2: baseTypeEnum; {temp variables (for speed)} + kind1,kind2: typeKind; {temp variables (for speed)} + +begin {AssignmentConversion} +kind1 := t1^.kind; +kind2 := t2^.kind; +if t1^.isConstant then + if genCode then + if checkConst then + Error(93); +if kind2 = definedType then + AssignmentConversion(t1, t2^.dType, false, 0, genCode, checkConst) +else if kind1 = definedType then + AssignmentConversion(t1^.dType, t2, false, 0, genCode, checkConst) +else if kind2 in + [scalarType,pointerType,enumType,structType,unionType,arrayType,functionType] then + case kind1 of + + scalarType: begin + baseType1 := t1^.baseType; + if baseType1 = cgString then + Error(64) + else if baseType1 = cgVoid then + Error(65) + else if kind2 = enumType then begin + if genCode then + Gen2(pc_cnv, ord(cgWord), ord(baseType1)); + end {else if} + else if kind2 = scalarType then begin + baseType2 := t2^.baseType; + if baseType2 in [cgString,cgVoid] then + Error(47) + else if genCode then + Gen2(pc_cnv, ord(baseType2), ord(baseType1)); + end {else if} + else + Error(47); + end; + + arrayType: ; + {any errors are handled elsewhere} + + functionType,enumConst: + Error(47); + + pointerType: begin + if kind2 = pointerType then begin + if not CompTypes(t1, t2) then + Error(47); + end {if} + else if kind2 = arrayType then begin + if not CompTypes(t1^.ptype, t2^.atype) then + if t1^.ptype^.baseType <> cgVoid then + Error(47); + end {if} + else if kind2 = scalarType then begin + if isConstant and (value = 0) then begin + if genCode then + Gen2(pc_cnv, ord(t2^.baseType), ord(cgULong)); + end {if} + else + Error(47); + end {else if} + else + Error(47); + end; + + enumType: begin + if kind2 = scalarType then begin + baseType2 := t2^.baseType; + if baseType2 in [cgString,cgVoid] then + Error(47) + else if genCode then + Gen2(pc_cnv, ord(baseType2), ord(cgWord)); + end {if} + else if kind2 <> enumType then + Error(47); + end; + + definedType: + AssignmentConversion(t1^.dType, t2, isConstant, value, genCode, + checkConst); + + structType,unionType: + if not CompTypes(t1, t2) then + Error(47); + + otherwise: Error(57); + + end; {case T1^.kind} + +expressionType := t1; {set the type of the expression} +end; {AssignmentConversion} + + +function ExpressionTree (kind: expressionKind; stopSym: tokenSet): tokenPtr; + +{ generate an expression tree } +{ } +{ Returns a pointer to the generated tree. The pointer is } +{ nil, and the variable errorFound is set to true, if an } +{ error is found. } +{ } +{ parameters: } +{ kind - Kind of expression; determines what operations } +{ and what kind of operands are allowed. } +{ stopSym - Set of symbols that can mark the end of an } +{ expression; used to skip tokens after syntax } +{ errors and to block certain operations. For } +{ example, the comma operator is not allowed in } +{ an expression when evaluating a function } +{ parameter list. } + +label 1,2; + +var + done,done2: boolean; {for loop termination} + doingSizeof: boolean; {used to test for a sizeof operator} + expectingTerm: boolean; {should the next token be a term?} + opStack: tokenPtr; {operation stack} + parenCount: integer; {# of open parenthesis} + stack: tokenPtr; {operand stack} + + op,sp: tokenPtr; {work pointers} + + + procedure ComplexTerm; + + { handle complex terms } + + var + done: boolean; {for loop termination} + namePtr: stringPtr; {name of struct/union fields} + sp,tp,tm: tokenPtr; {work pointers} + + begin {ComplexTerm} + while token.kind in + [lbrackch,lparench,dotch,minusgtop,plusplusop,minusminusop] do begin + case token.kind of + + lbrackch: begin {subscripting} + NextToken; {skip the '['} + new(sp); {evaluate the subscript} + sp^.token.kind := plusch; + sp^.token.class := reservedSymbol; + sp^.left := stack; + stack := stack^.next; + sp^.middle := nil; + sp^.right := ExpressionTree(normalExpression, [rbrackch]); + sp^.next := stack; + stack := sp; + Match(rbrackch,24); {skip the ']'} + new(sp); {resolve the pointer} + sp^.token.kind := uasterisk; + sp^.token.class := reservedSymbol; + sp^.left := stack; + sp^.middle := nil; + sp^.right := nil; + sp^.next := stack^.next; + stack := sp; + end; + + lparench: begin {function call} + NextToken; + new(sp); {create a parameter list terminator} + sp^.token.kind := parameteroper; + sp^.token.class := reservedSymbol; + sp^.left := nil; + sp^.middle := nil; + sp^.right := nil; + sp^.next := stack; + stack := sp; + if token.kind <> rparench {evaluate the parameters} + then begin + done := false; + repeat + if token.kind in [rparench,eofsy] then begin + done := true; + Error(35); + end {if} + else begin + new(sp); + sp^.token.kind := parameteroper; + sp^.token.class := reservedSymbol; + sp^.left := nil; + sp^.middle := + ExpressionTree(normalExpression, [rparench,commach]); + sp^.right := stack; + sp^.next := stack^.next; + stack := sp; + if token.kind = commach then + NextToken + else + done := true; + end; {else} + until done; + end; {if} + sp := stack; + stack := sp^.next; + sp^.left := stack; + sp^.next := stack^.next; + stack := sp; + Match(rparench,12); + end; + + dotch,minusgtop: begin {direct and indirect selection} + if token.kind = minusgtop then begin + new(sp); {e->name == (*e).name} + sp^.token.kind := uasterisk; + sp^.token.class := reservedSymbol; + sp^.left := stack; + sp^.middle := nil; + sp^.right := nil; + sp^.next := stack^.next; + stack := sp; + token.kind := dotch; + token.class := reservedSymbol; + end; {if} + new(sp); {create a record for the selection operator} + sp^.token := token; + sp^.left := stack; + stack := stack^.next; + sp^.middle := nil; + sp^.right := nil; + sp^.next := stack; + stack := sp; + NextToken; {skip the operator} + if token.kind in [ident,typedef] then begin + namePtr := token.name; {record the name} + new(sp); {record the selection field} + sp^.token := token; + sp^.left := nil; + sp^.middle := nil; + sp^.right := nil; + stack^.right := sp; {this becomes the right opnd} + NextToken; {skip the field name} + end {if} + else + Error(9); + end; + + plusplusop: begin {postfix ++} + NextToken; + new(sp); + sp^.token.kind := opplusplus; + sp^.token.class := reservedSymbol; + sp^.left := stack; + stack := stack^.next; + sp^.middle := nil; + sp^.right := nil; + sp^.next := stack; + stack := sp; + end; + + minusminusop: begin {postfix --} + NextToken; + new(sp); + sp^.token.kind := opminusminus; + sp^.token.class := reservedSymbol; + sp^.left := stack; + stack := stack^.next; + sp^.middle := nil; + sp^.right := nil; + sp^.next := stack; + stack := sp; + end; + + otherwise: Error(57); + end; {case} + end; {while} + end; {ComplexTerm} + + + procedure DoOperand; + + { process an operand } + + label 1,2; + + var + fnPtr: typePtr; {for defining functions on the fly} + fToken: tokenType; {used to save function name token} + id: identPtr; {pointer to an id's symbol table entry} + np: stringPtr; {for forming global names} + sp: tokenPtr; {work pointer} + + begin {DoOperand} + {create an operand on the stack} + new(sp); + sp^.token := token; + sp^.next := stack; + sp^.left := nil; + sp^.middle := nil; + sp^.right := nil; + stack := sp; + + {handle the preprocessor 'defined' function} + if kind = preprocessorExpression then + if token.name^ = 'defined' then begin + expandMacros := false; + NextToken; + sp^.token.kind := intconst; + sp^.token.class := intConstant; + if token.kind in [ident,typedef] then begin + sp^.token.ival := ord(IsDefined(token.name)); + NextToken; + end {if} + else begin + Match(lparench, 13); + if token.kind in [ident,typedef] then begin + sp^.token.ival := ord(IsDefined(token.name)); + NextToken; + end {if} + else begin + Error(9); + sp^.token.ival := 0; + end; {else} + Match(rparench, 12); + end; {else} + expandMacros := true; + goto 1; + end; {if} + + {check for illegal use} + id := FindSymbol(token, variableSpace, false, true); + if not (kind in + [normalExpression,initializerExpression,autoInitializerExpression]) + then begin + if id <> nil then + if id^.itype^.kind = enumConst then + goto 2; + if kind <> preprocessorExpression then begin + op := opStack; + while op <> nil do begin + if op^.token.kind = sizeofsy then + goto 2; + op := op^.next; + end; {while} + Error(41); + errorFound := true; + end; {if} + end; {if} + 2: + {skip the name} + fToken := token; + NextToken; + + {if the id is not declared, create a function returning integer} + if id = nil then begin + if token.kind = lparench then begin + fnPtr := pointer(GCalloc(sizeof(typeRecord))); + {fnPtr^.size := 0;} + {fnPtr^.saveDisp := 0;} + {fnPtr^.isConstant := false;} + fnPtr^.kind := functionType; + fnPtr^.fType := wordPtr; + {fnPtr^.varargs := false;} + {fnPtr^.prototyped := false;} + {fnPtr^.overrideKR := false;} + {fnPtr^.parameterList := nil;} + {fnPtr^.isPascal := false;} + {fnPtr^.toolNum := 0;} + {fnPtr^.dispatcher := 0;} + np := pointer(GMalloc(length(fToken.name^)+1)); + CopyString(pointer(np), pointer(fToken.name)); + id := NewSymbol(np, fnPtr, ident, variableSpace, declared); + if (lint & lintUndefFn) <> 0 then + Error(51); + end {if} + else if kind = preprocessorExpression then begin + stack^.token.kind := intconst; + stack^.token.ival := 0; + end {else if} + else begin + Error(31); + errorFound := true; + end; {else} + end {if id = nill} + else if id^.itype^.kind = enumConst then begin + stack^.token.kind := intconst; + stack^.token.ival := id^.itype^.eval; + end; {else if} + stack^.id := id; {save the identifier} + ComplexTerm; {handle subscripts, selection, etc.} + 1: + end; {DoOperand} + + + procedure Operation; + + { do an operation } + + label 1; + + var + baseType: baseTypeEnum; {base type of value to cast} + class: tokenClass; {class of cast token} + ekind: tokenEnum; {kind of constant expression} + kindLeft, kindRight: tokenEnum; {kinds of operands} + lCodeGeneration: boolean; {local copy of codeGeneration} + op: tokenPtr; {work pointer} + op1,op2: longint; {for evaluating constant expressions} + rop1,rop2: double; {for evaluating double expressions} + tp: typePtr; {cast type} + unsigned, unsigned1: boolean; {is the term unsigned?} + + + function Pop: tokenPtr; + + { pop an operand, returning its pointer } + + begin {Pop} + if stack = nil then begin + Error(36); + errorFound := true; + Pop := nil; + end {if} + else begin + Pop := stack; + stack := stack^.next; + end; {else} + end; {Pop} + + + function RealVal (token: tokenType): double; + + { convert an operand to a real value } + + begin {RealVal} + if token.kind = intconst then + RealVal := token.ival + else if token.kind = uintconst then begin + if token.ival < 0 then + RealVal := (token.ival & $7FFF) + 32768.0 + else + RealVal := token.ival; + end {else if} + else if token.kind = longconst then + RealVal := token.lval + else if token.kind = ulongconst then begin + if token.lval < 0 then + RealVal := (token.lval & $7FFFFFFF) + 2147483648.0 + else + RealVal := token.lval; + end {else if} + else + RealVal := token.rval; + end; {RealVal} + + + function IntVal (token: tokenType): longint; + + { convert an operand to a longint value } + + begin {IntVal} + if token.kind = intconst then + IntVal := token.ival + else if token.kind = uintconst then begin + IntVal := token.ival & $0000FFFF; + unsigned := true; + end {else if} + else if token.kind = longconst then begin + IntVal := token.lval; + ekind := longconst; + end {else if} + else begin + IntVal := token.lval; + ekind := longconst; + unsigned := true; + end; {else} + end; {IntVal} + + + begin {Operation} + op := opStack; {pop the operation} + opStack := op^.next; + case op^.token.kind of + + commach: begin {,} + op^.right := Pop; + op^.left := Pop; + end; + + eqch, {=} + pluseqop, {+=} + minuseqop, {-=} + asteriskeqop, {*=} + slasheqop, {/=} + percenteqop, {%=} + ltlteqop, {<<=} + gtgteqop, {>>=} + andeqop, {&=} + caroteqop, {^=} + bareqop: begin {|=} + op^.right := Pop; + op^.left := Pop; + end; + + colonch: begin {? :} + op^.right := Pop; + op^.middle := Pop; + op^.left := Pop; + if op^.right^.token.kind in + [intconst,uintconst,longconst,ulongconst] then + if op^.left^.token.kind in + [intconst,uintconst,longconst,ulongconst] then + if op^.middle^.token.kind in + [intconst,uintconst,longconst,ulongconst] then begin + if IntVal(op^.left^.token) <> 0 then + op^.token := op^.middle^.token + else + op^.token := op^.right^.token; + dispose(op^.left); + dispose(op^.right); + dispose(op^.middle); + op^.left := nil; + op^.right := nil; + op^.middle := nil; + end; {if} + end; + + questionch: begin {error -> ? should not be unmatched} + Error(29); + errorFound := true; + end; + + barbarop, {||} + andandop, {&&} + carotch, {^} + barch, {|} + andch, {&} + eqeqop, {==} + exceqop, {!=} + ltch, {<} + gtch, {>} + lteqop, {<=} + gteqop, {>=} + ltltop, {<<} + gtgtop, {>>} + plusch, {+} + minusch, {-} + asteriskch, {*} + slashch, {/} + percentch: begin {%} + op^.right := Pop; + op^.left := Pop; + kindRight := op^.right^.token.kind; + kindLeft := op^.left^.token.kind; + if kindRight in [intconst,uintconst,longconst,ulongconst] then begin + if kindLeft in [intconst,uintconst,longconst,ulongconst] then begin + + {do the usual binary conversions} + if (kindRight = ulongconst) or (kindLeft = ulongconst) then + ekind := ulongconst + else if (kindRight = longconst) or (kindLeft = longconst) then + ekind := longconst + else if (kindRight = uintconst) or (kindLeft = uintconst) then + ekind := uintconst + else + ekind := intconst; + + {evaluate a constant operation} + unsigned := false; + op1 := IntVal(op^.left^.token); + unsigned1 := unsigned; + unsigned := false; + op2 := IntVal(op^.right^.token); + unsigned := unsigned or unsigned1; + dispose(op^.right); + op^.right := nil; + dispose(op^.left); + op^.left := nil; + case op^.token.kind of + barbarop : {||} + op1 := ord((op1 <> 0) or (op2 <> 0)); + andandop : {&&} + op1 := ord((op1 <> 0) and (op2 <> 0)); + carotch : op1 := op1 ! op2; {^} + barch : op1 := op1 | op2; {|} + andch : op1 := op1 & op2; {&} + eqeqop : begin {==} + op1 := ord(op1 = op2); + ekind := intconst; + end; + exceqop : begin {!=} + op1 := ord(op1 <> op2); + ekind := intconst; + end; + ltch : begin {<} + if unsigned then + op1 := ult(op1,op2) + else + op1 := ord(op1 < op2); + ekind := intconst; + end; + gtch : begin {>} + if unsigned then + op1 := ugt(op1,op2) + else + op1 := ord(op1 > op2); + ekind := intconst; + end; + lteqop : begin {<=} + if unsigned then + op1 := ule(op1,op2) + else + op1 := ord(op1 <= op2); + ekind := intconst; + end; + gteqop : begin {>=} + if unsigned then + op1 := uge(op1,op2) + else + op1 := ord(op1 >= op2); + ekind := intconst; + end; + ltltop : op1 := op1 << op2; {<<} + gtgtop : if unsigned1 then {>>} + op1 := lshr(op1,op2) + else + op1 := op1 >> op2; + plusch : op1 := op1 + op2; {+} + minusch : op1 := op1 - op2; {-} + asteriskch : if unsigned then {*} + op1 := umul(op1,op2) + else + op1 := op1 * op2; + slashch : begin {/} + if op2 = 0 then begin + Error(109); + op2 := 1; + end; {if} + if unsigned then + op1 := udiv(op1,op2) + else + op1 := op1 div op2; + end; + percentch : begin {%} + if op2 <= 0 then begin + Error(109); + op2 := 1; + end; {if} + if unsigned then + op1 := umod(op1,op2) + else + op1 := op1 mod op2; + end; + otherwise: Error(57); + end; {case} + op^.token.kind := ekind; + if ekind in [longconst,ulongconst] then begin + op^.token.lval := op1; + op^.token.class := longConstant; + end {if} + else begin + op^.token.ival := long(op1).lsw; + op^.token.class := intConstant; + end; {else} + goto 1; + end; {if} + end; {if} + if op^.right^.token.kind in + [intconst,uintconst,longconst,ulongconst,doubleconst] then + if op^.left^.token.kind in + [intconst,uintconst,longconst,ulongconst,doubleconst] then + begin + ekind := doubleconst; {evaluate a constant operation} + rop1 := RealVal(op^.left^.token); + rop2 := RealVal(op^.right^.token); + dispose(op^.right); + op^.right := nil; + dispose(op^.left); + op^.left := nil; + case op^.token.kind of + barbarop : {||} + rop1 := ord((rop1 <> 0.0) or (rop2 <> 0.0)); + andandop : {&&} + rop1 := ord((rop1 <> 0.0) and (rop2 <> 0.0)); + eqeqop : begin {==} + op1 := ord(rop1 = rop2); + ekind := intconst; + end; + exceqop : begin {!=} + op1 := ord(rop1 <> rop2); + ekind := intconst; + end; + ltch : begin {<} + op1 := ord(rop1 < rop2); + ekind := intconst; + end; + gtch : begin {>} + op1 := ord(rop1 > rop2); + ekind := intconst; + end; + lteqop : begin {<=} + op1 := ord(rop1 <= rop2); + ekind := intconst; + end; + gteqop : begin {>=} + op1 := ord(rop1 >= rop2); + ekind := intconst; + end; + plusch : rop1 := rop1 + rop2; {+} + minusch : rop1 := rop1 - rop2; {-} + asteriskch : rop1 := rop1 * rop2; {*} + slashch : begin {/} + if rop2 = 0.0 then begin + Error(109); + rop2 := 1.0; + end; {if} + rop1 := rop1 / rop2; + end; + otherwise : Error(66); {illegal operation} + end; {case} + if ekind = intconst then begin + op^.token.ival := long(op1).lsw; + op^.token.class := intConstant; + op^.token.kind := intConst; + end {if} + else begin + op^.token.rval := rop1; + op^.token.class := doubleConstant; + op^.token.kind := doubleConst; + end; {else} + end; {if} +1: + end; + + plusplusop, {prefix ++} + minusminusop, {prefix --} + opplusplus, {postfix ++} + opminusminus, {postfix --} + sizeofsy, {sizeof} + castoper, {(type)} + typedef, {(type-name)} + tildech, {~} + excch, {!} + uminus, {unary -} + uand, {unary &} + uasterisk: begin {unary *} + op^.left := Pop; + + if op^.token.kind = sizeofsy then begin + op^.token.kind := longConst; + op^.token.class := longConstant; + if op^.left^.token.kind = stringConst then + op^.token.lval := op^.left^.token.sval^.length+1 + else begin + lCodeGeneration := codeGeneration; + codeGeneration := false; + GenerateCode(op^.left); + codeGeneration := lCodeGeneration and (numErrors = 0); + op^.token.lval := expressionType^.size; + with expressionType^ do + if kind = arrayType then + if (elements = 0) or (size = 0) then + Error(49); + end; {else} + op^.left := nil; + end {if sizeofsy} + + else if op^.token.kind = castoper then begin + class := op^.left^.token.class; + if class in [intConstant,longConstant,doubleConstant] then begin + tp := op^.castType; + while tp^.kind = definedType do + tp := tp^.dType; + if tp^.kind = scalarType then begin + baseType := tp^.baseType; + if baseType < cgString then begin + if class = doubleConstant then begin + rop1 := RealVal(op^.left^.token); + op1 := trunc(rop1); + end {if} + else {if class in [intConstant,longConstant] then} begin + op1 := IntVal(op^.left^.token); + if op1 >= 0 then + rop1 := op1 + else if op^.left^.token.kind = uintConst then + rop1 := (op1 & $7FFF) + 32768.0 + else if op^.left^.token.kind = ulongConst then + rop1 := (op1 & $7FFFFFFF) + 2147483648.0 + else + rop1 := op1; + end; {else if} + dispose(op^.left); + op^.left := nil; + if baseType in [cgByte,cgWord] then begin + op^.token.kind := intConst; + op^.token.class := intConstant; + op^.token.ival := long(op1).lsw; + if baseType = cgByte then + with op^.token do begin + ival := ival & $00FF; + if (ival & $0080) <> 0 then + ival := ival | $FF00; + end; {with} + end {if} + else if baseType in [cgUByte,cgUWord] then begin + op^.token.kind := uintConst; + op^.token.class := intConstant; + op^.token.ival := long(op1).lsw; + if baseType = cgUByte then + op^.token.ival := op^.token.ival & $00FF; + end {else if} + else if baseType = cgLong then begin + op^.token.kind := longConst; + op^.token.class := longConstant; + op^.token.lval := op1; + end {else if} + else if baseType = cgULong then begin + op^.token.kind := ulongConst; + op^.token.class := longConstant; + op^.token.lval := op1; + end {else if} + else begin + op^.token.kind := doubleConst; + op^.token.class := doubleConstant; + op^.token.rval := rop1; + end; {else if} + end; {if} + end; {if} + end; {if} + end {else if castoper} + + else if not (op^.token.kind in + [typedef,plusplusop,minusminusop,opplusplus,opminusminus,uand]) then + begin + if (op^.left^.token.kind + in [intconst,uintconst,longconst,ulongconst]) then begin + + {evaluate a constant operation} + ekind := op^.left^.token.kind; + op1 := IntVal(op^.left^.token); + dispose(op^.left); + op^.left := nil; + case op^.token.kind of + opplusplus, {posfix ++} + plusplusop : op1 := op1+1; {prefix ++} + opminusminus, {postfix --} + minusminusop: op1 := op1-1; {prefix --} + tildech : op1 := ~op1; {~} + excch : begin {!} + op1 := ord(op1 = 0); + ekind := intconst; + end; + uminus : op1 := -op1; {unary -} + uand : op1 := 0; {unary &} + uasterisk : op1 := 0; {unary *} + otherwise: Error(57); + end; {case} + op^.token.kind := ekind; + if ekind in [longconst,ulongconst] then begin + op^.token.class := longConstant; + op^.token.lval := op1; + end {if} + else begin + op^.token.class := intConstant; + op^.token.ival := long(op1).lsw; + end; {else} + end {if} + else if op^.left^.token.kind = doubleconst then begin + ekind := doubleconst; {evaluate a constant operation} + rop1 := RealVal(op^.left^.token); + dispose(op^.left); + op^.left := nil; + case op^.token.kind of + uminus : begin {unary -} + op^.token.class := doubleConstant; + op^.token.kind := doubleConst; + op^.token.rval := -rop1; + end; + otherwise : begin {illegal operation} + Error(66); + op^.token.class := doubleConstant; + op^.token.kind := doubleConst; + op^.token.rval := rop1; + end; + end; {case} + end; {if} + end; {if} + end; + + otherwise: Error(57); + end; {case} + op^.next := stack; {place the operation on the operand stack} + stack := op; + end; {Operation} + + + procedure Skip; + + { skip all tokens in the reminader of the expression } + + begin {Skip} + while not (token.kind in stopSym+[eofsy]) do + NextToken; + errorFound := true; + end; {Skip} + + + procedure TypeName; + + { find the type (used for casts and sizeof) } + { } + { outputs: } + { typeSpec - pointer to the type } + + var + tl,tp: typePtr; {for creating/reversing the type list} + + + procedure AbstractDeclarator; + + { process an abstract declarator } + { } + { abstract-declarator: } + { empty-abstract-declarator } + { nonempty-abstract-declarator } + + + procedure NonEmptyAbstractDeclarator; + + { process a nonempty abstract declarator } + { } + { nonempty-abstract-declarator: } + { ( nonempty-abstract-declarator ) } + { abstract-declarator ( ) } + { abstract-declaraotr [ expression OPT ] } + { * abstract-declarator } + + var + pcount: integer; {paren counter} + tp: typePtr; {work pointer} + + begin {NonEmptyAbstractDeclarator} + if token.kind = lparench then begin + NextToken; + if token.kind = rparench then begin + + {create a function type} + tp := pointer(Calloc(sizeof(typeRecord))); + {tp^.size := 0;} + {tp^.saveDisp := 0;} + {tp^.isConstant := false;} + tp^.kind := functionType; + {tp^.varargs := false;} + {tp^.prototyped := false;} + {tp^.overrideKR := false;} + {tp^.parameterList := nil;} + {tp^.isPascal := false;} + {tp^.toolNum := 0;} + {tp^.dispatcher := 0;} + tp^.fType := tl; + tl := tp; + NextToken; + end {if} + else begin + + {handle a perenthesized type} + if not (token.kind in [lparench,asteriskch,lbrackch]) then + begin + Error(82); + while not (token.kind in + [eofsy,lparench,asteriskch,lbrackch,rparench]) do + NextToken; + errorFound := true; + end; {if} + if token.kind in [lparench,asteriskch,lbrackch] then + NonEmptyAbstractDeclarator; + Match(rparench,12); + end; {else} + end {if token.kind = lparench} + else if token.kind = asteriskch then begin + + {create a pointer type} + NextToken; + AbstractDeclarator; + tp := pointer(Malloc(sizeof(typeRecord))); + tp^.size := cgLongSize; + tp^.saveDisp := 0; + tp^.isConstant := false; + tp^.kind := pointerType; + tp^.fType := tl; + tl := tp; + end {else if token.kind = asteriskch} + else {if token.kind = lbrackch then} begin + + {create an array type} + NextToken; + if token.kind = rbrackch then + expressionValue := 0 + else begin + Expression(arrayExpression, [rbrackch]); + if expressionValue <= 0 then begin + Error(45); + expressionValue := 1; + end; {if} + end; {else} + tp := pointer(Malloc(sizeof(typeRecord))); + tp^.saveDisp := 0; + tp^.kind := arrayType; + tp^.elements := expressionValue; + tp^.fType := tl; + tl := tp; + Match(rbrackch,24); + end; {else} + + if token.kind = lparench then begin + {create a function type} + NextToken; + pcount := 1; + while (token.kind <> eofsy) and (pcount <> 0) do begin + if token.kind = rparench then + pcount := pcount-1 + else if token.kind = lparench then + pcount := pcount+1; + NextToken; + end; {while} + tp := pointer(Calloc(sizeof(typeRecord))); + {tp^.size := 0;} + {tp.saveDisp := 0;} + {tp^.isConstant := false;} + tp^.kind := functionType; + {tp^.varargs := false;} + {tp^.prototyped := false;} + {tp^.overrideKR := false;} + {tp^.parameterList := nil;} + {tp^.isPascal := false;} + {tp^.toolNum := 0;} + {tp^.dispatcher := 0;} + tp^.fType := tl; + tl := tp; + end; {if} + end; {NonEmptyAbstractDeclarator} + + + begin {AbstractDeclarator} + while token.kind in [lparench,asteriskch,lbrackch] do + NonEmptyAbstractDeclarator; + end; {AbstractDeclarator} + + + begin {TypeName} + {read and process the type specifier} + typeSpec := wordPtr; + TypeSpecifier(false,false); + + {handle the abstract-declarator part} + tl := nil; {no types so far} + AbstractDeclarator; {create the type list} + while tl <> nil do begin {reverse the list & compute array sizes} + tp := tl^.aType; {NOTE: assumes aType, pType and fType overlap in typeRecord} + tl^.aType := typeSpec; + if tl^.kind = arrayType then + tl^.size := tl^.elements * typeSpec^.size; + typeSpec := tl; + tl := tp; + end; {while} + end; {TypeName} + + +begin {ExpressionTree} +opStack := nil; +stack := nil; +if token.kind = typedef then {handle typedefs that are hidden} + if FindSymbol(token,allSpaces,false,true) <> nil then + if token.symbolPtr^.class <> typedefsy then + token.kind := ident; +if token.kind in startExpression then begin + expressionValue := 0; {initialize the expression value} + expectingTerm := true; {the first item should be a term} + done := false; {convert the expression to postfix form} + parenCount := 0; + repeat {scan the token list...} + if token.kind in startTerm then begin + + {we must expect a term or unary operand} + if not expectingTerm then begin + Error(36); + Skip; + goto 1; + end; {if} + if token.kind = ident then + + {handle a complex operand} + DoOperand + else begin + {handle a constant operand} + new(sp); + sp^.token := token; + sp^.next := stack; + sp^.left := nil; + sp^.middle := nil; + sp^.right := nil; + stack := sp; + if kind in [preprocessorExpression,arrayExpression] then + if token.kind in [stringconst,doubleconst] then begin + Error(41); + errorFound := true; + end; {if} + NextToken; + ComplexTerm; + end; {else} + expectingTerm := false; {the next thing should be an operation} + end {else} + {handle a closing parenthesis} + else if (token.kind = rparench) and (parenCount > 0) then begin + if expectingTerm then begin {make sure it is in a legal spot} + Error(37); + Skip; + goto 1; + end; {if} + while opStack^.token.kind <> lparench do + Operation; {do pending operations} + op := opStack; + opStack := op^.next; + dispose(op); + parenCount := parenCount-1; + NextToken; {skip the ')'} + ComplexTerm; {handle subscripts, selection, etc.} + end {else} + else if token.kind = lparench then begin + + {handle open paren and type casts} + if not expectingTerm then begin + Error(38); + Skip; + goto 1; + end; {if} + NextToken; + if token.kind in [unsignedsy,intsy,longsy,charsy,shortsy,floatsy, + doublesy,compsy,extendedsy,voidsy,enumsy,structsy,unionsy, + typedef,constsy,volatilesy,signedsy] then begin + doingSizeof := false; + if opStack <> nil then + if opStack^.token.kind = sizeofsy then + doingSizeof := true; + TypeName; + if doingSizeof then begin + + {handle a sizeof operator} + op := opStack; + opStack := op^.next; + dispose(op); + new(sp); + sp^.next := stack; + sp^.left := nil; + sp^.middle := nil; + sp^.right := nil; + sp^.token.kind := longconst; + sp^.token.class := longConstant; + sp^.token.lval := typeSpec^.size; + if typeSpec^.kind = arrayType then + if (typeSpec^.elements = 0) or (typeSpec^.size = 0) then + Error(49); + sp^.next := stack; + stack := sp; + expectingTerm := false; + end {if} + else {doing a cast} begin + + {handle a type cast} + new(op); {stack the cast operator} + op^.left := nil; + op^.middle := nil; + op^.right := nil; + op^.castType := typeSpec; + op^.token.kind := castoper; + op^.token.class := reservedWord; + op^.next := opStack; + opStack := op; + end; {else} + Match(rparench,12); + end {if} + else begin + new(op); {record the '('} + op^.next := opStack; + op^.left := nil; + op^.middle := nil; + op^.right := nil; + opStack := op; + op^.token.kind := lparench; + op^.token.class := reservedSymbol; + parenCount := parenCount+1; + end; + end {else if} + else begin {handle an operation...} + if expectingTerm then {convert unary operators to separate tokens} + if token.kind in [asteriskch,minusch,plusch,andch] then + case token.kind of + asteriskch: token.kind := uasterisk; + minusch : token.kind := uminus; + andch : token.kind := uand; + plusch : begin + NextToken; + goto 2; + end; + otherwise : Error(57); + end; {case} + if icp[token.kind] = notAnOperation then + done := true {end of expression found...} + else if (token.kind in stopSym) and (parenCount = 0) then + done := true + else begin + if not (kind in [normalExpression, autoInitializerExpression]) then + if (token.kind in + [plusplusop,minusminusop,eqch,pluseqop,minuseqop, + opplusplus,opminusminus, + asteriskeqop,slasheqop,percenteqop,ltlteqop, + gtgteqop,caroteqop,bareqop,commach]) + or ((kind = preprocessorExpression) + and (token.kind = sizeofsy)) + or ((kind <> initializerExpression) + and (token.kind = uand)) then begin + Error(40); + errorFound := true; + end; {if} + if token.kind in {make sure we get what we want} + [plusplusop,minusminusop,sizeofsy,tildech,excch, + uasterisk,uminus,uand] then begin + if not expectingTerm then begin + Error(38); + Skip; + goto 1; + end; {if} + end {if} + else begin + if expectingTerm then begin + Error(37); + Skip; + goto 1; + end; {if} + expectingTerm := true; + {handle 2nd half of ternary operator} + if token.kind = colonch then begin + done2 := false; {do pending operations} + repeat + if opStack = nil then + done2 := true + else if opStack^.token.kind <> questionch then + Operation + else + done2 := true; + until done2; + if (opStack = nil) or + (opStack^.token.kind <> questionch) then begin + Error(39); + Skip; + goto 1; + end; {if} + op := opStack; + opStack := op^.next; + dispose(op); + end {if} + else begin + done2 := false; {do operations with less precidence} + repeat + if opStack = nil then + done2 := true + else if isp[opStack^.token.kind] >= icp[token.kind] then + Operation + else + done2 := true; + until done2; + end; {else} + end; {else} + new(op); {record the operation} + op^.next := opStack; + op^.left := nil; + op^.middle := nil; + op^.right := nil; + opStack := op; + op^.token := token; + NextToken; + end; {else} + end; {else} +2: + until done; + if parenCount > 0 then begin + Error(12); + errorFound := true; + end {if} + else begin + while opStack <> nil do {do pending operations} + Operation; + {there should be exactly one operand left} + if (stack = nil) or (stack^.next <> nil) then begin + Error(36); + errorFound := true; + end; {if} + end; {else} + end {if} +else begin {the start of an expression was not found} + Error(35); + if not (token.kind in stopSym) then + NextToken; + Skip; + end; {else} +1: +if errorFound then begin + while opStack <> nil do begin + op := opStack; + opStack := op^.next; + dispose(op); + end; {while} + while stack <> nil do begin + sp := stack; + stack := sp^.next; + DisposeTree(sp); + end; {while} + ExpressionTree := nil; + end {if} +else + ExpressionTree := stack; +end; {ExpressionTree} + + +procedure CompareToZero {op: pcodes}; + +{ Compare the result on tos to zero. } +{ } +{ This procedure is used by the logical statements to compare } +{ _any_ scalar result to zero, giving a boolean result. } +{ } +{ parameters: } +{ op - operation to use on the compare } + +var + bt: baseTypeEnum; {base type of loaded value} + +begin {CompareToZero} +if expressionType^.kind = pointerType then + expressionType := uLongPtr; +if expressionType^.kind = scalarType then begin + bt := UsualUnaryConversions; + case bt of + cgByte,cgUByte,cgWord,cgUWord: + Gen1t(pc_ldc, 0, cgWord); + cgLong,cgULong: + GenLdcLong(0); + cgReal,cgDouble,cgComp,cgExtended: + GenLdcReal(0.0); + otherwise: + Error(47); + end; {case} + expressionType := wordPtr; + Gen0t(op, bt); + end {if} +else + Error(47); +end; {CompareToZero} + + +procedure FreeTemp{labelNum, size: integer}; + +{ place a temporary label in the available label list } +{ } +{ parameters: } +{ labelNum - number of the label to free } +{ size - size of the variable } +{ } +{ variables: } +{ tempList - list of free labels } + +var + tl: tempPtr; {work pointer} + +begin {FreeTemp} +new(tl); +tl^.next := tempList; +tl^.last := nil; +tl^.labelNum := labelNum; +tl^.size := size; +if tempList <> nil then + tempList^.last := tl; +tempList := tl; +end; {FreeTemp} + + +function GetTemp{size: integer): integer}; + +{ find a temporary work variable } +{ } +{ parameters: } +{ size - size of the variable } +{ } +{ variables: } +{ tempList - list of free labels } +{ } +{ Returns the label number. } + +label 1; + +var + lcodeGeneration: boolean; {local copy of codeGeneration} + ln: integer; {label number} + tl: tempPtr; {work pointer} + +begin {GetTemp} +{try to find a temp from the existing list} +tl := tempList; +while tl <> nil do begin + if tl^.size = size then begin + + {found an old one - use it} + if tl^.last = nil then + tempList := tl^.next + else + tl^.last^.next := tl^.next; + if tl^.next <> nil then + tl^.next^.last := tl^.last; + GetTemp := tl^.labelNum; + goto 1; + end; {if} + tl := tl^.next; + end; {while} + +{none found - get a new one} +ln := GetLocalLabel; +GetTemp := ln; +lcodeGeneration := codeGeneration; +codeGeneration := true; +Gen2(dc_loc, ln, size); +codeGeneration := lCodeGeneration and (numErrors = 0); +1: +end; {GetTemp} + + +procedure LoadScalar (id: identPtr); + +{ Load a scalar value. } +{ } +{ parameters: } +{ id - ident for value to load } + +var + tp: baseTypeEnum; {base type} + +begin {LoadScalar} +if id^.itype^.kind = pointerType then + tp := cgULong +else + tp := id^.itype^.baseType; +case id^.storage of + stackFrame, parameter: + Gen2t(pc_lod, id^.lln, 0, tp); + external, global, private: + Gen1tName(pc_ldo, 0, tp, id^.name); + otherwise: ; + end; {case} +end; {LoadScalar} + + +procedure Cast(tp: typePtr); + +{ Cast the current expression to the stated type } +{ } +{ parameters: } +{ tp - type to cast to } +{ } +{ inputs: } +{ expressionType - type of the expression to cast } +{ } +{ outputs: } +{ expressionType - set to result type } + +var + et,rt: baseTypeEnum; {work variables} + +begin {Cast} +if (tp^.kind = scalarType) and (expressionType^.kind = scalarType) then begin + rt := tp^.baseType; + et := expressionType^.baseType; + if rt <> et then + Gen2(pc_cnv, ord(et), ord(rt)); + end {if} +else if (tp^.kind = enumType) and (expressionType^.kind = scalarType) then begin + rt := cgWord; + et := Unary(expressionType^.baseType); + if rt <> et then + Gen2(pc_cnv, ord(et), ord(rt)); + end {if} +else if (tp^.kind = scalarType) and (expressionType^.kind = enumType) then begin + rt := Unary(tp^.baseType); + et := cgWord; + if rt <> et then + Gen2(pc_cnv, ord(et), ord(rt)); + end {if} +else if tp^.kind = pointerType then begin + case expressionType^.kind of + + scalarType: + if expressionType^.baseType in + [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong] then + Gen2(pc_cnv, ord(Unary(expressionType^.baseType)), + ord(cgULong)) + else if doDispose then + Error(40); + + arrayType,pointerType: ; + + functionType,enumConst,enumType,definedType,structType,unionType: + if doDispose then + Error(40); + + otherwise: Error(57); + + end; {case} + end {else if} +else if expressionType^.kind in [pointerType,arrayType] then begin + case tp^.kind of + + scalarType: + if tp^.baseType in + [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong] then + Gen2(pc_cnv, ord(cgULong), + ord(Unary(tp^.baseType))) + else if tp^.baseType = cgVoid then + Gen0t(pc_pop, UsualUnaryConversions) + else + Error(40); + + otherwise: + Error(40); + end; {case} + end {else if} +else if expressionType^.kind in [structType,unionType] then begin + if tp^.kind = scalarType then + if tp^.baseType = cgVoid then + Gen0t(pc_pop, UsualUnaryConversions) + else Error(40) + else Error(40); + end {else if} +else + Error(40); +expressionType := tp; +end; {Cast} + + +procedure DoSelection {lType: typePtr; tree: tokenPtr; var size: longint}; + +{ Find the displacement & type for a selection operation } +{ } +{ parameters: } +{ lType - structure/union type } +{ tree - right-hand tree } +{ size - disp into the structure/union } +{ } +{ returned in non-local variables: } +{ bitDisp - displacement to bit field } +{ bitSize - size of bit field } +{ unsigned - is the bit field unsigned? } +{ isBitField - is the field a bit field? } +{ } +{ varaibles: } +{ expressionType - set to the type of the field } + +label 1; + +var + ip: identPtr; {for scanning for the field} + +begin {DoSelection} +expressionType := wordPtr; {set defaults in case there is an error} +size := 0; +if tree^.token.class = identifier then begin + while lType^.kind = definedType do + lType := lType^.dType; + if lType^.kind in [structType,unionType] then begin + ip := lType^.fieldList; {find a matching field} + while ip <> nil do begin + if ip^.name^ = tree^.token.name^ then begin + if ip^.isForwardDeclared then + ResolveForwardReference(ip); + size := ip^.disp; {match found - record parameters} + expressionType := ip^.itype; + bitDisp := ip^.bitDisp; + bitSize := ip^.bitSize; + isBitField := (bitSize+bitDisp) <> 0; + unsigned := ip^.itype^.baseType in [cgUByte,cgUWord,cgULong]; + goto 1; + end; {if} + ip := ip^.next; + end; {while} + Error(81); + end {if} + else + Error(80); + end; {if} +1: +end; {DoSelection} + + +procedure L_Value(tree: tokenPtr); + +{ Check for an l-value } +{ } +{ parameters: } +{ tree - expression tree to check } + +var + kind: tokenEnum; {for efficiency} + +begin {L_Value} +kind := tree^.token.kind; + +{A variable identifier is an l-value unless it is a function or } +{non-parameter array } +if kind = ident then begin + if tree^.id^.itype^.kind = arrayType then begin + if tree^.id^.storage <> parameter then + if doDispose then {prevent spurious errors} + Error(78); + end {if} + else if tree^.id^.itype^.kind in + [functionType,enumConst,enumType] then + if doDispose then {prevent spurious errors} + Error(78); + end {if} + +{e.field is an l-value if and only if e is an l-value} +else if kind = dotch then + L_Value(tree^.left) + +{Bypass cast operators } +{following test removed to flag bug for: } +{ int *p; long l; } +{ (long) p = l; } +{else if kind = castoper then + L_Value(tree^.left)} + +{The result of an array subscript (a[i]), indirect selection, } +{or the indirection operator all show up as the uasterisk } +{operator at this point. All are l-values, but nothing else } +{not already allowed is an l-value. } +else if kind <> uasterisk then + if doDispose then {prevent spurious errors} + Error(78); +end; {L_Value} + + +procedure ChangePointer (op: pcodes; size: longint; tp: baseTypeEnum); + +{ Add or subtract an integer to a pointer } +{ } +{ The stack has a pointer and an integer (integer on TOS). } +{ The integer is removed, multiplied by size, and either } +{ added to or subtracted from the pointer; the result } +{ replaces the pointer on the stack } +{ } +{ parameters: } +{ op - operation (pc_adl or pc_sbl) } +{ size - size of one pointer element } +{ tp - type of the integer operand } + +begin {ChangePointer} +case tp of + cgByte,cgUByte,cgWord,cgUWord: begin + if (size = long(size).lsw) and (op = pc_adl) + and smallMemoryModel and (tp in [cgUByte,cgUWord]) then begin + Gen1t(pc_ldc, long(size).lsw, cgWord); + Gen0(pc_umi); + Gen0t(pc_ixa, cgUWord); + end {if} + else if smallMemoryModel and (size = long(size).lsw) then begin + Gen1t(pc_ldc, long(size).lsw, cgWord); + Gen0(pc_mpi); + Gen2(pc_cnv, ord(tp), ord(cgLong)); + Gen0(op); + end {else if} + else begin + Gen2(pc_cnv, ord(tp), ord(cgLong)); + GenLdcLong(size); + Gen0(pc_mpl); + Gen0(op); + end; + end; + cgLong,cgULong: begin + GenLdcLong(size); + if tp = cgLong then + Gen0(pc_mpl) + else + Gen0(pc_uml); + Gen0(op); + end; + otherwise: + Error(66); + end; {case} +end; {ChangePointer} + + +procedure GenerateCode {tree: tokenPtr}; + +{ generate code from a fully formed expression tree } +{ } +{ parameters: } +{ tree - top of the expression tree to generate code from } +{ } +{ variables: } +{ expressionType - result type of the expression } + +var + doingScalar: boolean; {temp; for assignment operators} + et: baseTypeEnum; {temp storage for a base type} + i: integer; {loop variable} + isString: boolean; {was the ? : a string?} + lType: typePtr; {type of operands} + kind: typeKind; {temp type kind} + size: longint; {size of an array element} + t1: integer; {temporary work space label number} + tlastwasconst: boolean; {temp lastwasconst} + tlastconst: longint; {temp lastconst} + tp: tokenPtr; {work pointer} + tType: typePtr; {temp type of operand} + + lbitDisp,lbitSize: integer; {for temp storage} + lisBitField: boolean; + + + function ExpressionKind (tree: tokenPtr): typeKind; + + { returns the type of an expression } + { } + { This subroutine is used to see if + and - operarions } + { should do pointer addition. } + { } + { parameters: } + { tree - top of the expression tree to check } + + var + ldoDispose: boolean; {local copy of doDispose} + lcodeGeneration: boolean; {local copy of codeGeneration} + lexpressionType: typePtr; {local copy of expressionType} + + begin {ExpressionKind} + ldoDispose := doDispose; {inhibit disposing of the tree} + doDispose := false; + lcodeGeneration := codeGeneration; {inhibit code generation} + codeGeneration := false; + lexpressionType := expressionType; {save the expression type} + + GenerateCode(tree); {get the type} + ExpressionKind := expressionType^.kind; + + doDispose := ldoDispose; {resore the volitile variables} + codeGeneration := lCodeGeneration and (numErrors = 0); + expressionType := lexpressionType; + end; {ExpressionKind} + + + procedure LoadAddress (tree: tokenPtr); + + { load the address of an l-value } + { } + { parameters: } + { tree - top of the expression tree to load the } + { address of } + { } + { variables: } + { expressionType - result type of the expression } + { isBitField - this variable is set to false so that } + { it can be used to see if DoSelection was called } + { and located a bit field } + + label 1; + + var + eType: typePtr; {work pointer} + i: integer; {loop variable} + size: longint; {disp in record} + tname: stringPtr; {temp name pointer} + + begin {LoadAddress} + isBitField := false; + if tree^.token.kind = ident then begin + + {load the address of an identifier} + with tree^.id^ do begin + tname := name; + if itype^.kind = functionType then begin + if itype^.isPascal then begin + tname := pointer(Malloc(length(name^)+1)); + CopyString(pointer(tname), pointer(name)); + for i := 1 to length(tname^) do + if tname^[i] in ['a'..'z'] then + tname^[i] := chr(ord(tname^[i]) & $5F); + end; {if} + end; {if} + case storage of + stackFrame: Gen2(pc_lda, lln, 0); + parameter: if itype^.kind = arrayType then + Gen2t(pc_lod, pln, 0, cgULong) + else + Gen2(pc_lda, pln, 0); + external, + global, + private: Gen1Name(pc_lao, 0, tname); + otherwise: ; + end; {case} + eType := pointer(Malloc(sizeof(typeRecord))); + eType^.size := cgLongSize; + eType^.saveDisp := 0; + eType^.isConstant := false; + eType^.kind := pointerType; + eType^.pType := iType; + expressionType := eType; + end; {with} + end {if} + else if tree^.token.kind = uasterisk then begin + + {load the address of the item pointed to by the pointer} + GenerateCode(tree^.left); + end {else if} + else if tree^.token.kind = dotch then begin + + {load the address of a field of a record} + LoadAddress(tree^.left); + eType := expressionType; + if eType^.kind in [arrayType,pointerType] then begin + if eType^.kind = arrayType then + eType := eType^.aType + else if eType^.kind = pointerType then + eType := eType^.pType; + DoSelection(eType, tree^.right, size); + if size <> 0 then + if size & $00007FFF = size then + Gen1t(pc_inc, long(size).lsw, cgULong) + else begin + GenLdcLong(size); + Gen0(pc_adl); + end; {else} + eType := pointer(Malloc(sizeof(typeRecord))); + eType^.size := cgLongSize; + eType^.saveDisp := 0; + eType^.isConstant := false; + eType^.kind := pointerType; + eType^.pType := expressionType; + expressionType := eType; + end {if} + else + Error(79); + end {else if} + else if tree^.token.kind = castoper then begin + + {load the address of a field of a record} + LoadAddress(tree^.left); + expressionType := tree^.castType; + if expressionType^.kind <> arrayType then begin + eType := pointer(Malloc(sizeof(typeRecord))); + eType^.size := cgLongSize; + eType^.saveDisp := 0; + eType^.isConstant := false; + eType^.kind := pointerType; + eType^.pType := expressionType; + expressionType := eType; + end; {if} + end {else if} + + else if ExpressionKind(tree) in [arrayType,pointerType] then + GenerateCode(tree) + else + if doDispose then {prevent spurious errors} + Error(78); +1: + end; {LoadAddress} + + + procedure DoIncDec (tree: tokenPtr; pc_l, pc_g, pc_i: pcodes); + + { do ++ and -- } + { } + { parameters: } + { tree - tree to generate the instruction for } + { pc_l - op code for a local ++ or -- } + { pc_g - op code for a global ++ or -- } + { pc_i - op code for an indirect ++ or -- } + + label 1; + + var + baseType: baseTypeEnum; {type of operation} + lSize: longint; {number to inc or dec by} + iSize: integer; {number to inc or dec by} + tp: baseTypeEnum; {type of operand} + + + procedure IncOrDec (inc: boolean); + + { Increment or decrement a number on TOS } + { } + { parameters: } + { inc - increment the number? } + + begin {IncOrDec} + case expressionType^.kind of + + scalarType: + case tp of + + cgByte,cgUByte,cgWord,cgUWord: begin + Gen1t(pc_ldc, 1, cgWord); + if inc then + Gen0(pc_adi) + else + Gen0(pc_sbi); + end; + + cgLong,cgULong: begin + GenLdcLong(1); + if inc then + Gen0(pc_adl) + else + Gen0(pc_sbl); + end; + + cgReal,cgDouble,cgComp,cgExtended: begin + GenLdcReal(1.0); + if inc then + Gen0(pc_adr) + else + Gen0(pc_sbr); + end; + + otherwise: Error(57); + + end; {case} + + pointerType,arrayType: begin + GenldcLong(expressionType^.pType^.size); + if inc then + Gen0(pc_adl) + else + Gen0(pc_sbl); + end; + + otherwise: ; + + end; {case} + end; {IncOrDec} + + + begin {DoIncDec} + L_Value(tree); + with tree^.id^ do + if (tree^.token.kind = ident) + and ((iType^.kind in [scalarType,pointerType]) + or ((iType^.kind = arrayType) and (storage = parameter))) then begin + + {check for ++ or -- of a constant} + if iType^.isConstant then + Error(93); + + {do an efficient ++ or -- on a named location} + if iType^.kind = scalarType then begin + iSize := 1; + baseType := iType^.baseType; + if baseType in [cgReal,cgDouble,cgComp,cgExtended] then begin + + {do real inc or dec} + LoadScalar(tree^.id); {load the value} + tp := baseType; + expressionType := iType; + IncOrDec(pc_l in [pc_lli,pc_lil]); {do the ++ or --} + case storage of {save the result} + stackFrame, parameter: + Gen2t(pc_cop, lln, 0, baseType); + external, global, private: + Gen1tName(pc_cpo, 0, baseType, name); + otherwise: ; + end; {case} + {correct the value for postfix ops} + if pc_l in [pc_lli,pc_lld] then + IncOrDec(pc_l = pc_lld); + expressionType := doublePtr; + goto 1; + end; {if} + end {if} + else {if iType^.kind = pointerType then} begin + lSize := iType^.pType^.size; + if long(lSize).msw <> 0 then begin + + {handle inc/dec of >64K} + LoadScalar(tree^.id); + GenLdcLong(lSize); + if pc_l in [pc_lli,pc_lil] then + Gen0(pc_adl) + else + Gen0(pc_sbl); + with tree^.left^.id^ do + case storage of + stackFrame, parameter: + Gen2t(pc_cop, lln, 0, cgULong); + external, global, private: + Gen1tName(pc_cpo, 0, cgULong, name); + otherwise: ; + end; {case} + if pc_l in [pc_lli,pc_lld] then begin + GenLdcLong(lSize); + if pc_l = pc_lld then + Gen0(pc_adl) + else + Gen0(pc_sbl); + end; {if} + goto 1; + end; {if} + baseType := cgULong; + iSize := long(lSize).lsw; + end; {else} + case storage of + stackFrame, parameter: + Gen2t(pc_l, lln, iSize, baseType); + external, global, private: + Gen2tName(pc_g, iSize, 0, baseType, name); + otherwise: ; + end; {case} + expressionType := itype; + end {if} + else begin + + {do an indirect ++ or --} + LoadAddress(tree); {get the address to save to} + if expressionType^.kind = arrayType then + expressionType := expressionType^.aType + else if expressionType^.kind = pointerType then + expressionType := expressionType^.pType; + if expressionType^.kind = scalarType then + if expressionType^.baseType in [cgByte,cgUByte,cgWord,cgUWord] then + tp := expressionType^.baseType + else + tp := UsualUnaryConversions + else + tp := UsualUnaryConversions; + if tp in [cgByte,cgUByte,cgWord,cgUword] then + Gen0t(pc_i, tp) {do indirect inc/dec} + else begin + t1 := GetTemp(cgLongSize); + Gen2t(pc_str, t1, 0, cgULong); + Gen2t(pc_lod, t1, 0, cgULong); + Gen2t(pc_lod, t1, 0, cgULong); + FreeTemp(t1, cgLongSize); + Gen1t(pc_ind, 0, tp); {load the value} + IncOrDec(pc_l in [pc_lli,pc_lil]); {do the ++ or --} + if isBitField then {copy the value} + if bitDisp+bitSize > 16 then begin + Gen2t(pc_cbf, bitDisp, bitSize, cgLong); + Gen0t(pc_bno, cgLong); + end {if} + else begin + Gen2t(pc_cbf, bitDisp, bitSize, cgWord); + Gen0t(pc_bno, cgWord); + end {else} + else begin + Gen0t(pc_cpi, tp); + Gen0t(pc_bno, tp); + end; {else} + if pc_l in [pc_lli,pc_lld] then {correct the value for postfix ops} + IncOrDec(pc_l = pc_lld); + end; {else} + end; {else} +1: + end; {DoIncDec} + + + procedure FunctionCall (tree: tokenPtr); + + { generate the actual function call } + + var + fName: stringPtr; {uppercase file name} + fntype: typePtr; {temp function type} + ftree: tokenPtr; {function address tree} + ftype: typePtr; {function type} + i: integer; {loop variable} + indirect: boolean; {is this an indirect call?} + ldoDispose: boolean; {local copy of doDispose} + lcodeGeneration: boolean; {local copy of codeGeneration} + + + procedure FunctionParms (parms: tokenPtr; fType: typePtr); + + { Generate a function call. } + { } + { parameters: } + { parms - parameter list } + { fType - function type } + + var + kind: typeKind; {for expression kinds} + ldoDispose: boolean; {local copy of doDispose} + lnumErrors: integer; {number of errors before type check} + numParms: integer; {# of parameters generated} + parameters: parameterPtr; {next prototyped parameter} + pCount: integer; {# of parameters prototyped} + prototype: boolean; {is the function prototyped?} + tp,ltp: tokenPtr; {work pointers} + + + procedure Reverse; + + { Reverse the parameter list } + + var + p1,p2,p3: tokenPtr; {work pointers} + + begin {Reverse} + p3 := parms; {remove the last entry} + p1 := parms; + p2 := nil; + while p3^.right <> nil do begin + p2 := p3; + p3 := p3^.right; + end; {while} + if p2 <> nil then + p2^.right := nil + else + p1 := nil; + while p1 <> nil do begin {reverse the remaining parms} + p2 := p1; + p1 := p1^.right; + p2^.right := p3; + p3 := p2; + end; {while} + parms := p3; + end; {Reverse} + + + begin {FunctionParms} + {check the validity of the parameter list} + if ftype^.isPascal then {reverse parms for pascal calls} + Reverse; + tp := parms; {set up to check types} + prototype := ftype^.prototyped; + parameters := ftype^.parameterList; + pCount := 1; + while parameters <> nil do begin {count the prototypes} + pCount := pCount+1; + parameters := parameters^.next; + end; {while} + parameters := ftype^.parameterList; + if prototype then begin {check for wrong # of parms} + while tp <> nil do begin {count the parms} + pCount := pCount-1; + tp := tp^.right; + end; {while} + tp := parms; + if (pCount > 0) or ((pCount <> 0) and not ftype^.varargs) then + Error(85); + end; {if} + + {generate the parameters} + numParms := 0; + lDoDispose := doDispose; + doDispose := false; + while tp <> nil do begin + if tp^.middle <> nil then begin + lnumErrors := numErrors; + kind := ExpressionKind(tp^.middle); + if numErrors = lnumErrors then + if kind in [structType,unionType] then begin + GenerateCode(tp^.middle); + if expressionType^.size & $FFFF8000 <> 0 then + Error(61); + Gen1t(pc_ldc, long(expressionType^.size).lsw, cgWord); + Gen0(pc_psh); + end {else if} + else + GenerateCode(tp^.middle); + if prototype then begin + if pCount = 0 then begin + if parameters <> nil then begin + AssignmentConversion(parameters^.parameterType, + expressionType, lastWasConst, lastConst, true, true); + end; {if} + parameters := parameters^.next; + end {if} + else + pCount := pCount+1; + end; {if} + Gen0t(pc_stk, UsualUnaryConversions); + if numParms <> 0 then + Gen0t(pc_bno, UsualUnaryConversions); + numParms := numParms+1; + end; {if} + ltp := tp; + tp := tp^.right; + end; {while} + doDispose := lDoDispose; + if numParms = 0 then + Gen0(pc_nop); + + if ftype^.isPascal then {restore parm order} + Reverse; + + if doDispose then begin {dispose of leaf nodes} + DisposeTree(parms^.middle); + DisposeTree(parms^.right); + end; {if} + end; {FunctionParms} + + + begin {FunctionCall} + {find the type of the function} + indirect := true; {assume an indirect call} + ftree := tree^.left; {get the function tree} + if ftree^.token.kind = ident then {check for direct calls} + if ftree^.id^.itype^.kind = functionType then begin + indirect := false; + fType := ftree^.id^.itype; {get the function type} + end; {if} + if indirect then begin {get type for indirect call} + ldoDispose := doDispose; + doDispose := false; + lcodeGeneration := codeGeneration; + codeGeneration := false; + GenerateCode(ftree); + doDispose := ldoDispose; + codeGeneration := lCodeGeneration and (numErrors = 0); + ftype := expressionType; + while ftype^.kind in [pointerType,arrayType] do + ftype := ftype^.ptype; + end; {if} + + {make sure the identifier is really a function} + if ftype^.kind <> functionType then + Error(114) + else begin + + {generate function parameters} + FunctionParms (tree, fType); + + {generate the function call} + expressionType := ftype^.fType; + if expressionType^.kind in [structType,unionType] then + expressionType := uLongPtr; + if (ftype^.toolNum = 0) and (ftype^.dispatcher = 0) then begin + if indirect then begin + fntype := expressionType; + GenerateCode(ftree); + expressionType := fntype; + Gen1t(pc_cui, ord(fType^.varargs and strictVararg), + UsualUnaryConversions); + end {if} + else begin + fname := ftree^.id^.name; + if ftype^.isPascal then begin + fname := pointer(Malloc(length(fname^)+1)); + CopyString(pointer(fname), pointer(ftree^.id^.name)); + for i := 1 to length(fname^) do + if fName^[i] in ['a'..'z'] then + fName^[i] := chr(ord(fName^[i]) & $5F); + end; {if} + Gen1tName(pc_cup, ord(fType^.varargs and strictVararg), + UsualUnaryConversions, fname); + end; {else} + end {if} + else + GenTool(pc_tl1, ftype^.toolNum, long(ftype^.ftype^.size).lsw, + ftype^.dispatcher); + expressionType := ftype^.fType; + lastWasConst := false; + end; {else} + end; {FunctionCall} + + + procedure CompareCompatible (var t1,t2: typePtr); + + { Make sure that it is legal to compare t1 to t2 } + + begin {CompareCompatible} + if (t1^.kind = functionType) or (t2^.kind = functionType) then begin + if not CompTypes(t1, t2) then + Error(47); + end {if} + else if t1^.kind in [pointerType,arrayType] then begin + if t2^.kind in [pointerType,arrayType] then begin + if (t1^.ptype = voidPtr) or (t2^.ptype = voidPtr) then + else if t1^.kind = t2^.kind then begin + if not CompTypes(t1, t2) then + Error(47); + end {if} + else if not CompTypes(t1^.ptype, t2^.ptype) then + Error(47); + t2 := ulongPtr; + end {if} + else if (not lastwasconst) or (lastconst <> 0) then + Error(47); + t1 := ulongPtr; + end {if} + else if expressionType^.kind in [pointerType,arrayType] then begin + if (not tlastwasconst) or (tlastconst <> 0) then + Error(47); + t2 := ulongPtr; + end; {else if} + end; {CompareCompatible} + + +begin {GenerateCode} +lastwasconst := false; +case tree^.token.kind of + + parameterOper: + FunctionCall(tree); + + ident: begin + case tree^.id^.itype^.kind of + + scalarType: begin + LoadScalar(tree^.id); + expressionType := tree^.id^.itype; + end; + + pointerType: begin + LoadScalar(tree^.id); + expressionType := tree^.id^.itype; + end; + + + arrayType: begin + LoadAddress(tree); + expressionType := expressionType^.ptype; + end; + + functionType: + LoadAddress(tree); + + structType, unionType: begin + LoadAddress(tree); + if expressionType^.kind = pointerType then + expressionType := expressionType^.ptype; + end; + + enumConst: begin + Gen1t(pc_ldc, tree^.id^.itype^.eval, cgWord); + expressionType := wordPtr; + end; + + otherwise: ; + + end; {case} + end; + + intConst,uintConst: begin + Gen1t(pc_ldc, tree^.token.ival, cgWord); + lastwasconst := true; + lastconst := tree^.token.ival; + if tree^.token.kind = intConst then + expressionType := wordPtr + else + expressionType := uwordPtr; + end; {case intConst} + + longConst,ulongConst: begin + GenLdcLong(tree^.token.lval); + if tree^.token.kind = longConst then + expressionType := longPtr + else + expressionType := ulongPtr; + lastwasconst := true; + lastconst := tree^.token.lval; + end; {case longConst} + + doubleConst: begin + GenLdcReal(tree^.token.rval); + expressionType := doublePtr; + end; {case doubleConst} + + stringConst: begin + GenS(pc_lca, tree^.token.sval); + expressionType := stringTypePtr; + end; {case stringConst} + + eqch: begin {=} + L_Value(tree^.left); + with tree^.left^ do begin + if token.kind = ident then + kind := id^.itype^.kind + else + kind := definedType; + if kind = arrayType then + if id^.storage = parameter then + kind := pointerType; + if (token.kind = ident) + and (kind in [scalarType,pointerType]) then begin + GenerateCode(tree^.right); + with tree^.left^.id^ do begin + if itype^.kind in [pointerType,arrayType] then + lType := uLongPtr + else + lType := itype; + AssignmentConversion(itype, expressionType, lastWasConst, + lastConst, true, true); + case storage of + stackFrame, parameter: + Gen2t(pc_cop, lln, 0, lType^.baseType); + external, global, private: + Gen1tName(pc_cpo, 0, lType^.baseType, name); + otherwise: ; + end; {case} + end; {with} + end {if} + else begin + LoadAddress(tree^.left); + lType := expressionType; + lisBitField := isBitField; + lbitDisp := bitDisp; + lbitSize := bitSize; + if lType^.kind = arrayType then + lType := lType^.aType + else if lType^.kind = pointerType then + lType := lType^.pType; + GenerateCode(tree^.right); + AssignmentConversion(lType, expressionType, lastWasConst, + lastConst, true, true); + case lType^.kind of + scalarType: + if lisBitField then + Gen2t(pc_cbf, lbitDisp, lbitSize, lType^.baseType) + else + Gen0t(pc_cpi, lType^.baseType); + + pointerType: + Gen0t(pc_cpi, cgULong); + + structType,unionType: + Gen2(pc_mov, long(lType^.size).msw, long(lType^.size).lsw); + + otherwise: + Error(47); + + end; {case} + end; {else} + end; {with} + end; {=} + + pluseqop, {+=} + minuseqop, {-=} + asteriskeqop, {*=} + slasheqop, {/=} + percenteqop, {%=} + ltlteqop, {<<=} + gtgteqop, {>>=} + andeqop, {&=} + caroteqop, {^=} + bareqop: with tree^.left^ do {|=} + begin + L_Value(tree^.left); + if (token.kind = ident) + and (id^.itype^.kind in [scalarType,pointerType]) then begin + doingScalar := true; + LoadScalar(id); + lType := id^.itype; + end {if} + else begin + doingScalar := false; + LoadAddress(tree^.left); + lisBitField := isBitField; + lbitDisp := bitDisp; + lbitSize := bitSize; + t1 := GetTemp(cgLongSize); + Gen2t(pc_str, t1, 0, cgULong); + Gen2t(pc_lod, t1, 0, cgULong); + Gen2t(pc_lod, t1, 0, cgULong); + FreeTemp(t1, cgLongSize); + lType := expressionType^.pType; + if isBitField then begin + if unsigned then + Gen2t(pc_lbu, bitDisp, bitSize, lType^.baseType) + else + Gen2t(pc_lbf, bitDisp, bitSize, lType^.baseType); + end {if} + else if lType^.kind = pointerType then + Gen1t(pc_ind, 0, cgULong) + else + Gen1t(pc_ind, 0, lType^.baseType); + end; {else} + if lType^.isConstant then + Error(93); + GenerateCode(tree^.right); + if lType^.kind <> pointerType then + et := UsualBinaryConversions(lType); + case tree^.token.kind of + + pluseqop: + if lType^.kind = pointerType then begin + ChangePointer(pc_adl, lType^.pType^.size, UsualUnaryConversions); + expressionType := lType; + end + else if et in [cgWord,cgUWord] then + Gen0(pc_adi) + else if et in [cgLong,cgULong] then + Gen0(pc_adl) + else if et = cgExtended then + Gen0(pc_adr) + else + Error(66); + + minuseqop: + if lType^.kind = pointerType then begin + ChangePointer(pc_sbl, lType^.pType^.size, UsualUnaryConversions); + expressionType := lType; + end + else if et in [cgWord,cgUWord] then + Gen0(pc_sbi) + else if et in [cgLong,cgULong] then + Gen0(pc_sbl) + else if et = cgExtended then + Gen0(pc_sbr) + else + Error(66); + + asteriskeqop: + if et = cgWord then + Gen0(pc_mpi) + else if et = cgUWord then + Gen0(pc_umi) + else if et = cgLong then + Gen0(pc_mpl) + else if et = cgULong then + Gen0(pc_uml) + else if et = cgExtended then + Gen0(pc_mpr) + else + Error(66); + + slasheqop: + if et = cgWord then + Gen0(pc_dvi) + else if et = cgUWord then + Gen0(pc_udi) + else if et = cgLong then + Gen0(pc_dvl) + else if et = cgULong then + Gen0(pc_udl) + else if et = cgExtended then + Gen0(pc_dvr) + else + Error(66); + + percenteqop: + if et = cgWord then + Gen0(pc_mod) + else if et = cgUWord then + Gen0(pc_uim) + else if et = cgLong then + Gen0(pc_mdl) + else if et = cgULong then + Gen0(pc_ulm) + else + Error(66); + + ltlteqop: + if et in [cgWord,cgUWord] then + Gen0(pc_shl) + else if et in [cgLong,cgULong] then + Gen0(pc_sll) + else + Error(66); + + gtgteqop: + if et = cgWord then + Gen0(pc_shr) + else if et = cgUWord then + Gen0(pc_usr) + else if et = cgLong then + Gen0(pc_slr) + else if et = cgULong then + Gen0(pc_vsr) + else + Error(66); + + andeqop: + if et in [cgWord,cgUWord] then + Gen0(pc_bnd) + else if et in [cgLong,cgULong] then + Gen0(pc_bal) + else + Error(66); + + caroteqop: + if et in [cgWord,cgUWord] then + Gen0(pc_bxr) + else if et in [cgLong,cgULong] then + Gen0(pc_blx) + else + Error(66); + + bareqop: + if et in [cgWord,cgUWord] then + Gen0(pc_bor) + else if et in [cgLong,cgULong] then + Gen0(pc_blr) + else + Error(66); + + otherwise: Error(57); + end; {case} + AssignmentConversion(lType,expressionType,false,0,true,true); + if doingScalar then begin + if lType^.kind = pointerType then + lType := uLongPtr; + case id^.storage of + stackFrame, parameter: + Gen2t(pc_cop, id^.lln, 0, lType^.baseType); + external, global, private: + Gen1tName(pc_cpo, 0, lType^.baseType, id^.name); + otherwise: ; + end; {case} + end {if} + else begin + if lisBitField then + Gen2t(pc_cbf, lbitDisp, lbitSize, lType^.baseType) + else begin + if ltype^.kind in [pointerType,arrayType] then + lType := uLongPtr; + Gen0t(pc_cpi, lType^.baseType); + end; {else} + Gen0t(pc_bno, lType^.baseType); + end; {else} + end; {with} + + commach: begin {,} + GenerateCode(tree^.left); + if expressionType^.baseType <> cgVoid then + Gen0t(pc_pop, UsualUnaryConversions); + GenerateCode(tree^.right); + Gen0t(pc_bno, UsualUnaryConversions); + {result type is already in expressionType} + end; {case commach} + + barbarop: begin {||} + GenerateCode(tree^.left); + if expressionType^.kind = pointerType then + expressionType := uLongPtr + else if UsualUnaryConversions = cgExtended then begin + GenLdcReal(0.0); + Gen0t(pc_neq, cgExtended); + expressionType := wordPtr; + end; {if} + lType := expressionType; + GenerateCode(tree^.right); + if expressionType^.kind = pointerType then + expressionType := uLongPtr + else if UsualUnaryConversions = cgExtended then begin + GenLdcReal(0.0); + Gen0t(pc_neq, cgExtended); + expressionType := wordPtr; + end; {if} + case UsualBinaryConversions(lType) of + cgByte,cgUByte,cgWord,cgUWord: + Gen0(pc_ior); + cgLong,cgULong: + Gen0(pc_lor); + otherwise: + error(66); + end; {case} + expressionType := wordPtr; + end; {case barbarop} + + andandop: begin {&&} + GenerateCode(tree^.left); + if expressionType^.kind = pointerType then + expressionType := uLongPtr + else if UsualUnaryConversions = cgExtended then begin + GenLdcReal(0.0); + Gen0t(pc_neq, cgExtended); + expressionType := wordPtr; + end; {if} + lType := expressionType; + GenerateCode(tree^.right); + if expressionType^.kind = pointerType then + expressionType := uLongPtr + else if UsualUnaryConversions = cgExtended then begin + GenLdcReal(0.0); + Gen0t(pc_neq, cgExtended); + expressionType := wordPtr; + end; {if} + case UsualBinaryConversions(lType) of + cgByte,cgUByte,cgWord,cgUWord: + Gen0(pc_and); + cgLong,cgULong: + Gen0(pc_lnd); + otherwise: + error(66); + end; {case} + expressionType := wordPtr; + end; {case andandop} + + carotch: begin {^} + GenerateCode(tree^.left); + lType := expressionType; + GenerateCode(tree^.right); + case UsualBinaryConversions(lType) of + cgByte,cgUByte,cgWord,cgUWord: + Gen0(pc_bxr); + cgLong,cgULong: + Gen0(pc_blx); + otherwise: + error(66); + end; {case} + end; {case carotch} + + barch: begin {|} + GenerateCode(tree^.left); + lType := expressionType; + GenerateCode(tree^.right); + case UsualBinaryConversions(lType) of + cgByte,cgUByte,cgWord,cgUWord: + Gen0(pc_bor); + cgLong,cgULong: + Gen0(pc_blr); + otherwise: + error(66); + end; {case} + end; {case barch} + + andch: begin {&} + GenerateCode(tree^.left); + lType := expressionType; + GenerateCode(tree^.right); + case UsualBinaryConversions(lType) of + cgByte,cgUByte,cgWord,cgUWord: + Gen0(pc_bnd); + cgLong,cgULong: + Gen0(pc_bal); + otherwise: + error(66); + end; {case} + end; {case andch} + + ltltop: begin {<<} + GenerateCode(tree^.left); + lType := expressionType; + GenerateCode(tree^.right); + case UsualBinaryConversions(lType) of + cgByte,cgUByte,cgWord,cgUWord: + Gen0(pc_shl); + cgLong,cgULong: + Gen0(pc_sll); + otherwise: + error(66); + end; {case} + end; {case ltltop} + + gtgtop: begin {>>} + GenerateCode(tree^.left); + lType := expressionType; + GenerateCode(tree^.right); + case UsualBinaryConversions(lType) of + cgByte,cgWord: + Gen0(pc_shr); + cgUByte,cgUWord: + Gen0(pc_usr); + cgLong: + Gen0(pc_slr); + cgULong: + Gen0(pc_vsr); + otherwise: + error(66); + end; {case} + end; {case gtgtop} + + plusch: begin {+} + if ExpressionKind(tree^.right) in [arrayType,pointerType] then begin + tree^.middle := tree^.right; + tree^.right := tree^.left; + tree^.left := tree^.middle; + end; {if} + GenerateCode(tree^.left); + lType := expressionType; + GenerateCode(tree^.right); + if lType^.kind in [arrayType,pointerType] then begin + + {pointer addition} + et := UsualUnaryConversions; + expressionType := lType; + if lType^.kind = arrayType then + lType := lType^.aType + else + lType := lType^.pType; + ChangePointer(pc_adl, lType^.size, et); + end {if} + else begin + + {scalar addition} + case UsualBinaryConversions(lType) of + cgByte,cgUByte,cgWord,cgUWord: + Gen0(pc_adi); + cgLong,cgULong: + Gen0(pc_adl); + cgExtended: + Gen0(pc_adr); + otherwise: + error(66); + end; {case} + end; {else} + end; {case plusch} + + minusch: begin {-} + GenerateCode(tree^.left); + lType := expressionType; + GenerateCode(tree^.right); + if lType^.kind in [pointerType,arrayType] then begin + if lType^.kind = arrayType then + size := lType^.aType^.size + else + size := lType^.pType^.size; + if expressionType^.kind in [arrayType,pointerType] then begin + + {subtraction of two pointers} + Gen0(pc_sbl); + if size <> 1 then begin + GenLdcLong(size); + Gen0(pc_dvl); + end; {if} + lType := longPtr; + end {if} + else + {subtract a scalar from a pointer} + ChangePointer(pc_sbl, size, UsualUnaryConversions); + expressionType := lType; + end {if} + else begin + + {scalar subtraction} + case UsualBinaryConversions(lType) of + cgByte,cgUByte,cgWord,cgUWord: + Gen0(pc_sbi); + cgLong,cgULong: + Gen0(pc_sbl); + cgExtended: + Gen0(pc_sbr); + otherwise: + error(66); + end; {case} + end; {else} + end; {case minusch} + + asteriskch: begin {*} + GenerateCode(tree^.left); + lType := expressionType; + GenerateCode(tree^.right); + case UsualBinaryConversions(lType) of + cgByte,cgWord: + Gen0(pc_mpi); + cgUByte,cgUWord: + Gen0(pc_umi); + cgLong: + Gen0(pc_mpl); + cgULong: + Gen0(pc_uml); + cgExtended: + Gen0(pc_mpr); + otherwise: + error(66); + end; {case} + end; {case asteriskch} + + slashch: begin {/} + GenerateCode(tree^.left); + lType := expressionType; + GenerateCode(tree^.right); + case UsualBinaryConversions(lType) of + cgByte,cgWord: + Gen0(pc_dvi); + cgUByte,cgUWord: + Gen0(pc_udi); + cgLong: + Gen0(pc_dvl); + cgULong: + Gen0(pc_udl); + cgExtended: + Gen0(pc_dvr); + otherwise: + error(66); + end; {case} + end; {case slashch} + + percentch: begin {%} + GenerateCode(tree^.left); + lType := expressionType; + GenerateCode(tree^.right); + case UsualBinaryConversions(lType) of + cgByte,cgWord: + Gen0(pc_mod); + cgUByte,cgUWord: + Gen0(pc_uim); + cgLong: + Gen0(pc_mdl); + cgULong: + Gen0(pc_ulm); + otherwise: + error(66); + end; {case} + end; {case percentch} + + eqeqop, {==} + exceqop: begin {!=} + GenerateCode(tree^.left); + lType := expressionType; + tlastwasconst := lastwasconst; + tlastconst := lastconst; + GenerateCode(tree^.right); + CompareCompatible(ltype, expressionType); + if tree^.token.kind = eqeqop then + Gen0t(pc_equ, UsualBinaryConversions(lType)) + else + Gen0t(pc_neq, UsualBinaryConversions(lType)); + expressionType := wordPtr; + end; {case exceqop,eqeqop} + + lteqop, {<=} + gteqop, {>=} + ltch, {<} + gtch: begin {>} + GenerateCode(tree^.left); + lType := expressionType; + GenerateCode(tree^.right); + CompareCompatible(ltype, expressionType); + if tree^.token.kind = lteqop then + Gen0t(pc_leq, UsualBinaryConversions(lType)) + else if tree^.token.kind = gteqop then + Gen0t(pc_geq, UsualBinaryConversions(lType)) + else if tree^.token.kind = ltch then + Gen0t(pc_les, UsualBinaryConversions(lType)) + else {if tree^.token.kind = gtch then} + Gen0t(pc_grt, UsualBinaryConversions(lType)); + expressionType := wordPtr; + end; {case lteqop,gteqop,ltch,gtch} + + uminus: begin {unary -} + GenerateCode(tree^.left); + case UsualUnaryConversions of + cgByte,cgUByte,cgWord,cgUWord: + Gen0(pc_ngi); + cgLong,cgULong: + Gen0(pc_ngl); + cgExtended: + Gen0(pc_ngr); + otherwise: + error(66); + end; {case} + end; {case uminus} + + tildech: begin {~} + GenerateCode(tree^.left); + case UsualUnaryConversions of + cgByte,cgUByte,cgWord,cgUWord: + Gen0(pc_bnt); + cgLong,cgULong: + Gen0(pc_bnl); + otherwise: + error(66); + end; {case} + end; {case tildech} + + excch: begin {!} + GenerateCode(tree^.left); + if expressionType^.kind = pointerType then + expressionType := uLongPtr; + case UsualUnaryConversions of + + cgByte,cgUByte,cgWord,cgUWord: + Gen0(pc_not); + + cgLong,cgULong: begin + GenLdcLong(0); + Gen0t(pc_equ, cgLong); + end; + + cgExtended: begin + GenLdcReal(0.0); + Gen0t(pc_equ, cgExtended); + end; + + otherwise: + error(66); + end; {case} + expressionType := wordPtr; + end; {case excch} + + plusplusop: {prefix ++} + DoIncDec(tree^.left, pc_lil, pc_gil, pc_iil); + + opplusplus: {postfix ++} + DoIncDec(tree^.left, pc_lli, pc_gli, pc_ili); + + minusminusop: {prefix --} + DoIncDec(tree^.left, pc_ldl, pc_gdl, pc_idl); + + opminusminus: {postfix --} + DoIncDec(tree^.left, pc_lld, pc_gld, pc_ild); + + uand: {unary & (address operator)} + LoadAddress(tree^.left); + + uasterisk: begin {unary * (indirection)} + GenerateCode(tree^.left); + lType := expressionType; + if lType^.kind in [functiontype,arrayType,pointerType] then begin + if lType^.kind = arrayType then + lType := lType^.aType + else if lType^.kind = pointerType then + lType := lType^.pType; + expressionType := lType; + if lType^.kind = scalarType then + if lType^.baseType = cgVoid then + Gen1t(pc_ind, 0, cgULong) + else + Gen1t(pc_ind, 0, lType^.baseType) + else if lType^.kind = pointerType then + Gen1t(pc_ind, 0, cgULong) + else if not + (lType^.kind in [functionType,arrayType,structType,unionType]) then + Error(79); + end {if} + else if not (lType^.kind in [structType,unionType]) then + Error(79); + end; {case uasterisk} + + dotch: begin {.} + LoadAddress(tree^.left); + lType := expressionType; + if lType^.kind in [arrayType,pointerType] then begin + if lType^.kind = arrayType then + lType := lType^.aType + else if lType^.kind = pointerType then + lType := lType^.pType; + DoSelection(lType, tree^.right, size); + if (size & $00007FFF) <> size then begin + GenLdcLong(size); + Gen0(pc_adl); + size := 0; + end; {else} + kind := expressionType^.kind; + if kind = scalarType then begin + et := expressionType^.baseType; + if isBitField then begin + GenLdcLong(size); + Gen0(pc_adl); + if unsigned then + Gen2t(pc_lbu, bitDisp, bitSize, et) + else + Gen2t(pc_lbf, bitDisp, bitSize, et); + end {if} + else + Gen1t(pc_ind, long(size).lsw, et); + end {if} + else if kind = pointerType then + Gen1t(pc_ind, long(size).lsw, cgULong) + else if kind = enumType then + Gen1t(pc_ind, long(size).lsw, cgWord) + else if size <> 0 then + Gen1t(pc_inc, long(size).lsw, cgULong); + end {if} + else + Error(79); + end; {case dotch} + + colonch: begin {? :} + GenerateCode(tree^.left); {evaluate the condition} + CompareToZero(pc_neq); + GenerateCode(tree^.middle); {evaluate true expression} + lType := expressionType; + tlastwasconst := lastwasconst; + tlastconst := lastconst; + GenerateCode(tree^.right); {evaluate false expression} + isString := false; {handle string operands} + if lType^.kind in [arrayType,pointerType] then + if lType^.aType^.baseType = cgUByte then begin + with expressionType^ do + if kind in [arrayType,pointerType] then begin + if aType^.baseType = cgUByte then + isString := true + else if (kind = pointerType) + and (CompTypes(lType,expressionType)) then + {it's all OK} + else + Error(47) + end {if} + else if (kind = scalarType) + and lastWasConst + and (lastConst = 0) then + et := UsualBinaryConversions(lType) + {it's all OK} + else + Error(47); + lType := voidPtrPtr; + expressionType := voidPtrPtr; + end; {if} + with expressionType^ do + if kind in [arrayType,pointerType] then + if aType^.baseType in [cgByte,cgUByte] then begin + if kind = pointerType then begin + if tlastwasconst and (tlastconst = 0) then + {it's all OK} + else if CompTypes(lType, expressionType) then + {it's all OK} + else + Error(47); + end {if} + else + Error(47); + et := UsualBinaryConversions(lType); + lType := voidPtrPtr; + expressionType := voidPtrPtr; + end; {if} + {generate the operation} + if lType^.kind in [structType, unionType, arrayType] then begin + if not CompTypes(lType, expressionType) then + Error(47); + Gen0(pc_bno); + Gen0t(pc_tri, cgULong); + end {if} + else begin + if expressionType^.kind = pointerType then + tType := expressionType + else + tType := lType; + et := UsualBinaryConversions(lType); + Gen0(pc_bno); + Gen0t(pc_tri, et); + end; {else} + if isString then {set the type for strings} + expressionType := stringTypePtr; + end; {case colonch} + + castoper: begin {(cast)} + GenerateCode(tree^.left); + Cast(tree^.castType); + end; {case castoper} + + otherwise: + Error(57); + + end; {case} +if doDispose then + dispose(tree); +end; {GenerateCode} + + +procedure Expression {kind: expressionKind; stopSym: tokenSet}; + +{ handle an expression } +{ } +{ parameters: } +{ kind - Kind of expression; determines what operations } +{ and what kind of operands are allowed. } +{ stopSym - Set of symbols that can mark the end of an } +{ expression; used to skip tokens after syntax } +{ errors and to block certain operations. For } +{ example, the comma operator is not allowed in } +{ an expression when evaluating a function } +{ parameter list. } +{ } +{ variables: } +{ realExpressionValue - value of a real constant } +{ expression } +{ expressionValue - value of a constant expression } +{ expressionType - type of the constant expression } + +label 1; + +var + lcodeGeneration: boolean; {local copy of codeGeneration} + ldoDispose: boolean; {local copy of doDispose} + tree: tokenPtr; {expression tree} + castValue: tokenPtr; {element being type cast} + +begin {Expression} +errorFound := false; {no error so far} +tree := ExpressionTree(kind, stopSym); {create the expression tree} +if kind = normalExpression then begin {generate code from the expression tree} + if not errorFound then begin + doDispose := true; + GenerateCode(tree); + end; {if} + end {if} +else begin {record the expression for an initializer} + initializerTree := tree; + isConstant := false; + if errorFound then begin + DisposeTree(initializerTree); + initializerTree := nil; + end {if} + else begin + ldoDispose := doDispose; {find the expression type} + doDispose := false; + lcodeGeneration := codeGeneration; + codeGeneration := false; + GenerateCode(tree); + doDispose := ldoDispose; + codeGeneration := lCodeGeneration and (numErrors = 0); + {record the expression} + if tree^.token.kind = castoper then begin + castValue := tree^.left; + while castValue^.token.kind = castoper do + castValue := castValue^.left; + if castValue^.token.kind in [intconst,uintconst] then begin + expressionValue := castValue^.token.ival; + isConstant := true; + expressionType := tree^.castType; + if (castValue^.token.kind = uintconst) + or (expressionType^.kind = pointerType) then + expressionValue := expressionValue & $0000FFFF; + goto 1; + end; {if} + if castValue^.token.kind in [longconst,ulongconst] then begin + expressionValue := castValue^.token.lval; + isConstant := true; + expressionType := tree^.castType; + goto 1; + end; {if} + end; {if} + if tree^.token.kind = intconst then begin + expressionValue := tree^.token.ival; + expressionType := wordPtr; + isConstant := true; + end {else if} + else if tree^.token.kind = uintconst then begin + expressionValue := tree^.token.ival; + expressionType := uwordPtr; + isConstant := true; + end {else if} + else if tree^.token.kind = longconst then begin + expressionValue := tree^.token.lval; + expressionType := longPtr; + isConstant := true; + end {else if} + else if tree^.token.kind = ulongconst then begin + expressionValue := tree^.token.lval; + expressionType := ulongPtr; + isConstant := true; + end {else if} + else if tree^.token.kind = doubleconst then begin + realExpressionValue := tree^.token.rval; + expressionType := extendedPtr; + isConstant := true; + if kind in [arrayExpression,preprocessorExpression] then begin + expressionType := wordPtr; + expressionValue := 1; + Error(47); + end; {if} + end {else if} + else if tree^.token.kind = stringconst then begin + expressionValue := ord4(tree^.token.sval); + expressionType := stringTypePtr; + isConstant := true; + if kind in [arrayExpression,preprocessorExpression] then begin + expressionType := wordPtr; + expressionValue := 1; + Error(47); + end; {if} + end {else if} + else if kind in [arrayExpression,preprocessorExpression] then begin + DisposeTree(initializerTree); + expressionValue := 1; + end; {else if} + end; {else} + end; {else} +1: +end; {Expression} + + +procedure InitExpression; + +{ initialize the expression handler } + +begin {InitExpression} +startTerm := [ident,intconst,uintconst,longconst,ulongconst,doubleconst, + stringconst]; +startExpression:= startTerm + + [lparench,asteriskch,andch,plusch,minusch,excch,tildech,sizeofsy, + plusplusop,minusminusop,typedef]; +end; {InitExpression} + +end. + +{$append 'expression.asm'} diff --git a/Gen.pas b/Gen.pas old mode 100755 new mode 100644 index 81212ca..31c1c6e --- a/Gen.pas +++ b/Gen.pas @@ -1 +1,5648 @@ -{$optimize 7} {---------------------------------------------------------------} { } { Gen } { } { Generates native code from intermediate code instructions. } { } {---------------------------------------------------------------} unit Gen; interface {$segment 'gen'} {$LibPrefix '0/obj/'} uses CCommon, CGI, CGC, ObjOut, Native; {---------------------------------------------------------------} function LabelToDisp (lab: integer): integer; { convert a local label number to a stack frame displacement } { } { parameters: } { lab - label number } procedure Gen (blk: blockPtr); { Generates native code for a list of blocks } { } { parameters: } { blk - first of the list of blocks } {---------------------------------------------------------------} implementation const A_X = 1; {longword locations} onStack = 2; inPointer = 4; localAddress = 8; globalLabel = 16; constant = 32; {stack frame locations} {---------------------} returnSize = 3; {size of return address} type {possible locations for 4 byte values} longType = record {desciption of current four byte value} preference: integer; {where you want the value} where: integer; {where the value is at} fixedDisp: boolean; {is the displacement a fixed value?} isLong: boolean; {is long addr required for named labs?} disp: integer; {fixed displacement/local addr} lval: longint; {value} lab: stringPtr; {global label name} end; var gLong: longType; {info about last long value} namePushed: boolean; {has a name been pushed in this proc?} skipLoad: boolean; {skip load for a pc_lli, etc?} {stack frame locations} {---------------------} bankLoc: integer; {disp in dp where bank reg is stored} dworkLoc: integer; {disp in dp of 4 byte work spage for cg} funLoc: integer; {loc of fn ret value in stack frame} localSize: integer; {local space for current proc} parameterSize: integer; {# bytes of parameters for current proc} stackLoc: integer; {disp in dp where stack reg is stored} {---------------------------------------------------------------} procedure GenTree (op: icptr); forward; procedure OperA (mop: integer; op: icptr); { Do an operation on op that has addr modes equivalent to STA } { } { parameters: } { op - node to generate the leaf for } { mop - operation } var loc: integer; {stack frame position} opcode: pcodes; {temp storage} begin {OperA} opcode := op^.opcode; case opcode of pc_ldo,pc_gil,pc_gli,pc_gdl,pc_gld: begin case mop of m_cmp_imm: mop := m_cmp_abs; m_adc_imm: mop := m_adc_abs; m_and_imm: mop := m_and_abs; m_ora_imm: mop := m_ora_abs; m_sbc_imm: mop := m_sbc_abs; m_eor_imm: mop := m_eor_abs; otherwise: Error(cge1); end; {case} if opcode = pc_gil then GenNative(m_inc_abs, absolute, op^.q, op^.lab, 0) else if opcode = pc_gdl then GenNative(m_dec_abs, absolute, op^.q, op^.lab, 0); if smallMemoryModel then GenNative(mop, absolute, op^.q, op^.lab, 0) else GenNative(mop+2, longAbs, op^.q, op^.lab, 0); if opcode in [pc_gli,pc_gld] then begin if mop in [m_sbc_dir,m_cmp_dir] then GenImplied(m_php); if opcode = pc_gli then GenNative(m_inc_abs, absolute, op^.q, op^.lab, 0) else {if opcode = pc_gld then} GenNative(m_dec_abs, absolute, op^.q, op^.lab, 0); if mop in [m_sbc_dir,m_cmp_dir] then GenImplied(m_plp); end; {else} end; {case pc_ldo,pc_gil,pc_gli,pc_gdl,pc_gld} pc_lod,pc_lli,pc_lil,pc_lld,pc_ldl: begin case mop of m_cmp_imm: mop := m_cmp_dir; m_adc_imm: mop := m_adc_dir; m_and_imm: mop := m_and_dir; m_ora_imm: mop := m_ora_dir; m_sbc_imm: mop := m_sbc_dir; m_eor_imm: mop := m_eor_dir; otherwise: Error(cge1); end; {case} loc := LabelToDisp(op^.r); if opcode = pc_lod then loc := loc + op^.q; if opcode = pc_lil then GenNative(m_inc_dir, direct, loc, nil, 0) else if opcode = pc_ldl then GenNative(m_dec_dir, direct, loc, nil, 0); GenNative(mop, direct, loc, nil, 0); if opcode in [pc_lli,pc_lld] then begin if mop in [m_sbc_dir,m_cmp_dir] then GenImplied(m_php); if opcode = pc_lli then GenNative(m_inc_dir, direct, loc, nil, 0) else {if opc = pc_lld then} GenNative(m_dec_dir, direct, loc, nil, 0); if mop in [m_sbc_dir,m_cmp_dir] then GenImplied(m_plp); end; {else} end; {case pc_lod,pc_lli,pc_lil,pc_lld,pc_ldl} pc_ldc: GenNative(mop, immediate, op^.q, nil, 0); otherwise: Error(cge1); end; {case} end; {OperA} function Complex (op: icptr): boolean; { determine if loading the intermediate code involves anything } { but one reg } { } { parameters: } { code - intermediate code to check } { } { NOTE: for one and two byte values only!!! } begin {Complex} Complex := true; if op^.opcode in [pc_ldo,pc_ldc] then Complex := false else if op^.opcode in [pc_gil,pc_gli,pc_gdl,pc_gld] then Complex := smallMemoryModel else if op^.opcode = pc_lod then if LabelToDisp(op^.r) + op^.q < 256 then Complex := false else if op^.opcode in [pc_lli,pc_lil,pc_ldl,pc_lld] then if LabelToDisp(op^.r) < 256 then Complex := false; if op^.optype in [cgByte,cgUByte] then Complex := true; end; {Complex} procedure DoOp(op_imm, op_abs, op_dir: integer; icode: icptr; disp: integer); { Do an operation. } { } { Parameters: } { op_imm,op_abs,op_dir - op codes for the various } { addressing modes } { icode - intermediate code record } { disp - disp past the location (1 or 2) } var val: integer; {value for immediate operations} lval: longint; {long value for immediate operations} begin {DoOp} if icode^.opcode = pc_ldc then begin lval := icode^.lval; if disp = 0 then val := long(lval).lsw else val := long(lval).msw; GenNative(op_imm, immediate, val, nil, 0); end {if} else if icode^.opcode in [pc_lod,pc_str] then GenNative(op_dir, direct, LabelToDisp(icode^.r) + icode^.q + disp, nil, 0) else {if icode^.opcode in [pc_ldo, pc_sro] then} GenNative(op_abs, absolute, icode^.q + disp, icode^.lab, 0); end; {DoOp} procedure GetPointer (op: icptr); { convert a tree into a usable pointer for indirect } { loads/stores } { } { parameters: } { op - pointer tree } begin {GetPointer} gLong.preference := A_X+inPointer+localAddress+globalLabel; GenTree(op); if gLong.where = onStack then begin GenImplied(m_pla); GenImplied(m_plx); gLong.where := A_X; end; {if} if gLong.where = A_X then begin GenNative(m_sta_dir, direct, dworkLoc, nil, 0); GenNative(m_stx_dir, direct, dworkLoc+2, nil, 0); gLong.where := inPointer; gLong.fixedDisp := true; gLong.disp := dworkLoc; end; {else if} end; {GetPointer} procedure IncAddr (size: integer); { add a two byte constant to a four byte value - generally an } { address } { } { parameters: } { size - integer to add } var lab1: integer; {branch point} begin {IncAddr} if size <> 0 then case gLong.where of onStack: begin lab1 := GenLabel; GenImplied(m_pla); if size = 1 then begin GenImplied(m_ina); GenNative(m_bne, relative, lab1, nil, 0); end {if} else begin GenImplied(m_clc); GenNative(m_adc_imm, immediate, size, nil, 0); GenNative(m_bcc, relative, lab1, nil, 0); end; {else} GenImplied(m_plx); GenImplied(m_inx); GenImplied(m_phx); GenLab(lab1); GenImplied(m_pha); end; A_X: begin lab1 := GenLabel; if size = 1 then begin GenImplied(m_ina); GenNative(m_bne, relative, lab1, nil, 0); end {if} else begin GenImplied(m_clc); GenNative(m_adc_imm, immediate, size, nil, 0); GenNative(m_bcc, relative, lab1, nil, 0); end; {else} GenImplied(m_inx); GenLab(lab1); end; inPointer: if gLong.fixedDisp then begin gLong.fixedDisp := false; GenNative(m_ldy_imm, immediate, size, nil, 0); end {if} else if size <= 4 then begin while size <> 0 do begin GenImplied(m_iny); size := size - 1; end; {while} end {else if} else begin GenImplied(m_tya); GenImplied(m_clc); GenNative(m_adc_imm, immediate, size, nil, 0); GenImplied(m_tay); end; {else} localAddress,globalLabel: gLong.disp := gLong.disp+size; otherwise: Error(cge1); end; {case} end; {IncAddr} procedure LoadX (op: icptr); { Load X with a two byte value } { } { parameters: } { op - value to load } var q, r: integer; lab: stringPtr; begin {LoadX} q := op^.q; r := op^.r; lab := op^.lab; case op^.opcode of pc_lao,pc_lda: Error(cge1); pc_ldc: GenNative(m_ldx_imm, immediate, q, nil, 0); pc_ldo: GenNative(m_ldx_abs, absolute, q, lab, 0); pc_gli: begin GenNative(m_ldx_abs, absolute, q, lab, 0); GenNative(m_inc_abs, absolute, q, lab, 0); end; {if} pc_gil: begin GenNative(m_inc_abs, absolute, q, lab, 0); GenNative(m_ldx_abs, absolute, q, lab, 0); end; {if} pc_gld: begin GenNative(m_ldx_abs, absolute, q, lab, 0); GenNative(m_dec_abs, absolute, q, lab, 0); end; {if} pc_gdl: begin GenNative(m_dec_abs, absolute, q, lab, 0); GenNative(m_ldx_abs, absolute, q, lab, 0); end; {if} pc_lod: GenNative(m_ldx_dir, direct, LabelToDisp(r) + q, nil, 0); pc_lli: begin GenNative(m_ldx_dir, direct, LabelToDisp(r), nil, 0); GenNative(m_inc_dir, direct, LabelToDisp(r), nil, 0); end; {if} pc_lil: begin GenNative(m_inc_dir, direct, LabelToDisp(r), nil, 0); GenNative(m_ldx_dir, direct, LabelToDisp(r), nil, 0); end; {if} pc_lld: begin GenNative(m_ldx_dir, direct, LabelToDisp(r), nil, 0); GenNative(m_dec_dir, direct, LabelToDisp(r), nil, 0); end; {if} pc_ldl: begin GenNative(m_dec_dir, direct, LabelToDisp(r), nil, 0); GenNative(m_ldx_dir, direct, LabelToDisp(r), nil, 0); end; {if} otherwise: Error(cge1); end; {case} end; {LoadX} function NeedsCondition (opcode: pcodes): boolean; { See if the operation is one that doesn't set the condition } { code reliably } { } { Parameters: } { opcodes - operation to check } { } { Returns: True if the condition code is not set properly for } { an operand type of cgByte,cgUByte,cgWord,cgUWord, else } { false } begin {NeedsCondition} NeedsCondition := opcode in [pc_and,pc_ior,pc_cui,pc_cup,pc_lor,pc_lnd,pc_ldl,pc_lil,pc_lld, pc_lli,pc_gil,pc_gli,pc_gdl,pc_gld,pc_iil,pc_ili,pc_idl,pc_ild, pc_cop,pc_cpo,pc_cpi,pc_dvi,pc_mpi,pc_adi,pc_sbi,pc_mod,pc_bno]; end; {NeedsCondition} function SameLoc (load, save: icptr): boolean; { See if load and save represent the same location (which must } { be a direct page value or a global label). } { } { parameters: } { load - load operation } { save - save operation } { } { Returns: True the the same location is used, else false } begin {SameLoc} SameLoc := false; if save <> nil then begin if load^.opcode = pc_lod then begin if LabelToDisp(load^.r) + load^.q < 254 then if save^.opcode = pc_str then if save^.q = load^.q then if save^.r = load^.r then SameLoc := true; end {if} else if smallMemoryModel then if load^.opcode = pc_ldo then if save^.opcode = pc_sro then if load^.lab^ = save^.lab^ then if load^.q = save^.q then SameLoc := true; end; {if} end; {SameLoc} procedure SaveRetValue (optype: baseTypeEnum); { save a value returned by a function } { } { parameters: } { optype - function type } begin {SaveRetValue} if optype in [cgLong,cgULong] then begin if (A_X & gLong.preference) = 0 then begin gLong.where := onStack; GenImplied(m_phx); GenImplied(m_pha); end else gLong.where := A_X; end {if} else if optype in [cgReal,cgDouble,cgExtended,cgComp] then GenCall(8); end; {SaveRetValue} procedure GenAdlSbl (op, save: icptr); { generate code for pc_adl, pc_sbl } { } { parameters: } { op - pc_adl or pc_sbl operation } { save - save location (pc_str or pc_sro) or nil } var bcc,clc,adc_imm,inc_dir,adc_abs, {for op-code insensitive code} adc_dir,inc_abs,adc_s: integer; disp: integer; {direct page location} lab1: integer; {label number} lLong: longType; {used to reserve gLong} nd: icptr; {for swapping left/right children} opcode: pcodes; {temp storage; for efficiency} simpleStore: boolean; {is the store absolute or direct?} val: longint; {long constant value} function Simple (icode: icptr): boolean; { See if the intermediate code is simple; i.e., can be } { reached by direct page or absolute addressing. } var load: icptr; {left opcode} begin {Simple} Simple := false; if icode^.opcode = pc_ldc then Simple := true else if icode^.opcode in [pc_lod,pc_str] then begin if LabelToDisp(icode^.r) + icode^.q < 254 then Simple := true; end {else if} else if icode^.opcode in [pc_ldo,pc_sro] then Simple := smallMemoryModel; end; {Simple} begin {GenAdlSbl} {determine where the result goes} if save <> nil then gLong.preference := A_X+onStack+inPointer+localAddress+globalLabel+constant; lLong := gLong; {set up the master instructions} opcode := op^.opcode; if opcode = pc_adl then begin clc := m_clc; bcc := m_bcc; adc_imm := m_adc_imm; adc_abs := m_adc_abs; adc_dir := m_adc_dir; adc_s := m_adc_s; inc_dir := m_inc_dir; inc_abs := m_inc_abs; end {if} else begin clc := m_sec; bcc := m_bcs; adc_imm := m_sbc_imm; adc_abs := m_sbc_abs; adc_dir := m_sbc_dir; adc_s := m_sbc_s; inc_dir := m_dec_dir; inc_abs := m_dec_abs; end; {else} {if the lhs is a constant, swap the nodes} if ((op^.left^.opcode = pc_ldc) and (opcode = pc_adl)) then begin nd := op^.left; op^.left := op^.right; op^.right := nd; end; {if} {handle a constant rhs} if op^.right^.opcode = pc_ldc then val := op^.right^.lval else val := -1; if SameLoc(op^.left, save) and (long(val).msw = 0) then begin lab1 := GenLabel; if val = 1 then begin if opcode = pc_adl then begin DoOp(0, m_inc_abs, m_inc_dir, op^.left, 0); GenNative(m_bne, relative, lab1, nil, 0); DoOp(0, m_inc_abs, m_inc_dir, op^.left, 2); GenLab(lab1); end {if} else {if opcode = pc_sbl then} begin DoOp(m_lda_imm, m_lda_abs, m_lda_dir, op^.left, 0); GenNative(m_beq, relative, lab1, nil, 0); DoOp(0, m_dec_abs, m_dec_dir, op^.left, 0); GenLab(lab1); DoOp(0, m_dec_abs, m_dec_dir, op^.left, 2); end; {else} end {if} else begin {rhs in [2..65535]} GenImplied(clc); DoOp(m_lda_imm, m_lda_abs, m_lda_dir, op^.left, 0); GenNative(adc_imm, immediate, long(val).lsw, nil, 0); DoOp(0, m_sta_abs, m_sta_dir, op^.left, 0); GenNative(bcc, relative, lab1, nil, 0); if opcode = pc_adl then DoOp(0, m_inc_abs, m_inc_dir, op^.left, 2) else DoOp(0, m_dec_abs, m_dec_dir, op^.left, 2); GenLab(lab1); end; {else} end {if constant rhs} else begin simpleStore := false; if save <> nil then simpleStore := Simple(save); if (opcode = pc_adl) and Simple(op^.left) then begin nd := op^.left; op^.left := op^.right; op^.right := nd; end; {if} if simpleStore and Simple(op^.right) then begin if Simple(op^.left) then begin GenImplied(clc); DoOp(m_lda_imm, m_lda_abs, m_lda_dir, op^.left, 0); DoOp(adc_imm, adc_abs, adc_dir, op^.right, 0); DoOp(0, m_sta_abs, m_sta_dir, save, 0); DoOp(m_lda_imm, m_lda_abs, m_lda_dir, op^.left, 2); DoOp(adc_imm, adc_abs, adc_dir, op^.right, 2); DoOp(0, m_sta_abs, m_sta_dir, save, 2); end {if} else begin gLong.preference := A_X; GenTree(op^.left); GenImplied(clc); if gLong.where = onStack then GenImplied(m_pla); DoOp(adc_imm, adc_abs, adc_dir, op^.right, 0); DoOp(0, m_sta_abs, m_sta_dir, save, 0); if gLong.where = onStack then GenImplied(m_pla) else GenImplied(m_txa); DoOp(adc_imm, adc_abs, adc_dir, op^.right, 2); DoOp(0, m_sta_abs, m_sta_dir, save, 2); end; {else} end {if} else if Simple(op^.right) then begin gLong.preference := gLong.preference & A_X; GenTree(op^.left); GenImplied(clc); if gLong.where = onStack then begin GenImplied(m_pla); DoOp(adc_imm, adc_abs, adc_dir, op^.right, 0); GenImplied(m_pha); GenNative(m_lda_s, direct, 3, nil, 0); DoOp(adc_imm, adc_abs, adc_dir, op^.right, 2); GenNative(m_sta_s, direct, 3, nil, 0); end {if} else begin DoOp(adc_imm, adc_abs, adc_dir, op^.right, 0); GenImplied(m_tay); GenImplied(m_txa); DoOp(adc_imm, adc_abs, adc_dir, op^.right, 2); GenImplied(m_tax); GenImplied(m_tya); end; {else} end {else if} else begin {doing it the hard way} gLong.preference := onStack; GenTree(op^.right); gLong.preference := onStack; GenTree(op^.left); GenImplied(clc); GenImplied(m_pla); GenNative(adc_s, direct, 3, nil, 0); GenNative(m_sta_s, direct, 3, nil, 0); GenImplied(m_pla); GenNative(adc_s, direct, 3, nil, 0); GenNative(m_sta_s, direct, 3, nil, 0); if save = nil then gLong.where := onStack else if save^.opcode = pc_str then begin disp := LabelToDisp(save^.r) + save^.q; if disp < 254 then begin GenImplied(m_pla); GenNative(m_sta_dir, direct, disp, nil, 0); GenImplied(m_pla); GenNative(m_sta_dir, direct, disp+2, nil, 0); end {else if} else begin GenNative(m_ldx_imm, immediate, disp, nil, 0); GenImplied(m_pla); GenNative(m_sta_dirX, direct, 0, nil, 0); GenImplied(m_pla); GenNative(m_sta_dirX, direct, 2, nil, 0); end; {else} end {else if} else {if save^.opcode = pc_sro then} begin GenImplied(m_pla); if smallMemoryModel then GenNative(m_sta_abs, absolute, save^.q, save^.lab, 0) else GenNative(m_sta_long, longabsolute, save^.q, save^.lab, 0); GenImplied(m_pla); if smallMemoryModel then GenNative(m_sta_abs, absolute, save^.q+2, save^.lab, 0) else GenNative(m_sta_long, longabsolute, save^.q+2, save^.lab, 0); end; {else} end; {else} end; {else} end; {GenAdlSbl} procedure GenCmp (op: icptr; rOpcode: pcodes; lb: integer); { generate code for pc_les, pc_leq, pc_grt or pc_geq } { } { parameters: } { op - operation } { rOpcode - Opcode that will use the result of the } { compare. If the result is used by a tjp or fjp, } { this procedure generated special code and does the } { branch internally. } { lb - For fjp, tjp, this is the label to branch to if } { the condition is satisfied. } var i: integer; {loop variable} lab1,lab2,lab3,lab4: integer; {label numbers} num: integer; {constant to compare to} procedure Switch; { switch the operands } var nd: icptr; {used to switch nodes} begin {Switch} nd := op^.left; op^.left := op^.right; op^.right := nd; end; {Switch} begin {GenCmp} {To reduct the number of possibilities that must be handled, pc_les } {and pc_leq compares are reduced to their equivalent pc_grt and } {pc_geq instructions. } if op^.opcode = pc_les then begin Switch; op^.opcode := pc_grt; end {if} else if op^.opcode = pc_leq then begin Switch; op^.opcode := pc_geq; end; {else if} {To take advantage of shortcuts, switch operands if generating } {for a tjp or fjp with a constant left operand. } if op^.optype in [cgByte,cgUByte,cgWord,cgUWord] then if op^.left^.opcode = pc_ldc then if rOpcode in [pc_tjp,pc_fjp] then begin if op^.opcode = pc_geq then op^.opcode := pc_grt else op^.opcode := pc_geq; if rOpcode = pc_tjp then rOpcode := pc_fjp else rOpcode := pc_tjp; Switch; end; {if} {Short cuts are available for single-word operands where the } {right operand is a constant. } if (op^.optype in [cgByte,cgUByte,cgWord,cgUWord]) and (op^.right^.opcode = pc_ldc) then begin GenTree(op^.left); num := op^.right^.q; lab1 := GenLabel; if rOpcode = pc_fjp then begin if op^.optype in [cgByte,cgWord] then begin if NeedsCondition(op^.left^.opcode) then GenImplied(m_tax); if (num >= 0) and (num < 4) then begin if op^.opcode = pc_geq then begin if num <> 0 then begin lab2 := GenLabel; GenNative(m_bmi, relative, lab2, nil, 0); for i := 1 to num do GenImplied(m_dea); end; {if} GenNative(m_bpl, relative, lab1, nil, 0); if num <> 0 then GenLab(lab2); GenNative(m_brl, longrelative, lb, nil, 0); GenLab(lab1); end {if} else {if opcode = pc_grt then} begin lab2 := GenLabel; GenNative(m_bmi, relative, lab2, nil, 0); for i := 0 to num do GenImplied(m_dea); GenNative(m_bpl, relative, lab1, nil, 0); GenLab(lab2); GenNative(m_brl, longrelative, lb, nil, 0); GenLab(lab1); end; {else if} end {if (num >= 0) and (num < 4)} else begin lab2 := GenLabel; if num > 0 then GenNative(m_bmi, relative, lab1, nil, 0) else GenNative(m_bpl, relative, lab1, nil, 0); GenNative(m_cmp_imm, immediate, num, nil, 0); if op^.opcode = pc_grt then begin lab3 := GenLabel; GenNative(m_beq, relative, lab3, nil, 0); GenNative(m_bcs, relative, lab2, nil, 0); GenLab(lab3); end else GenNative(m_bcs, relative, lab2, nil, 0); if num > 0 then begin GenLab(lab1); GenNative(m_brl, longrelative, lb, nil, 0); end {if} else begin GenNative(m_brl, longrelative, lb, nil, 0); GenLab(lab1); end; {else} GenLab(lab2); end; {else if} end {if} else {if optype in [cgUByte,cgUWord] then} begin GenNative(m_cmp_imm, immediate, num, nil, 0); if op^.opcode = pc_grt then begin lab2 := GenLabel; GenNative(m_beq, relative, lab2, nil, 0); end; {if} GenNative(m_bcs, relative, lab1, nil, 0); if op^.opcode = pc_grt then GenLab(lab2); GenNative(m_brl, longrelative, lb, nil, 0); GenLab(lab1); end; {else} end {if rOpcode = pc_fjp} else if rOpcode = pc_tjp then begin if op^.optype in [cgByte,cgWord] then begin if NeedsCondition(op^.left^.opcode) then GenImplied(m_tax); if (num >= 0) and (num < 4) then begin lab2 := GenLabel; if op^.opcode = pc_geq then begin GenNative(m_bmi, relative, lab1, nil, 0); if num > 0 then begin for i := 1 to num do GenImplied(m_dea); GenNative(m_bmi, relative, lab2, nil, 0); end; {if} GenNative(m_brl, longrelative, lb, nil, 0); end {if} else {if op^.opcode = pc_grt then} begin if num > 0 then begin GenNative(m_bmi, relative, lab1, nil, 0); for i := 0 to num do GenImplied(m_dea); GenNative(m_bmi, relative, lab2, nil, 0); end {if} else begin GenNative(m_beq, relative, lab1, nil, 0); GenNative(m_bmi, relative, lab2, nil, 0); end; {else} GenNative(m_brl, longrelative, lb, nil, 0); end; {else} GenLab(lab2); GenLab(lab1); end {if (num >= 0) and (num < 4)} else begin lab2 := GenLabel; if num > 0 then GenNative(m_bmi, relative, lab1, nil, 0) else GenNative(m_bpl, relative, lab1, nil, 0); GenNative(m_cmp_imm, immediate, num, nil, 0); if op^.opcode = pc_grt then begin lab3 := GenLabel; GenNative(m_beq, relative, lab3, nil, 0); end; {if} GenNative(m_bcc, relative, lab2, nil, 0); if num > 0 then begin GenNative(m_brl, longrelative, lb, nil, 0); GenLab(lab2); GenLab(lab1); end {if} else begin GenLab(lab1); GenNative(m_brl, longrelative, lb, nil, 0); GenLab(lab2); end; {else} if op^.opcode = pc_grt then GenLab(lab3); end; {else} end {if} else {if optype in [cgUByte,cgUWord] then} begin GenNative(m_cmp_imm, immediate, num, nil, 0); GenNative(m_bcc, relative, lab1, nil, 0); if op^.opcode = pc_grt then begin lab2 := GenLabel; GenNative(m_beq, relative, lab1, nil, 0); end; {if} GenNative(m_brl, longrelative, lb, nil, 0); if op^.opcode = pc_grt then GenLab(lab2); GenLab(lab1); end; {else} end {if rOpcode = pc_tjp} else if op^.optype in [cgByte,cgWord] then begin lab2 := GenLabel; GenNative(m_ldx_imm, immediate, 1, nil, 0); GenImplied(m_sec); GenNative(m_sbc_imm, immediate, num, nil, 0); if op^.opcode = pc_grt then begin lab3 := GenLabel; GenNative(m_beq, relative, lab3, nil, 0); end; {if} GenNative(m_bvs, relative, lab1, nil, 0); GenNative(m_eor_imm, immediate, $8000, nil, 0); GenLab(lab1); GenNative(m_bmi, relative, lab2, nil, 0); if op^.opcode = pc_grt then GenLab(lab3); GenImplied(m_dex); GenLab(lab2); GenImplied(m_txa); end {else if} else begin GenNative(m_ldx_imm, immediate, 0, nil, 0); GenNative(m_cmp_imm, immediate, num, nil, 0); GenNative(m_bcc, relative, lab1, nil, 0); if op^.opcode = pc_grt then GenNative(m_beq, relative, lab1, nil, 0); GenImplied(m_inx); GenLab(lab1); GenImplied(m_txa); end; {else if} end {if (op^.optype in [cgByte,cgUByte,cgWord,cgUWord]) and (op^.right^.opcode = pc_ldc)} {This section of code handles the cases where the above short } {cuts cannot be used. } else case op^.optype of cgByte,cgUByte,cgWord,cgUWord: begin if Complex(op^.right) then begin GenTree(op^.right); if Complex(op^.left) then begin GenImplied(m_pha); GenTree(op^.left); GenImplied(m_ply); GenNative(m_sty_dir, direct, dworkLoc, nil, 0); end {if} else begin GenNative(m_sta_dir, direct, dworkLoc, nil, 0); GenTree(op^.left); end; {else} if not (rOpcode in [pc_fjp,pc_tjp]) then GenNative(m_ldx_imm, immediate, 1, nil, 0); if op^.optype in [cgByte,cgWord] then begin GenImplied(m_sec); GenNative(m_sbc_dir, direct, dworkLoc, nil, 0); end {if} else GenNative(m_cmp_dir, direct, dworkLoc, nil, 0); end {if} else begin GenTree(op^.left); if not (rOpcode in [pc_fjp,pc_tjp]) then GenNative(m_ldx_imm, immediate, 1, nil, 0); if op^.optype in [cgByte,cgWord] then begin GenImplied(m_sec); OperA(m_sbc_imm, op^.right); if op^.right^.opcode in [pc_lld,pc_lli,pc_gli,pc_gld] then GenImplied(m_tay); end {if} else OperA(m_cmp_imm, op^.right); end; {else} if rOpcode = pc_fjp then begin lab2 := GenLabel; if op^.opcode = pc_grt then begin lab3 := GenLabel; GenNative(m_beq, relative, lab3, nil, 0); end; {if} if op^.optype in [cgByte,cgWord] then begin lab1 := GenLabel; GenNative(m_bvs, relative, lab1, nil, 0); GenNative(m_eor_imm, immediate, $8000, nil, 0); GenLab(lab1); GenNative(m_bmi, relative, lab2, nil, 0); end {if} else GenNative(m_bcs, relative, lab2, nil, 0); if op^.opcode = pc_grt then GenLab(lab3); GenNative(m_brl, longrelative, lb, nil, 0); GenLab(lab2); end {if} else if rOpcode = pc_tjp then begin lab2 := GenLabel; if op^.opcode = pc_grt then begin lab3 := GenLabel; GenNative(m_beq, relative, lab3, nil, 0); end; {if} if op^.optype in [cgByte,cgWord] then begin lab1 := GenLabel; GenNative(m_bvs, relative, lab1, nil, 0); GenNative(m_eor_imm, immediate, $8000, nil, 0); GenLab(lab1); GenNative(m_bpl, relative, lab2, nil, 0); end {if} else GenNative(m_bcc, relative, lab2, nil, 0); GenNative(m_brl, longrelative, lb, nil, 0); if op^.opcode = pc_grt then GenLab(lab3); GenLab(lab2); end {else if} else begin lab2 := GenLabel; if op^.opcode = pc_grt then begin lab3 := GenLabel; GenNative(m_beq, relative, lab3, nil, 0); end; {if} if op^.optype in [cgByte,cgWord] then begin lab1 := GenLabel; GenNative(m_bvs, relative, lab1, nil, 0); GenNative(m_eor_imm, immediate, $8000, nil, 0); GenLab(lab1); GenNative(m_bmi, relative, lab2, nil, 0); end {if} else GenNative(m_bcs, relative, lab2, nil, 0); if op^.opcode = pc_grt then GenLab(lab3); GenImplied(m_dex); GenLab(lab2); GenImplied(m_txa); end; {else} end; {case optype of cgByte,cgUByte,cgWord,cgUWord} cgULong: begin gLong.preference := onStack; GenTree(op^.right); gLong.preference := A_X; GenTree(op^.left); if gLong.where = onStack then begin GenImplied(m_ply); GenImplied(m_pla); end {if} else begin GenImplied(m_tay); GenImplied(m_txa); end; {else} lab1 := GenLabel; GenNative(m_ldx_imm, immediate, 1, nil, 0); GenNative(m_cmp_s, direct, 3, nil, 0); GenNative(m_bne, relative, lab1, nil, 0); GenImplied(m_tya); GenNative(m_cmp_s, direct, 1, nil, 0); GenLab(lab1); lab2 := GenLabel; if op^.opcode = pc_grt then begin lab3 := GenLabel; GenNative(m_beq, relative, lab3, nil, 0); end; {if} GenNative(m_bcs, relative, lab2, nil, 0); if op^.opcode = pc_grt then GenLab(lab3); GenImplied(m_dex); GenLab(lab2); GenImplied(m_pla); GenImplied(m_pla); GenImplied(m_txa); if rOpcode = pc_fjp then begin lab4 := GenLabel; GenNative(m_bne, relative, lab4, nil, 0); GenNative(m_brl, longrelative, lb, nil, 0); GenLab(lab4); end {if} else if rOpcode = pc_tjp then begin lab4 := GenLabel; GenNative(m_beq, relative, lab4, nil, 0); GenNative(m_brl, longrelative, lb, nil, 0); GenLab(lab4); end; {else if} end; cgReal,cgDouble,cgComp,cgExtended: begin GenTree(op^.left); GenTree(op^.right); num := 31; if op^.opcode = pc_geq then GenCall(32) else GenCall(31); if (rOpcode = pc_fjp) or (rOpcode = pc_tjp) then begin lab1 := GenLabel; if rOpcode = pc_fjp then GenNative(m_bne, relative, lab1, nil, 0) else GenNative(m_beq, relative, lab1, nil, 0); GenNative(m_brl,longrelative,lb,nil,0); GenLab(lab1); end; {if} end; {case optype of cgReal..cgExtended} cgLong: begin gLong.preference := onStack; GenTree(op^.left); if op^.opcode = pc_geq then begin gLong.preference := A_X; GenTree(op^.right); if gLong.where = onStack then begin GenImplied(m_pla); GenImplied(m_plx); end; {if} num := 30; end {if} else begin gLong.preference := onStack; GenTree(op^.right); num := 29; end; {else} GenCall(num); if (rOpcode = pc_fjp) or (rOpcode = pc_tjp) then begin lab1 := GenLabel; if rOpcode = pc_fjp then GenNative(m_bne, relative, lab1, nil, 0) else GenNative(m_beq, relative, lab1, nil, 0); GenNative(m_brl, longrelative, lb, nil, 0); GenLab(lab1); end; {if} end; {case optype of cgLong} otherwise: Error(cge1); end; {case} end; {GenCmp} procedure GenCnv (op: icptr); { generate a pc_cnv instruction } const {note: these constants list all legal } { conversions; others are ignored} cReal = $06; cDouble = $07; cComp = $08; cExtended = $09; cVoid = $0B; byteToWord = $02; byteToUword = $03; byteToLong = $04; byteToUlong = $05; byteToReal = $06; byteToDouble = $07; ubyteToLong = $14; ubyteToUlong = $15; ubyteToReal = $16; ubyteToDouble = $17; wordToByte = $20; wordToUByte = $21; wordToLong = $24; wordToUlong = $25; wordToReal = $26; wordToDouble = $27; uwordToByte = $30; uwordToUByte = $31; uwordToLong = $34; uwordToUlong = $35; uwordToReal = $36; uwordToDouble = $37; longTobyte = $40; longToUbyte = $41; longToWord = $42; longToUword = $43; longToReal = $46; longToDouble = $47; longToVoid = $4B; ulongTobyte = $50; ulongToUbyte = $51; ulongToWord = $52; ulongToUword = $53; ulongToReal = $56; ulongToDouble = $57; ulongToVoid = $5B; realTobyte = $60; realToUbyte = $61; realToWord = $62; realToUword = $63; realToLong = $64; realToUlong = $65; realToVoid = $6B; doubleTobyte = $70; doubleToUbyte = $71; doubleToWord = $72; doubleToUword = $73; doubleToLong = $74; doubleToUlong = $75; var fromReal: boolean; {are we converting from a real?} lab1: integer; {used for branches} lLong: longType; {used to reserve gLong} begin {GenCnv} lLong := gLong; gLong.preference := onStack+A_X+constant; gLong.where := onStack; if ((op^.q & $00F0) >> 4) in [cDouble,cExtended,cComp] then begin op^.q := (op^.q & $000F) | (cReal * 16); fromReal := true; end {if} else fromReal := false; if (op^.q & $000F) in [cDouble,cExtended,cComp] then op^.q := (op^.q & $00F0) | cReal; GenTree(op^.left); if op^.q in [wordToLong,wordToUlong] then begin lab1 := GenLabel; GenNative(m_ldx_imm, immediate, 0, nil, 0); GenImplied(m_tay); GenNative(m_bpl, relative, lab1, nil, 0); GenImplied(m_dex); GenLab(lab1); if (lLong.preference & A_X) <> 0 then gLong.where := A_X else begin gLong.where := onStack; GenImplied(m_phx); GenImplied(m_pha); end; {else} end {if} else if op^.q in [byteToLong,byteToUlong] then begin lab1 := GenLabel; GenNative(m_ldx_imm, immediate, 0, nil, 0); GenNative(m_bit_imm, immediate, $0080, nil, 0); GenNative(m_beq, relative, lab1, nil, 0); GenImplied(m_dex); GenNative(m_ora_imm, immediate, $FF00, nil, 0); GenLab(lab1); if (lLong.preference & A_X) <> 0 then gLong.where := A_X else begin gLong.where := onStack; GenImplied(m_phx); GenImplied(m_pha); end; {else} end {if} else if op^.q in [byteToWord,byteToUword] then begin lab1 := GenLabel; GenNative(m_bit_imm, immediate, $0080, nil, 0); GenNative(m_beq, relative, lab1, nil, 0); GenNative(m_ora_imm, immediate, $FF00, nil, 0); GenLab(lab1); end {if} else if op^.q in [ubyteToLong,ubyteToUlong,uwordToLong,uwordToUlong] then begin if (lLong.preference & A_X) <> 0 then begin gLong.where := A_X; GenNative(m_ldx_imm, immediate, 0, nil, 0); end {if} else begin gLong.where := onStack; GenNative(m_pea, immediate, 0, nil, 0); GenImplied(m_pha); end; {else} end {else if} else if op^.q in [wordToByte,wordToUbyte,uwordToByte,uwordToUbyte] then GenNative(m_and_imm, immediate, $00FF, nil, 0) else if op^.q in [byteToReal,uByteToReal,wordToReal] then GenCall(11) else if op^.q = uwordToReal then begin GenNative(m_ldx_imm, immediate, 0, nil, 0); GenCall(12); end {else if} else if op^.q in [longToByte,longToUbyte,ulongToByte,ulongToUbyte] then begin if gLong.where = A_X then GenNative(m_and_imm, immediate, $00FF, nil, 0) else if gLong.where = constant then GenNative(m_lda_imm, immediate, long(gLong.lval).lsw & $00FF, nil, 0) else {if gLong.where = onStack then} begin GenImplied(m_pla); GenImplied(m_plx); GenNative(m_and_imm, immediate, $00FF, nil, 0); end; {else if} end {else if} else if op^.q in [longToWord,longToUword,ulongToWord,ulongToUword] then begin {Note: if the result is in A_X, no further action is needed} if gLong.where = constant then GenNative(m_lda_imm, immediate, long(gLong.lval).lsw, nil, 0) else if gLong.where = onStack then begin GenImplied(m_pla); GenImplied(m_plx); end; {else if} end {else if} else if op^.q in [longToReal,uLongToReal] then begin if gLong.where = constant then begin GenNative(m_lda_imm, immediate, long(gLong.lval).lsw, nil, 0); GenNative(m_ldx_imm, immediate, long(gLong.lval).msw, nil, 0); end {if} else if gLong.where = onStack then begin GenImplied(m_pla); GenImplied(m_plx); end; {else if} if op^.q = longToReal then GenCall(12) else GenCall(13); end {else} else if op^.q in [realToByte,realToUbyte,realToWord] then begin GenCall(14); if (op^.q & $00FF) in [0,1] then GenNative(m_and_imm, immediate, $00FF, nil, 0); end {else if} else if op^.q = realToUword then GenCall(15) else if op^.q in [realToLong,realToUlong] then begin if op^.q & $00FF = 5 then GenCall(17) else GenCall(16); if (lLong.preference & A_X) <> 0 then gLong.where := A_X else begin gLong.where := onStack; GenImplied(m_phx); GenImplied(m_pha); end; {else} end {else if} else if op^.q = realToVoid then begin GenImplied(m_tsc); GenImplied(m_clc); GenNative(m_adc_imm, immediate, 10, nil, 0); GenImplied(m_tcs); end {else if} else if op^.q in [longToVoid,ulongToVoid] then begin if gLong.where = onStack then begin GenImplied(m_pla); GenImplied(m_plx); gLong.where := A_X; end; {if} end {else if} else if (op^.q & $000F) = cVoid then {do nothing} else if lLong.preference & gLong.where = 0 then begin if gLong.where = constant then begin GenNative(m_pea, immediate, long(gLong.lval).msw, nil, 0); GenNative(m_pea, immediate, long(gLong.lval).lsw, nil, 0); end {if} else if gLong.where = A_X then begin GenImplied(m_phx); GenImplied(m_pha); end; {else if} gLong.where := onStack; end; {else if} end; {GenCnv} procedure GenEquNeq (op: icptr; opcode: pcodes; lb: integer); { generate a pc_equ or pc_neq instruction } { } { parameters: } { op - node to generate the compare for } { opcode - Opcode that will use the result of the compare. } { If the result is used by a tjp or fjp, this procedure } { generates special code and does the branch internally. } { lb - For fjp, tjp, this is the label to branch to if } { the condition is satisfied. } var nd: icptr; {work node} num: integer; {constant to compare to} lab1,lab2: integer; {label numbers} bne: integer; {instruction for a pc_equ bne branch} beq: integer; {instruction for a pc_equ beq branch} lLong: longType; {local long value information} leftOp,rightOp: pcodes; {opcode codes to left, right} procedure DoOr (op: icptr); { or the two halves of a four byte value } { } { parameters: } { operand to or } var disp: integer; {disp of value on stack frame} begin {DoOr} with op^ do begin if opcode = pc_ldo then begin GenNative(m_lda_abs, absolute, q, lab, 0); GenNative(m_ora_abs, absolute, q+2, lab, 0); end {if} else begin disp := LabelToDisp(r) + q; if disp < 254 then begin GenNative(m_lda_dir, direct, disp, nil, 0); GenNative(m_ora_dir, direct, disp+2, nil, 0); end {else if} else begin GenNative(m_ldx_imm, immediate, disp, nil, 0); GenNative(m_lda_dirX, direct, 0, nil, 0); GenNative(m_ora_dirX, direct, 2, nil, 0); end; {else} end; {else} end; {with} end; {DoOr} procedure DoCmp (op: icPtr); { compare a long value in A_X to a local or global scalar } { } { parameters: } { op - value to compare to } var disp: integer; {disp of value on stack frame} lab1: integer; {label numbers} begin {DoCmp} lab1 := GenLabel; with op^ do begin if opcode = pc_ldo then begin GenNative(m_cmp_abs, absolute, q, lab, 0); GenNative(m_bne, relative, lab1, nil, 0); GenNative(m_cpx_abs, absolute, q+2, lab, 0); end {if} else begin disp := LabelToDisp(r) + q; if disp < 254 then begin GenNative(m_cmp_dir, direct, disp, nil, 0); GenNative(m_bne, relative, lab1, nil, 0); GenNative(m_cpx_dir, direct, disp+2, nil, 0); end {if} else begin GenImplied(m_txy); GenNative(m_ldx_imm, immediate, disp, nil, 0); GenNative(m_cmp_dirX, direct, 0, nil, 0); GenNative(m_bne, relative, lab1, nil, 0); GenImplied(m_tya); GenNative(m_cmp_dirX, direct, 2, nil, 0); end; {else} end; {else} GenLab(lab1); end; {with} end; {DoCmp} begin {GenEquNeq} if op^.opcode = pc_equ then begin bne := m_bne; beq := m_beq; end {if} else begin bne := m_beq; beq := m_bne; end; {else} if op^.left^.opcode in [pc_lod,pc_ldo] then begin nd := op^.left; op^.left := op^.right; op^.right := nd; end; {if} if op^.left^.opcode = pc_ldc then begin nd := op^.left; op^.left := op^.right; op^.right := nd; end; {if} leftOp := op^.left^.opcode; {set op codes for fast access} rightOp := op^.right^.opcode; if (op^.optype in [cgByte,cgUByte,cgWord,cgUWord]) and (rightOp = pc_ldc) then begin GenTree(op^.left); num := op^.right^.q; lab1 := GenLabel; if opcode in [pc_fjp,pc_tjp] then begin if num <> 0 then GenNative(m_cmp_imm, immediate, num, nil, 0) else if NeedsCondition(leftOp) then GenImplied(m_tay); if opcode = pc_fjp then GenNative(beq, relative, lab1, nil, 0) else GenNative(bne, relative, lab1, nil, 0); GenNative(m_brl, longrelative, lb, nil, 0); GenLab(lab1); end {if} else begin GenNative(m_ldx_imm, immediate, 0, nil, 0); GenNative(m_cmp_imm, immediate, num, nil, 0); GenNative(bne, relative, lab1, nil, 0); GenImplied(m_inx); GenLab(lab1); GenImplied(m_txa); end; {else} end {if} else if (op^.optype in [cgLong,cgULong]) and (leftOp in [pc_ldo,pc_lod]) and (rightOp = pc_ldc) and (op^.right^.lval = 0) then begin if opcode in [pc_fjp,pc_tjp] then begin DoOr(op^.left); lab1 := GenLabel; if opcode = pc_fjp then GenNative(beq, relative, lab1, nil, 0) else GenNative(bne, relative, lab1, nil, 0); GenNative(m_brl, longrelative, lb, nil, 0); GenLab(lab1); end {if} else if op^.opcode = pc_equ then begin lab1 := GenLabel; lab2 := GenLabel; DoOr(op^.left); GenNative(bne, relative, lab1, nil, 0); GenNative(m_lda_imm, immediate, 1, nil, 0); GenNative(m_bra, relative, lab2, nil, 0); GenLab(lab1); GenNative(m_lda_imm, immediate, 0, nil, 0); GenLab(lab2); end {else if} else {if op^.opcode = pc_neq then} begin lab1 := GenLabel; DoOr(op^.left); GenNative(m_beq, relative, lab1, nil, 0); GenNative(m_lda_imm, immediate, 1, nil, 0); GenLab(lab1); end; {else if} end {else if} else if (op^.optype in [cgLong,cgULong]) and (rightOp in [pc_ldo,pc_lod]) then begin gLong.preference := A_X; GenTree(op^.left); if gLong.where = onStack then begin GenImplied(m_pla); GenImplied(m_plx); end; {if} if opcode in [pc_fjp,pc_tjp] then begin DoCmp(op^.right); lab1 := GenLabel; if opcode = pc_fjp then GenNative(beq, relative, lab1, nil, 0) else GenNative(bne, relative, lab1, nil, 0); GenNative(m_brl, longrelative, lb, nil, 0); GenLab(lab1); end {if} else begin lab1 := GenLabel; lab2 := GenLabel; DoCmp(op^.right); GenNative(bne, relative, lab1, nil, 0); GenNative(m_lda_imm, immediate, 1, nil, 0); GenNative(m_bra, relative, lab2, nil, 0); GenLab(lab1); GenNative(m_lda_imm, immediate, 0, nil, 0); GenLab(lab2); end; {else} end {else if} else case op^.optype of cgByte,cgUByte,cgWord,cgUWord: begin if not Complex(op^.left) then if Complex(op^.right) then begin nd := op^.left; op^.left := op^.right; op^.right := nd; end; {if} GenTree(op^.left); if Complex(op^.right) or (not (opcode in [pc_fjp,pc_tjp])) then begin GenImplied(m_pha); GenTree(op^.right); GenImplied(m_sec); GenNative(m_sbc_s, direct, 1, nil, 0); GenImplied(m_plx); GenImplied(m_tax); if opcode in [pc_fjp,pc_tjp] then begin lab1 := GenLabel; if opcode = pc_fjp then GenNative(beq, relative, lab1, nil, 0) else GenNative(bne, relative, lab1, nil, 0); GenNative(m_brl, longrelative, lb, nil, 0); GenLab(lab1); end {if} else begin lab1 := GenLabel; GenNative(m_beq, relative, lab1, nil, 0); GenNative(m_lda_imm, immediate, 1, nil, 0); GenLab(lab1); if op^.opcode = pc_equ then GenNative(m_eor_imm, immediate, 1, nil, 0); end; {else} end {if} else begin OperA(m_cmp_imm, op^.right); lab1 := GenLabel; if opcode = pc_fjp then GenNative(beq, relative, lab1, nil, 0) else GenNative(bne, relative, lab1, nil, 0); GenNative(m_brl, longrelative, lb, nil, 0); GenLab(lab1); end; {else} end; {case optype of cgByte,cgUByte,cgWord,cgUWord} cgLong,cgULong: begin gLong.preference := onStack; GenTree(op^.left); lLong := gLong; gLong.preference := A_X; GenTree(op^.right); if gLong.where = onStack then begin GenImplied(m_pla); GenImplied(m_plx); end; {if} GenNative(m_ldy_imm, immediate, 1, nil, 0); GenNative(m_cmp_s, direct, 1, nil, 0); lab1 := GenLabel; GenNative(m_beq, relative, lab1, nil, 0); GenImplied(m_dey); GenLab(lab1); GenImplied(m_txa); GenNative(m_cmp_s, direct, 3, nil, 0); lab1 := GenLabel; GenNative(m_beq, relative, lab1, nil, 0); GenNative(m_ldy_imm, immediate, 0, nil, 0); GenLab(lab1); GenImplied(m_pla); GenImplied(m_pla); GenImplied(m_tya); if opcode in [pc_fjp,pc_tjp] then begin lab1 := GenLabel; if opcode = pc_fjp then GenNative(bne, relative, lab1, nil, 0) else GenNative(beq, relative, lab1, nil, 0); GenNative(m_brl, longrelative, lb, nil, 0); GenLab(lab1); end {if} else if op^.opcode = pc_neq then GenNative(m_eor_imm, immediate, 1, nil, 0); end; {case optype of cgLong,cgULong} cgReal,cgDouble,cgComp,cgExtended: begin GenTree(op^.left); GenTree(op^.right); GenCall(36); if opcode in [pc_fjp,pc_tjp] then begin lab1 := GenLabel; if opcode = pc_fjp then GenNative(bne, relative, lab1, nil, 0) else GenNative(beq, relative, lab1, nil, 0); GenNative(m_brl, longrelative, lb, nil, 0); GenLab(lab1); end {if} else if op^.opcode = pc_neq then GenNative(m_eor_imm, immediate, 1, nil, 0); end; {case optype of cgReal..cgExtended,cgSet,cgString} otherwise: Error(cge1); end; {case} end; {GenEquNeq} procedure GenGilGliGdlGld (op: icptr); { Generate code for a pc_gil, pc_gli, pc_gdl or pc_gld } var lab1: integer; {branch point} lab: stringPtr; {op^.lab} opcode: pcodes; {op^.opcode} q: integer; {op^.q} procedure DoGIncDec (opcode: pcodes; lab: stringPtr; p, q: integer); { Do a decrement or increment on a global four byte value } { } { parameters } { opcode - operation code } { lab - label } { q - disp to value } { p - number to ind/dec by } var lab1: integer; {branch point} begin {DoGIncDec} if smallMemoryModel then begin if opcode in [pc_gil,pc_gli] then begin lab1 := GenLabel; if p = 1 then begin GenNative(m_inc_abs, absolute, q, lab, 0); GenNative(m_bne, relative, lab1, nil, 0); end {if} else begin GenImplied(m_clc); GenNative(m_lda_abs, absolute, q, lab, 0); GenNative(m_adc_imm, immediate, p, nil, 0); GenNative(m_sta_abs, absolute, q, lab, 0); GenNative(m_bcc, relative, lab1, nil, 0); end; {else} GenNative(m_inc_abs, absolute, q+2, lab, 0); GenLab(lab1); end {if} else {if opcode in [pc_gdl,pc_gld] then} begin lab1 := GenLabel; if p = 1 then begin GenNative(m_lda_abs, absolute, q, lab, 0); GenNative(m_bne, relative, lab1, nil, 0); GenNative(m_dec_abs, absolute, q+2, lab, 0); GenLab(lab1); GenNative(m_dec_abs, absolute, q, lab, 0); end {if} else begin GenImplied(m_sec); GenNative(m_lda_abs, absolute, q, lab, 0); GenNative(m_sbc_imm, immediate, p, nil, 0); GenNative(m_sta_abs, absolute, q, lab, 0); GenNative(m_bcs, relative, lab1, nil, 0); GenNative(m_dec_abs, absolute, q+2, lab, 0); GenLab(lab1); end; {else} end {else} end {of smallMemoryModel} else begin if opcode in [pc_gil,pc_gli] then begin lab1 := GenLabel; GenImplied(m_clc); GenNative(m_lda_long, longabsolute, q, lab, 0); GenNative(m_adc_imm, immediate, p, nil, 0); GenNative(m_sta_long, longabsolute, q, lab, 0); GenNative(m_bcc, relative, lab1, nil, 0); GenNative(m_lda_long, longabsolute, q+2, lab, 0); GenImplied(m_ina); GenNative(m_sta_long, longabsolute, q+2, lab, 0); GenLab(lab1); end {if} else {if opcode in [pc_gdl,pc_gld] then} begin lab1 := GenLabel; GenImplied(m_sec); GenNative(m_lda_long, longabsolute, q, lab, 0); GenNative(m_sbc_imm, immediate, p, nil, 0); GenNative(m_sta_long, longabsolute, q, lab, 0); GenNative(m_bcs, relative, lab1, nil, 0); GenNative(m_lda_long, longabsolute, q+2, lab, 0); GenImplied(m_dea); GenNative(m_sta_long, longabsolute, q+2, lab, 0); GenLab(lab1); end; {else if} end; {else} end; {DoGIncDec} begin {GenGilGliGdlGld} opcode := op^.opcode; q := op^.q; lab := op^.lab; case op^.optype of cgWord, cgUWord: begin if opcode = pc_gil then GenNative(m_inc_abs, absolute, q, lab, 0) else if opcode = pc_gdl then GenNative(m_dec_abs, absolute, q, lab, 0); if not skipLoad then GenNative(m_lda_abs, absolute, q, lab, 0); if opcode = pc_gli then GenNative(m_inc_abs, absolute, q, lab, 0) else if opcode = pc_gld then GenNative(m_dec_abs, absolute, q, lab, 0); end; cgByte, cgUByte: begin GenNative(m_sep, immediate, 32, nil, 0); if opcode = pc_gil then GenNative(m_inc_abs, absolute, q, lab, 0) else if opcode = pc_gdl then GenNative(m_dec_abs, absolute, q, lab, 0); if not skipLoad then GenNative(m_lda_abs, absolute, q, lab, 0); if opcode = pc_gli then GenNative(m_inc_abs, absolute, q, lab, 0) else if opcode = pc_gld then GenNative(m_dec_abs, absolute, q, lab, 0); GenNative(m_rep, immediate, 32, nil, 0); if not skipLoad then begin GenNative(m_and_imm, immediate, 255, nil, 0); if op^.optype = cgByte then begin GenNative(m_bit_imm, immediate, $0080, nil, 0); lab1 := GenLabel; GenNative(m_beq, relative, lab1, nil, 0); GenNative(m_ora_imm, immediate, $FF00, nil, 0); GenLab(lab1); GenNative(m_cmp_imm, immediate, $0000, nil, 0); end; {if} end; {if} end; cgLong, cgULong: begin if (A_X & gLong.preference) <> 0 then gLong.where := A_X else gLong.where := onStack; if opcode in [pc_gil,pc_gdl] then DoGIncDec(opcode, lab, op^.r, q); if not skipLoad then if smallMemoryModel then begin GenNative(m_ldx_abs, absolute, q+2, lab, 0); GenNative(m_lda_abs, absolute, q, lab, 0); if (opcode in [pc_gli,pc_gld]) and (op^.r <> 1) then gLong.where := onStack; if gLong.where = onStack then begin GenImplied(m_phx); GenImplied(m_pha); end; {if} end {if} else begin if opcode in [pc_gli,pc_gld] then gLong.where := onStack; GenNative(m_lda_long, longabsolute, q+2, lab, 0); if gLong.where = onStack then GenImplied(m_pha) else GenImplied(m_tax); GenNative(m_lda_long, longabsolute, q, lab, 0); if gLong.where = onStack then GenImplied(m_pha); end; {else} if opcode in [pc_gli,pc_gld] then DoGIncDec(opcode, lab, op^.r, q); end; {case cgLong,cgULong} otherwise: Error(cge1); end; {case} end; {GenGilGliGdlGld} procedure GenIilIliIdlIld (op: icptr); { Generate code for a pc_iil, pc_ili, pc_idl or pc_ild } var i: integer; {index variable} lab1: integer; {label} lSkipLoad: boolean; {copy of skipLoad} opcode: pcodes; {op^.opcode} short: boolean; {doing a one byte operand?} begin {GenIilIliIdlIld} opcode := op^.opcode; case op^.optype of cgByte,cgUByte,cgWord,cgUWord: begin short := op^.optype in [cgByte,cgUByte]; lSkipLoad := skipLoad; skipLoad := false; GetPointer(op^.left); skipLoad := lSkipLoad; if gLong.where = inPointer then begin if short then GenNative(m_sep, immediate, 32, nil, 0); if gLong.fixedDisp then GenNative(m_lda_indl, direct, gLong.disp, nil, 0) else GenNative(m_lda_indly, direct, gLong.disp, nil, 0); if opcode in [pc_ili,pc_iil] then GenImplied(m_ina) else GenImplied(m_dea); if gLong.fixedDisp then GenNative(m_sta_indl, direct, gLong.disp, nil, 0) else GenNative(m_sta_indly, direct, gLong.disp, nil, 0); if not skipLoad then if opcode = pc_ili then GenImplied(m_dea) else if opcode = pc_ild then GenImplied(m_ina); if short then GenNative(m_rep, immediate, 32, nil, 0); end {if} else if gLong.where = localAddress then begin gLong.disp := gLong.disp+op^.q; if gLong.fixedDisp then begin if short then GenNative(m_sep, immediate, 32, nil, 0); if (gLong.disp < 256) and (gLong.disp >= 0) then begin if (not skipLoad) and (opcode in [pc_ili,pc_ild]) then GenNative(m_lda_dir, direct, gLong.disp, nil, 0); if opcode in [pc_ili,pc_iil] then GenNative(m_inc_dir, direct, gLong.disp, nil, 0) else GenNative(m_dec_dir, direct, gLong.disp, nil, 0); if (not skipLoad) and (opcode in [pc_iil,pc_idl]) then GenNative(m_lda_dir, direct, gLong.disp, nil, 0); end {if} else begin GenNative(m_ldx_imm, immediate, gLong.disp, nil, 0); if (not skipLoad) and (opcode in [pc_ili,pc_ild]) then GenNative(m_lda_dirX, direct, gLong.disp, nil, 0); if opcode in [pc_ili,pc_iil] then GenNative(m_inc_dirX, direct, gLong.disp, nil, 0) else GenNative(m_dec_dirX, direct, gLong.disp, nil, 0); if (not skipLoad) and (opcode in [pc_iil,pc_idl]) then GenNative(m_lda_dirX, direct, gLong.disp, nil, 0); end; {else} if short then GenNative(m_rep, immediate, 32, nil, 0); end else begin if (gLong.disp > 255) or (gLong.disp < 0) then begin GenImplied(m_txa); GenImplied(m_clc); GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); GenImplied(m_tax); gLong.disp := 0; end; {if} if short then GenNative(m_sep, immediate, 32, nil, 0); if (not skipLoad) and (opcode in [pc_ili,pc_ild]) then GenNative(m_lda_dirX, direct, gLong.disp, nil, 0); if opcode in [pc_ili,pc_iil] then GenNative(m_inc_dirX, direct, gLong.disp, nil, 0) else GenNative(m_dec_dirX, direct, gLong.disp, nil, 0); if (not skipLoad) and (opcode in [pc_iil,pc_idl]) then GenNative(m_lda_dirX, direct, gLong.disp, nil, 0); if short then GenNative(m_rep, immediate, 32, nil, 0); end; {else} end {else if} else {if gLong.where = globalLabel then} begin gLong.disp := gLong.disp+op^.q; if short then GenNative(m_sep, immediate, 32, nil, 0); if gLong.fixedDisp then if smallMemoryModel then begin if (not skipLoad) and (opcode in [pc_ili,pc_ild]) then GenNative(m_lda_abs, absolute, gLong.disp, gLong.lab, 0); if opcode in [pc_ili,pc_iil] then GenNative(m_inc_abs, absolute, gLong.disp, gLong.lab, 0) else GenNative(m_dec_abs, absolute, gLong.disp, gLong.lab, 0); if (not skipLoad) and (opcode in [pc_iil,pc_idl]) then GenNative(m_lda_abs, absolute, gLong.disp, gLong.lab, 0); end {if} else begin GenNative(m_lda_long, longAbs, gLong.disp, gLong.lab, 0); if opcode in [pc_ili,pc_iil] then GenImplied(m_ina) else GenImplied(m_dea); GenNative(m_sta_long, longAbs, gLong.disp, gLong.lab, 0); if not skipLoad then if opcode = pc_ili then GenImplied(m_dea) else if opcode = pc_ild then GenImplied(m_ina); end {else} else if smallMemoryModel then begin if (not skipLoad) and (opcode in [pc_ili,pc_ild]) then GenNative(m_lda_absX, absolute, gLong.disp, gLong.lab, 0); if opcode in [pc_ili,pc_iil] then GenNative(m_inc_absX, absolute, gLong.disp, gLong.lab, 0) else GenNative(m_dec_absX, absolute, gLong.disp, gLong.lab, 0); if (not skipLoad) and (opcode in [pc_iil,pc_idl]) then GenNative(m_lda_absX, absolute, gLong.disp, gLong.lab, 0); end {if} else begin GenNative(m_lda_longX, longAbs, gLong.disp, gLong.lab, 0); if opcode in [pc_ili,pc_iil] then GenImplied(m_ina) else GenImplied(m_dea); GenNative(m_sta_longX, longAbs, gLong.disp, gLong.lab, 0); if not skipLoad then if opcode = pc_ili then GenImplied(m_dea) else if opcode = pc_ild then GenImplied(m_ina); end; {else} if short then GenNative(m_rep, immediate, 32, nil, 0); end; {else} if not skipLoad then if short then GenNative(m_and_imm, immediate, $00FF, nil, 0); end; {case cgByte,cgUByte,cgWord,cgUWord} otherwise: Error(cge1); end; {case} end; {GenIilIliIdlIld} procedure GenIncDec (op, save: icptr); { generate code for pc_inc, pc_dec } { } { parameters: } { op - pc_inc or pc_dec operation } { save - save location (pc_str or pc_sro) or nil } var disp: integer; {disp in stack frame} lab1: integer; {branch point} opcode: pcodes; {temp storage for op code} size: integer; {number to increment by} clc,ina,adc: integer; {instructions to generate} begin {GenIncDec} {set up local variables} opcode := op^.opcode; size := op^.q; if op^.optype in [cgByte,cgUByte,cgWord,cgUWord] then begin GenTree(op^.left); if opcode = pc_inc then begin clc := m_clc; ina := m_ina; adc := m_adc_imm; end {if} else begin clc := m_sec; ina := m_dea; adc := m_sbc_imm; end; {else} if size = 1 then GenImplied(ina) else if size = 2 then begin GenImplied(ina); GenImplied(ina); end {else if} else if size <> 0 then begin GenImplied(clc); GenNative(adc, immediate, size, nil, 0); end; {else if} end {if} else if op^.optype in [cgLong,cgULong] then begin if SameLoc(op^.left, save) then begin lab1 := GenLabel; if size = 1 then begin if opcode = pc_inc then begin DoOp(0, m_inc_abs, m_inc_dir, op^.left, 0); GenNative(m_bne, relative, lab1, nil, 0); DoOp(0, m_inc_abs, m_inc_dir, op^.left, 2); GenLab(lab1); end {if} else {if opcode = pc_dec then} begin DoOp(m_lda_imm, m_lda_abs, m_lda_dir, op^.left, 0); GenNative(m_bne, relative, lab1, nil, 0); DoOp(0, m_dec_abs, m_dec_dir, op^.left, 2); GenLab(lab1); DoOp(0, m_dec_abs, m_dec_dir, op^.left, 0); end; {else} end {if} else if opcode = pc_inc then begin GenImplied(m_clc); DoOp(m_lda_imm, m_lda_abs, m_lda_dir, op^.left, 0); GenNative(m_adc_imm, immediate, size, nil, 0); DoOp(0, m_sta_abs, m_sta_dir, op^.left, 0); GenNative(m_bcc, relative, lab1, nil, 0); DoOp(0, m_inc_abs, m_inc_dir, op^.left, 2); GenLab(lab1); end {else if} else begin GenImplied(m_sec); DoOp(m_lda_imm, m_lda_abs, m_lda_dir, op^.left, 0); GenNative(m_sbc_imm, immediate, size, nil, 0); DoOp(0, m_sta_abs, m_sta_dir, op^.left, 0); GenNative(m_bcs, relative, lab1, nil, 0); DoOp(0, m_dec_abs, m_dec_dir, op^.left, 2); GenLab(lab1); end; {else} end {if} else begin if save <> nil then gLong.preference := A_X else gLong.preference := gLong.preference & (A_X | inpointer); if opcode = pc_dec then gLong.preference := gLong.preference & A_X; GenTree(op^.left); if opcode = pc_inc then IncAddr(size) else begin lab1 := GenLabel; if gLong.where = A_X then begin GenImplied(m_sec); GenNative(m_sbc_imm, immediate, size, nil, 0); GenNative(m_bcs, relative, lab1, nil, 0); GenImplied(m_dex); end {if} else begin GenImplied(m_sec); GenNative(m_lda_s, direct, 1, nil, 0); GenNative(m_sbc_imm, immediate, size, nil, 0); GenNative(m_sta_s, direct, 1, nil, 0); GenNative(m_bcs, relative, lab1, nil, 0); GenNative(m_lda_s, direct, 3, nil, 0); GenImplied(m_dea); GenNative(m_sta_s, direct, 3, nil, 0); end; {else} GenLab(lab1); end; {else} if save <> nil then if save^.opcode = pc_str then begin disp := LabelToDisp(save^.r) + save^.q; if disp < 254 then begin if gLong.where = onStack then GenImplied(m_pla); GenNative(m_sta_dir, direct, disp, nil, 0); if gLong.where = onStack then GenImplied(m_plx); GenNative(m_stx_dir, direct, disp+2, nil, 0); end {else if} else begin if gLong.where = A_X then GenImplied(m_txy); GenNative(m_ldx_imm, immediate, disp, nil, 0); if gLong.where = onStack then GenImplied(m_pla); GenNative(m_sta_dirX, direct, 0, nil, 0); if gLong.where = onStack then GenImplied(m_pla) else GenImplied(m_tya); GenNative(m_sta_dirX, direct, 2, nil, 0); end; {else} end {else if} else {if save^.opcode = pc_sro then} begin if gLong.where = onStack then GenImplied(m_pla); if smallMemoryModel then GenNative(m_sta_abs, absolute, save^.q, save^.lab, 0) else GenNative(m_sta_long, longabsolute, save^.q, save^.lab, 0); if smallMemoryModel then begin if gLong.where = onStack then GenImplied(m_plx); GenNative(m_stx_abs, absolute, save^.q+2, save^.lab, 0) end {if} else begin if gLong.where = onStack then GenImplied(m_pla) else GenImplied(m_txa); GenNative(m_sta_long, longabsolute, save^.q+2, save^.lab, 0); end; {else} end; {else} end; {else} end; {else if} end; {GenIncDec} procedure GenInd (op: icptr); { Generate code for a pc_ind } var lab1: integer; {label} lLong: longType; {requested address type} optype: baseTypeEnum; {op^.optype} q: integer; {op^.q} begin {GenInd} optype := op^.optype; q := op^.q; case optype of cgReal,cgDouble,cgComp,cgExtended: begin gLong.preference := onStack; GenTree(op^.left); if q <> 0 then IncAddr(q); if optype = cgReal then GenCall(21) else if optype = cgDouble then GenCall(22) else if optype = cgComp then GenCall(70) else if optype = cgExtended then GenCall(71); end; {case cgReal,cgDouble,cgComp,cgExtended} cgLong,cgULong: begin lLong := gLong; GetPointer(op^.left); if gLong.where = inPointer then begin if q = 0 then begin if gLong.fixedDisp then begin GenNative(m_ldy_imm, immediate, 2, nil, 0); GenNative(m_lda_indly, direct, gLong.disp, nil, 0); if (A_X & lLong.preference) <> 0 then GenImplied(m_tax) else GenImplied(m_pha); GenNative(m_lda_indl, direct, gLong.disp, nil, 0); end {if} else begin GenImplied(m_iny); GenImplied(m_iny); GenNative(m_lda_indly, direct, gLong.disp, nil, 0); if (A_X & lLong.preference) <> 0 then GenImplied(m_tax) else GenImplied(m_pha); GenImplied(m_dey); GenImplied(m_dey); GenNative(m_lda_indly, direct, gLong.disp, nil, 0); end; {else} if (A_X & lLong.preference) = 0 then GenImplied(m_pha); end {if q = 0} else begin if gLong.fixedDisp then begin GenNative(m_ldy_imm, immediate, q+2, nil, 0); GenNative(m_lda_indly, direct, gLong.disp, nil, 0); if (A_X & lLong.preference) <> 0 then GenImplied(m_tax) else GenImplied(m_pha); GenNative(m_ldy_imm, immediate, q, nil, 0); end {if} else begin GenImplied(m_tya); GenImplied(m_clc); GenNative(m_adc_imm, immediate, q+2, nil, 0); GenImplied(m_tay); GenNative(m_lda_indly, direct, gLong.disp, nil, 0); if (A_X & lLong.preference) <> 0 then GenImplied(m_tax) else GenImplied(m_pha); GenImplied(m_dey); GenImplied(m_dey); end; {else} GenNative(m_lda_indly, direct, gLong.disp, nil, 0); if (A_X & lLong.preference) = 0 then GenImplied(m_pha); end; {else} end {if glong.where = inPointer} else if gLong.where = localAddress then begin gLong.disp := gLong.disp+q; if gLong.fixedDisp then if (gLong.disp < 254) and (gLong.disp >= 0) then begin GenNative(m_lda_dir, direct, gLong.disp, nil, 0); GenNative(m_ldx_dir, direct, gLong.disp+2, nil, 0); end {if} else begin GenNative(m_ldx_imm, immediate, gLong.disp, nil, 0); GenNative(m_lda_dirX, direct, 0, nil, 0); GenNative(m_ldy_dirX, direct, 2, nil, 0); GenImplied(m_tyx); end {else} else begin if (gLong.disp >= 254) or (gLong.disp < 0) then begin GenImplied(m_txa); GenImplied(m_clc); GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); GenImplied(m_tax); gLong.disp := 0; end; {if} GenNative(m_ldy_dirX, direct, gLong.disp+2, nil, 0); GenNative(m_lda_dirX, direct, gLong.disp, nil, 0); GenImplied(m_tyx); end; {else} if (A_X & lLong.preference) = 0 then begin GenImplied(m_phx); GenImplied(m_pha); end; {if} end {else if gLong.where = localAddress} else {if gLong.where = globalLabel then} begin gLong.disp := gLong.disp+q; if gLong.fixedDisp then if smallMemoryModel then begin GenNative(m_lda_abs, absolute, gLong.disp, gLong.lab, 0); GenNative(m_ldx_abs, absolute, gLong.disp+2, gLong.lab, 0); end {if} else begin GenNative(m_lda_long, longAbs, gLong.disp+2, gLong.lab, 0); GenImplied(m_tax); GenNative(m_lda_long, longAbs, gLong.disp, gLong.lab, 0); end {else} else if smallMemoryModel then begin GenNative(m_ldy_absX, absolute, gLong.disp+2, gLong.lab, 0); GenNative(m_lda_absX, absolute, gLong.disp, gLong.lab, 0); GenImplied(m_tyx); end {if} else begin GenNative(m_lda_longX, longAbs, gLong.disp+2, gLong.lab, 0); GenImplied(m_tay); GenNative(m_lda_longX, longAbs, gLong.disp, gLong.lab, 0); GenImplied(m_tyx); end; {else} if (A_X & lLong.preference) = 0 then begin GenImplied(m_phx); GenImplied(m_pha); end; {if} end; {else} if (A_X & lLong.preference) <> 0 then gLong.where := A_X else gLong.where := onStack; end; {cgLong,cgULong} cgByte,cgUByte,cgWord,cgUWord: begin GetPointer(op^.left); if gLong.where = inPointer then begin if q = 0 then if gLong.fixedDisp then GenNative(m_lda_indl, direct, gLong.disp, nil, 0) else GenNative(m_lda_indly, direct, gLong.disp, nil, 0) else if gLong.fixedDisp then begin GenNative(m_ldy_imm, immediate, q, nil, 0); GenNative(m_lda_indly, direct, gLong.disp, nil, 0) end {if} else begin GenImplied(m_tya); GenImplied(m_clc); GenNative(m_adc_imm, immediate, q, nil, 0); GenImplied(m_tay); GenNative(m_lda_indly, direct, gLong.disp, nil, 0) end; {else} end {if} else if gLong.where = localAddress then begin gLong.disp := gLong.disp+q; if gLong.fixedDisp then if (gLong.disp & $FF00) = 0 then GenNative(m_lda_dir, direct, gLong.disp, nil, 0) else begin GenNative(m_ldx_imm, immediate, gLong.disp, nil, 0); GenNative(m_lda_dirX, direct, 0, nil, 0); end {else} else if (gLong.disp & $FF00) = 0 then GenNative(m_lda_dirX, direct, gLong.disp, nil, 0) else begin GenImplied(m_txa); GenImplied(m_clc); GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); GenImplied(m_tax); GenNative(m_lda_dirX, direct, 0, nil, 0); end {else} end {else if} else {if gLong.where = globalLabel then} begin gLong.disp := gLong.disp+q; if gLong.fixedDisp then if smallMemoryModel then GenNative(m_lda_abs, absolute, gLong.disp, gLong.lab, 0) else GenNative(m_lda_long, longAbs, gLong.disp, gLong.lab, 0) else if smallMemoryModel then GenNative(m_lda_absX, absolute, gLong.disp, gLong.lab, 0) else GenNative(m_lda_longX, longAbs, gLong.disp, gLong.lab, 0) end; {else} if optype in [cgByte,cgUByte] then begin GenNative(m_and_imm, immediate, 255, nil, 0); if optype = cgByte then begin GenNative(m_cmp_imm, immediate, 128, nil, 0); lab1 := GenLabel; GenNative(m_bcc, relative, lab1, nil, 0); GenNative(m_ora_imm, immediate, $FF00, nil, 0); GenLab(lab1); end; {if} end; {if} end; {case cgByte,cgUByte,cgWord,cgUWord} otherwise: ; end; {case} end; {GenInd} procedure GenIxa (op: icptr); { Generate code for a pc_ixa } var lab1: integer; {branch label} lLong: longType; {type of address} zero: boolean; {is the index 0?} procedure Index; { Get the index size } var lLong: longType; {temp for preserving left node info} begin {Index} zero := false; with op^.right^ do begin if opcode = pc_ldc then begin if q = 0 then zero := true else GenNative(m_lda_imm, immediate, q, nil, 0); end {if} else begin lLong := gLong; GenTree(op^.right); gLong := lLong; end; {else} end; {with} end; {Index} begin {GenIxa} if smallMemoryModel then begin lLong := gLong; gLong.preference := inPointer+localAddress+globalLabel; GenTree(op^.left); case gLong.where of onStack: begin Index; if not zero then begin GenImplied(m_clc); GenNative(m_adc_s, direct, 1, nil, 0); GenNative(m_sta_s, direct, 1, nil, 0); lab1 := GenLabel; GenNative(m_bcc, relative, lab1, nil, 0); GenNative(m_lda_s, direct, 3, nil, 0); GenImplied(m_ina); GenNative(m_sta_s, direct, 3, nil, 0); GenLab(lab1); end; {if} end; {case onStack} inPointer: begin if not gLong.fixedDisp then begin if Complex(op^.right) then begin GenImplied(m_phy); Index; if not zero then begin GenImplied(m_clc); GenNative(m_adc_s, direct, 1, nil, 0); GenNative(m_sta_s, direct, 1, nil, 0); end; {if} GenImplied(m_ply); end {if} else begin GenImplied(m_tya); GenImplied(m_clc); OperA(m_adc_imm, op^.right); GenImplied(m_tay); end; {else} end {if} else begin Index; if not zero then begin GenImplied(m_tay); gLong.fixedDisp := false; end; {if} end; {else} if (inPointer & lLong.preference) = 0 then begin if not gLong.fixedDisp then begin GenImplied(m_tya); GenImplied(m_clc); GenNative(m_adc_dir, direct, gLong.disp, nil, 0); GenNative(m_ldx_dir, direct, gLong.disp+2, nil, 0); lab1 := GenLabel; GenNative(m_bcc, relative, lab1, nil, 0); GenImplied(m_inx); GenLab(lab1); end {if} else begin GenNative(m_ldx_dir, direct, gLong.disp+2, nil, 0); GenNative(m_lda_dir, direct, gLong.disp, nil, 0); end; {else} GenImplied(m_phx); GenImplied(m_pha); gLong.where := onStack; end; {if} end; {case inPointer} localAddress,globalLabel: begin if not gLong.fixedDisp then begin if Complex(op^.right) then begin GenImplied(m_phx); Index; if not zero then begin GenImplied(m_clc); GenNative(m_adc_s, direct, 1, nil, 0); GenNative(m_sta_s, direct, 1, nil, 0); end; {if} GenImplied(m_plx); end {if} else begin GenImplied(m_txa); GenImplied(m_clc); OperA(m_adc_imm, op^.right); GenImplied(m_tax); end; {else} end {if} else if Complex(op^.right) then begin Index; if not zero then begin GenImplied(m_tax); gLong.fixedDisp := false; end; {if} end {else if} else begin LoadX(op^.right); gLong.fixedDisp := false; end; {else} if (lLong.preference & gLong.where) = 0 then begin if (lLong.preference & inPointer) <> 0 then begin if gLong.where = localAddress then begin if not gLong.fixedDisp then begin GenNative(m_stz_dir, direct, dworkLoc+2, nil, 0); GenImplied(m_phx); GenImplied(m_tdc); GenImplied(m_clc); if gLong.disp <> 0 then GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); GenNative(m_adc_s, direct, 1, nil, 0); GenNative(m_sta_dir, direct, dworkLoc, nil, 0); GenImplied(m_plx); end {if} else begin GenNative(m_stz_dir, direct, dworkLoc+2, nil, 0); GenImplied(m_tdc); GenImplied(m_clc); GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); GenNative(m_sta_dir, direct, dworkLoc, nil, 0); end; {else} end {if} else begin if not gLong.fixedDisp then begin GenImplied(m_txa); GenImplied(m_clc); GenNative(m_adc_imm, immediate, gLong.disp, gLong.lab, 0); GenNative(m_sta_dir, direct, dworkLoc, nil, 0); GenNative(m_ldx_imm, immediate, gLong.disp, gLong.lab, shift16); lab1 := GenLabel; GenNative(m_bcc, relative, lab1, nil, 0); GenImplied(m_inx); GenLab(lab1); GenNative(m_stx_dir, direct, dworkLoc+2, nil, 0); end {if} else begin GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, shift16); GenNative(m_sta_dir, direct, dworkLoc+2, nil, 0); GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, 0); GenNative(m_sta_dir, direct, dworkLoc, nil, 0); end; {else} end; {else} gLong.where := inPointer; gLong.fixedDisp := true; gLong.disp := dworkLoc; end {if} else begin if gLong.where = localAddress then begin if not gLong.fixedDisp then begin GenNative(m_pea, immediate, 0, nil, 0); GenImplied(m_phx); GenImplied(m_tdc); GenImplied(m_clc); GenNative(m_adc_s, direct, 1, nil, 0); if gLong.disp <> 0 then GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); GenNative(m_sta_s, direct, 1, nil, 0); end {if} else begin GenNative(m_pea, immediate, 0, nil, 0); GenImplied(m_tdc); GenImplied(m_clc); GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); GenImplied(m_pha); end; {else} end {if} else begin if not gLong.fixedDisp then begin GenImplied(m_txa); GenImplied(m_clc); GenNative(m_adc_imm, immediate, gLong.disp, gLong.lab, 0); GenNative(m_ldx_imm, immediate, gLong.disp, gLong.lab, shift16); lab1 := GenLabel; GenNative(m_bcc, relative, lab1, nil, 0); GenImplied(m_inx); GenLab(lab1); GenImplied(m_phx); GenImplied(m_pha); end {if} else begin GenNative(m_pea, immediate, gLong.disp, gLong.lab, shift16); GenNative(m_pea, immediate, gLong.disp, gLong.lab, 0); end; {else} end; {else} gLong.where := onStack; end; {else} end; {if} end; {case localAddress,globalLabel} otherwise: Error(cge1); end; {case} end {if smallMemoryModel or (op^.right^.opcode = pc_ldc)} else begin gLong.preference := onStack; GenTree(op^.left); GenTree(op^.right); if op^.optype in [cgByte,cgWord] then begin lab1 := GenLabel; GenNative(m_ldx_imm, immediate, $0000, nil, 0); GenImplied(m_tay); GenNative(m_bpl, relative, lab1, nil, 0); GenImplied(m_dex); GenLab(lab1); GenImplied(m_phx); GenImplied(m_pha); end {else if} else begin GenNative(m_pea, immediate, 0, nil, 0); GenImplied(m_pha); end; {else} GenImplied(m_clc); GenImplied(m_pla); GenNative(m_adc_s, direct, 3, nil, 0); GenNative(m_sta_s, direct, 3, nil, 0); GenImplied(m_pla); GenNative(m_adc_s, direct, 3, nil, 0); GenNative(m_sta_s, direct, 3, nil, 0); gLong.where := onStack; end; {else} end; {GenIxa} procedure GenLilLliLdlLld (op: icptr); { Generate code for a pc_lil, pc_lli, pc_ldl or pc_lld } var disp: integer; {load location} lab1: integer; {branch point} opcode: pcodes; {op^.opcode} procedure DoXIncDec (op: pcodes; p: integer); { Do a decrement or increment on a local four byte value X } { bytes into the stack frame } { } { parameters } { op - operation code } { p - number to ind/dec by } var lab1: integer; {branch point} begin {DoXIncDec} if op in [pc_lil,pc_lli] then begin lab1 := GenLabel; if p = 1 then begin GenNative(m_inc_dirx, direct, 0, nil, 0); GenNative(m_bne, relative, lab1, nil, 0); end {if} else begin GenImplied(m_clc); GenNative(m_lda_dirx, direct, 0, nil, 0); GenNative(m_adc_imm, immediate, p, nil, 0); GenNative(m_sta_dirx, direct, 0, nil, 0); GenNative(m_bcc, relative, lab1, nil, 0); end; {else} GenNative(m_inc_dirx, direct, 2, nil, 0); GenLab(lab1); end {if} else {if op in [pc_gdl,pc_gld] then} begin lab1 := GenLabel; if p = 1 then begin GenNative(m_lda_dirx, direct, 0, nil, 0); GenNative(m_bne, relative, lab1, nil, 0); GenNative(m_dec_dirx, direct, 2, nil, 0); GenLab(lab1); GenNative(m_dec_dirx, direct, 0, nil, 0); end {if} else begin GenImplied(m_sec); GenNative(m_lda_dirx, direct, 0, nil, 0); GenNative(m_sbc_imm, immediate, p, nil, 0); GenNative(m_sta_dirx, direct, 0, nil, 0); GenNative(m_bcs, relative, lab1, nil, 0); GenNative(m_dec_dirx, direct, 2, nil, 0); GenLab(lab1); end; {else} end; {else} end; {DoXIncDec} procedure DoLIncDec (op: pcodes; disp, p: integer); { Do a decrement or increment on a local four byte value } { } { parameters } { op - operation code } { disp - disp in stack frame to value } { p - number to ind/dec by } var lab1: integer; {branch point} begin {DoLIncDec} if op in [pc_lil,pc_lli] then begin lab1 := GenLabel; if p = 1 then begin GenNative(m_inc_dir, direct, disp, nil, 0); GenNative(m_bne, relative, lab1, nil, 0); end {if} else begin GenImplied(m_clc); GenNative(m_lda_dir, direct, disp, nil, 0); GenNative(m_adc_imm, immediate, p, nil, 0); GenNative(m_sta_dir, direct, disp, nil, 0); GenNative(m_bcc, relative, lab1, nil, 0); end; {else} GenNative(m_inc_dir, direct, disp+2, nil, 0); GenLab(lab1); end {if} else {if op in [pc_ldl,pc_lld] then} begin lab1 := GenLabel; if p = 1 then begin GenNative(m_lda_dir, direct, disp, nil, 0); GenNative(m_bne, relative, lab1, nil, 0); GenNative(m_dec_dir, direct, disp+2, nil, 0); GenLab(lab1); GenNative(m_dec_dir, direct, disp, nil, 0); end {if} else begin GenImplied(m_sec); GenNative(m_lda_dir, direct, disp, nil, 0); GenNative(m_sbc_imm, immediate, p, nil, 0); GenNative(m_sta_dir, direct, disp, nil, 0); GenNative(m_bcs, relative, lab1, nil, 0); GenNative(m_dec_dir, direct, disp+2, nil, 0); GenLab(lab1); end; {else} end; {else} end; {DoLIncDec} begin {GenLilLliLdlLld} disp := LabelToDisp(op^.r); opcode := op^.opcode; case op^.optype of cgLong, cgULong: begin gLong.where := onStack; if disp >= 254 then begin GenNative(m_ldx_imm, immediate, disp, nil, 0); if opcode in [pc_lil,pc_ldl] then DoXIncDec(opcode, op^.q); if not skipLoad then begin GenNative(m_lda_dirx, direct, 2, nil, 0); GenImplied(m_pha); GenNative(m_lda_dirx, direct, 0, nil, 0); GenImplied(m_pha); end {if} else gLong.where := A_X; if opcode in [pc_lli,pc_lld] then DoXIncDec(opcode, op^.q); end {if} else begin if opcode in [pc_lil,pc_ldl] then DoLIncDec(opcode, disp, op^.q); if not skipLoad then begin GenNative(m_pei_dir, direct, disp+2, nil, 0); GenNative(m_pei_dir, direct, disp, nil, 0); end {if} else gLong.where := A_X; if opcode in [pc_lli,pc_lld] then DoLIncDec(opcode, disp, op^.q); end; {else} end; cgByte, cgUByte, cgWord, cgUWord: begin if op^.optype in [cgByte,cgUByte] then GenNative(m_sep, immediate, 32, nil, 0); if disp >= 256 then begin GenNative(m_ldx_imm, immediate, disp, nil, 0); if opcode = pc_lil then GenNative(m_inc_dirx, direct, 0, nil, 0) else if opcode = pc_ldl then GenNative(m_dec_dirx, direct, 0, nil, 0); if not skipLoad then GenNative(m_lda_dirx, direct, 0, nil, 0); if opcode = pc_lli then GenNative(m_inc_dirx, direct, 0, nil, 0) else if opcode = pc_lld then GenNative(m_dec_dirx, direct, 0, nil, 0); end else begin if opcode = pc_lil then GenNative(m_inc_dir, direct, disp, nil, 0) else if opcode = pc_ldl then GenNative(m_dec_dir, direct, disp, nil, 0); if not skipLoad then GenNative(m_lda_dir, direct, disp, nil, 0); if opcode = pc_lli then GenNative(m_inc_dir, direct, disp, nil, 0) else if opcode = pc_lld then GenNative(m_dec_dir, direct, disp, nil, 0); end; {else} if op^.optype in [cgByte,cgUByte] then begin GenNative(m_rep, immediate, 32, nil, 0); if not skipLoad then begin GenNative(m_and_imm, immediate, $00FF, nil, 0); if op^.optype = cgByte then begin GenNative(m_bit_imm, immediate, $0080, nil, 0); lab1 := GenLabel; GenNative(m_beq, relative, lab1, nil, 0); GenNative(m_ora_imm, immediate, $FF00, nil, 0); GenLab(lab1); GenNative(m_cmp_imm, immediate, $0000, nil, 0); end; {if} end; {if} end; {if} end; otherwise: Error(cge1); end; {case} end; {GenLilLliLdlLld} procedure GenLogic (op: icptr); { generate a pc_and, pc_ior, pc_bnd, pc_bor or pc_bxr } var lab1,lab2: integer; {label} nd: icptr; {temp node pointer} opcode: pcodes; {operation code} begin {GenLogic} opcode := op^.opcode; if opcode in [pc_and,pc_ior] then begin lab1 := GenLabel; GenTree(op^.left); GenNative(m_cmp_imm, immediate, 0, nil, 0); lab2 := GenLabel; if opcode = pc_and then GenNative(m_bne, relative, lab2, nil, 0) else begin GenNative(m_beq, relative, lab2, nil, 0); GenNative(m_lda_imm, immediate, 1, nil, 0); end; {else} GenNative(m_brl, longrelative, lab1, nil, 0); GenLab(lab2); GenTree(op^.right); GenNative(m_cmp_imm, immediate, 0, nil, 0); GenNative(m_beq, relative, lab1, nil, 0); GenNative(m_lda_imm, immediate, 1, nil, 0); GenLab(lab1); end {if} else begin if not Complex(op^.left) then if Complex(op^.right) then begin nd := op^.left; op^.left := op^.right; op^.right := nd; end; {if} GenTree(op^.left); if Complex(op^.right) then begin GenImplied(m_pha); GenTree(op^.right); case opcode of pc_and,pc_bnd: GenNative(m_and_s, direct, 1, nil, 0); pc_ior,pc_bor: GenNative(m_ora_s, direct, 1, nil, 0); pc_bxr: GenNative(m_eor_s, direct, 1, nil, 0); otherwise: Error(cge1); end; {case} GenImplied(m_plx); GenImplied(m_tax); end {if} else case opcode of pc_and,pc_bnd: OperA(m_and_imm, op^.right); pc_ior,pc_bor: OperA(m_ora_imm, op^.right); pc_bxr: OperA(m_eor_imm, op^.right); otherwise: Error(cge1); end; {case} end; {else} end; {GenLogic} procedure GenSroCpo (op: icptr); { Generate code for a pc_sro or pc_cpo } var lab: stringPtr; {op^.lab} lab1: integer; {branch point} lval: longint; {op^.left^.lval} opcode: pcodes; {op^.opcode} optype: baseTypeEnum; {op^.optype} q: integer; {op^.q} special: boolean; {special save?} begin {GenSroCpo} opcode := op^.opcode; optype := op^.optype; q := op^.q; lab := op^.lab; case optype of cgByte, cgUByte: begin if smallMemoryModel and (op^.left^.opcode = pc_ldc) and (op^.left^.q = 0) and (opcode = pc_sro) then begin GenNative(m_sep, immediate, 32, nil, 0); GenNative(m_stz_abs, absolute, q, lab, 0); end {if} else begin if op^.opcode = pc_sro then if op^.left^.opcode = pc_cnv then if (op^.left^.q >> 4) in [ord(cgWord),ord(cgUWord)] then op^.left := op^.left^.left; if op^.left^.opcode in [pc_ldc,pc_ldc,pc_lod] then begin GenNative(m_sep, immediate, 32, nil, 0); GenTree(op^.left); end {if} else begin GenTree(op^.left); GenNative(m_sep, immediate, 32, nil, 0); end; {else} if smallMemoryModel then GenNative(m_sta_abs, absolute, q, lab, 0) else GenNative(m_sta_long, longabsolute, q, lab, 0); end; {else} GenNative(m_rep, immediate, 32, nil, 0); end; cgWord, cgUWord: if smallMemoryModel and (op^.left^.opcode = pc_ldc) and (op^.left^.q = 0) and (opcode = pc_sro) then GenNative(m_stz_abs, absolute, q, lab, 0) else begin GenTree(op^.left); if smallMemoryModel then GenNative(m_sta_abs, absolute, q, lab, 0) else GenNative(m_sta_long, longabsolute, q, lab, 0); end; {else} cgReal, cgDouble, cgComp, cgExtended: begin GenTree(op^.left); GenNative(m_pea, immediate, q, lab, shift16); GenNative(m_pea, immediate, q, lab, 0); if opcode = pc_sro then begin if optype = cgReal then GenCall(9) else if optype = cgDouble then GenCall(10) else if optype = cgComp then GenCall(66) else {if optype = cgExtended then} GenCall(67); end {if} else {if opcode = pc_cpo then} begin if optype = cgReal then GenCall(51) else if optype = cgDouble then GenCall(52) else if optype = cgComp then GenCall(68) else {if optype = cgExtended then} GenCall(69); end; {else} end; cgLong, cgULong: begin if (opcode = pc_sro) and (op^.left^.opcode in [pc_adl,pc_sbl]) then GenAdlSbl(op^.left, op) else if (opcode = pc_sro) and (op^.left^.opcode in [pc_inc,pc_dec]) then GenIncDec(op^.left, op) else if smallMemoryModel and (op^.left^.opcode = pc_ldc) then begin lval := op^.left^.lval; if long(lval).lsw = 0 then GenNative(m_stz_abs, absolute, q, lab, 0) else begin GenNative(m_lda_imm, immediate, long(lval).lsw, nil, 0); GenNative(m_sta_abs, absolute, q, lab, 0) end; {else} if long(lval).msw = 0 then GenNative(m_stz_abs, absolute, q+2, lab, 0) else begin GenNative(m_ldx_imm, immediate, long(lval).msw, nil, 0); GenNative(m_stx_abs, absolute, q+2, lab, 0) end; {else} if op^.opcode = pc_cpo then GenTree(op^.left); end {if} else begin if op^.opcode = pc_sro then gLong.preference := A_X | inPointer | localAddress | globalLabel | constant else gLong.preference := gLong.preference & (A_X | inPointer | localAddress | globalLabel | constant); GenTree(op^.left); case gLong.where of A_X: begin if smallMemoryModel then begin GenNative(m_stx_abs, absolute, q+2, lab, 0); GenNative(m_sta_abs, absolute, q, lab, 0); end {if} else begin GenNative(m_sta_long, longabsolute, q, lab, 0); if opcode = pc_cpo then GenImplied(m_pha); GenImplied(m_txa); GenNative(m_sta_long, longabsolute, q+2, lab, 0); if opcode = pc_cpo then GenImplied(m_pla); end; {else} end; onStack: begin if opcode = pc_sro then GenImplied(m_pla) else {if opcode = pc_cpo then} GenNative(m_lda_s, direct, 1, nil, 0); if smallMemoryModel then GenNative(m_sta_abs, absolute, q, lab, 0) else GenNative(m_sta_long, longabsolute, q, lab, 0); if opcode = pc_sro then GenImplied(m_pla) else {if opcode = pc_cpo then} GenNative(m_lda_s, direct, 3, nil, 0); if smallMemoryModel then GenNative(m_sta_abs, absolute, q+2, lab, 0) else GenNative(m_sta_long, longabsolute, q+2, lab, 0); end; inPointer: begin GenNative(m_ldx_dir, direct, gLong.disp+2, nil, 0); if gLong.fixedDisp then GenNative(m_lda_dir, direct, gLong.disp, nil, 0) else begin GenImplied(m_tya); GenImplied(m_clc); GenNative(m_adc_dir, direct, gLong.disp, nil, 0); if not smallMemoryModel then begin lab1 := GenLabel; GenNative(m_bcc, relative, lab1, nil, 0); GenImplied(m_inx); GenLab(lab1); end; {if} end; {else} if smallMemoryModel then begin GenNative(m_stx_abs, absolute, q+2, lab, 0); GenNative(m_sta_abs, absolute, q, lab, 0); end {if} else begin GenNative(m_sta_long, longabsolute, q, lab, 0); if opcode = pc_cpo then GenImplied(m_pha); GenImplied(m_txa); GenNative(m_sta_long, longabsolute, q+2, lab, 0); if opcode = pc_cpo then GenImplied(m_pla); end; {else} gLong.where := A_X; end; localAddress: begin if smallMemoryModel then GenNative(m_stz_abs, absolute, q+2, lab, 0) else begin GenNative(m_lda_imm, immediate, 0, nil, 0); GenNative(m_sta_long, longabsolute, q+2, lab, 0); end; {else} GenImplied(m_tdc); GenImplied(m_clc); GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); if not gLong.fixedDisp then begin GenImplied(m_phx); GenNative(m_adc_s, direct, 1, nil, 0); GenImplied(m_plx); end; {if} if smallMemoryModel then GenNative(m_sta_abs, absolute, q, lab, 0) else GenNative(m_sta_long, longabsolute, q, lab, 0); end; globalLabel: if gLong.fixedDisp then begin if smallMemoryModel then begin GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, 0); GenNative(m_ldx_imm, immediate, gLong.disp, gLong.lab, shift16); GenNative(m_stx_abs, absolute, q+2, lab, 0); GenNative(m_sta_abs, absolute, q, lab, 0); end {if} else begin GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, shift16); GenNative(m_sta_long, longabsolute, q+2, lab, 0); if opcode = pc_cpo then GenImplied(m_tax); GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, 0); GenNative(m_sta_long, longabsolute, q, lab, 0); end; {else} gLong.where := A_X; end {if} else begin GenImplied(m_txa); GenImplied(m_clc); GenNative(m_adc_imm, immediate, gLong.disp, gLong.lab, 0); if smallMemoryModel then GenNative(m_sta_abs, absolute, q, lab, 0) else GenNative(m_sta_long, longabsolute, q, lab, 0); GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, shift16); GenNative(m_adc_imm, immediate, 0, nil, 0); if smallMemoryModel then GenNative(m_sta_abs, absolute, q+2, lab, 0) else GenNative(m_sta_long, longabsolute, q+2, lab, 0); end; {else} constant: begin if gLong.lval = 0 then begin if smallMemoryModel then begin GenNative(m_stz_abs, absolute, q+2, lab, 0); GenNative(m_stz_abs, absolute, q, lab, 0); end {if} else begin GenNative(m_lda_imm, immediate, 0, nil, 0); GenNative(m_sta_long, longabsolute, q+2, lab, 0); GenNative(m_sta_long, longabsolute, q, lab, 0); end; {else} end {if} else if not smallMemoryModel then begin GenNative(m_lda_imm, immediate, long(gLong.lval).msw, nil, 0); GenNative(m_sta_long, longabsolute, q+2, lab, 0); GenNative(m_lda_imm, immediate, long(gLong.lval).lsw, nil, 0); GenNative(m_sta_long, longabsolute, q, lab, 0); end {else if} else begin if long(gLong.lval).msw = 0 then GenNative(m_stz_abs, absolute, q+2, lab, 0) else begin GenNative(m_ldx_imm, immediate, long(gLong.lval).msw, nil, 0); GenNative(m_stx_abs, absolute, q+2, lab, 0); end; {else} if long(gLong.lval).lsw = 0 then GenNative(m_stz_abs, absolute, q, lab, 0) else begin GenNative(m_lda_imm, immediate, long(gLong.lval).lsw, nil, 0); GenNative(m_sta_abs, absolute, q, lab, 0); end; {else} if (long(gLong.lval).lsw <> 0) and (long(gLong.lval).msw <> 0) then gLong.where := A_X; end; {else} end; {case constant} otherwise: Error(cge1); end; {case} end; {else} end; {case CGLong, cgULong} end; {case} end; {GenSroCpo} procedure GenStoCpi (op: icptr); { Generate code for a pc_sto or pc_cpi } var disp: integer; {disp in stack frame} opcode: pcodes; {temp storage for op code} optype: baseTypeEnum; {operand type} short: boolean; {use short registers?} simple: boolean; {is the load a simple load?} lLong: longType; {address record for left node} zero: boolean; {is the operand a constant zero?} procedure LoadLSW; { load the least significant word of a four byte value } begin {LoadLSW} if lLong.where = onStack then if opcode = pc_sto then GenImplied(m_pla) else GenNative(m_lda_s, direct, 1, nil, 0) else {if lLong.where = constant then} GenNative(m_lda_imm, immediate, long(lLong.lval).lsw, nil, 0); end; {LoadLSW} procedure LoadMSW; { load the most significant word of a four byte value } { } { Note: LoadLSW MUST be called first! } begin {LoadMSW} if lLong.where = onStack then if opcode = pc_sto then GenImplied(m_pla) else GenNative(m_lda_s, direct, 3, nil, 0) else {if lLong.where = constant then} GenNative(m_lda_imm, immediate, long(lLong.lval).msw, nil, 0); end; {LoadMSW} procedure LoadWord; { Get the operand for a cgByte, cgUByte, cgWord or cgUWord } { into the accumulator } begin {LoadWord} if simple then begin with op^.right^ do if opcode = pc_ldc then GenNative(m_lda_imm, immediate, q, nil, 0) else if opcode = pc_lod then GenNative(m_lda_dir, direct, LabelToDisp(r) + q, nil, 0) else {if opcode = pc_ldo then} if smallMemoryModel then GenNative(m_lda_abs, absolute, q, lab, 0) else GenNative(m_lda_long, longabsolute, q, lab, 0); end {if} else begin GenImplied(m_pla); if short then GenNative(m_sep, immediate, 32, nil, 0); end {else} end; {LoadWord} begin {GenStoCpi} opcode := op^.opcode; optype := op^.optype; case optype of cgReal,cgDouble,cgComp,cgExtended: begin GenTree(op^.right); gLong.preference := onStack; GenTree(op^.left); if optype = cgReal then begin if opcode = pc_sto then GenCall(9) else GenCall(51); end {if} else if optype = cgDouble then begin if opcode = pc_sto then GenCall(10) else GenCall(52); end {else if} else if optype = cgComp then begin if opcode = pc_sto then GenCall(66) else GenCall(68); end {else if} else {if optype = cgExtended then} begin if opcode = pc_sto then GenCall(67) else GenCall(69); end; {else} end; {case cgReal,cgDouble,cgComp,cgExtended} cgLong,cgULong: begin if opcode = pc_sto then gLong.preference := onStack+constant else gLong.preference := (onStack+constant) & gLong.preference; GenTree(op^.right); lLong := gLong; gLong.preference := localAddress+inPointer+globalLabel+A_X; GenTree(op^.left); if gLong.where = onStack then begin GenImplied(m_pla); GenNative(m_sta_dir, direct, dworkLoc, nil, 0); GenImplied(m_pla); GenNative(m_sta_dir, direct, dworkLoc+2, nil, 0); LoadLSW; GenNative(m_sta_indl, direct, dworkLoc, nil, 0); GenNative(m_ldy_imm, immediate, 2, nil, 0); LoadMSW; GenNative(m_sta_indly, direct, dworkLoc, nil, 0); end {if} else if gLong.where = A_X then begin GenNative(m_sta_dir, direct, dworkLoc, nil, 0); GenNative(m_stx_dir, direct, dworkLoc+2, nil, 0); LoadLSW; GenNative(m_sta_indl, direct, dworkLoc, nil, 0); GenNative(m_ldy_imm, immediate, 2, nil, 0); LoadMSW; GenNative(m_sta_indly, direct, dworkLoc, nil, 0); end {if} else if gLong.where = localAddress then begin LoadLSW; if gLong.fixedDisp then if (gLong.disp & $FF00) = 0 then GenNative(m_sta_dir, direct, gLong.disp, nil, 0) else begin GenNative(m_ldx_imm, immediate, gLong.disp, nil, 0); GenNative(m_sta_dirX, direct, 0, nil, 0); end {else} else begin if (gLong.disp >= 254) or (gLong.disp < 0) then begin GenImplied(m_tay); GenImplied(m_txa); GenImplied(m_clc); GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); GenImplied(m_tax); GenImplied(m_tya); gLong.disp := 0; end; {if} GenNative(m_sta_dirX, direct, gLong.disp, nil, 0); end; {else} LoadMSW; if gLong.fixedDisp then if ((gLong.disp+2) & $FF00) = 0 then GenNative(m_sta_dir, direct, gLong.disp+2, nil, 0) else begin GenNative(m_ldx_imm, immediate, gLong.disp+2, nil, 0); GenNative(m_sta_dirX, direct, 0, nil, 0); end {else} else begin if (gLong.disp >= 254) or (gLong.disp < 0) then begin GenImplied(m_tay); GenImplied(m_txa); GenImplied(m_clc); GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); GenImplied(m_tax); GenImplied(m_tya); gLong.disp := 0; end; {if} GenNative(m_sta_dirX, direct, gLong.disp+2, nil, 0); end; {else} end {else if} else if gLong.where = globalLabel then begin LoadLSW; if gLong.fixedDisp then if smallMemoryModel then GenNative(m_sta_abs, absolute, gLong.disp, gLong.lab, 0) else GenNative(m_sta_long, longAbs, gLong.disp, gLong.lab, 0) else if smallMemoryModel then GenNative(m_sta_absX, absolute, gLong.disp, gLong.lab, 0) else GenNative(m_sta_longX, longAbs, gLong.disp, gLong.lab, 0); LoadMSW; if gLong.fixedDisp then if smallMemoryModel then GenNative(m_sta_abs, absolute, gLong.disp+2, gLong.lab, 0) else GenNative(m_sta_long, longAbs, gLong.disp+2, gLong.lab, 0) else if smallMemoryModel then GenNative(m_sta_absX, absolute, gLong.disp+2, gLong.lab, 0) else GenNative(m_sta_longX, longAbs, gLong.disp+2, gLong.lab, 0); end {else if} else begin LoadLSW; if gLong.fixedDisp = true then begin GenNative(m_sta_indl, direct, gLong.disp, nil, 0); GenNative(m_ldy_imm, immediate, 2, nil, 0); end {if} else begin GenNative(m_sta_indlY, direct, gLong.disp, nil, 0); GenImplied(m_iny); GenImplied(m_iny); end; {else} LoadMSW; GenNative(m_sta_indly, direct, gLong.Disp, nil, 0); end; {else} gLong := lLong; end; {case cgLong,cgULong} cgByte,cgUByte,cgWord,cgUWord: begin short := optype in [cgByte,cgUByte]; simple := false; zero := false; if op^.opcode = pc_sto then begin if short then if op^.right^.opcode = pc_cnv then if (op^.right^.q >> 4) in [ord(cgWord),ord(cgUWord)] then op^.right := op^.right^.left; with op^.right^ do begin if opcode = pc_ldo then simple := true else if opcode = pc_lod then simple := LabelToDisp(r) + q < 256 else if opcode = pc_ldc then begin simple := true; zero := q = 0; end; {else if} end; {with} end; {if} if not (zero or simple) then begin GenTree(op^.right); GenImplied(m_pha); end; {if} GetPointer(op^.left); if short then if simple then GenNative(m_sep, immediate, 32, nil, 0); if gLong.where = inPointer then begin if zero then GenNative(m_lda_imm, immediate, 0, nil, 0) else LoadWord; if gLong.fixedDisp then GenNative(m_sta_indl, direct, gLong.disp, nil, 0) else GenNative(m_sta_indlY, direct, gLong.disp, nil, 0); end {if} else if gLong.where = localAddress then begin if gLong.fixedDisp then if (gLong.disp & $FF00) = 0 then if zero then GenNative(m_stz_dir, direct, gLong.disp, nil, 0) else begin LoadWord; GenNative(m_sta_dir, direct, gLong.disp, nil, 0); end {else} else begin if zero then begin GenNative(m_ldx_imm, immediate, gLong.disp, nil, 0); GenNative(m_stz_dirX, direct, 0, nil, 0); end {if} else begin LoadWord; GenNative(m_ldx_imm, immediate, gLong.disp, nil, 0); GenNative(m_sta_dirX, direct, 0, nil, 0); end; {else} end {else} else begin if (gLong.disp & $FF00) <> 0 then begin GenImplied(m_txa); GenImplied(m_clc); GenNative(m_adc_imm, immediate, glong.disp, nil, 0); GenImplied(m_tax); gLong.disp := 0; end; {if} if zero then GenNative(m_stz_dirX, direct, gLong.disp, nil, 0) else begin LoadWord; GenNative(m_sta_dirX, direct, gLong.disp, nil, 0); end; {else} end; {else} end {else if} else {if gLong.where = globalLabel then} begin if zero then begin if not smallMemoryModel then GenNative(m_lda_imm, immediate, 0, nil, 0); end {if} else LoadWord; if gLong.fixedDisp then if smallMemoryModel then if zero then GenNative(m_stz_abs, absolute, gLong.disp, gLong.lab, 0) else GenNative(m_sta_abs, absolute, gLong.disp, gLong.lab, 0) else GenNative(m_sta_long, longAbs, gLong.disp, gLong.lab, 0) else if smallMemoryModel then if zero then GenNative(m_stz_absX, absolute, gLong.disp, gLong.lab, 0) else GenNative(m_sta_absX, absolute, gLong.disp, gLong.lab, 0) else GenNative(m_sta_longX, longAbs, gLong.disp, gLong.lab, 0); end; {else} if short then begin GenNative(m_rep, immediate, 32, nil, 0); if opcode = pc_cpi then GenNative(m_and_imm, immediate, $00FF, nil, 0); end; {if} end; {case cgByte,cgUByte,cgWord,cgUWord} otherwise: Error(cge1); end; {case} end; {GenStoCpi} procedure GenStrCop (op: icptr); { Generate code for a pc_str or pc_cop } var disp: integer; {store location} optype: baseTypeEnum; {op^.optype} special: boolean; {use special processing?} zero: boolean; {is the operand a constant zero?} begin {GenStrCop} disp := LabelToDisp(op^.r) + op^.q; optype := op^.optype; case optype of cgByte, cgUByte, cgWord, cgUWord: begin zero := false; if op^.left^.opcode = pc_ldc then if op^.opcode = pc_str then if op^.left^.q = 0 then zero := true; if not zero then begin if optype in [cgByte,cgUByte] then begin if op^.opcode = pc_str then if op^.left^.opcode = pc_cnv then if (op^.left^.q >> 4) in [ord(cgWord),ord(cgUWord)] then op^.left := op^.left^.left; if (op^.left^.opcode in [pc_ldc,pc_ldc,pc_lod]) and (op^.opcode = pc_str) then begin GenNative(m_sep, immediate, 32, nil, 0); GenTree(op^.left); end {if} else begin GenTree(op^.left); GenNative(m_sep, immediate, 32, nil, 0); end; {else} end {if} else GenTree(op^.left); end {if} else if optype in [cgByte,cgUByte] then GenNative(m_sep, immediate, 32, nil, 0); if disp > 255 then begin GenNative(m_ldx_imm, immediate, disp, nil, 0); if zero then GenNative(m_stz_dirx, direct, 0, nil, 0) else GenNative(m_sta_dirx, direct, 0, nil, 0); end {if} else if zero then GenNative(m_stz_dir, direct, disp, nil, 0) else GenNative(m_sta_dir, direct, disp, nil, 0); if optype in [cgByte,cgUByte] then GenNative(m_rep, immediate, 32, nil, 0); end; cgReal, cgDouble, cgComp, cgExtended: begin GenTree(op^.left); GenNative(m_pea, immediate, 0, nil, 0); GenImplied(m_tdc); GenImplied(m_clc); GenNative(m_adc_imm, immediate, disp, nil, 0); GenImplied(m_pha); if op^.opcode = pc_str then begin if optype = cgReal then GenCall(9) else if optype = cgDouble then GenCall(10) else if optype = cgComp then GenCall(66) else {if optype = cgExtended then} GenCall(67); end {if} else begin if optype = cgReal then GenCall(51) else if optype = cgDouble then GenCall(52) else if optype = cgComp then GenCall(68) else {if optype = cgExtended then} GenCall(69); end; {else} end; cgLong, cgULong: begin if (op^.opcode = pc_str) and (op^.left^.opcode in [pc_adl,pc_sbl]) then GenAdlSbl(op^.left, op) else if (op^.opcode = pc_str) and (op^.left^.opcode in [pc_inc,pc_dec]) then GenIncDec(op^.left, op) else begin if op^.opcode = pc_str then gLong.preference := A_X+onStack+inPointer+localAddress+globalLabel+constant else gLong.preference := onStack; GenTree(op^.left); case gLong.where of A_X: if disp < 254 then begin GenNative(m_stx_dir, direct, disp+2, nil, 0); GenNative(m_sta_dir, direct, disp, nil, 0); end {else if} else begin GenImplied(m_txy); GenNative(m_ldx_imm, immediate, disp, nil, 0); GenNative(m_sta_dirX, direct, 0, nil, 0); GenNative(m_sty_dirX, direct, 2, nil, 0); if op^.opcode = pc_cop then GenImplied(m_tyx); end; {else} onStack: if disp < 254 then begin if op^.opcode = pc_str then GenImplied(m_pla) else {if op^.opcode = pc_cop then} GenNative(m_lda_s, direct, 1, nil, 0); GenNative(m_sta_dir, direct, disp, nil, 0); if op^.opcode = pc_str then GenImplied(m_pla) else {if op^.opcode = pc_cop then} GenNative(m_lda_s, direct, 3, nil, 0); GenNative(m_sta_dir, direct, disp+2, nil, 0); end {else if} else begin GenNative(m_ldx_imm, immediate, disp, nil, 0); if op^.opcode = pc_str then GenImplied(m_pla) else {if op^.opcode = pc_cop then} GenNative(m_lda_s, direct, 1, nil, 0); GenNative(m_sta_dirX, direct, 0, nil, 0); if op^.opcode = pc_str then GenImplied(m_pla) else {if op^.opcode = pc_cop then} GenNative(m_lda_s, direct, 3, nil, 0); GenNative(m_sta_dirX, direct, 2, nil, 0); end; {else} inPointer: begin if (disp < 254) and (gLong.disp < 254) and gLong.fixedDisp and (disp >= 0) and (gLong.disp >= 0) then begin GenNative(m_lda_dir, direct, gLong.disp, nil, 0); GenNative(m_ldx_dir, direct, gLong.disp+2, nil, 0); GenNative(m_sta_dir, direct, disp, nil, 0); GenNative(m_stx_dir, direct, disp+2, nil, 0); end {if} else if (disp < 254) and (gLong.disp < 254) and (disp >= 0) and (gLong.disp >= 0) and (op^.opcode = pc_str) then begin GenImplied(m_tya); GenImplied(m_clc); GenNative(m_adc_dir, direct, gLong.disp, nil, 0); GenNative(m_sta_dir, direct, disp, nil, 0); GenNative(m_lda_dir, direct, gLong.disp+2, nil, 0); GenNative(m_adc_imm, immediate, 0, nil, 0); GenNative(m_sta_dir, direct, disp+2, nil, 0); end {else if} else begin GenNative(m_ldx_imm, immediate, disp, nil, 0); if not gLong.fixedDisp then begin GenImplied(m_tya); GenImplied(m_clc); GenNative(m_adc_dir, direct, gLong.disp, nil, 0); end {if} else GenNative(m_lda_dir, direct, gLong.disp, nil, 0); GenNative(m_sta_dirX, direct, 0, nil, 0); GenNative(m_lda_dir, direct, gLong.disp+2, nil, 0); if not gLong.fixedDisp then GenNative(m_adc_imm, immediate, 0, nil, 0); GenNative(m_sta_dirX, direct, 2, nil, 0); end; {else} end; localAddress: if disp < 254 then begin GenNative(m_stz_dir, direct, disp+2, nil, 0); GenImplied(m_tdc); GenImplied(m_clc); GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); if not gLong.fixedDisp then begin GenImplied(m_phx); GenNative(m_adc_s, direct, 1, nil, 0); GenImplied(m_plx); end; {if} GenNative(m_sta_dir, direct, disp, nil, 0); end {else if disp < 254} else begin if not gLong.fixedDisp then GenImplied(m_phx); GenNative(m_ldx_imm, immediate, disp, nil, 0); GenImplied(m_tdc); GenImplied(m_clc); GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); if not gLong.fixedDisp then begin GenNative(m_adc_s, direct, 1, nil, 0); GenImplied(m_ply); end; {if} GenNative(m_sta_dirX, direct, 0, nil, 0); GenNative(m_stz_dirX, direct, 2, nil, 0); end; {else} globalLabel: begin if not gLong.fixedDisp then GenImplied(m_txa) else if disp > 253 then GenNative(m_ldx_imm, immediate, disp, nil, 0); if gLong.fixedDisp then GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, 0) else begin GenImplied(m_clc); GenNative(m_adc_imm, immediate, gLong.disp, gLong.lab, 0); end; {else} if disp < 254 then GenNative(m_sta_dir, direct, disp, nil, 0) else GenNative(m_sta_dirX, direct, 0, nil, 0); GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, shift16); if not gLong.fixedDisp then GenNative(m_adc_imm, immediate, 0, nil, 0); if disp < 254 then GenNative(m_sta_dir, direct, disp+2, nil, 0) else GenNative(m_sta_dirX, direct, 2, nil, 0); end; constant: if disp < 254 then begin GenNative(m_lda_imm, immediate, long(gLong.lval).lsw, nil, 0); GenNative(m_sta_dir, direct, disp, nil, 0); GenNative(m_lda_imm, immediate, long(gLong.lval).msw, nil, 0); GenNative(m_sta_dir, direct, disp+2, nil, 0); end {else} else begin GenNative(m_ldx_imm, immediate, disp, nil, 0); GenNative(m_lda_imm, immediate, long(gLong.lval).lsw, nil, 0); GenNative(m_sta_dirX, direct, 0, nil, 0); GenNative(m_lda_imm, immediate, long(gLong.lval).msw, nil, 0); GenNative(m_sta_dirX, direct, 2, nil, 0); end; {else} otherwise: Error(cge1); end; {case} end; {else} end; otherwise: ; end; {case} end; {GenStrCop} procedure GenUnaryLong (op: icptr); { generate a pc_bnl or pc_ngl } begin {GenUnaryLong} gLong.preference := onStack; {get the operand} GenTree(op^.left); case op^.opcode of {do the operation} pc_bnl: begin GenNative(m_lda_s, direct, 1, nil, 0); GenNative(m_eor_imm, immediate, $FFFF, nil, 0); GenNative(m_sta_s, direct, 1, nil, 0); GenNative(m_lda_s, direct, 3, nil, 0); GenNative(m_eor_imm, immediate, $FFFF, nil, 0); GenNative(m_sta_s, direct, 3, nil, 0); end; {case pc_bnl} pc_ngl: begin GenImplied(m_sec); GenNative(m_lda_imm, immediate, 0, nil, 0); GenNative(m_sbc_s, direct, 1, nil, 0); GenNative(m_sta_s, direct, 1, nil, 0); GenNative(m_lda_imm, immediate, 0, nil, 0); GenNative(m_sbc_s, direct, 3, nil, 0); GenNative(m_sta_s, direct, 3, nil, 0); end; {case pc_ngl} end; {case} gLong.where := onStack; {the result is on the stack} end; {GenUnaryLong} procedure GenTree {op: icptr}; { generate code for op and its children } { } { parameters: } { op - opcode for which to generate code } procedure GenAdi (op: icptr); { generate a pc_adi } var nd: icptr; begin {GenAdi} if not Complex(op^.left) then if Complex(op^.right) then begin nd := op^.left; op^.left := op^.right; op^.right := nd; end; {if} GenTree(op^.left); if Complex(op^.right) then begin GenImplied(m_pha); GenTree(op^.right); GenImplied(m_clc); GenNative(m_adc_s, direct, 1, nil, 0); GenImplied(m_plx); end {if} else begin GenImplied(m_clc); OperA(m_adc_imm, op^.right); end; {else} end; {GenAdi} procedure GenBinLong (op: icptr); { generate one of: pc_blr, pc_blx, pc_bal, pc_dvl, pc_mdl, } { pc_mpl, pc_sll, pc_slr, pc_udl, pc_ulm, pc_uml, pc_vsr } var nd: icptr; {for swapping left/right children} procedure GenOp (ops, opi: integer); { generate a binary operation } { } { parameters: } { ops - stack version of operation } { opi - immediate version of operation } var lab1: integer; {label number} begin {GenOp} GenImplied(m_pla); if gLong.where = constant then begin GenNative(opi, immediate, long(gLong.lval).lsw, nil, 0); GenImplied(m_pha); GenNative(m_lda_s, direct, 3, nil, 0); GenNative(opi, immediate, long(gLong.lval).msw, nil, 0); GenNative(m_sta_s, direct, 3, nil, 0); end {if} else begin GenNative(ops, direct, 3, nil, 0); GenNative(m_sta_s, direct, 3, nil, 0); GenImplied(m_pla); GenNative(ops, direct, 3, nil, 0); GenNative(m_sta_s, direct, 3, nil, 0); end; {else} end; {GenOp} begin {GenBinLong} if (op^.left^.opcode = pc_ldc) and (op^.opcode in [pc_blr,pc_blx,pc_bal]) then begin nd := op^.left; op^.left := op^.right; op^.right := nd; end; {if} gLong.preference := onStack; GenTree(op^.left); if op^.opcode in [pc_blr,pc_blx,pc_bal] then begin gLong.preference := constant; GenTree(op^.right); end {if} else if op^.opcode in [pc_uml,pc_udl,pc_ulm] then begin gLong.preference := A_X; GenTree(op^.right); if gLong.where = onStack then begin GenImplied(m_pla); GenImplied(m_plx); end; {if} end {else if} else begin gLong.preference := onStack; GenTree(op^.right); end; {else} case op^.opcode of pc_blr: GenOp(m_ora_s, m_ora_imm); pc_blx: GenOp(m_eor_s, m_eor_imm); pc_bal: GenOp(m_and_s, m_and_imm); pc_dvl: GenCall(43); pc_mdl: begin GenCall(44); GenImplied(m_ply); GenImplied(m_ply); end; pc_mpl: GenCall(42); pc_sll: GenCall(45); pc_slr: GenCall(47); pc_udl: GenCall(49); pc_ulm: GenCall(50); pc_uml: GenCall(48); pc_vsr: GenCall(46); otherwise: Error(cge1); end; {case} gLong.where := onStack; end; {GenBinLong} procedure GenBno (op: icptr); { Generate code for a pc_bno } var lLong: longType; {requested address type} begin {GenBno} lLong := gLong; GenTree(op^.left); gLong := lLong; GenTree(op^.right); end; {GenBno} procedure GenBntNgiNot (op: icptr); { Generate code for a pc_bnt, pc_ngi or pc_not } var lab1: integer; begin {GenntNgiNot} GenTree(op^.left); case op^.opcode of pc_bnt: GenNative(m_eor_imm, immediate, -1, nil, 0); pc_ngi: begin GenNative(m_eor_imm, immediate, -1, nil, 0); GenImplied(m_ina); end; {case pc_ngi} pc_not: begin lab1 := GenLabel; GenImplied(m_tax); GenNative(m_beq, relative, lab1, nil, 0); GenNative(m_lda_imm, immediate, 1, nil, 0); GenLab(lab1); GenNative(m_eor_imm, immediate, 1, nil, 0); end; {if} end; {case} end; {GenBntNgiNot} procedure GenCui (op: icptr); { Generate code for a pc_cui } var lab1: integer; {return point} lLong: longType; {used to reserve gLong} begin {GenCup} {save the stack register} if saveStack or checkStack or (op^.q <> 0) then begin GenNative(m_ldx_dir, direct, stackLoc, nil, 0); GenImplied(m_phx); GenImplied(m_tsx); GenNative(m_stx_dir, direct, stackLoc, nil, 0); end; {if} {generate parameters} {place the operands on the stack} lLong := gLong; GenTree(op^.left); {get the address to call} gLong.preference := onStack; GenTree(op^.right); gLong := lLong; {create a return label} lab1 := GenLabel; {place the call/return addrs on stack} GenNative(m_lda_s, direct, 1, nil, 0); GenImplied(m_dea); GenImplied(m_pha); GenNative(m_sep, immediate, 32, nil, 0); GenNative(m_lda_s, direct, 5, nil, 0); GenNative(m_sta_s, direct, 3, nil, 0); GenNative(m_lda_imm, genAddress, lab1, nil, shift16); GenNative(m_sta_s, direct, 6, nil, 0); GenNative(m_rep, immediate, 32, nil, 0); GenNative(m_lda_imm, genAddress, lab1, nil, 0); GenNative(m_sta_s, direct, 4, nil, 0); {indirect call} GenImplied(m_rtl); GenLab(lab1); if checkStack then begin {check the stack for errors} GenNative(m_ldy_dir, direct, stackLoc, nil, 0); GenCall(76); GenImplied(m_ply); GenNative(m_sty_dir, direct, stackLoc, nil, 0); end {if} else if saveStack or (op^.q <> 0) then begin GenImplied(m_txy); GenNative(m_ldx_dir, direct, stackLoc, nil, 0); GenImplied(m_txs); GenImplied(m_tyx); GenImplied(m_ply); GenNative(m_sty_dir, direct, stackLoc, nil, 0); end; {else} {save the returned value} gLong.where := A_X; SaveRetValue(op^.optype); end; {GenCui} procedure GenCup (op: icptr); { Generate code for a pc_cup } var lLong: longType; {used to reserve gLong} begin {GenCup} {save the stack register} if saveStack or checkStack or (op^.q <> 0) then begin GenNative(m_ldx_dir, direct, stackLoc, nil, 0); GenImplied(m_phx); GenImplied(m_tsx); GenNative(m_stx_dir, direct, stackLoc, nil, 0); end; {if} {generate parameters} lLong := gLong; GenTree(op^.left); gLong := lLong; {generate the jsl} GenNative(m_jsl, longAbs, 0, op^.lab, 0); {check the stack for errors} if checkStack then begin GenNative(m_ldy_dir, direct, stackLoc, nil, 0); GenCall(76); GenImplied(m_ply); GenNative(m_sty_dir, direct, stackLoc, nil, 0); GenImplied(m_tay); end {if} else if saveStack or (op^.q <> 0) then begin GenImplied(m_tay); GenNative(m_lda_dir, direct, stackLoc, nil, 0); GenImplied(m_tcs); GenImplied(m_pla); GenNative(m_sta_dir, direct, stackLoc, nil, 0); GenImplied(m_tya); end; {else} {save the returned value} gLong.where := A_X; SaveRetValue(op^.optype); end; {GenCup} procedure GenDviMod (op: icptr); { Generate code for a pc_dvi, pc_mod, pc_udi or pc_uim } var opcode: pcodes; {temp storage} begin {GenDviMod} if Complex(op^.right) then begin GenTree(op^.right); if Complex(op^.left) then begin GenImplied(m_pha); GenTree(op^.left); GenImplied(m_plx); end {if} else begin GenImplied(m_tax); GenTree(op^.left); end; {else} end {if} else begin GenTree(op^.left); LoadX(op^.right); end; {else} opcode := op^.opcode; if opcode = pc_mod then GenCall(27) else if opcode = pc_dvi then GenCall(26) else {if opcode in [pc_udi,pc_uim] then} begin GenCall(40); if opcode = pc_uim then GenImplied(m_txa); end; {else} if rangeCheck then GenCall(25); end; {GenDviMod} procedure GenEnt; { Generate code for a pc_ent } begin {GenEnt} if rangeCheck then begin {if range checking is on, check for a stack overflow} GenNative(m_pea, immediate, localSize - returnSize - 1, nil, 0); GenCall(1); end; {if} if localSize = 0 then begin {create the stack frame} if parameterSize <> 0 then begin GenImplied(m_tsc); GenImplied(m_phd); GenImplied(m_tcd); end; {if} end {if} else if localSize = 2 then begin GenImplied(m_pha); GenImplied(m_tsc); GenImplied(m_phd); GenImplied(m_tcd); end {else if} else begin GenImplied(m_tsc); GenImplied(m_sec); GenNative(m_sbc_imm, immediate, localSize, nil, 0); GenImplied(m_tcs); GenImplied(m_phd); GenImplied(m_tcd); end; {if} if dataBank then begin {preserve and set data bank} GenImplied(m_phb); GenImplied(m_phb); GenImplied(m_pla); GenNative(m_sta_dir, direct, bankLoc, nil, 0); GenNative(m_pea, immediate, 0, @'~GLOBALS', shift8); GenImplied(m_plb); GenImplied(m_plb); end; {if} {no pc_nam (yet)} namePushed := false; end; {GenEnt} procedure GenFjpTjp (op: icptr); { Generate code for a pc_fjp or pc_tjp } var lab1: integer; {branch point} opcode: pcodes; {op^.left^.opcode} begin {GenFjpTjp} if op^.left^.opcode in [pc_equ,pc_geq,pc_grt,pc_les,pc_leq,pc_neq] then if op^.left^.opcode in [pc_equ,pc_neq] then GenEquNeq(op^.left, op^.opcode, op^.q) else GenCmp(op^.left, op^.opcode, op^.q) else begin lab1 := GenLabel; GenTree(op^.left); opcode := op^.left^.opcode; if NeedsCondition(opcode) then GenImplied(m_tax) else if opcode = pc_ind then if op^.left^.optype in [cgByte,cgUByte] then GenImplied(m_tax); if op^.opcode = pc_fjp then GenNative(m_bne, relative, lab1, nil, 0) else {if op^.opcode = pc_tjp then} GenNative(m_beq, relative, lab1, nil, 0); GenNative(m_brl, longrelative, op^.q, nil, 0); GenLab(lab1); end; {else} end; {GenFjpTjp} procedure GenLaoLad (op: icptr); { Generate code for a pc_lao, pc_lad } var q: integer; {displacement} begin {GenLaoLad} if op^.opcode = pc_lad then q := 0 else q := op^.q; if (globalLabel & gLong.preference) <> 0 then begin gLong.fixedDisp := true; gLong.where := globalLabel; gLong.disp := q; gLong.lab := op^.lab; end {if} else if (A_X & gLong.preference) <> 0 then begin gLong.where := A_X; GenNative(m_ldx_imm, immediate, q, op^.lab, shift16); GenNative(m_lda_imm, immediate, q, op^.lab, 0); end {else if} else begin gLong.where := onStack; GenNative(m_pea, immediate, q, op^.lab, shift16); GenNative(m_pea, immediate, q, op^.lab, 0); end; {else} end; {GenLaoLad} procedure GenLbfLbu (op: icptr); { Generate code for a pc_lbf or pc_lbu } var lLong: longType; {requested address type} begin {GenLbfLbu} lLong := gLong; gLong.preference := onStack; GenTree(op^.left); GenNative(m_pea, immediate, op^.r, nil, 0); GenNative(m_pea, immediate, op^.q, nil, 0); if op^.opcode = pc_lbf then GenCall(73) else GenCall(72); if op^.optype in [cgLong,cgULong] then begin if (A_X & lLong.preference) <> 0 then gLong.where := A_X else begin gLong.where := onStack; GenImplied(m_phx); GenImplied(m_pha); end; {else} end; {if} end; {GenLbfLbu} procedure GenLca (op: icptr); { Generate code for a pc_lca } var i: integer; {loop/index variable} begin {GenLca} gLong.where := onStack; GenNative(m_pea, immediate, stringSize, nil, stringReference+shift16); GenNative(m_pea, immediate, stringSize, nil, stringReference); if maxString-stringSize >= op^.q+1 then begin for i := 1 to op^.q do stringSpace[i+stringSize] := op^.str^.str[i]; stringSpace[stringSize+op^.q+1] := chr(0); stringSize := stringSize+op^.q+1; end else Error(cge3); op^.optype := cgULong; end; {GenLca} procedure GenLda (op: icptr); { Generate code for a pc_lda } begin {GenLda} if (localAddress & gLong.preference) <> 0 then begin gLong.fixedDisp := true; gLong.where := localAddress; gLong.disp := LabelToDisp(op^.r) + op^.q; end {if} else if (A_X & gLong.preference) <> 0 then begin gLong.where := A_X; GenImplied(m_tdc); GenImplied(m_clc); GenNative(m_adc_imm, immediate, LabelToDisp(op^.r) + op^.q, nil, 0); GenNative(m_ldx_imm, immediate, 0, nil, 0); end {else if} else begin gLong.where := onStack; GenNative(m_pea, immediate, 0, nil, 0); GenImplied(m_tdc); GenImplied(m_clc); GenNative(m_adc_imm, immediate, LabelToDisp(op^.r) + op^.q, nil, 0); GenImplied(m_pha); end; {else} end; {GenLda} procedure GenLdc (op: icptr); { Generate code for a pc_ldc } type kind = (vint, vbyte, vreal); {kinds of equivalenced data} var i: integer; {loop/index variable} rec: realrec; {conversion record} switch: packed record {used for type conversion} case rkind: kind of vint: (i: integer); vbyte: (b1, b2, b3, b4, b5, b6, b7, b8: byte); vreal: (r: double); end; begin {GenLdc} case op^.optype of cgByte: begin if op^.q > 127 then op^.q := op^.q | $FF00; GenNative(m_lda_imm, immediate, op^.q, nil, 0); end; cgUByte, cgWord, cgUWord: GenNative(m_lda_imm, immediate, op^.q, nil, 0); cgReal, cgDouble, cgComp, cgExtended: begin rec.itsReal := op^.rval; CnvSX(rec); i := 9; while i >= 0 do begin switch.b1 := rec.inSANE[i]; switch.b2 := rec.inSANE[i+1]; GenNative(m_pea, immediate, switch.i, nil, 0); i := i-2; end; {while} end; cgLong, cgULong: if (constant & gLong.preference) <> 0 then begin gLong.where := constant; gLong.lval := op^.lval; end else if (A_X & gLong.preference) <> 0 then begin gLong.where := A_X; GenNative(m_lda_imm, immediate, long(op^.lval).lsw, nil, 0); GenNative(m_ldx_imm, immediate, long(op^.lval).msw, nil, 0); end else begin gLong.where := onStack; GenNative(m_pea, immediate, long(op^.lval).msw, nil, 0); GenNative(m_pea, immediate, long(op^.lval).lsw, nil, 0); end; otherwise: Error(cge1); end; {case} end; {GenLdc} procedure GenLdo (op: icptr); { Generate code for a pc_ldo } var lab1: integer; {branch point} begin {GenLdo} case op^.optype of cgWord, cgUWord: if smallMemoryModel then GenNative(m_lda_abs, absolute, op^.q, op^.lab, 0) else GenNative(m_lda_long, longAbs, op^.q, op^.lab, 0); cgByte, cgUByte: begin if smallMemoryModel then GenNative(m_lda_abs, absolute, op^.q, op^.lab, 0) else GenNative(m_lda_long, longAbs, op^.q, op^.lab, 0); GenNative(m_and_imm, immediate, 255, nil, 0); if op^.optype = cgByte then begin GenNative(m_bit_imm, immediate, $0080, nil, 0); lab1 := GenLabel; GenNative(m_beq, relative, lab1, nil, 0); GenNative(m_ora_imm, immediate, $FF00, nil, 0); GenLab(lab1); GenNative(m_cmp_imm, immediate, $0000, nil, 0); end; {if} end; cgReal, cgDouble, cgComp, cgExtended: begin GenNative(m_pea, immediate, op^.q, op^.lab, shift16); GenNative(m_pea, immediate, op^.q, op^.lab, 0); if op^.optype = cgReal then GenCall(21) else if op^.optype = cgDouble then GenCall(22) else if op^.optype = cgComp then GenCall(70) else {if op^.optype = cgExtended then} GenCall(71); end; cgLong, cgULong: begin if (A_X & gLong.preference) <> 0 then gLong.where := A_X else gLong.where := onStack; if smallMemoryModel then begin GenNative(m_ldx_abs, absolute, op^.q+2, op^.lab, 0); GenNative(m_lda_abs, absolute, op^.q, op^.lab, 0); if gLong.where = onStack then begin GenImplied(m_phx); GenImplied(m_pha); end; {if} end {if} else begin GenNative(m_lda_long, longabsolute, op^.q+2, op^.lab, 0); if gLong.where = onStack then GenImplied(m_pha) else GenImplied(m_tax); GenNative(m_lda_long, longabsolute, op^.q, op^.lab, 0); if gLong.where = onStack then GenImplied(m_pha); end; {else} end; {case cgLong,cgULong} otherwise: Error(cge1); end; {case} end; {GenLdo} procedure GenLnm (op: icptr); { Generate code for a pc_lnm } begin {GenLnm} if op^.left <> nil then GenTree(op^.left); if traceBack then begin GenNative(m_pea, immediate, op^.r, nil, 0); GenCall(6); end; {if} if debugFlag then begin GenNative(m_cop, immediate, op^.q, nil, 0); GenNative(d_wrd, special, op^.r, nil, 0); end; {if} end; {GenLnm} procedure GenLod (op: icptr); { Generate code for a pc_lod } var disp: integer; {load location} lab1: integer; {branch point} optype: baseTypeEnum; {op^.optype} begin {GenLod} disp := LabelToDisp(op^.r) + op^.q; optype := op^.optype; case optype of cgReal, cgDouble, cgComp, cgExtended: begin GenNative(m_pea, immediate, 0, nil, 0); GenImplied(m_tdc); GenImplied(m_clc); GenNative(m_adc_imm, immediate, disp, nil, 0); GenImplied(m_pha); if optype = cgReal then GenCall(21) else if optype = cgDouble then GenCall(22) else if optype = cgComp then GenCall(70) else {if optype = cgExtended then} GenCall(71); end; cgLong, cgULong: begin if ((inPointer & gLong.preference) <> 0) and (disp < 254) then begin gLong.where := inPointer; gLong.fixedDisp := true; gLong.disp := disp; end {if} else if ((A_X & gLong.preference) <> 0) and (disp < 254) then begin gLong.where := A_X; GenNative(m_ldx_dir, direct, disp+2, nil, 0); GenNative(m_lda_dir, direct, disp, nil, 0); end {else if} else begin gLong.where := onStack; if disp >= 254 then begin GenNative(m_ldx_imm, immediate, disp, nil, 0); GenNative(m_lda_dirx, direct, 2, nil, 0); GenImplied(m_pha); GenNative(m_lda_dirx, direct, 0, nil, 0); GenImplied(m_pha); end {if} else begin GenNative(m_pei_dir, direct, disp+2, nil, 0); GenNative(m_pei_dir, direct, disp, nil, 0); end; {else} end; {else} end; cgByte, cgUByte, cgWord, cgUWord: begin if disp >= 256 then begin GenNative(m_ldx_imm, immediate, disp, nil, 0); GenNative(m_lda_dirx, direct, 0, nil, 0); end else GenNative(m_lda_dir, direct, disp, nil, 0); if optype in [cgByte,cgUByte] then begin GenNative(m_and_imm, immediate, $00FF, nil, 0); if optype = cgByte then begin GenNative(m_bit_imm, immediate, $0080, nil, 0); lab1 := GenLabel; GenNative(m_beq, relative, lab1, nil, 0); GenNative(m_ora_imm, immediate, $FF00, nil, 0); GenLab(lab1); GenNative(m_cmp_imm, immediate, $0000, nil, 0); end; {if} end; end; otherwise: Error(cge1); end; {case} end; {GenLod} procedure GenLorLnd (op: icptr); { Generate code for a pc_lor or pc_lnd } var lab1,lab2: integer; {label} nd: icptr; {temp node pointer} opc: pcodes; {operation code} procedure DoOra; { do some common oring operations to reduce space } begin {DoOra} if gLong.where = onStack then begin GenImplied(m_pla); GenNative(m_sta_dir, direct, dworkLoc, nil, 0); GenImplied(m_pla); end {if} else GenNative(m_stx_dir, direct, dworkLoc, nil, 0); GenNative(m_ora_dir, direct, dworkLoc, nil, 0); end; {DoOra} begin {GenLorLnd} opc := op^.opcode; lab1 := GenLabel; gLong.preference := A_X; GenTree(op^.left); DoOra; lab2 := GenLabel; if opc = pc_lnd then GenNative(m_bne, relative, lab2, nil, 0) else begin GenNative(m_beq, relative, lab2, nil, 0); GenNative(m_lda_imm, immediate, 1, nil, 0); end; {else} GenNative(m_brl, longrelative, lab1, nil, 0); GenLab(lab2); gLong.preference := A_X; GenTree(op^.right); DoOra; GenNative(m_beq, relative, lab1, nil, 0); GenNative(m_lda_imm, immediate, 1, nil, 0); GenLab(lab1); end; {GenLorLnd} procedure GenMov (op: icptr; duplicate: boolean); { Generate code for a pc_mov } { } { parameters: } { op - pc_mov instruction } { duplicate - should the source address be left on the } { stack? } var banks: integer; {number of banks to move} procedure Load (opcode: integer; op: icptr); { generate a load immediate based on instruction type } { } { parameters: } { opcode - native code load operation } { op - node to load } var i: integer; begin {Load} if op^.opcode = pc_lao then GenNative(opcode, immediate, op^.q, op^.lab, 0) else begin GenNative(opcode, immediate, stringsize, nil, StringReference); if maxstring-stringsize >= op^.q then begin for i := 1 to op^.q do stringspace[i+stringsize] := op^.str^.str[i]; stringsize := stringsize + op^.q; end {if} else Error(cge3); end; {else} end; {Load} begin {GenMov} {determine if the destination address must be left on the stack} if smallMemoryModel and (not duplicate) and (op^.left^.opcode in [pc_lao,pc_lca]) and (op^.right^.opcode in [pc_lao,pc_lca]) then begin {take advantage of any available short cuts} Load(m_ldy_imm, op^.left); Load(m_ldx_imm, op^.right); GenNative(m_lda_imm, immediate, op^.q-1, nil, 0); GenImplied(m_phb); GenImplied(m_mvn); with op^.left^ do if opcode = pc_lao then GenNative(d_bmov, immediate, q, lab, shift16) else GenNative(d_bmov, immediate, 0, nil, stringReference+shift16); with op^.right^ do if opcode = pc_lao then GenNative(d_bmov, immediate, q, lab, shift16) else GenNative(d_bmov, immediate, 0, nil, stringReference+shift16); GenImplied(m_plb); end {if} else begin {no short cuts are available - do it the hard way} gLong.preference := onStack; GenTree(op^.left); gLong.preference := onStack; GenTree(op^.right); banks := op^.r; if banks <> 0 then GenNative(m_pea, immediate, banks, nil, 0); GenNative(m_pea, immediate, op^.q, nil, 0); if banks = 0 then begin if duplicate then GenCall(55) else GenCall(54); end {if} else if duplicate then GenCall(63) else GenCall(62); end; {else} end; {GenMov} procedure GenMpi (op: icptr); { Generate code for a pc_mpi or pc_umi } var nd: icptr; begin {GenMpi} if not Complex(op^.left) then if Complex(op^.right) then begin nd := op^.left; op^.left := op^.right; op^.right := nd; end; {if} GenTree(op^.left); if Complex(op^.right) then begin GenImplied(m_pha); GenTree(op^.right); GenImplied(m_plx); end {if} else LoadX(op^.right); if op^.opcode = pc_mpi then GenCall(28) else {pc_umi} GenCall(39); if rangeCheck then GenCall(25); end; {GenMpi} procedure GenNam (op: icptr); { Generate code for a pc_nam } var i: integer; {loop/index variable} len: integer; {length of the file name} function ToUpper (ch: char): char; { Return the uppercase equivalent of the input character } begin {ToUpper} if (ch >= 'a') and (ch <= 'z') then ch := chr(ord(ch)-ord('a')+ord('A')); ToUpper := ch; end; {ToUpper} begin {GenNam} {generate a call to install the name in the traceback facility} if traceBack then begin GenNative(m_pea, immediate, stringSize, nil, stringReference+shift16); GenNative(m_pea, immediate, stringSize, nil, stringReference); GenCall(5); namePushed := true; end; {if} {send the name to the profiler} if profileFlag then begin GenNative(m_cop, immediate, 3, nil, 0); GenNative(d_add, genaddress, stringSize, nil, stringReference); GenNative(d_add, genaddress, stringSize, nil, stringReference+shift16); end; {if} {place the name in the string buffer} if maxString-stringSize >= op^.q+1 then begin stringSpace[stringSize+1] := chr(op^.q); for i := 1 to op^.q do stringSpace[i+stringSize+1] := op^.str^.str[i]; stringSize := stringSize + op^.q + 1; end {if} else Error(cge3); {send the file name to the debugger} if debugFlag then begin GenNative(m_cop, immediate, 6, nil, 0); GenNative(d_add, genaddress, stringSize, nil, stringReference); GenNative(d_add, genaddress, stringSize, nil, stringReference+shift16); len := sourceFileGS.theString.size; if len > 255 then len := 255; if maxString-stringSize >= len+1 then begin stringSpace[stringSize+1] := chr(len); for i := 1 to len do stringSpace[i+stringSize+1] := ToUpper(sourceFileGS.theString.theString[i]); stringSize := stringSize + len + 1; end {if} else Error(cge3); end; {if} end; {GenNam} procedure GenNat (op: icptr); { Generate code for a pc_nat } var flags: integer; {work var for flags} mode: addressingmode; {work var for addressing mode} pval: longint; {temp pointer} val: longint; {constant operand} begin {GenNat} val := op^.opnd; flags := op^.q; pval := op^.llab; mode := addressingMode(op^.r); if op^.slab <> 0 then val := val+LabelToDisp(op^.slab); if mode in [relative,longrelative] then GenNative(op^.s, mode, op^.llab, op^.lab, op^.q) else if (mode = longabsolute) and (op^.llab <> 0) then GenNative(op^.s, mode, long(val).lsw, pointer(pval), flags | localLab) else if (mode = longabsolute) and (op^.llab = 0) and (op^.lab = nil) then GenNative(op^.s, mode, 0, pointer(val), flags | constantOpnd) else begin if (mode = absolute) and (op^.llab = 0) then flags := flags | constantOpnd; if op^.llab <> 0 then GenNative(op^.s, mode, long(val).lsw, pointer(pval), flags | localLab) else GenNative(op^.s, mode, long(val).lsw, op^.lab, flags); end; {else} end; {GenNat} procedure GenNgr (op: icptr); { Generate code for a pc_ngr } begin {GenNgr} GenTree(op^.left); GenNative(m_lda_s, direct, 9, nil, 0); GenNative(m_eor_imm, immediate, -32767-1, nil, 0); GenNative(m_sta_s, direct, 9, nil, 0); end; {GenNgr} procedure GenPop (op: icptr); { Generate code for a pc_pop } var isIncLoad: boolean; {is the operand one of the inc/dec & load commands?} begin {GenPop} glong.preference := A_X; {generate the operand} isIncLoad := op^.left^.opcode in [pc_lil,pc_lli,pc_ldl,pc_lld,pc_gil,pc_gli,pc_gdl,pc_gld, pc_iil,pc_ili,pc_idl,pc_ild]; if isIncLoad then skipLoad := true; if op^.left^.opcode = pc_mov then GenMov(op^.left, false) else begin GenTree(op^.left); if isIncLoad then skipLoad := false; case op^.optype of {do the pop} otherwise: ; cgLong, cgULong: if not isIncLoad then if gLong.where = onStack then begin GenImplied(m_pla); GenImplied(m_pla); end; {if} {else do nothing} cgReal, cgDouble, cgComp, cgExtended: begin GenImplied(m_tsc); GenImplied(m_clc); GenNative(m_adc_imm, immediate, 10, nil, 0); GenImplied(m_tcs); end; end; {case} end; {else} end; {GenPop} procedure GenPsh (op: icptr); { Generate code for a pc_psh } begin {GenPsh} gLong.preference := onStack; GenTree(op^.left); GenTree(op^.right); GenImplied(m_pha); GenCall(77); end; {GenPsh} procedure GenRealBinOp (op: icptr); { Generate code for a pc_adr, pc_dvr, pc_mpr or pc_sbr } var nd: icptr; {temp pointer} snum: integer; {library subroutine numbers} ss,sd,sc,se: integer; {sane call numbers} begin {GenRealBinOp} case op^.opcode of pc_adr: begin snum := 56; ss := $0200; sd := $0100; sc := $0500; se := $0000; end; pc_dvr: begin snum := 57; ss := $0206; sd := $0106; sc := $0506; se := $0006; end; pc_mpr: begin snum := 58; ss := $0204; sd := $0104; sc := $0504; se := $0004; end; pc_sbr: begin snum := 59; ss := $0202; sd := $0102; sc := $0502; se := $0002; end; end; {case} if op^.opcode in [pc_mpr,pc_adr] then if op^.left^.opcode in [pc_lod,pc_ldo] then begin nd := op^.left; op^.left := op^.right; op^.right := nd; end; {if} GenTree(op^.left); if (op^.right^.opcode in [pc_lod,pc_ldo]) and (floatCard = 0) then with op^.right^ do begin if opcode = pc_lod then begin GenNative(m_pea, immediate, 0, nil, 0); GenImplied(m_tdc); GenImplied(m_clc); GenNative(m_adc_imm, immediate, LabelToDisp(r) + q, nil, 0); GenImplied(m_pha); end {if} else begin GenNative(m_pea, immediate, q, lab, shift16); GenNative(m_pea, immediate, q, lab, 0); end; {else} GenNative(m_pea, immediate, 0, nil, 0); GenImplied(m_tsc); GenImplied(m_clc); GenNative(m_adc_imm, immediate, 7, nil, 0); GenImplied(m_pha); if optype = cgReal then sd := ss else if optype = cgExtended then sd := se else if optype = cgComp then sd := sc; GenNative(m_pea, immediate, sd, nil, 0); GenNative(m_ldx_imm, immediate, $090A, nil, 0); GenNative(m_jsl, longAbs, 0, nil, toolCall); end {with} else begin GenTree(op^.right); GenCall(snum); end; {else} end; {GenRealBinOp} procedure GenRet (op: icptr); { Generate code for a pc_ret } var size: integer; {localSize + parameterSize} begin {GenRet} {pop the name record} if namePushed then GenCall(2); {generate an exit code for the debugger's benefit} if debugFlag then GenNative(m_cop, immediate, 4, nil, 0); {if anything needs to be removed from the stack, move the return val} size := localSize + parameterSize; if parameterSize <> 0 then begin if localSize > 254 then begin GenNative(m_ldx_imm, immediate, localSize+1, nil, 0); GenNative(m_lda_dirx, direct, 0, nil, 0); GenNative(m_ldy_dirx, direct, 1, nil, 0); GenNative(m_ldx_imm, immediate, localSize+parameterSize+1, nil, 0); GenNative(m_sta_dirx, direct, 0, nil, 0); GenNative(m_sty_dirx, direct, 1, nil, 0); end {if} else begin GenNative(m_lda_dir, direct, localSize+2, nil, 0); if localSize+parameterSize > 254 then begin GenNative(m_ldx_imm, immediate, localSize+parameterSize+1, nil, 0); GenNative(m_sta_dirx, direct, 1, nil, 0); GenNative(m_lda_dir, direct, localSize+1, nil, 0); GenNative(m_sta_dirx, direct, 0, nil, 0); end {if} else begin GenNative(m_sta_dir, direct, localSize+parameterSize+2, nil, 0); GenNative(m_lda_dir, direct, localSize+1, nil, 0); GenNative(m_sta_dir, direct, localSize+parameterSize+1, nil, 0); end; {else} end; {else} end; {if} {load the value to return} case op^.optype of cgVoid: ; cgByte,cgUByte: begin GenNative(m_lda_dir, direct, funLoc, nil, 0); GenNative(m_and_imm, immediate, $00FF, nil, 0); if size <> 2 then GenImplied(m_tay); end; cgWord,cgUWord: if size = 2 then GenNative(m_lda_dir, direct, funLoc, nil, 0) else GenNative(m_ldy_dir, direct, funLoc, nil, 0); cgReal: GenCall(3); cgDouble: GenCall(4); cgComp: GenCall(64); cgExtended: GenCall(65); cgLong,cgULong: begin GenNative(m_ldx_dir, direct, funLoc+2, nil, 0); GenNative(m_ldy_dir, direct, funLoc, nil, 0); end; otherwise: Error(cge1); end; {case} {restore data bank reg} if dataBank then begin GenNative(m_lda_dir, direct, bankLoc, nil, 0); GenImplied(m_pha); GenImplied(m_plb); GenImplied(m_plb); end; {if} {get rid of the stack frame space} if size <> 0 then GenImplied(m_pld); if size = 2 then GenImplied(m_ply) else if size <> 0 then begin GenImplied(m_tsc); GenImplied(m_clc); GenNative(m_adc_imm, immediate, size, nil, 0); GenImplied(m_tcs); end; {if} {put return value in correct place} case op^.optype of cgByte,cgUByte,cgWord,cgUWord: begin if size <> 2 then GenImplied(m_tya); if toolParms then {save value on stack for tools} GenNative(m_sta_s, direct, returnSize+1, nil, 0); end; cgLong,cgULong,cgReal,cgDouble,cgComp,cgExtended: begin GenImplied(m_tya); if toolParms then begin {save value on stack for tools} GenNative(m_sta_s, direct, returnSize+1, nil, 0); GenImplied(m_txa); GenNative(m_sta_s, direct, returnSize+3, nil, 0); end; {if} end; cgVoid: ; otherwise: Error(cge1); end; {case} {return to the caller} GenImplied(m_rtl); end; {GenRet} procedure GenSbfCbf (op: icptr); { Generate code for a pc_sbf or pc_cbf } begin {GenSbfCbf} gLong.preference := onStack; GenTree(op^.left); GenNative(m_pea, immediate, op^.r, nil, 0); GenNative(m_pea, immediate, op^.q, nil, 0); if op^.optype in [cgLong,cgULong] then begin gLong.preference := onStack; GenTree(op^.right); end {if} else begin GenNative(m_pea, immediate, 0, nil, 0); GenTree(op^.right); GenImplied(m_pha); end; {else} if op^.opcode = pc_sbf then GenCall(74) else begin GenCall(75); if not (op^.optype in [cgLong,cgULong]) then begin GenImplied(m_pla); GenImplied(m_plx); end; {if} end; {else} end; {GenSbfCbf} procedure GenSbi (op: icptr); { Generate code for a pc_sbi } begin {GenSbi} if Complex(op^.left) or Complex(op^.right) then begin GenTree(op^.right); if Complex(op^.left) then begin GenImplied(m_pha); GenTree(op^.left); GenImplied(m_sec); GenNative(m_sbc_s, direct, 1, nil, 0); GenImplied(m_plx); end {if} else begin GenNative(m_eor_imm, immediate, $FFFF, nil, 0); GenImplied(m_sec); OperA(m_adc_imm, op^.left); end; {else} end {if} else begin GenTree(op^.left); GenImplied(m_sec); OperA(m_sbc_imm, op^.right); end; {else} end; {GenSbi} procedure GenStk (op: icptr); { Generate code for a pc_stk } var lab1: integer; {branch point} begin {GenStk} glong.preference := onStack; {generate the operand} GenTree(op^.left); if op^.optype in {do the stk} [cgByte, cgUByte, cgWord, cgUWord] then GenImplied(m_pha); end; {GenStk} procedure GenShlShrUsr (op: icptr); { Generate code for a pc_shl, pc_shr or pc_usr } var i,op1,op2,num: integer; {temp variables} begin {GenShlShrUsr} {get the standard native operations} if op^.opcode = pc_shl then begin op1 := m_asl_a; op2 := m_lsr_a; end {if} else begin op1 := m_lsr_a; op2 := m_asl_a; end; {else} {take short cuts if they are legal} if (op^.right^.opcode = pc_ldc) and (op^.opcode <> pc_shr) then begin num := op^.right^.q; if (num > 16) or (num < -16) then GenNative(m_lda_imm, immediate, 0, nil, 0) else if num > 0 then begin GenTree(op^.left); if num >= 8 then begin GenImplied(m_xba); if op1 = m_lsr_a then i := $00FF else i := $FF00; GenNative(m_and_imm, immediate, i, nil, 0); num := num-8; end; {if} for i := 1 to num do GenImplied(op1); end {else if} else if num < 0 then begin GenTree(op^.left); if num <= -8 then begin GenImplied(m_xba); if op2 = m_lsr_a then i := $00FF else i := $FF00; GenNative(m_and_imm, immediate, i, nil, 0); num := num+8; end; {if} for i := 1 to -num do GenImplied(op2); end {else if} else GenTree(op^.left); end {if} else begin GenTree(op^.left); if Complex(op^.right) then begin GenImplied(m_pha); GenTree(op^.right); GenImplied(m_tax); GenImplied(m_pla); end {if} else LoadX(op^.right); if op^.opcode = pc_shl then GenCall(23) else if op^.opcode = pc_shr then GenCall(24) else {if op^.opcode = pc_usr then} GenCall(41); end; {else} end; {GenShlShrUsr} procedure GenTl1 (op: icptr); { Generate code for a pc_tl1 } var lLong: longType; {used to reserve gLong} tp: baseTypeEnum; {operand type} begin {GenTl1} if op^.r in [2,4] then begin GenImplied(m_pha); if op^.r = 4 then GenImplied(m_pha); end; {if} lLong := gLong; GenTree(op^.left); gLong := lLong; GenNative(m_ldx_imm, immediate, op^.q, nil, 0); GenNative(m_jsl, longAbs, 0, pointer(op^.lval), toolCall); if smallMemoryModel then GenNative(m_sta_abs, absolute, 0, @'~TOOLERROR', 0) else GenNative(m_sta_long, longAbs, 0, @'~TOOLERROR', 0); if op^.r in [2,4] then begin if op^.r = 2 then begin GenImplied(m_pla); tp := cgWord; end {if} else begin gLong.where := onStack; tp := cgLong; end; {else} end; {if} end; {GenTl1} procedure GenTri (op: icptr); { Generate code for a pc_tri } var lab1,lab2,lab3: integer; {label for branches} begin {GenTri} lab1 := GenLabel; lab2 := GenLabel; lab3 := GenLabel; GenTree(op^.left); if op^.left^.opcode in [pc_and,pc_ior,pc_cui,pc_cup,pc_lor,pc_lnd,pc_ldl,pc_lil,pc_lld, pc_lli,pc_gil,pc_gli,pc_gdl,pc_gld] then GenImplied(m_tax); GenNative(m_beq, relative, lab1, nil, 0); GenNative(m_brl, longrelative, lab2, nil, 0); GenLab(lab1); gLong.preference := onStack; GenTree(op^.right^.right); GenNative(m_brl, longrelative, lab3, nil, 0); GenLab(lab2); gLong.preference := onStack; GenTree(op^.right^.left); GenLab(lab3); gLong.where := onStack; end; {GenTri} procedure GenXjp (op: icptr); { Generate code for a pc_xjp } var lab1,lab2: integer; q: integer; begin {GenXjp} q := op^.q; GenTree(op^.left); GenNative(m_cmp_imm, immediate, q, nil, 0); lab1 := GenLabel; GenNative(m_bcc, relative, lab1, nil, 0); GenNative(m_lda_imm, immediate, q, nil, 0); GenLab(lab1); GenImplied(m_asl_a); GenImplied(m_tax); lab1 := GenLabel; GenNative(m_lda_longx, longAbs, lab1, nil, 0); GenImplied(m_pha); GenImplied(m_rts); GenLab(lab1); end; {GenXjp} procedure DirEnp; { Generate code for a dc_enp } begin {DirEnp} GenImplied(d_end); EndSeg; InitLabels; end; {DirEnp} procedure DirStr (op: icptr); { Generate code for a dc_str } begin {DirStr} skipLoad := false; InitNative; Header(op^.lab, op^.r, op^.q); end; {DirStr} procedure DirSym (op: icptr); { Generate code for a dc_sym } begin {DirSym} if debugFlag then GenNative(d_sym, special, op^.q, pointer(op^.lab), 0); end; {DirSym} begin {GenTree} {write('GEN: '); WriteCode(op); {debug} Spin; case op^.opcode of dc_cns: GenNative(d_cns, gnrConstant, op^.q, pointer(op), 0); dc_dst: GenNative(d_lab, gnrSpace, op^.q, nil, 0); dc_enp: DirEnp; dc_lab: GenLab(op^.q); dc_loc,dc_prm: ; dc_glb: GenNative(d_lab, gnrLabel, op^.r, op^.lab, isPrivate*op^.q); dc_pin: GenNative(d_pin, special, 0, nil, 0); dc_str: DirStr(op); dc_sym: DirSym(op); pc_add: GenNative(d_add, genaddress, op^.q, nil, 0); pc_adi: GenAdi(op); pc_adl,pc_sbl: GenAdlSbl(op, nil); pc_adr,pc_dvr,pc_mpr,pc_sbr: GenRealBinOp(op); pc_and,pc_bnd,pc_bor,pc_bxr,pc_ior: GenLogic(op); pc_blr,pc_blx,pc_bal,pc_dvl,pc_mdl,pc_mpl,pc_sll,pc_slr,pc_udl,pc_ulm, pc_uml,pc_vsr: GenBinLong(op); pc_bnl,pc_ngl: GenUnaryLong(op); pc_bno: GenBno(op); pc_bnt,pc_ngi,pc_not: GenBntNgiNot(op); pc_cnv: GenCnv(op); pc_cui: GenCui(op); pc_cup: GenCup(op); pc_dec,pc_inc: GenIncDec(op, nil); pc_dvi,pc_mod,pc_udi,pc_uim: GenDviMod(op); pc_ent: GenEnt; pc_equ,pc_neq: GenEquNeq(op, op^.opcode, 0); pc_fjp,pc_tjp: GenFjpTjp(op); pc_geq,pc_grt,pc_leq,pc_les: GenCmp(op, op^.opcode, 0); pc_gil,pc_gli,pc_gdl,pc_gld: GenGilGliGdlGld(op); pc_iil,pc_ili,pc_idl,pc_ild: GenIilIliIdlIld(op); pc_ind: GenInd(op); pc_ixa: GenIxa(op); pc_lao,pc_lad: GenLaoLad(op); pc_lbf,pc_lbu: GenLbfLbu(op); pc_lca: GenLca(op); pc_lda: GenLda(op); pc_ldc: GenLdc(op); pc_ldo: GenLdo(op); pc_lil,pc_lli,pc_ldl,pc_lld: GenLilLliLdlLld(op); pc_lnm: GenLnm(op); pc_lod: GenLod(op); pc_lor,pc_lnd: GenLorLnd(op); pc_mov: GenMov(op, true); pc_mpi,pc_umi: GenMpi(op); pc_nam: GenNam(op); pc_nat: GenNat(op); pc_ngr: GenNgr(op); pc_nop: ; pc_pop: GenPop(op); pc_psh: GenPsh(op); pc_ret: GenRet(op); pc_sbf,pc_cbf: GenSbfCbf(op); pc_sbi: GenSbi(op); pc_shl,pc_shr,pc_usr: GenShlShrUsr(op); pc_stk: GenStk(op); pc_sro,pc_cpo: GenSroCpo(op); pc_sto,pc_cpi: GenStoCpi(op); pc_str,pc_cop: GenStrCop(op); pc_tl1: GenTl1(op); pc_tri: GenTri(op); pc_ujp: GenNative(m_brl, longrelative, op^.q, nil, 0); pc_xjp: GenXjp(op); otherwise: Error(cge1); end; {case} end; {GenTree} {---------------------------------------------------------------} procedure Gen {blk: blockPtr}; { Generates native code for a list of blocks } { } { parameters: } { blk - first of the list of blocks } const locSize = 4; {variables <= this size allocated first} var bk: blockPtr; {used to trace block lists} minSize: integer; {location for the next local label} op: icptr; {used to trace code lists} procedure DirLoc1 (op: icptr); { allocates stack frame locations for small dc_loc } begin {DirLoc1} if op^.q <= locSize then begin if op^.r < maxLocalLabel then begin localLabel[op^.r] := minSize; minSize := minSize + op^.q; end {if} else Error(cge2); end; {if} end; {DirLoc1} procedure DirLoc2 (op: icptr); { allocates stack frame locations for large dc_loc } begin {DirLoc2} if op^.q > locSize then begin if op^.r < maxLocalLabel then begin localLabel[op^.r] := minSize; minSize := minSize + op^.q; end {if} else Error(cge2); end; {if} end; {DirLoc2} procedure DirPrm (op: icptr); { allocates stack frame locations for parameters } begin {DirPrm} if op^.s < maxLocalLabel then localLabel[op^.s] := localSize + returnSize + 1 + op^.r else Error(cge2); end; {DirPrm} procedure Scan (op: icptr); { scans the code stream for instructions that effect the } { size of the stack frame } { } { parameters: } { op - scan this opcode and its children } var opcode: pcodes; {op^.opcode} size: integer; {function return value size} begin {Scan} if op^.left <> nil then Scan(op^.left); if op^.right <> nil then Scan(op^.right); opcode := op^.opcode; if opcode = dc_loc then localSize := localSize + op^.q else if opcode = dc_prm then parameterSize := parameterSize + op^.q else if opcode = pc_ret then begin case op^.optype of otherwise: size := 0; cgByte,cgUByte,cgWord,cgUWord: size := cgWordSize; cgReal: size := cgRealSize; cgDouble: size := cgDoubleSize; cgComp: size := cgCompSize; cgExtended: size := cgExtendedSize; cgLong,cgULong: size := cgLongSize; end; {case} funLoc := 1; if dworkLoc <> 0 then dworkLoc := dworkLoc + size; minSize := minSize + size; localSize := localSize + size; end {else if} else if opcode in [pc_les,pc_leq,pc_grt,pc_geq,pc_sto,pc_cpi,pc_ind,pc_lor,pc_lnd, pc_ili,pc_iil,pc_idl,pc_ild,pc_ixa] then begin if dworkLoc = 0 then begin dworkLoc := minSize; minSize := minSize + 4; localSize := localSize + 4; end; {if} end; {else if} end; {Scan} begin {Gen} bk := blk; {determine the size of the stack frame} localSize := 0; parameterSize := 0; funLoc := 0; dworkLoc := 0; minSize := 1; while bk <> nil do begin op := bk^.code; while op <> nil do begin Scan(op); op := op^.next; end; {while} bk := bk^.next; end; {while} if saveStack or checkStack or strictVararg then begin stackLoc := minSize; minSize := minSize + 2; localSize := localSize + 2; end; {if} if dataBank then begin bankLoc := minSize; minSize := minSize + 2; localSize := localSize + 2; end; {if} bk := blk; {allocate locations for the values} while bk <> nil do begin op := bk^.code; while op <> nil do begin if op^.opcode = dc_loc then DirLoc1(op) else if op^.opcode = dc_prm then DirPrm(op); op := op^.next; end; {while} bk := bk^.next; end; {while} bk := blk; while bk <> nil do begin op := bk^.code; while op <> nil do begin if op^.opcode = dc_loc then DirLoc2(op); op := op^.next; end; {while} bk := bk^.next; end; {while} while blk <> nil do begin {generate code for the block} op := blk^.code; while op <> nil do begin GenTree(op); op := op^.next; end; {while} blk := blk^.next; end; {while} end; {Gen} function LabelToDisp {lab: integer): integer}; { convert a local label number to a stack frame displacement } { } { parameters: } { lab - label number } begin {LabelToDisp} if lab = 0 then LabelToDisp := funLoc else LabelToDisp := localLabel[lab]; end; {LabelToDisp} end. \ No newline at end of file +{$optimize 7} +{---------------------------------------------------------------} +{ } +{ Gen } +{ } +{ Generates native code from intermediate code instructions. } +{ } +{---------------------------------------------------------------} + +unit Gen; + +interface + +{$segment 'gen'} + +{$LibPrefix '0/obj/'} + +uses CCommon, CGI, CGC, ObjOut, Native; + +{---------------------------------------------------------------} + +function LabelToDisp (lab: integer): integer; + +{ convert a local label number to a stack frame displacement } +{ } +{ parameters: } +{ lab - label number } + + +procedure Gen (blk: blockPtr); + +{ Generates native code for a list of blocks } +{ } +{ parameters: } +{ blk - first of the list of blocks } + +{---------------------------------------------------------------} + +implementation + +const + A_X = 1; {longword locations} + onStack = 2; + inPointer = 4; + localAddress = 8; + globalLabel = 16; + constant = 32; + + {stack frame locations} + {---------------------} + returnSize = 3; {size of return address} + +type + {possible locations for 4 byte values} + longType = record {desciption of current four byte value} + preference: integer; {where you want the value} + where: integer; {where the value is at} + fixedDisp: boolean; {is the displacement a fixed value?} + isLong: boolean; {is long addr required for named labs?} + disp: integer; {fixed displacement/local addr} + lval: longint; {value} + lab: stringPtr; {global label name} + end; + +var + gLong: longType; {info about last long value} + namePushed: boolean; {has a name been pushed in this proc?} + skipLoad: boolean; {skip load for a pc_lli, etc?} + + {stack frame locations} + {---------------------} + bankLoc: integer; {disp in dp where bank reg is stored} + dworkLoc: integer; {disp in dp of 4 byte work spage for cg} + funLoc: integer; {loc of fn ret value in stack frame} + localSize: integer; {local space for current proc} + parameterSize: integer; {# bytes of parameters for current proc} + stackLoc: integer; {disp in dp where stack reg is stored} + +{---------------------------------------------------------------} + +procedure GenTree (op: icptr); forward; + + +procedure OperA (mop: integer; op: icptr); + +{ Do an operation on op that has addr modes equivalent to STA } +{ } +{ parameters: } +{ op - node to generate the leaf for } +{ mop - operation } + +var + loc: integer; {stack frame position} + opcode: pcodes; {temp storage} + +begin {OperA} +opcode := op^.opcode; +case opcode of + + pc_ldo,pc_gil,pc_gli,pc_gdl,pc_gld: begin + case mop of + m_cmp_imm: mop := m_cmp_abs; + m_adc_imm: mop := m_adc_abs; + m_and_imm: mop := m_and_abs; + m_ora_imm: mop := m_ora_abs; + m_sbc_imm: mop := m_sbc_abs; + m_eor_imm: mop := m_eor_abs; + otherwise: Error(cge1); + end; {case} + if opcode = pc_gil then + GenNative(m_inc_abs, absolute, op^.q, op^.lab, 0) + else if opcode = pc_gdl then + GenNative(m_dec_abs, absolute, op^.q, op^.lab, 0); + if smallMemoryModel then + GenNative(mop, absolute, op^.q, op^.lab, 0) + else + GenNative(mop+2, longAbs, op^.q, op^.lab, 0); + if opcode in [pc_gli,pc_gld] then begin + if mop in [m_sbc_dir,m_cmp_dir] then + GenImplied(m_php); + if opcode = pc_gli then + GenNative(m_inc_abs, absolute, op^.q, op^.lab, 0) + else {if opcode = pc_gld then} + GenNative(m_dec_abs, absolute, op^.q, op^.lab, 0); + if mop in [m_sbc_dir,m_cmp_dir] then + GenImplied(m_plp); + end; {else} + end; {case pc_ldo,pc_gil,pc_gli,pc_gdl,pc_gld} + + pc_lod,pc_lli,pc_lil,pc_lld,pc_ldl: begin + case mop of + m_cmp_imm: mop := m_cmp_dir; + m_adc_imm: mop := m_adc_dir; + m_and_imm: mop := m_and_dir; + m_ora_imm: mop := m_ora_dir; + m_sbc_imm: mop := m_sbc_dir; + m_eor_imm: mop := m_eor_dir; + otherwise: Error(cge1); + end; {case} + loc := LabelToDisp(op^.r); + if opcode = pc_lod then + loc := loc + op^.q; + if opcode = pc_lil then + GenNative(m_inc_dir, direct, loc, nil, 0) + else if opcode = pc_ldl then + GenNative(m_dec_dir, direct, loc, nil, 0); + GenNative(mop, direct, loc, nil, 0); + if opcode in [pc_lli,pc_lld] then begin + if mop in [m_sbc_dir,m_cmp_dir] then + GenImplied(m_php); + if opcode = pc_lli then + GenNative(m_inc_dir, direct, loc, nil, 0) + else {if opc = pc_lld then} + GenNative(m_dec_dir, direct, loc, nil, 0); + if mop in [m_sbc_dir,m_cmp_dir] then + GenImplied(m_plp); + end; {else} + end; {case pc_lod,pc_lli,pc_lil,pc_lld,pc_ldl} + + pc_ldc: + GenNative(mop, immediate, op^.q, nil, 0); + + otherwise: + Error(cge1); + end; {case} +end; {OperA} + + +function Complex (op: icptr): boolean; + +{ determine if loading the intermediate code involves anything } +{ but one reg } +{ } +{ parameters: } +{ code - intermediate code to check } +{ } +{ NOTE: for one and two byte values only!!! } + +begin {Complex} +Complex := true; +if op^.opcode in [pc_ldo,pc_ldc] then + Complex := false +else if op^.opcode in [pc_gil,pc_gli,pc_gdl,pc_gld] then + Complex := smallMemoryModel +else if op^.opcode = pc_lod then + if LabelToDisp(op^.r) + op^.q < 256 then + Complex := false +else if op^.opcode in [pc_lli,pc_lil,pc_ldl,pc_lld] then + if LabelToDisp(op^.r) < 256 then + Complex := false; +if op^.optype in [cgByte,cgUByte] then + Complex := true; +end; {Complex} + + +procedure DoOp(op_imm, op_abs, op_dir: integer; icode: icptr; disp: integer); + +{ Do an operation. } +{ } +{ Parameters: } +{ op_imm,op_abs,op_dir - op codes for the various } +{ addressing modes } +{ icode - intermediate code record } +{ disp - disp past the location (1 or 2) } + +var + val: integer; {value for immediate operations} + lval: longint; {long value for immediate operations} + +begin {DoOp} +if icode^.opcode = pc_ldc then begin + lval := icode^.lval; + if disp = 0 then + val := long(lval).lsw + else + val := long(lval).msw; + GenNative(op_imm, immediate, val, nil, 0); + end {if} +else if icode^.opcode in [pc_lod,pc_str] then + GenNative(op_dir, direct, LabelToDisp(icode^.r) + icode^.q + disp, nil, 0) +else {if icode^.opcode in [pc_ldo, pc_sro] then} + GenNative(op_abs, absolute, icode^.q + disp, icode^.lab, 0); +end; {DoOp} + + +procedure GetPointer (op: icptr); + +{ convert a tree into a usable pointer for indirect } +{ loads/stores } +{ } +{ parameters: } +{ op - pointer tree } + +begin {GetPointer} +gLong.preference := A_X+inPointer+localAddress+globalLabel; +GenTree(op); +if gLong.where = onStack then begin + GenImplied(m_pla); + GenImplied(m_plx); + gLong.where := A_X; + end; {if} +if gLong.where = A_X then begin + GenNative(m_sta_dir, direct, dworkLoc, nil, 0); + GenNative(m_stx_dir, direct, dworkLoc+2, nil, 0); + gLong.where := inPointer; + gLong.fixedDisp := true; + gLong.disp := dworkLoc; + end; {else if} +end; {GetPointer} + + +procedure IncAddr (size: integer); + +{ add a two byte constant to a four byte value - generally an } +{ address } +{ } +{ parameters: } +{ size - integer to add } + +var + lab1: integer; {branch point} + +begin {IncAddr} +if size <> 0 then + case gLong.where of + + onStack: begin + lab1 := GenLabel; + GenImplied(m_pla); + if size = 1 then begin + GenImplied(m_ina); + GenNative(m_bne, relative, lab1, nil, 0); + end {if} + else begin + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, size, nil, 0); + GenNative(m_bcc, relative, lab1, nil, 0); + end; {else} + GenImplied(m_plx); + GenImplied(m_inx); + GenImplied(m_phx); + GenLab(lab1); + GenImplied(m_pha); + end; + + A_X: begin + lab1 := GenLabel; + if size = 1 then begin + GenImplied(m_ina); + GenNative(m_bne, relative, lab1, nil, 0); + end {if} + else begin + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, size, nil, 0); + GenNative(m_bcc, relative, lab1, nil, 0); + end; {else} + GenImplied(m_inx); + GenLab(lab1); + end; + + inPointer: + if gLong.fixedDisp then begin + gLong.fixedDisp := false; + GenNative(m_ldy_imm, immediate, size, nil, 0); + end {if} + else if size <= 4 then begin + while size <> 0 do begin + GenImplied(m_iny); + size := size - 1; + end; {while} + end {else if} + else begin + GenImplied(m_tya); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, size, nil, 0); + GenImplied(m_tay); + end; {else} + + localAddress,globalLabel: + gLong.disp := gLong.disp+size; + + otherwise: + Error(cge1); + end; {case} +end; {IncAddr} + + +procedure LoadX (op: icptr); + +{ Load X with a two byte value } +{ } +{ parameters: } +{ op - value to load } + +var + q, r: integer; + lab: stringPtr; + +begin {LoadX} +q := op^.q; +r := op^.r; +lab := op^.lab; +case op^.opcode of + pc_lao,pc_lda: + Error(cge1); + pc_ldc: + GenNative(m_ldx_imm, immediate, q, nil, 0); + pc_ldo: + GenNative(m_ldx_abs, absolute, q, lab, 0); + pc_gli: begin + GenNative(m_ldx_abs, absolute, q, lab, 0); + GenNative(m_inc_abs, absolute, q, lab, 0); + end; {if} + pc_gil: begin + GenNative(m_inc_abs, absolute, q, lab, 0); + GenNative(m_ldx_abs, absolute, q, lab, 0); + end; {if} + pc_gld: begin + GenNative(m_ldx_abs, absolute, q, lab, 0); + GenNative(m_dec_abs, absolute, q, lab, 0); + end; {if} + pc_gdl: begin + GenNative(m_dec_abs, absolute, q, lab, 0); + GenNative(m_ldx_abs, absolute, q, lab, 0); + end; {if} + pc_lod: + GenNative(m_ldx_dir, direct, LabelToDisp(r) + q, nil, 0); + pc_lli: begin + GenNative(m_ldx_dir, direct, LabelToDisp(r), nil, 0); + GenNative(m_inc_dir, direct, LabelToDisp(r), nil, 0); + end; {if} + pc_lil: begin + GenNative(m_inc_dir, direct, LabelToDisp(r), nil, 0); + GenNative(m_ldx_dir, direct, LabelToDisp(r), nil, 0); + end; {if} + pc_lld: begin + GenNative(m_ldx_dir, direct, LabelToDisp(r), nil, 0); + GenNative(m_dec_dir, direct, LabelToDisp(r), nil, 0); + end; {if} + pc_ldl: begin + GenNative(m_dec_dir, direct, LabelToDisp(r), nil, 0); + GenNative(m_ldx_dir, direct, LabelToDisp(r), nil, 0); + end; {if} + otherwise: + Error(cge1); + end; {case} +end; {LoadX} + + +function NeedsCondition (opcode: pcodes): boolean; + +{ See if the operation is one that doesn't set the condition } +{ code reliably } +{ } +{ Parameters: } +{ opcodes - operation to check } +{ } +{ Returns: True if the condition code is not set properly for } +{ an operand type of cgByte,cgUByte,cgWord,cgUWord, else } +{ false } + +begin {NeedsCondition} +NeedsCondition := opcode in + [pc_and,pc_ior,pc_cui,pc_cup,pc_lor,pc_lnd,pc_ldl,pc_lil,pc_lld, + pc_lli,pc_gil,pc_gli,pc_gdl,pc_gld,pc_iil,pc_ili,pc_idl,pc_ild, + pc_cop,pc_cpo,pc_cpi,pc_dvi,pc_mpi,pc_adi,pc_sbi,pc_mod,pc_bno]; +end; {NeedsCondition} + + +function SameLoc (load, save: icptr): boolean; + +{ See if load and save represent the same location (which must } +{ be a direct page value or a global label). } +{ } +{ parameters: } +{ load - load operation } +{ save - save operation } +{ } +{ Returns: True the the same location is used, else false } + +begin {SameLoc} +SameLoc := false; +if save <> nil then begin + if load^.opcode = pc_lod then begin + if LabelToDisp(load^.r) + load^.q < 254 then + if save^.opcode = pc_str then + if save^.q = load^.q then + if save^.r = load^.r then + SameLoc := true; + end {if} + else if smallMemoryModel then + if load^.opcode = pc_ldo then + if save^.opcode = pc_sro then + if load^.lab^ = save^.lab^ then + if load^.q = save^.q then + SameLoc := true; + end; {if} +end; {SameLoc} + + +procedure SaveRetValue (optype: baseTypeEnum); + +{ save a value returned by a function } +{ } +{ parameters: } +{ optype - function type } + +begin {SaveRetValue} +if optype in [cgLong,cgULong] then begin + if (A_X & gLong.preference) = 0 then begin + gLong.where := onStack; + GenImplied(m_phx); + GenImplied(m_pha); + end + else + gLong.where := A_X; + end {if} +else if optype in [cgReal,cgDouble,cgExtended,cgComp] then + GenCall(8); +end; {SaveRetValue} + + +procedure GenAdlSbl (op, save: icptr); + +{ generate code for pc_adl, pc_sbl } +{ } +{ parameters: } +{ op - pc_adl or pc_sbl operation } +{ save - save location (pc_str or pc_sro) or nil } + +var + bcc,clc,adc_imm,inc_dir,adc_abs, {for op-code insensitive code} + adc_dir,inc_abs,adc_s: integer; + disp: integer; {direct page location} + lab1: integer; {label number} + lLong: longType; {used to reserve gLong} + nd: icptr; {for swapping left/right children} + opcode: pcodes; {temp storage; for efficiency} + simpleStore: boolean; {is the store absolute or direct?} + val: longint; {long constant value} + + + function Simple (icode: icptr): boolean; + + { See if the intermediate code is simple; i.e., can be } + { reached by direct page or absolute addressing. } + + var + load: icptr; {left opcode} + + begin {Simple} + Simple := false; + if icode^.opcode = pc_ldc then + Simple := true + else if icode^.opcode in [pc_lod,pc_str] then begin + if LabelToDisp(icode^.r) + icode^.q < 254 then + Simple := true; + end {else if} + else if icode^.opcode in [pc_ldo,pc_sro] then + Simple := smallMemoryModel; + end; {Simple} + + +begin {GenAdlSbl} +{determine where the result goes} +if save <> nil then + gLong.preference := + A_X+onStack+inPointer+localAddress+globalLabel+constant; +lLong := gLong; + +{set up the master instructions} +opcode := op^.opcode; +if opcode = pc_adl then begin + clc := m_clc; + bcc := m_bcc; + adc_imm := m_adc_imm; + adc_abs := m_adc_abs; + adc_dir := m_adc_dir; + adc_s := m_adc_s; + inc_dir := m_inc_dir; + inc_abs := m_inc_abs; + end {if} +else begin + clc := m_sec; + bcc := m_bcs; + adc_imm := m_sbc_imm; + adc_abs := m_sbc_abs; + adc_dir := m_sbc_dir; + adc_s := m_sbc_s; + inc_dir := m_dec_dir; + inc_abs := m_dec_abs; + end; {else} + +{if the lhs is a constant, swap the nodes} +if ((op^.left^.opcode = pc_ldc) and (opcode = pc_adl)) then begin + nd := op^.left; + op^.left := op^.right; + op^.right := nd; + end; {if} + +{handle a constant rhs} +if op^.right^.opcode = pc_ldc then + val := op^.right^.lval +else + val := -1; +if SameLoc(op^.left, save) and (long(val).msw = 0) then begin + lab1 := GenLabel; + if val = 1 then begin + if opcode = pc_adl then begin + DoOp(0, m_inc_abs, m_inc_dir, op^.left, 0); + GenNative(m_bne, relative, lab1, nil, 0); + DoOp(0, m_inc_abs, m_inc_dir, op^.left, 2); + GenLab(lab1); + end {if} + else {if opcode = pc_sbl then} begin + DoOp(m_lda_imm, m_lda_abs, m_lda_dir, op^.left, 0); + GenNative(m_beq, relative, lab1, nil, 0); + DoOp(0, m_dec_abs, m_dec_dir, op^.left, 0); + GenLab(lab1); + DoOp(0, m_dec_abs, m_dec_dir, op^.left, 2); + end; {else} + end {if} + else begin {rhs in [2..65535]} + GenImplied(clc); + DoOp(m_lda_imm, m_lda_abs, m_lda_dir, op^.left, 0); + GenNative(adc_imm, immediate, long(val).lsw, nil, 0); + DoOp(0, m_sta_abs, m_sta_dir, op^.left, 0); + GenNative(bcc, relative, lab1, nil, 0); + if opcode = pc_adl then + DoOp(0, m_inc_abs, m_inc_dir, op^.left, 2) + else + DoOp(0, m_dec_abs, m_dec_dir, op^.left, 2); + GenLab(lab1); + end; {else} + end {if constant rhs} + +else begin + simpleStore := false; + if save <> nil then + simpleStore := Simple(save); + if (opcode = pc_adl) and Simple(op^.left) then begin + nd := op^.left; + op^.left := op^.right; + op^.right := nd; + end; {if} + if simpleStore and Simple(op^.right) then begin + if Simple(op^.left) then begin + GenImplied(clc); + DoOp(m_lda_imm, m_lda_abs, m_lda_dir, op^.left, 0); + DoOp(adc_imm, adc_abs, adc_dir, op^.right, 0); + DoOp(0, m_sta_abs, m_sta_dir, save, 0); + DoOp(m_lda_imm, m_lda_abs, m_lda_dir, op^.left, 2); + DoOp(adc_imm, adc_abs, adc_dir, op^.right, 2); + DoOp(0, m_sta_abs, m_sta_dir, save, 2); + end {if} + else begin + gLong.preference := A_X; + GenTree(op^.left); + GenImplied(clc); + if gLong.where = onStack then + GenImplied(m_pla); + DoOp(adc_imm, adc_abs, adc_dir, op^.right, 0); + DoOp(0, m_sta_abs, m_sta_dir, save, 0); + if gLong.where = onStack then + GenImplied(m_pla) + else + GenImplied(m_txa); + DoOp(adc_imm, adc_abs, adc_dir, op^.right, 2); + DoOp(0, m_sta_abs, m_sta_dir, save, 2); + end; {else} + end {if} + else if Simple(op^.right) then begin + gLong.preference := gLong.preference & A_X; + GenTree(op^.left); + GenImplied(clc); + if gLong.where = onStack then begin + GenImplied(m_pla); + DoOp(adc_imm, adc_abs, adc_dir, op^.right, 0); + GenImplied(m_pha); + GenNative(m_lda_s, direct, 3, nil, 0); + DoOp(adc_imm, adc_abs, adc_dir, op^.right, 2); + GenNative(m_sta_s, direct, 3, nil, 0); + end {if} + else begin + DoOp(adc_imm, adc_abs, adc_dir, op^.right, 0); + GenImplied(m_tay); + GenImplied(m_txa); + DoOp(adc_imm, adc_abs, adc_dir, op^.right, 2); + GenImplied(m_tax); + GenImplied(m_tya); + end; {else} + end {else if} + else begin {doing it the hard way} + gLong.preference := onStack; + GenTree(op^.right); + gLong.preference := onStack; + GenTree(op^.left); + GenImplied(clc); + GenImplied(m_pla); + GenNative(adc_s, direct, 3, nil, 0); + GenNative(m_sta_s, direct, 3, nil, 0); + GenImplied(m_pla); + GenNative(adc_s, direct, 3, nil, 0); + GenNative(m_sta_s, direct, 3, nil, 0); + if save = nil then + gLong.where := onStack + else if save^.opcode = pc_str then begin + disp := LabelToDisp(save^.r) + save^.q; + if disp < 254 then begin + GenImplied(m_pla); + GenNative(m_sta_dir, direct, disp, nil, 0); + GenImplied(m_pla); + GenNative(m_sta_dir, direct, disp+2, nil, 0); + end {else if} + else begin + GenNative(m_ldx_imm, immediate, disp, nil, 0); + GenImplied(m_pla); + GenNative(m_sta_dirX, direct, 0, nil, 0); + GenImplied(m_pla); + GenNative(m_sta_dirX, direct, 2, nil, 0); + end; {else} + end {else if} + else {if save^.opcode = pc_sro then} begin + GenImplied(m_pla); + if smallMemoryModel then + GenNative(m_sta_abs, absolute, save^.q, save^.lab, 0) + else + GenNative(m_sta_long, longabsolute, save^.q, save^.lab, 0); + GenImplied(m_pla); + if smallMemoryModel then + GenNative(m_sta_abs, absolute, save^.q+2, save^.lab, 0) + else + GenNative(m_sta_long, longabsolute, save^.q+2, save^.lab, 0); + end; {else} + end; {else} + end; {else} +end; {GenAdlSbl} + + +procedure GenCmp (op: icptr; rOpcode: pcodes; lb: integer); + +{ generate code for pc_les, pc_leq, pc_grt or pc_geq } +{ } +{ parameters: } +{ op - operation } +{ rOpcode - Opcode that will use the result of the } +{ compare. If the result is used by a tjp or fjp, } +{ this procedure generated special code and does the } +{ branch internally. } +{ lb - For fjp, tjp, this is the label to branch to if } +{ the condition is satisfied. } + +var + i: integer; {loop variable} + lab1,lab2,lab3,lab4: integer; {label numbers} + num: integer; {constant to compare to} + + + procedure Switch; + + { switch the operands } + + var + nd: icptr; {used to switch nodes} + + begin {Switch} + nd := op^.left; + op^.left := op^.right; + op^.right := nd; + end; {Switch} + +begin {GenCmp} +{To reduct the number of possibilities that must be handled, pc_les } +{and pc_leq compares are reduced to their equivalent pc_grt and } +{pc_geq instructions. } +if op^.opcode = pc_les then begin + Switch; + op^.opcode := pc_grt; + end {if} +else if op^.opcode = pc_leq then begin + Switch; + op^.opcode := pc_geq; + end; {else if} + +{To take advantage of shortcuts, switch operands if generating } +{for a tjp or fjp with a constant left operand. } +if op^.optype in [cgByte,cgUByte,cgWord,cgUWord] then + if op^.left^.opcode = pc_ldc then + if rOpcode in [pc_tjp,pc_fjp] then begin + if op^.opcode = pc_geq then + op^.opcode := pc_grt + else + op^.opcode := pc_geq; + if rOpcode = pc_tjp then + rOpcode := pc_fjp + else + rOpcode := pc_tjp; + Switch; + end; {if} + +{Short cuts are available for single-word operands where the } +{right operand is a constant. } +if (op^.optype in [cgByte,cgUByte,cgWord,cgUWord]) and + (op^.right^.opcode = pc_ldc) then begin + GenTree(op^.left); + num := op^.right^.q; + lab1 := GenLabel; + if rOpcode = pc_fjp then begin + if op^.optype in [cgByte,cgWord] then begin + if NeedsCondition(op^.left^.opcode) then + GenImplied(m_tax); + if (num >= 0) and (num < 4) then begin + if op^.opcode = pc_geq then begin + if num <> 0 then begin + lab2 := GenLabel; + GenNative(m_bmi, relative, lab2, nil, 0); + for i := 1 to num do + GenImplied(m_dea); + end; {if} + GenNative(m_bpl, relative, lab1, nil, 0); + if num <> 0 then + GenLab(lab2); + GenNative(m_brl, longrelative, lb, nil, 0); + GenLab(lab1); + end {if} + else {if opcode = pc_grt then} begin + lab2 := GenLabel; + GenNative(m_bmi, relative, lab2, nil, 0); + for i := 0 to num do + GenImplied(m_dea); + GenNative(m_bpl, relative, lab1, nil, 0); + GenLab(lab2); + GenNative(m_brl, longrelative, lb, nil, 0); + GenLab(lab1); + end; {else if} + end {if (num >= 0) and (num < 4)} + else begin + lab2 := GenLabel; + if num > 0 then + GenNative(m_bmi, relative, lab1, nil, 0) + else + GenNative(m_bpl, relative, lab1, nil, 0); + GenNative(m_cmp_imm, immediate, num, nil, 0); + if op^.opcode = pc_grt then begin + lab3 := GenLabel; + GenNative(m_beq, relative, lab3, nil, 0); + GenNative(m_bcs, relative, lab2, nil, 0); + GenLab(lab3); + end + else + GenNative(m_bcs, relative, lab2, nil, 0); + if num > 0 then begin + GenLab(lab1); + GenNative(m_brl, longrelative, lb, nil, 0); + end {if} + else begin + GenNative(m_brl, longrelative, lb, nil, 0); + GenLab(lab1); + end; {else} + GenLab(lab2); + end; {else if} + end {if} + else {if optype in [cgUByte,cgUWord] then} begin + GenNative(m_cmp_imm, immediate, num, nil, 0); + if op^.opcode = pc_grt then begin + lab2 := GenLabel; + GenNative(m_beq, relative, lab2, nil, 0); + end; {if} + GenNative(m_bcs, relative, lab1, nil, 0); + if op^.opcode = pc_grt then + GenLab(lab2); + GenNative(m_brl, longrelative, lb, nil, 0); + GenLab(lab1); + end; {else} + end {if rOpcode = pc_fjp} + else if rOpcode = pc_tjp then begin + if op^.optype in [cgByte,cgWord] then begin + if NeedsCondition(op^.left^.opcode) then + GenImplied(m_tax); + if (num >= 0) and (num < 4) then begin + lab2 := GenLabel; + if op^.opcode = pc_geq then begin + GenNative(m_bmi, relative, lab1, nil, 0); + if num > 0 then begin + for i := 1 to num do + GenImplied(m_dea); + GenNative(m_bmi, relative, lab2, nil, 0); + end; {if} + GenNative(m_brl, longrelative, lb, nil, 0); + end {if} + else {if op^.opcode = pc_grt then} begin + if num > 0 then begin + GenNative(m_bmi, relative, lab1, nil, 0); + for i := 0 to num do + GenImplied(m_dea); + GenNative(m_bmi, relative, lab2, nil, 0); + end {if} + else begin + GenNative(m_beq, relative, lab1, nil, 0); + GenNative(m_bmi, relative, lab2, nil, 0); + end; {else} + GenNative(m_brl, longrelative, lb, nil, 0); + end; {else} + GenLab(lab2); + GenLab(lab1); + end {if (num >= 0) and (num < 4)} + else begin + lab2 := GenLabel; + if num > 0 then + GenNative(m_bmi, relative, lab1, nil, 0) + else + GenNative(m_bpl, relative, lab1, nil, 0); + GenNative(m_cmp_imm, immediate, num, nil, 0); + if op^.opcode = pc_grt then begin + lab3 := GenLabel; + GenNative(m_beq, relative, lab3, nil, 0); + end; {if} + GenNative(m_bcc, relative, lab2, nil, 0); + if num > 0 then begin + GenNative(m_brl, longrelative, lb, nil, 0); + GenLab(lab2); + GenLab(lab1); + end {if} + else begin + GenLab(lab1); + GenNative(m_brl, longrelative, lb, nil, 0); + GenLab(lab2); + end; {else} + if op^.opcode = pc_grt then + GenLab(lab3); + end; {else} + end {if} + else {if optype in [cgUByte,cgUWord] then} begin + GenNative(m_cmp_imm, immediate, num, nil, 0); + GenNative(m_bcc, relative, lab1, nil, 0); + if op^.opcode = pc_grt then begin + lab2 := GenLabel; + GenNative(m_beq, relative, lab1, nil, 0); + end; {if} + GenNative(m_brl, longrelative, lb, nil, 0); + if op^.opcode = pc_grt then + GenLab(lab2); + GenLab(lab1); + end; {else} + end {if rOpcode = pc_tjp} + else if op^.optype in [cgByte,cgWord] then begin + lab2 := GenLabel; + GenNative(m_ldx_imm, immediate, 1, nil, 0); + GenImplied(m_sec); + GenNative(m_sbc_imm, immediate, num, nil, 0); + if op^.opcode = pc_grt then begin + lab3 := GenLabel; + GenNative(m_beq, relative, lab3, nil, 0); + end; {if} + GenNative(m_bvs, relative, lab1, nil, 0); + GenNative(m_eor_imm, immediate, $8000, nil, 0); + GenLab(lab1); + GenNative(m_bmi, relative, lab2, nil, 0); + if op^.opcode = pc_grt then + GenLab(lab3); + GenImplied(m_dex); + GenLab(lab2); + GenImplied(m_txa); + end {else if} + else begin + GenNative(m_ldx_imm, immediate, 0, nil, 0); + GenNative(m_cmp_imm, immediate, num, nil, 0); + GenNative(m_bcc, relative, lab1, nil, 0); + if op^.opcode = pc_grt then + GenNative(m_beq, relative, lab1, nil, 0); + GenImplied(m_inx); + GenLab(lab1); + GenImplied(m_txa); + end; {else if} + end {if (op^.optype in [cgByte,cgUByte,cgWord,cgUWord]) and + (op^.right^.opcode = pc_ldc)} + +{This section of code handles the cases where the above short } +{cuts cannot be used. } +else + case op^.optype of + + cgByte,cgUByte,cgWord,cgUWord: begin + if Complex(op^.right) then begin + GenTree(op^.right); + if Complex(op^.left) then begin + GenImplied(m_pha); + GenTree(op^.left); + GenImplied(m_ply); + GenNative(m_sty_dir, direct, dworkLoc, nil, 0); + end {if} + else begin + GenNative(m_sta_dir, direct, dworkLoc, nil, 0); + GenTree(op^.left); + end; {else} + if not (rOpcode in [pc_fjp,pc_tjp]) then + GenNative(m_ldx_imm, immediate, 1, nil, 0); + if op^.optype in [cgByte,cgWord] then begin + GenImplied(m_sec); + GenNative(m_sbc_dir, direct, dworkLoc, nil, 0); + end {if} + else + GenNative(m_cmp_dir, direct, dworkLoc, nil, 0); + end {if} + else begin + GenTree(op^.left); + if not (rOpcode in [pc_fjp,pc_tjp]) then + GenNative(m_ldx_imm, immediate, 1, nil, 0); + if op^.optype in [cgByte,cgWord] then begin + GenImplied(m_sec); + OperA(m_sbc_imm, op^.right); + if op^.right^.opcode in [pc_lld,pc_lli,pc_gli,pc_gld] then + GenImplied(m_tay); + end {if} + else + OperA(m_cmp_imm, op^.right); + end; {else} + if rOpcode = pc_fjp then begin + lab2 := GenLabel; + if op^.opcode = pc_grt then begin + lab3 := GenLabel; + GenNative(m_beq, relative, lab3, nil, 0); + end; {if} + if op^.optype in [cgByte,cgWord] then begin + lab1 := GenLabel; + GenNative(m_bvs, relative, lab1, nil, 0); + GenNative(m_eor_imm, immediate, $8000, nil, 0); + GenLab(lab1); + GenNative(m_bmi, relative, lab2, nil, 0); + end {if} + else + GenNative(m_bcs, relative, lab2, nil, 0); + if op^.opcode = pc_grt then + GenLab(lab3); + GenNative(m_brl, longrelative, lb, nil, 0); + GenLab(lab2); + end {if} + else if rOpcode = pc_tjp then begin + lab2 := GenLabel; + if op^.opcode = pc_grt then begin + lab3 := GenLabel; + GenNative(m_beq, relative, lab3, nil, 0); + end; {if} + if op^.optype in [cgByte,cgWord] then begin + lab1 := GenLabel; + GenNative(m_bvs, relative, lab1, nil, 0); + GenNative(m_eor_imm, immediate, $8000, nil, 0); + GenLab(lab1); + GenNative(m_bpl, relative, lab2, nil, 0); + end {if} + else + GenNative(m_bcc, relative, lab2, nil, 0); + GenNative(m_brl, longrelative, lb, nil, 0); + if op^.opcode = pc_grt then + GenLab(lab3); + GenLab(lab2); + end {else if} + else begin + lab2 := GenLabel; + if op^.opcode = pc_grt then begin + lab3 := GenLabel; + GenNative(m_beq, relative, lab3, nil, 0); + end; {if} + if op^.optype in [cgByte,cgWord] then begin + lab1 := GenLabel; + GenNative(m_bvs, relative, lab1, nil, 0); + GenNative(m_eor_imm, immediate, $8000, nil, 0); + GenLab(lab1); + GenNative(m_bmi, relative, lab2, nil, 0); + end {if} + else + GenNative(m_bcs, relative, lab2, nil, 0); + if op^.opcode = pc_grt then + GenLab(lab3); + GenImplied(m_dex); + GenLab(lab2); + GenImplied(m_txa); + end; {else} + end; {case optype of cgByte,cgUByte,cgWord,cgUWord} + + cgULong: begin + gLong.preference := onStack; + GenTree(op^.right); + gLong.preference := A_X; + GenTree(op^.left); + if gLong.where = onStack then begin + GenImplied(m_ply); + GenImplied(m_pla); + end {if} + else begin + GenImplied(m_tay); + GenImplied(m_txa); + end; {else} + lab1 := GenLabel; + GenNative(m_ldx_imm, immediate, 1, nil, 0); + GenNative(m_cmp_s, direct, 3, nil, 0); + GenNative(m_bne, relative, lab1, nil, 0); + GenImplied(m_tya); + GenNative(m_cmp_s, direct, 1, nil, 0); + GenLab(lab1); + lab2 := GenLabel; + if op^.opcode = pc_grt then begin + lab3 := GenLabel; + GenNative(m_beq, relative, lab3, nil, 0); + end; {if} + GenNative(m_bcs, relative, lab2, nil, 0); + if op^.opcode = pc_grt then + GenLab(lab3); + GenImplied(m_dex); + GenLab(lab2); + GenImplied(m_pla); + GenImplied(m_pla); + GenImplied(m_txa); + if rOpcode = pc_fjp then begin + lab4 := GenLabel; + GenNative(m_bne, relative, lab4, nil, 0); + GenNative(m_brl, longrelative, lb, nil, 0); + GenLab(lab4); + end {if} + else if rOpcode = pc_tjp then begin + lab4 := GenLabel; + GenNative(m_beq, relative, lab4, nil, 0); + GenNative(m_brl, longrelative, lb, nil, 0); + GenLab(lab4); + end; {else if} + end; + + cgReal,cgDouble,cgComp,cgExtended: begin + GenTree(op^.left); + GenTree(op^.right); + num := 31; + if op^.opcode = pc_geq then + GenCall(32) + else + GenCall(31); + if (rOpcode = pc_fjp) or (rOpcode = pc_tjp) then begin + lab1 := GenLabel; + if rOpcode = pc_fjp then + GenNative(m_bne, relative, lab1, nil, 0) + else + GenNative(m_beq, relative, lab1, nil, 0); + GenNative(m_brl,longrelative,lb,nil,0); + GenLab(lab1); + end; {if} + end; {case optype of cgReal..cgExtended} + + cgLong: begin + gLong.preference := onStack; + GenTree(op^.left); + if op^.opcode = pc_geq then begin + gLong.preference := A_X; + GenTree(op^.right); + if gLong.where = onStack then begin + GenImplied(m_pla); + GenImplied(m_plx); + end; {if} + num := 30; + end {if} + else begin + gLong.preference := onStack; + GenTree(op^.right); + num := 29; + end; {else} + GenCall(num); + if (rOpcode = pc_fjp) or (rOpcode = pc_tjp) then begin + lab1 := GenLabel; + if rOpcode = pc_fjp then + GenNative(m_bne, relative, lab1, nil, 0) + else + GenNative(m_beq, relative, lab1, nil, 0); + GenNative(m_brl, longrelative, lb, nil, 0); + GenLab(lab1); + end; {if} + end; {case optype of cgLong} + + otherwise: + Error(cge1); + end; {case} +end; {GenCmp} + + +procedure GenCnv (op: icptr); + +{ generate a pc_cnv instruction } + +const {note: these constants list all legal } + { conversions; others are ignored} + cReal = $06; + cDouble = $07; + cComp = $08; + cExtended = $09; + cVoid = $0B; + + byteToWord = $02; + byteToUword = $03; + byteToLong = $04; + byteToUlong = $05; + byteToReal = $06; + byteToDouble = $07; + ubyteToLong = $14; + ubyteToUlong = $15; + ubyteToReal = $16; + ubyteToDouble = $17; + wordToByte = $20; + wordToUByte = $21; + wordToLong = $24; + wordToUlong = $25; + wordToReal = $26; + wordToDouble = $27; + uwordToByte = $30; + uwordToUByte = $31; + uwordToLong = $34; + uwordToUlong = $35; + uwordToReal = $36; + uwordToDouble = $37; + longTobyte = $40; + longToUbyte = $41; + longToWord = $42; + longToUword = $43; + longToReal = $46; + longToDouble = $47; + longToVoid = $4B; + ulongTobyte = $50; + ulongToUbyte = $51; + ulongToWord = $52; + ulongToUword = $53; + ulongToReal = $56; + ulongToDouble = $57; + ulongToVoid = $5B; + realTobyte = $60; + realToUbyte = $61; + realToWord = $62; + realToUword = $63; + realToLong = $64; + realToUlong = $65; + realToVoid = $6B; + doubleTobyte = $70; + doubleToUbyte = $71; + doubleToWord = $72; + doubleToUword = $73; + doubleToLong = $74; + doubleToUlong = $75; + +var + fromReal: boolean; {are we converting from a real?} + lab1: integer; {used for branches} + lLong: longType; {used to reserve gLong} + +begin {GenCnv} +lLong := gLong; +gLong.preference := onStack+A_X+constant; +gLong.where := onStack; +if ((op^.q & $00F0) >> 4) in [cDouble,cExtended,cComp] then begin + op^.q := (op^.q & $000F) | (cReal * 16); + fromReal := true; + end {if} +else + fromReal := false; +if (op^.q & $000F) in [cDouble,cExtended,cComp] then + op^.q := (op^.q & $00F0) | cReal; +GenTree(op^.left); +if op^.q in [wordToLong,wordToUlong] then begin + lab1 := GenLabel; + GenNative(m_ldx_imm, immediate, 0, nil, 0); + GenImplied(m_tay); + GenNative(m_bpl, relative, lab1, nil, 0); + GenImplied(m_dex); + GenLab(lab1); + if (lLong.preference & A_X) <> 0 then + gLong.where := A_X + else begin + gLong.where := onStack; + GenImplied(m_phx); + GenImplied(m_pha); + end; {else} + end {if} +else if op^.q in [byteToLong,byteToUlong] then begin + lab1 := GenLabel; + GenNative(m_ldx_imm, immediate, 0, nil, 0); + GenNative(m_bit_imm, immediate, $0080, nil, 0); + GenNative(m_beq, relative, lab1, nil, 0); + GenImplied(m_dex); + GenNative(m_ora_imm, immediate, $FF00, nil, 0); + GenLab(lab1); + if (lLong.preference & A_X) <> 0 then + gLong.where := A_X + else begin + gLong.where := onStack; + GenImplied(m_phx); + GenImplied(m_pha); + end; {else} + end {if} +else if op^.q in [byteToWord,byteToUword] then begin + lab1 := GenLabel; + GenNative(m_bit_imm, immediate, $0080, nil, 0); + GenNative(m_beq, relative, lab1, nil, 0); + GenNative(m_ora_imm, immediate, $FF00, nil, 0); + GenLab(lab1); + end {if} +else if op^.q in [ubyteToLong,ubyteToUlong,uwordToLong,uwordToUlong] then + begin + if (lLong.preference & A_X) <> 0 then begin + gLong.where := A_X; + GenNative(m_ldx_imm, immediate, 0, nil, 0); + end {if} + else begin + gLong.where := onStack; + GenNative(m_pea, immediate, 0, nil, 0); + GenImplied(m_pha); + end; {else} + end {else if} +else if op^.q in [wordToByte,wordToUbyte,uwordToByte,uwordToUbyte] then + GenNative(m_and_imm, immediate, $00FF, nil, 0) +else if op^.q in [byteToReal,uByteToReal,wordToReal] then + GenCall(11) +else if op^.q = uwordToReal then begin + GenNative(m_ldx_imm, immediate, 0, nil, 0); + GenCall(12); + end {else if} +else if op^.q in [longToByte,longToUbyte,ulongToByte,ulongToUbyte] then begin + if gLong.where = A_X then + GenNative(m_and_imm, immediate, $00FF, nil, 0) + else if gLong.where = constant then + GenNative(m_lda_imm, immediate, long(gLong.lval).lsw & $00FF, nil, 0) + else {if gLong.where = onStack then} begin + GenImplied(m_pla); + GenImplied(m_plx); + GenNative(m_and_imm, immediate, $00FF, nil, 0); + end; {else if} + end {else if} +else if op^.q in [longToWord,longToUword,ulongToWord,ulongToUword] then begin + {Note: if the result is in A_X, no further action is needed} + if gLong.where = constant then + GenNative(m_lda_imm, immediate, long(gLong.lval).lsw, nil, 0) + else if gLong.where = onStack then begin + GenImplied(m_pla); + GenImplied(m_plx); + end; {else if} + end {else if} +else if op^.q in [longToReal,uLongToReal] then begin + if gLong.where = constant then begin + GenNative(m_lda_imm, immediate, long(gLong.lval).lsw, nil, 0); + GenNative(m_ldx_imm, immediate, long(gLong.lval).msw, nil, 0); + end {if} + else if gLong.where = onStack then begin + GenImplied(m_pla); + GenImplied(m_plx); + end; {else if} + if op^.q = longToReal then + GenCall(12) + else + GenCall(13); + end {else} +else if op^.q in [realToByte,realToUbyte,realToWord] then begin + GenCall(14); + if (op^.q & $00FF) in [0,1] then + GenNative(m_and_imm, immediate, $00FF, nil, 0); + end {else if} +else if op^.q = realToUword then + GenCall(15) +else if op^.q in [realToLong,realToUlong] then begin + if op^.q & $00FF = 5 then + GenCall(17) + else + GenCall(16); + if (lLong.preference & A_X) <> 0 then + gLong.where := A_X + else begin + gLong.where := onStack; + GenImplied(m_phx); + GenImplied(m_pha); + end; {else} + end {else if} +else if op^.q = realToVoid then begin + GenImplied(m_tsc); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, 10, nil, 0); + GenImplied(m_tcs); + end {else if} +else if op^.q in [longToVoid,ulongToVoid] then begin + if gLong.where = onStack then begin + GenImplied(m_pla); + GenImplied(m_plx); + gLong.where := A_X; + end; {if} + end {else if} +else if (op^.q & $000F) = cVoid then + {do nothing} +else if lLong.preference & gLong.where = 0 then begin + if gLong.where = constant then begin + GenNative(m_pea, immediate, long(gLong.lval).msw, nil, 0); + GenNative(m_pea, immediate, long(gLong.lval).lsw, nil, 0); + end {if} + else if gLong.where = A_X then begin + GenImplied(m_phx); + GenImplied(m_pha); + end; {else if} + gLong.where := onStack; + end; {else if} +end; {GenCnv} + + +procedure GenEquNeq (op: icptr; opcode: pcodes; lb: integer); + +{ generate a pc_equ or pc_neq instruction } +{ } +{ parameters: } +{ op - node to generate the compare for } +{ opcode - Opcode that will use the result of the compare. } +{ If the result is used by a tjp or fjp, this procedure } +{ generates special code and does the branch internally. } +{ lb - For fjp, tjp, this is the label to branch to if } +{ the condition is satisfied. } + +var + nd: icptr; {work node} + num: integer; {constant to compare to} + lab1,lab2: integer; {label numbers} + bne: integer; {instruction for a pc_equ bne branch} + beq: integer; {instruction for a pc_equ beq branch} + lLong: longType; {local long value information} + leftOp,rightOp: pcodes; {opcode codes to left, right} + + + procedure DoOr (op: icptr); + + { or the two halves of a four byte value } + { } + { parameters: } + { operand to or } + + var + disp: integer; {disp of value on stack frame} + + begin {DoOr} + with op^ do begin + if opcode = pc_ldo then begin + GenNative(m_lda_abs, absolute, q, lab, 0); + GenNative(m_ora_abs, absolute, q+2, lab, 0); + end {if} + else begin + disp := LabelToDisp(r) + q; + if disp < 254 then begin + GenNative(m_lda_dir, direct, disp, nil, 0); + GenNative(m_ora_dir, direct, disp+2, nil, 0); + end {else if} + else begin + GenNative(m_ldx_imm, immediate, disp, nil, 0); + GenNative(m_lda_dirX, direct, 0, nil, 0); + GenNative(m_ora_dirX, direct, 2, nil, 0); + end; {else} + end; {else} + end; {with} + end; {DoOr} + + + procedure DoCmp (op: icPtr); + + { compare a long value in A_X to a local or global scalar } + { } + { parameters: } + { op - value to compare to } + + var + disp: integer; {disp of value on stack frame} + lab1: integer; {label numbers} + + begin {DoCmp} + lab1 := GenLabel; + with op^ do begin + if opcode = pc_ldo then begin + GenNative(m_cmp_abs, absolute, q, lab, 0); + GenNative(m_bne, relative, lab1, nil, 0); + GenNative(m_cpx_abs, absolute, q+2, lab, 0); + end {if} + else begin + disp := LabelToDisp(r) + q; + if disp < 254 then begin + GenNative(m_cmp_dir, direct, disp, nil, 0); + GenNative(m_bne, relative, lab1, nil, 0); + GenNative(m_cpx_dir, direct, disp+2, nil, 0); + end {if} + else begin + GenImplied(m_txy); + GenNative(m_ldx_imm, immediate, disp, nil, 0); + GenNative(m_cmp_dirX, direct, 0, nil, 0); + GenNative(m_bne, relative, lab1, nil, 0); + GenImplied(m_tya); + GenNative(m_cmp_dirX, direct, 2, nil, 0); + end; {else} + end; {else} + GenLab(lab1); + end; {with} + end; {DoCmp} + + +begin {GenEquNeq} +if op^.opcode = pc_equ then begin + bne := m_bne; + beq := m_beq; + end {if} +else begin + bne := m_beq; + beq := m_bne; + end; {else} +if op^.left^.opcode in [pc_lod,pc_ldo] then begin + nd := op^.left; + op^.left := op^.right; + op^.right := nd; + end; {if} +if op^.left^.opcode = pc_ldc then begin + nd := op^.left; + op^.left := op^.right; + op^.right := nd; + end; {if} +leftOp := op^.left^.opcode; {set op codes for fast access} +rightOp := op^.right^.opcode; +if (op^.optype in [cgByte,cgUByte,cgWord,cgUWord]) and + (rightOp = pc_ldc) then begin + GenTree(op^.left); + num := op^.right^.q; + lab1 := GenLabel; + if opcode in [pc_fjp,pc_tjp] then begin + if num <> 0 then + GenNative(m_cmp_imm, immediate, num, nil, 0) + else if NeedsCondition(leftOp) then + GenImplied(m_tay); + if opcode = pc_fjp then + GenNative(beq, relative, lab1, nil, 0) + else + GenNative(bne, relative, lab1, nil, 0); + GenNative(m_brl, longrelative, lb, nil, 0); + GenLab(lab1); + end {if} + else begin + GenNative(m_ldx_imm, immediate, 0, nil, 0); + GenNative(m_cmp_imm, immediate, num, nil, 0); + GenNative(bne, relative, lab1, nil, 0); + GenImplied(m_inx); + GenLab(lab1); + GenImplied(m_txa); + end; {else} + end {if} +else if (op^.optype in [cgLong,cgULong]) and (leftOp in [pc_ldo,pc_lod]) + and (rightOp = pc_ldc) and (op^.right^.lval = 0) then begin + if opcode in [pc_fjp,pc_tjp] then begin + DoOr(op^.left); + lab1 := GenLabel; + if opcode = pc_fjp then + GenNative(beq, relative, lab1, nil, 0) + else + GenNative(bne, relative, lab1, nil, 0); + GenNative(m_brl, longrelative, lb, nil, 0); + GenLab(lab1); + end {if} + else if op^.opcode = pc_equ then begin + lab1 := GenLabel; + lab2 := GenLabel; + DoOr(op^.left); + GenNative(bne, relative, lab1, nil, 0); + GenNative(m_lda_imm, immediate, 1, nil, 0); + GenNative(m_bra, relative, lab2, nil, 0); + GenLab(lab1); + GenNative(m_lda_imm, immediate, 0, nil, 0); + GenLab(lab2); + end {else if} + else {if op^.opcode = pc_neq then} begin + lab1 := GenLabel; + DoOr(op^.left); + GenNative(m_beq, relative, lab1, nil, 0); + GenNative(m_lda_imm, immediate, 1, nil, 0); + GenLab(lab1); + end; {else if} + end {else if} +else if (op^.optype in [cgLong,cgULong]) and (rightOp in [pc_ldo,pc_lod]) then begin + gLong.preference := A_X; + GenTree(op^.left); + if gLong.where = onStack then begin + GenImplied(m_pla); + GenImplied(m_plx); + end; {if} + if opcode in [pc_fjp,pc_tjp] then begin + DoCmp(op^.right); + lab1 := GenLabel; + if opcode = pc_fjp then + GenNative(beq, relative, lab1, nil, 0) + else + GenNative(bne, relative, lab1, nil, 0); + GenNative(m_brl, longrelative, lb, nil, 0); + GenLab(lab1); + end {if} + else begin + lab1 := GenLabel; + lab2 := GenLabel; + DoCmp(op^.right); + GenNative(bne, relative, lab1, nil, 0); + GenNative(m_lda_imm, immediate, 1, nil, 0); + GenNative(m_bra, relative, lab2, nil, 0); + GenLab(lab1); + GenNative(m_lda_imm, immediate, 0, nil, 0); + GenLab(lab2); + end; {else} + end {else if} +else + case op^.optype of + + cgByte,cgUByte,cgWord,cgUWord: begin + if not Complex(op^.left) then + if Complex(op^.right) then begin + nd := op^.left; + op^.left := op^.right; + op^.right := nd; + end; {if} + GenTree(op^.left); + if Complex(op^.right) or (not (opcode in [pc_fjp,pc_tjp])) then begin + GenImplied(m_pha); + GenTree(op^.right); + GenImplied(m_sec); + GenNative(m_sbc_s, direct, 1, nil, 0); + GenImplied(m_plx); + GenImplied(m_tax); + if opcode in [pc_fjp,pc_tjp] then begin + lab1 := GenLabel; + if opcode = pc_fjp then + GenNative(beq, relative, lab1, nil, 0) + else + GenNative(bne, relative, lab1, nil, 0); + GenNative(m_brl, longrelative, lb, nil, 0); + GenLab(lab1); + end {if} + else begin + lab1 := GenLabel; + GenNative(m_beq, relative, lab1, nil, 0); + GenNative(m_lda_imm, immediate, 1, nil, 0); + GenLab(lab1); + if op^.opcode = pc_equ then + GenNative(m_eor_imm, immediate, 1, nil, 0); + end; {else} + end {if} + else begin + OperA(m_cmp_imm, op^.right); + lab1 := GenLabel; + if opcode = pc_fjp then + GenNative(beq, relative, lab1, nil, 0) + else + GenNative(bne, relative, lab1, nil, 0); + GenNative(m_brl, longrelative, lb, nil, 0); + GenLab(lab1); + end; {else} + end; {case optype of cgByte,cgUByte,cgWord,cgUWord} + + cgLong,cgULong: begin + gLong.preference := onStack; + GenTree(op^.left); + lLong := gLong; + gLong.preference := A_X; + GenTree(op^.right); + if gLong.where = onStack then begin + GenImplied(m_pla); + GenImplied(m_plx); + end; {if} + GenNative(m_ldy_imm, immediate, 1, nil, 0); + GenNative(m_cmp_s, direct, 1, nil, 0); + lab1 := GenLabel; + GenNative(m_beq, relative, lab1, nil, 0); + GenImplied(m_dey); + GenLab(lab1); + GenImplied(m_txa); + GenNative(m_cmp_s, direct, 3, nil, 0); + lab1 := GenLabel; + GenNative(m_beq, relative, lab1, nil, 0); + GenNative(m_ldy_imm, immediate, 0, nil, 0); + GenLab(lab1); + GenImplied(m_pla); + GenImplied(m_pla); + GenImplied(m_tya); + if opcode in [pc_fjp,pc_tjp] then begin + lab1 := GenLabel; + if opcode = pc_fjp then + GenNative(bne, relative, lab1, nil, 0) + else + GenNative(beq, relative, lab1, nil, 0); + GenNative(m_brl, longrelative, lb, nil, 0); + GenLab(lab1); + end {if} + else if op^.opcode = pc_neq then + GenNative(m_eor_imm, immediate, 1, nil, 0); + end; {case optype of cgLong,cgULong} + + cgReal,cgDouble,cgComp,cgExtended: begin + GenTree(op^.left); + GenTree(op^.right); + GenCall(36); + if opcode in [pc_fjp,pc_tjp] then begin + lab1 := GenLabel; + if opcode = pc_fjp then + GenNative(bne, relative, lab1, nil, 0) + else + GenNative(beq, relative, lab1, nil, 0); + GenNative(m_brl, longrelative, lb, nil, 0); + GenLab(lab1); + end {if} + else if op^.opcode = pc_neq then + GenNative(m_eor_imm, immediate, 1, nil, 0); + end; {case optype of cgReal..cgExtended,cgSet,cgString} + + otherwise: + Error(cge1); + end; {case} +end; {GenEquNeq} + + +procedure GenGilGliGdlGld (op: icptr); + +{ Generate code for a pc_gil, pc_gli, pc_gdl or pc_gld } + +var + lab1: integer; {branch point} + lab: stringPtr; {op^.lab} + opcode: pcodes; {op^.opcode} + q: integer; {op^.q} + + + procedure DoGIncDec (opcode: pcodes; lab: stringPtr; p, q: integer); + + { Do a decrement or increment on a global four byte value } + { } + { parameters } + { opcode - operation code } + { lab - label } + { q - disp to value } + { p - number to ind/dec by } + + var + lab1: integer; {branch point} + + begin {DoGIncDec} + if smallMemoryModel then begin + if opcode in [pc_gil,pc_gli] then begin + lab1 := GenLabel; + if p = 1 then begin + GenNative(m_inc_abs, absolute, q, lab, 0); + GenNative(m_bne, relative, lab1, nil, 0); + end {if} + else begin + GenImplied(m_clc); + GenNative(m_lda_abs, absolute, q, lab, 0); + GenNative(m_adc_imm, immediate, p, nil, 0); + GenNative(m_sta_abs, absolute, q, lab, 0); + GenNative(m_bcc, relative, lab1, nil, 0); + end; {else} + GenNative(m_inc_abs, absolute, q+2, lab, 0); + GenLab(lab1); + end {if} + else {if opcode in [pc_gdl,pc_gld] then} begin + lab1 := GenLabel; + if p = 1 then begin + GenNative(m_lda_abs, absolute, q, lab, 0); + GenNative(m_bne, relative, lab1, nil, 0); + GenNative(m_dec_abs, absolute, q+2, lab, 0); + GenLab(lab1); + GenNative(m_dec_abs, absolute, q, lab, 0); + end {if} + else begin + GenImplied(m_sec); + GenNative(m_lda_abs, absolute, q, lab, 0); + GenNative(m_sbc_imm, immediate, p, nil, 0); + GenNative(m_sta_abs, absolute, q, lab, 0); + GenNative(m_bcs, relative, lab1, nil, 0); + GenNative(m_dec_abs, absolute, q+2, lab, 0); + GenLab(lab1); + end; {else} + end {else} + end {of smallMemoryModel} + else begin + if opcode in [pc_gil,pc_gli] then begin + lab1 := GenLabel; + GenImplied(m_clc); + GenNative(m_lda_long, longabsolute, q, lab, 0); + GenNative(m_adc_imm, immediate, p, nil, 0); + GenNative(m_sta_long, longabsolute, q, lab, 0); + GenNative(m_bcc, relative, lab1, nil, 0); + GenNative(m_lda_long, longabsolute, q+2, lab, 0); + GenImplied(m_ina); + GenNative(m_sta_long, longabsolute, q+2, lab, 0); + GenLab(lab1); + end {if} + else {if opcode in [pc_gdl,pc_gld] then} begin + lab1 := GenLabel; + GenImplied(m_sec); + GenNative(m_lda_long, longabsolute, q, lab, 0); + GenNative(m_sbc_imm, immediate, p, nil, 0); + GenNative(m_sta_long, longabsolute, q, lab, 0); + GenNative(m_bcs, relative, lab1, nil, 0); + GenNative(m_lda_long, longabsolute, q+2, lab, 0); + GenImplied(m_dea); + GenNative(m_sta_long, longabsolute, q+2, lab, 0); + GenLab(lab1); + end; {else if} + end; {else} + end; {DoGIncDec} + + +begin {GenGilGliGdlGld} +opcode := op^.opcode; +q := op^.q; +lab := op^.lab; +case op^.optype of + cgWord, cgUWord: begin + if opcode = pc_gil then + GenNative(m_inc_abs, absolute, q, lab, 0) + else if opcode = pc_gdl then + GenNative(m_dec_abs, absolute, q, lab, 0); + if not skipLoad then + GenNative(m_lda_abs, absolute, q, lab, 0); + if opcode = pc_gli then + GenNative(m_inc_abs, absolute, q, lab, 0) + else if opcode = pc_gld then + GenNative(m_dec_abs, absolute, q, lab, 0); + end; + + cgByte, cgUByte: begin + GenNative(m_sep, immediate, 32, nil, 0); + if opcode = pc_gil then + GenNative(m_inc_abs, absolute, q, lab, 0) + else if opcode = pc_gdl then + GenNative(m_dec_abs, absolute, q, lab, 0); + if not skipLoad then + GenNative(m_lda_abs, absolute, q, lab, 0); + if opcode = pc_gli then + GenNative(m_inc_abs, absolute, q, lab, 0) + else if opcode = pc_gld then + GenNative(m_dec_abs, absolute, q, lab, 0); + GenNative(m_rep, immediate, 32, nil, 0); + if not skipLoad then begin + GenNative(m_and_imm, immediate, 255, nil, 0); + if op^.optype = cgByte then begin + GenNative(m_bit_imm, immediate, $0080, nil, 0); + lab1 := GenLabel; + GenNative(m_beq, relative, lab1, nil, 0); + GenNative(m_ora_imm, immediate, $FF00, nil, 0); + GenLab(lab1); + GenNative(m_cmp_imm, immediate, $0000, nil, 0); + end; {if} + end; {if} + end; + + cgLong, cgULong: begin + if (A_X & gLong.preference) <> 0 then + gLong.where := A_X + else + gLong.where := onStack; + if opcode in [pc_gil,pc_gdl] then + DoGIncDec(opcode, lab, op^.r, q); + if not skipLoad then + if smallMemoryModel then begin + GenNative(m_ldx_abs, absolute, q+2, lab, 0); + GenNative(m_lda_abs, absolute, q, lab, 0); + if (opcode in [pc_gli,pc_gld]) and (op^.r <> 1) then + gLong.where := onStack; + if gLong.where = onStack then begin + GenImplied(m_phx); + GenImplied(m_pha); + end; {if} + end {if} + else begin + if opcode in [pc_gli,pc_gld] then + gLong.where := onStack; + GenNative(m_lda_long, longabsolute, q+2, lab, 0); + if gLong.where = onStack then + GenImplied(m_pha) + else + GenImplied(m_tax); + GenNative(m_lda_long, longabsolute, q, lab, 0); + if gLong.where = onStack then + GenImplied(m_pha); + end; {else} + if opcode in [pc_gli,pc_gld] then + DoGIncDec(opcode, lab, op^.r, q); + end; {case cgLong,cgULong} + + otherwise: + Error(cge1); + end; {case} +end; {GenGilGliGdlGld} + + +procedure GenIilIliIdlIld (op: icptr); + +{ Generate code for a pc_iil, pc_ili, pc_idl or pc_ild } + +var + i: integer; {index variable} + lab1: integer; {label} + lSkipLoad: boolean; {copy of skipLoad} + opcode: pcodes; {op^.opcode} + short: boolean; {doing a one byte operand?} + +begin {GenIilIliIdlIld} +opcode := op^.opcode; +case op^.optype of + cgByte,cgUByte,cgWord,cgUWord: begin + short := op^.optype in [cgByte,cgUByte]; + lSkipLoad := skipLoad; + skipLoad := false; + GetPointer(op^.left); + skipLoad := lSkipLoad; + if gLong.where = inPointer then begin + if short then + GenNative(m_sep, immediate, 32, nil, 0); + if gLong.fixedDisp then + GenNative(m_lda_indl, direct, gLong.disp, nil, 0) + else + GenNative(m_lda_indly, direct, gLong.disp, nil, 0); + if opcode in [pc_ili,pc_iil] then + GenImplied(m_ina) + else + GenImplied(m_dea); + if gLong.fixedDisp then + GenNative(m_sta_indl, direct, gLong.disp, nil, 0) + else + GenNative(m_sta_indly, direct, gLong.disp, nil, 0); + if not skipLoad then + if opcode = pc_ili then + GenImplied(m_dea) + else if opcode = pc_ild then + GenImplied(m_ina); + if short then + GenNative(m_rep, immediate, 32, nil, 0); + end {if} + else if gLong.where = localAddress then begin + gLong.disp := gLong.disp+op^.q; + if gLong.fixedDisp then begin + if short then + GenNative(m_sep, immediate, 32, nil, 0); + if (gLong.disp < 256) and (gLong.disp >= 0) then begin + if (not skipLoad) and (opcode in [pc_ili,pc_ild]) then + GenNative(m_lda_dir, direct, gLong.disp, nil, 0); + if opcode in [pc_ili,pc_iil] then + GenNative(m_inc_dir, direct, gLong.disp, nil, 0) + else + GenNative(m_dec_dir, direct, gLong.disp, nil, 0); + if (not skipLoad) and (opcode in [pc_iil,pc_idl]) then + GenNative(m_lda_dir, direct, gLong.disp, nil, 0); + end {if} + else begin + GenNative(m_ldx_imm, immediate, gLong.disp, nil, 0); + if (not skipLoad) and (opcode in [pc_ili,pc_ild]) then + GenNative(m_lda_dirX, direct, gLong.disp, nil, 0); + if opcode in [pc_ili,pc_iil] then + GenNative(m_inc_dirX, direct, gLong.disp, nil, 0) + else + GenNative(m_dec_dirX, direct, gLong.disp, nil, 0); + if (not skipLoad) and (opcode in [pc_iil,pc_idl]) then + GenNative(m_lda_dirX, direct, gLong.disp, nil, 0); + end; {else} + if short then + GenNative(m_rep, immediate, 32, nil, 0); + end + else begin + if (gLong.disp > 255) or (gLong.disp < 0) then begin + GenImplied(m_txa); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); + GenImplied(m_tax); + gLong.disp := 0; + end; {if} + if short then + GenNative(m_sep, immediate, 32, nil, 0); + if (not skipLoad) and (opcode in [pc_ili,pc_ild]) then + GenNative(m_lda_dirX, direct, gLong.disp, nil, 0); + if opcode in [pc_ili,pc_iil] then + GenNative(m_inc_dirX, direct, gLong.disp, nil, 0) + else + GenNative(m_dec_dirX, direct, gLong.disp, nil, 0); + if (not skipLoad) and (opcode in [pc_iil,pc_idl]) then + GenNative(m_lda_dirX, direct, gLong.disp, nil, 0); + if short then + GenNative(m_rep, immediate, 32, nil, 0); + end; {else} + end {else if} + else {if gLong.where = globalLabel then} begin + gLong.disp := gLong.disp+op^.q; + if short then + GenNative(m_sep, immediate, 32, nil, 0); + if gLong.fixedDisp then + if smallMemoryModel then begin + if (not skipLoad) and (opcode in [pc_ili,pc_ild]) then + GenNative(m_lda_abs, absolute, gLong.disp, gLong.lab, 0); + if opcode in [pc_ili,pc_iil] then + GenNative(m_inc_abs, absolute, gLong.disp, gLong.lab, 0) + else + GenNative(m_dec_abs, absolute, gLong.disp, gLong.lab, 0); + if (not skipLoad) and (opcode in [pc_iil,pc_idl]) then + GenNative(m_lda_abs, absolute, gLong.disp, gLong.lab, 0); + end {if} + else begin + GenNative(m_lda_long, longAbs, gLong.disp, gLong.lab, 0); + if opcode in [pc_ili,pc_iil] then + GenImplied(m_ina) + else + GenImplied(m_dea); + GenNative(m_sta_long, longAbs, gLong.disp, gLong.lab, 0); + if not skipLoad then + if opcode = pc_ili then + GenImplied(m_dea) + else if opcode = pc_ild then + GenImplied(m_ina); + end {else} + else + if smallMemoryModel then begin + if (not skipLoad) and (opcode in [pc_ili,pc_ild]) then + GenNative(m_lda_absX, absolute, gLong.disp, gLong.lab, 0); + if opcode in [pc_ili,pc_iil] then + GenNative(m_inc_absX, absolute, gLong.disp, gLong.lab, 0) + else + GenNative(m_dec_absX, absolute, gLong.disp, gLong.lab, 0); + if (not skipLoad) and (opcode in [pc_iil,pc_idl]) then + GenNative(m_lda_absX, absolute, gLong.disp, gLong.lab, 0); + end {if} + else begin + GenNative(m_lda_longX, longAbs, gLong.disp, gLong.lab, 0); + if opcode in [pc_ili,pc_iil] then + GenImplied(m_ina) + else + GenImplied(m_dea); + GenNative(m_sta_longX, longAbs, gLong.disp, gLong.lab, 0); + if not skipLoad then + if opcode = pc_ili then + GenImplied(m_dea) + else if opcode = pc_ild then + GenImplied(m_ina); + end; {else} + if short then + GenNative(m_rep, immediate, 32, nil, 0); + end; {else} + if not skipLoad then + if short then + GenNative(m_and_imm, immediate, $00FF, nil, 0); + end; {case cgByte,cgUByte,cgWord,cgUWord} + + otherwise: + Error(cge1); + end; {case} +end; {GenIilIliIdlIld} + + +procedure GenIncDec (op, save: icptr); + +{ generate code for pc_inc, pc_dec } +{ } +{ parameters: } +{ op - pc_inc or pc_dec operation } +{ save - save location (pc_str or pc_sro) or nil } + +var + disp: integer; {disp in stack frame} + lab1: integer; {branch point} + opcode: pcodes; {temp storage for op code} + size: integer; {number to increment by} + clc,ina,adc: integer; {instructions to generate} + +begin {GenIncDec} +{set up local variables} +opcode := op^.opcode; +size := op^.q; + +if op^.optype in [cgByte,cgUByte,cgWord,cgUWord] then begin + GenTree(op^.left); + if opcode = pc_inc then begin + clc := m_clc; + ina := m_ina; + adc := m_adc_imm; + end {if} + else begin + clc := m_sec; + ina := m_dea; + adc := m_sbc_imm; + end; {else} + if size = 1 then + GenImplied(ina) + else if size = 2 then begin + GenImplied(ina); + GenImplied(ina); + end {else if} + else if size <> 0 then begin + GenImplied(clc); + GenNative(adc, immediate, size, nil, 0); + end; {else if} + end {if} +else if op^.optype in [cgLong,cgULong] then begin + if SameLoc(op^.left, save) then begin + lab1 := GenLabel; + if size = 1 then begin + if opcode = pc_inc then begin + DoOp(0, m_inc_abs, m_inc_dir, op^.left, 0); + GenNative(m_bne, relative, lab1, nil, 0); + DoOp(0, m_inc_abs, m_inc_dir, op^.left, 2); + GenLab(lab1); + end {if} + else {if opcode = pc_dec then} begin + DoOp(m_lda_imm, m_lda_abs, m_lda_dir, op^.left, 0); + GenNative(m_bne, relative, lab1, nil, 0); + DoOp(0, m_dec_abs, m_dec_dir, op^.left, 2); + GenLab(lab1); + DoOp(0, m_dec_abs, m_dec_dir, op^.left, 0); + end; {else} + end {if} + else if opcode = pc_inc then begin + GenImplied(m_clc); + DoOp(m_lda_imm, m_lda_abs, m_lda_dir, op^.left, 0); + GenNative(m_adc_imm, immediate, size, nil, 0); + DoOp(0, m_sta_abs, m_sta_dir, op^.left, 0); + GenNative(m_bcc, relative, lab1, nil, 0); + DoOp(0, m_inc_abs, m_inc_dir, op^.left, 2); + GenLab(lab1); + end {else if} + else begin + GenImplied(m_sec); + DoOp(m_lda_imm, m_lda_abs, m_lda_dir, op^.left, 0); + GenNative(m_sbc_imm, immediate, size, nil, 0); + DoOp(0, m_sta_abs, m_sta_dir, op^.left, 0); + GenNative(m_bcs, relative, lab1, nil, 0); + DoOp(0, m_dec_abs, m_dec_dir, op^.left, 2); + GenLab(lab1); + end; {else} + end {if} + else begin + if save <> nil then + gLong.preference := A_X + else + gLong.preference := gLong.preference & (A_X | inpointer); + if opcode = pc_dec then + gLong.preference := gLong.preference & A_X; + GenTree(op^.left); + if opcode = pc_inc then + IncAddr(size) + else begin + lab1 := GenLabel; + if gLong.where = A_X then begin + GenImplied(m_sec); + GenNative(m_sbc_imm, immediate, size, nil, 0); + GenNative(m_bcs, relative, lab1, nil, 0); + GenImplied(m_dex); + end {if} + else begin + GenImplied(m_sec); + GenNative(m_lda_s, direct, 1, nil, 0); + GenNative(m_sbc_imm, immediate, size, nil, 0); + GenNative(m_sta_s, direct, 1, nil, 0); + GenNative(m_bcs, relative, lab1, nil, 0); + GenNative(m_lda_s, direct, 3, nil, 0); + GenImplied(m_dea); + GenNative(m_sta_s, direct, 3, nil, 0); + end; {else} + GenLab(lab1); + end; {else} + if save <> nil then + if save^.opcode = pc_str then begin + disp := LabelToDisp(save^.r) + save^.q; + if disp < 254 then begin + if gLong.where = onStack then + GenImplied(m_pla); + GenNative(m_sta_dir, direct, disp, nil, 0); + if gLong.where = onStack then + GenImplied(m_plx); + GenNative(m_stx_dir, direct, disp+2, nil, 0); + end {else if} + else begin + if gLong.where = A_X then + GenImplied(m_txy); + GenNative(m_ldx_imm, immediate, disp, nil, 0); + if gLong.where = onStack then + GenImplied(m_pla); + GenNative(m_sta_dirX, direct, 0, nil, 0); + if gLong.where = onStack then + GenImplied(m_pla) + else + GenImplied(m_tya); + GenNative(m_sta_dirX, direct, 2, nil, 0); + end; {else} + end {else if} + else {if save^.opcode = pc_sro then} begin + if gLong.where = onStack then + GenImplied(m_pla); + if smallMemoryModel then + GenNative(m_sta_abs, absolute, save^.q, save^.lab, 0) + else + GenNative(m_sta_long, longabsolute, save^.q, save^.lab, 0); + if smallMemoryModel then begin + if gLong.where = onStack then + GenImplied(m_plx); + GenNative(m_stx_abs, absolute, save^.q+2, save^.lab, 0) + end {if} + else begin + if gLong.where = onStack then + GenImplied(m_pla) + else + GenImplied(m_txa); + GenNative(m_sta_long, longabsolute, save^.q+2, save^.lab, 0); + end; {else} + end; {else} + end; {else} + end; {else if} +end; {GenIncDec} + + +procedure GenInd (op: icptr); + +{ Generate code for a pc_ind } + +var + lab1: integer; {label} + lLong: longType; {requested address type} + optype: baseTypeEnum; {op^.optype} + q: integer; {op^.q} + +begin {GenInd} +optype := op^.optype; +q := op^.q; +case optype of + cgReal,cgDouble,cgComp,cgExtended: begin + gLong.preference := onStack; + GenTree(op^.left); + if q <> 0 then + IncAddr(q); + if optype = cgReal then + GenCall(21) + else if optype = cgDouble then + GenCall(22) + else if optype = cgComp then + GenCall(70) + else if optype = cgExtended then + GenCall(71); + end; {case cgReal,cgDouble,cgComp,cgExtended} + + cgLong,cgULong: begin + lLong := gLong; + GetPointer(op^.left); + if gLong.where = inPointer then begin + if q = 0 then begin + if gLong.fixedDisp then begin + GenNative(m_ldy_imm, immediate, 2, nil, 0); + GenNative(m_lda_indly, direct, gLong.disp, nil, 0); + if (A_X & lLong.preference) <> 0 then + GenImplied(m_tax) + else + GenImplied(m_pha); + GenNative(m_lda_indl, direct, gLong.disp, nil, 0); + end {if} + else begin + GenImplied(m_iny); + GenImplied(m_iny); + GenNative(m_lda_indly, direct, gLong.disp, nil, 0); + if (A_X & lLong.preference) <> 0 then + GenImplied(m_tax) + else + GenImplied(m_pha); + GenImplied(m_dey); + GenImplied(m_dey); + GenNative(m_lda_indly, direct, gLong.disp, nil, 0); + end; {else} + if (A_X & lLong.preference) = 0 then + GenImplied(m_pha); + end {if q = 0} + else begin + if gLong.fixedDisp then begin + GenNative(m_ldy_imm, immediate, q+2, nil, 0); + GenNative(m_lda_indly, direct, gLong.disp, nil, 0); + if (A_X & lLong.preference) <> 0 then + GenImplied(m_tax) + else + GenImplied(m_pha); + GenNative(m_ldy_imm, immediate, q, nil, 0); + end {if} + else begin + GenImplied(m_tya); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, q+2, nil, 0); + GenImplied(m_tay); + GenNative(m_lda_indly, direct, gLong.disp, nil, 0); + if (A_X & lLong.preference) <> 0 then + GenImplied(m_tax) + else + GenImplied(m_pha); + GenImplied(m_dey); + GenImplied(m_dey); + end; {else} + GenNative(m_lda_indly, direct, gLong.disp, nil, 0); + if (A_X & lLong.preference) = 0 then + GenImplied(m_pha); + end; {else} + end {if glong.where = inPointer} + else if gLong.where = localAddress then begin + gLong.disp := gLong.disp+q; + if gLong.fixedDisp then + if (gLong.disp < 254) and (gLong.disp >= 0) then begin + GenNative(m_lda_dir, direct, gLong.disp, nil, 0); + GenNative(m_ldx_dir, direct, gLong.disp+2, nil, 0); + end {if} + else begin + GenNative(m_ldx_imm, immediate, gLong.disp, nil, 0); + GenNative(m_lda_dirX, direct, 0, nil, 0); + GenNative(m_ldy_dirX, direct, 2, nil, 0); + GenImplied(m_tyx); + end {else} + else begin + if (gLong.disp >= 254) or (gLong.disp < 0) then begin + GenImplied(m_txa); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); + GenImplied(m_tax); + gLong.disp := 0; + end; {if} + GenNative(m_ldy_dirX, direct, gLong.disp+2, nil, 0); + GenNative(m_lda_dirX, direct, gLong.disp, nil, 0); + GenImplied(m_tyx); + end; {else} + if (A_X & lLong.preference) = 0 then begin + GenImplied(m_phx); + GenImplied(m_pha); + end; {if} + end {else if gLong.where = localAddress} + else {if gLong.where = globalLabel then} begin + gLong.disp := gLong.disp+q; + if gLong.fixedDisp then + if smallMemoryModel then begin + GenNative(m_lda_abs, absolute, gLong.disp, gLong.lab, 0); + GenNative(m_ldx_abs, absolute, gLong.disp+2, gLong.lab, 0); + end {if} + else begin + GenNative(m_lda_long, longAbs, gLong.disp+2, gLong.lab, 0); + GenImplied(m_tax); + GenNative(m_lda_long, longAbs, gLong.disp, gLong.lab, 0); + end {else} + else + if smallMemoryModel then begin + GenNative(m_ldy_absX, absolute, gLong.disp+2, gLong.lab, 0); + GenNative(m_lda_absX, absolute, gLong.disp, gLong.lab, 0); + GenImplied(m_tyx); + end {if} + else begin + GenNative(m_lda_longX, longAbs, gLong.disp+2, gLong.lab, 0); + GenImplied(m_tay); + GenNative(m_lda_longX, longAbs, gLong.disp, gLong.lab, 0); + GenImplied(m_tyx); + end; {else} + if (A_X & lLong.preference) = 0 then begin + GenImplied(m_phx); + GenImplied(m_pha); + end; {if} + end; {else} + if (A_X & lLong.preference) <> 0 then + gLong.where := A_X + else + gLong.where := onStack; + end; {cgLong,cgULong} + + cgByte,cgUByte,cgWord,cgUWord: begin + GetPointer(op^.left); + if gLong.where = inPointer then begin + if q = 0 then + if gLong.fixedDisp then + GenNative(m_lda_indl, direct, gLong.disp, nil, 0) + else + GenNative(m_lda_indly, direct, gLong.disp, nil, 0) + else + if gLong.fixedDisp then begin + GenNative(m_ldy_imm, immediate, q, nil, 0); + GenNative(m_lda_indly, direct, gLong.disp, nil, 0) + end {if} + else begin + GenImplied(m_tya); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, q, nil, 0); + GenImplied(m_tay); + GenNative(m_lda_indly, direct, gLong.disp, nil, 0) + end; {else} + end {if} + else if gLong.where = localAddress then begin + gLong.disp := gLong.disp+q; + if gLong.fixedDisp then + if (gLong.disp & $FF00) = 0 then + GenNative(m_lda_dir, direct, gLong.disp, nil, 0) + else begin + GenNative(m_ldx_imm, immediate, gLong.disp, nil, 0); + GenNative(m_lda_dirX, direct, 0, nil, 0); + end {else} + else + if (gLong.disp & $FF00) = 0 then + GenNative(m_lda_dirX, direct, gLong.disp, nil, 0) + else begin + GenImplied(m_txa); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); + GenImplied(m_tax); + GenNative(m_lda_dirX, direct, 0, nil, 0); + end {else} + end {else if} + else {if gLong.where = globalLabel then} begin + gLong.disp := gLong.disp+q; + if gLong.fixedDisp then + if smallMemoryModel then + GenNative(m_lda_abs, absolute, gLong.disp, gLong.lab, 0) + else + GenNative(m_lda_long, longAbs, gLong.disp, gLong.lab, 0) + else + if smallMemoryModel then + GenNative(m_lda_absX, absolute, gLong.disp, gLong.lab, 0) + else + GenNative(m_lda_longX, longAbs, gLong.disp, gLong.lab, 0) + end; {else} + if optype in [cgByte,cgUByte] then begin + GenNative(m_and_imm, immediate, 255, nil, 0); + if optype = cgByte then begin + GenNative(m_cmp_imm, immediate, 128, nil, 0); + lab1 := GenLabel; + GenNative(m_bcc, relative, lab1, nil, 0); + GenNative(m_ora_imm, immediate, $FF00, nil, 0); + GenLab(lab1); + end; {if} + end; {if} + end; {case cgByte,cgUByte,cgWord,cgUWord} + + otherwise: ; + end; {case} +end; {GenInd} + + +procedure GenIxa (op: icptr); + +{ Generate code for a pc_ixa } + +var + lab1: integer; {branch label} + lLong: longType; {type of address} + zero: boolean; {is the index 0?} + + + procedure Index; + + { Get the index size } + + var + lLong: longType; {temp for preserving left node info} + + begin {Index} + zero := false; + with op^.right^ do begin + if opcode = pc_ldc then begin + if q = 0 then + zero := true + else + GenNative(m_lda_imm, immediate, q, nil, 0); + end {if} + else begin + lLong := gLong; + GenTree(op^.right); + gLong := lLong; + end; {else} + end; {with} + end; {Index} + + +begin {GenIxa} +if smallMemoryModel then begin + lLong := gLong; + gLong.preference := inPointer+localAddress+globalLabel; + GenTree(op^.left); + case gLong.where of + + onStack: begin + Index; + if not zero then begin + GenImplied(m_clc); + GenNative(m_adc_s, direct, 1, nil, 0); + GenNative(m_sta_s, direct, 1, nil, 0); + lab1 := GenLabel; + GenNative(m_bcc, relative, lab1, nil, 0); + GenNative(m_lda_s, direct, 3, nil, 0); + GenImplied(m_ina); + GenNative(m_sta_s, direct, 3, nil, 0); + GenLab(lab1); + end; {if} + end; {case onStack} + + inPointer: begin + if not gLong.fixedDisp then begin + if Complex(op^.right) then begin + GenImplied(m_phy); + Index; + if not zero then begin + GenImplied(m_clc); + GenNative(m_adc_s, direct, 1, nil, 0); + GenNative(m_sta_s, direct, 1, nil, 0); + end; {if} + GenImplied(m_ply); + end {if} + else begin + GenImplied(m_tya); + GenImplied(m_clc); + OperA(m_adc_imm, op^.right); + GenImplied(m_tay); + end; {else} + end {if} + else begin + Index; + if not zero then begin + GenImplied(m_tay); + gLong.fixedDisp := false; + end; {if} + end; {else} + if (inPointer & lLong.preference) = 0 then begin + if not gLong.fixedDisp then begin + GenImplied(m_tya); + GenImplied(m_clc); + GenNative(m_adc_dir, direct, gLong.disp, nil, 0); + GenNative(m_ldx_dir, direct, gLong.disp+2, nil, 0); + lab1 := GenLabel; + GenNative(m_bcc, relative, lab1, nil, 0); + GenImplied(m_inx); + GenLab(lab1); + end {if} + else begin + GenNative(m_ldx_dir, direct, gLong.disp+2, nil, 0); + GenNative(m_lda_dir, direct, gLong.disp, nil, 0); + end; {else} + GenImplied(m_phx); + GenImplied(m_pha); + gLong.where := onStack; + end; {if} + end; {case inPointer} + + localAddress,globalLabel: begin + if not gLong.fixedDisp then begin + if Complex(op^.right) then begin + GenImplied(m_phx); + Index; + if not zero then begin + GenImplied(m_clc); + GenNative(m_adc_s, direct, 1, nil, 0); + GenNative(m_sta_s, direct, 1, nil, 0); + end; {if} + GenImplied(m_plx); + end {if} + else begin + GenImplied(m_txa); + GenImplied(m_clc); + OperA(m_adc_imm, op^.right); + GenImplied(m_tax); + end; {else} + end {if} + else if Complex(op^.right) then begin + Index; + if not zero then begin + GenImplied(m_tax); + gLong.fixedDisp := false; + end; {if} + end {else if} + else begin + LoadX(op^.right); + gLong.fixedDisp := false; + end; {else} + if (lLong.preference & gLong.where) = 0 then begin + if (lLong.preference & inPointer) <> 0 then begin + if gLong.where = localAddress then begin + if not gLong.fixedDisp then begin + GenNative(m_stz_dir, direct, dworkLoc+2, nil, 0); + GenImplied(m_phx); + GenImplied(m_tdc); + GenImplied(m_clc); + if gLong.disp <> 0 then + GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); + GenNative(m_adc_s, direct, 1, nil, 0); + GenNative(m_sta_dir, direct, dworkLoc, nil, 0); + GenImplied(m_plx); + end {if} + else begin + GenNative(m_stz_dir, direct, dworkLoc+2, nil, 0); + GenImplied(m_tdc); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); + GenNative(m_sta_dir, direct, dworkLoc, nil, 0); + end; {else} + end {if} + else begin + if not gLong.fixedDisp then begin + GenImplied(m_txa); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, gLong.disp, gLong.lab, 0); + GenNative(m_sta_dir, direct, dworkLoc, nil, 0); + GenNative(m_ldx_imm, immediate, gLong.disp, gLong.lab, shift16); + lab1 := GenLabel; + GenNative(m_bcc, relative, lab1, nil, 0); + GenImplied(m_inx); + GenLab(lab1); + GenNative(m_stx_dir, direct, dworkLoc+2, nil, 0); + end {if} + else begin + GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, shift16); + GenNative(m_sta_dir, direct, dworkLoc+2, nil, 0); + GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, 0); + GenNative(m_sta_dir, direct, dworkLoc, nil, 0); + end; {else} + end; {else} + gLong.where := inPointer; + gLong.fixedDisp := true; + gLong.disp := dworkLoc; + end {if} + else begin + if gLong.where = localAddress then begin + if not gLong.fixedDisp then begin + GenNative(m_pea, immediate, 0, nil, 0); + GenImplied(m_phx); + GenImplied(m_tdc); + GenImplied(m_clc); + GenNative(m_adc_s, direct, 1, nil, 0); + if gLong.disp <> 0 then + GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); + GenNative(m_sta_s, direct, 1, nil, 0); + end {if} + else begin + GenNative(m_pea, immediate, 0, nil, 0); + GenImplied(m_tdc); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); + GenImplied(m_pha); + end; {else} + end {if} + else begin + if not gLong.fixedDisp then begin + GenImplied(m_txa); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, gLong.disp, gLong.lab, 0); + GenNative(m_ldx_imm, immediate, gLong.disp, gLong.lab, shift16); + lab1 := GenLabel; + GenNative(m_bcc, relative, lab1, nil, 0); + GenImplied(m_inx); + GenLab(lab1); + GenImplied(m_phx); + GenImplied(m_pha); + end {if} + else begin + GenNative(m_pea, immediate, gLong.disp, gLong.lab, shift16); + GenNative(m_pea, immediate, gLong.disp, gLong.lab, 0); + end; {else} + end; {else} + gLong.where := onStack; + end; {else} + end; {if} + end; {case localAddress,globalLabel} + otherwise: + Error(cge1); + end; {case} + end {if smallMemoryModel or (op^.right^.opcode = pc_ldc)} +else begin + gLong.preference := onStack; + GenTree(op^.left); + GenTree(op^.right); + if op^.optype in [cgByte,cgWord] then begin + lab1 := GenLabel; + GenNative(m_ldx_imm, immediate, $0000, nil, 0); + GenImplied(m_tay); + GenNative(m_bpl, relative, lab1, nil, 0); + GenImplied(m_dex); + GenLab(lab1); + GenImplied(m_phx); + GenImplied(m_pha); + end {else if} + else begin + GenNative(m_pea, immediate, 0, nil, 0); + GenImplied(m_pha); + end; {else} + GenImplied(m_clc); + GenImplied(m_pla); + GenNative(m_adc_s, direct, 3, nil, 0); + GenNative(m_sta_s, direct, 3, nil, 0); + GenImplied(m_pla); + GenNative(m_adc_s, direct, 3, nil, 0); + GenNative(m_sta_s, direct, 3, nil, 0); + gLong.where := onStack; + end; {else} +end; {GenIxa} + + +procedure GenLilLliLdlLld (op: icptr); + +{ Generate code for a pc_lil, pc_lli, pc_ldl or pc_lld } + +var + disp: integer; {load location} + lab1: integer; {branch point} + opcode: pcodes; {op^.opcode} + + + procedure DoXIncDec (op: pcodes; p: integer); + + { Do a decrement or increment on a local four byte value X } + { bytes into the stack frame } + { } + { parameters } + { op - operation code } + { p - number to ind/dec by } + + var + lab1: integer; {branch point} + + begin {DoXIncDec} + if op in [pc_lil,pc_lli] then begin + lab1 := GenLabel; + if p = 1 then begin + GenNative(m_inc_dirx, direct, 0, nil, 0); + GenNative(m_bne, relative, lab1, nil, 0); + end {if} + else begin + GenImplied(m_clc); + GenNative(m_lda_dirx, direct, 0, nil, 0); + GenNative(m_adc_imm, immediate, p, nil, 0); + GenNative(m_sta_dirx, direct, 0, nil, 0); + GenNative(m_bcc, relative, lab1, nil, 0); + end; {else} + GenNative(m_inc_dirx, direct, 2, nil, 0); + GenLab(lab1); + end {if} + else {if op in [pc_gdl,pc_gld] then} begin + lab1 := GenLabel; + if p = 1 then begin + GenNative(m_lda_dirx, direct, 0, nil, 0); + GenNative(m_bne, relative, lab1, nil, 0); + GenNative(m_dec_dirx, direct, 2, nil, 0); + GenLab(lab1); + GenNative(m_dec_dirx, direct, 0, nil, 0); + end {if} + else begin + GenImplied(m_sec); + GenNative(m_lda_dirx, direct, 0, nil, 0); + GenNative(m_sbc_imm, immediate, p, nil, 0); + GenNative(m_sta_dirx, direct, 0, nil, 0); + GenNative(m_bcs, relative, lab1, nil, 0); + GenNative(m_dec_dirx, direct, 2, nil, 0); + GenLab(lab1); + end; {else} + end; {else} + end; {DoXIncDec} + + + procedure DoLIncDec (op: pcodes; disp, p: integer); + + { Do a decrement or increment on a local four byte value } + { } + { parameters } + { op - operation code } + { disp - disp in stack frame to value } + { p - number to ind/dec by } + + var + lab1: integer; {branch point} + + begin {DoLIncDec} + if op in [pc_lil,pc_lli] then begin + lab1 := GenLabel; + if p = 1 then begin + GenNative(m_inc_dir, direct, disp, nil, 0); + GenNative(m_bne, relative, lab1, nil, 0); + end {if} + else begin + GenImplied(m_clc); + GenNative(m_lda_dir, direct, disp, nil, 0); + GenNative(m_adc_imm, immediate, p, nil, 0); + GenNative(m_sta_dir, direct, disp, nil, 0); + GenNative(m_bcc, relative, lab1, nil, 0); + end; {else} + GenNative(m_inc_dir, direct, disp+2, nil, 0); + GenLab(lab1); + end {if} + else {if op in [pc_ldl,pc_lld] then} begin + lab1 := GenLabel; + if p = 1 then begin + GenNative(m_lda_dir, direct, disp, nil, 0); + GenNative(m_bne, relative, lab1, nil, 0); + GenNative(m_dec_dir, direct, disp+2, nil, 0); + GenLab(lab1); + GenNative(m_dec_dir, direct, disp, nil, 0); + end {if} + else begin + GenImplied(m_sec); + GenNative(m_lda_dir, direct, disp, nil, 0); + GenNative(m_sbc_imm, immediate, p, nil, 0); + GenNative(m_sta_dir, direct, disp, nil, 0); + GenNative(m_bcs, relative, lab1, nil, 0); + GenNative(m_dec_dir, direct, disp+2, nil, 0); + GenLab(lab1); + end; {else} + end; {else} + end; {DoLIncDec} + + +begin {GenLilLliLdlLld} +disp := LabelToDisp(op^.r); +opcode := op^.opcode; +case op^.optype of + cgLong, cgULong: begin + gLong.where := onStack; + if disp >= 254 then begin + GenNative(m_ldx_imm, immediate, disp, nil, 0); + if opcode in [pc_lil,pc_ldl] then + DoXIncDec(opcode, op^.q); + if not skipLoad then begin + GenNative(m_lda_dirx, direct, 2, nil, 0); + GenImplied(m_pha); + GenNative(m_lda_dirx, direct, 0, nil, 0); + GenImplied(m_pha); + end {if} + else + gLong.where := A_X; + if opcode in [pc_lli,pc_lld] then + DoXIncDec(opcode, op^.q); + end {if} + else begin + if opcode in [pc_lil,pc_ldl] then + DoLIncDec(opcode, disp, op^.q); + if not skipLoad then begin + GenNative(m_pei_dir, direct, disp+2, nil, 0); + GenNative(m_pei_dir, direct, disp, nil, 0); + end {if} + else + gLong.where := A_X; + if opcode in [pc_lli,pc_lld] then + DoLIncDec(opcode, disp, op^.q); + end; {else} + end; + + cgByte, cgUByte, cgWord, cgUWord: begin + if op^.optype in [cgByte,cgUByte] then + GenNative(m_sep, immediate, 32, nil, 0); + if disp >= 256 then begin + GenNative(m_ldx_imm, immediate, disp, nil, 0); + if opcode = pc_lil then + GenNative(m_inc_dirx, direct, 0, nil, 0) + else if opcode = pc_ldl then + GenNative(m_dec_dirx, direct, 0, nil, 0); + if not skipLoad then + GenNative(m_lda_dirx, direct, 0, nil, 0); + if opcode = pc_lli then + GenNative(m_inc_dirx, direct, 0, nil, 0) + else if opcode = pc_lld then + GenNative(m_dec_dirx, direct, 0, nil, 0); + end + else begin + if opcode = pc_lil then + GenNative(m_inc_dir, direct, disp, nil, 0) + else if opcode = pc_ldl then + GenNative(m_dec_dir, direct, disp, nil, 0); + if not skipLoad then + GenNative(m_lda_dir, direct, disp, nil, 0); + if opcode = pc_lli then + GenNative(m_inc_dir, direct, disp, nil, 0) + else if opcode = pc_lld then + GenNative(m_dec_dir, direct, disp, nil, 0); + end; {else} + if op^.optype in [cgByte,cgUByte] then begin + GenNative(m_rep, immediate, 32, nil, 0); + if not skipLoad then begin + GenNative(m_and_imm, immediate, $00FF, nil, 0); + if op^.optype = cgByte then begin + GenNative(m_bit_imm, immediate, $0080, nil, 0); + lab1 := GenLabel; + GenNative(m_beq, relative, lab1, nil, 0); + GenNative(m_ora_imm, immediate, $FF00, nil, 0); + GenLab(lab1); + GenNative(m_cmp_imm, immediate, $0000, nil, 0); + end; {if} + end; {if} + end; {if} + end; + + otherwise: + Error(cge1); + + end; {case} +end; {GenLilLliLdlLld} + + +procedure GenLogic (op: icptr); + +{ generate a pc_and, pc_ior, pc_bnd, pc_bor or pc_bxr } + +var + lab1,lab2: integer; {label} + nd: icptr; {temp node pointer} + opcode: pcodes; {operation code} + +begin {GenLogic} +opcode := op^.opcode; +if opcode in [pc_and,pc_ior] then begin + lab1 := GenLabel; + GenTree(op^.left); + GenNative(m_cmp_imm, immediate, 0, nil, 0); + lab2 := GenLabel; + if opcode = pc_and then + GenNative(m_bne, relative, lab2, nil, 0) + else begin + GenNative(m_beq, relative, lab2, nil, 0); + GenNative(m_lda_imm, immediate, 1, nil, 0); + end; {else} + GenNative(m_brl, longrelative, lab1, nil, 0); + GenLab(lab2); + GenTree(op^.right); + GenNative(m_cmp_imm, immediate, 0, nil, 0); + GenNative(m_beq, relative, lab1, nil, 0); + GenNative(m_lda_imm, immediate, 1, nil, 0); + GenLab(lab1); + end {if} +else begin + if not Complex(op^.left) then + if Complex(op^.right) then begin + nd := op^.left; + op^.left := op^.right; + op^.right := nd; + end; {if} + GenTree(op^.left); + if Complex(op^.right) then begin + GenImplied(m_pha); + GenTree(op^.right); + case opcode of + pc_and,pc_bnd: GenNative(m_and_s, direct, 1, nil, 0); + pc_ior,pc_bor: GenNative(m_ora_s, direct, 1, nil, 0); + pc_bxr: GenNative(m_eor_s, direct, 1, nil, 0); + otherwise: + Error(cge1); + end; {case} + GenImplied(m_plx); + GenImplied(m_tax); + end {if} + else + case opcode of + pc_and,pc_bnd: OperA(m_and_imm, op^.right); + pc_ior,pc_bor: OperA(m_ora_imm, op^.right); + pc_bxr: OperA(m_eor_imm, op^.right); + otherwise: + Error(cge1); + end; {case} + end; {else} +end; {GenLogic} + + +procedure GenSroCpo (op: icptr); + +{ Generate code for a pc_sro or pc_cpo } + +var + lab: stringPtr; {op^.lab} + lab1: integer; {branch point} + lval: longint; {op^.left^.lval} + opcode: pcodes; {op^.opcode} + optype: baseTypeEnum; {op^.optype} + q: integer; {op^.q} + special: boolean; {special save?} + +begin {GenSroCpo} +opcode := op^.opcode; +optype := op^.optype; +q := op^.q; +lab := op^.lab; +case optype of + cgByte, cgUByte: begin + if smallMemoryModel and (op^.left^.opcode = pc_ldc) + and (op^.left^.q = 0) and (opcode = pc_sro) then begin + GenNative(m_sep, immediate, 32, nil, 0); + GenNative(m_stz_abs, absolute, q, lab, 0); + end {if} + else begin + if op^.opcode = pc_sro then + if op^.left^.opcode = pc_cnv then + if (op^.left^.q >> 4) in [ord(cgWord),ord(cgUWord)] then + op^.left := op^.left^.left; + if op^.left^.opcode in [pc_ldc,pc_ldc,pc_lod] then begin + GenNative(m_sep, immediate, 32, nil, 0); + GenTree(op^.left); + end {if} + else begin + GenTree(op^.left); + GenNative(m_sep, immediate, 32, nil, 0); + end; {else} + if smallMemoryModel then + GenNative(m_sta_abs, absolute, q, lab, 0) + else + GenNative(m_sta_long, longabsolute, q, lab, 0); + end; {else} + GenNative(m_rep, immediate, 32, nil, 0); + end; + + cgWord, cgUWord: + if smallMemoryModel and (op^.left^.opcode = pc_ldc) + and (op^.left^.q = 0) and (opcode = pc_sro) then + GenNative(m_stz_abs, absolute, q, lab, 0) + else begin + GenTree(op^.left); + if smallMemoryModel then + GenNative(m_sta_abs, absolute, q, lab, 0) + else + GenNative(m_sta_long, longabsolute, q, lab, 0); + end; {else} + + cgReal, cgDouble, cgComp, cgExtended: begin + GenTree(op^.left); + GenNative(m_pea, immediate, q, lab, shift16); + GenNative(m_pea, immediate, q, lab, 0); + if opcode = pc_sro then begin + if optype = cgReal then + GenCall(9) + else if optype = cgDouble then + GenCall(10) + else if optype = cgComp then + GenCall(66) + else {if optype = cgExtended then} + GenCall(67); + end {if} + else {if opcode = pc_cpo then} begin + if optype = cgReal then + GenCall(51) + else if optype = cgDouble then + GenCall(52) + else if optype = cgComp then + GenCall(68) + else {if optype = cgExtended then} + GenCall(69); + end; {else} + end; + + cgLong, cgULong: begin + if (opcode = pc_sro) and (op^.left^.opcode in [pc_adl,pc_sbl]) then + GenAdlSbl(op^.left, op) + else if (opcode = pc_sro) and (op^.left^.opcode in [pc_inc,pc_dec]) then + GenIncDec(op^.left, op) + else if smallMemoryModel and (op^.left^.opcode = pc_ldc) then begin + lval := op^.left^.lval; + if long(lval).lsw = 0 then + GenNative(m_stz_abs, absolute, q, lab, 0) + else begin + GenNative(m_lda_imm, immediate, long(lval).lsw, nil, 0); + GenNative(m_sta_abs, absolute, q, lab, 0) + end; {else} + if long(lval).msw = 0 then + GenNative(m_stz_abs, absolute, q+2, lab, 0) + else begin + GenNative(m_ldx_imm, immediate, long(lval).msw, nil, 0); + GenNative(m_stx_abs, absolute, q+2, lab, 0) + end; {else} + if op^.opcode = pc_cpo then + GenTree(op^.left); + end {if} + else begin + if op^.opcode = pc_sro then + gLong.preference := A_X | inPointer | localAddress | globalLabel | constant + else + gLong.preference := gLong.preference & + (A_X | inPointer | localAddress | globalLabel | constant); + GenTree(op^.left); + case gLong.where of + + A_X: begin + if smallMemoryModel then begin + GenNative(m_stx_abs, absolute, q+2, lab, 0); + GenNative(m_sta_abs, absolute, q, lab, 0); + end {if} + else begin + GenNative(m_sta_long, longabsolute, q, lab, 0); + if opcode = pc_cpo then + GenImplied(m_pha); + GenImplied(m_txa); + GenNative(m_sta_long, longabsolute, q+2, lab, 0); + if opcode = pc_cpo then + GenImplied(m_pla); + end; {else} + end; + + onStack: begin + if opcode = pc_sro then + GenImplied(m_pla) + else {if opcode = pc_cpo then} + GenNative(m_lda_s, direct, 1, nil, 0); + if smallMemoryModel then + GenNative(m_sta_abs, absolute, q, lab, 0) + else + GenNative(m_sta_long, longabsolute, q, lab, 0); + if opcode = pc_sro then + GenImplied(m_pla) + else {if opcode = pc_cpo then} + GenNative(m_lda_s, direct, 3, nil, 0); + if smallMemoryModel then + GenNative(m_sta_abs, absolute, q+2, lab, 0) + else + GenNative(m_sta_long, longabsolute, q+2, lab, 0); + end; + + inPointer: begin + GenNative(m_ldx_dir, direct, gLong.disp+2, nil, 0); + if gLong.fixedDisp then + GenNative(m_lda_dir, direct, gLong.disp, nil, 0) + else begin + GenImplied(m_tya); + GenImplied(m_clc); + GenNative(m_adc_dir, direct, gLong.disp, nil, 0); + if not smallMemoryModel then begin + lab1 := GenLabel; + GenNative(m_bcc, relative, lab1, nil, 0); + GenImplied(m_inx); + GenLab(lab1); + end; {if} + end; {else} + if smallMemoryModel then begin + GenNative(m_stx_abs, absolute, q+2, lab, 0); + GenNative(m_sta_abs, absolute, q, lab, 0); + end {if} + else begin + GenNative(m_sta_long, longabsolute, q, lab, 0); + if opcode = pc_cpo then + GenImplied(m_pha); + GenImplied(m_txa); + GenNative(m_sta_long, longabsolute, q+2, lab, 0); + if opcode = pc_cpo then + GenImplied(m_pla); + end; {else} + gLong.where := A_X; + end; + + localAddress: begin + if smallMemoryModel then + GenNative(m_stz_abs, absolute, q+2, lab, 0) + else begin + GenNative(m_lda_imm, immediate, 0, nil, 0); + GenNative(m_sta_long, longabsolute, q+2, lab, 0); + end; {else} + GenImplied(m_tdc); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); + if not gLong.fixedDisp then begin + GenImplied(m_phx); + GenNative(m_adc_s, direct, 1, nil, 0); + GenImplied(m_plx); + end; {if} + if smallMemoryModel then + GenNative(m_sta_abs, absolute, q, lab, 0) + else + GenNative(m_sta_long, longabsolute, q, lab, 0); + end; + + globalLabel: + if gLong.fixedDisp then begin + if smallMemoryModel then begin + GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, 0); + GenNative(m_ldx_imm, immediate, gLong.disp, gLong.lab, shift16); + GenNative(m_stx_abs, absolute, q+2, lab, 0); + GenNative(m_sta_abs, absolute, q, lab, 0); + end {if} + else begin + GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, shift16); + GenNative(m_sta_long, longabsolute, q+2, lab, 0); + if opcode = pc_cpo then + GenImplied(m_tax); + GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, 0); + GenNative(m_sta_long, longabsolute, q, lab, 0); + end; {else} + gLong.where := A_X; + end {if} + else begin + GenImplied(m_txa); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, gLong.disp, gLong.lab, 0); + if smallMemoryModel then + GenNative(m_sta_abs, absolute, q, lab, 0) + else + GenNative(m_sta_long, longabsolute, q, lab, 0); + GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, shift16); + GenNative(m_adc_imm, immediate, 0, nil, 0); + if smallMemoryModel then + GenNative(m_sta_abs, absolute, q+2, lab, 0) + else + GenNative(m_sta_long, longabsolute, q+2, lab, 0); + end; {else} + + constant: begin + if gLong.lval = 0 then begin + if smallMemoryModel then begin + GenNative(m_stz_abs, absolute, q+2, lab, 0); + GenNative(m_stz_abs, absolute, q, lab, 0); + end {if} + else begin + GenNative(m_lda_imm, immediate, 0, nil, 0); + GenNative(m_sta_long, longabsolute, q+2, lab, 0); + GenNative(m_sta_long, longabsolute, q, lab, 0); + end; {else} + end {if} + else if not smallMemoryModel then begin + GenNative(m_lda_imm, immediate, long(gLong.lval).msw, nil, 0); + GenNative(m_sta_long, longabsolute, q+2, lab, 0); + GenNative(m_lda_imm, immediate, long(gLong.lval).lsw, nil, 0); + GenNative(m_sta_long, longabsolute, q, lab, 0); + end {else if} + else begin + if long(gLong.lval).msw = 0 then + GenNative(m_stz_abs, absolute, q+2, lab, 0) + else begin + GenNative(m_ldx_imm, immediate, long(gLong.lval).msw, nil, 0); + GenNative(m_stx_abs, absolute, q+2, lab, 0); + end; {else} + if long(gLong.lval).lsw = 0 then + GenNative(m_stz_abs, absolute, q, lab, 0) + else begin + GenNative(m_lda_imm, immediate, long(gLong.lval).lsw, nil, 0); + GenNative(m_sta_abs, absolute, q, lab, 0); + end; {else} + if (long(gLong.lval).lsw <> 0) and (long(gLong.lval).msw <> 0) then + gLong.where := A_X; + end; {else} + end; {case constant} + + otherwise: + Error(cge1); + end; {case} + end; {else} + end; {case CGLong, cgULong} + end; {case} +end; {GenSroCpo} + + +procedure GenStoCpi (op: icptr); + +{ Generate code for a pc_sto or pc_cpi } + +var + disp: integer; {disp in stack frame} + opcode: pcodes; {temp storage for op code} + optype: baseTypeEnum; {operand type} + short: boolean; {use short registers?} + simple: boolean; {is the load a simple load?} + lLong: longType; {address record for left node} + zero: boolean; {is the operand a constant zero?} + + + procedure LoadLSW; + + { load the least significant word of a four byte value } + + begin {LoadLSW} + if lLong.where = onStack then + if opcode = pc_sto then + GenImplied(m_pla) + else + GenNative(m_lda_s, direct, 1, nil, 0) + else {if lLong.where = constant then} + GenNative(m_lda_imm, immediate, long(lLong.lval).lsw, nil, 0); + end; {LoadLSW} + + + procedure LoadMSW; + + { load the most significant word of a four byte value } + { } + { Note: LoadLSW MUST be called first! } + + begin {LoadMSW} + if lLong.where = onStack then + if opcode = pc_sto then + GenImplied(m_pla) + else + GenNative(m_lda_s, direct, 3, nil, 0) + else {if lLong.where = constant then} + GenNative(m_lda_imm, immediate, long(lLong.lval).msw, nil, 0); + end; {LoadMSW} + + + procedure LoadWord; + + { Get the operand for a cgByte, cgUByte, cgWord or cgUWord } + { into the accumulator } + + begin {LoadWord} + if simple then begin + with op^.right^ do + if opcode = pc_ldc then + GenNative(m_lda_imm, immediate, q, nil, 0) + else if opcode = pc_lod then + GenNative(m_lda_dir, direct, LabelToDisp(r) + q, nil, 0) + else {if opcode = pc_ldo then} + if smallMemoryModel then + GenNative(m_lda_abs, absolute, q, lab, 0) + else + GenNative(m_lda_long, longabsolute, q, lab, 0); + end {if} + else begin + GenImplied(m_pla); + if short then + GenNative(m_sep, immediate, 32, nil, 0); + end {else} + end; {LoadWord} + + +begin {GenStoCpi} +opcode := op^.opcode; +optype := op^.optype; +case optype of + + cgReal,cgDouble,cgComp,cgExtended: begin + GenTree(op^.right); + gLong.preference := onStack; + GenTree(op^.left); + if optype = cgReal then begin + if opcode = pc_sto then + GenCall(9) + else + GenCall(51); + end {if} + else if optype = cgDouble then begin + if opcode = pc_sto then + GenCall(10) + else + GenCall(52); + end {else if} + else if optype = cgComp then begin + if opcode = pc_sto then + GenCall(66) + else + GenCall(68); + end {else if} + else {if optype = cgExtended then} begin + if opcode = pc_sto then + GenCall(67) + else + GenCall(69); + end; {else} + end; {case cgReal,cgDouble,cgComp,cgExtended} + + cgLong,cgULong: begin + if opcode = pc_sto then + gLong.preference := onStack+constant + else + gLong.preference := (onStack+constant) & gLong.preference; + GenTree(op^.right); + lLong := gLong; + gLong.preference := localAddress+inPointer+globalLabel+A_X; + GenTree(op^.left); + if gLong.where = onStack then begin + GenImplied(m_pla); + GenNative(m_sta_dir, direct, dworkLoc, nil, 0); + GenImplied(m_pla); + GenNative(m_sta_dir, direct, dworkLoc+2, nil, 0); + LoadLSW; + GenNative(m_sta_indl, direct, dworkLoc, nil, 0); + GenNative(m_ldy_imm, immediate, 2, nil, 0); + LoadMSW; + GenNative(m_sta_indly, direct, dworkLoc, nil, 0); + end {if} + else if gLong.where = A_X then begin + GenNative(m_sta_dir, direct, dworkLoc, nil, 0); + GenNative(m_stx_dir, direct, dworkLoc+2, nil, 0); + LoadLSW; + GenNative(m_sta_indl, direct, dworkLoc, nil, 0); + GenNative(m_ldy_imm, immediate, 2, nil, 0); + LoadMSW; + GenNative(m_sta_indly, direct, dworkLoc, nil, 0); + end {if} + else if gLong.where = localAddress then begin + LoadLSW; + if gLong.fixedDisp then + if (gLong.disp & $FF00) = 0 then + GenNative(m_sta_dir, direct, gLong.disp, nil, 0) + else begin + GenNative(m_ldx_imm, immediate, gLong.disp, nil, 0); + GenNative(m_sta_dirX, direct, 0, nil, 0); + end {else} + else begin + if (gLong.disp >= 254) or (gLong.disp < 0) then begin + GenImplied(m_tay); + GenImplied(m_txa); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); + GenImplied(m_tax); + GenImplied(m_tya); + gLong.disp := 0; + end; {if} + GenNative(m_sta_dirX, direct, gLong.disp, nil, 0); + end; {else} + LoadMSW; + if gLong.fixedDisp then + if ((gLong.disp+2) & $FF00) = 0 then + GenNative(m_sta_dir, direct, gLong.disp+2, nil, 0) + else begin + GenNative(m_ldx_imm, immediate, gLong.disp+2, nil, 0); + GenNative(m_sta_dirX, direct, 0, nil, 0); + end {else} + else begin + if (gLong.disp >= 254) or (gLong.disp < 0) then begin + GenImplied(m_tay); + GenImplied(m_txa); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); + GenImplied(m_tax); + GenImplied(m_tya); + gLong.disp := 0; + end; {if} + GenNative(m_sta_dirX, direct, gLong.disp+2, nil, 0); + end; {else} + end {else if} + else if gLong.where = globalLabel then begin + LoadLSW; + if gLong.fixedDisp then + if smallMemoryModel then + GenNative(m_sta_abs, absolute, gLong.disp, gLong.lab, 0) + else + GenNative(m_sta_long, longAbs, gLong.disp, gLong.lab, 0) + else + if smallMemoryModel then + GenNative(m_sta_absX, absolute, gLong.disp, gLong.lab, 0) + else + GenNative(m_sta_longX, longAbs, gLong.disp, gLong.lab, 0); + LoadMSW; + if gLong.fixedDisp then + if smallMemoryModel then + GenNative(m_sta_abs, absolute, gLong.disp+2, gLong.lab, 0) + else + GenNative(m_sta_long, longAbs, gLong.disp+2, gLong.lab, 0) + else + if smallMemoryModel then + GenNative(m_sta_absX, absolute, gLong.disp+2, gLong.lab, 0) + else + GenNative(m_sta_longX, longAbs, gLong.disp+2, gLong.lab, 0); + end {else if} + else begin + LoadLSW; + if gLong.fixedDisp = true then begin + GenNative(m_sta_indl, direct, gLong.disp, nil, 0); + GenNative(m_ldy_imm, immediate, 2, nil, 0); + end {if} + else begin + GenNative(m_sta_indlY, direct, gLong.disp, nil, 0); + GenImplied(m_iny); + GenImplied(m_iny); + end; {else} + LoadMSW; + GenNative(m_sta_indly, direct, gLong.Disp, nil, 0); + end; {else} + gLong := lLong; + end; {case cgLong,cgULong} + + cgByte,cgUByte,cgWord,cgUWord: begin + short := optype in [cgByte,cgUByte]; + simple := false; + zero := false; + if op^.opcode = pc_sto then begin + if short then + if op^.right^.opcode = pc_cnv then + if (op^.right^.q >> 4) in [ord(cgWord),ord(cgUWord)] then + op^.right := op^.right^.left; + with op^.right^ do begin + if opcode = pc_ldo then + simple := true + else if opcode = pc_lod then + simple := LabelToDisp(r) + q < 256 + else if opcode = pc_ldc then begin + simple := true; + zero := q = 0; + end; {else if} + end; {with} + end; {if} + if not (zero or simple) then begin + GenTree(op^.right); + GenImplied(m_pha); + end; {if} + GetPointer(op^.left); + if short then + if simple then + GenNative(m_sep, immediate, 32, nil, 0); + if gLong.where = inPointer then begin + if zero then + GenNative(m_lda_imm, immediate, 0, nil, 0) + else + LoadWord; + if gLong.fixedDisp then + GenNative(m_sta_indl, direct, gLong.disp, nil, 0) + else + GenNative(m_sta_indlY, direct, gLong.disp, nil, 0); + end {if} + else if gLong.where = localAddress then begin + if gLong.fixedDisp then + if (gLong.disp & $FF00) = 0 then + if zero then + GenNative(m_stz_dir, direct, gLong.disp, nil, 0) + else begin + LoadWord; + GenNative(m_sta_dir, direct, gLong.disp, nil, 0); + end {else} + else begin + if zero then begin + GenNative(m_ldx_imm, immediate, gLong.disp, nil, 0); + GenNative(m_stz_dirX, direct, 0, nil, 0); + end {if} + else begin + LoadWord; + GenNative(m_ldx_imm, immediate, gLong.disp, nil, 0); + GenNative(m_sta_dirX, direct, 0, nil, 0); + end; {else} + end {else} + else begin + if (gLong.disp & $FF00) <> 0 then begin + GenImplied(m_txa); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, glong.disp, nil, 0); + GenImplied(m_tax); + gLong.disp := 0; + end; {if} + if zero then + GenNative(m_stz_dirX, direct, gLong.disp, nil, 0) + else begin + LoadWord; + GenNative(m_sta_dirX, direct, gLong.disp, nil, 0); + end; {else} + end; {else} + end {else if} + else {if gLong.where = globalLabel then} begin + if zero then begin + if not smallMemoryModel then + GenNative(m_lda_imm, immediate, 0, nil, 0); + end {if} + else + LoadWord; + if gLong.fixedDisp then + if smallMemoryModel then + if zero then + GenNative(m_stz_abs, absolute, gLong.disp, gLong.lab, 0) + else + GenNative(m_sta_abs, absolute, gLong.disp, gLong.lab, 0) + else + GenNative(m_sta_long, longAbs, gLong.disp, gLong.lab, 0) + else + if smallMemoryModel then + if zero then + GenNative(m_stz_absX, absolute, gLong.disp, gLong.lab, 0) + else + GenNative(m_sta_absX, absolute, gLong.disp, gLong.lab, 0) + else + GenNative(m_sta_longX, longAbs, gLong.disp, gLong.lab, 0); + end; {else} + if short then begin + GenNative(m_rep, immediate, 32, nil, 0); + if opcode = pc_cpi then + GenNative(m_and_imm, immediate, $00FF, nil, 0); + end; {if} + end; {case cgByte,cgUByte,cgWord,cgUWord} + + otherwise: + Error(cge1); + end; {case} +end; {GenStoCpi} + + +procedure GenStrCop (op: icptr); + +{ Generate code for a pc_str or pc_cop } + +var + disp: integer; {store location} + optype: baseTypeEnum; {op^.optype} + special: boolean; {use special processing?} + zero: boolean; {is the operand a constant zero?} + +begin {GenStrCop} +disp := LabelToDisp(op^.r) + op^.q; +optype := op^.optype; +case optype of + cgByte, cgUByte, cgWord, cgUWord: begin + zero := false; + if op^.left^.opcode = pc_ldc then + if op^.opcode = pc_str then + if op^.left^.q = 0 then + zero := true; + if not zero then begin + if optype in [cgByte,cgUByte] then begin + if op^.opcode = pc_str then + if op^.left^.opcode = pc_cnv then + if (op^.left^.q >> 4) in [ord(cgWord),ord(cgUWord)] then + op^.left := op^.left^.left; + if (op^.left^.opcode in [pc_ldc,pc_ldc,pc_lod]) + and (op^.opcode = pc_str) then begin + GenNative(m_sep, immediate, 32, nil, 0); + GenTree(op^.left); + end {if} + else begin + GenTree(op^.left); + GenNative(m_sep, immediate, 32, nil, 0); + end; {else} + end {if} + else + GenTree(op^.left); + end {if} + else + if optype in [cgByte,cgUByte] then + GenNative(m_sep, immediate, 32, nil, 0); + if disp > 255 then begin + GenNative(m_ldx_imm, immediate, disp, nil, 0); + if zero then + GenNative(m_stz_dirx, direct, 0, nil, 0) + else + GenNative(m_sta_dirx, direct, 0, nil, 0); + end {if} + else + if zero then + GenNative(m_stz_dir, direct, disp, nil, 0) + else + GenNative(m_sta_dir, direct, disp, nil, 0); + if optype in [cgByte,cgUByte] then + GenNative(m_rep, immediate, 32, nil, 0); + end; + + cgReal, cgDouble, cgComp, cgExtended: begin + GenTree(op^.left); + GenNative(m_pea, immediate, 0, nil, 0); + GenImplied(m_tdc); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, disp, nil, 0); + GenImplied(m_pha); + if op^.opcode = pc_str then begin + if optype = cgReal then + GenCall(9) + else if optype = cgDouble then + GenCall(10) + else if optype = cgComp then + GenCall(66) + else {if optype = cgExtended then} + GenCall(67); + end {if} + else begin + if optype = cgReal then + GenCall(51) + else if optype = cgDouble then + GenCall(52) + else if optype = cgComp then + GenCall(68) + else {if optype = cgExtended then} + GenCall(69); + end; {else} + end; + + cgLong, cgULong: begin + if (op^.opcode = pc_str) and (op^.left^.opcode in [pc_adl,pc_sbl]) then + GenAdlSbl(op^.left, op) + else if (op^.opcode = pc_str) and (op^.left^.opcode in [pc_inc,pc_dec]) then + GenIncDec(op^.left, op) + else begin + if op^.opcode = pc_str then + gLong.preference := + A_X+onStack+inPointer+localAddress+globalLabel+constant + else + gLong.preference := onStack; + GenTree(op^.left); + case gLong.where of + + A_X: + if disp < 254 then begin + GenNative(m_stx_dir, direct, disp+2, nil, 0); + GenNative(m_sta_dir, direct, disp, nil, 0); + end {else if} + else begin + GenImplied(m_txy); + GenNative(m_ldx_imm, immediate, disp, nil, 0); + GenNative(m_sta_dirX, direct, 0, nil, 0); + GenNative(m_sty_dirX, direct, 2, nil, 0); + if op^.opcode = pc_cop then + GenImplied(m_tyx); + end; {else} + + onStack: + if disp < 254 then begin + if op^.opcode = pc_str then + GenImplied(m_pla) + else {if op^.opcode = pc_cop then} + GenNative(m_lda_s, direct, 1, nil, 0); + GenNative(m_sta_dir, direct, disp, nil, 0); + if op^.opcode = pc_str then + GenImplied(m_pla) + else {if op^.opcode = pc_cop then} + GenNative(m_lda_s, direct, 3, nil, 0); + GenNative(m_sta_dir, direct, disp+2, nil, 0); + end {else if} + else begin + GenNative(m_ldx_imm, immediate, disp, nil, 0); + if op^.opcode = pc_str then + GenImplied(m_pla) + else {if op^.opcode = pc_cop then} + GenNative(m_lda_s, direct, 1, nil, 0); + GenNative(m_sta_dirX, direct, 0, nil, 0); + if op^.opcode = pc_str then + GenImplied(m_pla) + else {if op^.opcode = pc_cop then} + GenNative(m_lda_s, direct, 3, nil, 0); + GenNative(m_sta_dirX, direct, 2, nil, 0); + end; {else} + + inPointer: begin + if (disp < 254) and (gLong.disp < 254) and gLong.fixedDisp + and (disp >= 0) and (gLong.disp >= 0) then begin + GenNative(m_lda_dir, direct, gLong.disp, nil, 0); + GenNative(m_ldx_dir, direct, gLong.disp+2, nil, 0); + GenNative(m_sta_dir, direct, disp, nil, 0); + GenNative(m_stx_dir, direct, disp+2, nil, 0); + end {if} + else if (disp < 254) and (gLong.disp < 254) + and (disp >= 0) and (gLong.disp >= 0) + and (op^.opcode = pc_str) then begin + GenImplied(m_tya); + GenImplied(m_clc); + GenNative(m_adc_dir, direct, gLong.disp, nil, 0); + GenNative(m_sta_dir, direct, disp, nil, 0); + GenNative(m_lda_dir, direct, gLong.disp+2, nil, 0); + GenNative(m_adc_imm, immediate, 0, nil, 0); + GenNative(m_sta_dir, direct, disp+2, nil, 0); + end {else if} + else begin + GenNative(m_ldx_imm, immediate, disp, nil, 0); + if not gLong.fixedDisp then begin + GenImplied(m_tya); + GenImplied(m_clc); + GenNative(m_adc_dir, direct, gLong.disp, nil, 0); + end {if} + else + GenNative(m_lda_dir, direct, gLong.disp, nil, 0); + GenNative(m_sta_dirX, direct, 0, nil, 0); + GenNative(m_lda_dir, direct, gLong.disp+2, nil, 0); + if not gLong.fixedDisp then + GenNative(m_adc_imm, immediate, 0, nil, 0); + GenNative(m_sta_dirX, direct, 2, nil, 0); + end; {else} + end; + + localAddress: + if disp < 254 then begin + GenNative(m_stz_dir, direct, disp+2, nil, 0); + GenImplied(m_tdc); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); + if not gLong.fixedDisp then begin + GenImplied(m_phx); + GenNative(m_adc_s, direct, 1, nil, 0); + GenImplied(m_plx); + end; {if} + GenNative(m_sta_dir, direct, disp, nil, 0); + end {else if disp < 254} + else begin + if not gLong.fixedDisp then + GenImplied(m_phx); + GenNative(m_ldx_imm, immediate, disp, nil, 0); + GenImplied(m_tdc); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, gLong.disp, nil, 0); + if not gLong.fixedDisp then begin + GenNative(m_adc_s, direct, 1, nil, 0); + GenImplied(m_ply); + end; {if} + GenNative(m_sta_dirX, direct, 0, nil, 0); + GenNative(m_stz_dirX, direct, 2, nil, 0); + end; {else} + + globalLabel: begin + if not gLong.fixedDisp then + GenImplied(m_txa) + else if disp > 253 then + GenNative(m_ldx_imm, immediate, disp, nil, 0); + if gLong.fixedDisp then + GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, 0) + else begin + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, gLong.disp, gLong.lab, 0); + end; {else} + if disp < 254 then + GenNative(m_sta_dir, direct, disp, nil, 0) + else + GenNative(m_sta_dirX, direct, 0, nil, 0); + GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, shift16); + if not gLong.fixedDisp then + GenNative(m_adc_imm, immediate, 0, nil, 0); + if disp < 254 then + GenNative(m_sta_dir, direct, disp+2, nil, 0) + else + GenNative(m_sta_dirX, direct, 2, nil, 0); + end; + + constant: + if disp < 254 then begin + GenNative(m_lda_imm, immediate, long(gLong.lval).lsw, nil, 0); + GenNative(m_sta_dir, direct, disp, nil, 0); + GenNative(m_lda_imm, immediate, long(gLong.lval).msw, nil, 0); + GenNative(m_sta_dir, direct, disp+2, nil, 0); + end {else} + else begin + GenNative(m_ldx_imm, immediate, disp, nil, 0); + GenNative(m_lda_imm, immediate, long(gLong.lval).lsw, nil, 0); + GenNative(m_sta_dirX, direct, 0, nil, 0); + GenNative(m_lda_imm, immediate, long(gLong.lval).msw, nil, 0); + GenNative(m_sta_dirX, direct, 2, nil, 0); + end; {else} + + otherwise: + Error(cge1); + end; {case} + end; {else} + end; + + otherwise: ; + + end; {case} +end; {GenStrCop} + + +procedure GenUnaryLong (op: icptr); + +{ generate a pc_bnl or pc_ngl } + +begin {GenUnaryLong} +gLong.preference := onStack; {get the operand} +GenTree(op^.left); +case op^.opcode of {do the operation} + + pc_bnl: begin + GenNative(m_lda_s, direct, 1, nil, 0); + GenNative(m_eor_imm, immediate, $FFFF, nil, 0); + GenNative(m_sta_s, direct, 1, nil, 0); + GenNative(m_lda_s, direct, 3, nil, 0); + GenNative(m_eor_imm, immediate, $FFFF, nil, 0); + GenNative(m_sta_s, direct, 3, nil, 0); + end; {case pc_bnl} + + pc_ngl: begin + GenImplied(m_sec); + GenNative(m_lda_imm, immediate, 0, nil, 0); + GenNative(m_sbc_s, direct, 1, nil, 0); + GenNative(m_sta_s, direct, 1, nil, 0); + GenNative(m_lda_imm, immediate, 0, nil, 0); + GenNative(m_sbc_s, direct, 3, nil, 0); + GenNative(m_sta_s, direct, 3, nil, 0); + end; {case pc_ngl} + end; {case} +gLong.where := onStack; {the result is on the stack} +end; {GenUnaryLong} + + +procedure GenTree {op: icptr}; + +{ generate code for op and its children } +{ } +{ parameters: } +{ op - opcode for which to generate code } + + + procedure GenAdi (op: icptr); + + { generate a pc_adi } + + var + nd: icptr; + + begin {GenAdi} + if not Complex(op^.left) then + if Complex(op^.right) then begin + nd := op^.left; + op^.left := op^.right; + op^.right := nd; + end; {if} + GenTree(op^.left); + if Complex(op^.right) then begin + GenImplied(m_pha); + GenTree(op^.right); + GenImplied(m_clc); + GenNative(m_adc_s, direct, 1, nil, 0); + GenImplied(m_plx); + end {if} + else begin + GenImplied(m_clc); + OperA(m_adc_imm, op^.right); + end; {else} + end; {GenAdi} + + + procedure GenBinLong (op: icptr); + + { generate one of: pc_blr, pc_blx, pc_bal, pc_dvl, pc_mdl, } + { pc_mpl, pc_sll, pc_slr, pc_udl, pc_ulm, pc_uml, pc_vsr } + + var + nd: icptr; {for swapping left/right children} + + + procedure GenOp (ops, opi: integer); + + { generate a binary operation } + { } + { parameters: } + { ops - stack version of operation } + { opi - immediate version of operation } + + var + lab1: integer; {label number} + + begin {GenOp} + GenImplied(m_pla); + if gLong.where = constant then begin + GenNative(opi, immediate, long(gLong.lval).lsw, nil, 0); + GenImplied(m_pha); + GenNative(m_lda_s, direct, 3, nil, 0); + GenNative(opi, immediate, long(gLong.lval).msw, nil, 0); + GenNative(m_sta_s, direct, 3, nil, 0); + end {if} + else begin + GenNative(ops, direct, 3, nil, 0); + GenNative(m_sta_s, direct, 3, nil, 0); + GenImplied(m_pla); + GenNative(ops, direct, 3, nil, 0); + GenNative(m_sta_s, direct, 3, nil, 0); + end; {else} + end; {GenOp} + + + begin {GenBinLong} + if (op^.left^.opcode = pc_ldc) and + (op^.opcode in [pc_blr,pc_blx,pc_bal]) then begin + nd := op^.left; + op^.left := op^.right; + op^.right := nd; + end; {if} + gLong.preference := onStack; + GenTree(op^.left); + if op^.opcode in [pc_blr,pc_blx,pc_bal] then begin + gLong.preference := constant; + GenTree(op^.right); + end {if} + else if op^.opcode in [pc_uml,pc_udl,pc_ulm] then begin + gLong.preference := A_X; + GenTree(op^.right); + if gLong.where = onStack then begin + GenImplied(m_pla); + GenImplied(m_plx); + end; {if} + end {else if} + else begin + gLong.preference := onStack; + GenTree(op^.right); + end; {else} + case op^.opcode of + + pc_blr: GenOp(m_ora_s, m_ora_imm); + + pc_blx: GenOp(m_eor_s, m_eor_imm); + + pc_bal: GenOp(m_and_s, m_and_imm); + + pc_dvl: GenCall(43); + + pc_mdl: begin + GenCall(44); + GenImplied(m_ply); + GenImplied(m_ply); + end; + + pc_mpl: GenCall(42); + + pc_sll: GenCall(45); + + pc_slr: GenCall(47); + + pc_udl: GenCall(49); + + pc_ulm: GenCall(50); + + pc_uml: GenCall(48); + + pc_vsr: GenCall(46); + + otherwise: Error(cge1); + end; {case} + gLong.where := onStack; + end; {GenBinLong} + + + procedure GenBno (op: icptr); + + { Generate code for a pc_bno } + + var + lLong: longType; {requested address type} + + begin {GenBno} + lLong := gLong; + GenTree(op^.left); + gLong := lLong; + GenTree(op^.right); + end; {GenBno} + + + procedure GenBntNgiNot (op: icptr); + + { Generate code for a pc_bnt, pc_ngi or pc_not } + + var + lab1: integer; + + begin {GenntNgiNot} + GenTree(op^.left); + case op^.opcode of + pc_bnt: + GenNative(m_eor_imm, immediate, -1, nil, 0); + + pc_ngi: begin + GenNative(m_eor_imm, immediate, -1, nil, 0); + GenImplied(m_ina); + end; {case pc_ngi} + + pc_not: begin + lab1 := GenLabel; + GenImplied(m_tax); + GenNative(m_beq, relative, lab1, nil, 0); + GenNative(m_lda_imm, immediate, 1, nil, 0); + GenLab(lab1); + GenNative(m_eor_imm, immediate, 1, nil, 0); + end; {if} + end; {case} + end; {GenBntNgiNot} + + + procedure GenCui (op: icptr); + + { Generate code for a pc_cui } + + var + lab1: integer; {return point} + lLong: longType; {used to reserve gLong} + + begin {GenCup} + {save the stack register} + if saveStack or checkStack or (op^.q <> 0) then begin + GenNative(m_ldx_dir, direct, stackLoc, nil, 0); + GenImplied(m_phx); + GenImplied(m_tsx); + GenNative(m_stx_dir, direct, stackLoc, nil, 0); + end; {if} + + {generate parameters} + {place the operands on the stack} + lLong := gLong; + GenTree(op^.left); + + {get the address to call} + gLong.preference := onStack; + GenTree(op^.right); + gLong := lLong; + + {create a return label} + lab1 := GenLabel; + + {place the call/return addrs on stack} + GenNative(m_lda_s, direct, 1, nil, 0); + GenImplied(m_dea); + GenImplied(m_pha); + GenNative(m_sep, immediate, 32, nil, 0); + GenNative(m_lda_s, direct, 5, nil, 0); + GenNative(m_sta_s, direct, 3, nil, 0); + GenNative(m_lda_imm, genAddress, lab1, nil, shift16); + GenNative(m_sta_s, direct, 6, nil, 0); + GenNative(m_rep, immediate, 32, nil, 0); + GenNative(m_lda_imm, genAddress, lab1, nil, 0); + GenNative(m_sta_s, direct, 4, nil, 0); + + {indirect call} + GenImplied(m_rtl); + GenLab(lab1); + + if checkStack then begin + {check the stack for errors} + GenNative(m_ldy_dir, direct, stackLoc, nil, 0); + GenCall(76); + GenImplied(m_ply); + GenNative(m_sty_dir, direct, stackLoc, nil, 0); + end {if} + else if saveStack or (op^.q <> 0) then begin + GenImplied(m_txy); + GenNative(m_ldx_dir, direct, stackLoc, nil, 0); + GenImplied(m_txs); + GenImplied(m_tyx); + GenImplied(m_ply); + GenNative(m_sty_dir, direct, stackLoc, nil, 0); + end; {else} + + {save the returned value} + gLong.where := A_X; + SaveRetValue(op^.optype); + end; {GenCui} + + + procedure GenCup (op: icptr); + + { Generate code for a pc_cup } + + var + lLong: longType; {used to reserve gLong} + + begin {GenCup} + {save the stack register} + if saveStack or checkStack or (op^.q <> 0) then begin + GenNative(m_ldx_dir, direct, stackLoc, nil, 0); + GenImplied(m_phx); + GenImplied(m_tsx); + GenNative(m_stx_dir, direct, stackLoc, nil, 0); + end; {if} + + {generate parameters} + lLong := gLong; + GenTree(op^.left); + gLong := lLong; + + {generate the jsl} + GenNative(m_jsl, longAbs, 0, op^.lab, 0); + + {check the stack for errors} + if checkStack then begin + GenNative(m_ldy_dir, direct, stackLoc, nil, 0); + GenCall(76); + GenImplied(m_ply); + GenNative(m_sty_dir, direct, stackLoc, nil, 0); + GenImplied(m_tay); + end {if} + else if saveStack or (op^.q <> 0) then begin + GenImplied(m_tay); + GenNative(m_lda_dir, direct, stackLoc, nil, 0); + GenImplied(m_tcs); + GenImplied(m_pla); + GenNative(m_sta_dir, direct, stackLoc, nil, 0); + GenImplied(m_tya); + end; {else} + + {save the returned value} + gLong.where := A_X; + SaveRetValue(op^.optype); + end; {GenCup} + + + procedure GenDviMod (op: icptr); + + { Generate code for a pc_dvi, pc_mod, pc_udi or pc_uim } + + var + opcode: pcodes; {temp storage} + + begin {GenDviMod} + if Complex(op^.right) then begin + GenTree(op^.right); + if Complex(op^.left) then begin + GenImplied(m_pha); + GenTree(op^.left); + GenImplied(m_plx); + end {if} + else begin + GenImplied(m_tax); + GenTree(op^.left); + end; {else} + end {if} + else begin + GenTree(op^.left); + LoadX(op^.right); + end; {else} + opcode := op^.opcode; + if opcode = pc_mod then + GenCall(27) + else if opcode = pc_dvi then + GenCall(26) + else {if opcode in [pc_udi,pc_uim] then} begin + GenCall(40); + if opcode = pc_uim then + GenImplied(m_txa); + end; {else} + if rangeCheck then + GenCall(25); + end; {GenDviMod} + + + procedure GenEnt; + + { Generate code for a pc_ent } + + begin {GenEnt} + if rangeCheck then begin {if range checking is on, check for a stack overflow} + GenNative(m_pea, immediate, localSize - returnSize - 1, nil, 0); + GenCall(1); + end; {if} + + if localSize = 0 then begin {create the stack frame} + if parameterSize <> 0 then begin + GenImplied(m_tsc); + GenImplied(m_phd); + GenImplied(m_tcd); + end; {if} + end {if} + else if localSize = 2 then begin + GenImplied(m_pha); + GenImplied(m_tsc); + GenImplied(m_phd); + GenImplied(m_tcd); + end {else if} + else begin + GenImplied(m_tsc); + GenImplied(m_sec); + GenNative(m_sbc_imm, immediate, localSize, nil, 0); + GenImplied(m_tcs); + GenImplied(m_phd); + GenImplied(m_tcd); + end; {if} + + if dataBank then begin {preserve and set data bank} + GenImplied(m_phb); + GenImplied(m_phb); + GenImplied(m_pla); + GenNative(m_sta_dir, direct, bankLoc, nil, 0); + GenNative(m_pea, immediate, 0, @'~GLOBALS', shift8); + GenImplied(m_plb); + GenImplied(m_plb); + end; {if} + + {no pc_nam (yet)} + namePushed := false; + end; {GenEnt} + + + procedure GenFjpTjp (op: icptr); + + { Generate code for a pc_fjp or pc_tjp } + + var + lab1: integer; {branch point} + opcode: pcodes; {op^.left^.opcode} + + begin {GenFjpTjp} + if op^.left^.opcode in [pc_equ,pc_geq,pc_grt,pc_les,pc_leq,pc_neq] then + if op^.left^.opcode in [pc_equ,pc_neq] then + GenEquNeq(op^.left, op^.opcode, op^.q) + else + GenCmp(op^.left, op^.opcode, op^.q) + else begin + lab1 := GenLabel; + GenTree(op^.left); + opcode := op^.left^.opcode; + if NeedsCondition(opcode) then + GenImplied(m_tax) + else if opcode = pc_ind then + if op^.left^.optype in [cgByte,cgUByte] then + GenImplied(m_tax); + if op^.opcode = pc_fjp then + GenNative(m_bne, relative, lab1, nil, 0) + else {if op^.opcode = pc_tjp then} + GenNative(m_beq, relative, lab1, nil, 0); + GenNative(m_brl, longrelative, op^.q, nil, 0); + GenLab(lab1); + end; {else} + end; {GenFjpTjp} + + + procedure GenLaoLad (op: icptr); + + { Generate code for a pc_lao, pc_lad } + + var + q: integer; {displacement} + + begin {GenLaoLad} + if op^.opcode = pc_lad then + q := 0 + else + q := op^.q; + if (globalLabel & gLong.preference) <> 0 then begin + gLong.fixedDisp := true; + gLong.where := globalLabel; + gLong.disp := q; + gLong.lab := op^.lab; + end {if} + else if (A_X & gLong.preference) <> 0 then begin + gLong.where := A_X; + GenNative(m_ldx_imm, immediate, q, op^.lab, shift16); + GenNative(m_lda_imm, immediate, q, op^.lab, 0); + end {else if} + else begin + gLong.where := onStack; + GenNative(m_pea, immediate, q, op^.lab, shift16); + GenNative(m_pea, immediate, q, op^.lab, 0); + end; {else} + end; {GenLaoLad} + + + procedure GenLbfLbu (op: icptr); + + { Generate code for a pc_lbf or pc_lbu } + + var + lLong: longType; {requested address type} + + begin {GenLbfLbu} + lLong := gLong; + gLong.preference := onStack; + GenTree(op^.left); + GenNative(m_pea, immediate, op^.r, nil, 0); + GenNative(m_pea, immediate, op^.q, nil, 0); + if op^.opcode = pc_lbf then + GenCall(73) + else + GenCall(72); + if op^.optype in [cgLong,cgULong] then begin + if (A_X & lLong.preference) <> 0 then + gLong.where := A_X + else begin + gLong.where := onStack; + GenImplied(m_phx); + GenImplied(m_pha); + end; {else} + end; {if} + end; {GenLbfLbu} + + + procedure GenLca (op: icptr); + + { Generate code for a pc_lca } + + var + i: integer; {loop/index variable} + + begin {GenLca} + gLong.where := onStack; + GenNative(m_pea, immediate, stringSize, nil, stringReference+shift16); + GenNative(m_pea, immediate, stringSize, nil, stringReference); + if maxString-stringSize >= op^.q+1 then begin + for i := 1 to op^.q do + stringSpace[i+stringSize] := op^.str^.str[i]; + stringSpace[stringSize+op^.q+1] := chr(0); + stringSize := stringSize+op^.q+1; + end + else + Error(cge3); + op^.optype := cgULong; + end; {GenLca} + + + procedure GenLda (op: icptr); + + { Generate code for a pc_lda } + + begin {GenLda} + if (localAddress & gLong.preference) <> 0 then begin + gLong.fixedDisp := true; + gLong.where := localAddress; + gLong.disp := LabelToDisp(op^.r) + op^.q; + end {if} + else if (A_X & gLong.preference) <> 0 then begin + gLong.where := A_X; + GenImplied(m_tdc); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, LabelToDisp(op^.r) + op^.q, nil, 0); + GenNative(m_ldx_imm, immediate, 0, nil, 0); + end {else if} + else begin + gLong.where := onStack; + GenNative(m_pea, immediate, 0, nil, 0); + GenImplied(m_tdc); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, LabelToDisp(op^.r) + op^.q, nil, 0); + GenImplied(m_pha); + end; {else} + end; {GenLda} + + + procedure GenLdc (op: icptr); + + { Generate code for a pc_ldc } + + type + kind = (vint, vbyte, vreal); {kinds of equivalenced data} + + var + i: integer; {loop/index variable} + rec: realrec; {conversion record} + switch: packed record {used for type conversion} + case rkind: kind of + vint: (i: integer); + vbyte: (b1, b2, b3, b4, b5, b6, b7, b8: byte); + vreal: (r: double); + end; + + begin {GenLdc} + case op^.optype of + cgByte: begin + if op^.q > 127 then + op^.q := op^.q | $FF00; + GenNative(m_lda_imm, immediate, op^.q, nil, 0); + end; + + cgUByte, cgWord, cgUWord: + GenNative(m_lda_imm, immediate, op^.q, nil, 0); + + cgReal, cgDouble, cgComp, cgExtended: begin + rec.itsReal := op^.rval; + CnvSX(rec); + i := 9; + while i >= 0 do begin + switch.b1 := rec.inSANE[i]; + switch.b2 := rec.inSANE[i+1]; + GenNative(m_pea, immediate, switch.i, nil, 0); + i := i-2; + end; {while} + end; + + cgLong, cgULong: + if (constant & gLong.preference) <> 0 then begin + gLong.where := constant; + gLong.lval := op^.lval; + end + else if (A_X & gLong.preference) <> 0 then begin + gLong.where := A_X; + GenNative(m_lda_imm, immediate, long(op^.lval).lsw, nil, 0); + GenNative(m_ldx_imm, immediate, long(op^.lval).msw, nil, 0); + end + else begin + gLong.where := onStack; + GenNative(m_pea, immediate, long(op^.lval).msw, nil, 0); + GenNative(m_pea, immediate, long(op^.lval).lsw, nil, 0); + end; + + otherwise: + Error(cge1); + end; {case} + end; {GenLdc} + + + procedure GenLdo (op: icptr); + + { Generate code for a pc_ldo } + + var + lab1: integer; {branch point} + + begin {GenLdo} + case op^.optype of + cgWord, cgUWord: + if smallMemoryModel then + GenNative(m_lda_abs, absolute, op^.q, op^.lab, 0) + else + GenNative(m_lda_long, longAbs, op^.q, op^.lab, 0); + + cgByte, cgUByte: begin + if smallMemoryModel then + GenNative(m_lda_abs, absolute, op^.q, op^.lab, 0) + else + GenNative(m_lda_long, longAbs, op^.q, op^.lab, 0); + GenNative(m_and_imm, immediate, 255, nil, 0); + if op^.optype = cgByte then begin + GenNative(m_bit_imm, immediate, $0080, nil, 0); + lab1 := GenLabel; + GenNative(m_beq, relative, lab1, nil, 0); + GenNative(m_ora_imm, immediate, $FF00, nil, 0); + GenLab(lab1); + GenNative(m_cmp_imm, immediate, $0000, nil, 0); + end; {if} + end; + + cgReal, cgDouble, cgComp, cgExtended: begin + GenNative(m_pea, immediate, op^.q, op^.lab, shift16); + GenNative(m_pea, immediate, op^.q, op^.lab, 0); + if op^.optype = cgReal then + GenCall(21) + else if op^.optype = cgDouble then + GenCall(22) + else if op^.optype = cgComp then + GenCall(70) + else {if op^.optype = cgExtended then} + GenCall(71); + end; + + cgLong, cgULong: begin + if (A_X & gLong.preference) <> 0 then + gLong.where := A_X + else + gLong.where := onStack; + if smallMemoryModel then begin + GenNative(m_ldx_abs, absolute, op^.q+2, op^.lab, 0); + GenNative(m_lda_abs, absolute, op^.q, op^.lab, 0); + if gLong.where = onStack then begin + GenImplied(m_phx); + GenImplied(m_pha); + end; {if} + end {if} + else begin + GenNative(m_lda_long, longabsolute, op^.q+2, op^.lab, 0); + if gLong.where = onStack then + GenImplied(m_pha) + else + GenImplied(m_tax); + GenNative(m_lda_long, longabsolute, op^.q, op^.lab, 0); + if gLong.where = onStack then + GenImplied(m_pha); + end; {else} + end; {case cgLong,cgULong} + + otherwise: + Error(cge1); + end; {case} + end; {GenLdo} + + + procedure GenLnm (op: icptr); + + { Generate code for a pc_lnm } + + begin {GenLnm} + if op^.left <> nil then + GenTree(op^.left); + if traceBack then begin + GenNative(m_pea, immediate, op^.r, nil, 0); + GenCall(6); + end; {if} + if debugFlag then begin + GenNative(m_cop, immediate, op^.q, nil, 0); + GenNative(d_wrd, special, op^.r, nil, 0); + end; {if} + end; {GenLnm} + + + procedure GenLod (op: icptr); + + { Generate code for a pc_lod } + + var + disp: integer; {load location} + lab1: integer; {branch point} + optype: baseTypeEnum; {op^.optype} + + begin {GenLod} + disp := LabelToDisp(op^.r) + op^.q; + optype := op^.optype; + case optype of + cgReal, cgDouble, cgComp, cgExtended: begin + GenNative(m_pea, immediate, 0, nil, 0); + GenImplied(m_tdc); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, disp, nil, 0); + GenImplied(m_pha); + if optype = cgReal then + GenCall(21) + else if optype = cgDouble then + GenCall(22) + else if optype = cgComp then + GenCall(70) + else {if optype = cgExtended then} + GenCall(71); + end; + + cgLong, cgULong: begin + if ((inPointer & gLong.preference) <> 0) and (disp < 254) then + begin + gLong.where := inPointer; + gLong.fixedDisp := true; + gLong.disp := disp; + end {if} + else if ((A_X & gLong.preference) <> 0) and (disp < 254) then begin + gLong.where := A_X; + GenNative(m_ldx_dir, direct, disp+2, nil, 0); + GenNative(m_lda_dir, direct, disp, nil, 0); + end {else if} + else begin + gLong.where := onStack; + if disp >= 254 then begin + GenNative(m_ldx_imm, immediate, disp, nil, 0); + GenNative(m_lda_dirx, direct, 2, nil, 0); + GenImplied(m_pha); + GenNative(m_lda_dirx, direct, 0, nil, 0); + GenImplied(m_pha); + end {if} + else begin + GenNative(m_pei_dir, direct, disp+2, nil, 0); + GenNative(m_pei_dir, direct, disp, nil, 0); + end; {else} + end; {else} + end; + + cgByte, cgUByte, cgWord, cgUWord: begin + if disp >= 256 then begin + GenNative(m_ldx_imm, immediate, disp, nil, 0); + GenNative(m_lda_dirx, direct, 0, nil, 0); + end + else + GenNative(m_lda_dir, direct, disp, nil, 0); + if optype in [cgByte,cgUByte] then begin + GenNative(m_and_imm, immediate, $00FF, nil, 0); + if optype = cgByte then begin + GenNative(m_bit_imm, immediate, $0080, nil, 0); + lab1 := GenLabel; + GenNative(m_beq, relative, lab1, nil, 0); + GenNative(m_ora_imm, immediate, $FF00, nil, 0); + GenLab(lab1); + GenNative(m_cmp_imm, immediate, $0000, nil, 0); + end; {if} + end; + end; + + otherwise: + Error(cge1); + + end; {case} + end; {GenLod} + + + procedure GenLorLnd (op: icptr); + + { Generate code for a pc_lor or pc_lnd } + + var + lab1,lab2: integer; {label} + nd: icptr; {temp node pointer} + opc: pcodes; {operation code} + + + procedure DoOra; + + { do some common oring operations to reduce space } + + begin {DoOra} + if gLong.where = onStack then begin + GenImplied(m_pla); + GenNative(m_sta_dir, direct, dworkLoc, nil, 0); + GenImplied(m_pla); + end {if} + else + GenNative(m_stx_dir, direct, dworkLoc, nil, 0); + GenNative(m_ora_dir, direct, dworkLoc, nil, 0); + end; {DoOra} + + + begin {GenLorLnd} + opc := op^.opcode; + lab1 := GenLabel; + gLong.preference := A_X; + GenTree(op^.left); + DoOra; + + lab2 := GenLabel; + if opc = pc_lnd then + GenNative(m_bne, relative, lab2, nil, 0) + else begin + GenNative(m_beq, relative, lab2, nil, 0); + GenNative(m_lda_imm, immediate, 1, nil, 0); + end; {else} + GenNative(m_brl, longrelative, lab1, nil, 0); + GenLab(lab2); + + gLong.preference := A_X; + GenTree(op^.right); + DoOra; + GenNative(m_beq, relative, lab1, nil, 0); + GenNative(m_lda_imm, immediate, 1, nil, 0); + GenLab(lab1); + end; {GenLorLnd} + + + procedure GenMov (op: icptr; duplicate: boolean); + + { Generate code for a pc_mov } + { } + { parameters: } + { op - pc_mov instruction } + { duplicate - should the source address be left on the } + { stack? } + + var + banks: integer; {number of banks to move} + + + procedure Load (opcode: integer; op: icptr); + + { generate a load immediate based on instruction type } + { } + { parameters: } + { opcode - native code load operation } + { op - node to load } + + var + i: integer; + + begin {Load} + if op^.opcode = pc_lao then + GenNative(opcode, immediate, op^.q, op^.lab, 0) + else begin + GenNative(opcode, immediate, stringsize, nil, StringReference); + if maxstring-stringsize >= op^.q then begin + for i := 1 to op^.q do + stringspace[i+stringsize] := op^.str^.str[i]; + stringsize := stringsize + op^.q; + end {if} + else + Error(cge3); + end; {else} + end; {Load} + + + begin {GenMov} + {determine if the destination address must be left on the stack} + if smallMemoryModel + and (not duplicate) + and (op^.left^.opcode in [pc_lao,pc_lca]) + and (op^.right^.opcode in [pc_lao,pc_lca]) then begin + + {take advantage of any available short cuts} + Load(m_ldy_imm, op^.left); + Load(m_ldx_imm, op^.right); + GenNative(m_lda_imm, immediate, op^.q-1, nil, 0); + GenImplied(m_phb); + GenImplied(m_mvn); + with op^.left^ do + if opcode = pc_lao then + GenNative(d_bmov, immediate, q, lab, shift16) + else + GenNative(d_bmov, immediate, 0, nil, stringReference+shift16); + with op^.right^ do + if opcode = pc_lao then + GenNative(d_bmov, immediate, q, lab, shift16) + else + GenNative(d_bmov, immediate, 0, nil, stringReference+shift16); + GenImplied(m_plb); + end {if} + else begin + + {no short cuts are available - do it the hard way} + gLong.preference := onStack; + GenTree(op^.left); + gLong.preference := onStack; + GenTree(op^.right); + banks := op^.r; + if banks <> 0 then + GenNative(m_pea, immediate, banks, nil, 0); + GenNative(m_pea, immediate, op^.q, nil, 0); + if banks = 0 then begin + if duplicate then + GenCall(55) + else + GenCall(54); + end {if} + else + if duplicate then + GenCall(63) + else + GenCall(62); + end; {else} + end; {GenMov} + + + procedure GenMpi (op: icptr); + + { Generate code for a pc_mpi or pc_umi } + + var + nd: icptr; + + begin {GenMpi} + if not Complex(op^.left) then + if Complex(op^.right) then begin + nd := op^.left; + op^.left := op^.right; + op^.right := nd; + end; {if} + GenTree(op^.left); + if Complex(op^.right) then begin + GenImplied(m_pha); + GenTree(op^.right); + GenImplied(m_plx); + end {if} + else + LoadX(op^.right); + if op^.opcode = pc_mpi then + GenCall(28) + else {pc_umi} + GenCall(39); + if rangeCheck then + GenCall(25); + end; {GenMpi} + + + procedure GenNam (op: icptr); + + { Generate code for a pc_nam } + + var + i: integer; {loop/index variable} + len: integer; {length of the file name} + + + function ToUpper (ch: char): char; + + { Return the uppercase equivalent of the input character } + + begin {ToUpper} + if (ch >= 'a') and (ch <= 'z') then + ch := chr(ord(ch)-ord('a')+ord('A')); + ToUpper := ch; + end; {ToUpper} + + + begin {GenNam} + {generate a call to install the name in the traceback facility} + if traceBack then begin + GenNative(m_pea, immediate, stringSize, nil, stringReference+shift16); + GenNative(m_pea, immediate, stringSize, nil, stringReference); + GenCall(5); + namePushed := true; + end; {if} + + {send the name to the profiler} + if profileFlag then begin + GenNative(m_cop, immediate, 3, nil, 0); + GenNative(d_add, genaddress, stringSize, nil, stringReference); + GenNative(d_add, genaddress, stringSize, nil, stringReference+shift16); + end; {if} + + {place the name in the string buffer} + if maxString-stringSize >= op^.q+1 then begin + stringSpace[stringSize+1] := chr(op^.q); + for i := 1 to op^.q do + stringSpace[i+stringSize+1] := op^.str^.str[i]; + stringSize := stringSize + op^.q + 1; + end {if} + else + Error(cge3); + + {send the file name to the debugger} + if debugFlag then begin + GenNative(m_cop, immediate, 6, nil, 0); + GenNative(d_add, genaddress, stringSize, nil, stringReference); + GenNative(d_add, genaddress, stringSize, nil, stringReference+shift16); + len := sourceFileGS.theString.size; + if len > 255 then + len := 255; + if maxString-stringSize >= len+1 then begin + stringSpace[stringSize+1] := chr(len); + for i := 1 to len do + stringSpace[i+stringSize+1] := + ToUpper(sourceFileGS.theString.theString[i]); + stringSize := stringSize + len + 1; + end {if} + else + Error(cge3); + end; {if} + end; {GenNam} + + + procedure GenNat (op: icptr); + + { Generate code for a pc_nat } + + var + flags: integer; {work var for flags} + mode: addressingmode; {work var for addressing mode} + pval: longint; {temp pointer} + val: longint; {constant operand} + + begin {GenNat} + val := op^.opnd; + flags := op^.q; + pval := op^.llab; + mode := addressingMode(op^.r); + if op^.slab <> 0 then + val := val+LabelToDisp(op^.slab); + if mode in [relative,longrelative] then + GenNative(op^.s, mode, op^.llab, op^.lab, op^.q) + else if (mode = longabsolute) and (op^.llab <> 0) then + GenNative(op^.s, mode, long(val).lsw, pointer(pval), + flags | localLab) + else if (mode = longabsolute) and (op^.llab = 0) + and (op^.lab = nil) then + GenNative(op^.s, mode, 0, pointer(val), flags | constantOpnd) + else begin + if (mode = absolute) and (op^.llab = 0) then + flags := flags | constantOpnd; + if op^.llab <> 0 then + GenNative(op^.s, mode, long(val).lsw, pointer(pval), + flags | localLab) + else + GenNative(op^.s, mode, long(val).lsw, op^.lab, flags); + end; {else} + end; {GenNat} + + + procedure GenNgr (op: icptr); + + { Generate code for a pc_ngr } + + begin {GenNgr} + GenTree(op^.left); + GenNative(m_lda_s, direct, 9, nil, 0); + GenNative(m_eor_imm, immediate, -32767-1, nil, 0); + GenNative(m_sta_s, direct, 9, nil, 0); + end; {GenNgr} + + + procedure GenPop (op: icptr); + + { Generate code for a pc_pop } + + var + isIncLoad: boolean; {is the operand one of the inc/dec & load commands?} + + begin {GenPop} + glong.preference := A_X; {generate the operand} + isIncLoad := op^.left^.opcode in + [pc_lil,pc_lli,pc_ldl,pc_lld,pc_gil,pc_gli,pc_gdl,pc_gld, + pc_iil,pc_ili,pc_idl,pc_ild]; + if isIncLoad then + skipLoad := true; + if op^.left^.opcode = pc_mov then + GenMov(op^.left, false) + else begin + GenTree(op^.left); + if isIncLoad then + skipLoad := false; + case op^.optype of {do the pop} + otherwise: ; + + cgLong, cgULong: + if not isIncLoad then + if gLong.where = onStack then begin + GenImplied(m_pla); + GenImplied(m_pla); + end; {if} + {else do nothing} + + cgReal, cgDouble, cgComp, cgExtended: begin + GenImplied(m_tsc); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, 10, nil, 0); + GenImplied(m_tcs); + end; + end; {case} + end; {else} + end; {GenPop} + + + procedure GenPsh (op: icptr); + + { Generate code for a pc_psh } + + begin {GenPsh} + gLong.preference := onStack; + GenTree(op^.left); + GenTree(op^.right); + GenImplied(m_pha); + GenCall(77); + end; {GenPsh} + + + procedure GenRealBinOp (op: icptr); + + { Generate code for a pc_adr, pc_dvr, pc_mpr or pc_sbr } + + var + nd: icptr; {temp pointer} + snum: integer; {library subroutine numbers} + ss,sd,sc,se: integer; {sane call numbers} + + begin {GenRealBinOp} + case op^.opcode of + pc_adr: begin + snum := 56; + ss := $0200; + sd := $0100; + sc := $0500; + se := $0000; + end; + + pc_dvr: begin + snum := 57; + ss := $0206; + sd := $0106; + sc := $0506; + se := $0006; + end; + + pc_mpr: begin + snum := 58; + ss := $0204; + sd := $0104; + sc := $0504; + se := $0004; + end; + + pc_sbr: begin + snum := 59; + ss := $0202; + sd := $0102; + sc := $0502; + se := $0002; + end; + end; {case} + + if op^.opcode in [pc_mpr,pc_adr] then + if op^.left^.opcode in [pc_lod,pc_ldo] then begin + nd := op^.left; + op^.left := op^.right; + op^.right := nd; + end; {if} + GenTree(op^.left); + if (op^.right^.opcode in [pc_lod,pc_ldo]) and (floatCard = 0) then + with op^.right^ do begin + if opcode = pc_lod then begin + GenNative(m_pea, immediate, 0, nil, 0); + GenImplied(m_tdc); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, LabelToDisp(r) + q, nil, 0); + GenImplied(m_pha); + end {if} + else begin + GenNative(m_pea, immediate, q, lab, shift16); + GenNative(m_pea, immediate, q, lab, 0); + end; {else} + GenNative(m_pea, immediate, 0, nil, 0); + GenImplied(m_tsc); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, 7, nil, 0); + GenImplied(m_pha); + if optype = cgReal then + sd := ss + else if optype = cgExtended then + sd := se + else if optype = cgComp then + sd := sc; + GenNative(m_pea, immediate, sd, nil, 0); + GenNative(m_ldx_imm, immediate, $090A, nil, 0); + GenNative(m_jsl, longAbs, 0, nil, toolCall); + end {with} + else begin + GenTree(op^.right); + GenCall(snum); + end; {else} + end; {GenRealBinOp} + + + procedure GenRet (op: icptr); + + { Generate code for a pc_ret } + + var + size: integer; {localSize + parameterSize} + + begin {GenRet} + {pop the name record} + if namePushed then + GenCall(2); + + {generate an exit code for the debugger's benefit} + if debugFlag then + GenNative(m_cop, immediate, 4, nil, 0); + + {if anything needs to be removed from the stack, move the return val} + size := localSize + parameterSize; + if parameterSize <> 0 then begin + if localSize > 254 then begin + GenNative(m_ldx_imm, immediate, localSize+1, nil, 0); + GenNative(m_lda_dirx, direct, 0, nil, 0); + GenNative(m_ldy_dirx, direct, 1, nil, 0); + GenNative(m_ldx_imm, immediate, + localSize+parameterSize+1, nil, 0); + GenNative(m_sta_dirx, direct, 0, nil, 0); + GenNative(m_sty_dirx, direct, 1, nil, 0); + end {if} + else begin + GenNative(m_lda_dir, direct, localSize+2, nil, 0); + if localSize+parameterSize > 254 then begin + GenNative(m_ldx_imm, immediate, + localSize+parameterSize+1, nil, 0); + GenNative(m_sta_dirx, direct, 1, nil, 0); + GenNative(m_lda_dir, direct, localSize+1, nil, 0); + GenNative(m_sta_dirx, direct, 0, nil, 0); + end {if} + else begin + GenNative(m_sta_dir, direct, + localSize+parameterSize+2, nil, 0); + GenNative(m_lda_dir, direct, localSize+1, nil, 0); + GenNative(m_sta_dir, direct, + localSize+parameterSize+1, nil, 0); + end; {else} + end; {else} + end; {if} + + {load the value to return} + case op^.optype of + + cgVoid: ; + + cgByte,cgUByte: begin + GenNative(m_lda_dir, direct, funLoc, nil, 0); + GenNative(m_and_imm, immediate, $00FF, nil, 0); + if size <> 2 then + GenImplied(m_tay); + end; + + cgWord,cgUWord: + if size = 2 then + GenNative(m_lda_dir, direct, funLoc, nil, 0) + else + GenNative(m_ldy_dir, direct, funLoc, nil, 0); + + cgReal: + GenCall(3); + + cgDouble: + GenCall(4); + + cgComp: + GenCall(64); + + cgExtended: + GenCall(65); + + cgLong,cgULong: begin + GenNative(m_ldx_dir, direct, funLoc+2, nil, 0); + GenNative(m_ldy_dir, direct, funLoc, nil, 0); + end; + + otherwise: + Error(cge1); + end; {case} + + {restore data bank reg} + if dataBank then begin + GenNative(m_lda_dir, direct, bankLoc, nil, 0); + GenImplied(m_pha); + GenImplied(m_plb); + GenImplied(m_plb); + end; {if} + + {get rid of the stack frame space} + if size <> 0 then + GenImplied(m_pld); + if size = 2 then + GenImplied(m_ply) + else if size <> 0 then begin + GenImplied(m_tsc); + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, size, nil, 0); + GenImplied(m_tcs); + end; {if} + + {put return value in correct place} + case op^.optype of + cgByte,cgUByte,cgWord,cgUWord: begin + if size <> 2 then + GenImplied(m_tya); + if toolParms then {save value on stack for tools} + GenNative(m_sta_s, direct, returnSize+1, nil, 0); + end; + + cgLong,cgULong,cgReal,cgDouble,cgComp,cgExtended: begin + GenImplied(m_tya); + if toolParms then begin {save value on stack for tools} + GenNative(m_sta_s, direct, returnSize+1, nil, 0); + GenImplied(m_txa); + GenNative(m_sta_s, direct, returnSize+3, nil, 0); + end; {if} + end; + + cgVoid: ; + + otherwise: + Error(cge1); + end; {case} + + {return to the caller} + GenImplied(m_rtl); + end; {GenRet} + + + procedure GenSbfCbf (op: icptr); + + { Generate code for a pc_sbf or pc_cbf } + + begin {GenSbfCbf} + gLong.preference := onStack; + GenTree(op^.left); + GenNative(m_pea, immediate, op^.r, nil, 0); + GenNative(m_pea, immediate, op^.q, nil, 0); + if op^.optype in [cgLong,cgULong] then begin + gLong.preference := onStack; + GenTree(op^.right); + end {if} + else begin + GenNative(m_pea, immediate, 0, nil, 0); + GenTree(op^.right); + GenImplied(m_pha); + end; {else} + if op^.opcode = pc_sbf then + GenCall(74) + else begin + GenCall(75); + if not (op^.optype in [cgLong,cgULong]) then begin + GenImplied(m_pla); + GenImplied(m_plx); + end; {if} + end; {else} + end; {GenSbfCbf} + + + procedure GenSbi (op: icptr); + + { Generate code for a pc_sbi } + + begin {GenSbi} + if Complex(op^.left) or Complex(op^.right) then begin + GenTree(op^.right); + if Complex(op^.left) then begin + GenImplied(m_pha); + GenTree(op^.left); + GenImplied(m_sec); + GenNative(m_sbc_s, direct, 1, nil, 0); + GenImplied(m_plx); + end {if} + else begin + GenNative(m_eor_imm, immediate, $FFFF, nil, 0); + GenImplied(m_sec); + OperA(m_adc_imm, op^.left); + end; {else} + end {if} + else begin + GenTree(op^.left); + GenImplied(m_sec); + OperA(m_sbc_imm, op^.right); + end; {else} + end; {GenSbi} + + + procedure GenStk (op: icptr); + + { Generate code for a pc_stk } + + var + lab1: integer; {branch point} + + begin {GenStk} + glong.preference := onStack; {generate the operand} + GenTree(op^.left); + if op^.optype in {do the stk} + [cgByte, cgUByte, cgWord, cgUWord] then + GenImplied(m_pha); + end; {GenStk} + + + procedure GenShlShrUsr (op: icptr); + + { Generate code for a pc_shl, pc_shr or pc_usr } + + var + i,op1,op2,num: integer; {temp variables} + + begin {GenShlShrUsr} + {get the standard native operations} + if op^.opcode = pc_shl then begin + op1 := m_asl_a; + op2 := m_lsr_a; + end {if} + else begin + op1 := m_lsr_a; + op2 := m_asl_a; + end; {else} + + {take short cuts if they are legal} + if (op^.right^.opcode = pc_ldc) and (op^.opcode <> pc_shr) then begin + num := op^.right^.q; + if (num > 16) or (num < -16) then + GenNative(m_lda_imm, immediate, 0, nil, 0) + else if num > 0 then begin + GenTree(op^.left); + if num >= 8 then begin + GenImplied(m_xba); + if op1 = m_lsr_a then + i := $00FF + else + i := $FF00; + GenNative(m_and_imm, immediate, i, nil, 0); + num := num-8; + end; {if} + for i := 1 to num do + GenImplied(op1); + end {else if} + else if num < 0 then begin + GenTree(op^.left); + if num <= -8 then begin + GenImplied(m_xba); + if op2 = m_lsr_a then + i := $00FF + else + i := $FF00; + GenNative(m_and_imm, immediate, i, nil, 0); + num := num+8; + end; {if} + for i := 1 to -num do + GenImplied(op2); + end {else if} + else + GenTree(op^.left); + end {if} + else begin + GenTree(op^.left); + if Complex(op^.right) then begin + GenImplied(m_pha); + GenTree(op^.right); + GenImplied(m_tax); + GenImplied(m_pla); + end {if} + else + LoadX(op^.right); + if op^.opcode = pc_shl then + GenCall(23) + else if op^.opcode = pc_shr then + GenCall(24) + else {if op^.opcode = pc_usr then} + GenCall(41); + end; {else} + end; {GenShlShrUsr} + + + procedure GenTl1 (op: icptr); + + { Generate code for a pc_tl1 } + + var + lLong: longType; {used to reserve gLong} + tp: baseTypeEnum; {operand type} + + begin {GenTl1} + if op^.r in [2,4] then begin + GenImplied(m_pha); + if op^.r = 4 then + GenImplied(m_pha); + end; {if} + lLong := gLong; + GenTree(op^.left); + gLong := lLong; + GenNative(m_ldx_imm, immediate, op^.q, nil, 0); + GenNative(m_jsl, longAbs, 0, pointer(op^.lval), toolCall); + if smallMemoryModel then + GenNative(m_sta_abs, absolute, 0, @'~TOOLERROR', 0) + else + GenNative(m_sta_long, longAbs, 0, @'~TOOLERROR', 0); + if op^.r in [2,4] then begin + if op^.r = 2 then begin + GenImplied(m_pla); + tp := cgWord; + end {if} + else begin + gLong.where := onStack; + tp := cgLong; + end; {else} + end; {if} + end; {GenTl1} + + + procedure GenTri (op: icptr); + + { Generate code for a pc_tri } + + var + lab1,lab2,lab3: integer; {label for branches} + + begin {GenTri} + lab1 := GenLabel; + lab2 := GenLabel; + lab3 := GenLabel; + GenTree(op^.left); + if op^.left^.opcode in + [pc_and,pc_ior,pc_cui,pc_cup,pc_lor,pc_lnd,pc_ldl,pc_lil,pc_lld, + pc_lli,pc_gil,pc_gli,pc_gdl,pc_gld] then + GenImplied(m_tax); + GenNative(m_beq, relative, lab1, nil, 0); + GenNative(m_brl, longrelative, lab2, nil, 0); + GenLab(lab1); + gLong.preference := onStack; + GenTree(op^.right^.right); + GenNative(m_brl, longrelative, lab3, nil, 0); + GenLab(lab2); + gLong.preference := onStack; + GenTree(op^.right^.left); + GenLab(lab3); + gLong.where := onStack; + end; {GenTri} + + + procedure GenXjp (op: icptr); + + { Generate code for a pc_xjp } + + var + lab1,lab2: integer; + q: integer; + + begin {GenXjp} + q := op^.q; + GenTree(op^.left); + GenNative(m_cmp_imm, immediate, q, nil, 0); + lab1 := GenLabel; + GenNative(m_bcc, relative, lab1, nil, 0); + GenNative(m_lda_imm, immediate, q, nil, 0); + GenLab(lab1); + GenImplied(m_asl_a); + GenImplied(m_tax); + lab1 := GenLabel; + GenNative(m_lda_longx, longAbs, lab1, nil, 0); + GenImplied(m_pha); + GenImplied(m_rts); + GenLab(lab1); + end; {GenXjp} + + + procedure DirEnp; + + { Generate code for a dc_enp } + + begin {DirEnp} + GenImplied(d_end); + EndSeg; + InitLabels; + end; {DirEnp} + + + procedure DirStr (op: icptr); + + { Generate code for a dc_str } + + begin {DirStr} + skipLoad := false; + InitNative; + Header(op^.lab, op^.r, op^.q); + end; {DirStr} + + + procedure DirSym (op: icptr); + + { Generate code for a dc_sym } + + begin {DirSym} + if debugFlag then + GenNative(d_sym, special, op^.q, pointer(op^.lab), 0); + end; {DirSym} + + +begin {GenTree} +{write('GEN: '); WriteCode(op); {debug} +Spin; +case op^.opcode of + dc_cns: GenNative(d_cns, gnrConstant, op^.q, pointer(op), 0); + dc_dst: GenNative(d_lab, gnrSpace, op^.q, nil, 0); + dc_enp: DirEnp; + dc_lab: GenLab(op^.q); + dc_loc,dc_prm: ; + dc_glb: GenNative(d_lab, gnrLabel, op^.r, op^.lab, isPrivate*op^.q); + dc_pin: GenNative(d_pin, special, 0, nil, 0); + dc_str: DirStr(op); + dc_sym: DirSym(op); + pc_add: GenNative(d_add, genaddress, op^.q, nil, 0); + pc_adi: GenAdi(op); + pc_adl,pc_sbl: GenAdlSbl(op, nil); + pc_adr,pc_dvr,pc_mpr,pc_sbr: GenRealBinOp(op); + pc_and,pc_bnd,pc_bor,pc_bxr,pc_ior: GenLogic(op); + pc_blr,pc_blx,pc_bal,pc_dvl,pc_mdl,pc_mpl,pc_sll,pc_slr,pc_udl,pc_ulm, + pc_uml,pc_vsr: GenBinLong(op); + pc_bnl,pc_ngl: GenUnaryLong(op); + pc_bno: GenBno(op); + pc_bnt,pc_ngi,pc_not: GenBntNgiNot(op); + pc_cnv: GenCnv(op); + pc_cui: GenCui(op); + pc_cup: GenCup(op); + pc_dec,pc_inc: GenIncDec(op, nil); + pc_dvi,pc_mod,pc_udi,pc_uim: GenDviMod(op); + pc_ent: GenEnt; + pc_equ,pc_neq: GenEquNeq(op, op^.opcode, 0); + pc_fjp,pc_tjp: GenFjpTjp(op); + pc_geq,pc_grt,pc_leq,pc_les: GenCmp(op, op^.opcode, 0); + pc_gil,pc_gli,pc_gdl,pc_gld: GenGilGliGdlGld(op); + pc_iil,pc_ili,pc_idl,pc_ild: GenIilIliIdlIld(op); + pc_ind: GenInd(op); + pc_ixa: GenIxa(op); + pc_lao,pc_lad: GenLaoLad(op); + pc_lbf,pc_lbu: GenLbfLbu(op); + pc_lca: GenLca(op); + pc_lda: GenLda(op); + pc_ldc: GenLdc(op); + pc_ldo: GenLdo(op); + pc_lil,pc_lli,pc_ldl,pc_lld: GenLilLliLdlLld(op); + pc_lnm: GenLnm(op); + pc_lod: GenLod(op); + pc_lor,pc_lnd: GenLorLnd(op); + pc_mov: GenMov(op, true); + pc_mpi,pc_umi: GenMpi(op); + pc_nam: GenNam(op); + pc_nat: GenNat(op); + pc_ngr: GenNgr(op); + pc_nop: ; + pc_pop: GenPop(op); + pc_psh: GenPsh(op); + pc_ret: GenRet(op); + pc_sbf,pc_cbf: GenSbfCbf(op); + pc_sbi: GenSbi(op); + pc_shl,pc_shr,pc_usr: GenShlShrUsr(op); + pc_stk: GenStk(op); + pc_sro,pc_cpo: GenSroCpo(op); + pc_sto,pc_cpi: GenStoCpi(op); + pc_str,pc_cop: GenStrCop(op); + pc_tl1: GenTl1(op); + pc_tri: GenTri(op); + pc_ujp: GenNative(m_brl, longrelative, op^.q, nil, 0); + pc_xjp: GenXjp(op); + + otherwise: Error(cge1); + end; {case} +end; {GenTree} + +{---------------------------------------------------------------} + +procedure Gen {blk: blockPtr}; + +{ Generates native code for a list of blocks } +{ } +{ parameters: } +{ blk - first of the list of blocks } + +const + locSize = 4; {variables <= this size allocated first} + +var + bk: blockPtr; {used to trace block lists} + minSize: integer; {location for the next local label} + op: icptr; {used to trace code lists} + + + procedure DirLoc1 (op: icptr); + + { allocates stack frame locations for small dc_loc } + + begin {DirLoc1} + if op^.q <= locSize then begin + if op^.r < maxLocalLabel then begin + localLabel[op^.r] := minSize; + minSize := minSize + op^.q; + end {if} + else + Error(cge2); + end; {if} + end; {DirLoc1} + + + procedure DirLoc2 (op: icptr); + + { allocates stack frame locations for large dc_loc } + + begin {DirLoc2} + if op^.q > locSize then begin + if op^.r < maxLocalLabel then begin + localLabel[op^.r] := minSize; + minSize := minSize + op^.q; + end {if} + else + Error(cge2); + end; {if} + end; {DirLoc2} + + + procedure DirPrm (op: icptr); + + { allocates stack frame locations for parameters } + + begin {DirPrm} + if op^.s < maxLocalLabel then + localLabel[op^.s] := localSize + returnSize + 1 + op^.r + else + Error(cge2); + end; {DirPrm} + + + procedure Scan (op: icptr); + + { scans the code stream for instructions that effect the } + { size of the stack frame } + { } + { parameters: } + { op - scan this opcode and its children } + + var + opcode: pcodes; {op^.opcode} + size: integer; {function return value size} + + begin {Scan} + if op^.left <> nil then + Scan(op^.left); + if op^.right <> nil then + Scan(op^.right); + opcode := op^.opcode; + if opcode = dc_loc then + localSize := localSize + op^.q + else if opcode = dc_prm then + parameterSize := parameterSize + op^.q + else if opcode = pc_ret then begin + case op^.optype of + otherwise: size := 0; + cgByte,cgUByte,cgWord,cgUWord: size := cgWordSize; + cgReal: size := cgRealSize; + cgDouble: size := cgDoubleSize; + cgComp: size := cgCompSize; + cgExtended: size := cgExtendedSize; + cgLong,cgULong: size := cgLongSize; + end; {case} + funLoc := 1; + if dworkLoc <> 0 then + dworkLoc := dworkLoc + size; + minSize := minSize + size; + localSize := localSize + size; + end {else if} + else if opcode in + [pc_les,pc_leq,pc_grt,pc_geq,pc_sto,pc_cpi,pc_ind,pc_lor,pc_lnd, + pc_ili,pc_iil,pc_idl,pc_ild,pc_ixa] + then begin + if dworkLoc = 0 then begin + dworkLoc := minSize; + minSize := minSize + 4; + localSize := localSize + 4; + end; {if} + end; {else if} + end; {Scan} + + +begin {Gen} +bk := blk; {determine the size of the stack frame} +localSize := 0; +parameterSize := 0; +funLoc := 0; +dworkLoc := 0; +minSize := 1; +while bk <> nil do begin + op := bk^.code; + while op <> nil do begin + Scan(op); + op := op^.next; + end; {while} + bk := bk^.next; + end; {while} +if saveStack or checkStack or strictVararg then begin + stackLoc := minSize; + minSize := minSize + 2; + localSize := localSize + 2; + end; {if} +if dataBank then begin + bankLoc := minSize; + minSize := minSize + 2; + localSize := localSize + 2; + end; {if} +bk := blk; {allocate locations for the values} +while bk <> nil do begin + op := bk^.code; + while op <> nil do begin + if op^.opcode = dc_loc then + DirLoc1(op) + else if op^.opcode = dc_prm then + DirPrm(op); + op := op^.next; + end; {while} + bk := bk^.next; + end; {while} +bk := blk; +while bk <> nil do begin + op := bk^.code; + while op <> nil do begin + if op^.opcode = dc_loc then + DirLoc2(op); + op := op^.next; + end; {while} + bk := bk^.next; + end; {while} +while blk <> nil do begin {generate code for the block} + op := blk^.code; + while op <> nil do begin + GenTree(op); + op := op^.next; + end; {while} + blk := blk^.next; + end; {while} +end; {Gen} + + +function LabelToDisp {lab: integer): integer}; + +{ convert a local label number to a stack frame displacement } +{ } +{ parameters: } +{ lab - label number } + +begin {LabelToDisp} +if lab = 0 then + LabelToDisp := funLoc +else + LabelToDisp := localLabel[lab]; +end; {LabelToDisp} + +end. diff --git a/Header.pas b/Header.pas old mode 100755 new mode 100644 index bc54633..256ed9f --- a/Header.pas +++ b/Header.pas @@ -1 +1,1943 @@ -{$optimize 7} {---------------------------------------------------------------} { } { Header } { } { Handles saving and reading precompiled headers. } { } {---------------------------------------------------------------} unit Header; interface {$LibPrefix '0/obj/'} uses CCommon, MM, Scanner, Symbol, CGI; {$segment 'scanner'} var inhibitHeader: boolean; {should .sym includes be blocked?} procedure EndInclude (chPtr: ptr); { Saves symbols created by the include file } { } { Parameters: } { chPtr - chPtr when the file returned } { } { Notes: } { 1. Call this subroutine right after processing an } { include file. } { 2. Declared externally in Symbol.pas } procedure FlagPragmas (pragma: pragmas); { record the effects of a pragma } { } { parameters: } { pragma - pragma to record } { } { Notes: } { 1. Defined as extern in Scanner.pas } { 2. For the purposes of this unit, the segment statement is } { treated as a pragma. } procedure InitHeader (var fName: gsosOutString); { look for a header file, reading it if it exists } { } { parameters: } { fName - source file name (var for efficiency) } procedure TermHeader; { Stop processing the header file } { } { Note: This is called when the first code-generating } { subroutine is found, and again when the compile ends. It } { closes any open symbol file, and should take no action if } { called twice. } procedure StartInclude (name: gsosOutStringPtr); { Marks the start of an include file } { } { Notes: } { 1. Call this subroutine right after opening an include } { file. } { 2. Defined externally in Scanner.pas } {---------------------------------------------------------------} implementation const symFiletype = $5E; {symbol file type} symAuxtype = $008008; {file buffer} {-----------} bufSize = 1024; {size of output buffer} type closeOSDCB = record pcount: integer; refNum: integer; end; createOSDCB = record pcount: integer; pathName: gsosInStringPtr; access: integer; fileType: integer; auxType: longint; storageType: integer; dataEOF: longint; resourceEOF: longint; end; destroyOSDCB = record pcount: integer; pathName: gsosInStringPtr; end; getFileInfoOSDCB = record pcount: integer; pathName: gsosInStringPtr; access: integer; fileType: integer; auxType: longint; storageType: integer; createDateTime: timeField; modDateTime: timeField; optionList: optionListPtr; dataEOF: longint; blocksUsed: longint; resourceEOF: longint; resourceBlocks: longint; end; getMarkOSDCB = record pcount: integer; refNum: integer; displacement: longint; end; openOSDCB = record pcount: integer; refNum: integer; pathName: gsosInStringPtr; requestAccess: integer; resourceNumber: integer; access: integer; fileType: integer; auxType: longint; storageType: integer; createDateTime: timeField; modDateTime: timeField; optionList: optionListPtr; dataEOF: longint; blocksUsed: longint; resourceEOF: longint; resourceBlocks: longint; end; readWriteOSDCB = record pcount: integer; refNum: integer; dataBuffer: ptr; requestCount: longint; transferCount: longint; cachePriority: integer; end; setMarkOSDCB = record pcount: integer; refNum: integer; base: integer; displacement: longint; end; {file buffer} {-----------} bufferType = array[0..bufSize] of byte; {output buffer} var codeStarted: boolean; {has code generation started?} includeLevel: 0..maxint; {nexted include level} includeMark: boolean; {has the mark field been written?} savePragmas: set of pragmas; {pragmas to record} saveSource: boolean; {save source streams?} symChPtr: ptr; {chPtr at start of current source sequence} symEndPtr: ptr; {points to first byte past end of file} symMark: longint; {start of current block} symName: gsosOutString; {symbol file name} symStartPtr: ptr; {first byte in the symbol file} symPtr: ptr; {next byte in the symbol file} symRefnum: integer; {symName reference number} tokenMark: longint; {start of last token list} {file buffer} {-----------} buffer: ^bufferType; {output buffer} bufPtr: ^byte; {next available byte} bufLen: 0..bufSize; {bytes left in buffer} {---------------------------------------------------------------} procedure BlockMove (sourcPtr, destPtr: ptr; count: longint); tool ($02, $2B); procedure CloseGS (var parms: closeOSDCB); prodos ($2014); procedure CreateGS (var parms: createOSDCB); prodos ($2001); procedure DestroyGS (var parms: destroyOSDCB); prodos ($2002); procedure GetFileInfoGS (var parms: getFileInfoOSDCB); prodos ($2006); procedure GetMarkGS (var parms: getMarkOSDCB); prodos ($2017); procedure OpenGS (var parms: openOSDCB); prodos ($2010); procedure SetEOFGS (var parms: setMarkOSDCB); prodos ($2018); procedure SetMarkGS (var parms: setMarkOSDCB); prodos ($2016); procedure WriteGS (var parms: readWriteOSDCB); prodos ($2013); {---------------------------------------------------------------} procedure DestroySymbolFile; { Delete any existing symbol file } var dsRec: destroyOSDCB; {DestroyGS record} giRec: getFileInfoOSDCB; {GetFileInfoGS record} begin {DestroySymbolFile} giRec.pCount := 4; giRec.pathname := @symName.theString; GetFileInfoGS(giRec); if (giRec.filetype = symFiletype) and (giRec.auxtype = symAuxtype) then begin dsRec.pCount := 1; dsRec.pathname := @symName.theString; DestroyGS(dsRec); end; {if} end; {DestroySymbolFile} procedure Purge; { Purge the output buffer } var clRec: closeOSDCB; {CloseGS record} wrRec: readWriteOSDCB; {WriteGS record} begin {Purge} wrRec.pcount := 4; wrRec.refnum := symRefnum; wrRec.dataBuffer := pointer(buffer); wrRec.requestCount := (bufSize - bufLen); WriteGS(wrRec); if ToolError <> 0 then begin clRec.pCount := 1; clRec.refnum := symRefnum; CloseGS(clRec); DestroySymbolFile; saveSource := false; end; {if} bufLen := bufSize; bufPtr := pointer(buffer); end; {Purge} procedure CloseSymbols; { Close the symbol file } var clRec: closeOSDCB; {CloseGS record} begin {CloseSymbols} Purge; clRec.pCount := 1; clRec.refnum := symRefnum; CloseGS(clRec); if numErrors <> 0 then DestroySymbolFile; end; {CloseSymbols} function ReadDouble: double; { Read a double precision real from the symbol file } { } { Returns: value read } type doubleptr = ^double; begin {ReadDouble} ReadDouble := doubleptr(symPtr)^; symPtr := pointer(ord4(symPtr)+8); end; {ReadDouble} function ReadLong: longint; { Read a long word from the symbol file } { } { Returns: long word read } type longptr = ^longint; begin {ReadLong} ReadLong := longptr(symPtr)^; symPtr := pointer(ord4(symPtr)+4); end; {ReadLong} function ReadLongString: longStringPtr; { Read a long string from the symbol file } { } { Returns: string read } var len: 0..maxint; {string buffer length} sp1, sp2: longStringPtr; {work pointers} begin {ReadLongString} sp1 := longStringPtr(symPtr); len := sp1^.length + 2; symPtr := pointer(ord4(symPtr) + len); sp2 := pointer(GMalloc(len)); BlockMove(sp1, sp2, len); ReadLongString := sp2; end; {ReadLongString} function ReadString: stringPtr; { Read a string from the symbol file } { } { Returns: string read } var len: 0..255; {string buffer length} sp1, sp2: stringPtr; {work pointers} begin {ReadString} sp1 := stringptr(symPtr); len := length(sp1^) + 1; symPtr := pointer(ord4(symPtr) + len); sp2 := pointer(GMalloc(len)); BlockMove(sp1, sp2, len); ReadString := sp2; end; {ReadString} function ReadByte: integer; { Read a byte from the symbol file } { } { Returns: byte read } type intptr = ^integer; begin {ReadByte} ReadByte := (intptr(symPtr)^) & $00FF; symPtr := pointer(ord4(symPtr)+1); end; {ReadByte} function ReadWord: integer; { Read a word from the symbol file } { } { Returns: word read } type intptr = ^integer; begin {ReadWord} ReadWord := intptr(symPtr)^; symPtr := pointer(ord4(symPtr)+2); end; {ReadWord} procedure ReadChars (var p1, p2: ptr); { Read a character stream from the file } { } { parameters: } { p1 - (output) pointer to first char in stream } { p2 - (output) points one past last char in stream } var len: integer; {length of the stream} begin {ReadChars} len := ReadWord; p1 := pointer(GMalloc(len)); p2 := pointer(ord4(p1) + len); BlockMove(symPtr, p1, len); symPtr := pointer(ord4(symPtr) + len); end; {ReadChars} procedure WriteDouble (d: double); { Write a double constant to the symbol file } { } { parameters: } { d - constant to write } var dPtr: ^double; {work pointer} begin {WriteDouble} if bufLen < 8 then Purge; dPtr := pointer(bufPtr); dPtr^ := d; bufPtr := pointer(ord4(bufPtr) + 8); bufLen := bufLen - 8; end; {WriteDouble} procedure WriteLong (i: longint); { Write a long word to the symbol file } { } { parameters: } { i - long word to write } var lPtr: ^longint; {work pointer} begin {WriteLong} if bufLen < 4 then Purge; lPtr := pointer(bufPtr); lPtr^ := i; bufPtr := pointer(ord4(bufPtr) + 4); bufLen := bufLen - 4; end; {WriteLong} procedure WriteByte (i: integer); { Write a byte to the symbol file } { } { parameters: } { i - byte to write } var iPtr: ^byte; {work pointer} begin {WriteByte} if bufLen = 0 then Purge; iPtr := pointer(bufPtr); iPtr^ := i; bufPtr := pointer(ord4(bufPtr) + 1); bufLen := bufLen - 1; end; {WriteByte} procedure WriteWord (i: integer); { Write a word to the symbol file } { } { parameters: } { i - word to write } var iPtr: ^integer; {work pointer} begin {WriteWord} if bufLen < 2 then Purge; iPtr := pointer(bufPtr); iPtr^ := i; bufPtr := pointer(ord4(bufPtr) + 2); bufLen := bufLen - 2; end; {WriteWord} procedure WriteLongString (s: longStringPtr); { Write a long string to the symbol file } { } { parameters: } { s - pointer to the string to write } var i: 0..maxint; {loop/index variables} len: 0..maxint; {string length} wrRec: readWriteOSDCB; {WriteGS record} begin {WriteLongString} len := s^.length; if bufLen < len+2 then Purge; if bufLen < len+2 then begin wrRec.pcount := 4; wrRec.refnum := symRefnum; wrRec.dataBuffer := pointer(s); wrRec.requestCount := s^.length + 2; WriteGS(wrRec); if ToolError <> 0 then begin CloseSymbols; DestroySymbolFile; saveSource := false; end; {if} end {if} else begin WriteWord(len); for i := 1 to len do begin bufPtr^ := ord(s^.str[i]); bufPtr := pointer(ord4(bufPtr) + 1); end; {for} bufLen := bufLen - len; end; {else} end; {WriteLongString} procedure WriteChars (p1, p2: ptr); { Write a stream of chars as a longString } { } { parameters: } { p1 - points to the first char to write } { p2 - points to the byte following the last char } var i: 0..maxint; {loop/index variables} len: 0..maxint; {char length} wrRec: readWriteOSDCB; {WriteGS record} begin {WriteChars} len := ord(ord4(p2) - ord4(p1)); WriteWord(len); if bufLen < len then Purge; if bufLen < len then begin if saveSource then begin wrRec.pcount := 4; wrRec.refnum := symRefnum; wrRec.dataBuffer := pointer(p1); wrRec.requestCount := ord4(p2) - ord4(p1); WriteGS(wrRec); if ToolError <> 0 then begin CloseSymbols; DestroySymbolFile; saveSource := false; end; {if} end; {if} end {if} else begin for i := 1 to len do begin bufPtr^ := p1^; bufPtr := pointer(ord4(bufPtr)+1); p1 := pointer(ord4(p1)+1); end; {for} bufLen := bufLen - len; end; {else} end; {WriteChars} procedure WriteString (s: stringPtr); { Write a string to the symbol file } { } { parameters: } { s - pointer to the string to write } var i: 0..255; {loop/index variable} len: 0..255; {length of the string} begin {WriteString} len := length(s^); if bufLen < len+1 then Purge; for i := 0 to len do begin bufPtr^ := ord(s^[i]); bufPtr := pointer(ord4(bufPtr)+1); end; {for} bufLen := bufLen - (len + 1); end; {WriteString} procedure MarkBlock; { Mark the length of the current block } var l: longint; {block length} smRec: setMarkOSDCB; {SetMarkGS record} gmRec: getMarkOSDCB; {GetMarkGS record} wrRec: readWriteOSDCB; {WriteGS record} begin {MarkBlock} Purge; {purge the buffer} gmRec.pCount := 2; {get the current EOF} gmRec.refnum := symRefnum; GetMarkGS(gmRec); if ToolError = 0 then begin smRec.pcount := 3; {set the mark to the block length field} smRec.refnum := symRefnum; smRec.base := 0; smRec.displacement := symMark; SetMarkGS(smRec); if ToolError = 0 then begin l := gmRec.displacement - smRec.displacement - 4; wrRec.pcount := 4; wrRec.refnum := symRefnum; wrRec.dataBuffer := @l; wrRec.requestCount := 4; WriteGS(wrRec); if ToolError <> 0 then begin CloseSymbols; DestroySymbolFile; saveSource := false; end; {if} smRec.displacement := gmRec.displacement; SetMarkGS(smRec); end; {if} end; {if} if ToolError <> 0 then begin {for errors, delete the symbol file} CloseSymbols; DestroySymbolFile; saveSource := false; end; {if} end; {MarkBlock} function GetMark: longint; { Find the current file mark } { } { Returns: file mark } var gmRec: getMarkOSDCB; {GetMarkGS record} begin {GetMark} gmRec.pCount := 2; gmRec.refnum := symRefnum; GetMarkGS(gmRec); GetMark := gmRec.displacement + (bufSize - bufLen); if ToolError <> 0 then begin CloseSymbols; DestroySymbolFile; saveSource := false; end; {else} end; {GetMark} procedure SetMark; { Mark the start of a block } begin {SetMark} symMark := GetMark; WriteLong(0); end; {SetMark} {---------------------------------------------------------------} procedure EndInclude {chPtr: ptr}; { Saves symbols created by the include file } { } { Parameters: } { chPtr - chPtr when the file returned } { } { Notes: } { 1. Call this subroutine right after processing an } { include file. } { 2. Declared externally in Scanner.pas } procedure SaveMacroTable; { Save macros to the symbol file } procedure SaveMacros; { Write the macros to the symbol file } var i: 0..hashSize; {loop/index variable} mp: macroRecordPtr; {used to trace macro lists} tp: tokenListRecordPtr; {used to trace token lists} procedure WriteToken (var token: tokenType); { Write a token in the header file } { } { parameters: } { token - token to write } begin {WriteToken} WriteByte(ord(token.kind)); WriteByte(ord(token.class)); if token.numstring = nil then WriteByte(0) else begin WriteByte(1); WriteString(token.numstring); end; {else} case token.class of identifier: WriteString(token.name); intConstant: WriteWord(token.ival); longConstant: WriteLong(token.lval); doubleConstant: WriteDouble(token.rval); stringConstant: begin WriteLongString(token.sval); WriteByte(ord(token.ispstring)); end; macroParameter: WriteWord(token.pnum); otherwise: ; end; {case} end; {WriteToken} begin {SaveMacros} for i := 0 to hashSize do begin {loop over hash buckets} mp := macros^[i]; {loop over macro records in hash bucket} while mp <> nil do begin if not mp^.saved then begin mp^.saved := true; {mark this one as saved} WriteString(mp^.name); {write the macroRecord} WriteByte(mp^.parameters); WriteByte(ord(mp^.readOnly)); WriteByte(mp^.algorithm); tp := mp^.tokens; {loop over token list} while tp <> nil do begin WriteByte(1); {write tokenListRecord} WriteLongString(tp^.tokenString); WriteToken(tp^.token); WriteByte(ord(tp^.expandEnabled)); WriteChars(tp^.tokenStart, tp^.tokenEnd); tp := tp^.next; end; {while} WriteByte(0); {mark end of token list} end; {if} mp := mp^.next; end; {while} end; {for} end; {SaveMacros} begin {SaveMacroTable} SetMark; {set the macro table length mark} if saveSource then {write the macro table} SaveMacros; if saveSource then {mark the length of the table} MarkBlock; end; {SaveMacroTable} procedure SavePragmaEffects; { Save the variables effected by any pragmas encountered } var count: 0..maxint; {number of path names} i: 1..10; {loop/index variable} p: pragmas; {loop variable} pp: pathRecordPtr; {used to trace pathname list} begin {SavePragmaEffects} SetMark; if saveSource then for p := succ(p_startofenum) to pred(p_endofenum) do if p in savePragmas then if saveSource then begin WriteByte(ord(p)); case p of p_cda: begin WriteString(@menuLine); WriteString(openName); WriteString(closeName); end; p_cdev: WriteString(openName); p_float: begin WriteWord(floatCard); WriteWord(floatSlot); end; p_keep: WriteLongString(@outFileGS.theString); p_line: begin WriteWord(lineNumber); WriteLongString(@sourceFileGS.theString); end; p_nda: begin WriteString(openName); WriteString(closeName); WriteString(actionName); WriteString(initName); WriteWord(refreshPeriod); WriteWord(eventMask); WriteString(@menuLine); end; p_nba: WriteString(openName); p_xcmd: WriteString(openName); p_debug: WriteByte(ord(rangeCheck) | (ord(debugFlag) << 1) | (ord(profileFlag) << 2) | (ord(traceBack) << 3) | (ord(checkStack) << 4)); p_lint: WriteWord(lint); p_memorymodel: WriteByte(ord(smallMemoryModel)); p_expand: WriteByte(ord(printMacroExpansions)); p_optimize: WriteByte(ord(peepHole) | (ord(npeepHole) << 1) | (ord(registers) << 2) | (ord(saveStack) << 3) | (ord(commonSubexpression) << 4) | (ord(loopOptimizations) << 5) | (ord(strictVararg) << 6)); p_stacksize: WriteWord(stackSize); p_toolparms: WriteByte(ord(toolParms)); p_databank: WriteByte(ord(dataBank)); p_rtl: ; p_noroot: ; p_path: begin pp := pathList; count := 0; while pp <> nil do begin count := count+1; pp := pp^.next; end; {while} WriteWord(count); pp := pathList; while pp <> nil do begin WriteString(pp^.path); pp := pp^.next; end; {while} end; {p_path} p_ignore: WriteByte(ord(skipIllegalTokens) + (ord(slashSlashComments) << 3)); p_segment: begin for i := 1 to 10 do begin WriteByte(defaultSegment[i]); WriteByte(currentSegment[i]); end; {for} WriteWord(segmentKind); end; p_unix: WriteByte(ord(unix_1)); end; {case} end; {if} if saveSource then MarkBlock; savePragmas := []; end; {SavePragmaEffects} procedure SaveSourceStream; { Save the source stream for later compares } var wrRec: readWriteOSDCB; {WriteGS record} begin {SaveSourceStream} WriteLong(ord4(chPtr) - ord4(symChPtr)); Purge; wrRec.pcount := 4; wrRec.refnum := symRefnum; wrRec.dataBuffer := pointer(symChPtr); wrRec.requestCount := ord4(chPtr) - ord4(symChPtr); WriteGS(wrRec); symChPtr := chPtr; if ToolError <> 0 then begin CloseSymbols; DestroySymbolFile; saveSource := false; end; {if} end; {SaveSourceStream} procedure SaveSymbolTable; { Save symbols to the symbol file } procedure SaveSymbol; { Write the symbols to the symbol file } var abort: boolean; {abort due to initialized var?} efRec: setMarkOSDCB; {SetEOFGS record} i: 0..hashSize; {loop/index variable} sp: identPtr; {used to trace symbol lists} procedure WriteIdent (ip: identPtr); { write a symbol to the symbol file } { } { parameters: } { ip - pointer to symbol entry } procedure WriteType (tp: typePtr); { write a type entry to the symbol file } { } { parameters: } { tp - pointer to type entry } var ip: identPtr; {for tracing field list} procedure WriteParm (pp: parameterPtr); { write a parameter list to the symbol file } { } { parameters: } { pp - parameter pointer } begin {WriteParm} while pp <> nil do begin WriteByte(1); WriteType(pp^.parameterType); pp := pp^.next; end; {while} WriteByte(0); end; {WriteParm} begin {WriteType} if tp = bytePtr then WriteByte(2) else if tp = uBytePtr then WriteByte(3) else if tp = wordPtr then WriteByte(4) else if tp = uWordPtr then WriteByte(5) else if tp = longPtr then WriteByte(6) else if tp = uLongPtr then WriteByte(7) else if tp = realPtr then WriteByte(8) else if tp = doublePtr then WriteByte(9) else if tp = extendedPtr then WriteByte(10) else if tp = stringTypePtr then WriteByte(11) else if tp = voidPtr then WriteByte(12) else if tp = voidPtrPtr then WriteByte(13) else if tp = defaultStruct then WriteByte(14) else if tp^.saveDisp <> 0 then begin WriteByte(1); WriteLong(tp^.saveDisp); end {if} else begin WriteByte(0); tp^.saveDisp := GetMark; WriteLong(tp^.size); WriteByte(ord(tp^.isConstant)); WriteByte(ord(tp^.kind)); case tp^.kind of scalarType: WriteByte(ord(tp^.baseType)); arrayType: begin WriteLong(tp^.elements); WriteType(tp^.aType); end; pointerType: WriteType(tp^.pType); functionType: begin WriteByte((ord(tp^.varargs) << 2) | (ord(tp^.prototyped) << 1) | ord(tp^.isPascal)); WriteWord(tp^.toolnum); WriteLong(tp^.dispatcher); WriteType(tp^.fType); WriteParm(tp^.parameterList); end; enumConst: WriteWord(tp^.eval); definedType: WriteType(tp^.dType); structType, unionType: begin ip := tp^.fieldList; while ip <> nil do begin WriteByte(1); WriteIdent(ip); ip := ip^.next; end; {while} WriteByte(0); end; otherwise: ; end; {case} end; {else} end; {WriteType} begin {WriteIdent} WriteString(ip^.name); WriteType(ip^.itype); if (ip^.disp = 0) and (ip^.bitDisp = 0) and (ip^.bitSize = 0) then WriteByte(0) else if (ip^.bitSize = 0) and (ip^.bitDisp = 0) then begin if ip^.disp < maxint then begin WriteByte(1); WriteWord(ord(ip^.disp)); end {if} else begin WriteByte(2); WriteLong(ip^.disp); end; {else} end {else if} else begin WriteByte(3); WriteLong(ip^.disp); WriteByte(ip^.bitDisp); WriteByte(ip^.bitSize); end; {else} if ip^.iPtr <> nil then abort := true; WriteByte(ord(ip^.state)); WriteByte(ord(ip^.isForwardDeclared)); WriteByte(ord(ip^.class)); WriteByte(ord(ip^.storage)); end; {WriteIdent} begin {SaveSymbol} abort := false; {no reason to abort, yet} for i := 0 to hashSize2 do begin {loop over hash buckets} sp := globalTable^.buckets[i]; {loop over symbol records in hash bucket} while sp <> nil do begin if not sp^.saved then begin sp^.saved := true; {mark this one as saved} WriteWord(i); {save the symbol} WriteIdent(sp); end; {if} sp := sp^.next; end; {while} end; {for} if abort then begin Purge; efRec.pcount := 3; efRec.refnum := symRefnum; efRec.base := 0; efRec.displacement := tokenMark; SetEOFGS(efRec); if ToolError <> 0 then begin CloseSymbols; DestroySymbolFile; end; {if} saveSource := false; end; {if} end; {SaveSymbol} begin {SaveSymbolTable} SetMark; {set the symbol table length mark} if saveSource then {write the symbol table} if globalTable <> nil then SaveSymbol; if saveSource then {mark the length of the table} MarkBlock; end; {SaveSymbolTable} begin {EndInclude} if not ignoreSymbols then begin includeLevel := includeLevel-1; if includeLevel = 0 then if saveSource then begin MarkBlock; {set the include name mark} SaveSourceStream; {save the source stream} SaveMacroTable; {save the macro table} SaveSymbolTable; {save the symbol table} SavePragmaEffects; {save the effects of pragmas} tokenMark := GetMark; {record mark for early exit} includeMark := false; {no include mark, yet} end; {if} end; {if} end; {EndInclude} procedure FlagPragmas {pragma: pragmas}; { record the effects of a pragma } { } { parameters: } { pragma - pragma to record } { } { Notes: } { 1. Defined as extern in Scanner.pas } { 2. For the purposes of this unit, the segment statement } { and #line directive are treated as pragmas. } begin {FlagPragmas} savePragmas := savePragmas + [pragma]; end; {FlagPragmas} procedure InitHeader {var fName: gsosOutString}; { look for a header file, reading it if it exists } { } { parameters: } { fName - source file name (var for efficiency) } type typeDispPtr = ^typeDispRecord; {type displacement/pointer table} typeDispRecord = record next: typeDispPtr; saveDisp: longint; tPtr: typePtr; end; var done: boolean; {for loop termination test} typeDispList: typeDispPtr; {type displacement/pointer table} procedure DisposeTypeDispList; { Dispose of the type displacement list } var tp: typeDispPtr; {work pointer} begin {DisposeTypeDispList} while typeDispList <> nil do begin tp := typeDispList; typeDispList := tp^.next; dispose(tp); end; {while} end; {DisposeTypeDispList} function EndOfSymbols: boolean; { See if we're at the end of the symbol file } { } { Returns: True if at the end, else false } begin {EndOfSymbols} EndOfSymbols := ord4(symPtr) >= ord4(symEndPtr); end; {EndOfSymbols} function OpenSymbols: boolean; { open and initialize the symbol file } { } { Returns: True if successful, else false } var crRec: createOSDCB; {CreateGS record} opRec: openOSDCB; {OpenGS record} begin {OpenSymbols} OpenSymbols := false; {assume we will fail} DestroySymbolFile; {destroy any existing file} crRec.pCount := 5; {create a symbol file} crRec.pathName := @symName.theString; crRec.access := $C3; crRec.fileType := symFiletype; crRec.auxType := symAuxtype; crRec.storageType := 1; CreateGS(crRec); if ToolError = 0 then begin opRec.pCount := 3; opRec.pathname := @symName.theString; opRec.requestAccess := 3; OpenGS(opRec); if ToolError = 0 then begin symRefnum := opRec.refnum; OpenSymbols := true; WriteWord(1); tokenMark := GetMark; includeMark := false; end; {if} end; {if} end; {OpenSymbols} procedure PurgeSymbols; { Purge the symbol input file } var ffDCBGS: fastFileDCBGS; {fast file DCB} begin {PurgeSymbols} with ffDCBGS do begin {purge the file} pCount := 5; action := 7; pathName := @symName.theString; end; {with} FastFileGS(ffDCBGS); end; {PurgeSymbols} function DatesMatch: boolean; { Make sure the create/mod dates have not changed } var giRec: getFileInfoOSDCB; {GetFileInfoGS record} i: 1..maxint; {loop/index variable} len: longint; {length of names} match: boolean; {do the dates match?} begin {DatesMatch} match := true; len := ReadLong; while len > 0 do begin giRec.pCount := 7; giRec.pathname := pointer(ReadLongString); len := len - (giRec.pathname^.size + 18); GetFileInfoGS(giRec); if ToolError = 0 then begin for i := 1 to 8 do match := match and (giRec.createDateTime[i] = ReadByte); for i := 1 to 8 do match := match and (giRec.modDateTime[i] = ReadByte); end {if} else begin match := false; len := 0; end; {else} if match and progress then begin write('Including '); for i := 1 to giRec.pathname^.size do write(giRec.pathname^.theString[i]); writeln; end; {if} end; {while} DatesMatch := match; end; {DatesMatch} procedure ReadMacroTable; { Read macros from the symbol file } var bp: ^macroRecordPtr; {pointer to head of hash bucket} ep: tokenListRecordPtr; {last token record} mePtr: ptr; {end of macro table} mp: macroRecordPtr; {new macro record} tlen: integer; {length of the token name} tp: tokenListRecordPtr; {new token record} procedure ReadToken (var token: tokenType); { read a token } { } { parameters: } { token - (output) token read) } begin {ReadToken} token.kind := tokenEnum(ReadByte); token.class := tokenClass(ReadByte); if ReadByte = 0 then token.numString := nil else token.numstring := ReadString; case token.class of identifier: token.name := ReadString; intConstant: token.ival := ReadWord; longConstant: token.lval := ReadLong; doubleConstant: token.rval := ReadDouble; stringConstant: begin token.sval := ReadLongString; token.ispstring := ReadByte <> 0; end; macroParameter: token.pnum := ReadWord; otherwise: ; end; {case} end; {ReadToken} begin {ReadMacroTable} mePtr := symPtr; {read the block length} mePtr := pointer(ord4(mePtr) + ReadLong + 4); while ord4(symPtr) < ord4(mePtr) do {process the macros} begin Spin; mp := pointer(GMalloc(sizeof(macroRecord))); mp^.saved := false; mp^.name := ReadString; bp := pointer(ord4(macros) + Hash(mp^.name)); mp^.next := bp^; bp^ := mp; mp^.parameters := ReadByte; if mp^.parameters & $0080 <> 0 then mp^.parameters := mp^.parameters | $FF00; mp^.readOnly := boolean(ReadByte); mp^.algorithm := ReadByte; mp^.tokens := nil; ep := nil; while ReadByte <> 0 do begin tp := pointer(GMalloc(sizeof(tokenListRecord))); tp^.next := nil; tp^.tokenString := ReadLongString; ReadToken(tp^.token); tp^.expandEnabled := boolean(ReadByte); ReadChars(tp^.tokenStart, tp^.tokenEnd); if ep = nil then mp^.tokens := tp else ep^.next := tp; ep := tp; end; {while} end; {while} symPtr := mePtr; end; {ReadMacroTable} procedure ReadPragmas; { Read pragma effects } var i: 0..maxint; {loop/index variable} lsPtr: longStringPtr; {work pointer} p: pragmas; {kind of pragma being processed} pePtr: ptr; {end of pragma table} pp, ppe: pathRecordPtr; {used to create a path name list} sPtr: stringPtr; {work pointer} val: integer; {temp value} begin {ReadPragmas} pePtr := symPtr; {read the block length} pePtr := pointer(ord4(pePtr) + ReadLong + 4); while ord4(symPtr) < ord4(pePtr) do {process the pragmas} begin Spin; p := pragmas(ReadByte); case p of p_cda: begin isClassicDeskAcc := true; sPtr := ReadString; menuLine := sPtr^; openName := ReadString; closeName := ReadString; end; p_cdev: begin isCDev := true; openName := ReadString; end; p_float: begin floatCard := ReadWord; floatSlot := ReadWord; end; p_keep: begin liDCBGS.kFlag := 1; lsPtr := ReadLongString; outFileGS.theString.size := lsPtr^.length; for i := 1 to outFileGS.theString.size do outFileGS.theString.theString[i] := lsPtr^.str[i]; end; p_line: begin lineNumber := ReadWord; lsPtr := ReadLongString; sourceFileGS.theString.size := lsPtr^.length; for i := 1 to sourceFileGS.theString.size do sourceFileGS.theString.theString[i] := lsPtr^.str[i]; end; p_nda: begin isNewDeskAcc := true; openName := ReadString; closeName := ReadString; actionName := ReadString; initName := ReadString; refreshPeriod := ReadWord; eventMask := ReadWord; sPtr := ReadString; menuLine := sPtr^; end; p_nba: begin isNBA := true; openName := ReadString; end; p_xcmd: begin isXCMD := true; openName := ReadString; end; p_debug: begin val := ReadByte; rangeCheck := odd(val); debugFlag := odd(val >> 1); profileFlag := odd(val >> 2); traceback := odd(val >> 3); checkStack := odd(val >> 4); end; p_lint: lint := ReadWord; p_memorymodel: smallMemoryModel := boolean(ReadByte); p_expand: printMacroExpansions := boolean(ReadByte); p_optimize: begin val := ReadByte; peepHole := odd(val); npeepHole := odd(val >> 1); registers := odd(val >> 2); saveStack := odd(val >> 3); commonSubexpression := odd(val >> 4); loopOptimizations := odd(val >> 5); strictVararg := odd(val >> 6); end; p_stacksize: stackSize := ReadWord; p_toolparms: toolParms := boolean(ReadByte); p_databank: dataBank := boolean(ReadByte); p_rtl: rtl := true; p_noroot: noroot := true; p_path: begin i := ReadWord; pathList := nil; ppe := nil; while i <> 0 do begin pp := pathRecordPtr(GMalloc(sizeof(pathRecord))); pp^.path := ReadString; pp^.next := nil; if pathList = nil then pathList := pp else ppe^.next := pp; ppe := pp; i := i-1; end; {while} end; {p_path} p_ignore: begin i := ReadByte; skipIllegalTokens := odd(i); slashSlashComments := odd(i >> 3); end; p_segment: begin for i := 1 to 10 do begin defaultSegment[i] := chr(ReadByte); currentSegment[i] := chr(ReadByte); end; {for} segmentKind := ReadWord; end; p_unix: unix_1 := boolean(ReadByte); end; {case} end; {while} symPtr := pePtr; end; {ReadPragmas} procedure ReadSymbolTable; { Read symbols from the symbol file } var hashPtr: ^identPtr; {pointer to hash bucket in symbol table} sePtr: ptr; {end of symbol table} sp: identPtr; {identifier being constructed} function ReadIdent: identPtr; { Read an identifier from the file } { } { Returns: Pointer to the new identifier } var format: 0..3; {storage format} sp: identPtr; {identifier being constructed} procedure ReadType (var tp: typePtr); { read a type from the symbol file } { } { parameters: } { tp - (output) type entry } var disp: longint; {disp read from symbol file} ep: identPtr; {end of list of field names} ip: identPtr; {for tracing field list} tdisp: typeDispPtr; {used to trace, add to typeDispList} val: integer; {temp word} procedure ReadParm (var pp: parameterPtr); { read a parameter list from the symbol file } { } { parameters: } { pp - (output) parameter pointer } var ep: parameterPtr; {last parameter in list} np: parameterPtr; {new parameter} begin {ReadParm} pp := nil; ep := nil; while ReadByte = 1 do begin np := parameterPtr(GMalloc(sizeof(parameterRecord))); np^.next := nil; np^.parameter := nil; ReadType(np^.parameterType); if ep = nil then pp := np else ep^.next := np; ep := np; end; {while} end; {ReadParm} begin {ReadType} case ReadByte of 0: begin {read a new type} tp := typePtr(GMalloc(sizeof(typeRecord))); new(tdisp); tdisp^.next := typeDispList; typeDispList := tdisp; tdisp^.saveDisp := ord4(symPtr) - ord4(symStartPtr); tdisp^.tPtr := tp; tp^.size := ReadLong; tp^.saveDisp := 0; tp^.isConstant := boolean(ReadByte); tp^.kind := typeKind(ReadByte); case tp^.kind of scalarType: tp^.baseType := baseTypeEnum(ReadByte); arrayType: begin tp^.elements := ReadLong; ReadType(tp^.aType); end; pointerType: ReadType(tp^.pType); functionType: begin val := ReadByte; tp^.varargs := odd(val >> 2); tp^.prototyped := odd(val >> 1); tp^.isPascal := odd(val); tp^.toolnum := ReadWord; tp^.dispatcher := ReadLong; ReadType(tp^.fType); ReadParm(tp^.parameterList); end; enumConst: tp^.eval := ReadWord; definedType: ReadType(tp^.dType); structType, unionType: begin tp^.fieldList := nil; ep := nil; while ReadByte = 1 do begin ip := ReadIdent; if ep = nil then tp^.fieldList := ip else ep^.next := ip; ep := ip; end; {while} end; otherwise: ; end; {case} end; {case 0} 1: begin {read a type displacement} tdisp := typeDispList; disp := ReadLong; while tdisp <> nil do if tdisp^.saveDisp = disp then begin tp := tdisp^.tPtr; tdisp := nil; end {if} else tdisp := tdisp^.next; end; {case 1} 2: tp := bytePtr; 3: tp := uBytePtr; 4: tp := wordPtr; 5: tp := uWordPtr; 6: tp := longPtr; 7: tp := uLongPtr; 8: tp := realPtr; 9: tp := doublePtr; 10: tp := extendedPtr; 11: tp := stringTypePtr; 12: tp := voidPtr; 13: tp := voidPtrPtr; 14: tp := defaultStruct; end; {case} end; {ReadType} begin {ReadIdent} sp := pointer(GMalloc(sizeof(identRecord))); sp^.next := nil; sp^.saved := false; sp^.name := ReadString; ReadType(sp^.itype); format := ReadByte; if format = 0 then begin sp^.disp := 0; sp^.bitDisp := 0; sp^.bitSize := 0; end {if} else if format = 1 then begin sp^.disp := ReadWord; sp^.bitDisp := 0; sp^.bitSize := 0; end {else if} else if format = 2 then begin sp^.disp := ReadLong; sp^.bitDisp := 0; sp^.bitSize := 0; end {else if} else begin sp^.disp := ReadLong; sp^.bitDisp := ReadByte; sp^.bitSize := ReadByte; end; {else} sp^.iPtr := nil; sp^.state := stateKind(ReadByte); sp^.isForwardDeclared := boolean(ReadByte); sp^.class := tokenEnum(ReadByte); sp^.storage := storageType(ReadByte); ReadIdent := sp; end; {ReadIdent} begin {ReadSymbolTable} sePtr := symPtr; {read the block length} sePtr := pointer(ord4(sePtr) + ReadLong + 4); while ord4(symPtr) < ord4(sePtr) do {process the symbols} begin Spin; hashPtr := pointer(ord4(globalTable) + ReadWord*4); sp := ReadIdent; sp^.next := hashPtr^; hashPtr^ := sp; end; {while} symPtr := sePtr; end; {ReadSymbolTable} function OpenSymbolFile (var fName: gsosOutString): boolean; { Look for and open a symbol file } { } { parameters: } { fName - source file name (var for efficiency) } { } { Returns: True if the file was found and opened, else false } { } { Notes: As a side effect, this subroutine creates the } { pathname for the symbol file (symName). } var ffDCBGS: fastFileDCBGS; {fast file DCB} i: integer; {loop/index variable} begin {OpenSymbolFile} symName := fName; {create the symbol file name} i := symName.theString.size - 1; while not (symName.theString.theString[i] in [':', '/', '.']) do i := i-1; if symName.theString.theString[i] <> '.' then i := symName.theString.size; if i > maxPath-5 then i := maxPath-5; symName.theString.theString[i] := '.'; symName.theString.theString[i+1] := 's'; symName.theString.theString[i+2] := 'y'; symName.theString.theString[i+3] := 'm'; symName.theString.theString[i+4] := chr(0); symName.theString.size := i+3; if rebuildSymbols then begin {rebuild any existing symbol file} DestroySymbolFile; OpenSymbolFile := false; end {if} else begin with ffDCBGS do begin {read the symbol file} pCount := 14; action := 0; flags := $C000; pathName := @symName.theString; end; {with} FastFileGS(ffDCBGS); if ToolError = 0 then begin if (ffDCBGS.filetype = symFiletype) and (ffDCBGS.auxtype = symAuxtype) then OpenSymbolFile := true else begin OpenSymbolFile := false; PurgeSymbols; end; {else} symPtr := ffDCBGS.fileHandle^; symStartPtr := symPtr; symEndPtr := pointer(ord4(symPtr) + ffDCBGS.fileLength); end {if} else OpenSymbolFile := false; end; {else} end; {OpenSymbolFile} function SymbolVersion: integer; { Read the symbol file version number } { } { Returns: version number } begin {SymbolVersion} SymbolVersion := ReadWord; end; {SymbolVersion} function SourceMatches: boolean; { Make sure the token streams match up to the next include } type intPtr = ^integer; {for faster compares} var len, len2: longint; {size of stream to compare} match: boolean; {result flag} p1, p2: ptr; {work pointers} begin {SourceMatches} match := true; len := ReadLong; len2 := len; p1 := symPtr; p2 := chPtr; while len > 1 do if intPtr(p1)^ <> intPtr(p2)^ then begin match := false; len := 0; end {if} else begin len := len-2; p1 := pointer(ord4(p1)+2); p2 := pointer(ord4(p2)+2); end; {else} if len = 1 then if p1^ <> p2^ then match := false; if match then begin symPtr := pointer(ord4(symPtr)+len2); symChPtr := pointer(ord4(chPtr)+len2); while chPtr <> symChPtr do NextCh; end; {if} SourceMatches := match; end; {SourceMatches} begin {InitHeader} inhibitHeader := false; {don't block .sym files} if not ignoreSymbols then begin codeStarted := false; {code generation has not started} new(buffer); {allocate an output buffer} bufPtr := pointer(buffer); bufLen := bufSize; includeLevel := 0; {no nested includes} symChPtr := chPtr; {record initial source location} if OpenSymbolFile(fName) then begin {check for symbol file} if SymbolVersion = 1 then begin done := EndOfSymbols; {valid file found - process it} if done then PurgeSymbols; typeDispList := nil; while not done do begin if DatesMatch then begin if SourceMatches then begin ReadMacroTable; ReadSymbolTable; ReadPragmas; if EndOfSymbols then begin done := true; PurgeSymbols; end; {if} end {if} else begin PurgeSymbols; DestroySymbolFile; done := true; end; {else} end {if} else begin PurgeSymbols; DestroySymbolFile; done := true; end; {else} end; {while} DisposeTypeDispList; saveSource := false; end {if} else begin PurgeSymbols; {no file found} saveSource := true; end; {else} end {if} else saveSource := true; if saveSource then begin {start saving source} saveSource := OpenSymbols; savePragmas := []; DoDefaultsDotH; end; {if} end {if} else DoDefaultsDotH; end; {InitHeader} procedure StartInclude {name: gsosOutStringPtr}; { Marks the start of an include file } { } { Notes: } { 1. Call this subroutine right after opening an include } { file. } { 2. Defined externally in Scanner.pas } var giRec: getFileInfoOSDCB; {GetFileInfoGS record} i: 1..8; {loop/index counter} begin {StartInclude} if inhibitHeader then TermHeader; if not ignoreSymbols then begin includeLevel := includeLevel+1; if saveSource then begin if not includeMark then begin includeMark := true; SetMark; end; {if} giRec.pCount := 7; giRec.pathname := pointer(ord4(name)+2); GetFileInfoGS(giRec); WriteLongString(pointer(giRec.pathname)); for i := 1 to 8 do WriteByte(giRec.createDateTime[i]); for i := 1 to 8 do WriteByte(giRec.modDateTime[i]); end {if} else if not codeStarted then DestroySymbolFile; end; {if} end; {StartInclude} procedure TermHeader; { Stop processing the header file } { } { Note: This is called when the first code-generating } { subroutine is found, and again when the compile ends. It } { closes any open symbol file, and should take no action if } { called twice. } begin {TermHeader} if not ignoreSymbols then begin codeStarted := true; if saveSource then begin CloseSymbols; saveSource := false; dispose(buffer); end; {if} end; {if} end; {TermHeader} end. \ No newline at end of file +{$optimize 7} +{---------------------------------------------------------------} +{ } +{ Header } +{ } +{ Handles saving and reading precompiled headers. } +{ } +{---------------------------------------------------------------} + +unit Header; + +interface + +{$LibPrefix '0/obj/'} + +uses CCommon, MM, Scanner, Symbol, CGI; + +{$segment 'scanner'} + +var + inhibitHeader: boolean; {should .sym includes be blocked?} + + +procedure EndInclude (chPtr: ptr); + +{ Saves symbols created by the include file } +{ } +{ Parameters: } +{ chPtr - chPtr when the file returned } +{ } +{ Notes: } +{ 1. Call this subroutine right after processing an } +{ include file. } +{ 2. Declared externally in Symbol.pas } + + +procedure FlagPragmas (pragma: pragmas); + +{ record the effects of a pragma } +{ } +{ parameters: } +{ pragma - pragma to record } +{ } +{ Notes: } +{ 1. Defined as extern in Scanner.pas } +{ 2. For the purposes of this unit, the segment statement is } +{ treated as a pragma. } + + +procedure InitHeader (var fName: gsosOutString); + +{ look for a header file, reading it if it exists } +{ } +{ parameters: } +{ fName - source file name (var for efficiency) } + + +procedure TermHeader; + +{ Stop processing the header file } +{ } +{ Note: This is called when the first code-generating } +{ subroutine is found, and again when the compile ends. It } +{ closes any open symbol file, and should take no action if } +{ called twice. } + + +procedure StartInclude (name: gsosOutStringPtr); + +{ Marks the start of an include file } +{ } +{ Notes: } +{ 1. Call this subroutine right after opening an include } +{ file. } +{ 2. Defined externally in Scanner.pas } + +{---------------------------------------------------------------} + +implementation + +const + symFiletype = $5E; {symbol file type} + symAuxtype = $008008; + + {file buffer} + {-----------} + bufSize = 1024; {size of output buffer} + +type + closeOSDCB = record + pcount: integer; + refNum: integer; + end; + + createOSDCB = record + pcount: integer; + pathName: gsosInStringPtr; + access: integer; + fileType: integer; + auxType: longint; + storageType: integer; + dataEOF: longint; + resourceEOF: longint; + end; + + destroyOSDCB = record + pcount: integer; + pathName: gsosInStringPtr; + end; + + getFileInfoOSDCB = record + pcount: integer; + pathName: gsosInStringPtr; + access: integer; + fileType: integer; + auxType: longint; + storageType: integer; + createDateTime: timeField; + modDateTime: timeField; + optionList: optionListPtr; + dataEOF: longint; + blocksUsed: longint; + resourceEOF: longint; + resourceBlocks: longint; + end; + + getMarkOSDCB = record + pcount: integer; + refNum: integer; + displacement: longint; + end; + + openOSDCB = record + pcount: integer; + refNum: integer; + pathName: gsosInStringPtr; + requestAccess: integer; + resourceNumber: integer; + access: integer; + fileType: integer; + auxType: longint; + storageType: integer; + createDateTime: timeField; + modDateTime: timeField; + optionList: optionListPtr; + dataEOF: longint; + blocksUsed: longint; + resourceEOF: longint; + resourceBlocks: longint; + end; + + readWriteOSDCB = record + pcount: integer; + refNum: integer; + dataBuffer: ptr; + requestCount: longint; + transferCount: longint; + cachePriority: integer; + end; + + setMarkOSDCB = record + pcount: integer; + refNum: integer; + base: integer; + displacement: longint; + end; + + {file buffer} + {-----------} + bufferType = array[0..bufSize] of byte; {output buffer} + +var + codeStarted: boolean; {has code generation started?} + includeLevel: 0..maxint; {nexted include level} + includeMark: boolean; {has the mark field been written?} + savePragmas: set of pragmas; {pragmas to record} + saveSource: boolean; {save source streams?} + symChPtr: ptr; {chPtr at start of current source sequence} + symEndPtr: ptr; {points to first byte past end of file} + symMark: longint; {start of current block} + symName: gsosOutString; {symbol file name} + symStartPtr: ptr; {first byte in the symbol file} + symPtr: ptr; {next byte in the symbol file} + symRefnum: integer; {symName reference number} + tokenMark: longint; {start of last token list} + + {file buffer} + {-----------} + buffer: ^bufferType; {output buffer} + bufPtr: ^byte; {next available byte} + bufLen: 0..bufSize; {bytes left in buffer} + +{---------------------------------------------------------------} + +procedure BlockMove (sourcPtr, destPtr: ptr; count: longint); tool ($02, $2B); + +procedure CloseGS (var parms: closeOSDCB); prodos ($2014); + +procedure CreateGS (var parms: createOSDCB); prodos ($2001); + +procedure DestroyGS (var parms: destroyOSDCB); prodos ($2002); + +procedure GetFileInfoGS (var parms: getFileInfoOSDCB); prodos ($2006); + +procedure GetMarkGS (var parms: getMarkOSDCB); prodos ($2017); + +procedure OpenGS (var parms: openOSDCB); prodos ($2010); + +procedure SetEOFGS (var parms: setMarkOSDCB); prodos ($2018); + +procedure SetMarkGS (var parms: setMarkOSDCB); prodos ($2016); + +procedure WriteGS (var parms: readWriteOSDCB); prodos ($2013); + +{---------------------------------------------------------------} + +procedure DestroySymbolFile; + +{ Delete any existing symbol file } + +var + dsRec: destroyOSDCB; {DestroyGS record} + giRec: getFileInfoOSDCB; {GetFileInfoGS record} + +begin {DestroySymbolFile} +giRec.pCount := 4; +giRec.pathname := @symName.theString; +GetFileInfoGS(giRec); +if (giRec.filetype = symFiletype) and (giRec.auxtype = symAuxtype) then begin + dsRec.pCount := 1; + dsRec.pathname := @symName.theString; + DestroyGS(dsRec); + end; {if} +end; {DestroySymbolFile} + + +procedure Purge; + +{ Purge the output buffer } + +var + clRec: closeOSDCB; {CloseGS record} + wrRec: readWriteOSDCB; {WriteGS record} + +begin {Purge} +wrRec.pcount := 4; +wrRec.refnum := symRefnum; +wrRec.dataBuffer := pointer(buffer); +wrRec.requestCount := (bufSize - bufLen); +WriteGS(wrRec); +if ToolError <> 0 then begin + clRec.pCount := 1; + clRec.refnum := symRefnum; + CloseGS(clRec); + DestroySymbolFile; + saveSource := false; + end; {if} +bufLen := bufSize; +bufPtr := pointer(buffer); +end; {Purge} + + +procedure CloseSymbols; + +{ Close the symbol file } + +var + clRec: closeOSDCB; {CloseGS record} + +begin {CloseSymbols} +Purge; +clRec.pCount := 1; +clRec.refnum := symRefnum; +CloseGS(clRec); +if numErrors <> 0 then + DestroySymbolFile; +end; {CloseSymbols} + + +function ReadDouble: double; + +{ Read a double precision real from the symbol file } +{ } +{ Returns: value read } + +type + doubleptr = ^double; + +begin {ReadDouble} +ReadDouble := doubleptr(symPtr)^; +symPtr := pointer(ord4(symPtr)+8); +end; {ReadDouble} + + +function ReadLong: longint; + +{ Read a long word from the symbol file } +{ } +{ Returns: long word read } + +type + longptr = ^longint; + +begin {ReadLong} +ReadLong := longptr(symPtr)^; +symPtr := pointer(ord4(symPtr)+4); +end; {ReadLong} + + +function ReadLongString: longStringPtr; + +{ Read a long string from the symbol file } +{ } +{ Returns: string read } + +var + len: 0..maxint; {string buffer length} + sp1, sp2: longStringPtr; {work pointers} + +begin {ReadLongString} +sp1 := longStringPtr(symPtr); +len := sp1^.length + 2; +symPtr := pointer(ord4(symPtr) + len); +sp2 := pointer(GMalloc(len)); +BlockMove(sp1, sp2, len); +ReadLongString := sp2; +end; {ReadLongString} + + +function ReadString: stringPtr; + +{ Read a string from the symbol file } +{ } +{ Returns: string read } + +var + len: 0..255; {string buffer length} + sp1, sp2: stringPtr; {work pointers} + +begin {ReadString} +sp1 := stringptr(symPtr); +len := length(sp1^) + 1; +symPtr := pointer(ord4(symPtr) + len); +sp2 := pointer(GMalloc(len)); +BlockMove(sp1, sp2, len); +ReadString := sp2; +end; {ReadString} + + +function ReadByte: integer; + +{ Read a byte from the symbol file } +{ } +{ Returns: byte read } + +type + intptr = ^integer; + +begin {ReadByte} +ReadByte := (intptr(symPtr)^) & $00FF; +symPtr := pointer(ord4(symPtr)+1); +end; {ReadByte} + + +function ReadWord: integer; + +{ Read a word from the symbol file } +{ } +{ Returns: word read } + +type + intptr = ^integer; + +begin {ReadWord} +ReadWord := intptr(symPtr)^; +symPtr := pointer(ord4(symPtr)+2); +end; {ReadWord} + + +procedure ReadChars (var p1, p2: ptr); + +{ Read a character stream from the file } +{ } +{ parameters: } +{ p1 - (output) pointer to first char in stream } +{ p2 - (output) points one past last char in stream } + +var + len: integer; {length of the stream} + +begin {ReadChars} +len := ReadWord; +p1 := pointer(GMalloc(len)); +p2 := pointer(ord4(p1) + len); +BlockMove(symPtr, p1, len); +symPtr := pointer(ord4(symPtr) + len); +end; {ReadChars} + + +procedure WriteDouble (d: double); + +{ Write a double constant to the symbol file } +{ } +{ parameters: } +{ d - constant to write } + +var + dPtr: ^double; {work pointer} + +begin {WriteDouble} +if bufLen < 8 then + Purge; +dPtr := pointer(bufPtr); +dPtr^ := d; +bufPtr := pointer(ord4(bufPtr) + 8); +bufLen := bufLen - 8; +end; {WriteDouble} + + +procedure WriteLong (i: longint); + +{ Write a long word to the symbol file } +{ } +{ parameters: } +{ i - long word to write } + +var + lPtr: ^longint; {work pointer} + +begin {WriteLong} +if bufLen < 4 then + Purge; +lPtr := pointer(bufPtr); +lPtr^ := i; +bufPtr := pointer(ord4(bufPtr) + 4); +bufLen := bufLen - 4; +end; {WriteLong} + + +procedure WriteByte (i: integer); + +{ Write a byte to the symbol file } +{ } +{ parameters: } +{ i - byte to write } + +var + iPtr: ^byte; {work pointer} + +begin {WriteByte} +if bufLen = 0 then + Purge; +iPtr := pointer(bufPtr); +iPtr^ := i; +bufPtr := pointer(ord4(bufPtr) + 1); +bufLen := bufLen - 1; +end; {WriteByte} + + +procedure WriteWord (i: integer); + +{ Write a word to the symbol file } +{ } +{ parameters: } +{ i - word to write } + +var + iPtr: ^integer; {work pointer} + +begin {WriteWord} +if bufLen < 2 then + Purge; +iPtr := pointer(bufPtr); +iPtr^ := i; +bufPtr := pointer(ord4(bufPtr) + 2); +bufLen := bufLen - 2; +end; {WriteWord} + + +procedure WriteLongString (s: longStringPtr); + +{ Write a long string to the symbol file } +{ } +{ parameters: } +{ s - pointer to the string to write } + +var + i: 0..maxint; {loop/index variables} + len: 0..maxint; {string length} + wrRec: readWriteOSDCB; {WriteGS record} + +begin {WriteLongString} +len := s^.length; +if bufLen < len+2 then + Purge; +if bufLen < len+2 then begin + wrRec.pcount := 4; + wrRec.refnum := symRefnum; + wrRec.dataBuffer := pointer(s); + wrRec.requestCount := s^.length + 2; + WriteGS(wrRec); + if ToolError <> 0 then begin + CloseSymbols; + DestroySymbolFile; + saveSource := false; + end; {if} + end {if} +else begin + WriteWord(len); + for i := 1 to len do begin + bufPtr^ := ord(s^.str[i]); + bufPtr := pointer(ord4(bufPtr) + 1); + end; {for} + bufLen := bufLen - len; + end; {else} +end; {WriteLongString} + + +procedure WriteChars (p1, p2: ptr); + +{ Write a stream of chars as a longString } +{ } +{ parameters: } +{ p1 - points to the first char to write } +{ p2 - points to the byte following the last char } + +var + i: 0..maxint; {loop/index variables} + len: 0..maxint; {char length} + wrRec: readWriteOSDCB; {WriteGS record} + +begin {WriteChars} +len := ord(ord4(p2) - ord4(p1)); +WriteWord(len); +if bufLen < len then + Purge; +if bufLen < len then begin + if saveSource then begin + wrRec.pcount := 4; + wrRec.refnum := symRefnum; + wrRec.dataBuffer := pointer(p1); + wrRec.requestCount := ord4(p2) - ord4(p1); + WriteGS(wrRec); + if ToolError <> 0 then begin + CloseSymbols; + DestroySymbolFile; + saveSource := false; + end; {if} + end; {if} + end {if} +else begin + for i := 1 to len do begin + bufPtr^ := p1^; + bufPtr := pointer(ord4(bufPtr)+1); + p1 := pointer(ord4(p1)+1); + end; {for} + bufLen := bufLen - len; + end; {else} +end; {WriteChars} + + +procedure WriteString (s: stringPtr); + +{ Write a string to the symbol file } +{ } +{ parameters: } +{ s - pointer to the string to write } + +var + i: 0..255; {loop/index variable} + len: 0..255; {length of the string} + +begin {WriteString} +len := length(s^); +if bufLen < len+1 then + Purge; +for i := 0 to len do begin + bufPtr^ := ord(s^[i]); + bufPtr := pointer(ord4(bufPtr)+1); + end; {for} +bufLen := bufLen - (len + 1); +end; {WriteString} + + +procedure MarkBlock; + +{ Mark the length of the current block } + +var + l: longint; {block length} + smRec: setMarkOSDCB; {SetMarkGS record} + gmRec: getMarkOSDCB; {GetMarkGS record} + wrRec: readWriteOSDCB; {WriteGS record} + +begin {MarkBlock} +Purge; {purge the buffer} +gmRec.pCount := 2; {get the current EOF} +gmRec.refnum := symRefnum; +GetMarkGS(gmRec); +if ToolError = 0 then begin + smRec.pcount := 3; {set the mark to the block length field} + smRec.refnum := symRefnum; + smRec.base := 0; + smRec.displacement := symMark; + SetMarkGS(smRec); + if ToolError = 0 then begin + l := gmRec.displacement - smRec.displacement - 4; + wrRec.pcount := 4; + wrRec.refnum := symRefnum; + wrRec.dataBuffer := @l; + wrRec.requestCount := 4; + WriteGS(wrRec); + if ToolError <> 0 then begin + CloseSymbols; + DestroySymbolFile; + saveSource := false; + end; {if} + smRec.displacement := gmRec.displacement; + SetMarkGS(smRec); + end; {if} + end; {if} +if ToolError <> 0 then begin {for errors, delete the symbol file} + CloseSymbols; + DestroySymbolFile; + saveSource := false; + end; {if} +end; {MarkBlock} + + +function GetMark: longint; + +{ Find the current file mark } +{ } +{ Returns: file mark } + +var + gmRec: getMarkOSDCB; {GetMarkGS record} + +begin {GetMark} +gmRec.pCount := 2; +gmRec.refnum := symRefnum; +GetMarkGS(gmRec); +GetMark := gmRec.displacement + (bufSize - bufLen); +if ToolError <> 0 then begin + CloseSymbols; + DestroySymbolFile; + saveSource := false; + end; {else} +end; {GetMark} + + +procedure SetMark; + +{ Mark the start of a block } + +begin {SetMark} +symMark := GetMark; +WriteLong(0); +end; {SetMark} + +{---------------------------------------------------------------} + +procedure EndInclude {chPtr: ptr}; + +{ Saves symbols created by the include file } +{ } +{ Parameters: } +{ chPtr - chPtr when the file returned } +{ } +{ Notes: } +{ 1. Call this subroutine right after processing an } +{ include file. } +{ 2. Declared externally in Scanner.pas } + + + procedure SaveMacroTable; + + { Save macros to the symbol file } + + + procedure SaveMacros; + + { Write the macros to the symbol file } + + var + i: 0..hashSize; {loop/index variable} + mp: macroRecordPtr; {used to trace macro lists} + tp: tokenListRecordPtr; {used to trace token lists} + + + procedure WriteToken (var token: tokenType); + + { Write a token in the header file } + { } + { parameters: } + { token - token to write } + + begin {WriteToken} + WriteByte(ord(token.kind)); + WriteByte(ord(token.class)); + if token.numstring = nil then + WriteByte(0) + else begin + WriteByte(1); + WriteString(token.numstring); + end; {else} + case token.class of + identifier: WriteString(token.name); + intConstant: WriteWord(token.ival); + longConstant: WriteLong(token.lval); + doubleConstant: WriteDouble(token.rval); + stringConstant: begin + WriteLongString(token.sval); + WriteByte(ord(token.ispstring)); + end; + macroParameter: WriteWord(token.pnum); + otherwise: ; + end; {case} + end; {WriteToken} + + + begin {SaveMacros} + for i := 0 to hashSize do begin {loop over hash buckets} + mp := macros^[i]; {loop over macro records in hash bucket} + while mp <> nil do begin + if not mp^.saved then begin + mp^.saved := true; {mark this one as saved} + WriteString(mp^.name); {write the macroRecord} + WriteByte(mp^.parameters); + WriteByte(ord(mp^.readOnly)); + WriteByte(mp^.algorithm); + tp := mp^.tokens; {loop over token list} + while tp <> nil do begin + WriteByte(1); {write tokenListRecord} + WriteLongString(tp^.tokenString); + WriteToken(tp^.token); + WriteByte(ord(tp^.expandEnabled)); + WriteChars(tp^.tokenStart, tp^.tokenEnd); + tp := tp^.next; + end; {while} + WriteByte(0); {mark end of token list} + end; {if} + mp := mp^.next; + end; {while} + end; {for} + end; {SaveMacros} + + + begin {SaveMacroTable} + SetMark; {set the macro table length mark} + if saveSource then {write the macro table} + SaveMacros; + if saveSource then {mark the length of the table} + MarkBlock; + end; {SaveMacroTable} + + + procedure SavePragmaEffects; + + { Save the variables effected by any pragmas encountered } + + var + count: 0..maxint; {number of path names} + i: 1..10; {loop/index variable} + p: pragmas; {loop variable} + pp: pathRecordPtr; {used to trace pathname list} + + begin {SavePragmaEffects} + SetMark; + if saveSource then + for p := succ(p_startofenum) to pred(p_endofenum) do + if p in savePragmas then + if saveSource then begin + WriteByte(ord(p)); + case p of + p_cda: begin + WriteString(@menuLine); + WriteString(openName); + WriteString(closeName); + end; + + p_cdev: WriteString(openName); + + p_float: begin + WriteWord(floatCard); + WriteWord(floatSlot); + end; + + p_keep: WriteLongString(@outFileGS.theString); + + p_line: begin + WriteWord(lineNumber); + WriteLongString(@sourceFileGS.theString); + end; + + p_nda: begin + WriteString(openName); + WriteString(closeName); + WriteString(actionName); + WriteString(initName); + WriteWord(refreshPeriod); + WriteWord(eventMask); + WriteString(@menuLine); + end; + + p_nba: + WriteString(openName); + + p_xcmd: + WriteString(openName); + + p_debug: + WriteByte(ord(rangeCheck) + | (ord(debugFlag) << 1) + | (ord(profileFlag) << 2) + | (ord(traceBack) << 3) + | (ord(checkStack) << 4)); + + p_lint: WriteWord(lint); + + p_memorymodel: WriteByte(ord(smallMemoryModel)); + + p_expand: WriteByte(ord(printMacroExpansions)); + + p_optimize: + WriteByte(ord(peepHole) + | (ord(npeepHole) << 1) + | (ord(registers) << 2) + | (ord(saveStack) << 3) + | (ord(commonSubexpression) << 4) + | (ord(loopOptimizations) << 5) + | (ord(strictVararg) << 6)); + + p_stacksize: WriteWord(stackSize); + + p_toolparms: WriteByte(ord(toolParms)); + + p_databank: WriteByte(ord(dataBank)); + + p_rtl: ; + + p_noroot: ; + + p_path: begin + pp := pathList; + count := 0; + while pp <> nil do begin + count := count+1; + pp := pp^.next; + end; {while} + WriteWord(count); + pp := pathList; + while pp <> nil do begin + WriteString(pp^.path); + pp := pp^.next; + end; {while} + end; {p_path} + + p_ignore: WriteByte(ord(skipIllegalTokens) + + (ord(slashSlashComments) << 3)); + + p_segment: begin + for i := 1 to 10 do begin + WriteByte(defaultSegment[i]); + WriteByte(currentSegment[i]); + end; {for} + WriteWord(segmentKind); + end; + + p_unix: WriteByte(ord(unix_1)); + + end; {case} + end; {if} + if saveSource then + MarkBlock; + savePragmas := []; + end; {SavePragmaEffects} + + + procedure SaveSourceStream; + + { Save the source stream for later compares } + + var + wrRec: readWriteOSDCB; {WriteGS record} + + begin {SaveSourceStream} + WriteLong(ord4(chPtr) - ord4(symChPtr)); + Purge; + wrRec.pcount := 4; + wrRec.refnum := symRefnum; + wrRec.dataBuffer := pointer(symChPtr); + wrRec.requestCount := ord4(chPtr) - ord4(symChPtr); + WriteGS(wrRec); + symChPtr := chPtr; + if ToolError <> 0 then begin + CloseSymbols; + DestroySymbolFile; + saveSource := false; + end; {if} + end; {SaveSourceStream} + + + procedure SaveSymbolTable; + + { Save symbols to the symbol file } + + + procedure SaveSymbol; + + { Write the symbols to the symbol file } + + var + abort: boolean; {abort due to initialized var?} + efRec: setMarkOSDCB; {SetEOFGS record} + i: 0..hashSize; {loop/index variable} + sp: identPtr; {used to trace symbol lists} + + + procedure WriteIdent (ip: identPtr); + + { write a symbol to the symbol file } + { } + { parameters: } + { ip - pointer to symbol entry } + + + procedure WriteType (tp: typePtr); + + { write a type entry to the symbol file } + { } + { parameters: } + { tp - pointer to type entry } + + var + ip: identPtr; {for tracing field list} + + + procedure WriteParm (pp: parameterPtr); + + { write a parameter list to the symbol file } + { } + { parameters: } + { pp - parameter pointer } + + begin {WriteParm} + while pp <> nil do begin + WriteByte(1); + WriteType(pp^.parameterType); + pp := pp^.next; + end; {while} + WriteByte(0); + end; {WriteParm} + + + begin {WriteType} + if tp = bytePtr then + WriteByte(2) + else if tp = uBytePtr then + WriteByte(3) + else if tp = wordPtr then + WriteByte(4) + else if tp = uWordPtr then + WriteByte(5) + else if tp = longPtr then + WriteByte(6) + else if tp = uLongPtr then + WriteByte(7) + else if tp = realPtr then + WriteByte(8) + else if tp = doublePtr then + WriteByte(9) + else if tp = extendedPtr then + WriteByte(10) + else if tp = stringTypePtr then + WriteByte(11) + else if tp = voidPtr then + WriteByte(12) + else if tp = voidPtrPtr then + WriteByte(13) + else if tp = defaultStruct then + WriteByte(14) + else if tp^.saveDisp <> 0 then begin + WriteByte(1); + WriteLong(tp^.saveDisp); + end {if} + else begin + WriteByte(0); + tp^.saveDisp := GetMark; + WriteLong(tp^.size); + WriteByte(ord(tp^.isConstant)); + WriteByte(ord(tp^.kind)); + case tp^.kind of + scalarType: + WriteByte(ord(tp^.baseType)); + + arrayType: begin + WriteLong(tp^.elements); + WriteType(tp^.aType); + end; + + pointerType: + WriteType(tp^.pType); + + functionType: begin + WriteByte((ord(tp^.varargs) << 2) + | (ord(tp^.prototyped) << 1) | ord(tp^.isPascal)); + WriteWord(tp^.toolnum); + WriteLong(tp^.dispatcher); + WriteType(tp^.fType); + WriteParm(tp^.parameterList); + end; + + enumConst: + WriteWord(tp^.eval); + + definedType: + WriteType(tp^.dType); + + structType, unionType: begin + ip := tp^.fieldList; + while ip <> nil do begin + WriteByte(1); + WriteIdent(ip); + ip := ip^.next; + end; {while} + WriteByte(0); + end; + + otherwise: ; + + end; {case} + end; {else} + end; {WriteType} + + + begin {WriteIdent} + WriteString(ip^.name); + WriteType(ip^.itype); + if (ip^.disp = 0) and (ip^.bitDisp = 0) and (ip^.bitSize = 0) then + WriteByte(0) + else if (ip^.bitSize = 0) and (ip^.bitDisp = 0) then begin + if ip^.disp < maxint then begin + WriteByte(1); + WriteWord(ord(ip^.disp)); + end {if} + else begin + WriteByte(2); + WriteLong(ip^.disp); + end; {else} + end {else if} + else begin + WriteByte(3); + WriteLong(ip^.disp); + WriteByte(ip^.bitDisp); + WriteByte(ip^.bitSize); + end; {else} + if ip^.iPtr <> nil then + abort := true; + WriteByte(ord(ip^.state)); + WriteByte(ord(ip^.isForwardDeclared)); + WriteByte(ord(ip^.class)); + WriteByte(ord(ip^.storage)); + end; {WriteIdent} + + + begin {SaveSymbol} + abort := false; {no reason to abort, yet} + for i := 0 to hashSize2 do begin {loop over hash buckets} + sp := globalTable^.buckets[i]; {loop over symbol records in hash bucket} + while sp <> nil do begin + if not sp^.saved then begin + sp^.saved := true; {mark this one as saved} + WriteWord(i); {save the symbol} + WriteIdent(sp); + end; {if} + sp := sp^.next; + end; {while} + end; {for} + if abort then begin + Purge; + efRec.pcount := 3; + efRec.refnum := symRefnum; + efRec.base := 0; + efRec.displacement := tokenMark; + SetEOFGS(efRec); + if ToolError <> 0 then begin + CloseSymbols; + DestroySymbolFile; + end; {if} + saveSource := false; + end; {if} + end; {SaveSymbol} + + + begin {SaveSymbolTable} + SetMark; {set the symbol table length mark} + if saveSource then {write the symbol table} + if globalTable <> nil then + SaveSymbol; + if saveSource then {mark the length of the table} + MarkBlock; + end; {SaveSymbolTable} + + +begin {EndInclude} +if not ignoreSymbols then begin + includeLevel := includeLevel-1; + if includeLevel = 0 then + if saveSource then begin + MarkBlock; {set the include name mark} + SaveSourceStream; {save the source stream} + SaveMacroTable; {save the macro table} + SaveSymbolTable; {save the symbol table} + SavePragmaEffects; {save the effects of pragmas} + tokenMark := GetMark; {record mark for early exit} + includeMark := false; {no include mark, yet} + end; {if} + end; {if} +end; {EndInclude} + + +procedure FlagPragmas {pragma: pragmas}; + +{ record the effects of a pragma } +{ } +{ parameters: } +{ pragma - pragma to record } +{ } +{ Notes: } +{ 1. Defined as extern in Scanner.pas } +{ 2. For the purposes of this unit, the segment statement } +{ and #line directive are treated as pragmas. } + +begin {FlagPragmas} +savePragmas := savePragmas + [pragma]; +end; {FlagPragmas} + + +procedure InitHeader {var fName: gsosOutString}; + +{ look for a header file, reading it if it exists } +{ } +{ parameters: } +{ fName - source file name (var for efficiency) } + +type + typeDispPtr = ^typeDispRecord; {type displacement/pointer table} + typeDispRecord = record + next: typeDispPtr; + saveDisp: longint; + tPtr: typePtr; + end; + +var + done: boolean; {for loop termination test} + typeDispList: typeDispPtr; {type displacement/pointer table} + + + procedure DisposeTypeDispList; + + { Dispose of the type displacement list } + + var + tp: typeDispPtr; {work pointer} + + begin {DisposeTypeDispList} + while typeDispList <> nil do begin + tp := typeDispList; + typeDispList := tp^.next; + dispose(tp); + end; {while} + end; {DisposeTypeDispList} + + + function EndOfSymbols: boolean; + + { See if we're at the end of the symbol file } + { } + { Returns: True if at the end, else false } + + begin {EndOfSymbols} + EndOfSymbols := ord4(symPtr) >= ord4(symEndPtr); + end; {EndOfSymbols} + + + function OpenSymbols: boolean; + + { open and initialize the symbol file } + { } + { Returns: True if successful, else false } + + var + crRec: createOSDCB; {CreateGS record} + opRec: openOSDCB; {OpenGS record} + + begin {OpenSymbols} + OpenSymbols := false; {assume we will fail} + DestroySymbolFile; {destroy any existing file} + crRec.pCount := 5; {create a symbol file} + crRec.pathName := @symName.theString; + crRec.access := $C3; + crRec.fileType := symFiletype; + crRec.auxType := symAuxtype; + crRec.storageType := 1; + CreateGS(crRec); + if ToolError = 0 then begin + opRec.pCount := 3; + opRec.pathname := @symName.theString; + opRec.requestAccess := 3; + OpenGS(opRec); + if ToolError = 0 then begin + symRefnum := opRec.refnum; + OpenSymbols := true; + WriteWord(1); + tokenMark := GetMark; + includeMark := false; + end; {if} + end; {if} + end; {OpenSymbols} + + + procedure PurgeSymbols; + + { Purge the symbol input file } + + var + ffDCBGS: fastFileDCBGS; {fast file DCB} + + begin {PurgeSymbols} + with ffDCBGS do begin {purge the file} + pCount := 5; + action := 7; + pathName := @symName.theString; + end; {with} + FastFileGS(ffDCBGS); + end; {PurgeSymbols} + + + function DatesMatch: boolean; + + { Make sure the create/mod dates have not changed } + + var + giRec: getFileInfoOSDCB; {GetFileInfoGS record} + i: 1..maxint; {loop/index variable} + len: longint; {length of names} + match: boolean; {do the dates match?} + + begin {DatesMatch} + match := true; + len := ReadLong; + while len > 0 do begin + giRec.pCount := 7; + giRec.pathname := pointer(ReadLongString); + len := len - (giRec.pathname^.size + 18); + GetFileInfoGS(giRec); + if ToolError = 0 then begin + for i := 1 to 8 do + match := match and (giRec.createDateTime[i] = ReadByte); + for i := 1 to 8 do + match := match and (giRec.modDateTime[i] = ReadByte); + end {if} + else begin + match := false; + len := 0; + end; {else} + if match and progress then begin + write('Including '); + for i := 1 to giRec.pathname^.size do + write(giRec.pathname^.theString[i]); + writeln; + end; {if} + end; {while} + DatesMatch := match; + end; {DatesMatch} + + + procedure ReadMacroTable; + + { Read macros from the symbol file } + + var + bp: ^macroRecordPtr; {pointer to head of hash bucket} + ep: tokenListRecordPtr; {last token record} + mePtr: ptr; {end of macro table} + mp: macroRecordPtr; {new macro record} + tlen: integer; {length of the token name} + tp: tokenListRecordPtr; {new token record} + + + procedure ReadToken (var token: tokenType); + + { read a token } + { } + { parameters: } + { token - (output) token read) } + + begin {ReadToken} + token.kind := tokenEnum(ReadByte); + token.class := tokenClass(ReadByte); + if ReadByte = 0 then + token.numString := nil + else + token.numstring := ReadString; + case token.class of + identifier: token.name := ReadString; + intConstant: token.ival := ReadWord; + longConstant: token.lval := ReadLong; + doubleConstant: token.rval := ReadDouble; + stringConstant: begin + token.sval := ReadLongString; + token.ispstring := ReadByte <> 0; + end; + macroParameter: token.pnum := ReadWord; + otherwise: ; + end; {case} + end; {ReadToken} + + + begin {ReadMacroTable} + mePtr := symPtr; {read the block length} + mePtr := pointer(ord4(mePtr) + ReadLong + 4); + while ord4(symPtr) < ord4(mePtr) do {process the macros} + begin + Spin; + mp := pointer(GMalloc(sizeof(macroRecord))); + mp^.saved := false; + mp^.name := ReadString; + bp := pointer(ord4(macros) + Hash(mp^.name)); + mp^.next := bp^; + bp^ := mp; + mp^.parameters := ReadByte; + if mp^.parameters & $0080 <> 0 then + mp^.parameters := mp^.parameters | $FF00; + mp^.readOnly := boolean(ReadByte); + mp^.algorithm := ReadByte; + mp^.tokens := nil; + ep := nil; + while ReadByte <> 0 do begin + tp := pointer(GMalloc(sizeof(tokenListRecord))); + tp^.next := nil; + tp^.tokenString := ReadLongString; + ReadToken(tp^.token); + tp^.expandEnabled := boolean(ReadByte); + ReadChars(tp^.tokenStart, tp^.tokenEnd); + if ep = nil then + mp^.tokens := tp + else + ep^.next := tp; + ep := tp; + end; {while} + end; {while} + symPtr := mePtr; + end; {ReadMacroTable} + + + procedure ReadPragmas; + + { Read pragma effects } + + var + i: 0..maxint; {loop/index variable} + lsPtr: longStringPtr; {work pointer} + p: pragmas; {kind of pragma being processed} + pePtr: ptr; {end of pragma table} + pp, ppe: pathRecordPtr; {used to create a path name list} + sPtr: stringPtr; {work pointer} + val: integer; {temp value} + + begin {ReadPragmas} + pePtr := symPtr; {read the block length} + pePtr := pointer(ord4(pePtr) + ReadLong + 4); + while ord4(symPtr) < ord4(pePtr) do {process the pragmas} + begin + Spin; + p := pragmas(ReadByte); + case p of + p_cda: begin + isClassicDeskAcc := true; + sPtr := ReadString; + menuLine := sPtr^; + openName := ReadString; + closeName := ReadString; + end; + + p_cdev: begin + isCDev := true; + openName := ReadString; + end; + + p_float: begin + floatCard := ReadWord; + floatSlot := ReadWord; + end; + + p_keep: begin + liDCBGS.kFlag := 1; + lsPtr := ReadLongString; + outFileGS.theString.size := lsPtr^.length; + for i := 1 to outFileGS.theString.size do + outFileGS.theString.theString[i] := lsPtr^.str[i]; + end; + + p_line: begin + lineNumber := ReadWord; + lsPtr := ReadLongString; + sourceFileGS.theString.size := lsPtr^.length; + for i := 1 to sourceFileGS.theString.size do + sourceFileGS.theString.theString[i] := lsPtr^.str[i]; + end; + + p_nda: begin + isNewDeskAcc := true; + openName := ReadString; + closeName := ReadString; + actionName := ReadString; + initName := ReadString; + refreshPeriod := ReadWord; + eventMask := ReadWord; + sPtr := ReadString; + menuLine := sPtr^; + end; + + p_nba: begin + isNBA := true; + openName := ReadString; + end; + + p_xcmd: begin + isXCMD := true; + openName := ReadString; + end; + + p_debug: begin + val := ReadByte; + rangeCheck := odd(val); + debugFlag := odd(val >> 1); + profileFlag := odd(val >> 2); + traceback := odd(val >> 3); + checkStack := odd(val >> 4); + end; + + p_lint: lint := ReadWord; + + p_memorymodel: smallMemoryModel := boolean(ReadByte); + + p_expand: printMacroExpansions := boolean(ReadByte); + + p_optimize: begin + val := ReadByte; + peepHole := odd(val); + npeepHole := odd(val >> 1); + registers := odd(val >> 2); + saveStack := odd(val >> 3); + commonSubexpression := odd(val >> 4); + loopOptimizations := odd(val >> 5); + strictVararg := odd(val >> 6); + end; + + p_stacksize: stackSize := ReadWord; + + p_toolparms: toolParms := boolean(ReadByte); + + p_databank: dataBank := boolean(ReadByte); + + p_rtl: rtl := true; + + p_noroot: noroot := true; + + p_path: begin + i := ReadWord; + pathList := nil; + ppe := nil; + while i <> 0 do begin + pp := pathRecordPtr(GMalloc(sizeof(pathRecord))); + pp^.path := ReadString; + pp^.next := nil; + if pathList = nil then + pathList := pp + else + ppe^.next := pp; + ppe := pp; + i := i-1; + end; {while} + end; {p_path} + + p_ignore: begin + i := ReadByte; + skipIllegalTokens := odd(i); + slashSlashComments := odd(i >> 3); + end; + + p_segment: begin + for i := 1 to 10 do begin + defaultSegment[i] := chr(ReadByte); + currentSegment[i] := chr(ReadByte); + end; {for} + segmentKind := ReadWord; + end; + + p_unix: unix_1 := boolean(ReadByte); + + end; {case} + end; {while} + symPtr := pePtr; + end; {ReadPragmas} + + + procedure ReadSymbolTable; + + { Read symbols from the symbol file } + + var + hashPtr: ^identPtr; {pointer to hash bucket in symbol table} + sePtr: ptr; {end of symbol table} + sp: identPtr; {identifier being constructed} + + + function ReadIdent: identPtr; + + { Read an identifier from the file } + { } + { Returns: Pointer to the new identifier } + + var + format: 0..3; {storage format} + sp: identPtr; {identifier being constructed} + + + procedure ReadType (var tp: typePtr); + + { read a type from the symbol file } + { } + { parameters: } + { tp - (output) type entry } + + var + disp: longint; {disp read from symbol file} + ep: identPtr; {end of list of field names} + ip: identPtr; {for tracing field list} + tdisp: typeDispPtr; {used to trace, add to typeDispList} + val: integer; {temp word} + + + procedure ReadParm (var pp: parameterPtr); + + { read a parameter list from the symbol file } + { } + { parameters: } + { pp - (output) parameter pointer } + + var + ep: parameterPtr; {last parameter in list} + np: parameterPtr; {new parameter} + + begin {ReadParm} + pp := nil; + ep := nil; + while ReadByte = 1 do begin + np := parameterPtr(GMalloc(sizeof(parameterRecord))); + np^.next := nil; + np^.parameter := nil; + ReadType(np^.parameterType); + if ep = nil then + pp := np + else + ep^.next := np; + ep := np; + end; {while} + end; {ReadParm} + + + begin {ReadType} + case ReadByte of + 0: begin {read a new type} + tp := typePtr(GMalloc(sizeof(typeRecord))); + new(tdisp); + tdisp^.next := typeDispList; + typeDispList := tdisp; + tdisp^.saveDisp := ord4(symPtr) - ord4(symStartPtr); + tdisp^.tPtr := tp; + tp^.size := ReadLong; + tp^.saveDisp := 0; + tp^.isConstant := boolean(ReadByte); + tp^.kind := typeKind(ReadByte); + case tp^.kind of + scalarType: + tp^.baseType := baseTypeEnum(ReadByte); + + arrayType: begin + tp^.elements := ReadLong; + ReadType(tp^.aType); + end; + + pointerType: + ReadType(tp^.pType); + + functionType: begin + val := ReadByte; + tp^.varargs := odd(val >> 2); + tp^.prototyped := odd(val >> 1); + tp^.isPascal := odd(val); + tp^.toolnum := ReadWord; + tp^.dispatcher := ReadLong; + ReadType(tp^.fType); + ReadParm(tp^.parameterList); + end; + + enumConst: + tp^.eval := ReadWord; + + definedType: + ReadType(tp^.dType); + + structType, unionType: begin + tp^.fieldList := nil; + ep := nil; + while ReadByte = 1 do begin + ip := ReadIdent; + if ep = nil then + tp^.fieldList := ip + else + ep^.next := ip; + ep := ip; + end; {while} + end; + + otherwise: ; + + end; {case} + end; {case 0} + + 1: begin {read a type displacement} + tdisp := typeDispList; + disp := ReadLong; + while tdisp <> nil do + if tdisp^.saveDisp = disp then begin + tp := tdisp^.tPtr; + tdisp := nil; + end {if} + else + tdisp := tdisp^.next; + end; {case 1} + + 2: tp := bytePtr; + 3: tp := uBytePtr; + 4: tp := wordPtr; + 5: tp := uWordPtr; + 6: tp := longPtr; + 7: tp := uLongPtr; + 8: tp := realPtr; + 9: tp := doublePtr; + 10: tp := extendedPtr; + 11: tp := stringTypePtr; + 12: tp := voidPtr; + 13: tp := voidPtrPtr; + 14: tp := defaultStruct; + end; {case} + end; {ReadType} + + + begin {ReadIdent} + sp := pointer(GMalloc(sizeof(identRecord))); + sp^.next := nil; + sp^.saved := false; + sp^.name := ReadString; + ReadType(sp^.itype); + format := ReadByte; + if format = 0 then begin + sp^.disp := 0; + sp^.bitDisp := 0; + sp^.bitSize := 0; + end {if} + else if format = 1 then begin + sp^.disp := ReadWord; + sp^.bitDisp := 0; + sp^.bitSize := 0; + end {else if} + else if format = 2 then begin + sp^.disp := ReadLong; + sp^.bitDisp := 0; + sp^.bitSize := 0; + end {else if} + else begin + sp^.disp := ReadLong; + sp^.bitDisp := ReadByte; + sp^.bitSize := ReadByte; + end; {else} + sp^.iPtr := nil; + sp^.state := stateKind(ReadByte); + sp^.isForwardDeclared := boolean(ReadByte); + sp^.class := tokenEnum(ReadByte); + sp^.storage := storageType(ReadByte); + ReadIdent := sp; + end; {ReadIdent} + + + begin {ReadSymbolTable} + sePtr := symPtr; {read the block length} + sePtr := pointer(ord4(sePtr) + ReadLong + 4); + while ord4(symPtr) < ord4(sePtr) do {process the symbols} + begin + Spin; + hashPtr := pointer(ord4(globalTable) + ReadWord*4); + sp := ReadIdent; + sp^.next := hashPtr^; + hashPtr^ := sp; + end; {while} + symPtr := sePtr; + end; {ReadSymbolTable} + + + function OpenSymbolFile (var fName: gsosOutString): boolean; + + { Look for and open a symbol file } + { } + { parameters: } + { fName - source file name (var for efficiency) } + { } + { Returns: True if the file was found and opened, else false } + { } + { Notes: As a side effect, this subroutine creates the } + { pathname for the symbol file (symName). } + + var + ffDCBGS: fastFileDCBGS; {fast file DCB} + i: integer; {loop/index variable} + + begin {OpenSymbolFile} + symName := fName; {create the symbol file name} + i := symName.theString.size - 1; + while not (symName.theString.theString[i] in [':', '/', '.']) do + i := i-1; + if symName.theString.theString[i] <> '.' then + i := symName.theString.size; + if i > maxPath-5 then + i := maxPath-5; + symName.theString.theString[i] := '.'; + symName.theString.theString[i+1] := 's'; + symName.theString.theString[i+2] := 'y'; + symName.theString.theString[i+3] := 'm'; + symName.theString.theString[i+4] := chr(0); + symName.theString.size := i+3; + if rebuildSymbols then begin {rebuild any existing symbol file} + DestroySymbolFile; + OpenSymbolFile := false; + end {if} + else begin + with ffDCBGS do begin {read the symbol file} + pCount := 14; + action := 0; + flags := $C000; + pathName := @symName.theString; + end; {with} + FastFileGS(ffDCBGS); + if ToolError = 0 then begin + if (ffDCBGS.filetype = symFiletype) and (ffDCBGS.auxtype = symAuxtype) then + OpenSymbolFile := true + else begin + OpenSymbolFile := false; + PurgeSymbols; + end; {else} + symPtr := ffDCBGS.fileHandle^; + symStartPtr := symPtr; + symEndPtr := pointer(ord4(symPtr) + ffDCBGS.fileLength); + end {if} + else + OpenSymbolFile := false; + end; {else} + end; {OpenSymbolFile} + + + function SymbolVersion: integer; + + { Read the symbol file version number } + { } + { Returns: version number } + + begin {SymbolVersion} + SymbolVersion := ReadWord; + end; {SymbolVersion} + + + function SourceMatches: boolean; + + { Make sure the token streams match up to the next include } + + type + intPtr = ^integer; {for faster compares} + + var + len, len2: longint; {size of stream to compare} + match: boolean; {result flag} + p1, p2: ptr; {work pointers} + + begin {SourceMatches} + match := true; + len := ReadLong; + len2 := len; + p1 := symPtr; + p2 := chPtr; + while len > 1 do + if intPtr(p1)^ <> intPtr(p2)^ then begin + match := false; + len := 0; + end {if} + else begin + len := len-2; + p1 := pointer(ord4(p1)+2); + p2 := pointer(ord4(p2)+2); + end; {else} + if len = 1 then + if p1^ <> p2^ then + match := false; + if match then begin + symPtr := pointer(ord4(symPtr)+len2); + symChPtr := pointer(ord4(chPtr)+len2); + while chPtr <> symChPtr do + NextCh; + end; {if} + SourceMatches := match; + end; {SourceMatches} + + +begin {InitHeader} +inhibitHeader := false; {don't block .sym files} +if not ignoreSymbols then begin + codeStarted := false; {code generation has not started} + new(buffer); {allocate an output buffer} + bufPtr := pointer(buffer); + bufLen := bufSize; + includeLevel := 0; {no nested includes} + symChPtr := chPtr; {record initial source location} + if OpenSymbolFile(fName) then begin {check for symbol file} + if SymbolVersion = 1 then begin + done := EndOfSymbols; {valid file found - process it} + if done then + PurgeSymbols; + typeDispList := nil; + while not done do begin + if DatesMatch then begin + if SourceMatches then begin + ReadMacroTable; + ReadSymbolTable; + ReadPragmas; + if EndOfSymbols then begin + done := true; + PurgeSymbols; + end; {if} + end {if} + else begin + PurgeSymbols; + DestroySymbolFile; + done := true; + end; {else} + end {if} + else begin + PurgeSymbols; + DestroySymbolFile; + done := true; + end; {else} + end; {while} + DisposeTypeDispList; + saveSource := false; + end {if} + else begin + PurgeSymbols; {no file found} + saveSource := true; + end; {else} + end {if} + else + saveSource := true; + if saveSource then begin {start saving source} + saveSource := OpenSymbols; + savePragmas := []; + DoDefaultsDotH; + end; {if} + end {if} +else + DoDefaultsDotH; +end; {InitHeader} + + +procedure StartInclude {name: gsosOutStringPtr}; + +{ Marks the start of an include file } +{ } +{ Notes: } +{ 1. Call this subroutine right after opening an include } +{ file. } +{ 2. Defined externally in Scanner.pas } + +var + giRec: getFileInfoOSDCB; {GetFileInfoGS record} + i: 1..8; {loop/index counter} + +begin {StartInclude} +if inhibitHeader then + TermHeader; +if not ignoreSymbols then begin + includeLevel := includeLevel+1; + if saveSource then begin + if not includeMark then begin + includeMark := true; + SetMark; + end; {if} + giRec.pCount := 7; + giRec.pathname := pointer(ord4(name)+2); + GetFileInfoGS(giRec); + WriteLongString(pointer(giRec.pathname)); + for i := 1 to 8 do + WriteByte(giRec.createDateTime[i]); + for i := 1 to 8 do + WriteByte(giRec.modDateTime[i]); + end {if} + else if not codeStarted then + DestroySymbolFile; + end; {if} +end; {StartInclude} + + +procedure TermHeader; + +{ Stop processing the header file } +{ } +{ Note: This is called when the first code-generating } +{ subroutine is found, and again when the compile ends. It } +{ closes any open symbol file, and should take no action if } +{ called twice. } + +begin {TermHeader} +if not ignoreSymbols then begin + codeStarted := true; + if saveSource then begin + CloseSymbols; + saveSource := false; + dispose(buffer); + end; {if} + end; {if} +end; {TermHeader} + +end. diff --git a/Header2.pas b/Header2.pas old mode 100755 new mode 100644 index bc8a566..5a0c0d9 --- a/Header2.pas +++ b/Header2.pas @@ -1 +1,149 @@ -{$optimize 7} {---------------------------------------------------------------} { } { Header } { } { Handles saving and reading precompiled headers. } { } {---------------------------------------------------------------} unit Header; {$LibPrefix '0/obj/'} interface uses CCommon, MM, Scanner, Symbol, CGI; {$segment 'scanner'} var inhibitHeader: boolean; {should .sym includes be blocked?} procedure EndInclude (chPtr: ptr); { Saves symbols created by the include file } { } { Parameters: } { chPtr - chPtr when the file returned } { } { Notes: } { 1. Call this subroutine right after processing an } { include file. } { 2. Declared externally in Symbol.pas } procedure FlagPragmas (pragma: pragmas); { record the effects of a pragma } { } { parameters: } { pragma - pragma to record } { } { Notes: } { 1. Defined as extern in Scanner.pas } { 2. For the purposes of this unit, the segment statement is } { treated as a pragma. } procedure InitHeader (var fName: gsosOutString); { look for a header file, reading it if it exists } { } { parameters: } { fName - source file name (var for efficiency) } procedure TermHeader; { Stop processing the header file } { } { Note: This is called when the first code-generating } { subroutine is found, and again when the compile ends. It } { closes any open symbol file, and should take no action if } { called twice. } procedure StartInclude (name: gsosOutStringPtr); { Marks the start of an include file } { } { Notes: } { 1. Call this subroutine right after opening an include } { file. } { 2. Defined externally in Scanner.pas } {---------------------------------------------------------------} implementation procedure EndInclude {chPtr: ptr}; { Saves symbols created by the include file } { } { Parameters: } { chPtr - chPtr when the file returned } { } { Notes: } { 1. Call this subroutine right after processing an } { include file. } { 2. Declared externally in Symbol.pas } begin {EndInclude} end; {EndInclude} procedure FlagPragmas {pragma: pragmas}; { record the effects of a pragma } { } { parameters: } { pragma - pragma to record } { } { Notes: } { 1. Defined as extern in Scanner.pas } { 2. For the purposes of this unit, the segment statement is } { treated as a pragma. } begin {FlagPragmas} end; {FlagPragmas} procedure InitHeader {var fName: gsosOutString}; { look for a header file, reading it if it exists } { } { parameters: } { fName - source file name (var for efficiency) } begin {InitHeader} end; {InitHeader} procedure StartInclude {name: gsosOutStringPtr}; { Marks the start of an include file } { } { Notes: } { 1. Call this subroutine right after opening an include } { file. } { 2. Defined externally in Scanner.pas } begin {StartInclude} end; {StartInclude} procedure TermHeader; { Stop processing the header file } { } { Note: This is called when the first code-generating } { subroutine is found, and again when the compile ends. It } { closes any open symbol file, and should take no action if } { called twice. } begin {TermHeader} end; {TermHeader} end. \ No newline at end of file +{$optimize 7} +{---------------------------------------------------------------} +{ } +{ Header } +{ } +{ Handles saving and reading precompiled headers. } +{ } +{---------------------------------------------------------------} + +unit Header; + +{$LibPrefix '0/obj/'} + +interface + +uses CCommon, MM, Scanner, Symbol, CGI; + +{$segment 'scanner'} + +var + inhibitHeader: boolean; {should .sym includes be blocked?} + + +procedure EndInclude (chPtr: ptr); + +{ Saves symbols created by the include file } +{ } +{ Parameters: } +{ chPtr - chPtr when the file returned } +{ } +{ Notes: } +{ 1. Call this subroutine right after processing an } +{ include file. } +{ 2. Declared externally in Symbol.pas } + + +procedure FlagPragmas (pragma: pragmas); + +{ record the effects of a pragma } +{ } +{ parameters: } +{ pragma - pragma to record } +{ } +{ Notes: } +{ 1. Defined as extern in Scanner.pas } +{ 2. For the purposes of this unit, the segment statement is } +{ treated as a pragma. } + + +procedure InitHeader (var fName: gsosOutString); + +{ look for a header file, reading it if it exists } +{ } +{ parameters: } +{ fName - source file name (var for efficiency) } + + +procedure TermHeader; + +{ Stop processing the header file } +{ } +{ Note: This is called when the first code-generating } +{ subroutine is found, and again when the compile ends. It } +{ closes any open symbol file, and should take no action if } +{ called twice. } + + +procedure StartInclude (name: gsosOutStringPtr); + +{ Marks the start of an include file } +{ } +{ Notes: } +{ 1. Call this subroutine right after opening an include } +{ file. } +{ 2. Defined externally in Scanner.pas } + +{---------------------------------------------------------------} + +implementation + +procedure EndInclude {chPtr: ptr}; + +{ Saves symbols created by the include file } +{ } +{ Parameters: } +{ chPtr - chPtr when the file returned } +{ } +{ Notes: } +{ 1. Call this subroutine right after processing an } +{ include file. } +{ 2. Declared externally in Symbol.pas } + +begin {EndInclude} +end; {EndInclude} + + +procedure FlagPragmas {pragma: pragmas}; + +{ record the effects of a pragma } +{ } +{ parameters: } +{ pragma - pragma to record } +{ } +{ Notes: } +{ 1. Defined as extern in Scanner.pas } +{ 2. For the purposes of this unit, the segment statement is } +{ treated as a pragma. } + +begin {FlagPragmas} +end; {FlagPragmas} + + +procedure InitHeader {var fName: gsosOutString}; + +{ look for a header file, reading it if it exists } +{ } +{ parameters: } +{ fName - source file name (var for efficiency) } + +begin {InitHeader} +end; {InitHeader} + + +procedure StartInclude {name: gsosOutStringPtr}; + +{ Marks the start of an include file } +{ } +{ Notes: } +{ 1. Call this subroutine right after opening an include } +{ file. } +{ 2. Defined externally in Scanner.pas } + +begin {StartInclude} +end; {StartInclude} + + +procedure TermHeader; + +{ Stop processing the header file } +{ } +{ Note: This is called when the first code-generating } +{ subroutine is found, and again when the compile ends. It } +{ closes any open symbol file, and should take no action if } +{ called twice. } + +begin {TermHeader} +end; {TermHeader} + +end. diff --git a/MM.asm b/MM.asm old mode 100755 new mode 100644 index aac8d30..7250e10 --- a/MM.asm +++ b/MM.asm @@ -1 +1,115 @@ - mcopy mm.macros **************************************************************** * * Calloc - Allocate memory from a pool and set it to 0. * * Inputs: * bytes - number of bytes to allocate * useGlobalPool - should the memory come from the global * (or local) pool * * Outputs: * ptr - points to the first byte of the allocated memory * **************************************************************** * Calloc start ptr equ 0 pointer to reserved memory subroutine (2:bytes),4 ph2 bytes reserve the memory jsl Malloc sta ptr save the pointer to the memory stx ptr+2 lda bytes if there are an odd number of bytes then tay lsr a bcc lb1 short M zero the first byte lda #0 dey sta [ptr],Y long M lb1 tyx done if there are no more bytes beq lb4 lda #0 dey branch if the next word is the zeroth dey beq lb3 lb2 sta [ptr],Y zero full words dey dey bne lb2 lb3 sta [ptr] zero the last word lb4 return 4:ptr return the pointer end **************************************************************** * * GCalloc - Allocate and clear memory from the global pool. * * Inputs: * bytes - number of bytes to allocate * * Outputs: * ptr - points to the first byte of the allocated memory * **************************************************************** * GCalloc start ptr equ 0 pointer to reserved memory subroutine (2:bytes),4 ph2 bytes reserve the memory jsl GMalloc sta ptr save the pointer to the memory stx ptr+2 lda bytes if there are an odd number of bytes then tay lsr a bcc lb1 short M zero the first byte lda #0 dey sta [ptr],Y long M lb1 tyx done if there are no more bytes beq lb4 lda #0 dey branch if the next word is the zeroth dey beq lb3 lb2 sta [ptr],Y zero full words dey dey bne lb2 lb3 sta [ptr] zero the last word lb4 return 4:ptr return the pointer end **************************************************************** * * Malloc - Allocate memory from a pool. * * Inputs: * bytes - number of bytes to allocate * useGlobalPool - should the memory come from the global * (or local) pool * * Outputs: * ptr - points to the first byte of the allocated memory * **************************************************************** * Malloc start lda useGlobalPool jne GMalloc jmp LMalloc end \ No newline at end of file + mcopy mm.macros +**************************************************************** +* +* Calloc - Allocate memory from a pool and set it to 0. +* +* Inputs: +* bytes - number of bytes to allocate +* useGlobalPool - should the memory come from the global +* (or local) pool +* +* Outputs: +* ptr - points to the first byte of the allocated memory +* +**************************************************************** +* +Calloc start + +ptr equ 0 pointer to reserved memory + + subroutine (2:bytes),4 + + ph2 bytes reserve the memory + jsl Malloc + sta ptr save the pointer to the memory + stx ptr+2 + lda bytes if there are an odd number of bytes then + tay + lsr a + bcc lb1 + short M zero the first byte + lda #0 + dey + sta [ptr],Y + long M +lb1 tyx done if there are no more bytes + beq lb4 + lda #0 + dey branch if the next word is the zeroth + dey + beq lb3 +lb2 sta [ptr],Y zero full words + dey + dey + bne lb2 +lb3 sta [ptr] zero the last word + +lb4 return 4:ptr return the pointer + end + +**************************************************************** +* +* GCalloc - Allocate and clear memory from the global pool. +* +* Inputs: +* bytes - number of bytes to allocate +* +* Outputs: +* ptr - points to the first byte of the allocated memory +* +**************************************************************** +* +GCalloc start + +ptr equ 0 pointer to reserved memory + + subroutine (2:bytes),4 + + ph2 bytes reserve the memory + jsl GMalloc + sta ptr save the pointer to the memory + stx ptr+2 + lda bytes if there are an odd number of bytes then + tay + lsr a + bcc lb1 + short M zero the first byte + lda #0 + dey + sta [ptr],Y + long M +lb1 tyx done if there are no more bytes + beq lb4 + lda #0 + dey branch if the next word is the zeroth + dey + beq lb3 +lb2 sta [ptr],Y zero full words + dey + dey + bne lb2 +lb3 sta [ptr] zero the last word + +lb4 return 4:ptr return the pointer + end + +**************************************************************** +* +* Malloc - Allocate memory from a pool. +* +* Inputs: +* bytes - number of bytes to allocate +* useGlobalPool - should the memory come from the global +* (or local) pool +* +* Outputs: +* ptr - points to the first byte of the allocated memory +* +**************************************************************** +* +Malloc start + + lda useGlobalPool + jne GMalloc + jmp LMalloc + end diff --git a/MM.macros b/MM.macros old mode 100755 new mode 100644 index ea3fa02..d3e16ed --- a/MM.macros +++ b/MM.macros @@ -1 +1,195 @@ - MACRO &lab subroutine &parms,&work &lab anop aif c:&work,.a lclc &work &work setc 0 .a gbla &totallen gbla &worklen &worklen seta &work &totallen seta 0 aif c:&parms=0,.e lclc &len lclc &p lcla &i &i seta c:&parms .b &p setc &parms(&i) &len amid &p,2,1 aif "&len"=":",.c &len amid &p,1,2 &p amid &p,4,l:&p-3 ago .d .c &len amid &p,1,1 &p amid &p,3,l:&p-2 .d &p equ &totallen+3+&work &totallen seta &totallen+&len &i seta &i-1 aif &i,^b .e tsc sec sbc #&work tcs inc a phd tcd mend MACRO &lab return &r &lab anop lclc &len aif c:&r,.a lclc &r &r setc 0 &len setc 0 ago .h .a &len amid &r,2,1 aif "&len"=":",.b &len amid &r,1,2 &r amid &r,4,l:&r-3 ago .c .b &len amid &r,1,1 &r amid &r,3,l:&r-2 .c aif &len<>2,.d ldy &r ago .h .d aif &len<>4,.e ldx &r+2 ldy &r ago .h .e aif &len<>10,.g aif &totallen=0,.f lda &worklen+1 sta &worklen+&totallen+1 lda &worklen sta &worklen+&totallen .f pld tsc clc adc #&worklen+&totallen tcs phb plx ply lda &r+8 pha lda &r+6 pha lda &r+4 pha lda &r+2 pha lda &r pha phy phx plb rtl mexit .g mnote 'Not a valid return length',16 mexit .h aif &totallen=0,.i lda &worklen+1 sta &worklen+&totallen+1 lda &worklen sta &worklen+&totallen .i pld tsc clc adc #&worklen+&totallen tcs aif &len=0,.j tya .j rtl mend MACRO &LAB JNE &BP &LAB BEQ *+5 BRL &BP MEND MACRO &LAB LONG &A,&B LCLB &I LCLB &M &A AMID &A,1,1 &M SETB ("&A"="M").OR.("&A"="m") &I SETB ("&A"="I").OR.("&A"="i") AIF C:&B=0,.A &B AMID &B,1,1 &M SETB ("&B"="M").OR.("&B"="m").OR.&M &I SETB ("&B"="I").OR.("&B"="i").OR.&I .A &LAB REP #&M*32+&I*16 AIF .NOT.&M,.B LONGA ON .B AIF .NOT.&I,.C LONGI ON .C MEND MACRO &LAB PH2 &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"="#",.D AIF S:LONGA=1,.A REP #%00100000 .A AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 LDA (&N1) PHA AGO .E .B LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &LAB SHORT &A,&B LCLB &I LCLB &M &A AMID &A,1,1 &M SETB ("&A"="M").OR.("&A"="m") &I SETB ("&A"="I").OR.("&A"="i") AIF C:&B=0,.A &B AMID &B,1,1 &M SETB ("&B"="M").OR.("&B"="m").OR.&M &I SETB ("&B"="I").OR.("&B"="i").OR.&I .A &LAB SEP #&M*32+&I*16 AIF .NOT.&M,.B LONGA OFF .B AIF .NOT.&I,.C LONGI OFF .C MEND \ No newline at end of file + MACRO +&lab subroutine &parms,&work +&lab anop + aif c:&work,.a + lclc &work +&work setc 0 +.a + gbla &totallen + gbla &worklen +&worklen seta &work +&totallen seta 0 + aif c:&parms=0,.e + lclc &len + lclc &p + lcla &i +&i seta c:&parms +.b +&p setc &parms(&i) +&len amid &p,2,1 + aif "&len"=":",.c +&len amid &p,1,2 +&p amid &p,4,l:&p-3 + ago .d +.c +&len amid &p,1,1 +&p amid &p,3,l:&p-2 +.d +&p equ &totallen+3+&work +&totallen seta &totallen+&len +&i seta &i-1 + aif &i,^b +.e + tsc + sec + sbc #&work + tcs + inc a + phd + tcd + mend + MACRO +&lab return &r +&lab anop + lclc &len + aif c:&r,.a + lclc &r +&r setc 0 +&len setc 0 + ago .h +.a +&len amid &r,2,1 + aif "&len"=":",.b +&len amid &r,1,2 +&r amid &r,4,l:&r-3 + ago .c +.b +&len amid &r,1,1 +&r amid &r,3,l:&r-2 +.c + aif &len<>2,.d + ldy &r + ago .h +.d + aif &len<>4,.e + ldx &r+2 + ldy &r + ago .h +.e + aif &len<>10,.g + aif &totallen=0,.f + lda &worklen+1 + sta &worklen+&totallen+1 + lda &worklen + sta &worklen+&totallen +.f + pld + tsc + clc + adc #&worklen+&totallen + tcs + phb + plx + ply + lda &r+8 + pha + lda &r+6 + pha + lda &r+4 + pha + lda &r+2 + pha + lda &r + pha + phy + phx + plb + rtl + mexit +.g + mnote 'Not a valid return length',16 + mexit +.h + aif &totallen=0,.i + lda &worklen+1 + sta &worklen+&totallen+1 + lda &worklen + sta &worklen+&totallen +.i + pld + tsc + clc + adc #&worklen+&totallen + tcs + aif &len=0,.j + tya +.j + rtl + mend + MACRO +&LAB JNE &BP +&LAB BEQ *+5 + BRL &BP + MEND + MACRO +&LAB LONG &A,&B + LCLB &I + LCLB &M +&A AMID &A,1,1 +&M SETB ("&A"="M").OR.("&A"="m") +&I SETB ("&A"="I").OR.("&A"="i") + AIF C:&B=0,.A +&B AMID &B,1,1 +&M SETB ("&B"="M").OR.("&B"="m").OR.&M +&I SETB ("&B"="I").OR.("&B"="i").OR.&I +.A +&LAB REP #&M*32+&I*16 + AIF .NOT.&M,.B + LONGA ON +.B + AIF .NOT.&I,.C + LONGI ON +.C + MEND + MACRO +&LAB PH2 &N1 + LCLC &C +&LAB ANOP +&C AMID &N1,1,1 + AIF "&C"="#",.D + AIF S:LONGA=1,.A + REP #%00100000 +.A + AIF "&C"<>"{",.B +&C AMID &N1,L:&N1,1 + AIF "&C"<>"}",.G +&N1 AMID &N1,2,L:&N1-2 + LDA (&N1) + PHA + AGO .E +.B + LDA &N1 + PHA + AGO .E +.D +&N1 AMID &N1,2,L:&N1-1 + PEA &N1 + AGO .F +.E + AIF S:LONGA=1,.F + SEP #%00100000 +.F + MEXIT +.G + MNOTE "Missing closing '}'",16 + MEND + MACRO +&LAB SHORT &A,&B + LCLB &I + LCLB &M +&A AMID &A,1,1 +&M SETB ("&A"="M").OR.("&A"="m") +&I SETB ("&A"="I").OR.("&A"="i") + AIF C:&B=0,.A +&B AMID &B,1,1 +&M SETB ("&B"="M").OR.("&B"="m").OR.&M +&I SETB ("&B"="I").OR.("&B"="i").OR.&I +.A +&LAB SEP #&M*32+&I*16 + AIF .NOT.&M,.B + LONGA OFF +.B + AIF .NOT.&I,.C + LONGI OFF +.C + MEND diff --git a/MM.pas b/MM.pas old mode 100755 new mode 100644 index 99d2418..9cbd6d0 --- a/MM.pas +++ b/MM.pas @@ -1 +1,232 @@ -{$optimize 7} {---------------------------------------------------------------} { } { Memory Manager } { } { This memory manager provides a stack-based memory allocation } { and deallocation mechanism to allow compact symbol tables } { that can be disposed of with a single call after a function } { has been compiled. Two separate stacks, or pools, are } { available. The local pool is typically disposed of when } { the compilation of a function is complete. It is used for } { local memory allocations such as local strings and symbols. } { The global pool is used for global values like macro } { definitions and global symbols. } { } { External Variables: } { localID - userID for the local pool } { globalID - userID for the global pool } { } { External Subroutines: } { DisposeLocalPool - dump the local memory pool } { Calloc - clear and allocate memory } { GCalloc - allocate & clear memory from the global pool } { GInit - initialize a global pool } { GMalloc - allocate memory from the global pool } { LInit - initialize a local pool } { LMalloc - allocate memory from the local pool } { Malloc - allocate memory } { MMQuit - Dispose of memory allocated with private user } { IDs } { } {---------------------------------------------------------------} unit MM; {$LibPrefix '0/obj/'} interface uses CCommon; var localID,globalID: integer; {user ID's for the local & global pools} {---------------------------------------------------------------} function Calloc (bytes: integer): ptr; extern; { Allocate memory from a pool and set it to 0. } { } { Parameters: } { bytes - number of bytes to allocate } { ptr - points to the first byte of the allocated memory } { } { Globals: } { useGlobalPool - should the memory come from the global } { (or local) pool } function GCalloc (bytes: integer): ptr; extern; { Allocate and clear memory from the global pool. } { } { Parameters: } { bytes - number of bytes to allocate } { ptr - points to the first byte of the allocated memory } procedure GInit; { Initialize a global pool } function GMalloc (bytes: integer): ptr; { Allocate memory from the global pool. } { } { Parameters: } { bytes - number of bytes to allocate } { ptr - points to the first byte of the allocated memory } procedure LInit; { Initialize a local pool } function LMalloc (bytes: integer): ptr; { Allocate memory from the local pool. } { } { Parameters: } { bytes - number of bytes to allocate } { ptr - points to the first byte of the allocated memory } function Malloc (bytes: integer): ptr; extern; { Allocate memory from a pool. } { } { Parameters: } { bytes - number of bytes to allocate } { ptr - points to the first byte of the allocated memory } { } { Globals: } { useGlobalPool - should the memory come from the global } { (or local) pool } procedure MMQuit; { Dispose of memory allocated with private user IDs } {---------------------------------------------------------------} implementation const poolSize = 4096; {size of a memory pool} var globalPtr: ptr; {pointer to the next free global byte} globalSize: integer; {bytes remaining in the global pool} localPtr: ptr; {pointer to the next free local byte} localSize: integer; {bytes remaining in the local pool} {---------------------------------------------------------------} {GS memory manager} {-----------------} procedure DisposeAll (userID: integer); tool($02, $11); function NewHandle (blockSize: longint; userID, memAttributes: integer; memLocation: ptr): handle; tool($02, $09); {---------------------------------------------------------------} procedure GInit; { Initialize a global pool } var myhandle: handle; {for dereferencing the block} begin {GInit} globalID := UserID | $0200; {set the global user ID} DisposeAll(globalID); {dump any old pool areas} globalSize := poolSize; {allocate a new pool} myhandle := NewHandle(poolSize, globalID, $C010, nil); if ToolError <> 0 then TermError(5); globalPtr := myhandle^; end; {GInit} function GMalloc {bytes: integer): ptr}; { Allocate memory from the global pool. } { } { Parameters: } { bytes - number of bytes to allocate } { ptr - points to the first byte of the allocated memory } var myhandle: handle; {for dereferencing the block} begin {GMalloc} if bytes > globalSize then begin {allocate a new pool, if needed} globalSize := poolSize; myhandle := NewHandle(poolSize, globalID, $C010, nil); if ToolError <> 0 then TermError(5); globalPtr := myhandle^; end; {if} GMalloc := globalPtr; {allocate memory from the pool} globalSize := globalSize - bytes; globalPtr := pointer(ord4(globalPtr) + bytes); end; {GMalloc} procedure LInit; { Initialize a local pool } var myhandle: handle; {for dereferencing the block} begin {LInit} localID := UserID | $0400; {set the local user ID} DisposeAll(localID); {dump any old pool areas} localSize := poolSize; {allocate a new pool} myhandle := NewHandle(poolSize, localID, $C010, nil); if ToolError <> 0 then TermError(5); localPtr := myhandle^; end; {LInit} function LMalloc {bytes: integer): ptr}; { Allocate memory from the local pool. } { } { Parameters: } { bytes - number of bytes to allocate } { ptr - points to the first byte of the allocated memory } var myhandle: handle; {for dereferencing the block} begin {LMalloc} if bytes > localSize then begin {allocate a new pool, if needed} localSize := poolSize; myhandle := NewHandle(poolSize, localID, $C010, nil); if ToolError <> 0 then TermError(5); localPtr := myhandle^; end; {if} LMalloc := localPtr; {allocate memory from the pool} localSize := localSize - bytes; localPtr := pointer(ord4(localPtr) + bytes); end; {LMalloc} procedure MMQuit; { Dispose of memory allocated with private user IDs } begin {MMQuit} DisposeAll(globalID); DisposeAll(localID); end; {MMQuit} end. {$append 'mm.asm'} \ No newline at end of file +{$optimize 7} +{---------------------------------------------------------------} +{ } +{ Memory Manager } +{ } +{ This memory manager provides a stack-based memory allocation } +{ and deallocation mechanism to allow compact symbol tables } +{ that can be disposed of with a single call after a function } +{ has been compiled. Two separate stacks, or pools, are } +{ available. The local pool is typically disposed of when } +{ the compilation of a function is complete. It is used for } +{ local memory allocations such as local strings and symbols. } +{ The global pool is used for global values like macro } +{ definitions and global symbols. } +{ } +{ External Variables: } +{ localID - userID for the local pool } +{ globalID - userID for the global pool } +{ } +{ External Subroutines: } +{ DisposeLocalPool - dump the local memory pool } +{ Calloc - clear and allocate memory } +{ GCalloc - allocate & clear memory from the global pool } +{ GInit - initialize a global pool } +{ GMalloc - allocate memory from the global pool } +{ LInit - initialize a local pool } +{ LMalloc - allocate memory from the local pool } +{ Malloc - allocate memory } +{ MMQuit - Dispose of memory allocated with private user } +{ IDs } +{ } +{---------------------------------------------------------------} + +unit MM; + +{$LibPrefix '0/obj/'} + +interface + +uses CCommon; + +var + localID,globalID: integer; {user ID's for the local & global pools} + +{---------------------------------------------------------------} + +function Calloc (bytes: integer): ptr; extern; + +{ Allocate memory from a pool and set it to 0. } +{ } +{ Parameters: } +{ bytes - number of bytes to allocate } +{ ptr - points to the first byte of the allocated memory } +{ } +{ Globals: } +{ useGlobalPool - should the memory come from the global } +{ (or local) pool } + + +function GCalloc (bytes: integer): ptr; extern; + +{ Allocate and clear memory from the global pool. } +{ } +{ Parameters: } +{ bytes - number of bytes to allocate } +{ ptr - points to the first byte of the allocated memory } + + +procedure GInit; + +{ Initialize a global pool } + + +function GMalloc (bytes: integer): ptr; + +{ Allocate memory from the global pool. } +{ } +{ Parameters: } +{ bytes - number of bytes to allocate } +{ ptr - points to the first byte of the allocated memory } + + +procedure LInit; + +{ Initialize a local pool } + + +function LMalloc (bytes: integer): ptr; + +{ Allocate memory from the local pool. } +{ } +{ Parameters: } +{ bytes - number of bytes to allocate } +{ ptr - points to the first byte of the allocated memory } + + +function Malloc (bytes: integer): ptr; extern; + +{ Allocate memory from a pool. } +{ } +{ Parameters: } +{ bytes - number of bytes to allocate } +{ ptr - points to the first byte of the allocated memory } +{ } +{ Globals: } +{ useGlobalPool - should the memory come from the global } +{ (or local) pool } + + +procedure MMQuit; + +{ Dispose of memory allocated with private user IDs } + +{---------------------------------------------------------------} + +implementation + +const + poolSize = 4096; {size of a memory pool} + +var + globalPtr: ptr; {pointer to the next free global byte} + globalSize: integer; {bytes remaining in the global pool} + localPtr: ptr; {pointer to the next free local byte} + localSize: integer; {bytes remaining in the local pool} + +{---------------------------------------------------------------} + + {GS memory manager} + {-----------------} + + procedure DisposeAll (userID: integer); tool($02, $11); + + function NewHandle (blockSize: longint; userID, memAttributes: integer; + memLocation: ptr): handle; tool($02, $09); + +{---------------------------------------------------------------} + +procedure GInit; + +{ Initialize a global pool } + +var + myhandle: handle; {for dereferencing the block} + +begin {GInit} +globalID := UserID | $0200; {set the global user ID} +DisposeAll(globalID); {dump any old pool areas} +globalSize := poolSize; {allocate a new pool} +myhandle := NewHandle(poolSize, globalID, $C010, nil); +if ToolError <> 0 then TermError(5); +globalPtr := myhandle^; +end; {GInit} + + +function GMalloc {bytes: integer): ptr}; + +{ Allocate memory from the global pool. } +{ } +{ Parameters: } +{ bytes - number of bytes to allocate } +{ ptr - points to the first byte of the allocated memory } + +var + myhandle: handle; {for dereferencing the block} + +begin {GMalloc} +if bytes > globalSize then begin {allocate a new pool, if needed} + globalSize := poolSize; + myhandle := NewHandle(poolSize, globalID, $C010, nil); + if ToolError <> 0 then TermError(5); + globalPtr := myhandle^; + end; {if} +GMalloc := globalPtr; {allocate memory from the pool} +globalSize := globalSize - bytes; +globalPtr := pointer(ord4(globalPtr) + bytes); +end; {GMalloc} + + +procedure LInit; + +{ Initialize a local pool } + +var + myhandle: handle; {for dereferencing the block} + +begin {LInit} +localID := UserID | $0400; {set the local user ID} +DisposeAll(localID); {dump any old pool areas} +localSize := poolSize; {allocate a new pool} +myhandle := NewHandle(poolSize, localID, $C010, nil); +if ToolError <> 0 then TermError(5); +localPtr := myhandle^; +end; {LInit} + + +function LMalloc {bytes: integer): ptr}; + +{ Allocate memory from the local pool. } +{ } +{ Parameters: } +{ bytes - number of bytes to allocate } +{ ptr - points to the first byte of the allocated memory } + +var + myhandle: handle; {for dereferencing the block} + +begin {LMalloc} +if bytes > localSize then begin {allocate a new pool, if needed} + localSize := poolSize; + myhandle := NewHandle(poolSize, localID, $C010, nil); + if ToolError <> 0 then TermError(5); + localPtr := myhandle^; + end; {if} +LMalloc := localPtr; {allocate memory from the pool} +localSize := localSize - bytes; +localPtr := pointer(ord4(localPtr) + bytes); +end; {LMalloc} + + +procedure MMQuit; + +{ Dispose of memory allocated with private user IDs } + +begin {MMQuit} +DisposeAll(globalID); +DisposeAll(localID); +end; {MMQuit} + +end. + +{$append 'mm.asm'} diff --git a/Native.asm b/Native.asm old mode 100755 new mode 100644 index 46a01a5..9c8fd36 --- a/Native.asm +++ b/Native.asm @@ -1 +1,162 @@ - mcopy native.macros **************************************************************** * * Remove - remove an instruction from the peephole array * * Inputs: * ns - index of element to remove * **************************************************************** * Remove start elSize equ 12 size of an element nPeepSize equ 128 size of array ns equ 4 array element lda ns,S compute the source address cmp #nPeepSize (quit if nothing to move) bge rtl asl a adc ns,S asl a asl a adc #NPEEP tax sec compute the source address sbc #elSize tay sec compute the move length sbc #(nPeepSize-1)*elSize+NPEEP eor #$FFFF mvn NPEEP,NPEEP move the array elements rtl dec nNextSpot nnextspot := nnextspot-1; lda #1 didone := true; sta didOne lda 2,S fix stack and return sta 4,S pla sta 1,S rtl end **************************************************************** * * Short - See if label lab is within short range of instruction n * * Inputs: * n - instruction number * lab - label number * **************************************************************** * Short start elSize equ 12 size of npeep array element peep_opcode equ 0 disp in nativeType of opcode peep_mode equ 2 disp in nativeType of mode peep_operand equ 4 disp in nativeType of operand peep_name equ 6 disp in nativeType of name peep_flags equ 10 disp in nativeType of flags d_lab equ 256 label op code # len equ 0 i equ 2 subroutine (2:n,2:lab),4 stz len len := 0; lda n i := n-1; dec a while i > 0 do begin dec a ldx #elSize jsl ~mul2 tax bmi lb3 lb1 lda nPeep+peep_opcode,X if npeep[i].opcode = d_lab then cmp #d_lab bne lb2 lda nPeep+peep_operand,X if npeep[i].operand = lab then begin cmp lab bne lb2 stz fn Short := len <= 126; lda len cmp #127 bge lab1 inc fn bra lab1 goto 1; lb2 anop end; lda nPeep+peep_opcode,X len := len+size[npeep[i].mode]; tay lda size,Y and #$00FF clc adc len sta len txa i := i-1; sec sbc #elSize tax bpl lb1 end; {while} lb3 stz len len := 0; lda n i := n+1; ldx #elSize jsl ~mul2 tax lda n inc a sta i lb4 lda i while i < nnextspot do begin cmp nNextSpot bge lb6 lda nPeep+peep_opcode,X if npeep[i].opcode = d_lab then cmp #d_lab bne lb5 lda nPeep+peep_operand,X if npeep[i].operand = lab then begin cmp lab bne lb5 stz fn Short := len < 128; lda len cmp #128 bge lab1 inc fn bra lab1 goto 1; lb5 anop end; lda nPeep+peep_opcode,X len := len+size[npeep[i].mode]; tay lda size,Y and #$00FF clc adc len sta len inc i i := i+1; txa clc adc #elSize tax bra lb4 end; {while} lb6 stz fn Short := false; lab1 anop 1:end; {Short} return 2:fn fn ds 2 function return value size dc i1'2,2,2,2,2,2,2,2,1,3,1,1,3,3,3,4' dc i1'2,2,2,2,2,2,2,2,1,3,1,1,3,3,3,4' dc i1'3,2,4,2,2,2,2,2,1,3,1,1,3,3,3,4' dc i1'2,2,2,2,2,2,2,2,1,3,1,1,3,3,3,4' dc i1'1,2,2,2,3,2,2,2,1,3,1,1,3,3,3,4' dc i1'2,2,2,2,3,2,2,2,1,3,1,1,4,3,3,4' dc i1'1,2,3,2,2,2,2,2,1,3,1,1,3,3,3,4' dc i1'2,2,2,2,2,2,2,2,1,3,1,1,3,3,3,4' dc i1'2,2,3,2,2,2,2,2,1,3,1,1,3,3,3,4' dc i1'2,2,2,2,2,2,2,2,1,3,1,1,3,3,3,4' dc i1'3,2,3,2,2,2,2,2,1,3,1,1,3,3,3,4' dc i1'2,2,2,2,2,2,2,2,1,3,1,1,3,3,3,4' dc i1'3,2,2,2,2,2,2,2,1,3,1,1,3,3,3,4' dc i1'2,2,2,2,2,2,2,2,1,3,1,1,3,3,3,4' dc i1'3,2,2,2,2,2,2,2,1,3,1,1,3,3,3,4' dc i1'2,2,2,2,3,2,2,2,1,3,1,1,3,3,3,4' dc i1'0,0,1,2,0,2,0,255' end \ No newline at end of file + mcopy native.macros +**************************************************************** +* +* Remove - remove an instruction from the peephole array +* +* Inputs: +* ns - index of element to remove +* +**************************************************************** +* +Remove start +elSize equ 12 size of an element +nPeepSize equ 128 size of array +ns equ 4 array element + + lda ns,S compute the source address + cmp #nPeepSize (quit if nothing to move) + bge rtl + asl a + adc ns,S + asl a + asl a + adc #NPEEP + tax + sec compute the source address + sbc #elSize + tay + sec compute the move length + sbc #(nPeepSize-1)*elSize+NPEEP + eor #$FFFF + mvn NPEEP,NPEEP move the array elements +rtl dec nNextSpot nnextspot := nnextspot-1; + lda #1 didone := true; + sta didOne + lda 2,S fix stack and return + sta 4,S + pla + sta 1,S + rtl + end + +**************************************************************** +* +* Short - See if label lab is within short range of instruction n +* +* Inputs: +* n - instruction number +* lab - label number +* +**************************************************************** +* +Short start +elSize equ 12 size of npeep array element +peep_opcode equ 0 disp in nativeType of opcode +peep_mode equ 2 disp in nativeType of mode +peep_operand equ 4 disp in nativeType of operand +peep_name equ 6 disp in nativeType of name +peep_flags equ 10 disp in nativeType of flags + +d_lab equ 256 label op code # + +len equ 0 +i equ 2 + + subroutine (2:n,2:lab),4 + + stz len len := 0; + lda n i := n-1; + dec a while i > 0 do begin + dec a + ldx #elSize + jsl ~mul2 + tax + bmi lb3 +lb1 lda nPeep+peep_opcode,X if npeep[i].opcode = d_lab then + cmp #d_lab + bne lb2 + lda nPeep+peep_operand,X if npeep[i].operand = lab then begin + cmp lab + bne lb2 + stz fn Short := len <= 126; + lda len + cmp #127 + bge lab1 + inc fn + bra lab1 goto 1; +lb2 anop end; + lda nPeep+peep_opcode,X len := len+size[npeep[i].mode]; + tay + lda size,Y + and #$00FF + clc + adc len + sta len + txa i := i-1; + sec + sbc #elSize + tax + bpl lb1 end; {while} +lb3 stz len len := 0; + lda n i := n+1; + ldx #elSize + jsl ~mul2 + tax + lda n + inc a + sta i +lb4 lda i while i < nnextspot do begin + cmp nNextSpot + bge lb6 + lda nPeep+peep_opcode,X if npeep[i].opcode = d_lab then + cmp #d_lab + bne lb5 + lda nPeep+peep_operand,X if npeep[i].operand = lab then begin + cmp lab + bne lb5 + stz fn Short := len < 128; + lda len + cmp #128 + bge lab1 + inc fn + bra lab1 goto 1; +lb5 anop end; + lda nPeep+peep_opcode,X len := len+size[npeep[i].mode]; + tay + lda size,Y + and #$00FF + clc + adc len + sta len + inc i i := i+1; + txa + clc + adc #elSize + tax + bra lb4 end; {while} +lb6 stz fn Short := false; +lab1 anop 1:end; {Short} + return 2:fn + +fn ds 2 function return value + +size dc i1'2,2,2,2,2,2,2,2,1,3,1,1,3,3,3,4' + dc i1'2,2,2,2,2,2,2,2,1,3,1,1,3,3,3,4' + dc i1'3,2,4,2,2,2,2,2,1,3,1,1,3,3,3,4' + dc i1'2,2,2,2,2,2,2,2,1,3,1,1,3,3,3,4' + dc i1'1,2,2,2,3,2,2,2,1,3,1,1,3,3,3,4' + dc i1'2,2,2,2,3,2,2,2,1,3,1,1,4,3,3,4' + dc i1'1,2,3,2,2,2,2,2,1,3,1,1,3,3,3,4' + dc i1'2,2,2,2,2,2,2,2,1,3,1,1,3,3,3,4' + + dc i1'2,2,3,2,2,2,2,2,1,3,1,1,3,3,3,4' + dc i1'2,2,2,2,2,2,2,2,1,3,1,1,3,3,3,4' + dc i1'3,2,3,2,2,2,2,2,1,3,1,1,3,3,3,4' + dc i1'2,2,2,2,2,2,2,2,1,3,1,1,3,3,3,4' + dc i1'3,2,2,2,2,2,2,2,1,3,1,1,3,3,3,4' + dc i1'2,2,2,2,2,2,2,2,1,3,1,1,3,3,3,4' + dc i1'3,2,2,2,2,2,2,2,1,3,1,1,3,3,3,4' + dc i1'2,2,2,2,3,2,2,2,1,3,1,1,3,3,3,4' + + dc i1'0,0,1,2,0,2,0,255' + end diff --git a/Native.macros b/Native.macros old mode 100755 new mode 100644 index 33a7632..1a00d44 --- a/Native.macros +++ b/Native.macros @@ -1 +1,118 @@ - MACRO &lab subroutine &parms,&work &lab anop aif c:&work,.a lclc &work &work setc 0 .a gbla &totallen gbla &worklen &worklen seta &work &totallen seta 0 aif c:&parms=0,.e lclc &len lclc &p lcla &i &i seta c:&parms .b &p setc &parms(&i) &len amid &p,2,1 aif "&len"=":",.c &len amid &p,1,2 &p amid &p,4,l:&p-3 ago .d .c &len amid &p,1,1 &p amid &p,3,l:&p-2 .d &p equ &totallen+3+&work &totallen seta &totallen+&len &i seta &i-1 aif &i,^b .e tsc sec sbc #&work tcs inc a phd tcd mend MACRO &lab return &r &lab anop lclc &len aif c:&r,.a lclc &r &r setc 0 &len setc 0 ago .h .a &len amid &r,2,1 aif "&len"=":",.b &len amid &r,1,2 &r amid &r,4,l:&r-3 ago .c .b &len amid &r,1,1 &r amid &r,3,l:&r-2 .c aif &len<>2,.d ldy &r ago .h .d aif &len<>4,.e ldx &r+2 ldy &r ago .h .e aif &len<>10,.g aif &totallen=0,.f lda &worklen+1 sta &worklen+&totallen+1 lda &worklen sta &worklen+&totallen .f pld tsc clc adc #&worklen+&totallen tcs phb plx ply lda &r+8 pha lda &r+6 pha lda &r+4 pha lda &r+2 pha lda &r pha phy phx plb rtl mexit .g mnote 'Not a valid return length',16 mexit .h aif &totallen=0,.i lda &worklen+1 sta &worklen+&totallen+1 lda &worklen sta &worklen+&totallen .i pld tsc clc adc #&worklen+&totallen tcs aif &len=0,.j tya .j rtl mend \ No newline at end of file + MACRO +&lab subroutine &parms,&work +&lab anop + aif c:&work,.a + lclc &work +&work setc 0 +.a + gbla &totallen + gbla &worklen +&worklen seta &work +&totallen seta 0 + aif c:&parms=0,.e + lclc &len + lclc &p + lcla &i +&i seta c:&parms +.b +&p setc &parms(&i) +&len amid &p,2,1 + aif "&len"=":",.c +&len amid &p,1,2 +&p amid &p,4,l:&p-3 + ago .d +.c +&len amid &p,1,1 +&p amid &p,3,l:&p-2 +.d +&p equ &totallen+3+&work +&totallen seta &totallen+&len +&i seta &i-1 + aif &i,^b +.e + tsc + sec + sbc #&work + tcs + inc a + phd + tcd + mend + MACRO +&lab return &r +&lab anop + lclc &len + aif c:&r,.a + lclc &r +&r setc 0 +&len setc 0 + ago .h +.a +&len amid &r,2,1 + aif "&len"=":",.b +&len amid &r,1,2 +&r amid &r,4,l:&r-3 + ago .c +.b +&len amid &r,1,1 +&r amid &r,3,l:&r-2 +.c + aif &len<>2,.d + ldy &r + ago .h +.d + aif &len<>4,.e + ldx &r+2 + ldy &r + ago .h +.e + aif &len<>10,.g + aif &totallen=0,.f + lda &worklen+1 + sta &worklen+&totallen+1 + lda &worklen + sta &worklen+&totallen +.f + pld + tsc + clc + adc #&worklen+&totallen + tcs + phb + plx + ply + lda &r+8 + pha + lda &r+6 + pha + lda &r+4 + pha + lda &r+2 + pha + lda &r + pha + phy + phx + plb + rtl + mexit +.g + mnote 'Not a valid return length',16 + mexit +.h + aif &totallen=0,.i + lda &worklen+1 + sta &worklen+&totallen+1 + lda &worklen + sta &worklen+&totallen +.i + pld + tsc + clc + adc #&worklen+&totallen + tcs + aif &len=0,.j + tya +.j + rtl + mend diff --git a/Native.pas b/Native.pas old mode 100755 new mode 100644 index 87f8899..9b0ae4a --- a/Native.pas +++ b/Native.pas @@ -1 +1,2316 @@ -{$optimize 7} {---------------------------------------------------------------} { } { ORCA Native Code Generation } { } { This module of the code generator is called to generate } { native code instructions. The native code is optimized } { and written to the object segment. } { } { Externally available procedures: } { } { EndSeg - close out the current segment } { GenNative - write a native code instruction to the output } { file } { GenImplied - short form of GenNative - reduces code size } { GenCall - short form of jsl to library subroutine - reduces } { code size } { GenLab - generate a label } { InitFile - Set up the object file } { InitNative - set up for a new segment } { RefName - handle a reference to a named label } { } {---------------------------------------------------------------} unit Native; interface {$LibPrefix '0/obj/'} uses CCommon, CGI, CGC, ObjOut; {$segment 'CodeGen'} type labelptr = ^labelentry; {pointer to a forward ref node} labelentry = record {forward ref node} addr: integer; next: labelptr; end; labelrec = record {label record} defined: boolean; {Note: form used in objout.asm} chain: labelptr; case boolean of true : (val: longint); false: (ival,hval: integer); end; var {current instruction info} {------------------------} pc: longint; {program counter} {65816 native code generation} {----------------------------} didOne: boolean; {has an optimization been done?} labeltab: array[0..maxlabel] of labelrec; {label table} localLabel: array[0..maxLocalLabel] of integer; {local variable label table} {---------------------------------------------------------------} procedure EndSeg; { close out the current segment } procedure GenNative (p_opcode: integer; p_mode: addressingMode; p_operand: integer; p_name: stringPtr; p_flags: integer); { write a native code instruction to the output file } { } { parameters: } { p_opcode - native op code } { p_mode - addressing mode } { p_operand - integer operand } { p_name - named operand } { p_flags - operand modifier flags } procedure GenImplied (p_opcode: integer); { short form of GenNative - reduces code size } { } { parameters: } { p_code - operation code } procedure GenCall (callNum: integer); { short form of jsl to library subroutine - reduces code size } { } { parameters: } { callNum - subroutine # to generate a call for } procedure GenLab (lnum: integer); { generate a label } { } { parameters: } { lnum - label number } procedure InitFile (keepName: gsosOutStringPtr; keepFlag: integer; partial: boolean); { Set up the object file } { } { parameters: } { keepName - name of the output file } { keepFlag - keep status: } { 0 - don't keep the output } { 1 - create a new object module } { 2 - a .root already exists } { 3 - at least on .letter file exists } { partial - is this a partial compile? } { } { Note: Declared as extern in CGI.pas } procedure InitNative; { set up for a new segment } procedure LabelSearch (lab: integer; len, shift, disp: integer); { resolve a label reference } { } { parameters: } { lab - label number } { len - # bytes for the generated code } { shift - shift factor } { disp - disp past the label } { } { Note 1: maxlabel is reserved for use as the start of the } { string space } { Note 2: negative length indicates relative branch } { Note 3: zero length indicates 2 byte addr -1 } procedure RefName (lab: stringPtr; disp, len, shift: integer); { handle a reference to a named label } { } { parameters: } { lab - label name } { disp - displacement past the label } { len - number of bytes in the reference } { shift - shift factor } {--------------------------------------------------------------------------} implementation const npeepSize = 128; {native peephole optimizer window size} nMaxPeep = 4; {max # instructions needed to opt.} type {65816 native code generation} {----------------------------} npeepRange = 1..npeepsize; {subrange for native code peephole opt.} nativeType = record {native code instruction} opcode: integer; {op code} mode: addressingMode; {addressing mode} operand: integer; {operand value} name: stringPtr; {operand label} flags: integer; {modifier flags} end; registerConditions = (regUnknown,regImmediate,regAbsolute,regLocal); registerType = record {used to track register contents} condition: registerConditions; value: integer; lab: stringPtr; flags: integer; end; var {native peephole optimization} {----------------------------} aRegister, {current register contents} xRegister, yRegister: registerType; nleadOpcodes: set of 0..max_opcode; {instructions that can start an opt.} nstopOpcodes: set of 0..max_opcode; {instructions not involved in opt.} nnextspot: npeepRange; {next empty spot in npeep} npeep: array[npeepRange] of nativeType; {native peephole array} {I/O files} {---------} fname1, fname2: gsosOutString; {file names} nextSuffix: char; {next suffix character to use} procedure GenSymbols (sym: ptr; doGlobals: integer); extern; { generate the symbol table } {--------------------------------------------------------------------------} procedure LabelSearch {lab: integer; len, shift, disp: integer}; { resolve a label reference } { } { parameters: } { lab - label number } { len - # bytes for the generated code } { shift - shift factor } { disp - disp past the label } { } { Note 1: maxlabel is reserved for use as the start of the } { string space } { Note 2: negative length indicates relative branch } { Note 3: zero length indicates 2 byte addr -1 } var next: labelptr; {work pointer} begin {LabelSearch} if labeltab[lab].defined and (len < 0) and (shift = 0) and (disp = 0) then begin {handle a relative branch to a known disp} if len = -1 then CnOut(labeltab[lab].ival - long(pc).lsw - cbufflen + len) else CnOut2(labeltab[lab].ival - long(pc).lsw - cbufflen + len); end {if} else begin if lab <> maxlabel then begin {handle a normal label reference} Purge; {empty the constant buffer} if len < 0 then begin len := -len; {generate a RELEXPR} Out(238); Out(len); Out2(len); Out2(0); end {if} else begin if isJSL then {generate a standard EXPR} Out(243) else Out(235); if len = 0 then Out(2) else Out(len); end; {else} end; {if} Out(135); {generate a relative offset from the seg. start} if not labeltab[lab].defined then begin next := pointer(Malloc(sizeof(labelEntry))); {value unknown: create a reference} next^.next := labeltab[lab].chain; labeltab[lab].chain := next; next^.addr := blkcnt; Out2(0); Out2(0); end {if} else {labeltab[lab].defined} begin Out2(labeltab[lab].ival); {value known: write it} Out2(labeltab[lab].hval); end; {else} if len = 0 then begin Out(129); {subtract 1 from addr} Out2(1); Out2(0); Out(2); len := 2; end; {if} if disp <> 0 then begin Out(129); {add in the displacement} Out2(disp); if disp < 0 then Out2(-1) else Out2(0); Out(1); end; {if} if shift <> 0 then begin Out(129); {shift the address} Out2(-shift); Out2(-1); Out(7); end; {if} if lab <> maxlabel then {if not a string, end the expression} Out(0); pc := pc+len; {update the pc} end; {else} end; {LabelSearch} procedure UpDate (lab: integer; labelValue: longint); { define a label } { } { parameters: } { lab - label number } { labelValue - displacement in seg where label is located } var next,temp: labelptr; {work pointers} begin {UpDate} if labeltab[lab].defined then Error(cge1) else begin {define the label for future references} with labeltab[lab] do begin defined := true; val := labelValue; next := chain; end; {with} {resolve any forward references} if next <> nil then begin Purge; while next <> nil do begin segdisp := next^.addr; Out2(long(labelvalue).lsw); Out2(long(labelvalue).msw); blkcnt := blkcnt-4; temp := next; next := next^.next; end; {while} segdisp := blkcnt; end; {if} end; {else} end; {UpDate} procedure WriteNative (opcode: integer; mode: addressingMode; operand: integer; name: stringPtr; flags: integer); { write a native code instruction to the output file } { } { parameters: } { opcode - native op code } { mode - addressing mode } { operand - integer operand } { name - named operand } { flags - operand modifier flags } label 1; type rkind = (k1,k2,k3); {cnv record types} var ch: char; {temp storage for string constants} cns: realRec; {for converting reals to bytes} cnv: record {for converting double, real to bytes} case rkind of k1: (rval: real;); k2: (dval: double;); k3: (ival1,ival2,ival3,ival4: integer;); end; count: integer; {number of constants to repeat} i,j,k: integer; {loop variables} lsegDisp: integer; {for backtracking while writting the } { debugger's symbol table } lval: longint; {temp storage for long constant} nptr: stringPtr; {pointer to a name} sptr: longstringPtr; {pointer to a string constant} procedure GenImmediate1; { generate a one byte immediate operand } begin {GenImmediate1} if (flags & stringReference) <> 0 then begin Purge; Out(235); Out(1); {one byte expression} Out(128); {current location ctr} Out(129); Out2(-16); Out2(-1); {-16} Out(7); {bit shift} Out(0); {end of expr} pc := pc+1; end {if} else if (flags & localLab) <> 0 then LabelSearch(long(name).lsw, 1, ord(odd(flags div shift16))*16, operand) else if (flags & shift16) <> 0 then RefName(name, operand, 1, -16) else CnOut(operand); end; {GenImmediate1} procedure GenImmediate2; { generate a two byte immediate operand } begin {GenImmediate2} if (flags & stringReference) <> 0 then begin Purge; Out(235); Out(2); LabelSearch(maxLabel, 2, 0, 0); if operand <> 0 then begin Out(129); Out2(operand); Out2(0); Out(1); end; {if} if (flags & shift16) <> 0 then begin Out(129); Out2(-16); Out2(-1); Out(7); end; {if} Out(0); end {if} else if (flags & shift8) <> 0 then RefName(name, operand, 2, -8) else if (flags & localLab) <> 0 then LabelSearch(long(name).lsw, 2, ord(odd(flags div shift16))*16, operand) else if (flags & shift16) <> 0 then RefName(name, operand, 2, -16) else if name = nil then CnOut2(operand) else RefName(name, operand, 2, 0); end; {GenImmediate2} procedure DefGlobal (private: integer); { define a global label } { } { parameters: } { private - private flag } var i: integer; {loop variable} begin {DefGlobal} Purge; Out(230); {global label definition} Out(ord(name^[0])); {write label name} for i := 1 to ord(name^[0]) do Out(ord(name^[i])); Out2(0); {length attribute} Out(ord('N')); {type attribute: other directive} Out(private); {private or global?} end; {DefGlobal} begin {WriteNative} { writeln('WriteNative: ',opcode:4, ', mode=', ord(mode):1, ' operand=', operand:1); {debug} case mode of implied: CnOut(opcode); immediate: begin if opcode = d_bmov then GenImmediate1 else begin if opcode = m_and_imm then if not longA then if operand = 255 then goto 1; CnOut(opcode); if opcode = m_pea then GenImmediate2 else if opcode in [m_adc_imm,m_and_imm,m_cmp_imm,m_eor_imm,m_lda_imm,m_ora_imm, m_sbc_imm,m_bit_imm] then if longA then GenImmediate2 else GenImmediate1 else if opcode in [m_rep,m_sep,m_cop] then begin GenImmediate1; if opcode = m_rep then begin if odd(operand div 32) then longA := true; if odd(operand div 16) then longI := true; end {if} else if opcode = m_sep then begin if odd(operand div 32) then longA := false; if odd(operand div 16) then longI := false; end; {else} end {else} else if longI then GenImmediate2 else GenImmediate1; end; {else} end; longabs: begin CnOut(opcode); isJSL := opcode = m_jsl; {allow for dynamic segs} if name = nil then if odd(flags div toolcall) then begin CnOut2(0); CnOut(225); end {if} else LabelSearch(operand, 3, 0, 0) else if odd(flags div toolcall) then begin CnOut2(long(name).lsw); CnOut(long(name).msw); end {if} else RefName(name, operand, 3, 0); isJSL := false; end; longabsolute: begin if opcode <> d_add then begin CnOut(opcode); i := 3; end {if} else i := 4; if (flags & localLab) <> 0 then LabelSearch(long(name).lsw, i, 0, operand) else if (flags & constantOpnd) <> 0 then begin lval := ord4(name); CnOut2(long(lval).lsw); if opcode = d_add then CnOut2(long(lval).msw) else CnOut(long(lval).msw); end {else if} else if name <> nil then RefName(name, operand, i, 0) else begin CnOut2(operand); CnOut(0); if opcode = d_add then CnOut(0); end; {else} end; absolute: begin if opcode <> d_add then CnOut(opcode); if (flags & localLab) <> 0 then LabelSearch(long(name).lsw, 2, 0, operand) else if name <> nil then RefName(name, operand, 2, 0) else if (flags & constantOpnd) <> 0 then CnOut2(operand) else LabelSearch(operand, 2, 0, 0); end; direct: begin if opcode <> d_add then CnOut(opcode); if (flags & localLab) <> 0 then LabelSearch(long(name).lsw, 1, 0, operand) else if name <> nil then RefName(name, operand, 1, 0) else CnOut(operand); end; longrelative: begin CnOut(opcode); LabelSearch(operand, -2, 0, 0); end; relative: begin CnOut(opcode); LabelSearch(operand, -1, 0, 0); end; gnrLabel: if name = nil then UpDate(operand, pc+cbufflen) else begin DefGlobal((flags >> 5) & 1); if operand <> 0 then begin Out(241); Out2(operand); Out2(0); pc := pc+operand; end; {if} end; {else} gnrSpace: if operand <> 0 then begin Out(241); Out2(operand); Out2(0); pc := pc+operand; end; {if} gnrConstant: begin if icptr(name)^.optype = cgString then count := 1 else count := icptr(name)^.q; for i := 1 to count do case icptr(name)^.optype of cgByte,cgUByte : CnOut(icptr(name)^.r); cgWord,cgUWord : CnOut2(icptr(name)^.r); cgLong,cgULong : begin lval := icptr(name)^.lval; CnOut2(long(lval).lsw); CnOut2(long(lval).msw); end; cgReal : begin cnv.rval := icptr(name)^.rval; CnOut2(cnv.ival1); CnOut2(cnv.ival2); end; cgDouble : begin cnv.dval := icptr(name)^.rval; CnOut2(cnv.ival1); CnOut2(cnv.ival2); CnOut2(cnv.ival3); CnOut2(cnv.ival4); end; cgComp : begin cns.itsReal := icptr(name)^.rval; CnvSC(cns); for j := 1 to 8 do CnOut(cns.inCOMP[j]); end; cgExtended : begin cns.itsReal := icptr(name)^.rval; CnvSX(cns); for j := 1 to 10 do CnOut(cns.inSANE[j]); end; cgString : begin sptr := icptr(name)^.str; for j := 1 to sptr^.length do CnOut(ord(sPtr^.str[j])); end; ccPointer : begin if icptr(name)^.lab <> nil then begin Purge; Out(235); Out(4); Out(131); pc := pc+4; nptr := icptr(name)^.lab; for j := 0 to ord(nptr^[0]) do Out(ord(nptr^[j])); lval := icptr(name)^.pVal; if lval <> 0 then begin Out(129); Out2(long(lval).lsw); Out2(long(lval).msw); Out(2-icptr(name)^.r); end; {if} Out(0); end {if} else begin lval := icptr(name)^.pVal; if icptr(name)^.r = 1 then operand := stringSize+long(lval).lsw else operand := stringSize-long(lval).lsw; flags := stringReference; GenImmediate2; flags := stringReference+shift16; GenImmediate2; sptr := icptr(name)^.pStr; j := sptr^.length; if maxString-stringSize >= j+1 then begin for k := 1 to j do stringSpace[k+stringSize] := sptr^.str[k]; stringSpace[stringSize+j+1] := chr(0); stringSize := stringSize+j+1; end {if} else Error(cge3); end; {else} end; otherwise : Error(cge1); end; {case} end; genAddress: begin if opcode < 256 then CnOut(opcode); if (flags & stringReference) <> 0 then begin Purge; Out(235); Out(2); LabelSearch(maxLabel,2,0,0); if operand <> 0 then begin Out(129); Out2(operand); Out2(0); Out(1); end; {if} if (flags & shift16) <> 0 then begin Out(129); Out2(-16); Out2(-1); Out(7); end; {if} Out(0); end {if} else if operand = 0 then begin CnOut(0); CnOut(0); end {else if} else if (flags & shift16) <> 0 then if longA then LabelSearch(operand, 2, 16, 0) else LabelSearch(operand, 1, 16, 0) else LabelSearch(operand, 0, 0, 0); end; special: if opcode = d_pin then begin segDisp := 36; out2(long(pc).lsw+cBuffLen); blkCnt := blkCnt-2; segDisp := blkCnt; end {if} else if opcode = d_sym then begin CnOut(m_cop); CnOut(5); Purge; lsegDisp := segDisp+1; CnOut2(0); symLength := 0; GenSymbols(pointer(name), operand); segDisp := lSegDisp; out2(symLength); blkCnt := blkCnt-2; segDisp := blkCnt; end {else if} else {d_wrd} CnOut2(operand); otherwise: Error(cge1); end; {case} 1: end; {WriteNative} procedure CheckRegisters(p_opcode: integer; p_mode: addressingMode; p_operand: integer; p_name: stringPtr; p_flags: integer); { write a native code instruction to the output file } { } { parameters: } { p_opcode - native op code } { p_mode - addressing mode } { p_operand - integer operand } { p_name - named operand } { p_flags - operand modifier flags } label 1,2; begin {CheckRegisters} case p_opcode of m_adc_abs,m_adc_dir,m_adc_imm,m_adc_s,m_and_abs,m_and_dir,m_and_imm, m_and_s,m_asl_a,m_dea,m_eor_abs,m_eor_dir,m_eor_imm,m_eor_s,m_lda_absx, m_lda_dirx,m_lda_indl,m_lda_indly,m_lda_longx,m_lda_s,m_lsr_a,m_ora_abs, m_ora_dir,m_ora_dirX,m_ora_imm,m_ora_longX,m_ora_s,m_pla,m_sbc_abs, m_sbc_dir,m_sbc_imm,m_sbc_s,m_tdc,m_tsc,m_tsb_dir,m_tsb_abs: aRegister.condition := regUnknown; m_ldy_absX,m_ldy_dirX,m_ply: yRegister.condition := regUnknown; m_plx: xRegister.condition := regUnknown; m_bcc,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_bra,m_brl,m_bvs,m_clc,m_cmp_abs, m_cmp_dir,m_cmp_imm,m_cmp_s,m_cpx_imm,m_jml,m_pha,m_phb,m_phd, m_phx,m_phy,m_plb,m_pld,m_rtl,m_rts,m_sec,m_sta_absX, m_sta_dir,m_sta_dirX,m_sta_indl,m_sta_indlY,m_sta_longX, m_sta_s,m_stx_dir,m_sty_dir,m_sty_dirX,m_stz_abs,m_stz_absX, m_stz_dir,m_stz_dirX,m_tcs,m_tcd,d_add,d_pin,m_pei_dir,m_cpx_abs, m_cpx_dir,m_cmp_dirx,m_php,m_plp,m_cop,d_wrd: ; m_pea: begin if aRegister.condition = regImmediate then if aRegister.value = p_operand then if aRegister.lab = p_name then if aRegister.flags = p_flags then if longA then begin p_opcode := m_pha; p_mode := implied; goto 2; end; {if} if longI then begin if xRegister.condition = regImmediate then if xRegister.value = p_operand then if xRegister.lab = p_name then if xRegister.flags = p_flags then begin p_opcode := m_phx; p_mode := implied; goto 2; end; {if} if yRegister.condition = regImmediate then if yRegister.value = p_operand then if yRegister.lab = p_name then if yRegister.flags = p_flags then begin p_opcode := m_phy; p_mode := implied; goto 2; end; {if} end; {if} end; m_dec_abs,m_inc_abs,m_sta_abs,m_stx_abs,m_sty_abs,m_sta_long: begin if aRegister.condition = regAbsolute then if aRegister.lab = p_name then if aRegister.value = p_operand then if not (p_opcode in [m_sta_abs,m_sta_long]) then aRegister.condition := regUnknown; if xRegister.condition = regAbsolute then if xRegister.lab = p_name then if xRegister.value = p_operand then if p_opcode <> m_stx_abs then xRegister.condition := regUnknown; if yRegister.condition = regAbsolute then if yRegister.lab = p_name then if yRegister.value = p_operand then if p_opcode <> m_sty_abs then yRegister.condition := regUnknown; end; m_dec_dir,m_dec_dirX,m_inc_dir,m_inc_dirX: begin if aRegister.condition = regLocal then if aRegister.value = p_operand then aRegister.condition := regUnknown; if xRegister.condition = regLocal then if xRegister.value = p_operand then xRegister.condition := regUnknown; if yRegister.condition = regLocal then if yRegister.value = p_operand then yRegister.condition := regUnknown; end; m_dex: if xRegister.condition = regImmediate then xRegister.value := xRegister.value-1 else xRegister.condition := regUnknown; m_dey: if yRegister.condition = regImmediate then yRegister.value := yRegister.value-1 else yRegister.condition := regUnknown; m_ina: if aRegister.condition = regImmediate then aRegister.value := aRegister.value+1 else aRegister.condition := regUnknown; m_inx: if xRegister.condition = regImmediate then xRegister.value := xRegister.value+1 else xRegister.condition := regUnknown; m_iny: if yRegister.condition = regImmediate then yRegister.value := yRegister.value+1 else yRegister.condition := regUnknown; otherwise, m_jsl,m_mvn,m_rep,m_sep,d_lab,d_end,d_bmov,d_cns: begin aRegister.condition := regUnknown; xRegister.condition := regUnknown; yRegister.condition := regUnknown; end; m_lda_abs,m_lda_long: begin if (aRegister.condition = regAbsolute) and (aRegister.value = p_operand) and (aRegister.lab = p_name) then goto 1 else if longA = longI then begin if (xRegister.condition = regAbsolute) and (xRegister.value = p_operand) and (xRegister.lab = p_name) then begin p_opcode := m_txa; p_mode := implied; aRegister := xRegister; goto 2; end {if} else if (yRegister.condition = regAbsolute) and (yRegister.value = p_operand) and (yRegister.lab = p_name) then begin p_opcode := m_tya; p_mode := implied; aRegister := yRegister; goto 2; end; {else if} end; aRegister.condition := regAbsolute; aRegister.value := p_operand; aRegister.lab := p_name; aRegister.flags := p_flags; end; m_lda_dir: begin if (aRegister.condition = regLocal) and (aRegister.value = p_operand) then goto 1 else if longA = longI then begin if (xRegister.condition = regLocal) and (xRegister.value = p_operand) then begin p_opcode := m_txa; p_mode := implied; aRegister := xRegister; goto 2; end {if} else if (yRegister.condition = regLocal) and (yRegister.value = p_operand) then begin p_opcode := m_tya; p_mode := implied; aRegister := yRegister; goto 2; end; {else if} end; {else if} aRegister.condition := regLocal; aRegister.value := p_operand; aRegister.flags := p_flags; end; m_lda_imm: begin if (aRegister.condition = regImmediate) and (aRegister.value = p_operand) and (aRegister.lab = p_name) and (aRegister.flags = p_flags) then goto 1 else if longA = longI then begin if (xRegister.condition = regImmediate) and (xRegister.value = p_operand) and (xRegister.lab = p_name) and (xRegister.flags = p_flags) then begin p_opcode := m_txa; p_mode := implied; aRegister := xRegister; goto 2; end {if} else if (yRegister.condition = regImmediate) and (yRegister.value = p_operand) and (yRegister.lab = p_name) and (yRegister.flags = p_flags) then begin p_opcode := m_tya; p_mode := implied; aRegister := yRegister; goto 2; end; {else if} end; {else if} if (aRegister.condition = regImmediate) and (aRegister.lab = p_name) and (aRegister.flags = p_flags) then if aRegister.value = (p_operand + 1) then begin p_opcode := m_dea; p_mode := implied; aRegister.value := p_operand; goto 2; end {if} else if aRegister.value = (p_operand - 1) then begin p_opcode := m_ina; p_mode := implied; aRegister.value := p_operand; goto 2; end; {else if} aRegister.condition := regImmediate; aRegister.value := p_operand; aRegister.flags := p_flags; aRegister.lab := p_name; end; m_ldx_abs: begin if (xRegister.condition = regAbsolute) and (xRegister.value = p_operand) and (xRegister.lab = p_name) then goto 1 else if (aRegister.condition = regAbsolute) and (aRegister.value = p_operand) and (aRegister.lab = p_name) and (longA = longI) then begin p_opcode := m_tax; p_mode := implied; xRegister := aRegister; end {else if} else if (yRegister.condition = regAbsolute) and (yRegister.value = p_operand) and (yRegister.lab = p_name) then begin p_opcode := m_tyx; p_mode := implied; xRegister := yRegister; end {else if} else begin xRegister.condition := regAbsolute; xRegister.value := p_operand; xRegister.lab := p_name; xRegister.flags := p_flags; end; {else} end; m_ldx_dir: begin if (xRegister.condition = regLocal) and (xRegister.value = p_operand) then goto 1 else if (aRegister.condition = regLocal) and (aRegister.value = p_operand) and (longA = longI) then begin p_opcode := m_tax; p_mode := implied; xRegister := aRegister; end {else if} else if (yRegister.condition = regLocal) and (yRegister.value = p_operand) then begin p_opcode := m_tyx; p_mode := implied; xRegister := yRegister; end {else if} else begin xRegister.condition := regLocal; xRegister.value := p_operand; xRegister.flags := p_flags; end; {else} end; m_ldx_imm: begin if (xRegister.condition = regImmediate) and (xRegister.value = p_operand) and (xRegister.lab = p_name) and (xRegister.flags = p_flags) then goto 1 else if (aRegister.condition = regImmediate) and (aRegister.value = p_operand) and (longA = longI) and (aRegister.lab = p_name) and (aRegister.flags = p_flags) then begin p_opcode := m_tax; p_mode := implied; xRegister := aRegister; end {else} else if (yRegister.condition = regImmediate) and (yRegister.value = p_operand) and (yRegister.lab = p_name) and (yRegister.flags = p_flags) then begin p_opcode := m_tyx; p_mode := implied; xRegister := yRegister; end {else if} else begin if (xRegister.condition = regImmediate) and (xRegister.lab = p_name) and (xRegister.flags = p_flags) then if xRegister.value = (p_operand + 1) then begin p_opcode := m_dex; p_mode := implied; xRegister.value := p_operand; goto 2; end {if} else if xRegister.value = (p_operand - 1) then begin p_opcode := m_inx; p_mode := implied; xRegister.value := p_operand; goto 2; end; {else if} xRegister.condition := regImmediate; xRegister.value := p_operand; xRegister.flags := p_flags; xRegister.lab := p_name; end; {else} end; m_ldy_abs: begin if (yRegister.condition = regAbsolute) and (yRegister.value = p_operand) and (yRegister.lab = p_name) then goto 1 else if (aRegister.condition = regAbsolute) and (aRegister.value = p_operand) and (aRegister.lab = p_name) and (longA = longI) then begin p_opcode := m_tay; p_mode := implied; yRegister := aRegister; end {else if} else if (xRegister.condition = regAbsolute) and (xRegister.value = p_operand) and (xRegister.lab = p_name) then begin p_opcode := m_txy; p_mode := implied; yRegister := xRegister; end {else if} else begin yRegister.condition := regAbsolute; yRegister.value := p_operand; yRegister.lab := p_name; yRegister.flags := p_flags; end; {else} end; m_ldy_dir: begin if (yRegister.condition = regLocal) and (yRegister.value = p_operand) then goto 1 else if (aRegister.condition = regLocal) and (aRegister.value = p_operand) and (longA = longI) then begin p_opcode := m_tay; p_mode := implied; yRegister := aRegister; end {else if} else if (xRegister.condition = regLocal) and (xRegister.value = p_operand) then begin p_opcode := m_txy; p_mode := implied; yRegister := xRegister; end {else if} else begin yRegister.condition := regLocal; yRegister.value := p_operand; yRegister.flags := p_flags; end; {else} end; m_ldy_imm: begin if (yRegister.condition = regImmediate) and (yRegister.value = p_operand) and (yRegister.lab = p_name) and (yRegister.flags = p_flags) then goto 1 else if (aRegister.condition = regImmediate) and (aRegister.value = p_operand) and (aRegister.flags = p_flags) and (aRegister.lab = p_name) and (longA = longI) then begin p_opcode := m_tay; p_mode := implied; yRegister := aRegister; end {else if} else if (xRegister.condition = regImmediate) and (xRegister.value = p_operand) and (xRegister.lab = p_name) and (xRegister.flags = p_flags) then begin p_opcode := m_txy; p_mode := implied; yRegister := xRegister; end {else if} else begin if (yRegister.condition = regImmediate) and (yRegister.lab = p_name) and (yRegister.flags = p_flags) then if yRegister.value = (p_operand + 1) then begin p_opcode := m_dey; p_mode := implied; yRegister.value := p_operand; goto 2; end {if} else if yRegister.value = (p_operand - 1) then begin p_opcode := m_iny; p_mode := implied; yRegister.value := p_operand; goto 2; end; {else if} yRegister.condition := regImmediate; yRegister.value := p_operand; yRegister.flags := p_flags; yRegister.lab := p_name; end; {else} end; m_tax: begin if aRegister.condition <> regUnknown then if aRegister.condition = xRegister.condition then if aRegister.value = xRegister.value then if aRegister.flags = xRegister.flags then if aRegister.condition <> regAbsolute then goto 1 else if aRegister.lab = xRegister.lab then goto 1; xRegister := aRegister; end; m_tay: begin if aRegister.condition <> regUnknown then if aRegister.condition = yRegister.condition then if aRegister.value = yRegister.value then if aRegister.flags = yRegister.flags then if aRegister.condition <> regAbsolute then goto 1 else if aRegister.lab = yRegister.lab then goto 1; yRegister := aRegister; end; m_txa: begin if xRegister.condition <> regUnknown then if xRegister.condition = aRegister.condition then if xRegister.value = aRegister.value then if xRegister.flags = aRegister.flags then if xRegister.condition <> regAbsolute then goto 1 else if xRegister.lab = aRegister.lab then goto 1; aRegister := xRegister; end; m_txy: begin if xRegister.condition <> regUnknown then if xRegister.condition = yRegister.condition then if xRegister.value = yRegister.value then if xRegister.flags = yRegister.flags then if xRegister.condition <> regAbsolute then goto 1 else if xRegister.lab = yRegister.lab then goto 1; yRegister := xRegister; end; m_tya: begin if yRegister.condition <> regUnknown then if yRegister.condition = aRegister.condition then if yRegister.value = aRegister.value then if yRegister.flags = aRegister.flags then if yRegister.condition <> regAbsolute then goto 1 else if yRegister.lab = aRegister.lab then goto 1; aRegister := yRegister; end; m_tyx: begin if yRegister.condition <> regUnknown then if yRegister.condition = xRegister.condition then if yRegister.value = xRegister.value then if yRegister.flags = xRegister.flags then if yRegister.condition <> regAbsolute then goto 1 else if yRegister.lab = xRegister.lab then goto 1; xRegister := yRegister; end; end; {case} 2: WriteNative(p_opcode, p_mode, p_operand, p_name, p_flags); 1: end; {CheckRegisters} procedure Remove (ns: integer); extern; { Remove the instruction ns from the peephole array } { } { parameters: } { ns - index of the instruction to remove } function Short (n, lab: integer): boolean; extern; { see if a label is within range of a one-byte relative branch } { } { parameters: } { n - index to branch instruction } { lab - label number } {--------------------------------------------------------------------------} procedure EndSeg; { close out the current segment } var i: integer; begin {EndSeg} Purge; {dump constant buffer} if stringsize <> 0 then begin {define string space} UpDate(maxLabel, pc); {define the local label for the string space} for i := 1 to stringsize do CnOut(ord(stringspace[i])); Purge; end; {if} Out(0); {end the segment} segDisp := 8; {update header} Out2(long(pc).lsw); Out2(long(pc).msw); blkcnt := blkcnt-4; {purge the segment to disk} segDisp := blkcnt; CloseSeg; end; {EndSeg} procedure GenNative {p_opcode: integer; p_mode: addressingMode; p_operand: integer; p_name: stringPtr; p_flags: integer}; { write a native code instruction to the output file } { } { parameters: } { p_opcode - native op code } { p_mode - addressing mode } { p_operand - integer operand } { p_name - named operand } { p_flags - operand modifier flags } var done: boolean; {loop termination} llongA: boolean; {for tracking A size during opt.} i: integer; {index} op: integer; {temp storage for opcode} procedure Purge; { Empty the peephole array } begin {Purge} while nnextSpot > 1 do begin if registers then CheckRegisters(npeep[1].opcode, npeep[1].mode, npeep[1].operand, npeep[1].name, npeep[1].flags) else WriteNative(npeep[1].opcode, npeep[1].mode, npeep[1].operand, npeep[1].name, npeep[1].flags); Remove(1); end; {while} end; {Purge} procedure Optimize(ns: integer; longA: boolean); { Optimize the instruction starting at ns } { } { parameters: } { ns - index of instruction to check for optimization } { longA - is the accumulator long? } label 1; var tn: nativeType; {temp operation} function ASafe (ns: integer): boolean; { See if it is safe to skip loading the A register } { } { parameters: } { ns - starting index } label 1; var i: integer; {loop variable} opcode: integer; {copy of current op code} begin {ASafe} ASafe := false; for i := ns to nnextSpot-1 do begin opcode := npeep[i].opcode; if opcode in [m_bcc,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_bra,m_brl,m_bvs,m_jml,m_jsl, m_lda_abs,m_lda_absx,m_lda_dir,m_lda_dirx,m_lda_imm,m_lda_indl, m_lda_indly,m_lda_long,m_lda_longx,m_lda_s,m_mvn,m_pla,m_rtl, m_rts,m_tdc,m_txa,m_tya,m_tsc,d_end,d_bmov,d_add,d_pin,d_wrd, d_sym,d_cns] then begin ASafe := true; goto 1; end {if} else if opcode in [m_adc_abs,m_adc_dir,m_adc_imm,m_adc_s,m_and_abs,m_and_dir, m_and_imm,m_and_s,m_asl_a,m_cmp_abs,m_cmp_dir,m_cmp_dirX,m_cmp_imm, m_cmp_long,m_cmp_s,m_dea,m_eor_abs,m_eor_dir,m_eor_imm,m_eor_s, m_ina,m_lda_abs,m_lda_absx,m_lda_dir,m_lda_dirx,m_lda_imm, m_lda_indl,m_lda_indly,m_lda_long,m_lda_longx,m_lda_s,m_lsr_a, m_ora_abs,m_ora_dir,m_ora_dirX,m_ora_imm,m_ora_longX,m_ora_s, m_pha,m_sbc_abs,m_sbc_dir,m_sbc_imm,m_sbc_s,m_sta_abs,m_sta_absX, m_sta_dir,m_sta_dirX,m_sta_indl,m_sta_indlY,m_sta_long,m_sta_longX, m_sta_s,m_tax,m_tay,m_tcd,m_tcs,m_xba,m_tsb_dir,m_tsb_abs] then goto 1; end; {for} 1: end; {ASafe} function SignExtension (ns: integer): boolean; { See if the pattern is a sugn extension } { } { Parameters: } { ns - start of suspected pattern } { } { Returns: true for a sign extension, else false } begin {SignExtension} SignExtension := false; if npeep[ns].opcode = m_ldx_imm then if npeep[ns].operand = 0 then if npeep[ns+1].opcode = m_tay then if npeep[ns+2].opcode = m_bpl then if npeep[ns+3].opcode = m_dex then SignExtension := true; end; {SignExtension} begin {Optimize} with npeep[ns] do case opcode of m_and_imm: if npeep[ns+1].opcode = m_and_imm then begin operand := operand & npeep[ns+1].operand; Remove(ns+1); end; {if} m_asl_a: if npeep[ns+1].opcode = m_tay then if npeep[ns+2].opcode = m_iny then if npeep[ns+3].opcode = m_iny then begin opcode := m_ina; npeep[ns+1].opcode := m_asl_a; npeep[ns+2].opcode := m_tay; Remove(ns+3); end; {if} m_bcs,m_beq,m_bne,m_bmi,m_bpl,m_bcc: if npeep[ns+2].opcode = d_lab then if npeep[ns+2].operand = operand then if npeep[ns+1].opcode = m_brl then begin if Short(ns,npeep[ns+1].operand) then begin operand := npeep[ns+1].operand; Remove(ns+1); if opcode = m_bcs then opcode := m_bcc else if opcode = m_beq then opcode := m_bne else if opcode = m_bne then opcode := m_beq else if opcode = m_bmi then opcode := m_bpl else if opcode = m_bcc then opcode := m_bcs else opcode := m_bmi; end; {if} end {if m_brl} else if npeep[ns+1].opcode = m_bra then begin operand := npeep[ns+1].operand; Remove(ns+1); Remove(ns+1); if opcode = m_bcs then opcode := m_bcc else if opcode = m_beq then opcode := m_bne else if opcode = m_bne then opcode := m_beq else if opcode = m_bmi then opcode := m_bpl else if opcode = m_bcc then opcode := m_bcs else opcode := m_bmi; end; {else if m_bra} m_brl: if Short(ns,operand) then begin opcode := m_bra; mode := relative; didOne := true; end; {if} m_bvs: if npeep[ns+2].opcode = d_lab then if npeep[ns+2].operand = operand then if npeep[ns+1].opcode = m_bmi then if npeep[ns+4].opcode = d_lab then if npeep[ns+1].operand = npeep[ns+4].operand then if npeep[ns+3].opcode = m_brl then if Short(ns,npeep[ns+3].operand) then if Short(ns+1,npeep[ns+3].operand) then begin operand := npeep[ns+3].operand; npeep[ns+1].operand := npeep[ns+3].operand; npeep[ns+1].opcode := m_bpl; Remove(ns+3); end; {if} m_dec_abs: if npeep[ns+1].opcode = m_lda_abs then if name^ = npeep[ns+1].name^ then if npeep[ns+2].opcode = m_beq then Remove(ns+1); m_lda_abs: if npeep[ns+1].opcode = m_clc then begin if npeep[ns+2].opcode = m_adc_abs then if operand = npeep[ns+2].operand then if name = npeep[ns+2].name then if not rangeCheck then begin npeep[ns+1].opcode := m_asl_a; Remove(ns+2); end; {if} end {if} else if npeep[ns+1].opcode = m_dea then begin if npeep[ns+2].opcode = m_tax then begin opcode := m_ldx_abs; npeep[ns+1].opcode := m_dex; Remove(ns+2); end; {if} end {else if} else if npeep[ns+2].opcode = m_sta_abs then begin if npeep[ns+1].opcode in [m_ora_dir,m_ora_abs,m_ora_dirX, m_ora_imm,m_ora_longX,m_ora_s] then if operand = npeep[ns+2].operand then if name = npeep[ns+2].name then begin npeep[ns+1].opcode := npeep[ns+1].opcode + $00A0; npeep[ns+2].opcode := m_tsb_abs; Remove(ns); end; {if} end {else if} else if SignExtension(ns+1) then begin npeep[ns+2] := npeep[ns]; Remove(ns); end {else if} else if npeep[ns+1].opcode = m_xba then if npeep[ns+2].opcode = m_and_imm then if npeep[ns+2].operand = $00FF then begin operand := operand+1; Remove(ns+1); end; {if} m_lda_dir: if npeep[ns+1].opcode = m_clc then begin if npeep[ns+2].opcode = m_adc_dir then if operand = npeep[ns+2].operand then if not rangeCheck then begin npeep[ns+1].opcode := m_asl_a; Remove(ns+2); end; {if} end else if npeep[ns+1].opcode = m_dea then begin if npeep[ns+2].opcode = m_tax then begin opcode := m_ldx_dir; npeep[ns+1].opcode := m_dex; Remove(ns+2); end; {if} end {else if} else if npeep[ns+1].opcode = m_pha then begin if longA then begin opcode := m_pei_dir; Remove(ns+1); end {if} end {else if} else if npeep[ns+2].opcode = m_sta_dir then begin if npeep[ns+1].opcode in [m_ora_dir,m_ora_abs,m_ora_dirX, m_ora_imm,m_ora_longX,m_ora_s] then if operand = npeep[ns+2].operand then begin npeep[ns+1].opcode := npeep[ns+1].opcode + $00A0; npeep[ns+2].opcode := m_tsb_dir; Remove(ns); end {if} end {else if} else if SignExtension(ns+1) then begin npeep[ns+2] := npeep[ns]; Remove(ns); end {else if} else if npeep[ns+1].opcode = m_xba then if npeep[ns+2].opcode = m_and_imm then if npeep[ns+2].operand = $00FF then begin operand := operand+1; Remove(ns+1); end; {if} m_pei_dir: if npeep[ns+1].opcode = m_pla then begin opcode := m_lda_dir; Remove(ns+1); end; {if} m_lda_imm: if npeep[ns+1].opcode = m_pha then if ASafe(ns+2) then if longA then begin opcode := m_pea; Remove(ns+1); end; {if} m_ldx_imm: if npeep[ns+1].opcode = m_lda_imm then if npeep[ns+2].opcode = m_phx then if npeep[ns+3].opcode = m_pha then begin opcode := m_pea; npeep[ns+1].opcode := m_pea; Remove(ns+2); Remove(ns+2); end; {if} m_ldy_imm: if npeep[ns+1].opcode = m_sep then if npeep[ns+1].operand = 32 then begin didOne := true; tn := npeep[ns]; npeep[ns] := npeep[ns+1]; npeep[ns+1] := tn; end; {if} m_ora_abs: if npeep[ns+1].opcode = m_sta_abs then if operand = npeep[ns+1].operand then if name = npeep[ns+1].name then begin opcode := m_tsb_abs; Remove(ns+1); end; {if} m_ora_dir: if npeep[ns+1].opcode = m_sta_dir then if operand = npeep[ns+1].operand then begin opcode := m_tsb_dir; Remove(ns+1); end; {if} m_pea: if npeep[ns+1].opcode = m_pla then begin opcode := m_lda_imm; Remove(ns+1); end; {if} m_sta_abs: if npeep[ns+1].opcode = m_lda_abs then if operand = npeep[ns+1].operand then if name = npeep[ns+1].name then if not (npeep[ns+2].opcode in [m_bcc,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_bvs]) then Remove(ns+1); m_sta_dir: if npeep[ns+1].opcode = m_lda_dir then if operand = npeep[ns+1].operand then if not (npeep[ns+2].opcode in [m_bcc,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_bvs]) then Remove(ns+1); m_plb: if npeep[ns+1].opcode = m_phb then begin Remove(ns); Remove(ns); end; {if} m_plx: if npeep[ns+1].opcode = m_pha then begin opcode := m_sta_s; mode := direct; operand := 1; Remove(ns+1); end; {if} m_tax: if npeep[ns+1].opcode = m_phx then begin Remove(ns+1); opcode := m_pha; end {if} else if npeep[ns+1].opcode = m_txa then begin if not (npeep[ns+2].opcode in [m_bcc,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_bvs]) then begin Remove(ns); Remove(ns); end; {if} end {else if} else if npeep[ns+1].opcode = m_dey then if npeep[ns+2].opcode = m_dey then if npeep[ns+3].opcode = m_lda_indly then if npeep[ns+4].opcode = m_stx_dir then begin npeep[ns] := npeep[ns+4]; opcode := m_sta_dir; Remove(ns+4); end; {if} m_tya: if npeep[ns+1].opcode = m_sta_dir then begin npeep[ns+1].opcode := m_sty_dir; Remove(ns); end {if} else if npeep[ns+1].opcode = m_sta_abs then begin npeep[ns+1].opcode := m_sty_abs; Remove(ns); end; {else if} m_tyx: if npeep[ns+1].opcode = m_phx then begin Remove(ns+1); opcode := m_phy; end; {if} m_pha: if npeep[ns+1].opcode = m_pla then begin Remove(ns); Remove(ns); end {if} else if npeep[ns+1].opcode in [m_ldx_abs,m_ldx_dir] then if npeep[ns+2].opcode = m_pla then begin Remove(ns+2); Remove(ns); end; {if} m_phy: if npeep[ns+1].opcode = m_ply then begin Remove(ns); Remove(ns); end; {if} m_rep: if npeep[ns+1].opcode = m_sep then if npeep[ns].operand = npeep[ns+1].operand then begin Remove(ns); Remove(ns); end; {if} otherwise: ; end; {case} 1: end; {Optimize} begin {GenNative} { writeln('GenNative: ',p_opcode:4, ', mode=', ord(p_mode):1, ' operand=', p_operand:1); {debug} if npeephole then begin if (nnextspot = 1) and not (p_opcode in nleadOpcodes) then begin if p_opcode <> d_end then if registers then CheckRegisters(p_opcode, p_mode, p_operand, p_name, p_flags) else WriteNative(p_opcode, p_mode, p_operand, p_name, p_flags); end {if} else if p_opcode in nstopOpcodes then begin repeat didOne := false; i := 1; llongA := longA; while i < nnextSpot-nMaxPeep do begin op := npeep[i].opcode; if op = m_sep then begin if npeep[i].operand & $20 <> 0 then llongA := false; end {if} else if op = m_rep then begin if npeep[i].operand & $20 <> 0 then llongA := true; end; {else} Optimize(i,llongA); i := i+1; end; {while} until not didone; Purge; if p_opcode <> d_end then if registers then CheckRegisters(p_opcode, p_mode, p_operand, p_name, p_flags) else WriteNative(p_opcode, p_mode, p_operand, p_name, p_flags); end {else if} else if nnextSpot = npeepSize then begin repeat didOne := false; i := 1; llongA := longA; while i < nnextSpot-nMaxPeep do begin op := npeep[i].opcode; if op = m_sep then begin if npeep[i].operand & $20 <> 0 then llongA := false; end {if} else if op = m_rep then begin if npeep[i].operand & $20 <> 0 then llongA := true; end; {else} Optimize(i,llongA); i := i+1; end; {while} until not didone; done := false; repeat if nnextSpot = 1 then done := true else begin if npeep[1].opcode in nleadOpcodes then done := true else begin if registers then CheckRegisters(nPeep[1].opcode, nPeep[1].mode, nPeep[1].operand, nPeep[1].name, nPeep[1].flags) else WriteNative(nPeep[1].opcode, nPeep[1].mode, nPeep[1].operand, nPeep[1].name,nPeep[1].flags); Remove(1); end; {else} end; {else} until done; if nnextSpot = nPeepSize then begin if registers then CheckRegisters(nPeep[1].opcode, nPeep[1].mode, nPeep[1].operand, nPeep[1].name, nPeep[1].flags) else WriteNative(nPeep[1].opcode, nPeep[1].mode, nPeep[1].operand, nPeep[1].name, nPeep[1].flags); Remove(1); end; {if} with npeep[nnextSpot] do begin opcode := p_opcode; mode := p_mode; operand := p_operand; name := p_name; flags := p_flags; end; {with} nnextSpot := nnextSpot+1; if not (npeep[1].opcode in nleadOpcodes) then begin if registers then CheckRegisters(nPeep[1].opcode, nPeep[1].mode, nPeep[1].operand, nPeep[1].name, nPeep[1].flags) else WriteNative(nPeep[1].opcode, nPeep[1].mode, nPeep[1].operand, nPeep[1].name, nPeep[1].flags); Remove(1); end; {if} end {else if} else begin with npeep[nnextSpot] do begin opcode := p_opcode; mode := p_mode; operand := p_operand; name := p_name; flags := p_flags; end; {with} nnextSpot := nnextSpot+1; end; {else} end {if} else if p_opcode <> d_end then if registers then CheckRegisters(p_opcode, p_mode, p_operand, p_name, p_flags) else WriteNative(p_opcode, p_mode, p_operand, p_name, p_flags); end; {GenNative} procedure GenImplied {p_opcode: integer}; { short form of GenNative - reduces code size } { } { parameters: } { p_code - operation code } begin {GenImplied} GenNative(p_opcode, implied, 0, nil, 0); end; {GenImplied} procedure GenCall {callNum: integer}; { short form of jsl to library subroutine - reduces code size } { } { parameters: } { callNum - subroutine # to generate a call for } var sp: stringPtr; {work string} begin {GenCall} case callNum of 1: sp := @'~CHECKSTACK'; 2: sp := @'~RESETNAME'; 3: sp := @'~CREALRET'; 4: sp := @'~CDOUBLERET'; 5: sp := @'~SETNAME'; 6: sp := @'~SETLINENUMBER'; 7: sp := @'~REALFN'; 8: sp := @'~DOUBLEFN'; 9: sp := @'~SAVEREAL'; 10: sp := @'~SAVEDOUBLE'; 11: sp := @'~CNVINTREAL'; 12: sp := @'~CNVLONGREAL'; 13: sp := @'~CNVULONGREAL'; 14: sp := @'~CNVREALINT'; 15: sp := @'~CNVREALUINT'; 16: sp := @'~CNVREALLONG'; 17: sp := @'~CNVREALULONG'; 18: sp := @'~CNVL2'; {PASCAL} 19: sp := @'~SAVESET'; 20: sp := @'~LOADSET'; {PASCAL} 21: sp := @'~LOADREAL'; 22: sp := @'~LOADDOUBLE'; 23: sp := @'~SHIFTLEFT'; 24: sp := @'~SSHIFTRIGHT'; 25: sp := @'~INTCHKC'; 26: sp := @'~DIV2'; 27: sp := @'~MOD2'; 28: sp := @'~MUL2'; 29: sp := @'~GRTL'; 30: sp := @'~GEQL'; 31: sp := @'~GRTE'; 32: sp := @'~GEQE'; 33: sp := @'~SETINCLUSION'; 34: sp := @'~GRTSTRING'; 35: sp := @'~GEQSTRING'; 36: sp := @'~EQUE'; 37: sp := @'~SETEQU'; 38: sp := @'~EQUSTRING'; 39: sp := @'~UMUL2'; 40: sp := @'~UDIV2'; 41: sp := @'~USHIFTRIGHT'; 42: sp := @'~MUL4'; 43: sp := @'~PDIV4'; 44: sp := @'~MOD4'; 45: sp := @'~SHL4'; 46: sp := @'~LSHR4'; 47: sp := @'~ASHR4'; {CC} 48: sp := @'~UMUL4'; {CC} 49: sp := @'~UDIV4'; {CC} 50: sp := @'~UMOD4'; {CC} 51: sp := @'~COPYREAL'; 52: sp := @'~COPYDOUBLE'; 53: sp := @'~XJPERROR'; 54: sp := @'~MOVE'; 55: sp := @'~MOVE2'; 56: sp := @'~ADDE'; 57: sp := @'~DIVE'; 58: sp := @'~MULE'; 59: sp := @'~SUBE'; 60: sp := @'~POWER'; 61: sp := @'~ARCTAN2E'; 62: sp := @'~LONGMOVE'; 63: sp := @'~LONGMOVE2'; 64: sp := @'~CCOMPRET'; 65: sp := @'~CEXTENDEDRET'; 66: sp := @'~SAVECOMP'; 67: sp := @'~SAVEEXTENDED'; 68: sp := @'~COPYCOMP'; 69: sp := @'~COPYEXTENDED'; 70: sp := @'~LOADCOMP'; 71: sp := @'~LOADEXTENDED'; 72: sp := @'~LOADUBF'; 73: sp := @'~LOADBF'; 74: sp := @'~SAVEBF'; 75: sp := @'~COPYBF'; 76: sp := @'~STACKERR'; {CC} 77: sp := @'~LOADSTRUCT'; {CC} otherwise: Error(cge1); end; {case} GenNative(m_jsl, longabs, 0, sp, 0); end; {GenCall} procedure GenLab {lnum: integer}; { generate a label } { } { parameters: } { lnum - label number } begin {GenLab} GenNative(d_lab, gnrlabel, lnum, nil, 0); end; {GenLab} procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: boolean}; { Set up the object file } { } { parameters: } { keepName - name of the output file } { keepFlag - keep status: } { 0 - don't keep the output } { 1 - create a new object module } { 2 - a .root already exists } { 3 - at least on .letter file exists } { partial - is this a partial compile? } { } { Note: Declared as extern in CGI.pas } procedure RootFile; { Create and write the initial entry segment } const dispToOpen = 21; {disps to glue routines for NDAs} dispToClose = 38; dispToAction = 50; dispToInit = 65; dispToCDAOpen = 9; {disps to glue routines for CDAs} dispToCDAClose = 36; var i: integer; {loop index} lab: stringPtr; {for holdling names var pointers} menuLen: integer; {length of the menu name string} procedure SetDataBank; { set up the data bank register } begin {SetDataBank} CnOut(m_pea); RefName(@'~GLOBALS', 0, 2, -8); CnOut(m_plb); CnOut(m_plb); end; {SetDataBank} begin {RootFile} {open the initial object module} fname2.theString.theString := concat(fname1.theString.theString, '.root'); fname2.theString.size := length(fname2.theString.theString); OpenObj(fname2); {write the header} Header(@'~_ROOT', $4000, 0); {new desk accessory initialization} if isNewDeskAcc then begin {set up the initial jump table} lab := @'~_ROOT'; menuLen := length(menuLine); RefName(lab, menuLen + dispToOpen, 4, 0); RefName(lab, menuLen + dispToClose, 4, 0); RefName(lab, menuLen + dispToAction, 4, 0); RefName(lab, menuLen + dispToInit, 4, 0); CnOut2(refreshPeriod); CnOut2(eventMask); for i := 1 to menuLen do CnOut(ord(menuLine[i])); CnOut(0); {glue code for calling open routine} CnOut(m_phb); SetDataBank; CnOut(m_jsl); RefName(openName, 0, 3, 0); CnOut(m_plb); CnOut(m_sta_s); CnOut(4); CnOut(m_txa); CnOut(m_sta_s); CnOut(6); CnOut(m_rtl); {glue code for calling close routine} CnOut(m_phb); SetDataBank; CnOut(m_jsl); RefName(closeName, 0, 3, 0); CnOut(m_plb); CnOut(m_rtl); {glue code for calling action routine} CnOut(m_phb); SetDataBank; CnOut(m_pha); CnOut(m_phy); CnOut(m_phx); CnOut(m_jsl); RefName(actionName, 0, 3, 0); CnOut(m_plb); CnOut(m_rtl); {glue code for calling init routine} CnOut(m_pha); CnOut(m_jsl); RefName(@'~DAID', 0, 3, 0); CnOut(m_phb); SetDataBank; CnOut(m_pha); CnOut(m_jsl); RefName(initName, 0, 3, 0); CnOut(m_plb); CnOut(m_rtl); end {classic desk accessory initialization} else if isClassicDeskAcc then begin {write the name} menuLen := length(menuLine); CnOut(menuLen); for i := 1 to menuLen do CnOut(ord(menuLine[i])); {set up the initial jump table} lab := @'~_ROOT'; RefName(lab, menuLen + dispToCDAOpen, 4, 0); RefName(lab, menuLen + dispToCDAClose, 4, 0); {glue code for calling open routine} CnOut(m_pea); CnOut2(1); CnOut(m_jsl); RefName(@'~DAID', 0, 3, 0); CnOut(m_phb); SetDataBank; CnOut(m_jsl); RefName(@'~CDASTART', 0, 3, 0); CnOut(m_jsl); RefName(openName,0,3,0); CnOut(m_jsl); RefName(@'~CDASHUTDOWN', 0, 3, 0); CnOut(m_plb); CnOut(m_rtl); {glue code for calling close routine} CnOut(m_phb); SetDataBank; CnOut(m_jsl); RefName(closeName, 0, 3, 0); CnOut(m_pea); CnOut2(0); CnOut(m_jsl); RefName(@'~DAID', 0, 3, 0); CnOut(m_plb); CnOut(m_rtl); end {control panel device initialization} else if isCDev then begin CnOut(m_pea); CnOut2(1); CnOut(m_jsl); RefName(@'~DAID', 0, 3, 0); CnOut(m_phb); SetDataBank; CnOut(m_pla); CnOut(m_sta_s); CnOut(13); CnOut(m_pla); CnOut(m_sta_s); CnOut(13); CnOut(m_jsl); RefName(openName,0,3,0); CnOut(m_tay); CnOut(m_lda_s); CnOut(3); CnOut(m_pha); CnOut(m_lda_s); CnOut(3); CnOut(m_pha); CnOut(m_txa); CnOut(m_sta_s); CnOut(7); CnOut(m_tya); CnOut(m_sta_s); CnOut(5); CnOut(m_plb); CnOut(m_rtl); end {NBA initialization} else if isNBA then begin CnOut(m_jsl); RefName(@'~NBASTARTUP', 0, 3, 0); CnOut(m_phx); CnOut(m_phy); CnOut(m_jsl); RefName(openName,0,3,0); CnOut(m_jsl); RefName(@'~NBASHUTDOWN', 0, 3, 0); CnOut(m_rtl); end {XCMD initialization} else if isXCMD then begin CnOut(m_jsl); RefName(@'~XCMDSTARTUP', 0, 3, 0); CnOut(m_jsl); RefName(openName,0,3,0); CnOut(m_jsl); RefName(@'~XCMDSHUTDOWN', 0, 3, 0); CnOut(m_rtl); end {normal program initialization} else begin {write the initial JSL} CnOut(m_jsl); if rtl then RefName(@'~_BWSTARTUP4', 0, 3, 0) else RefName(@'~_BWSTARTUP3', 0, 3, 0); {set the data bank register} SetDataBank; {write JSL to main entry point} CnOut(m_jsl); if rtl then RefName(@'~C_STARTUP2', 0, 3, 0) else RefName(@'~C_STARTUP', 0, 3, 0); CnOut(m_jsl); RefName(@'main', 0, 3, 0); CnOut(m_jsl); if rtl then RefName(@'~C_SHUTDOWN2', 0, 3, 0) else RefName(@'~C_SHUTDOWN', 0, 3, 0); end; {finish the current segment} EndSeg; end; {RootFile} procedure SetStack; { Set up a stack frame } begin {SetStack} if stackSize <> 0 then begin currentSegment := '~_STACK '; {write the header} Header(@'~_STACK', $4012, 0); currentSegment := defaultSegment; Out($F1); {write the DS record to reserve space} Out2(stackSize); Out2(0); EndSeg; {finish the current segment} end; {if} end; {SetStack} begin {InitFile} fname1 := keepname^; if partial or (keepFlag = 3) then FindSuffix(fname1, nextSuffix) else begin if (keepFlag = 1) and (not noroot) then begin RootFile; SetStack; CloseObj; end; {if} DestroySuffixes(fname1); nextSuffix := 'a'; end; {else} fname2.theString.theString := concat(fname1.theString.theString, '.', nextSuffix); fname2.theString.size := length(fname2.theString.theString); OpenObj(fname2); end; {InitFile} procedure InitNative; { set up for a new segment } begin {InitNative} aRegister.condition := regUnknown; {set up the peephole optimizer} xRegister.condition := regUnknown; yRegister.condition := regUnknown; nnextspot := 1; nleadOpcodes := [m_asl_a,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_brl,m_bvs,m_bcc, m_dec_abs,m_lda_abs,m_lda_dir,m_lda_imm,m_ldx_imm,m_sta_abs,m_sta_dir, m_pha,m_plb,m_plx,m_tax,m_tya,m_tyx,m_phy,m_pei_dir,m_ldy_imm,m_rep, m_ora_dir,m_ora_abs,m_and_imm,m_pea]; nstopOpcodes := [d_end,d_pin]; stringSize := 0; {initialize scalars for a new segment} pc := 0; cbufflen := 0; longA := true; longI := true; end; {InitNative} procedure RefName {lab: stringPtr; disp, len, shift: integer}; { handle a reference to a named label } { } { parameters: } { lab - label name } { disp - displacement past the label } { len - number of bytes in the reference } { shift - shift factor } var i: integer; {loop var} slen: integer; {length of string} begin {RefName} Purge; {clear any constant bytes} if isJSL then {expression header} Out(243) else Out(235); Out(len); Out(131); pc := pc+len; slen := length(lab^); Out(slen); for i := 1 to slen do Out(ord(lab^[i])); if disp <> 0 then begin {if there is a disp, add it in} Out(129); Out2(disp); Out2(0); Out(1); end; {end} if shift <> 0 then begin {if there is a shift, add it in} Out(129); Out2(shift); if shift < 0 then Out2(-1) else Out2(0); Out(7); end; {if} Out(0); {end of expression} end; {RefName} end. {$append 'native.asm'} \ No newline at end of file +{$optimize 7} +{---------------------------------------------------------------} +{ } +{ ORCA Native Code Generation } +{ } +{ This module of the code generator is called to generate } +{ native code instructions. The native code is optimized } +{ and written to the object segment. } +{ } +{ Externally available procedures: } +{ } +{ EndSeg - close out the current segment } +{ GenNative - write a native code instruction to the output } +{ file } +{ GenImplied - short form of GenNative - reduces code size } +{ GenCall - short form of jsl to library subroutine - reduces } +{ code size } +{ GenLab - generate a label } +{ InitFile - Set up the object file } +{ InitNative - set up for a new segment } +{ RefName - handle a reference to a named label } +{ } +{---------------------------------------------------------------} + +unit Native; + +interface + +{$LibPrefix '0/obj/'} + +uses CCommon, CGI, CGC, ObjOut; + +{$segment 'CodeGen'} + +type + labelptr = ^labelentry; {pointer to a forward ref node} + labelentry = record {forward ref node} + addr: integer; + next: labelptr; + end; + + labelrec = record {label record} + defined: boolean; {Note: form used in objout.asm} + chain: labelptr; + case boolean of + true : (val: longint); + false: (ival,hval: integer); + end; + +var + {current instruction info} + {------------------------} + pc: longint; {program counter} + + {65816 native code generation} + {----------------------------} + didOne: boolean; {has an optimization been done?} + labeltab: array[0..maxlabel] of labelrec; {label table} + localLabel: array[0..maxLocalLabel] of integer; {local variable label table} + +{---------------------------------------------------------------} + +procedure EndSeg; + +{ close out the current segment } + + +procedure GenNative (p_opcode: integer; p_mode: addressingMode; + p_operand: integer; p_name: stringPtr; p_flags: integer); + +{ write a native code instruction to the output file } +{ } +{ parameters: } +{ p_opcode - native op code } +{ p_mode - addressing mode } +{ p_operand - integer operand } +{ p_name - named operand } +{ p_flags - operand modifier flags } + + +procedure GenImplied (p_opcode: integer); + +{ short form of GenNative - reduces code size } +{ } +{ parameters: } +{ p_code - operation code } + + +procedure GenCall (callNum: integer); + +{ short form of jsl to library subroutine - reduces code size } +{ } +{ parameters: } +{ callNum - subroutine # to generate a call for } + + +procedure GenLab (lnum: integer); + +{ generate a label } +{ } +{ parameters: } +{ lnum - label number } + + +procedure InitFile (keepName: gsosOutStringPtr; keepFlag: integer; partial: boolean); + +{ Set up the object file } +{ } +{ parameters: } +{ keepName - name of the output file } +{ keepFlag - keep status: } +{ 0 - don't keep the output } +{ 1 - create a new object module } +{ 2 - a .root already exists } +{ 3 - at least on .letter file exists } +{ partial - is this a partial compile? } +{ } +{ Note: Declared as extern in CGI.pas } + + +procedure InitNative; + +{ set up for a new segment } + + +procedure LabelSearch (lab: integer; len, shift, disp: integer); + +{ resolve a label reference } +{ } +{ parameters: } +{ lab - label number } +{ len - # bytes for the generated code } +{ shift - shift factor } +{ disp - disp past the label } +{ } +{ Note 1: maxlabel is reserved for use as the start of the } +{ string space } +{ Note 2: negative length indicates relative branch } +{ Note 3: zero length indicates 2 byte addr -1 } + + +procedure RefName (lab: stringPtr; disp, len, shift: integer); + +{ handle a reference to a named label } +{ } +{ parameters: } +{ lab - label name } +{ disp - displacement past the label } +{ len - number of bytes in the reference } +{ shift - shift factor } + + +{--------------------------------------------------------------------------} + +implementation + +const + npeepSize = 128; {native peephole optimizer window size} + nMaxPeep = 4; {max # instructions needed to opt.} + +type + {65816 native code generation} + {----------------------------} + npeepRange = 1..npeepsize; {subrange for native code peephole opt.} + + nativeType = record {native code instruction} + opcode: integer; {op code} + mode: addressingMode; {addressing mode} + operand: integer; {operand value} + name: stringPtr; {operand label} + flags: integer; {modifier flags} + end; + + registerConditions = (regUnknown,regImmediate,regAbsolute,regLocal); + registerType = record {used to track register contents} + condition: registerConditions; + value: integer; + lab: stringPtr; + flags: integer; + end; + +var + {native peephole optimization} + {----------------------------} + aRegister, {current register contents} + xRegister, + yRegister: registerType; + nleadOpcodes: set of 0..max_opcode; {instructions that can start an opt.} + nstopOpcodes: set of 0..max_opcode; {instructions not involved in opt.} + nnextspot: npeepRange; {next empty spot in npeep} + npeep: array[npeepRange] of nativeType; {native peephole array} + + {I/O files} + {---------} + fname1, fname2: gsosOutString; {file names} + nextSuffix: char; {next suffix character to use} + + +procedure GenSymbols (sym: ptr; doGlobals: integer); extern; + +{ generate the symbol table } + +{--------------------------------------------------------------------------} + +procedure LabelSearch {lab: integer; len, shift, disp: integer}; + +{ resolve a label reference } +{ } +{ parameters: } +{ lab - label number } +{ len - # bytes for the generated code } +{ shift - shift factor } +{ disp - disp past the label } +{ } +{ Note 1: maxlabel is reserved for use as the start of the } +{ string space } +{ Note 2: negative length indicates relative branch } +{ Note 3: zero length indicates 2 byte addr -1 } + +var + next: labelptr; {work pointer} + +begin {LabelSearch} +if labeltab[lab].defined and (len < 0) and (shift = 0) and (disp = 0) then begin + + {handle a relative branch to a known disp} + if len = -1 then + CnOut(labeltab[lab].ival - long(pc).lsw - cbufflen + len) + else + CnOut2(labeltab[lab].ival - long(pc).lsw - cbufflen + len); + end {if} +else begin + if lab <> maxlabel then begin + + {handle a normal label reference} + Purge; {empty the constant buffer} + if len < 0 then begin + len := -len; {generate a RELEXPR} + Out(238); + Out(len); + Out2(len); Out2(0); + end {if} + else begin + if isJSL then {generate a standard EXPR} + Out(243) + else + Out(235); + if len = 0 then + Out(2) + else + Out(len); + end; {else} + end; {if} + Out(135); {generate a relative offset from the seg. start} + if not labeltab[lab].defined then begin + next := pointer(Malloc(sizeof(labelEntry))); {value unknown: create a reference} + next^.next := labeltab[lab].chain; + labeltab[lab].chain := next; + next^.addr := blkcnt; + Out2(0); + Out2(0); + end {if} + else {labeltab[lab].defined} begin + Out2(labeltab[lab].ival); {value known: write it} + Out2(labeltab[lab].hval); + end; {else} + if len = 0 then begin + Out(129); {subtract 1 from addr} + Out2(1); Out2(0); + Out(2); + len := 2; + end; {if} + if disp <> 0 then begin + Out(129); {add in the displacement} + Out2(disp); + if disp < 0 then + Out2(-1) + else + Out2(0); + Out(1); + end; {if} + if shift <> 0 then begin + Out(129); {shift the address} + Out2(-shift); Out2(-1); + Out(7); + end; {if} + if lab <> maxlabel then {if not a string, end the expression} + Out(0); + pc := pc+len; {update the pc} + end; {else} +end; {LabelSearch} + + +procedure UpDate (lab: integer; labelValue: longint); + +{ define a label } +{ } +{ parameters: } +{ lab - label number } +{ labelValue - displacement in seg where label is located } + +var + next,temp: labelptr; {work pointers} + +begin {UpDate} +if labeltab[lab].defined then + Error(cge1) +else begin + + {define the label for future references} + with labeltab[lab] do begin + defined := true; + val := labelValue; + next := chain; + end; {with} + + {resolve any forward references} + if next <> nil then begin + Purge; + while next <> nil do begin + segdisp := next^.addr; + Out2(long(labelvalue).lsw); + Out2(long(labelvalue).msw); + blkcnt := blkcnt-4; + temp := next; + next := next^.next; + end; {while} + segdisp := blkcnt; + end; {if} + end; {else} +end; {UpDate} + + +procedure WriteNative (opcode: integer; mode: addressingMode; operand: integer; + name: stringPtr; flags: integer); + +{ write a native code instruction to the output file } +{ } +{ parameters: } +{ opcode - native op code } +{ mode - addressing mode } +{ operand - integer operand } +{ name - named operand } +{ flags - operand modifier flags } + +label 1; + +type + rkind = (k1,k2,k3); {cnv record types} + +var + ch: char; {temp storage for string constants} + cns: realRec; {for converting reals to bytes} + cnv: record {for converting double, real to bytes} + case rkind of + k1: (rval: real;); + k2: (dval: double;); + k3: (ival1,ival2,ival3,ival4: integer;); + end; + count: integer; {number of constants to repeat} + i,j,k: integer; {loop variables} + lsegDisp: integer; {for backtracking while writting the } + { debugger's symbol table } + lval: longint; {temp storage for long constant} + nptr: stringPtr; {pointer to a name} + sptr: longstringPtr; {pointer to a string constant} + + + procedure GenImmediate1; + + { generate a one byte immediate operand } + + begin {GenImmediate1} + if (flags & stringReference) <> 0 then begin + Purge; + Out(235); Out(1); {one byte expression} + Out(128); {current location ctr} + Out(129); Out2(-16); Out2(-1); {-16} + Out(7); {bit shift} + Out(0); {end of expr} + pc := pc+1; + end {if} + else if (flags & localLab) <> 0 then + LabelSearch(long(name).lsw, 1, ord(odd(flags div shift16))*16, operand) + else if (flags & shift16) <> 0 then + RefName(name, operand, 1, -16) + else + CnOut(operand); + end; {GenImmediate1} + + + procedure GenImmediate2; + + { generate a two byte immediate operand } + + begin {GenImmediate2} + if (flags & stringReference) <> 0 then begin + Purge; + Out(235); Out(2); + LabelSearch(maxLabel, 2, 0, 0); + if operand <> 0 then begin + Out(129); + Out2(operand); Out2(0); + Out(1); + end; {if} + if (flags & shift16) <> 0 then begin + Out(129); + Out2(-16); Out2(-1); + Out(7); + end; {if} + Out(0); + end {if} + else if (flags & shift8) <> 0 then + RefName(name, operand, 2, -8) + else if (flags & localLab) <> 0 then + LabelSearch(long(name).lsw, 2, ord(odd(flags div shift16))*16, operand) + else if (flags & shift16) <> 0 then + RefName(name, operand, 2, -16) + else if name = nil then + CnOut2(operand) + else + RefName(name, operand, 2, 0); + end; {GenImmediate2} + + + procedure DefGlobal (private: integer); + + { define a global label } + { } + { parameters: } + { private - private flag } + + var + i: integer; {loop variable} + + begin {DefGlobal} + Purge; + Out(230); {global label definition} + Out(ord(name^[0])); {write label name} + for i := 1 to ord(name^[0]) do + Out(ord(name^[i])); + Out2(0); {length attribute} + Out(ord('N')); {type attribute: other directive} + Out(private); {private or global?} + end; {DefGlobal} + + +begin {WriteNative} +{ writeln('WriteNative: ',opcode:4, ', mode=', ord(mode):1, + ' operand=', operand:1); {debug} +case mode of + + implied: + CnOut(opcode); + + immediate: begin + if opcode = d_bmov then + GenImmediate1 + else begin + if opcode = m_and_imm then + if not longA then + if operand = 255 then + goto 1; + CnOut(opcode); + if opcode = m_pea then + GenImmediate2 + else if opcode in + [m_adc_imm,m_and_imm,m_cmp_imm,m_eor_imm,m_lda_imm,m_ora_imm, + m_sbc_imm,m_bit_imm] then + if longA then + GenImmediate2 + else + GenImmediate1 + else if opcode in [m_rep,m_sep,m_cop] then begin + GenImmediate1; + if opcode = m_rep then begin + if odd(operand div 32) then longA := true; + if odd(operand div 16) then longI := true; + end {if} + else if opcode = m_sep then begin + if odd(operand div 32) then longA := false; + if odd(operand div 16) then longI := false; + end; {else} + end {else} + else + if longI then + GenImmediate2 + else + GenImmediate1; + end; {else} + end; + + longabs: begin + CnOut(opcode); + isJSL := opcode = m_jsl; {allow for dynamic segs} + if name = nil then + if odd(flags div toolcall) then begin + CnOut2(0); + CnOut(225); + end {if} + else + LabelSearch(operand, 3, 0, 0) + else + if odd(flags div toolcall) then begin + CnOut2(long(name).lsw); + CnOut(long(name).msw); + end {if} + else + RefName(name, operand, 3, 0); + isJSL := false; + end; + + longabsolute: begin + if opcode <> d_add then begin + CnOut(opcode); + i := 3; + end {if} + else + i := 4; + if (flags & localLab) <> 0 then + LabelSearch(long(name).lsw, i, 0, operand) + else if (flags & constantOpnd) <> 0 then begin + lval := ord4(name); + CnOut2(long(lval).lsw); + if opcode = d_add then + CnOut2(long(lval).msw) + else + CnOut(long(lval).msw); + end {else if} + else if name <> nil then + RefName(name, operand, i, 0) + else begin + CnOut2(operand); + CnOut(0); + if opcode = d_add then + CnOut(0); + end; {else} + end; + + absolute: begin + if opcode <> d_add then + CnOut(opcode); + if (flags & localLab) <> 0 then + LabelSearch(long(name).lsw, 2, 0, operand) + else if name <> nil then + RefName(name, operand, 2, 0) + else if (flags & constantOpnd) <> 0 then + CnOut2(operand) + else + LabelSearch(operand, 2, 0, 0); + end; + + direct: begin + if opcode <> d_add then + CnOut(opcode); + if (flags & localLab) <> 0 then + LabelSearch(long(name).lsw, 1, 0, operand) + else if name <> nil then + RefName(name, operand, 1, 0) + else + CnOut(operand); + end; + + longrelative: begin + CnOut(opcode); + LabelSearch(operand, -2, 0, 0); + end; + + relative: begin + CnOut(opcode); + LabelSearch(operand, -1, 0, 0); + end; + + gnrLabel: + if name = nil then + UpDate(operand, pc+cbufflen) + else begin + DefGlobal((flags >> 5) & 1); + if operand <> 0 then begin + Out(241); + Out2(operand); + Out2(0); + pc := pc+operand; + end; {if} + end; {else} + + gnrSpace: + if operand <> 0 then begin + Out(241); + Out2(operand); + Out2(0); + pc := pc+operand; + end; {if} + + gnrConstant: begin + if icptr(name)^.optype = cgString then + count := 1 + else + count := icptr(name)^.q; + for i := 1 to count do + case icptr(name)^.optype of + cgByte,cgUByte : CnOut(icptr(name)^.r); + cgWord,cgUWord : CnOut2(icptr(name)^.r); + cgLong,cgULong : begin + lval := icptr(name)^.lval; + CnOut2(long(lval).lsw); + CnOut2(long(lval).msw); + end; + cgReal : begin + cnv.rval := icptr(name)^.rval; + CnOut2(cnv.ival1); + CnOut2(cnv.ival2); + end; + cgDouble : begin + cnv.dval := icptr(name)^.rval; + CnOut2(cnv.ival1); + CnOut2(cnv.ival2); + CnOut2(cnv.ival3); + CnOut2(cnv.ival4); + end; + cgComp : begin + cns.itsReal := icptr(name)^.rval; + CnvSC(cns); + for j := 1 to 8 do + CnOut(cns.inCOMP[j]); + end; + cgExtended : begin + cns.itsReal := icptr(name)^.rval; + CnvSX(cns); + for j := 1 to 10 do + CnOut(cns.inSANE[j]); + end; + cgString : begin + sptr := icptr(name)^.str; + for j := 1 to sptr^.length do + CnOut(ord(sPtr^.str[j])); + end; + ccPointer : begin + if icptr(name)^.lab <> nil then begin + Purge; + Out(235); + Out(4); + Out(131); + pc := pc+4; + nptr := icptr(name)^.lab; + for j := 0 to ord(nptr^[0]) do + Out(ord(nptr^[j])); + lval := icptr(name)^.pVal; + if lval <> 0 then begin + Out(129); + Out2(long(lval).lsw); + Out2(long(lval).msw); + Out(2-icptr(name)^.r); + end; {if} + Out(0); + end {if} + else begin + lval := icptr(name)^.pVal; + if icptr(name)^.r = 1 then + operand := stringSize+long(lval).lsw + else + operand := stringSize-long(lval).lsw; + flags := stringReference; + GenImmediate2; + flags := stringReference+shift16; + GenImmediate2; + sptr := icptr(name)^.pStr; + j := sptr^.length; + if maxString-stringSize >= j+1 then begin + for k := 1 to j do + stringSpace[k+stringSize] := + sptr^.str[k]; + stringSpace[stringSize+j+1] := chr(0); + stringSize := stringSize+j+1; + end {if} + else + Error(cge3); + end; {else} + end; + otherwise : Error(cge1); + end; {case} + end; + + genAddress: begin + if opcode < 256 then + CnOut(opcode); + if (flags & stringReference) <> 0 then begin + Purge; + Out(235); + Out(2); + LabelSearch(maxLabel,2,0,0); + if operand <> 0 then begin + Out(129); + Out2(operand); + Out2(0); + Out(1); + end; {if} + if (flags & shift16) <> 0 then begin + Out(129); + Out2(-16); + Out2(-1); + Out(7); + end; {if} + Out(0); + end {if} + else if operand = 0 then begin + CnOut(0); + CnOut(0); + end {else if} + else if (flags & shift16) <> 0 then + if longA then + LabelSearch(operand, 2, 16, 0) + else + LabelSearch(operand, 1, 16, 0) + else + LabelSearch(operand, 0, 0, 0); + end; + + special: + if opcode = d_pin then begin + segDisp := 36; + out2(long(pc).lsw+cBuffLen); + blkCnt := blkCnt-2; + segDisp := blkCnt; + end {if} + else if opcode = d_sym then begin + CnOut(m_cop); + CnOut(5); + Purge; + lsegDisp := segDisp+1; + CnOut2(0); + symLength := 0; + GenSymbols(pointer(name), operand); + segDisp := lSegDisp; + out2(symLength); + blkCnt := blkCnt-2; + segDisp := blkCnt; + end {else if} + else {d_wrd} + CnOut2(operand); + + otherwise: Error(cge1); + + end; {case} +1: +end; {WriteNative} + + +procedure CheckRegisters(p_opcode: integer; p_mode: addressingMode; + p_operand: integer; p_name: stringPtr; p_flags: integer); + +{ write a native code instruction to the output file } +{ } +{ parameters: } +{ p_opcode - native op code } +{ p_mode - addressing mode } +{ p_operand - integer operand } +{ p_name - named operand } +{ p_flags - operand modifier flags } + +label 1,2; + +begin {CheckRegisters} +case p_opcode of + m_adc_abs,m_adc_dir,m_adc_imm,m_adc_s,m_and_abs,m_and_dir,m_and_imm, + m_and_s,m_asl_a,m_dea,m_eor_abs,m_eor_dir,m_eor_imm,m_eor_s,m_lda_absx, + m_lda_dirx,m_lda_indl,m_lda_indly,m_lda_longx,m_lda_s,m_lsr_a,m_ora_abs, + m_ora_dir,m_ora_dirX,m_ora_imm,m_ora_longX,m_ora_s,m_pla,m_sbc_abs, + m_sbc_dir,m_sbc_imm,m_sbc_s,m_tdc,m_tsc,m_tsb_dir,m_tsb_abs: + aRegister.condition := regUnknown; + + m_ldy_absX,m_ldy_dirX,m_ply: + yRegister.condition := regUnknown; + + m_plx: + xRegister.condition := regUnknown; + + m_bcc,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_bra,m_brl,m_bvs,m_clc,m_cmp_abs, + m_cmp_dir,m_cmp_imm,m_cmp_s,m_cpx_imm,m_jml,m_pha,m_phb,m_phd, + m_phx,m_phy,m_plb,m_pld,m_rtl,m_rts,m_sec,m_sta_absX, + m_sta_dir,m_sta_dirX,m_sta_indl,m_sta_indlY,m_sta_longX, + m_sta_s,m_stx_dir,m_sty_dir,m_sty_dirX,m_stz_abs,m_stz_absX, + m_stz_dir,m_stz_dirX,m_tcs,m_tcd,d_add,d_pin,m_pei_dir,m_cpx_abs, + m_cpx_dir,m_cmp_dirx,m_php,m_plp,m_cop,d_wrd: ; + + m_pea: begin + if aRegister.condition = regImmediate then + if aRegister.value = p_operand then + if aRegister.lab = p_name then + if aRegister.flags = p_flags then + if longA then begin + p_opcode := m_pha; + p_mode := implied; + goto 2; + end; {if} + if longI then begin + if xRegister.condition = regImmediate then + if xRegister.value = p_operand then + if xRegister.lab = p_name then + if xRegister.flags = p_flags then begin + p_opcode := m_phx; + p_mode := implied; + goto 2; + end; {if} + if yRegister.condition = regImmediate then + if yRegister.value = p_operand then + if yRegister.lab = p_name then + if yRegister.flags = p_flags then begin + p_opcode := m_phy; + p_mode := implied; + goto 2; + end; {if} + end; {if} + end; + + m_dec_abs,m_inc_abs,m_sta_abs,m_stx_abs,m_sty_abs,m_sta_long: begin + if aRegister.condition = regAbsolute then + if aRegister.lab = p_name then + if aRegister.value = p_operand then + if not (p_opcode in [m_sta_abs,m_sta_long]) then + aRegister.condition := regUnknown; + if xRegister.condition = regAbsolute then + if xRegister.lab = p_name then + if xRegister.value = p_operand then + if p_opcode <> m_stx_abs then + xRegister.condition := regUnknown; + if yRegister.condition = regAbsolute then + if yRegister.lab = p_name then + if yRegister.value = p_operand then + if p_opcode <> m_sty_abs then + yRegister.condition := regUnknown; + end; + + m_dec_dir,m_dec_dirX,m_inc_dir,m_inc_dirX: begin + if aRegister.condition = regLocal then + if aRegister.value = p_operand then + aRegister.condition := regUnknown; + if xRegister.condition = regLocal then + if xRegister.value = p_operand then + xRegister.condition := regUnknown; + if yRegister.condition = regLocal then + if yRegister.value = p_operand then + yRegister.condition := regUnknown; + end; + + m_dex: + if xRegister.condition = regImmediate then + xRegister.value := xRegister.value-1 + else + xRegister.condition := regUnknown; + + m_dey: + if yRegister.condition = regImmediate then + yRegister.value := yRegister.value-1 + else + yRegister.condition := regUnknown; + + m_ina: + if aRegister.condition = regImmediate then + aRegister.value := aRegister.value+1 + else + aRegister.condition := regUnknown; + + m_inx: + if xRegister.condition = regImmediate then + xRegister.value := xRegister.value+1 + else + xRegister.condition := regUnknown; + + m_iny: + if yRegister.condition = regImmediate then + yRegister.value := yRegister.value+1 + else + yRegister.condition := regUnknown; + + otherwise, + m_jsl,m_mvn,m_rep,m_sep,d_lab,d_end,d_bmov,d_cns: begin + aRegister.condition := regUnknown; + xRegister.condition := regUnknown; + yRegister.condition := regUnknown; + end; + + m_lda_abs,m_lda_long: begin + if (aRegister.condition = regAbsolute) and + (aRegister.value = p_operand) and + (aRegister.lab = p_name) then + goto 1 + else if longA = longI then begin + if (xRegister.condition = regAbsolute) and + (xRegister.value = p_operand) and + (xRegister.lab = p_name) then begin + p_opcode := m_txa; + p_mode := implied; + aRegister := xRegister; + goto 2; + end {if} + else if (yRegister.condition = regAbsolute) and + (yRegister.value = p_operand) and + (yRegister.lab = p_name) then begin + p_opcode := m_tya; + p_mode := implied; + aRegister := yRegister; + goto 2; + end; {else if} + end; + aRegister.condition := regAbsolute; + aRegister.value := p_operand; + aRegister.lab := p_name; + aRegister.flags := p_flags; + end; + + m_lda_dir: begin + if (aRegister.condition = regLocal) and + (aRegister.value = p_operand) then + goto 1 + else if longA = longI then begin + if (xRegister.condition = regLocal) and + (xRegister.value = p_operand) then begin + p_opcode := m_txa; + p_mode := implied; + aRegister := xRegister; + goto 2; + end {if} + else if (yRegister.condition = regLocal) and + (yRegister.value = p_operand) then begin + p_opcode := m_tya; + p_mode := implied; + aRegister := yRegister; + goto 2; + end; {else if} + end; {else if} + aRegister.condition := regLocal; + aRegister.value := p_operand; + aRegister.flags := p_flags; + end; + + m_lda_imm: begin + if (aRegister.condition = regImmediate) and + (aRegister.value = p_operand) and + (aRegister.lab = p_name) and + (aRegister.flags = p_flags) then + goto 1 + else if longA = longI then begin + if (xRegister.condition = regImmediate) and + (xRegister.value = p_operand) and + (xRegister.lab = p_name) and + (xRegister.flags = p_flags) then begin + p_opcode := m_txa; + p_mode := implied; + aRegister := xRegister; + goto 2; + end {if} + else if (yRegister.condition = regImmediate) and + (yRegister.value = p_operand) and + (yRegister.lab = p_name) and + (yRegister.flags = p_flags) then begin + p_opcode := m_tya; + p_mode := implied; + aRegister := yRegister; + goto 2; + end; {else if} + end; {else if} + if (aRegister.condition = regImmediate) and + (aRegister.lab = p_name) and + (aRegister.flags = p_flags) then + if aRegister.value = (p_operand + 1) then begin + p_opcode := m_dea; + p_mode := implied; + aRegister.value := p_operand; + goto 2; + end {if} + else if aRegister.value = (p_operand - 1) then begin + p_opcode := m_ina; + p_mode := implied; + aRegister.value := p_operand; + goto 2; + end; {else if} + aRegister.condition := regImmediate; + aRegister.value := p_operand; + aRegister.flags := p_flags; + aRegister.lab := p_name; + end; + + m_ldx_abs: begin + if (xRegister.condition = regAbsolute) and + (xRegister.value = p_operand) and + (xRegister.lab = p_name) then + goto 1 + else if (aRegister.condition = regAbsolute) and + (aRegister.value = p_operand) and + (aRegister.lab = p_name) and + (longA = longI) then begin + p_opcode := m_tax; + p_mode := implied; + xRegister := aRegister; + end {else if} + else if (yRegister.condition = regAbsolute) and + (yRegister.value = p_operand) and + (yRegister.lab = p_name) then begin + p_opcode := m_tyx; + p_mode := implied; + xRegister := yRegister; + end {else if} + else begin + xRegister.condition := regAbsolute; + xRegister.value := p_operand; + xRegister.lab := p_name; + xRegister.flags := p_flags; + end; {else} + end; + + m_ldx_dir: begin + if (xRegister.condition = regLocal) and + (xRegister.value = p_operand) then + goto 1 + else if (aRegister.condition = regLocal) and + (aRegister.value = p_operand) and + (longA = longI) then begin + p_opcode := m_tax; + p_mode := implied; + xRegister := aRegister; + end {else if} + else if (yRegister.condition = regLocal) and + (yRegister.value = p_operand) then begin + p_opcode := m_tyx; + p_mode := implied; + xRegister := yRegister; + end {else if} + else begin + xRegister.condition := regLocal; + xRegister.value := p_operand; + xRegister.flags := p_flags; + end; {else} + end; + + m_ldx_imm: begin + if (xRegister.condition = regImmediate) and + (xRegister.value = p_operand) and + (xRegister.lab = p_name) and + (xRegister.flags = p_flags) then + goto 1 + else if (aRegister.condition = regImmediate) and + (aRegister.value = p_operand) and + (longA = longI) and + (aRegister.lab = p_name) and + (aRegister.flags = p_flags) then begin + p_opcode := m_tax; + p_mode := implied; + xRegister := aRegister; + end {else} + else if (yRegister.condition = regImmediate) and + (yRegister.value = p_operand) and + (yRegister.lab = p_name) and + (yRegister.flags = p_flags) then begin + p_opcode := m_tyx; + p_mode := implied; + xRegister := yRegister; + end {else if} + else begin + if (xRegister.condition = regImmediate) and + (xRegister.lab = p_name) and + (xRegister.flags = p_flags) then + if xRegister.value = (p_operand + 1) then begin + p_opcode := m_dex; + p_mode := implied; + xRegister.value := p_operand; + goto 2; + end {if} + else if xRegister.value = (p_operand - 1) then begin + p_opcode := m_inx; + p_mode := implied; + xRegister.value := p_operand; + goto 2; + end; {else if} + xRegister.condition := regImmediate; + xRegister.value := p_operand; + xRegister.flags := p_flags; + xRegister.lab := p_name; + end; {else} + end; + + m_ldy_abs: begin + if (yRegister.condition = regAbsolute) and + (yRegister.value = p_operand) and + (yRegister.lab = p_name) then + goto 1 + else if (aRegister.condition = regAbsolute) and + (aRegister.value = p_operand) and + (aRegister.lab = p_name) and + (longA = longI) then begin + p_opcode := m_tay; + p_mode := implied; + yRegister := aRegister; + end {else if} + else if (xRegister.condition = regAbsolute) and + (xRegister.value = p_operand) and + (xRegister.lab = p_name) then begin + p_opcode := m_txy; + p_mode := implied; + yRegister := xRegister; + end {else if} + else begin + yRegister.condition := regAbsolute; + yRegister.value := p_operand; + yRegister.lab := p_name; + yRegister.flags := p_flags; + end; {else} + end; + + m_ldy_dir: begin + if (yRegister.condition = regLocal) and + (yRegister.value = p_operand) then + goto 1 + else if (aRegister.condition = regLocal) and + (aRegister.value = p_operand) and + (longA = longI) then begin + p_opcode := m_tay; + p_mode := implied; + yRegister := aRegister; + end {else if} + else if (xRegister.condition = regLocal) and + (xRegister.value = p_operand) then begin + p_opcode := m_txy; + p_mode := implied; + yRegister := xRegister; + end {else if} + else begin + yRegister.condition := regLocal; + yRegister.value := p_operand; + yRegister.flags := p_flags; + end; {else} + end; + + m_ldy_imm: begin + if (yRegister.condition = regImmediate) and + (yRegister.value = p_operand) and + (yRegister.lab = p_name) and + (yRegister.flags = p_flags) then + goto 1 + else if (aRegister.condition = regImmediate) and + (aRegister.value = p_operand) and + (aRegister.flags = p_flags) and + (aRegister.lab = p_name) and + (longA = longI) then begin + p_opcode := m_tay; + p_mode := implied; + yRegister := aRegister; + end {else if} + else if (xRegister.condition = regImmediate) and + (xRegister.value = p_operand) and + (xRegister.lab = p_name) and + (xRegister.flags = p_flags) then begin + p_opcode := m_txy; + p_mode := implied; + yRegister := xRegister; + end {else if} + else begin + if (yRegister.condition = regImmediate) and + (yRegister.lab = p_name) and + (yRegister.flags = p_flags) then + if yRegister.value = (p_operand + 1) then begin + p_opcode := m_dey; + p_mode := implied; + yRegister.value := p_operand; + goto 2; + end {if} + else if yRegister.value = (p_operand - 1) then begin + p_opcode := m_iny; + p_mode := implied; + yRegister.value := p_operand; + goto 2; + end; {else if} + yRegister.condition := regImmediate; + yRegister.value := p_operand; + yRegister.flags := p_flags; + yRegister.lab := p_name; + end; {else} + end; + + m_tax: begin + if aRegister.condition <> regUnknown then + if aRegister.condition = xRegister.condition then + if aRegister.value = xRegister.value then + if aRegister.flags = xRegister.flags then + if aRegister.condition <> regAbsolute then + goto 1 + else if aRegister.lab = xRegister.lab then + goto 1; + xRegister := aRegister; + end; + + m_tay: begin + if aRegister.condition <> regUnknown then + if aRegister.condition = yRegister.condition then + if aRegister.value = yRegister.value then + if aRegister.flags = yRegister.flags then + if aRegister.condition <> regAbsolute then + goto 1 + else if aRegister.lab = yRegister.lab then + goto 1; + yRegister := aRegister; + end; + + m_txa: begin + if xRegister.condition <> regUnknown then + if xRegister.condition = aRegister.condition then + if xRegister.value = aRegister.value then + if xRegister.flags = aRegister.flags then + if xRegister.condition <> regAbsolute then + goto 1 + else if xRegister.lab = aRegister.lab then + goto 1; + aRegister := xRegister; + end; + + m_txy: begin + if xRegister.condition <> regUnknown then + if xRegister.condition = yRegister.condition then + if xRegister.value = yRegister.value then + if xRegister.flags = yRegister.flags then + if xRegister.condition <> regAbsolute then + goto 1 + else if xRegister.lab = yRegister.lab then + goto 1; + yRegister := xRegister; + end; + + m_tya: begin + if yRegister.condition <> regUnknown then + if yRegister.condition = aRegister.condition then + if yRegister.value = aRegister.value then + if yRegister.flags = aRegister.flags then + if yRegister.condition <> regAbsolute then + goto 1 + else if yRegister.lab = aRegister.lab then + goto 1; + aRegister := yRegister; + end; + + m_tyx: begin + if yRegister.condition <> regUnknown then + if yRegister.condition = xRegister.condition then + if yRegister.value = xRegister.value then + if yRegister.flags = xRegister.flags then + if yRegister.condition <> regAbsolute then + goto 1 + else if yRegister.lab = xRegister.lab then + goto 1; + xRegister := yRegister; + end; + end; {case} +2: +WriteNative(p_opcode, p_mode, p_operand, p_name, p_flags); +1: +end; {CheckRegisters} + + +procedure Remove (ns: integer); extern; + +{ Remove the instruction ns from the peephole array } +{ } +{ parameters: } +{ ns - index of the instruction to remove } + + +function Short (n, lab: integer): boolean; extern; + +{ see if a label is within range of a one-byte relative branch } +{ } +{ parameters: } +{ n - index to branch instruction } +{ lab - label number } + +{--------------------------------------------------------------------------} + +procedure EndSeg; + +{ close out the current segment } + +var + i: integer; + +begin {EndSeg} +Purge; {dump constant buffer} +if stringsize <> 0 then begin {define string space} + UpDate(maxLabel, pc); {define the local label for the string space} + for i := 1 to stringsize do + CnOut(ord(stringspace[i])); + Purge; + end; {if} +Out(0); {end the segment} +segDisp := 8; {update header} +Out2(long(pc).lsw); +Out2(long(pc).msw); +blkcnt := blkcnt-4; {purge the segment to disk} +segDisp := blkcnt; +CloseSeg; +end; {EndSeg} + + +procedure GenNative {p_opcode: integer; p_mode: addressingMode; + p_operand: integer; p_name: stringPtr; p_flags: integer}; + +{ write a native code instruction to the output file } +{ } +{ parameters: } +{ p_opcode - native op code } +{ p_mode - addressing mode } +{ p_operand - integer operand } +{ p_name - named operand } +{ p_flags - operand modifier flags } + +var + done: boolean; {loop termination} + llongA: boolean; {for tracking A size during opt.} + i: integer; {index} + op: integer; {temp storage for opcode} + + + procedure Purge; + + { Empty the peephole array } + + begin {Purge} + while nnextSpot > 1 do begin + if registers then + CheckRegisters(npeep[1].opcode, npeep[1].mode, npeep[1].operand, + npeep[1].name, npeep[1].flags) + else + WriteNative(npeep[1].opcode, npeep[1].mode, npeep[1].operand, + npeep[1].name, npeep[1].flags); + Remove(1); + end; {while} + end; {Purge} + + + procedure Optimize(ns: integer; longA: boolean); + + { Optimize the instruction starting at ns } + { } + { parameters: } + { ns - index of instruction to check for optimization } + { longA - is the accumulator long? } + + label 1; + + var + tn: nativeType; {temp operation} + + + function ASafe (ns: integer): boolean; + + { See if it is safe to skip loading the A register } + { } + { parameters: } + { ns - starting index } + + label 1; + + var + i: integer; {loop variable} + opcode: integer; {copy of current op code} + + begin {ASafe} + ASafe := false; + for i := ns to nnextSpot-1 do begin + opcode := npeep[i].opcode; + if opcode in + [m_bcc,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_bra,m_brl,m_bvs,m_jml,m_jsl, + m_lda_abs,m_lda_absx,m_lda_dir,m_lda_dirx,m_lda_imm,m_lda_indl, + m_lda_indly,m_lda_long,m_lda_longx,m_lda_s,m_mvn,m_pla,m_rtl, + m_rts,m_tdc,m_txa,m_tya,m_tsc,d_end,d_bmov,d_add,d_pin,d_wrd, + d_sym,d_cns] then begin + ASafe := true; + goto 1; + end {if} + else if opcode in + [m_adc_abs,m_adc_dir,m_adc_imm,m_adc_s,m_and_abs,m_and_dir, + m_and_imm,m_and_s,m_asl_a,m_cmp_abs,m_cmp_dir,m_cmp_dirX,m_cmp_imm, + m_cmp_long,m_cmp_s,m_dea,m_eor_abs,m_eor_dir,m_eor_imm,m_eor_s, + m_ina,m_lda_abs,m_lda_absx,m_lda_dir,m_lda_dirx,m_lda_imm, + m_lda_indl,m_lda_indly,m_lda_long,m_lda_longx,m_lda_s,m_lsr_a, + m_ora_abs,m_ora_dir,m_ora_dirX,m_ora_imm,m_ora_longX,m_ora_s, + m_pha,m_sbc_abs,m_sbc_dir,m_sbc_imm,m_sbc_s,m_sta_abs,m_sta_absX, + m_sta_dir,m_sta_dirX,m_sta_indl,m_sta_indlY,m_sta_long,m_sta_longX, + m_sta_s,m_tax,m_tay,m_tcd,m_tcs,m_xba,m_tsb_dir,m_tsb_abs] then + goto 1; + end; {for} +1: + end; {ASafe} + + + function SignExtension (ns: integer): boolean; + + { See if the pattern is a sugn extension } + { } + { Parameters: } + { ns - start of suspected pattern } + { } + { Returns: true for a sign extension, else false } + + begin {SignExtension} + SignExtension := false; + if npeep[ns].opcode = m_ldx_imm then + if npeep[ns].operand = 0 then + if npeep[ns+1].opcode = m_tay then + if npeep[ns+2].opcode = m_bpl then + if npeep[ns+3].opcode = m_dex then + SignExtension := true; + end; {SignExtension} + + + begin {Optimize} + with npeep[ns] do + case opcode of + + m_and_imm: + if npeep[ns+1].opcode = m_and_imm then begin + operand := operand & npeep[ns+1].operand; + Remove(ns+1); + end; {if} + + m_asl_a: + if npeep[ns+1].opcode = m_tay then + if npeep[ns+2].opcode = m_iny then + if npeep[ns+3].opcode = m_iny then begin + opcode := m_ina; + npeep[ns+1].opcode := m_asl_a; + npeep[ns+2].opcode := m_tay; + Remove(ns+3); + end; {if} + + m_bcs,m_beq,m_bne,m_bmi,m_bpl,m_bcc: + if npeep[ns+2].opcode = d_lab then + if npeep[ns+2].operand = operand then + if npeep[ns+1].opcode = m_brl then begin + if Short(ns,npeep[ns+1].operand) then begin + operand := npeep[ns+1].operand; + Remove(ns+1); + if opcode = m_bcs then + opcode := m_bcc + else if opcode = m_beq then + opcode := m_bne + else if opcode = m_bne then + opcode := m_beq + else if opcode = m_bmi then + opcode := m_bpl + else if opcode = m_bcc then + opcode := m_bcs + else + opcode := m_bmi; + end; {if} + end {if m_brl} + else if npeep[ns+1].opcode = m_bra then begin + operand := npeep[ns+1].operand; + Remove(ns+1); Remove(ns+1); + if opcode = m_bcs then + opcode := m_bcc + else if opcode = m_beq then + opcode := m_bne + else if opcode = m_bne then + opcode := m_beq + else if opcode = m_bmi then + opcode := m_bpl + else if opcode = m_bcc then + opcode := m_bcs + else + opcode := m_bmi; + end; {else if m_bra} + + m_brl: + if Short(ns,operand) then begin + opcode := m_bra; + mode := relative; + didOne := true; + end; {if} + + m_bvs: + if npeep[ns+2].opcode = d_lab then + if npeep[ns+2].operand = operand then + if npeep[ns+1].opcode = m_bmi then + if npeep[ns+4].opcode = d_lab then + if npeep[ns+1].operand = npeep[ns+4].operand then + if npeep[ns+3].opcode = m_brl then + if Short(ns,npeep[ns+3].operand) then + if Short(ns+1,npeep[ns+3].operand) then begin + operand := npeep[ns+3].operand; + npeep[ns+1].operand := npeep[ns+3].operand; + npeep[ns+1].opcode := m_bpl; + Remove(ns+3); + end; {if} + + m_dec_abs: + if npeep[ns+1].opcode = m_lda_abs then + if name^ = npeep[ns+1].name^ then + if npeep[ns+2].opcode = m_beq then + Remove(ns+1); + + m_lda_abs: + if npeep[ns+1].opcode = m_clc then begin + if npeep[ns+2].opcode = m_adc_abs then + if operand = npeep[ns+2].operand then + if name = npeep[ns+2].name then + if not rangeCheck then begin + npeep[ns+1].opcode := m_asl_a; + Remove(ns+2); + end; {if} + end {if} + else if npeep[ns+1].opcode = m_dea then begin + if npeep[ns+2].opcode = m_tax then begin + opcode := m_ldx_abs; + npeep[ns+1].opcode := m_dex; + Remove(ns+2); + end; {if} + end {else if} + else if npeep[ns+2].opcode = m_sta_abs then begin + if npeep[ns+1].opcode in [m_ora_dir,m_ora_abs,m_ora_dirX, + m_ora_imm,m_ora_longX,m_ora_s] then + if operand = npeep[ns+2].operand then + if name = npeep[ns+2].name then begin + npeep[ns+1].opcode := npeep[ns+1].opcode + $00A0; + npeep[ns+2].opcode := m_tsb_abs; + Remove(ns); + end; {if} + end {else if} + else if SignExtension(ns+1) then begin + npeep[ns+2] := npeep[ns]; + Remove(ns); + end {else if} + else if npeep[ns+1].opcode = m_xba then + if npeep[ns+2].opcode = m_and_imm then + if npeep[ns+2].operand = $00FF then begin + operand := operand+1; + Remove(ns+1); + end; {if} + + m_lda_dir: + if npeep[ns+1].opcode = m_clc then begin + if npeep[ns+2].opcode = m_adc_dir then + if operand = npeep[ns+2].operand then + if not rangeCheck then begin + npeep[ns+1].opcode := m_asl_a; + Remove(ns+2); + end; {if} + end + else if npeep[ns+1].opcode = m_dea then begin + if npeep[ns+2].opcode = m_tax then begin + opcode := m_ldx_dir; + npeep[ns+1].opcode := m_dex; + Remove(ns+2); + end; {if} + end {else if} + else if npeep[ns+1].opcode = m_pha then begin + if longA then begin + opcode := m_pei_dir; + Remove(ns+1); + end {if} + end {else if} + else if npeep[ns+2].opcode = m_sta_dir then begin + if npeep[ns+1].opcode in [m_ora_dir,m_ora_abs,m_ora_dirX, + m_ora_imm,m_ora_longX,m_ora_s] then + if operand = npeep[ns+2].operand then begin + npeep[ns+1].opcode := npeep[ns+1].opcode + $00A0; + npeep[ns+2].opcode := m_tsb_dir; + Remove(ns); + end {if} + end {else if} + else if SignExtension(ns+1) then begin + npeep[ns+2] := npeep[ns]; + Remove(ns); + end {else if} + else if npeep[ns+1].opcode = m_xba then + if npeep[ns+2].opcode = m_and_imm then + if npeep[ns+2].operand = $00FF then begin + operand := operand+1; + Remove(ns+1); + end; {if} + + m_pei_dir: + if npeep[ns+1].opcode = m_pla then begin + opcode := m_lda_dir; + Remove(ns+1); + end; {if} + + m_lda_imm: + if npeep[ns+1].opcode = m_pha then + if ASafe(ns+2) then + if longA then begin + opcode := m_pea; + Remove(ns+1); + end; {if} + + m_ldx_imm: + if npeep[ns+1].opcode = m_lda_imm then + if npeep[ns+2].opcode = m_phx then + if npeep[ns+3].opcode = m_pha then begin + opcode := m_pea; + npeep[ns+1].opcode := m_pea; + Remove(ns+2); + Remove(ns+2); + end; {if} + + m_ldy_imm: + if npeep[ns+1].opcode = m_sep then + if npeep[ns+1].operand = 32 then begin + didOne := true; + tn := npeep[ns]; + npeep[ns] := npeep[ns+1]; + npeep[ns+1] := tn; + end; {if} + + m_ora_abs: + if npeep[ns+1].opcode = m_sta_abs then + if operand = npeep[ns+1].operand then + if name = npeep[ns+1].name then begin + opcode := m_tsb_abs; + Remove(ns+1); + end; {if} + + m_ora_dir: + if npeep[ns+1].opcode = m_sta_dir then + if operand = npeep[ns+1].operand then begin + opcode := m_tsb_dir; + Remove(ns+1); + end; {if} + + m_pea: + if npeep[ns+1].opcode = m_pla then begin + opcode := m_lda_imm; + Remove(ns+1); + end; {if} + + m_sta_abs: + if npeep[ns+1].opcode = m_lda_abs then + if operand = npeep[ns+1].operand then + if name = npeep[ns+1].name then + if not (npeep[ns+2].opcode in + [m_bcc,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_bvs]) then + Remove(ns+1); + + m_sta_dir: + if npeep[ns+1].opcode = m_lda_dir then + if operand = npeep[ns+1].operand then + if not (npeep[ns+2].opcode in + [m_bcc,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_bvs]) then + Remove(ns+1); + + m_plb: + if npeep[ns+1].opcode = m_phb then begin + Remove(ns); + Remove(ns); + end; {if} + + m_plx: + if npeep[ns+1].opcode = m_pha then begin + opcode := m_sta_s; + mode := direct; + operand := 1; + Remove(ns+1); + end; {if} + + m_tax: + if npeep[ns+1].opcode = m_phx then begin + Remove(ns+1); + opcode := m_pha; + end {if} + else if npeep[ns+1].opcode = m_txa then begin + if not (npeep[ns+2].opcode in + [m_bcc,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_bvs]) then begin + Remove(ns); + Remove(ns); + end; {if} + end {else if} + else if npeep[ns+1].opcode = m_dey then + if npeep[ns+2].opcode = m_dey then + if npeep[ns+3].opcode = m_lda_indly then + if npeep[ns+4].opcode = m_stx_dir then begin + npeep[ns] := npeep[ns+4]; + opcode := m_sta_dir; + Remove(ns+4); + end; {if} + + m_tya: + if npeep[ns+1].opcode = m_sta_dir then begin + npeep[ns+1].opcode := m_sty_dir; + Remove(ns); + end {if} + else if npeep[ns+1].opcode = m_sta_abs then begin + npeep[ns+1].opcode := m_sty_abs; + Remove(ns); + end; {else if} + + m_tyx: + if npeep[ns+1].opcode = m_phx then begin + Remove(ns+1); + opcode := m_phy; + end; {if} + + m_pha: + if npeep[ns+1].opcode = m_pla then begin + Remove(ns); + Remove(ns); + end {if} + else if npeep[ns+1].opcode in [m_ldx_abs,m_ldx_dir] then + if npeep[ns+2].opcode = m_pla then begin + Remove(ns+2); + Remove(ns); + end; {if} + + m_phy: + if npeep[ns+1].opcode = m_ply then begin + Remove(ns); + Remove(ns); + end; {if} + + m_rep: + if npeep[ns+1].opcode = m_sep then + if npeep[ns].operand = npeep[ns+1].operand then begin + Remove(ns); + Remove(ns); + end; {if} + + otherwise: ; + + end; {case} +1: + end; {Optimize} + +begin {GenNative} +{ writeln('GenNative: ',p_opcode:4, ', mode=', ord(p_mode):1, + ' operand=', p_operand:1); {debug} +if npeephole then begin + if (nnextspot = 1) and not (p_opcode in nleadOpcodes) then begin + if p_opcode <> d_end then + if registers then + CheckRegisters(p_opcode, p_mode, p_operand, p_name, p_flags) + else + WriteNative(p_opcode, p_mode, p_operand, p_name, p_flags); + end {if} + else if p_opcode in nstopOpcodes then begin + repeat + didOne := false; + i := 1; + llongA := longA; + while i < nnextSpot-nMaxPeep do begin + op := npeep[i].opcode; + if op = m_sep then begin + if npeep[i].operand & $20 <> 0 then + llongA := false; + end {if} + else if op = m_rep then begin + if npeep[i].operand & $20 <> 0 then + llongA := true; + end; {else} + Optimize(i,llongA); + i := i+1; + end; {while} + until not didone; + Purge; + if p_opcode <> d_end then + if registers then + CheckRegisters(p_opcode, p_mode, p_operand, p_name, p_flags) + else + WriteNative(p_opcode, p_mode, p_operand, p_name, p_flags); + end {else if} + else if nnextSpot = npeepSize then begin + repeat + didOne := false; + i := 1; + llongA := longA; + while i < nnextSpot-nMaxPeep do begin + op := npeep[i].opcode; + if op = m_sep then begin + if npeep[i].operand & $20 <> 0 then + llongA := false; + end {if} + else if op = m_rep then begin + if npeep[i].operand & $20 <> 0 then + llongA := true; + end; {else} + Optimize(i,llongA); + i := i+1; + end; {while} + until not didone; + done := false; + repeat + if nnextSpot = 1 then + done := true + else begin + if npeep[1].opcode in nleadOpcodes then + done := true + else begin + if registers then + CheckRegisters(nPeep[1].opcode, nPeep[1].mode, + nPeep[1].operand, nPeep[1].name, nPeep[1].flags) + else + WriteNative(nPeep[1].opcode, nPeep[1].mode, nPeep[1].operand, + nPeep[1].name,nPeep[1].flags); + Remove(1); + end; {else} + end; {else} + until done; + if nnextSpot = nPeepSize then begin + if registers then + CheckRegisters(nPeep[1].opcode, nPeep[1].mode, nPeep[1].operand, + nPeep[1].name, nPeep[1].flags) + else + WriteNative(nPeep[1].opcode, nPeep[1].mode, nPeep[1].operand, + nPeep[1].name, nPeep[1].flags); + Remove(1); + end; {if} + with npeep[nnextSpot] do begin + opcode := p_opcode; + mode := p_mode; + operand := p_operand; + name := p_name; + flags := p_flags; + end; {with} + nnextSpot := nnextSpot+1; + if not (npeep[1].opcode in nleadOpcodes) then begin + if registers then + CheckRegisters(nPeep[1].opcode, nPeep[1].mode, nPeep[1].operand, + nPeep[1].name, nPeep[1].flags) + else + WriteNative(nPeep[1].opcode, nPeep[1].mode, nPeep[1].operand, + nPeep[1].name, nPeep[1].flags); + Remove(1); + end; {if} + end {else if} + else begin + with npeep[nnextSpot] do begin + opcode := p_opcode; + mode := p_mode; + operand := p_operand; + name := p_name; + flags := p_flags; + end; {with} + nnextSpot := nnextSpot+1; + end; {else} + end {if} +else if p_opcode <> d_end then + if registers then + CheckRegisters(p_opcode, p_mode, p_operand, p_name, p_flags) + else + WriteNative(p_opcode, p_mode, p_operand, p_name, p_flags); +end; {GenNative} + + +procedure GenImplied {p_opcode: integer}; + +{ short form of GenNative - reduces code size } +{ } +{ parameters: } +{ p_code - operation code } + +begin {GenImplied} +GenNative(p_opcode, implied, 0, nil, 0); +end; {GenImplied} + + +procedure GenCall {callNum: integer}; + +{ short form of jsl to library subroutine - reduces code size } +{ } +{ parameters: } +{ callNum - subroutine # to generate a call for } + +var + sp: stringPtr; {work string} + +begin {GenCall} +case callNum of + 1: sp := @'~CHECKSTACK'; + 2: sp := @'~RESETNAME'; + 3: sp := @'~CREALRET'; + 4: sp := @'~CDOUBLERET'; + 5: sp := @'~SETNAME'; + 6: sp := @'~SETLINENUMBER'; + 7: sp := @'~REALFN'; + 8: sp := @'~DOUBLEFN'; + 9: sp := @'~SAVEREAL'; + 10: sp := @'~SAVEDOUBLE'; + 11: sp := @'~CNVINTREAL'; + 12: sp := @'~CNVLONGREAL'; + 13: sp := @'~CNVULONGREAL'; + 14: sp := @'~CNVREALINT'; + 15: sp := @'~CNVREALUINT'; + 16: sp := @'~CNVREALLONG'; + 17: sp := @'~CNVREALULONG'; + 18: sp := @'~CNVL2'; {PASCAL} + 19: sp := @'~SAVESET'; + 20: sp := @'~LOADSET'; {PASCAL} + 21: sp := @'~LOADREAL'; + 22: sp := @'~LOADDOUBLE'; + 23: sp := @'~SHIFTLEFT'; + 24: sp := @'~SSHIFTRIGHT'; + 25: sp := @'~INTCHKC'; + 26: sp := @'~DIV2'; + 27: sp := @'~MOD2'; + 28: sp := @'~MUL2'; + 29: sp := @'~GRTL'; + 30: sp := @'~GEQL'; + 31: sp := @'~GRTE'; + 32: sp := @'~GEQE'; + 33: sp := @'~SETINCLUSION'; + 34: sp := @'~GRTSTRING'; + 35: sp := @'~GEQSTRING'; + 36: sp := @'~EQUE'; + 37: sp := @'~SETEQU'; + 38: sp := @'~EQUSTRING'; + 39: sp := @'~UMUL2'; + 40: sp := @'~UDIV2'; + 41: sp := @'~USHIFTRIGHT'; + 42: sp := @'~MUL4'; + 43: sp := @'~PDIV4'; + 44: sp := @'~MOD4'; + 45: sp := @'~SHL4'; + 46: sp := @'~LSHR4'; + 47: sp := @'~ASHR4'; {CC} + 48: sp := @'~UMUL4'; {CC} + 49: sp := @'~UDIV4'; {CC} + 50: sp := @'~UMOD4'; {CC} + 51: sp := @'~COPYREAL'; + 52: sp := @'~COPYDOUBLE'; + 53: sp := @'~XJPERROR'; + 54: sp := @'~MOVE'; + 55: sp := @'~MOVE2'; + 56: sp := @'~ADDE'; + 57: sp := @'~DIVE'; + 58: sp := @'~MULE'; + 59: sp := @'~SUBE'; + 60: sp := @'~POWER'; + 61: sp := @'~ARCTAN2E'; + 62: sp := @'~LONGMOVE'; + 63: sp := @'~LONGMOVE2'; + 64: sp := @'~CCOMPRET'; + 65: sp := @'~CEXTENDEDRET'; + 66: sp := @'~SAVECOMP'; + 67: sp := @'~SAVEEXTENDED'; + 68: sp := @'~COPYCOMP'; + 69: sp := @'~COPYEXTENDED'; + 70: sp := @'~LOADCOMP'; + 71: sp := @'~LOADEXTENDED'; + 72: sp := @'~LOADUBF'; + 73: sp := @'~LOADBF'; + 74: sp := @'~SAVEBF'; + 75: sp := @'~COPYBF'; + 76: sp := @'~STACKERR'; {CC} + 77: sp := @'~LOADSTRUCT'; {CC} + otherwise: + Error(cge1); + end; {case} +GenNative(m_jsl, longabs, 0, sp, 0); +end; {GenCall} + + +procedure GenLab {lnum: integer}; + +{ generate a label } +{ } +{ parameters: } +{ lnum - label number } + +begin {GenLab} +GenNative(d_lab, gnrlabel, lnum, nil, 0); +end; {GenLab} + + +procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: boolean}; + +{ Set up the object file } +{ } +{ parameters: } +{ keepName - name of the output file } +{ keepFlag - keep status: } +{ 0 - don't keep the output } +{ 1 - create a new object module } +{ 2 - a .root already exists } +{ 3 - at least on .letter file exists } +{ partial - is this a partial compile? } +{ } +{ Note: Declared as extern in CGI.pas } + + + procedure RootFile; + + { Create and write the initial entry segment } + + const + dispToOpen = 21; {disps to glue routines for NDAs} + dispToClose = 38; + dispToAction = 50; + dispToInit = 65; + dispToCDAOpen = 9; {disps to glue routines for CDAs} + dispToCDAClose = 36; + + var + i: integer; {loop index} + lab: stringPtr; {for holdling names var pointers} + menuLen: integer; {length of the menu name string} + + + procedure SetDataBank; + + { set up the data bank register } + + begin {SetDataBank} + CnOut(m_pea); + RefName(@'~GLOBALS', 0, 2, -8); + CnOut(m_plb); + CnOut(m_plb); + end; {SetDataBank} + + + begin {RootFile} + {open the initial object module} + fname2.theString.theString := concat(fname1.theString.theString, '.root'); + fname2.theString.size := length(fname2.theString.theString); + OpenObj(fname2); + + {write the header} + Header(@'~_ROOT', $4000, 0); + + {new desk accessory initialization} + if isNewDeskAcc then begin + + {set up the initial jump table} + lab := @'~_ROOT'; + menuLen := length(menuLine); + RefName(lab, menuLen + dispToOpen, 4, 0); + RefName(lab, menuLen + dispToClose, 4, 0); + RefName(lab, menuLen + dispToAction, 4, 0); + RefName(lab, menuLen + dispToInit, 4, 0); + CnOut2(refreshPeriod); + CnOut2(eventMask); + for i := 1 to menuLen do + CnOut(ord(menuLine[i])); + CnOut(0); + + {glue code for calling open routine} + CnOut(m_phb); + SetDataBank; + CnOut(m_jsl); + RefName(openName, 0, 3, 0); + CnOut(m_plb); + CnOut(m_sta_s); CnOut(4); + CnOut(m_txa); + CnOut(m_sta_s); CnOut(6); + CnOut(m_rtl); + + {glue code for calling close routine} + CnOut(m_phb); + SetDataBank; + CnOut(m_jsl); + RefName(closeName, 0, 3, 0); + CnOut(m_plb); + CnOut(m_rtl); + + {glue code for calling action routine} + CnOut(m_phb); + SetDataBank; + CnOut(m_pha); + CnOut(m_phy); + CnOut(m_phx); + CnOut(m_jsl); + RefName(actionName, 0, 3, 0); + CnOut(m_plb); + CnOut(m_rtl); + + {glue code for calling init routine} + CnOut(m_pha); + CnOut(m_jsl); + RefName(@'~DAID', 0, 3, 0); + CnOut(m_phb); + SetDataBank; + CnOut(m_pha); + CnOut(m_jsl); + RefName(initName, 0, 3, 0); + CnOut(m_plb); + CnOut(m_rtl); + end + + {classic desk accessory initialization} + else if isClassicDeskAcc then begin + + {write the name} + menuLen := length(menuLine); + CnOut(menuLen); + for i := 1 to menuLen do + CnOut(ord(menuLine[i])); + + {set up the initial jump table} + lab := @'~_ROOT'; + RefName(lab, menuLen + dispToCDAOpen, 4, 0); + RefName(lab, menuLen + dispToCDAClose, 4, 0); + + {glue code for calling open routine} + CnOut(m_pea); + CnOut2(1); + CnOut(m_jsl); + RefName(@'~DAID', 0, 3, 0); + CnOut(m_phb); + SetDataBank; + CnOut(m_jsl); + RefName(@'~CDASTART', 0, 3, 0); + CnOut(m_jsl); + RefName(openName,0,3,0); + CnOut(m_jsl); + RefName(@'~CDASHUTDOWN', 0, 3, 0); + CnOut(m_plb); + CnOut(m_rtl); + + {glue code for calling close routine} + CnOut(m_phb); + SetDataBank; + CnOut(m_jsl); + RefName(closeName, 0, 3, 0); + CnOut(m_pea); + CnOut2(0); + CnOut(m_jsl); + RefName(@'~DAID', 0, 3, 0); + CnOut(m_plb); + CnOut(m_rtl); + end + + {control panel device initialization} + else if isCDev then begin + CnOut(m_pea); + CnOut2(1); + CnOut(m_jsl); + RefName(@'~DAID', 0, 3, 0); + CnOut(m_phb); + SetDataBank; + CnOut(m_pla); + CnOut(m_sta_s); CnOut(13); + CnOut(m_pla); + CnOut(m_sta_s); CnOut(13); + CnOut(m_jsl); + RefName(openName,0,3,0); + CnOut(m_tay); + CnOut(m_lda_s); CnOut(3); + CnOut(m_pha); + CnOut(m_lda_s); CnOut(3); + CnOut(m_pha); + CnOut(m_txa); + CnOut(m_sta_s); CnOut(7); + CnOut(m_tya); + CnOut(m_sta_s); CnOut(5); + CnOut(m_plb); + CnOut(m_rtl); + end + + {NBA initialization} + else if isNBA then begin + CnOut(m_jsl); + RefName(@'~NBASTARTUP', 0, 3, 0); + CnOut(m_phx); + CnOut(m_phy); + CnOut(m_jsl); + RefName(openName,0,3,0); + CnOut(m_jsl); + RefName(@'~NBASHUTDOWN', 0, 3, 0); + CnOut(m_rtl); + end + + {XCMD initialization} + else if isXCMD then begin + CnOut(m_jsl); + RefName(@'~XCMDSTARTUP', 0, 3, 0); + CnOut(m_jsl); + RefName(openName,0,3,0); + CnOut(m_jsl); + RefName(@'~XCMDSHUTDOWN', 0, 3, 0); + CnOut(m_rtl); + end + + {normal program initialization} + else begin + + {write the initial JSL} + CnOut(m_jsl); + if rtl then + RefName(@'~_BWSTARTUP4', 0, 3, 0) + else + RefName(@'~_BWSTARTUP3', 0, 3, 0); + + {set the data bank register} + SetDataBank; + + {write JSL to main entry point} + CnOut(m_jsl); + if rtl then + RefName(@'~C_STARTUP2', 0, 3, 0) + else + RefName(@'~C_STARTUP', 0, 3, 0); + CnOut(m_jsl); + RefName(@'main', 0, 3, 0); + CnOut(m_jsl); + if rtl then + RefName(@'~C_SHUTDOWN2', 0, 3, 0) + else + RefName(@'~C_SHUTDOWN', 0, 3, 0); + end; + + {finish the current segment} + EndSeg; + end; {RootFile} + + + procedure SetStack; + + { Set up a stack frame } + + begin {SetStack} + if stackSize <> 0 then begin + currentSegment := '~_STACK '; {write the header} + Header(@'~_STACK', $4012, 0); + currentSegment := defaultSegment; + Out($F1); {write the DS record to reserve space} + Out2(stackSize); + Out2(0); + EndSeg; {finish the current segment} + end; {if} + end; {SetStack} + + +begin {InitFile} +fname1 := keepname^; +if partial or (keepFlag = 3) then + FindSuffix(fname1, nextSuffix) +else begin + if (keepFlag = 1) and (not noroot) then begin + RootFile; + SetStack; + CloseObj; + end; {if} + DestroySuffixes(fname1); + nextSuffix := 'a'; + end; {else} +fname2.theString.theString := concat(fname1.theString.theString, '.', nextSuffix); +fname2.theString.size := length(fname2.theString.theString); +OpenObj(fname2); +end; {InitFile} + + +procedure InitNative; + +{ set up for a new segment } + +begin {InitNative} +aRegister.condition := regUnknown; {set up the peephole optimizer} +xRegister.condition := regUnknown; +yRegister.condition := regUnknown; +nnextspot := 1; +nleadOpcodes := [m_asl_a,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_brl,m_bvs,m_bcc, + m_dec_abs,m_lda_abs,m_lda_dir,m_lda_imm,m_ldx_imm,m_sta_abs,m_sta_dir, + m_pha,m_plb,m_plx,m_tax,m_tya,m_tyx,m_phy,m_pei_dir,m_ldy_imm,m_rep, + m_ora_dir,m_ora_abs,m_and_imm,m_pea]; +nstopOpcodes := [d_end,d_pin]; + +stringSize := 0; {initialize scalars for a new segment} +pc := 0; +cbufflen := 0; +longA := true; +longI := true; +end; {InitNative} + + +procedure RefName {lab: stringPtr; disp, len, shift: integer}; + +{ handle a reference to a named label } +{ } +{ parameters: } +{ lab - label name } +{ disp - displacement past the label } +{ len - number of bytes in the reference } +{ shift - shift factor } + +var + i: integer; {loop var} + slen: integer; {length of string} + +begin {RefName} +Purge; {clear any constant bytes} +if isJSL then {expression header} + Out(243) +else + Out(235); +Out(len); +Out(131); +pc := pc+len; +slen := length(lab^); +Out(slen); +for i := 1 to slen do + Out(ord(lab^[i])); +if disp <> 0 then begin {if there is a disp, add it in} + Out(129); + Out2(disp); + Out2(0); + Out(1); + end; {end} +if shift <> 0 then begin {if there is a shift, add it in} + Out(129); + Out2(shift); + if shift < 0 then + Out2(-1) + else + Out2(0); + Out(7); + end; {if} +Out(0); {end of expression} +end; {RefName} + +end. + +{$append 'native.asm'} diff --git a/Native2.pas b/Native2.pas old mode 100755 new mode 100644 index 71aa9d1..78ee1ab --- a/Native2.pas +++ b/Native2.pas @@ -1 +1,1241 @@ -{$optimize 7} {---------------------------------------------------------------} { } { ORCA Native Code Generation } { } { This module of the code generator is called to generate } { native code instructions. The native code is optimized } { and written to the object segment. } { } { Externally available procedures: } { } { EndSeg - close out the current segment } { GenNative - write a native code instruction to the output } { file } { GenImplied - short form of GenNative - reduces code size } { GenCall - short form of jsl to library subroutine - reduces } { code size } { GenLab - generate a label } { InitFile - Set up the object file } { InitNative - set up for a new segment } { RefName - handle a reference to a named label } { } {---------------------------------------------------------------} unit Native; interface {$LibPrefix '0/obj/'} uses CCommon, CGI, CGC, ObjOut; {$segment 'CodeGen'} type labelptr = ^labelentry; {pointer to a forward ref node} labelentry = record {forward ref node} addr: integer; next: labelptr; end; labelrec = record {label record} defined: boolean; {Note: form used in objout.asm} chain: labelptr; case boolean of true : (val: longint); false: (ival,hval: integer); end; var {current instruction info} {------------------------} pc: longint; {program counter} {65816 native code generation} {----------------------------} didOne: boolean; {has an optimization been done?} labeltab: array[0..maxlabel] of labelrec; {label table} localLabel: array[0..maxLocalLabel] of integer; {local variable label table} {---------------------------------------------------------------} procedure EndSeg; { close out the current segment } procedure GenNative (p_opcode: integer; p_mode: addressingMode; p_operand: integer; p_name: stringPtr; p_flags: integer); { write a native code instruction to the output file } { } { parameters: } { p_opcode - native op code } { p_mode - addressing mode } { p_operand - integer operand } { p_name - named operand } { p_flags - operand modifier flags } procedure GenImplied (p_opcode: integer); { short form of GenNative - reduces code size } { } { parameters: } { p_code - operation code } procedure GenCall (callNum: integer); { short form of jsl to library subroutine - reduces code size } { } { parameters: } { callNum - subroutine # to generate a call for } procedure GenLab (lnum: integer); { generate a label } { } { parameters: } { lnum - label number } procedure InitFile (keepName: gsosOutStringPtr; keepFlag: integer; partial: boolean); { Set up the object file } { } { parameters: } { keepName - name of the output file } { keepFlag - keep status: } { 0 - don't keep the output } { 1 - create a new object module } { 2 - a .root already exists } { 3 - at least on .letter file exists } { partial - is this a partial compile? } { } { Note: Declared as extern in CGI.pas } procedure InitNative; { set up for a new segment } procedure LabelSearch (lab: integer; len, shift, disp: integer); { resolve a label reference } { } { parameters: } { lab - label number } { len - # bytes for the generated code } { shift - shift factor } { disp - disp past the label } { } { Note 1: maxlabel is reserved for use as the start of the } { string space } { Note 2: negative length indicates relative branch } { Note 3: zero length indicates 2 byte addr -1 } procedure RefName (lab: stringPtr; disp, len, shift: integer); { handle a reference to a named label } { } { parameters: } { lab - label name } { disp - displacement past the label } { len - number of bytes in the reference } { shift - shift factor } {--------------------------------------------------------------------------} implementation const npeepSize = 128; {native peephole optimizer window size} nMaxPeep = 4; {max # instructions needed to opt.} type {65816 native code generation} {----------------------------} npeepRange = 1..npeepsize; {subrange for native code peephole opt.} nativeType = record {native code instruction} opcode: integer; {op code} mode: addressingMode; {addressing mode} operand: integer; {operand value} name: stringPtr; {operand label} flags: integer; {modifier flags} end; registerConditions = (regUnknown,regImmediate,regAbsolute,regLocal); registerType = record {used to track register contents} condition: registerConditions; value: integer; lab: stringPtr; flags: integer; end; var {I/O files} {---------} fname1, fname2: gsosOutString; {file names} nextSuffix: char; {next suffix character to use} procedure GenSymbols (sym: ptr; doGlobals: integer); extern; { generate the symbol table } {--------------------------------------------------------------------------} procedure LabelSearch {lab: integer; len, shift, disp: integer}; { resolve a label reference } { } { parameters: } { lab - label number } { len - # bytes for the generated code } { shift - shift factor } { disp - disp past the label } { } { Note 1: maxlabel is reserved for use as the start of the } { string space } { Note 2: negative length indicates relative branch } { Note 3: zero length indicates 2 byte addr -1 } var next: labelptr; {work pointer} begin {LabelSearch} if labeltab[lab].defined and (len < 0) and (shift = 0) and (disp = 0) then begin {handle a relative branch to a known disp} if len = -1 then CnOut(labeltab[lab].ival - long(pc).lsw - cbufflen + len) else CnOut2(labeltab[lab].ival - long(pc).lsw - cbufflen + len); end {if} else begin if lab <> maxlabel then begin {handle a normal label reference} Purge; {empty the constant buffer} if len < 0 then begin len := -len; {generate a RELEXPR} Out(238); Out(len); Out2(len); Out2(0); end {if} else begin if isJSL then {generate a standard EXPR} Out(243) else Out(235); if len = 0 then Out(2) else Out(len); end; {else} end; {if} Out(135); {generate a relative offset from the seg. start} if not labeltab[lab].defined then begin next := pointer(Malloc(sizeof(labelEntry))); {value unknown: create a reference} next^.next := labeltab[lab].chain; labeltab[lab].chain := next; next^.addr := blkcnt; Out2(0); Out2(0); end {if} else {labeltab[lab].defined} begin Out2(labeltab[lab].ival); {value known: write it} Out2(labeltab[lab].hval); end; {else} if len = 0 then begin Out(129); {subtract 1 from addr} Out2(1); Out2(0); Out(2); len := 2; end; {if} if disp <> 0 then begin Out(129); {add in the displacement} Out2(disp); if disp < 0 then Out2(-1) else Out2(0); Out(1); end; {if} if shift <> 0 then begin Out(129); {shift the address} Out2(-shift); Out2(-1); Out(7); end; {if} if lab <> maxlabel then {if not a string, end the expression} Out(0); pc := pc+len; {update the pc} end; {else} end; {LabelSearch} procedure UpDate (lab: integer; labelValue: longint); { define a label } { } { parameters: } { lab - label number } { labelValue - displacement in seg where label is located } var next,temp: labelptr; {work pointers} begin {UpDate} if labeltab[lab].defined then Error(cge1) else begin {define the label for future references} with labeltab[lab] do begin defined := true; val := labelValue; next := chain; end; {with} {resolve any forward references} if next <> nil then begin Purge; while next <> nil do begin segdisp := next^.addr; Out2(long(labelvalue).lsw); Out2(long(labelvalue).msw); blkcnt := blkcnt-4; temp := next; next := next^.next; end; {while} segdisp := blkcnt; end; {if} end; {else} end; {UpDate} procedure WriteNative (opcode: integer; mode: addressingMode; operand: integer; name: stringPtr; flags: integer); { write a native code instruction to the output file } { } { parameters: } { opcode - native op code } { mode - addressing mode } { operand - integer operand } { name - named operand } { flags - operand modifier flags } label 1; type rkind = (k1,k2,k3); {cnv record types} var ch: char; {temp storage for string constants} cns: realRec; {for converting reals to bytes} cnv: record {for converting double, real to bytes} case rkind of k1: (rval: real;); k2: (dval: double;); k3: (ival1,ival2,ival3,ival4: integer;); end; count: integer; {number of constants to repeat} i,j,k: integer; {loop variables} lsegDisp: integer; {for backtracking while writting the } { debugger's symbol table } lval: longint; {temp storage for long constant} nptr: stringPtr; {pointer to a name} sptr: longstringPtr; {pointer to a string constant} procedure GenImmediate1; { generate a one byte immediate operand } begin {GenImmediate1} if (flags & stringReference) <> 0 then begin Purge; Out(235); Out(1); {one byte expression} Out(128); {current location ctr} Out(129); Out2(-16); Out2(-1); {-16} Out(7); {bit shift} Out(0); {end of expr} pc := pc+1; end {if} else if (flags & localLab) <> 0 then LabelSearch(long(name).lsw, 1, ord(odd(flags div shift16))*16, operand) else if (flags & shift16) <> 0 then RefName(name, operand, 1, -16) else CnOut(operand); end; {GenImmediate1} procedure GenImmediate2; { generate a two byte immediate operand } begin {GenImmediate2} if (flags & stringReference) <> 0 then begin Purge; Out(235); Out(2); LabelSearch(maxLabel, 2, 0, 0); if operand <> 0 then begin Out(129); Out2(operand); Out2(0); Out(1); end; {if} if (flags & shift16) <> 0 then begin Out(129); Out2(-16); Out2(-1); Out(7); end; {if} Out(0); end {if} else if (flags & shift8) <> 0 then RefName(name, operand, 2, -8) else if (flags & localLab) <> 0 then LabelSearch(long(name).lsw, 2, ord(odd(flags div shift16))*16, operand) else if (flags & shift16) <> 0 then RefName(name, operand, 2, -16) else if name = nil then CnOut2(operand) else RefName(name, operand, 2, 0); end; {GenImmediate2} procedure DefGlobal (private: integer); { define a global label } { } { parameters: } { private - private flag } var i: integer; {loop variable} begin {DefGlobal} Purge; Out(230); {global label definition} Out(ord(name^[0])); {write label name} for i := 1 to ord(name^[0]) do Out(ord(name^[i])); Out2(0); {length attribute} Out(ord('N')); {type attribute: other directive} Out(private); {private or global?} end; {DefGlobal} begin {WriteNative} { writeln('WriteNative: ',opcode:4, ', mode=', ord(mode):1, ' operand=', operand:1); {debug} case mode of implied: CnOut(opcode); immediate: begin if opcode = d_bmov then GenImmediate1 else begin if opcode = m_and_imm then if not longA then if operand = 255 then goto 1; CnOut(opcode); if opcode = m_pea then GenImmediate2 else if opcode in [m_adc_imm,m_and_imm,m_cmp_imm,m_eor_imm,m_lda_imm,m_ora_imm, m_sbc_imm,m_bit_imm] then if longA then GenImmediate2 else GenImmediate1 else if opcode in [m_rep,m_sep,m_cop] then begin GenImmediate1; if opcode = m_rep then begin if odd(operand div 32) then longA := true; if odd(operand div 16) then longI := true; end {if} else if opcode = m_sep then begin if odd(operand div 32) then longA := false; if odd(operand div 16) then longI := false; end; {else} end {else} else if longI then GenImmediate2 else GenImmediate1; end; {else} end; longabs: begin CnOut(opcode); isJSL := opcode = m_jsl; {allow for dynamic segs} if name = nil then if odd(flags div toolcall) then begin CnOut2(0); CnOut(225); end {if} else LabelSearch(operand, 3, 0, 0) else if odd(flags div toolcall) then begin CnOut2(long(name).lsw); CnOut(long(name).msw); end {if} else RefName(name, operand, 3, 0); isJSL := false; end; longabsolute: begin if opcode <> d_add then begin CnOut(opcode); i := 3; end {if} else i := 4; if (flags & localLab) <> 0 then LabelSearch(long(name).lsw, i, 0, operand) else if (flags & constantOpnd) <> 0 then begin lval := ord4(name); CnOut2(long(lval).lsw); if opcode = d_add then CnOut2(long(lval).msw) else CnOut(long(lval).msw); end {else if} else if name <> nil then RefName(name, operand, i, 0) else begin CnOut2(operand); CnOut(0); if opcode = d_add then CnOut(0); end; {else} end; absolute: begin if opcode <> d_add then CnOut(opcode); if (flags & localLab) <> 0 then LabelSearch(long(name).lsw, 2, 0, operand) else if name <> nil then RefName(name, operand, 2, 0) else if (flags & constantOpnd) <> 0 then CnOut2(operand) else LabelSearch(operand, 2, 0, 0); end; direct: begin if opcode <> d_add then CnOut(opcode); if (flags & localLab) <> 0 then LabelSearch(long(name).lsw, 1, 0, operand) else if name <> nil then RefName(name, operand, 1, 0) else CnOut(operand); end; longrelative: begin CnOut(opcode); LabelSearch(operand, -2, 0, 0); end; relative: begin CnOut(opcode); LabelSearch(operand, -1, 0, 0); end; gnrLabel: if name = nil then UpDate(operand, pc+cbufflen) else begin DefGlobal((flags >> 5) & 1); if operand <> 0 then begin Out(241); Out2(operand); Out2(0); pc := pc+operand; end; {if} end; {else} gnrSpace: if operand <> 0 then begin Out(241); Out2(operand); Out2(0); pc := pc+operand; end; {if} gnrConstant: begin if icptr(name)^.optype = cgString then count := 1 else count := icptr(name)^.q; for i := 1 to count do case icptr(name)^.optype of cgByte,cgUByte : CnOut(icptr(name)^.r); cgWord,cgUWord : CnOut2(icptr(name)^.r); cgLong,cgULong : begin lval := icptr(name)^.lval; CnOut2(long(lval).lsw); CnOut2(long(lval).msw); end; cgReal : begin cnv.rval := icptr(name)^.rval; CnOut2(cnv.ival1); CnOut2(cnv.ival2); end; cgDouble : begin cnv.dval := icptr(name)^.rval; CnOut2(cnv.ival1); CnOut2(cnv.ival2); CnOut2(cnv.ival3); CnOut2(cnv.ival4); end; cgComp : begin cns.itsReal := icptr(name)^.rval; CnvSC(cns); for j := 1 to 8 do CnOut(cns.inCOMP[j]); end; cgExtended : begin cns.itsReal := icptr(name)^.rval; CnvSX(cns); for j := 1 to 10 do CnOut(cns.inSANE[j]); end; cgString : begin sptr := icptr(name)^.str; for j := 1 to sptr^.length do CnOut(ord(sPtr^.str[j])); end; ccPointer : begin if icptr(name)^.lab <> nil then begin Purge; Out(235); Out(4); Out(131); pc := pc+4; nptr := icptr(name)^.lab; for j := 0 to ord(nptr^[0]) do Out(ord(nptr^[j])); lval := icptr(name)^.pVal; if lval <> 0 then begin Out(129); Out2(long(lval).lsw); Out2(long(lval).msw); Out(2-icptr(name)^.r); end; {if} Out(0); end {if} else begin lval := icptr(name)^.pVal; if icptr(name)^.r = 1 then operand := stringSize+long(lval).lsw else operand := stringSize-long(lval).lsw; flags := stringReference; GenImmediate2; flags := stringReference+shift16; GenImmediate2; sptr := icptr(name)^.pStr; j := sptr^.length; if maxString-stringSize >= j+1 then begin for k := 1 to j do stringSpace[k+stringSize] := sptr^.str[k]; stringSpace[stringSize+j+1] := chr(0); stringSize := stringSize+j+1; end {if} else Error(cge3); end; {else} end; otherwise : Error(cge1); end; {case} end; genAddress: begin if opcode < 256 then CnOut(opcode); if (flags & stringReference) <> 0 then begin Purge; Out(235); Out(2); LabelSearch(maxLabel,2,0,0); if operand <> 0 then begin Out(129); Out2(operand); Out2(0); Out(1); end; {if} if (flags & shift16) <> 0 then begin Out(129); Out2(-16); Out2(-1); Out(7); end; {if} Out(0); end {if} else if operand = 0 then begin CnOut(0); CnOut(0); end {else if} else if (flags & shift16) <> 0 then if longA then LabelSearch(operand, 2, 16, 0) else LabelSearch(operand, 1, 16, 0) else LabelSearch(operand, 0, 0, 0); end; special: if opcode = d_pin then begin segDisp := 36; out2(long(pc).lsw+cBuffLen); blkCnt := blkCnt-2; segDisp := blkCnt; end {if} else if opcode = d_sym then begin CnOut(m_cop); CnOut(5); Purge; lsegDisp := segDisp+1; CnOut2(0); symLength := 0; GenSymbols(pointer(name), operand); segDisp := lSegDisp; out2(symLength); blkCnt := blkCnt-2; segDisp := blkCnt; end {else if} else {d_wrd} CnOut2(operand); otherwise: Error(cge1); end; {case} 1: end; {WriteNative} {--------------------------------------------------------------------------} procedure EndSeg; { close out the current segment } var i: integer; begin {EndSeg} Purge; {dump constant buffer} if stringsize <> 0 then begin {define string space} UpDate(maxLabel, pc); {define the local label for the string space} for i := 1 to stringsize do CnOut(ord(stringspace[i])); Purge; end; {if} Out(0); {end the segment} segDisp := 8; {update header} Out2(long(pc).lsw); Out2(long(pc).msw); blkcnt := blkcnt-4; {purge the segment to disk} segDisp := blkcnt; CloseSeg; end; {EndSeg} procedure GenNative {p_opcode: integer; p_mode: addressingMode; p_operand: integer; p_name: stringPtr; p_flags: integer}; { write a native code instruction to the output file } { } { parameters: } { p_opcode - native op code } { p_mode - addressing mode } { p_operand - integer operand } { p_name - named operand } { p_flags - operand modifier flags } begin {GenNative} { writeln('GenNative: ',p_opcode:4, ', mode=', ord(p_mode):1, ' operand=', p_operand:1); {debug} if p_opcode <> d_end then WriteNative(p_opcode, p_mode, p_operand, p_name, p_flags); end; {GenNative} procedure GenImplied {p_opcode: integer}; { short form of GenNative - reduces code size } { } { parameters: } { p_code - operation code } begin {GenImplied} GenNative(p_opcode, implied, 0, nil, 0); end; {GenImplied} procedure GenCall {callNum: integer}; { short form of jsl to library subroutine - reduces code size } { } { parameters: } { callNum - subroutine # to generate a call for } var sp: stringPtr; {work string} begin {GenCall} case callNum of 1: sp := @'~CHECKSTACK'; 2: sp := @'~RESETNAME'; 3: sp := @'~CREALRET'; 4: sp := @'~CDOUBLERET'; 5: sp := @'~SETNAME'; 6: sp := @'~SETLINENUMBER'; 7: sp := @'~REALFN'; 8: sp := @'~DOUBLEFN'; 9: sp := @'~SAVEREAL'; 10: sp := @'~SAVEDOUBLE'; 11: sp := @'~CNVINTREAL'; 12: sp := @'~CNVLONGREAL'; 13: sp := @'~CNVULONGREAL'; 14: sp := @'~CNVREALINT'; 15: sp := @'~CNVREALUINT'; 16: sp := @'~CNVREALLONG'; 17: sp := @'~CNVREALULONG'; 18: sp := @'~CNVL2'; {PASCAL} 19: sp := @'~SAVESET'; 20: sp := @'~LOADSET'; {PASCAL} 21: sp := @'~LOADREAL'; 22: sp := @'~LOADDOUBLE'; 23: sp := @'~SHIFTLEFT'; 24: sp := @'~SSHIFTRIGHT'; 25: sp := @'~INTCHKC'; 26: sp := @'~DIV2'; 27: sp := @'~MOD2'; 28: sp := @'~MUL2'; 29: sp := @'~GRTL'; 30: sp := @'~GEQL'; 31: sp := @'~GRTE'; 32: sp := @'~GEQE'; 33: sp := @'~SETINCLUSION'; 34: sp := @'~GRTSTRING'; 35: sp := @'~GEQSTRING'; 36: sp := @'~EQUE'; 37: sp := @'~SETEQU'; 38: sp := @'~EQUSTRING'; 39: sp := @'~UMUL2'; 40: sp := @'~UDIV2'; 41: sp := @'~USHIFTRIGHT'; 42: sp := @'~MUL4'; 43: sp := @'~PDIV4'; 44: sp := @'~MOD4'; 45: sp := @'~SHL4'; 46: sp := @'~LSHR4'; 47: sp := @'~ASHR4'; {CC} 48: sp := @'~UMUL4'; {CC} 49: sp := @'~UDIV4'; {CC} 50: sp := @'~UMOD4'; {CC} 51: sp := @'~COPYREAL'; 52: sp := @'~COPYDOUBLE'; 53: sp := @'~XJPERROR'; 54: sp := @'~MOVE'; 55: sp := @'~MOVE2'; 56: sp := @'~ADDE'; 57: sp := @'~DIVE'; 58: sp := @'~MULE'; 59: sp := @'~SUBE'; 60: sp := @'~POWER'; 61: sp := @'~ARCTAN2E'; 62: sp := @'~LONGMOVE'; 63: sp := @'~LONGMOVE2'; 64: sp := @'~CCOMPRET'; 65: sp := @'~CEXTENDEDRET'; 66: sp := @'~SAVECOMP'; 67: sp := @'~SAVEEXTENDED'; 68: sp := @'~COPYCOMP'; 69: sp := @'~COPYEXTENDED'; 70: sp := @'~LOADCOMP'; 71: sp := @'~LOADEXTENDED'; 72: sp := @'~LOADUBF'; 73: sp := @'~LOADBF'; 74: sp := @'~SAVEBF'; 75: sp := @'~COPYBF'; 76: sp := @'~STACKERR'; {CC} 77: sp := @'~LOADSTRUCT'; {CC} otherwise: Error(cge1); end; {case} GenNative(m_jsl, longabs, 0, sp, 0); end; {GenCall} procedure GenLab {lnum: integer}; { generate a label } { } { parameters: } { lnum - label number } begin {GenLab} GenNative(d_lab, gnrlabel, lnum, nil, 0); end; {GenLab} procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: boolean}; { Set up the object file } { } { parameters: } { keepName - name of the output file } { keepFlag - keep status: } { 0 - don't keep the output } { 1 - create a new object module } { 2 - a .root already exists } { 3 - at least on .letter file exists } { partial - is this a partial compile? } { } { Note: Declared as extern in CGI.pas } procedure RootFile; { Create and write the initial entry segment } const dispToOpen = 21; {disps to glue routines for NDAs} dispToClose = 38; dispToAction = 50; dispToInit = 65; dispToCDAOpen = 9; {disps to glue routines for CDAs} dispToCDAClose = 36; var i: integer; {loop index} lab: stringPtr; {for holdling names var pointers} menuLen: integer; {length of the menu name string} procedure SetDataBank; { set up the data bank register } begin {SetDataBank} CnOut(m_pea); RefName(@'~GLOBALS', 0, 2, -8); CnOut(m_plb); CnOut(m_plb); end; {SetDataBank} begin {RootFile} {open the initial object module} fname2.theString.theString := concat(fname1.theString.theString, '.root'); fname2.theString.size := length(fname2.theString.theString); OpenObj(fname2); {write the header} Header(@'~_ROOT', $4000, 0); {new desk accessory initialization} if isNewDeskAcc then begin {set up the initial jump table} lab := @'~_ROOT'; menuLen := length(menuLine); RefName(lab, menuLen + dispToOpen, 4, 0); RefName(lab, menuLen + dispToClose, 4, 0); RefName(lab, menuLen + dispToAction, 4, 0); RefName(lab, menuLen + dispToInit, 4, 0); CnOut2(refreshPeriod); CnOut2(eventMask); for i := 1 to menuLen do CnOut(ord(menuLine[i])); CnOut(0); {glue code for calling open routine} CnOut(m_phb); SetDataBank; CnOut(m_jsl); RefName(openName, 0, 3, 0); CnOut(m_plb); CnOut(m_sta_s); CnOut(4); CnOut(m_txa); CnOut(m_sta_s); CnOut(6); CnOut(m_rtl); {glue code for calling close routine} CnOut(m_phb); SetDataBank; CnOut(m_jsl); RefName(closeName, 0, 3, 0); CnOut(m_plb); CnOut(m_rtl); {glue code for calling action routine} CnOut(m_phb); SetDataBank; CnOut(m_pha); CnOut(m_phy); CnOut(m_phx); CnOut(m_jsl); RefName(actionName, 0, 3, 0); CnOut(m_plb); CnOut(m_rtl); {glue code for calling init routine} CnOut(m_pha); CnOut(m_jsl); RefName(@'~DAID', 0, 3, 0); CnOut(m_phb); SetDataBank; CnOut(m_pha); CnOut(m_jsl); RefName(initName, 0, 3, 0); CnOut(m_plb); CnOut(m_rtl); end {classic desk accessory initialization} else if isClassicDeskAcc then begin {write the name} menuLen := length(menuLine); CnOut(menuLen); for i := 1 to menuLen do CnOut(ord(menuLine[i])); {set up the initial jump table} lab := @'~_ROOT'; RefName(lab, menuLen + dispToCDAOpen, 4, 0); RefName(lab, menuLen + dispToCDAClose, 4, 0); {glue code for calling open routine} CnOut(m_pea); CnOut2(1); CnOut(m_jsl); RefName(@'~DAID', 0, 3, 0); CnOut(m_phb); SetDataBank; CnOut(m_jsl); RefName(@'~CDASTART', 0, 3, 0); CnOut(m_jsl); RefName(openName,0,3,0); CnOut(m_jsl); RefName(@'~CDASHUTDOWN', 0, 3, 0); CnOut(m_plb); CnOut(m_rtl); {glue code for calling close routine} CnOut(m_phb); SetDataBank; CnOut(m_jsl); RefName(closeName, 0, 3, 0); CnOut(m_pea); CnOut2(0); CnOut(m_jsl); RefName(@'~DAID', 0, 3, 0); CnOut(m_plb); CnOut(m_rtl); end {control panel device initialization} else if isCDev then begin CnOut(m_pea); CnOut2(1); CnOut(m_jsl); RefName(@'~DAID', 0, 3, 0); CnOut(m_phb); SetDataBank; CnOut(m_pla); CnOut(m_sta_s); CnOut(13); CnOut(m_pla); CnOut(m_sta_s); CnOut(13); CnOut(m_jsl); RefName(openName,0,3,0); CnOut(m_tay); CnOut(m_lda_s); CnOut(3); CnOut(m_pha); CnOut(m_lda_s); CnOut(3); CnOut(m_pha); CnOut(m_txa); CnOut(m_sta_s); CnOut(7); CnOut(m_tya); CnOut(m_sta_s); CnOut(5); CnOut(m_plb); CnOut(m_rtl); end {NBA initialization} else if isNBA then begin CnOut(m_jsl); RefName(@'~NBASTARTUP', 0, 3, 0); CnOut(m_phx); CnOut(m_phy); CnOut(m_jsl); RefName(openName,0,3,0); CnOut(m_jsl); RefName(@'~NBASHUTDOWN', 0, 3, 0); CnOut(m_rtl); end {XCMD initialization} else if isXCMD then begin CnOut(m_jsl); RefName(@'~XCMDSTARTUP', 0, 3, 0); CnOut(m_jsl); RefName(openName,0,3,0); CnOut(m_jsl); RefName(@'~XCMDSHUTDOWN', 0, 3, 0); CnOut(m_rtl); end {normal program initialization} else begin {write the initial JSL} CnOut(m_jsl); if rtl then RefName(@'~_BWSTARTUP4', 0, 3, 0) else RefName(@'~_BWSTARTUP3', 0, 3, 0); {set the data bank register} SetDataBank; {write JSL to main entry point} CnOut(m_jsl); if rtl then RefName(@'~C_STARTUP2', 0, 3, 0) else RefName(@'~C_STARTUP', 0, 3, 0); CnOut(m_jsl); RefName(@'main', 0, 3, 0); CnOut(m_jsl); if rtl then RefName(@'~C_SHUTDOWN2', 0, 3, 0) else RefName(@'~C_SHUTDOWN', 0, 3, 0); end; {finish the current segment} EndSeg; end; {RootFile} procedure SetStack; { Set up a stack frame } begin {SetStack} if stackSize <> 0 then begin currentSegment := '~_STACK '; {write the header} Header(@'~_STACK', $4012, 0); currentSegment := defaultSegment; Out($F1); {write the DS record to reserve space} Out2(stackSize); Out2(0); EndSeg; {finish the current segment} end; {if} end; {SetStack} begin {InitFile} fname1 := keepname^; if partial or (keepFlag = 3) then FindSuffix(fname1, nextSuffix) else begin if (keepFlag = 1) and (not noroot) then begin RootFile; SetStack; CloseObj; end; {if} DestroySuffixes(fname1); nextSuffix := 'a'; end; {else} fname2.theString.theString := concat(fname1.theString.theString, '.', nextSuffix); fname2.theString.size := length(fname2.theString.theString); OpenObj(fname2); end; {InitFile} procedure InitNative; { set up for a new segment } begin {InitNative} stringSize := 0; {initialize scalars for a new segment} pc := 0; cbufflen := 0; longA := true; longI := true; end; {InitNative} procedure RefName {lab: stringPtr; disp, len, shift: integer}; { handle a reference to a named label } { } { parameters: } { lab - label name } { disp - displacement past the label } { len - number of bytes in the reference } { shift - shift factor } var i: integer; {loop var} slen: integer; {length of string} begin {RefName} Purge; {clear any constant bytes} if isJSL then {expression header} Out(243) else Out(235); Out(len); Out(131); pc := pc+len; slen := length(lab^); Out(slen); for i := 1 to slen do Out(ord(lab^[i])); if disp <> 0 then begin {if there is a disp, add it in} Out(129); Out2(disp); Out2(0); Out(1); end; {end} if shift <> 0 then begin {if there is a shift, add it in} Out(129); Out2(shift); if shift < 0 then Out2(-1) else Out2(0); Out(7); end; {if} Out(0); {end of expression} end; {RefName} end. \ No newline at end of file +{$optimize 7} +{---------------------------------------------------------------} +{ } +{ ORCA Native Code Generation } +{ } +{ This module of the code generator is called to generate } +{ native code instructions. The native code is optimized } +{ and written to the object segment. } +{ } +{ Externally available procedures: } +{ } +{ EndSeg - close out the current segment } +{ GenNative - write a native code instruction to the output } +{ file } +{ GenImplied - short form of GenNative - reduces code size } +{ GenCall - short form of jsl to library subroutine - reduces } +{ code size } +{ GenLab - generate a label } +{ InitFile - Set up the object file } +{ InitNative - set up for a new segment } +{ RefName - handle a reference to a named label } +{ } +{---------------------------------------------------------------} + +unit Native; + +interface + +{$LibPrefix '0/obj/'} + +uses CCommon, CGI, CGC, ObjOut; + +{$segment 'CodeGen'} + +type + labelptr = ^labelentry; {pointer to a forward ref node} + labelentry = record {forward ref node} + addr: integer; + next: labelptr; + end; + + labelrec = record {label record} + defined: boolean; {Note: form used in objout.asm} + chain: labelptr; + case boolean of + true : (val: longint); + false: (ival,hval: integer); + end; + +var + {current instruction info} + {------------------------} + pc: longint; {program counter} + + {65816 native code generation} + {----------------------------} + didOne: boolean; {has an optimization been done?} + labeltab: array[0..maxlabel] of labelrec; {label table} + localLabel: array[0..maxLocalLabel] of integer; {local variable label table} + +{---------------------------------------------------------------} + +procedure EndSeg; + +{ close out the current segment } + + +procedure GenNative (p_opcode: integer; p_mode: addressingMode; + p_operand: integer; p_name: stringPtr; p_flags: integer); + +{ write a native code instruction to the output file } +{ } +{ parameters: } +{ p_opcode - native op code } +{ p_mode - addressing mode } +{ p_operand - integer operand } +{ p_name - named operand } +{ p_flags - operand modifier flags } + + +procedure GenImplied (p_opcode: integer); + +{ short form of GenNative - reduces code size } +{ } +{ parameters: } +{ p_code - operation code } + + +procedure GenCall (callNum: integer); + +{ short form of jsl to library subroutine - reduces code size } +{ } +{ parameters: } +{ callNum - subroutine # to generate a call for } + + +procedure GenLab (lnum: integer); + +{ generate a label } +{ } +{ parameters: } +{ lnum - label number } + + +procedure InitFile (keepName: gsosOutStringPtr; keepFlag: integer; partial: boolean); + +{ Set up the object file } +{ } +{ parameters: } +{ keepName - name of the output file } +{ keepFlag - keep status: } +{ 0 - don't keep the output } +{ 1 - create a new object module } +{ 2 - a .root already exists } +{ 3 - at least on .letter file exists } +{ partial - is this a partial compile? } +{ } +{ Note: Declared as extern in CGI.pas } + + +procedure InitNative; + +{ set up for a new segment } + + +procedure LabelSearch (lab: integer; len, shift, disp: integer); + +{ resolve a label reference } +{ } +{ parameters: } +{ lab - label number } +{ len - # bytes for the generated code } +{ shift - shift factor } +{ disp - disp past the label } +{ } +{ Note 1: maxlabel is reserved for use as the start of the } +{ string space } +{ Note 2: negative length indicates relative branch } +{ Note 3: zero length indicates 2 byte addr -1 } + + +procedure RefName (lab: stringPtr; disp, len, shift: integer); + +{ handle a reference to a named label } +{ } +{ parameters: } +{ lab - label name } +{ disp - displacement past the label } +{ len - number of bytes in the reference } +{ shift - shift factor } + + +{--------------------------------------------------------------------------} + +implementation + +const + npeepSize = 128; {native peephole optimizer window size} + nMaxPeep = 4; {max # instructions needed to opt.} + +type + {65816 native code generation} + {----------------------------} + npeepRange = 1..npeepsize; {subrange for native code peephole opt.} + + nativeType = record {native code instruction} + opcode: integer; {op code} + mode: addressingMode; {addressing mode} + operand: integer; {operand value} + name: stringPtr; {operand label} + flags: integer; {modifier flags} + end; + + registerConditions = (regUnknown,regImmediate,regAbsolute,regLocal); + registerType = record {used to track register contents} + condition: registerConditions; + value: integer; + lab: stringPtr; + flags: integer; + end; + +var + + {I/O files} + {---------} + fname1, fname2: gsosOutString; {file names} + nextSuffix: char; {next suffix character to use} + + +procedure GenSymbols (sym: ptr; doGlobals: integer); extern; + +{ generate the symbol table } + +{--------------------------------------------------------------------------} + +procedure LabelSearch {lab: integer; len, shift, disp: integer}; + +{ resolve a label reference } +{ } +{ parameters: } +{ lab - label number } +{ len - # bytes for the generated code } +{ shift - shift factor } +{ disp - disp past the label } +{ } +{ Note 1: maxlabel is reserved for use as the start of the } +{ string space } +{ Note 2: negative length indicates relative branch } +{ Note 3: zero length indicates 2 byte addr -1 } + +var + next: labelptr; {work pointer} + +begin {LabelSearch} +if labeltab[lab].defined and (len < 0) and (shift = 0) and (disp = 0) then begin + + {handle a relative branch to a known disp} + if len = -1 then + CnOut(labeltab[lab].ival - long(pc).lsw - cbufflen + len) + else + CnOut2(labeltab[lab].ival - long(pc).lsw - cbufflen + len); + end {if} +else begin + if lab <> maxlabel then begin + + {handle a normal label reference} + Purge; {empty the constant buffer} + if len < 0 then begin + len := -len; {generate a RELEXPR} + Out(238); + Out(len); + Out2(len); Out2(0); + end {if} + else begin + if isJSL then {generate a standard EXPR} + Out(243) + else + Out(235); + if len = 0 then + Out(2) + else + Out(len); + end; {else} + end; {if} + Out(135); {generate a relative offset from the seg. start} + if not labeltab[lab].defined then begin + next := pointer(Malloc(sizeof(labelEntry))); {value unknown: create a reference} + next^.next := labeltab[lab].chain; + labeltab[lab].chain := next; + next^.addr := blkcnt; + Out2(0); + Out2(0); + end {if} + else {labeltab[lab].defined} begin + Out2(labeltab[lab].ival); {value known: write it} + Out2(labeltab[lab].hval); + end; {else} + if len = 0 then begin + Out(129); {subtract 1 from addr} + Out2(1); Out2(0); + Out(2); + len := 2; + end; {if} + if disp <> 0 then begin + Out(129); {add in the displacement} + Out2(disp); + if disp < 0 then + Out2(-1) + else + Out2(0); + Out(1); + end; {if} + if shift <> 0 then begin + Out(129); {shift the address} + Out2(-shift); Out2(-1); + Out(7); + end; {if} + if lab <> maxlabel then {if not a string, end the expression} + Out(0); + pc := pc+len; {update the pc} + end; {else} +end; {LabelSearch} + + +procedure UpDate (lab: integer; labelValue: longint); + +{ define a label } +{ } +{ parameters: } +{ lab - label number } +{ labelValue - displacement in seg where label is located } + +var + next,temp: labelptr; {work pointers} + +begin {UpDate} +if labeltab[lab].defined then + Error(cge1) +else begin + + {define the label for future references} + with labeltab[lab] do begin + defined := true; + val := labelValue; + next := chain; + end; {with} + + {resolve any forward references} + if next <> nil then begin + Purge; + while next <> nil do begin + segdisp := next^.addr; + Out2(long(labelvalue).lsw); + Out2(long(labelvalue).msw); + blkcnt := blkcnt-4; + temp := next; + next := next^.next; + end; {while} + segdisp := blkcnt; + end; {if} + end; {else} +end; {UpDate} + + +procedure WriteNative (opcode: integer; mode: addressingMode; operand: integer; + name: stringPtr; flags: integer); + +{ write a native code instruction to the output file } +{ } +{ parameters: } +{ opcode - native op code } +{ mode - addressing mode } +{ operand - integer operand } +{ name - named operand } +{ flags - operand modifier flags } + +label 1; + +type + rkind = (k1,k2,k3); {cnv record types} + +var + ch: char; {temp storage for string constants} + cns: realRec; {for converting reals to bytes} + cnv: record {for converting double, real to bytes} + case rkind of + k1: (rval: real;); + k2: (dval: double;); + k3: (ival1,ival2,ival3,ival4: integer;); + end; + count: integer; {number of constants to repeat} + i,j,k: integer; {loop variables} + lsegDisp: integer; {for backtracking while writting the } + { debugger's symbol table } + lval: longint; {temp storage for long constant} + nptr: stringPtr; {pointer to a name} + sptr: longstringPtr; {pointer to a string constant} + + + procedure GenImmediate1; + + { generate a one byte immediate operand } + + begin {GenImmediate1} + if (flags & stringReference) <> 0 then begin + Purge; + Out(235); Out(1); {one byte expression} + Out(128); {current location ctr} + Out(129); Out2(-16); Out2(-1); {-16} + Out(7); {bit shift} + Out(0); {end of expr} + pc := pc+1; + end {if} + else if (flags & localLab) <> 0 then + LabelSearch(long(name).lsw, 1, ord(odd(flags div shift16))*16, operand) + else if (flags & shift16) <> 0 then + RefName(name, operand, 1, -16) + else + CnOut(operand); + end; {GenImmediate1} + + + procedure GenImmediate2; + + { generate a two byte immediate operand } + + begin {GenImmediate2} + if (flags & stringReference) <> 0 then begin + Purge; + Out(235); Out(2); + LabelSearch(maxLabel, 2, 0, 0); + if operand <> 0 then begin + Out(129); + Out2(operand); Out2(0); + Out(1); + end; {if} + if (flags & shift16) <> 0 then begin + Out(129); + Out2(-16); Out2(-1); + Out(7); + end; {if} + Out(0); + end {if} + else if (flags & shift8) <> 0 then + RefName(name, operand, 2, -8) + else if (flags & localLab) <> 0 then + LabelSearch(long(name).lsw, 2, ord(odd(flags div shift16))*16, operand) + else if (flags & shift16) <> 0 then + RefName(name, operand, 2, -16) + else if name = nil then + CnOut2(operand) + else + RefName(name, operand, 2, 0); + end; {GenImmediate2} + + + procedure DefGlobal (private: integer); + + { define a global label } + { } + { parameters: } + { private - private flag } + + var + i: integer; {loop variable} + + begin {DefGlobal} + Purge; + Out(230); {global label definition} + Out(ord(name^[0])); {write label name} + for i := 1 to ord(name^[0]) do + Out(ord(name^[i])); + Out2(0); {length attribute} + Out(ord('N')); {type attribute: other directive} + Out(private); {private or global?} + end; {DefGlobal} + + +begin {WriteNative} +{ writeln('WriteNative: ',opcode:4, ', mode=', ord(mode):1, + ' operand=', operand:1); {debug} +case mode of + + implied: + CnOut(opcode); + + immediate: begin + if opcode = d_bmov then + GenImmediate1 + else begin + if opcode = m_and_imm then + if not longA then + if operand = 255 then + goto 1; + CnOut(opcode); + if opcode = m_pea then + GenImmediate2 + else if opcode in + [m_adc_imm,m_and_imm,m_cmp_imm,m_eor_imm,m_lda_imm,m_ora_imm, + m_sbc_imm,m_bit_imm] then + if longA then + GenImmediate2 + else + GenImmediate1 + else if opcode in [m_rep,m_sep,m_cop] then begin + GenImmediate1; + if opcode = m_rep then begin + if odd(operand div 32) then longA := true; + if odd(operand div 16) then longI := true; + end {if} + else if opcode = m_sep then begin + if odd(operand div 32) then longA := false; + if odd(operand div 16) then longI := false; + end; {else} + end {else} + else + if longI then + GenImmediate2 + else + GenImmediate1; + end; {else} + end; + + longabs: begin + CnOut(opcode); + isJSL := opcode = m_jsl; {allow for dynamic segs} + if name = nil then + if odd(flags div toolcall) then begin + CnOut2(0); + CnOut(225); + end {if} + else + LabelSearch(operand, 3, 0, 0) + else + if odd(flags div toolcall) then begin + CnOut2(long(name).lsw); + CnOut(long(name).msw); + end {if} + else + RefName(name, operand, 3, 0); + isJSL := false; + end; + + longabsolute: begin + if opcode <> d_add then begin + CnOut(opcode); + i := 3; + end {if} + else + i := 4; + if (flags & localLab) <> 0 then + LabelSearch(long(name).lsw, i, 0, operand) + else if (flags & constantOpnd) <> 0 then begin + lval := ord4(name); + CnOut2(long(lval).lsw); + if opcode = d_add then + CnOut2(long(lval).msw) + else + CnOut(long(lval).msw); + end {else if} + else if name <> nil then + RefName(name, operand, i, 0) + else begin + CnOut2(operand); + CnOut(0); + if opcode = d_add then + CnOut(0); + end; {else} + end; + + absolute: begin + if opcode <> d_add then + CnOut(opcode); + if (flags & localLab) <> 0 then + LabelSearch(long(name).lsw, 2, 0, operand) + else if name <> nil then + RefName(name, operand, 2, 0) + else if (flags & constantOpnd) <> 0 then + CnOut2(operand) + else + LabelSearch(operand, 2, 0, 0); + end; + + direct: begin + if opcode <> d_add then + CnOut(opcode); + if (flags & localLab) <> 0 then + LabelSearch(long(name).lsw, 1, 0, operand) + else if name <> nil then + RefName(name, operand, 1, 0) + else + CnOut(operand); + end; + + longrelative: begin + CnOut(opcode); + LabelSearch(operand, -2, 0, 0); + end; + + relative: begin + CnOut(opcode); + LabelSearch(operand, -1, 0, 0); + end; + + gnrLabel: + if name = nil then + UpDate(operand, pc+cbufflen) + else begin + DefGlobal((flags >> 5) & 1); + if operand <> 0 then begin + Out(241); + Out2(operand); + Out2(0); + pc := pc+operand; + end; {if} + end; {else} + + gnrSpace: + if operand <> 0 then begin + Out(241); + Out2(operand); + Out2(0); + pc := pc+operand; + end; {if} + + gnrConstant: begin + if icptr(name)^.optype = cgString then + count := 1 + else + count := icptr(name)^.q; + for i := 1 to count do + case icptr(name)^.optype of + cgByte,cgUByte : CnOut(icptr(name)^.r); + cgWord,cgUWord : CnOut2(icptr(name)^.r); + cgLong,cgULong : begin + lval := icptr(name)^.lval; + CnOut2(long(lval).lsw); + CnOut2(long(lval).msw); + end; + cgReal : begin + cnv.rval := icptr(name)^.rval; + CnOut2(cnv.ival1); + CnOut2(cnv.ival2); + end; + cgDouble : begin + cnv.dval := icptr(name)^.rval; + CnOut2(cnv.ival1); + CnOut2(cnv.ival2); + CnOut2(cnv.ival3); + CnOut2(cnv.ival4); + end; + cgComp : begin + cns.itsReal := icptr(name)^.rval; + CnvSC(cns); + for j := 1 to 8 do + CnOut(cns.inCOMP[j]); + end; + cgExtended : begin + cns.itsReal := icptr(name)^.rval; + CnvSX(cns); + for j := 1 to 10 do + CnOut(cns.inSANE[j]); + end; + cgString : begin + sptr := icptr(name)^.str; + for j := 1 to sptr^.length do + CnOut(ord(sPtr^.str[j])); + end; + ccPointer : begin + if icptr(name)^.lab <> nil then begin + Purge; + Out(235); + Out(4); + Out(131); + pc := pc+4; + nptr := icptr(name)^.lab; + for j := 0 to ord(nptr^[0]) do + Out(ord(nptr^[j])); + lval := icptr(name)^.pVal; + if lval <> 0 then begin + Out(129); + Out2(long(lval).lsw); + Out2(long(lval).msw); + Out(2-icptr(name)^.r); + end; {if} + Out(0); + end {if} + else begin + lval := icptr(name)^.pVal; + if icptr(name)^.r = 1 then + operand := stringSize+long(lval).lsw + else + operand := stringSize-long(lval).lsw; + flags := stringReference; + GenImmediate2; + flags := stringReference+shift16; + GenImmediate2; + sptr := icptr(name)^.pStr; + j := sptr^.length; + if maxString-stringSize >= j+1 then begin + for k := 1 to j do + stringSpace[k+stringSize] := + sptr^.str[k]; + stringSpace[stringSize+j+1] := chr(0); + stringSize := stringSize+j+1; + end {if} + else + Error(cge3); + end; {else} + end; + otherwise : Error(cge1); + end; {case} + end; + + genAddress: begin + if opcode < 256 then + CnOut(opcode); + if (flags & stringReference) <> 0 then begin + Purge; + Out(235); + Out(2); + LabelSearch(maxLabel,2,0,0); + if operand <> 0 then begin + Out(129); + Out2(operand); + Out2(0); + Out(1); + end; {if} + if (flags & shift16) <> 0 then begin + Out(129); + Out2(-16); + Out2(-1); + Out(7); + end; {if} + Out(0); + end {if} + else if operand = 0 then begin + CnOut(0); + CnOut(0); + end {else if} + else if (flags & shift16) <> 0 then + if longA then + LabelSearch(operand, 2, 16, 0) + else + LabelSearch(operand, 1, 16, 0) + else + LabelSearch(operand, 0, 0, 0); + end; + + special: + if opcode = d_pin then begin + segDisp := 36; + out2(long(pc).lsw+cBuffLen); + blkCnt := blkCnt-2; + segDisp := blkCnt; + end {if} + else if opcode = d_sym then begin + CnOut(m_cop); + CnOut(5); + Purge; + lsegDisp := segDisp+1; + CnOut2(0); + symLength := 0; + GenSymbols(pointer(name), operand); + segDisp := lSegDisp; + out2(symLength); + blkCnt := blkCnt-2; + segDisp := blkCnt; + end {else if} + else {d_wrd} + CnOut2(operand); + + otherwise: Error(cge1); + + end; {case} +1: +end; {WriteNative} + +{--------------------------------------------------------------------------} + +procedure EndSeg; + +{ close out the current segment } + +var + i: integer; + +begin {EndSeg} +Purge; {dump constant buffer} +if stringsize <> 0 then begin {define string space} + UpDate(maxLabel, pc); {define the local label for the string space} + for i := 1 to stringsize do + CnOut(ord(stringspace[i])); + Purge; + end; {if} +Out(0); {end the segment} +segDisp := 8; {update header} +Out2(long(pc).lsw); +Out2(long(pc).msw); +blkcnt := blkcnt-4; {purge the segment to disk} +segDisp := blkcnt; +CloseSeg; +end; {EndSeg} + + +procedure GenNative {p_opcode: integer; p_mode: addressingMode; + p_operand: integer; p_name: stringPtr; p_flags: integer}; + +{ write a native code instruction to the output file } +{ } +{ parameters: } +{ p_opcode - native op code } +{ p_mode - addressing mode } +{ p_operand - integer operand } +{ p_name - named operand } +{ p_flags - operand modifier flags } + +begin {GenNative} +{ writeln('GenNative: ',p_opcode:4, ', mode=', ord(p_mode):1, + ' operand=', p_operand:1); {debug} +if p_opcode <> d_end then + WriteNative(p_opcode, p_mode, p_operand, p_name, p_flags); +end; {GenNative} + + +procedure GenImplied {p_opcode: integer}; + +{ short form of GenNative - reduces code size } +{ } +{ parameters: } +{ p_code - operation code } + +begin {GenImplied} +GenNative(p_opcode, implied, 0, nil, 0); +end; {GenImplied} + + +procedure GenCall {callNum: integer}; + +{ short form of jsl to library subroutine - reduces code size } +{ } +{ parameters: } +{ callNum - subroutine # to generate a call for } + +var + sp: stringPtr; {work string} + +begin {GenCall} +case callNum of + 1: sp := @'~CHECKSTACK'; + 2: sp := @'~RESETNAME'; + 3: sp := @'~CREALRET'; + 4: sp := @'~CDOUBLERET'; + 5: sp := @'~SETNAME'; + 6: sp := @'~SETLINENUMBER'; + 7: sp := @'~REALFN'; + 8: sp := @'~DOUBLEFN'; + 9: sp := @'~SAVEREAL'; + 10: sp := @'~SAVEDOUBLE'; + 11: sp := @'~CNVINTREAL'; + 12: sp := @'~CNVLONGREAL'; + 13: sp := @'~CNVULONGREAL'; + 14: sp := @'~CNVREALINT'; + 15: sp := @'~CNVREALUINT'; + 16: sp := @'~CNVREALLONG'; + 17: sp := @'~CNVREALULONG'; + 18: sp := @'~CNVL2'; {PASCAL} + 19: sp := @'~SAVESET'; + 20: sp := @'~LOADSET'; {PASCAL} + 21: sp := @'~LOADREAL'; + 22: sp := @'~LOADDOUBLE'; + 23: sp := @'~SHIFTLEFT'; + 24: sp := @'~SSHIFTRIGHT'; + 25: sp := @'~INTCHKC'; + 26: sp := @'~DIV2'; + 27: sp := @'~MOD2'; + 28: sp := @'~MUL2'; + 29: sp := @'~GRTL'; + 30: sp := @'~GEQL'; + 31: sp := @'~GRTE'; + 32: sp := @'~GEQE'; + 33: sp := @'~SETINCLUSION'; + 34: sp := @'~GRTSTRING'; + 35: sp := @'~GEQSTRING'; + 36: sp := @'~EQUE'; + 37: sp := @'~SETEQU'; + 38: sp := @'~EQUSTRING'; + 39: sp := @'~UMUL2'; + 40: sp := @'~UDIV2'; + 41: sp := @'~USHIFTRIGHT'; + 42: sp := @'~MUL4'; + 43: sp := @'~PDIV4'; + 44: sp := @'~MOD4'; + 45: sp := @'~SHL4'; + 46: sp := @'~LSHR4'; + 47: sp := @'~ASHR4'; {CC} + 48: sp := @'~UMUL4'; {CC} + 49: sp := @'~UDIV4'; {CC} + 50: sp := @'~UMOD4'; {CC} + 51: sp := @'~COPYREAL'; + 52: sp := @'~COPYDOUBLE'; + 53: sp := @'~XJPERROR'; + 54: sp := @'~MOVE'; + 55: sp := @'~MOVE2'; + 56: sp := @'~ADDE'; + 57: sp := @'~DIVE'; + 58: sp := @'~MULE'; + 59: sp := @'~SUBE'; + 60: sp := @'~POWER'; + 61: sp := @'~ARCTAN2E'; + 62: sp := @'~LONGMOVE'; + 63: sp := @'~LONGMOVE2'; + 64: sp := @'~CCOMPRET'; + 65: sp := @'~CEXTENDEDRET'; + 66: sp := @'~SAVECOMP'; + 67: sp := @'~SAVEEXTENDED'; + 68: sp := @'~COPYCOMP'; + 69: sp := @'~COPYEXTENDED'; + 70: sp := @'~LOADCOMP'; + 71: sp := @'~LOADEXTENDED'; + 72: sp := @'~LOADUBF'; + 73: sp := @'~LOADBF'; + 74: sp := @'~SAVEBF'; + 75: sp := @'~COPYBF'; + 76: sp := @'~STACKERR'; {CC} + 77: sp := @'~LOADSTRUCT'; {CC} + otherwise: + Error(cge1); + end; {case} +GenNative(m_jsl, longabs, 0, sp, 0); +end; {GenCall} + + +procedure GenLab {lnum: integer}; + +{ generate a label } +{ } +{ parameters: } +{ lnum - label number } + +begin {GenLab} +GenNative(d_lab, gnrlabel, lnum, nil, 0); +end; {GenLab} + + +procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: boolean}; + +{ Set up the object file } +{ } +{ parameters: } +{ keepName - name of the output file } +{ keepFlag - keep status: } +{ 0 - don't keep the output } +{ 1 - create a new object module } +{ 2 - a .root already exists } +{ 3 - at least on .letter file exists } +{ partial - is this a partial compile? } +{ } +{ Note: Declared as extern in CGI.pas } + + + procedure RootFile; + + { Create and write the initial entry segment } + + const + dispToOpen = 21; {disps to glue routines for NDAs} + dispToClose = 38; + dispToAction = 50; + dispToInit = 65; + dispToCDAOpen = 9; {disps to glue routines for CDAs} + dispToCDAClose = 36; + + var + i: integer; {loop index} + lab: stringPtr; {for holdling names var pointers} + menuLen: integer; {length of the menu name string} + + + procedure SetDataBank; + + { set up the data bank register } + + begin {SetDataBank} + CnOut(m_pea); + RefName(@'~GLOBALS', 0, 2, -8); + CnOut(m_plb); + CnOut(m_plb); + end; {SetDataBank} + + + begin {RootFile} + {open the initial object module} + fname2.theString.theString := concat(fname1.theString.theString, '.root'); + fname2.theString.size := length(fname2.theString.theString); + OpenObj(fname2); + + {write the header} + Header(@'~_ROOT', $4000, 0); + + {new desk accessory initialization} + if isNewDeskAcc then begin + + {set up the initial jump table} + lab := @'~_ROOT'; + menuLen := length(menuLine); + RefName(lab, menuLen + dispToOpen, 4, 0); + RefName(lab, menuLen + dispToClose, 4, 0); + RefName(lab, menuLen + dispToAction, 4, 0); + RefName(lab, menuLen + dispToInit, 4, 0); + CnOut2(refreshPeriod); + CnOut2(eventMask); + for i := 1 to menuLen do + CnOut(ord(menuLine[i])); + CnOut(0); + + {glue code for calling open routine} + CnOut(m_phb); + SetDataBank; + CnOut(m_jsl); + RefName(openName, 0, 3, 0); + CnOut(m_plb); + CnOut(m_sta_s); CnOut(4); + CnOut(m_txa); + CnOut(m_sta_s); CnOut(6); + CnOut(m_rtl); + + {glue code for calling close routine} + CnOut(m_phb); + SetDataBank; + CnOut(m_jsl); + RefName(closeName, 0, 3, 0); + CnOut(m_plb); + CnOut(m_rtl); + + {glue code for calling action routine} + CnOut(m_phb); + SetDataBank; + CnOut(m_pha); + CnOut(m_phy); + CnOut(m_phx); + CnOut(m_jsl); + RefName(actionName, 0, 3, 0); + CnOut(m_plb); + CnOut(m_rtl); + + {glue code for calling init routine} + CnOut(m_pha); + CnOut(m_jsl); + RefName(@'~DAID', 0, 3, 0); + CnOut(m_phb); + SetDataBank; + CnOut(m_pha); + CnOut(m_jsl); + RefName(initName, 0, 3, 0); + CnOut(m_plb); + CnOut(m_rtl); + end + + {classic desk accessory initialization} + else if isClassicDeskAcc then begin + + {write the name} + menuLen := length(menuLine); + CnOut(menuLen); + for i := 1 to menuLen do + CnOut(ord(menuLine[i])); + + {set up the initial jump table} + lab := @'~_ROOT'; + RefName(lab, menuLen + dispToCDAOpen, 4, 0); + RefName(lab, menuLen + dispToCDAClose, 4, 0); + + {glue code for calling open routine} + CnOut(m_pea); + CnOut2(1); + CnOut(m_jsl); + RefName(@'~DAID', 0, 3, 0); + CnOut(m_phb); + SetDataBank; + CnOut(m_jsl); + RefName(@'~CDASTART', 0, 3, 0); + CnOut(m_jsl); + RefName(openName,0,3,0); + CnOut(m_jsl); + RefName(@'~CDASHUTDOWN', 0, 3, 0); + CnOut(m_plb); + CnOut(m_rtl); + + {glue code for calling close routine} + CnOut(m_phb); + SetDataBank; + CnOut(m_jsl); + RefName(closeName, 0, 3, 0); + CnOut(m_pea); + CnOut2(0); + CnOut(m_jsl); + RefName(@'~DAID', 0, 3, 0); + CnOut(m_plb); + CnOut(m_rtl); + end + + {control panel device initialization} + else if isCDev then begin + CnOut(m_pea); + CnOut2(1); + CnOut(m_jsl); + RefName(@'~DAID', 0, 3, 0); + CnOut(m_phb); + SetDataBank; + CnOut(m_pla); + CnOut(m_sta_s); CnOut(13); + CnOut(m_pla); + CnOut(m_sta_s); CnOut(13); + CnOut(m_jsl); + RefName(openName,0,3,0); + CnOut(m_tay); + CnOut(m_lda_s); CnOut(3); + CnOut(m_pha); + CnOut(m_lda_s); CnOut(3); + CnOut(m_pha); + CnOut(m_txa); + CnOut(m_sta_s); CnOut(7); + CnOut(m_tya); + CnOut(m_sta_s); CnOut(5); + CnOut(m_plb); + CnOut(m_rtl); + end + + {NBA initialization} + else if isNBA then begin + CnOut(m_jsl); + RefName(@'~NBASTARTUP', 0, 3, 0); + CnOut(m_phx); + CnOut(m_phy); + CnOut(m_jsl); + RefName(openName,0,3,0); + CnOut(m_jsl); + RefName(@'~NBASHUTDOWN', 0, 3, 0); + CnOut(m_rtl); + end + + {XCMD initialization} + else if isXCMD then begin + CnOut(m_jsl); + RefName(@'~XCMDSTARTUP', 0, 3, 0); + CnOut(m_jsl); + RefName(openName,0,3,0); + CnOut(m_jsl); + RefName(@'~XCMDSHUTDOWN', 0, 3, 0); + CnOut(m_rtl); + end + + {normal program initialization} + else begin + + {write the initial JSL} + CnOut(m_jsl); + if rtl then + RefName(@'~_BWSTARTUP4', 0, 3, 0) + else + RefName(@'~_BWSTARTUP3', 0, 3, 0); + + {set the data bank register} + SetDataBank; + + {write JSL to main entry point} + CnOut(m_jsl); + if rtl then + RefName(@'~C_STARTUP2', 0, 3, 0) + else + RefName(@'~C_STARTUP', 0, 3, 0); + CnOut(m_jsl); + RefName(@'main', 0, 3, 0); + CnOut(m_jsl); + if rtl then + RefName(@'~C_SHUTDOWN2', 0, 3, 0) + else + RefName(@'~C_SHUTDOWN', 0, 3, 0); + end; + + {finish the current segment} + EndSeg; + end; {RootFile} + + + procedure SetStack; + + { Set up a stack frame } + + begin {SetStack} + if stackSize <> 0 then begin + currentSegment := '~_STACK '; {write the header} + Header(@'~_STACK', $4012, 0); + currentSegment := defaultSegment; + Out($F1); {write the DS record to reserve space} + Out2(stackSize); + Out2(0); + EndSeg; {finish the current segment} + end; {if} + end; {SetStack} + + +begin {InitFile} +fname1 := keepname^; +if partial or (keepFlag = 3) then + FindSuffix(fname1, nextSuffix) +else begin + if (keepFlag = 1) and (not noroot) then begin + RootFile; + SetStack; + CloseObj; + end; {if} + DestroySuffixes(fname1); + nextSuffix := 'a'; + end; {else} +fname2.theString.theString := concat(fname1.theString.theString, '.', nextSuffix); +fname2.theString.size := length(fname2.theString.theString); +OpenObj(fname2); +end; {InitFile} + + +procedure InitNative; + +{ set up for a new segment } + +begin {InitNative} +stringSize := 0; {initialize scalars for a new segment} +pc := 0; +cbufflen := 0; +longA := true; +longI := true; +end; {InitNative} + + +procedure RefName {lab: stringPtr; disp, len, shift: integer}; + +{ handle a reference to a named label } +{ } +{ parameters: } +{ lab - label name } +{ disp - displacement past the label } +{ len - number of bytes in the reference } +{ shift - shift factor } + +var + i: integer; {loop var} + slen: integer; {length of string} + +begin {RefName} +Purge; {clear any constant bytes} +if isJSL then {expression header} + Out(243) +else + Out(235); +Out(len); +Out(131); +pc := pc+len; +slen := length(lab^); +Out(slen); +for i := 1 to slen do + Out(ord(lab^[i])); +if disp <> 0 then begin {if there is a disp, add it in} + Out(129); + Out2(disp); + Out2(0); + Out(1); + end; {end} +if shift <> 0 then begin {if there is a shift, add it in} + Out(129); + Out2(shift); + if shift < 0 then + Out2(-1) + else + Out2(0); + Out(7); + end; {if} +Out(0); {end of expression} +end; {RefName} + +end. diff --git a/ObjOut.asm b/ObjOut.asm old mode 100755 new mode 100644 index 989a5e3..ba164be --- a/ObjOut.asm +++ b/ObjOut.asm @@ -1 +1,228 @@ - mcopy objout.macros **************************************************************** * * CnOut - write a byte to the constant buffer * * Inputs: * i - byte to write * **************************************************************** * CnOut start maxCBuffLen equ 191 max index into the constant buffer lda cBuffLen if cBuffLen = maxCBuffLen then cmp #maxCBuffLen bne lb1 jsl Purge Purge; lb1 phb cBuff[cBuffLen] := i; plx ply pla phy phx plb ldx cBuffLen short M sta cBuff,X long M inc cBuffLen cBuffLen := cBuffLen+1; rtl end **************************************************************** * * CnOut2 - write a word to the constant buffer * * Inputs: * i - word to write * **************************************************************** * CnOut2 start maxCBuffLen equ 191 max index into the constant buffer lda cBuffLen if cBuffLen+1 >= maxCBuffLen then inc A cmp #maxCBuffLen blt lb1 jsl Purge Purge; lb1 phb cBuff[cBuffLen] := i; plx ply pla phy phx plb ldx cBuffLen sta cBuff,X inx cBuffLen := cBuffLen+2; inx stx cBuffLen rtl end **************************************************************** * * COut - write a code byte to the object file * * Inputs: * b - byte to write (on stack) * **************************************************************** * COut start phb OutByte(b); pla ply plx phy pha plb jsr OutByte inc blkcnt blkcnt := blkcnt+1; inc4 pc pc := pc+1; rtl end **************************************************************** * * Out2 - write a word to the output file * * Inputs: * w - word to write (on stack) * **************************************************************** * Out2 start phb OutWord(w); pla ply plx phy pha plb jsr OutWord inc blkcnt blkcnt := blkcnt+2; inc blkcnt rtl end **************************************************************** * * Out - write a byte to the output file * * Inputs: * b - byte to write (on stack) * **************************************************************** * Out start phb OutByte(b); pla ply plx phy pha plb jsr OutByte inc blkcnt blkcnt := blkcnt+1; rtl end **************************************************************** * * OutByte - write a byte to the object file * * Inputs: * X - byte to write * **************************************************************** * OutByte private lda objLen if objLen+segDisp = buffSize then clc adc segDisp bcc lb2 phx PurgeObjBuffer; jsl PurgeObjBuffer plx lda objLen check for segment overflow clc adc segDisp bcs lb2a lb2 ph4 objPtr p := pointer(ord4(objPtr)+segDisp); tsc p^ := b; phd tcd ldy segDisp short M txa sta [1],Y long M inc segDisp segDisp := segDisp+1; pld tsc clc adc #4 tcs rts lb2a lda #$8000 handle a segment overflow sta segDisp ph2 #112 jsl Error rts end **************************************************************** * * OutWord - write a word to the object file * * Inputs: * X - word to write * **************************************************************** * OutWord private lda objLen if objLen+segDisp+1 = buffSize then sec adc segDisp bcc lb2 phx PurgeObjBuffer; jsl PurgeObjBuffer plx lda objLen check for segment overflow sec adc segDisp bcs lb3 lb2 ph4 objPtr p := pointer(ord4(objPtr)+segDisp); tsc p^ := b; phd tcd ldy segDisp txa sta [1],Y iny segDisp := segDisp+2; iny sty segDisp save new segDisp pld tsc clc adc #4 tcs rts lb3 ph2 #112 flag segment overflow error jsl Error lda #$8000 sta segDisp rts end \ No newline at end of file + mcopy objout.macros +**************************************************************** +* +* CnOut - write a byte to the constant buffer +* +* Inputs: +* i - byte to write +* +**************************************************************** +* +CnOut start +maxCBuffLen equ 191 max index into the constant buffer + + lda cBuffLen if cBuffLen = maxCBuffLen then + cmp #maxCBuffLen + bne lb1 + jsl Purge Purge; +lb1 phb cBuff[cBuffLen] := i; + plx + ply + pla + phy + phx + plb + ldx cBuffLen + short M + sta cBuff,X + long M + inc cBuffLen cBuffLen := cBuffLen+1; + rtl + end + +**************************************************************** +* +* CnOut2 - write a word to the constant buffer +* +* Inputs: +* i - word to write +* +**************************************************************** +* +CnOut2 start +maxCBuffLen equ 191 max index into the constant buffer + + lda cBuffLen if cBuffLen+1 >= maxCBuffLen then + inc A + cmp #maxCBuffLen + blt lb1 + jsl Purge Purge; +lb1 phb cBuff[cBuffLen] := i; + plx + ply + pla + phy + phx + plb + ldx cBuffLen + sta cBuff,X + inx cBuffLen := cBuffLen+2; + inx + stx cBuffLen + rtl + end + +**************************************************************** +* +* COut - write a code byte to the object file +* +* Inputs: +* b - byte to write (on stack) +* +**************************************************************** +* +COut start + + phb OutByte(b); + pla + ply + plx + phy + pha + plb + jsr OutByte + inc blkcnt blkcnt := blkcnt+1; + inc4 pc pc := pc+1; + rtl + end + +**************************************************************** +* +* Out2 - write a word to the output file +* +* Inputs: +* w - word to write (on stack) +* +**************************************************************** +* +Out2 start + + phb OutWord(w); + pla + ply + plx + phy + pha + plb + jsr OutWord + inc blkcnt blkcnt := blkcnt+2; + inc blkcnt + rtl + end + +**************************************************************** +* +* Out - write a byte to the output file +* +* Inputs: +* b - byte to write (on stack) +* +**************************************************************** +* +Out start + + phb OutByte(b); + pla + ply + plx + phy + pha + plb + jsr OutByte + inc blkcnt blkcnt := blkcnt+1; + rtl + end + +**************************************************************** +* +* OutByte - write a byte to the object file +* +* Inputs: +* X - byte to write +* +**************************************************************** +* +OutByte private + + lda objLen if objLen+segDisp = buffSize then + clc + adc segDisp + bcc lb2 + phx PurgeObjBuffer; + jsl PurgeObjBuffer + plx + lda objLen check for segment overflow + clc + adc segDisp + bcs lb2a +lb2 ph4 objPtr p := pointer(ord4(objPtr)+segDisp); + tsc p^ := b; + phd + tcd + ldy segDisp + short M + txa + sta [1],Y + long M + inc segDisp segDisp := segDisp+1; + + pld + tsc + clc + adc #4 + tcs + rts + +lb2a lda #$8000 handle a segment overflow + sta segDisp + ph2 #112 + jsl Error + rts + end + +**************************************************************** +* +* OutWord - write a word to the object file +* +* Inputs: +* X - word to write +* +**************************************************************** +* +OutWord private + + lda objLen if objLen+segDisp+1 = buffSize then + sec + adc segDisp + bcc lb2 + phx PurgeObjBuffer; + jsl PurgeObjBuffer + plx + lda objLen check for segment overflow + sec + adc segDisp + bcs lb3 +lb2 ph4 objPtr p := pointer(ord4(objPtr)+segDisp); + tsc p^ := b; + phd + tcd + ldy segDisp + txa + sta [1],Y + iny segDisp := segDisp+2; + iny + sty segDisp save new segDisp + + pld + tsc + clc + adc #4 + tcs + rts + +lb3 ph2 #112 flag segment overflow error + jsl Error + lda #$8000 + sta segDisp + rts + end diff --git a/ObjOut.macros b/ObjOut.macros old mode 100755 new mode 100644 index e704a43..a94011d --- a/ObjOut.macros +++ b/ObjOut.macros @@ -1 +1,253 @@ - MACRO &LAB LONG &A,&B LCLB &I LCLB &M &A AMID &A,1,1 &M SETB ("&A"="M").OR.("&A"="m") &I SETB ("&A"="I").OR.("&A"="i") AIF C:&B=0,.A &B AMID &B,1,1 &M SETB ("&B"="M").OR.("&B"="m").OR.&M &I SETB ("&B"="I").OR.("&B"="i").OR.&I .A &LAB REP #&M*32+&I*16 AIF .NOT.&M,.B LONGA ON .B AIF .NOT.&I,.C LONGI ON .C MEND MACRO &LAB PH4 &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"="#",.D AIF S:LONGA=1,.A REP #%00100000 .A AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 LDY #2 LDA (&N1),Y PHA LDA (&N1) PHA AGO .E .B AIF "&C"<>"[",.C LDY #2 LDA &N1,Y PHA LDA &N1 PHA AGO .E .C LDA &N1+2 PHA LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA +(&N1)|-16 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &LAB SHORT &A,&B LCLB &I LCLB &M &A AMID &A,1,1 &M SETB ("&A"="M").OR.("&A"="m") &I SETB ("&A"="I").OR.("&A"="i") AIF C:&B=0,.A &B AMID &B,1,1 &M SETB ("&B"="M").OR.("&B"="m").OR.&M &I SETB ("&B"="I").OR.("&B"="i").OR.&I .A &LAB SEP #&M*32+&I*16 AIF .NOT.&M,.B LONGA OFF .B AIF .NOT.&I,.C LONGI OFF .C MEND MACRO &LAB INC4 &A &LAB ~SETM INC &A BNE ~&SYSCNT INC 2+&A ~&SYSCNT ~RESTM MEND MACRO &LAB ~SETM &LAB ANOP AIF C:&~LA,.B GBLB &~LA GBLB &~LI .B &~LA SETB S:LONGA &~LI SETB S:LONGI AIF S:LONGA.AND.S:LONGI,.A REP #32*(.NOT.&~LA)+16*(.NOT.&~LI) LONGA ON LONGI ON .A MEND MACRO &LAB ~RESTM &LAB ANOP AIF (&~LA+&~LI)=2,.I SEP #32*(.NOT.&~LA)+16*(.NOT.&~LI) AIF &~LA,.H LONGA OFF .H AIF &~LI,.I LONGI OFF .I MEND MACRO &LAB PUT2 &N1,&F1,&CR,&ERROUT AIF C:&F1,.A LCLC &F1 &F1 SETC #0 .A &LAB ~SETM PH2 &N1 PH2 &F1 PH2 #C:&CR PH2 #C:&ERROUT JSL ~PUT2 ~RESTM MEND MACRO &LAB PUT4 &N1,&F1,&CR,&ERROUT AIF C:&F1,.A LCLC &F1 &F1 SETC #0 .A &LAB ~SETM PH4 &N1 PH2 &F1 PH2 #C:&CR PH2 #C:&ERROUT JSL ~PUT4 ~RESTM MEND MACRO &LAB PUTS &N1,&F1,&CR,&ERROUT &LAB ~SETM LCLC &C &C AMID "&N1",1,1 AIF "&C"<>"#",.C AIF L:&N1>127,.A BRA ~&SYSCNT AGO .B .A BRL ~&SYSCNT .B &N1 AMID "&N1",2,L:&N1-1 ~L&SYSCNT DC I1"L:~S&SYSCNT" ~S&SYSCNT DC C&N1 ~&SYSCNT ANOP &N1 SETC ~L&SYSCNT-1 AIF C:&F1=0,.D .C ~PUSHA &N1 AIF C:&F1,.C1 PEA 0 AGO .C2 .C1 PH2 &F1 .C2 PH2 #C:&CR PH2 #C:&ERROUT JSL ~PUTS ~RESTM MEXIT .D PEA ~L&SYSCNT|-16 PEA ~L&SYSCNT LDX #$1C0C+(C:&ERROUT*256)-(512*C:&CR) JSL $E10000 ~RESTM MEND MACRO &LAB ~PUSHA &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 SEP #$20 LONGA OFF LDA #0 PHA REP #$20 LONGA ON PHK LDA &N1 PHA MEXIT .B AIF "&C"<>"[",.C &N1 AMID &N1,2,L:&N1-2 LDA &N1+2 PHA LDA &N1 PHA MEXIT .C PEA +(&N1)|-16 PEA &N1 MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &LAB PH2 &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"="#",.D AIF S:LONGA=1,.A REP #%00100000 .A AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 LDA (&N1) PHA AGO .E .B LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND \ No newline at end of file + MACRO +&LAB LONG &A,&B + LCLB &I + LCLB &M +&A AMID &A,1,1 +&M SETB ("&A"="M").OR.("&A"="m") +&I SETB ("&A"="I").OR.("&A"="i") + AIF C:&B=0,.A +&B AMID &B,1,1 +&M SETB ("&B"="M").OR.("&B"="m").OR.&M +&I SETB ("&B"="I").OR.("&B"="i").OR.&I +.A +&LAB REP #&M*32+&I*16 + AIF .NOT.&M,.B + LONGA ON +.B + AIF .NOT.&I,.C + LONGI ON +.C + MEND + MACRO +&LAB PH4 &N1 + LCLC &C +&LAB ANOP +&C AMID &N1,1,1 + AIF "&C"="#",.D + AIF S:LONGA=1,.A + REP #%00100000 +.A + AIF "&C"<>"{",.B +&C AMID &N1,L:&N1,1 + AIF "&C"<>"}",.G +&N1 AMID &N1,2,L:&N1-2 + LDY #2 + LDA (&N1),Y + PHA + LDA (&N1) + PHA + AGO .E +.B + AIF "&C"<>"[",.C + LDY #2 + LDA &N1,Y + PHA + LDA &N1 + PHA + AGO .E +.C + LDA &N1+2 + PHA + LDA &N1 + PHA + AGO .E +.D +&N1 AMID &N1,2,L:&N1-1 + PEA +(&N1)|-16 + PEA &N1 + AGO .F +.E + AIF S:LONGA=1,.F + SEP #%00100000 +.F + MEXIT +.G + MNOTE "Missing closing '}'",16 + MEND + MACRO +&LAB SHORT &A,&B + LCLB &I + LCLB &M +&A AMID &A,1,1 +&M SETB ("&A"="M").OR.("&A"="m") +&I SETB ("&A"="I").OR.("&A"="i") + AIF C:&B=0,.A +&B AMID &B,1,1 +&M SETB ("&B"="M").OR.("&B"="m").OR.&M +&I SETB ("&B"="I").OR.("&B"="i").OR.&I +.A +&LAB SEP #&M*32+&I*16 + AIF .NOT.&M,.B + LONGA OFF +.B + AIF .NOT.&I,.C + LONGI OFF +.C + MEND + MACRO +&LAB INC4 &A +&LAB ~SETM + INC &A + BNE ~&SYSCNT + INC 2+&A +~&SYSCNT ~RESTM + MEND + MACRO +&LAB ~SETM +&LAB ANOP + AIF C:&~LA,.B + GBLB &~LA + GBLB &~LI +.B +&~LA SETB S:LONGA +&~LI SETB S:LONGI + AIF S:LONGA.AND.S:LONGI,.A + REP #32*(.NOT.&~LA)+16*(.NOT.&~LI) + LONGA ON + LONGI ON +.A + MEND + MACRO +&LAB ~RESTM +&LAB ANOP + AIF (&~LA+&~LI)=2,.I + SEP #32*(.NOT.&~LA)+16*(.NOT.&~LI) + AIF &~LA,.H + LONGA OFF +.H + AIF &~LI,.I + LONGI OFF +.I + MEND + MACRO +&LAB PUT2 &N1,&F1,&CR,&ERROUT + AIF C:&F1,.A + LCLC &F1 +&F1 SETC #0 +.A +&LAB ~SETM + PH2 &N1 + PH2 &F1 + PH2 #C:&CR + PH2 #C:&ERROUT + JSL ~PUT2 + ~RESTM + MEND + MACRO +&LAB PUT4 &N1,&F1,&CR,&ERROUT + AIF C:&F1,.A + LCLC &F1 +&F1 SETC #0 +.A +&LAB ~SETM + PH4 &N1 + PH2 &F1 + PH2 #C:&CR + PH2 #C:&ERROUT + JSL ~PUT4 + ~RESTM + MEND + MACRO +&LAB PUTS &N1,&F1,&CR,&ERROUT +&LAB ~SETM + LCLC &C +&C AMID "&N1",1,1 + AIF "&C"<>"#",.C + AIF L:&N1>127,.A + BRA ~&SYSCNT + AGO .B +.A + BRL ~&SYSCNT +.B +&N1 AMID "&N1",2,L:&N1-1 +~L&SYSCNT DC I1"L:~S&SYSCNT" +~S&SYSCNT DC C&N1 +~&SYSCNT ANOP +&N1 SETC ~L&SYSCNT-1 + AIF C:&F1=0,.D +.C + ~PUSHA &N1 + AIF C:&F1,.C1 + PEA 0 + AGO .C2 +.C1 + PH2 &F1 +.C2 + PH2 #C:&CR + PH2 #C:&ERROUT + JSL ~PUTS + ~RESTM + MEXIT +.D + PEA ~L&SYSCNT|-16 + PEA ~L&SYSCNT + LDX #$1C0C+(C:&ERROUT*256)-(512*C:&CR) + JSL $E10000 + ~RESTM + MEND + MACRO +&LAB ~PUSHA &N1 + LCLC &C +&LAB ANOP +&C AMID &N1,1,1 + AIF "&C"<>"{",.B +&C AMID &N1,L:&N1,1 + AIF "&C"<>"}",.G +&N1 AMID &N1,2,L:&N1-2 + SEP #$20 + LONGA OFF + LDA #0 + PHA + REP #$20 + LONGA ON + PHK + LDA &N1 + PHA + MEXIT +.B + AIF "&C"<>"[",.C +&N1 AMID &N1,2,L:&N1-2 + LDA &N1+2 + PHA + LDA &N1 + PHA + MEXIT +.C + PEA +(&N1)|-16 + PEA &N1 + MEXIT +.G + MNOTE "Missing closing '}'",16 + MEND + MACRO +&LAB PH2 &N1 + LCLC &C +&LAB ANOP +&C AMID &N1,1,1 + AIF "&C"="#",.D + AIF S:LONGA=1,.A + REP #%00100000 +.A + AIF "&C"<>"{",.B +&C AMID &N1,L:&N1,1 + AIF "&C"<>"}",.G +&N1 AMID &N1,2,L:&N1-2 + LDA (&N1) + PHA + AGO .E +.B + LDA &N1 + PHA + AGO .E +.D +&N1 AMID &N1,2,L:&N1-1 + PEA &N1 + AGO .F +.E + AIF S:LONGA=1,.F + SEP #%00100000 +.F + MEXIT +.G + MNOTE "Missing closing '}'",16 + MEND diff --git a/ObjOut.pas b/ObjOut.pas old mode 100755 new mode 100644 index 0f49044..f8f861d --- a/ObjOut.pas +++ b/ObjOut.pas @@ -1 +1,595 @@ -{$optimize 7} {---------------------------------------------------------------} { } { ObjOut } { } { This unit has the primitive routines used to actually } { create and write to object modules. A few low-level } { subroutines that need to be in assembly language for speed } { are also included here. } { } { External Subroutines: } { } { CloseObj - close the current obj file } { CloseSeg - close out the current segment } { COut - write a code byte to the object file } { CnOut - write a byte to the constant buffer } { CnOut2 - write a word to the constant buffer } { DestroySuffixes - destroy the .a, .b, etc suffixes } { FindSuffix - find the next available alphabetic suffix } { Header - write a segment header to the output file } { OpenObj - open a new obj file with the indicated file name } { OpenSeg - create a new segment and mark its beginning } { Out - write a byte to the output file } { Out2 - write a word to the output file } { Purge - write any constant bytes to the output buffer } { } {---------------------------------------------------------------} unit CCommon; interface {$LibPrefix '0/obj/'} uses CCommon, CGI, CGC; {$segment 'CodeGen'} procedure CloseObj; { close the current obj file } { } { Note: Declared as extern in CGI.pas } procedure COut (b: integer); extern; { write a code byte to the object file } { } { parameters: } { b - byte to write } procedure CnOut (i: integer); extern; { write a byte to the constant buffer } { } { parameters: } { i - byte to write } procedure CnOut2 (i: integer); extern; { write a word to the constant buffer } { } { parameters: } { i - word to write } procedure DestroySuffixes (var name: gsosOutString); { destroy the .a, .b, etc suffixes } { } { parameters: } { name - root name of file sequence to destroy } procedure CloseSeg; { close out the current segment } procedure FindSuffix (var name: gsosOutString; var ch: char); { find the next available alphabetic suffix } { } { parameters: } { ch - addr to place suffix character } { name - root name of suffix to find } procedure Header (name: stringPtr; kind: integer; lengthCode: integer); { write a segment header to the output file } { } { parameters: } { name - name of the segment } { kind - segment kind } { lengthCode - code bank size code; bank size div $10000 } procedure OpenSeg; { create a new segment and mark its beginning } procedure OpenObj (var name: gsosOutString); { open a new obj file with the indicated file name } { } { parameters: } { name - object file name } procedure Out (b: integer); extern; { write a byte to the output file } { } { parameters: } { b - byte to write } procedure Out2 (w: integer); extern; { write a word to the output file } { } { parameters: } { w - word to write } procedure Purge; { write any constant bytes to the output buffer } {---------------------------------------------------------------} implementation const {NOTE: OutByte and Outword assume } { buffSize is 64K } buffSize = 65536; {size of the obj buffer} maxCBuffLen = 191; {length of the constant buffer} OBJ = $B1; {object file type} type closeOSDCB = record {Close DCB} pcount: integer; refNum: integer; end; createOSDCB = record {Create DCB} pcount: integer; pathName: gsosInStringPtr; access: integer; fileType: integer; auxType: longint; storageType: integer; dataEOF: longint; resourceEOF: longint; end; destroyOSDCB = record {Destroy DCB} pcount: integer; pathName: gsosInStringPtr; end; getFileInfoOSDCB = record {GetFileInfo DCB} pcount: integer; pathName: gsosInStringPtr; access: integer; fileType: integer; auxType: longint; storageType: integer; createDateTime: timeField; modDateTime: timeField; optionList: optionListPtr; dataEOF: longint; blocksUsed: longint; resourceEOF: longint; resourceBlocks: longint; end; openOSDCB = record {Open DCB} pcount: integer; refNum: integer; pathName: gsosInStringPtr; requestAccess: integer; resourceNumber: integer; access: integer; fileType: integer; auxType: longint; storageType: integer; createDateTime: timeField; modDateTime: timeField; optionList: optionListPtr; dataEOF: longint; blocksUsed: longint; resourceEOF: longint; resourceBlocks: longint; end; readWriteOSDCB = record {WriteGS DCB} pcount: integer; refNum: integer; dataBuffer: ptr; requestCount: longint; transferCount: longint; cachePriority: integer; end; {---------------------------------------------------------------} var cBuff: array[0..maxCBuffLen] of byte; {constant buffer} objLen: longint; {# bytes used in obj buffer} objHandle: handle; {handle of the obj buffer} objPtr: ptr; {pointer to the next spot in the obj buffer} segStart: ptr; {points to first byte in current segment} spoolRefnum: integer; {reference number for open file} {---------------------------------------------------------------} {memory manager calls} {--------------------} procedure BlockMove (sourcPtr, destPtr: ptr; count: longint); tool ($02, $2B); function NewHandle (blockSize: longint; userID, memAttributes: integer; memLocation: ptr): handle; tool($02, $09); procedure SetHandleSize (newSize: longint; theHandle: handle); tool ($02, $19); procedure HUnLock (theHandle: handle); tool ($02, $22); procedure HLock (theHandle: handle); tool ($02, $20); {ProDOS calls} {------------} procedure CloseGS (var parms: closeOSDCB); prodos ($2014); procedure CreateGS (var parms: createOSDCB); prodos ($2001); procedure DestroyGS (var parms: destroyOSDCB); prodos ($2002); procedure GetFileInfoGS (var parms: getFileInfoOSDCB); prodos ($2006); procedure OpenGS (var parms: openOSDCB); prodos ($2010); procedure WriteGS (var parms: readWriteOSDCB); prodos ($2013); {---------------------------------------------------------------} procedure PurgeObjBuffer; { Spool any completed segments to the object file } var len: longint; {# bytes to write} sPtr: ptr; {start of object buffer} wrRec: readWriteOSDCB; {WriteGS record} procedure InitSpoolFile; { Set up the spool file } var dsRec: destroyOSDCB; {DestroyGS record} crRec: createOSDCB; {CreateGS record} opRec: openOSDCB; {OpenGS record} begin {InitSpoolFile} if memoryCompile then {make sure this is a disk-based compile} TermError(11); dsRec.pCount := 1; {destroy any old file} dsRec.pathname := @objFile.theString; DestroyGS(dsRec); crRec.pCount := 5; {create a new file} crRec.pathName := @objFile.theString; crRec.access := $C3; crRec.fileType := OBJ; crRec.auxType := $0000; crRec.storageType := 1; CreateGS(crRec); if ToolError <> 0 then TermError(9); opRec.pCount := 3; {open the file} opRec.pathname := @objFile.theString; opRec.requestAccess := 3; OpenGS(opRec); if ToolError <> 0 then TermError(9); spoolRefnum := opRec.refnum; end; {InitSpoolFile} begin {PurgeObjBuffer} if spoolRefnum = 0 then {make sure the spool file exists} InitSpoolFile; sPtr := objHandle^; {determine size of completed segments} len := ord4(segStart) - ord4(sPtr); if len <> 0 then begin wrRec.pcount := 4; {write completed segments} wrRec.refnum := spoolRefnum; wrRec.dataBuffer := pointer(sPtr); wrRec.requestCount := len; WriteGS(wrRec); if ToolError <> 0 then {check for write errors} TermError(9); objLen := 0; {adjust file pointers} BlockMove(segStart, sPtr, ord4(segDisp) & $00FFFF); objPtr := sPtr; segStart := sPtr; end; {if} end; {PurgeObjBuffer} {---------------------------------------------------------------} procedure CloseObj; { close the current obj file } { } { Note: Declared as extern in CGI.pas } var clRec: closeOSDCB; {CloseGS record} ffDCBGS: fastFileDCBGS; {dcb for fastfile call} i: integer; {loop/index variable} begin {CloseObj} if spoolRefnum <> 0 then begin PurgeObjBuffer; clRec.pCount := 1; clRec.refnum := spoolRefnum; CloseGS(clRec); end {if} else if objLen <> 0 then begin {resize the buffer} HUnLock(objHandle); SetHandleSize(objLen, objHandle); HLock(objHandle); {save the file} ffDCBGS.pCount := 14; ffDCBGS.fileHandle := objHandle; ffDCBGS.pathName := @objFile.theString; ffDCBGS.access := $C3; ffDCBGS.fileType := OBJ; ffDCBGS.auxType := 0; ffDCBGS.storageType := 1; for i := 1 to 8 do ffDCBGS.createDate[i] := 0; ffDCBGS.modDate := ffDCBGS.createDate; ffDCBGS.option := nil; ffDCBGS.fileLength := objLen; if memoryCompile then begin ffDCBGS.flags := 0; ffDCBGS.action := 4; end {if} else begin ffDCBGS.flags := $C000; ffDCBGS.action := 3; end; {else} FastFileGS(ffDCBGS); if ToolError <> 0 then TermError(9) else begin ffDCBGS.PATHName := @objFile.theString; ffDCBGS.action := 7; FastFileGS(ffDCBGS); end; {else} end; {if} end; {CloseObj} procedure DestroySuffixes {var name: gsosOutString}; { destroy the .a, .b, etc suffixes } { } { parameters: } { name - root name of file sequence to destroy } var done: boolean; {loop termination flag} dsDCBGS: destroyOSDCB; {dcb for destroy call} giDCBGS: getFileInfoOSDCB; {dcb for Get_File_Info call} suffix: char; {current suffix character} fName: gsosInString; {work file name} begin {DestroySuffixes} suffix := 'a'; done := false; repeat fName := name.theString; if fName.size > maxPath-2 then fName.size := maxPath-2; fName.theString[fName.size+1] := '.'; fName.theString[fName.size+2] := suffix; fName.size := fName.size + 2; giDCBGS.pCount := 12; giDCBGS.optionList := nil; giDCBGS.pathName := @fName; GetFileInfoGS(giDCBGS); if ToolError = 0 then begin if giDCBGS.fileType = OBJ then begin dsDCBGS.pCount := 1; dsDCBGS.pathName := @fName; DestroyGS(dsDCBGS); end; {if} end {if} else done := true; suffix := succ(suffix); until done; end; {DestroySuffixes} procedure CloseSeg; { close out the current segment } { } { variables: } { objHandle - segment handle } { objLen - used bytes in the segment } { objPtr - set to point to a fresh segment } var longPtr: ^longint; {used to set the block count} begin {CloseSeg} longPtr := pointer(objPtr); {set the block count} longPtr^ := ord4(segDisp) & $00FFFF; objLen := objLen + (ord4(segDisp) & $00FFFF); {update the length of the obj file} objPtr := pointer(ord4(objHandle^)+objLen); {set objPtr} segStart := objPtr; if objLen = buffSize then PurgeObjBuffer; end; {CloseSeg} procedure FindSuffix {var name: gsosOutString; var ch: char}; { find the next available alphabetic suffix } { } { parameters: } { ch - addr to place suffix character } { name - root name of suffix to find } var done: boolean; {loop termination test} giDCBGS: getFileInfoOSDCB; {dcb for Get_File_Info call} fName: gsosInString; {work file name} begin {FindSuffix} ch := 'a'; done := false; repeat fName := name.theString; if fName.size > maxPath-2 then fName.size := maxPath-2; fName.theString[fName.size+1] := '.'; fName.theString[fName.size+2] := ch; fName.size := fName.size + 2; giDCBGS.pCount := 12; giDCBGS.optionList := nil; giDCBGS.pathName := @fName; GetFileInfoGS(giDCBGS); if ToolError = 0 then ch := succ(ch) else done := true; until done; end; {FindSuffix} procedure Header {name: stringPtr; kind: integer; lengthCode: integer}; { write a segment header to the output file } { } { parameters: } { name - name of the segment } { kind - segment kind } { lengthCode - code bank size code; bank size div $10000 } var i: integer; {loop var} len: integer; {length of string} begin {Header} OpenSeg; {start the new segment} blkcnt := 0; segdisp := 0; for i := 1 to 12 do {blkcnt,resspc,length} Out(0); Out(0); {unused} Out(0); {lablen} Out(4); {numlen} Out(2); {version} Out2(0); Out2(ord(lengthcode=0)); {cbanksize} Out2(kind|segmentKind); {kind} for i := 1 to 9 do {unused,org,align,numsex,unused,segnum,entry} Out2(0); len := length(name^); {dispname,dispdata} Out2($30); Out2($3B+len); Out2(0); Out2(0); {temporg} for i := 1 to 10 do {write the segment name} Out(ord(currentSegment[i])); currentSegment := defaultSegment; {revert to default segment name} Out(len); {segname} for i := 1 to len do Out(ord(name^[i])); end; {Header} procedure OpenSeg; { create a new segment and mark its beginning } begin {OpenSeg} segDisp := 0; segStart := objPtr; end; {OpenSeg} procedure OpenObj {var name: gsosOutString}; { open a new obj file with the indicated file name } { } { parameters: } { name - object file name } var dsDCBGS: destroyOSDCB; {dcb for Destroy call} giDCBGS: getFileInfoOSDCB; {dcb for Get_File_Info call} begin {OpenObj} {the file is not spooled (yet)} spoolRefnum := 0; {if there is an existing file, delete it} if memoryCompile then begin giDCBGS.pCount := 3; giDCBGS.pathName := @name.theString; GetFileInfoGS(giDCBGS); if ToolError = 0 then if giDCBGS.fileType = OBJ then begin dsDCBGS.pCount := 1; dsDCBGS.pathName := @name.theString; DestroyGS(dsDCBGS); end; {if} end; {if} {allocate memory for an initial buffer} objHandle := pointer(NewHandle(buffSize, userID, $8000, nil)); {set up the buffer variables} if ToolError = 0 then begin objLen := 0; objPtr := objHandle^; end {if} else TermError(5); {save the object file name} objFile := name; end; {OpenObj} procedure Purge; { write any constant bytes to the output buffer } var i: integer; {loop variable} begin {Purge} if cBuffLen <> 0 then begin Out(cBuffLen); for i := 0 to cBuffLen-1 do COut(cBuff[i]); cBuffLen := 0; end; {if} end; {Purge} end. {$append 'objout.asm'} \ No newline at end of file +{$optimize 7} +{---------------------------------------------------------------} +{ } +{ ObjOut } +{ } +{ This unit has the primitive routines used to actually } +{ create and write to object modules. A few low-level } +{ subroutines that need to be in assembly language for speed } +{ are also included here. } +{ } +{ External Subroutines: } +{ } +{ CloseObj - close the current obj file } +{ CloseSeg - close out the current segment } +{ COut - write a code byte to the object file } +{ CnOut - write a byte to the constant buffer } +{ CnOut2 - write a word to the constant buffer } +{ DestroySuffixes - destroy the .a, .b, etc suffixes } +{ FindSuffix - find the next available alphabetic suffix } +{ Header - write a segment header to the output file } +{ OpenObj - open a new obj file with the indicated file name } +{ OpenSeg - create a new segment and mark its beginning } +{ Out - write a byte to the output file } +{ Out2 - write a word to the output file } +{ Purge - write any constant bytes to the output buffer } +{ } +{---------------------------------------------------------------} + +unit CCommon; + +interface + +{$LibPrefix '0/obj/'} + +uses CCommon, CGI, CGC; + +{$segment 'CodeGen'} + + +procedure CloseObj; + +{ close the current obj file } +{ } +{ Note: Declared as extern in CGI.pas } + + +procedure COut (b: integer); extern; + +{ write a code byte to the object file } +{ } +{ parameters: } +{ b - byte to write } + + +procedure CnOut (i: integer); extern; + +{ write a byte to the constant buffer } +{ } +{ parameters: } +{ i - byte to write } + + +procedure CnOut2 (i: integer); extern; + +{ write a word to the constant buffer } +{ } +{ parameters: } +{ i - word to write } + + +procedure DestroySuffixes (var name: gsosOutString); + +{ destroy the .a, .b, etc suffixes } +{ } +{ parameters: } +{ name - root name of file sequence to destroy } + + +procedure CloseSeg; + +{ close out the current segment } + + +procedure FindSuffix (var name: gsosOutString; var ch: char); + +{ find the next available alphabetic suffix } +{ } +{ parameters: } +{ ch - addr to place suffix character } +{ name - root name of suffix to find } + + +procedure Header (name: stringPtr; kind: integer; lengthCode: integer); + +{ write a segment header to the output file } +{ } +{ parameters: } +{ name - name of the segment } +{ kind - segment kind } +{ lengthCode - code bank size code; bank size div $10000 } + + +procedure OpenSeg; + +{ create a new segment and mark its beginning } + + +procedure OpenObj (var name: gsosOutString); + +{ open a new obj file with the indicated file name } +{ } +{ parameters: } +{ name - object file name } + + +procedure Out (b: integer); extern; + +{ write a byte to the output file } +{ } +{ parameters: } +{ b - byte to write } + + +procedure Out2 (w: integer); extern; + +{ write a word to the output file } +{ } +{ parameters: } +{ w - word to write } + + +procedure Purge; + +{ write any constant bytes to the output buffer } + +{---------------------------------------------------------------} + +implementation + +const + {NOTE: OutByte and Outword assume } + { buffSize is 64K } + buffSize = 65536; {size of the obj buffer} + maxCBuffLen = 191; {length of the constant buffer} + OBJ = $B1; {object file type} + +type + closeOSDCB = record {Close DCB} + pcount: integer; + refNum: integer; + end; + + createOSDCB = record {Create DCB} + pcount: integer; + pathName: gsosInStringPtr; + access: integer; + fileType: integer; + auxType: longint; + storageType: integer; + dataEOF: longint; + resourceEOF: longint; + end; + + destroyOSDCB = record {Destroy DCB} + pcount: integer; + pathName: gsosInStringPtr; + end; + + getFileInfoOSDCB = record {GetFileInfo DCB} + pcount: integer; + pathName: gsosInStringPtr; + access: integer; + fileType: integer; + auxType: longint; + storageType: integer; + createDateTime: timeField; + modDateTime: timeField; + optionList: optionListPtr; + dataEOF: longint; + blocksUsed: longint; + resourceEOF: longint; + resourceBlocks: longint; + end; + + openOSDCB = record {Open DCB} + pcount: integer; + refNum: integer; + pathName: gsosInStringPtr; + requestAccess: integer; + resourceNumber: integer; + access: integer; + fileType: integer; + auxType: longint; + storageType: integer; + createDateTime: timeField; + modDateTime: timeField; + optionList: optionListPtr; + dataEOF: longint; + blocksUsed: longint; + resourceEOF: longint; + resourceBlocks: longint; + end; + + readWriteOSDCB = record {WriteGS DCB} + pcount: integer; + refNum: integer; + dataBuffer: ptr; + requestCount: longint; + transferCount: longint; + cachePriority: integer; + end; + +{---------------------------------------------------------------} + +var + cBuff: array[0..maxCBuffLen] of byte; {constant buffer} + + objLen: longint; {# bytes used in obj buffer} + objHandle: handle; {handle of the obj buffer} + objPtr: ptr; {pointer to the next spot in the obj buffer} + + segStart: ptr; {points to first byte in current segment} + spoolRefnum: integer; {reference number for open file} + +{---------------------------------------------------------------} + + {memory manager calls} + {--------------------} + +procedure BlockMove (sourcPtr, destPtr: ptr; count: longint); tool ($02, $2B); + +function NewHandle (blockSize: longint; userID, memAttributes: integer; + memLocation: ptr): handle; tool($02, $09); + +procedure SetHandleSize (newSize: longint; theHandle: handle); tool ($02, $19); + +procedure HUnLock (theHandle: handle); tool ($02, $22); + +procedure HLock (theHandle: handle); tool ($02, $20); + + {ProDOS calls} + {------------} + +procedure CloseGS (var parms: closeOSDCB); prodos ($2014); + +procedure CreateGS (var parms: createOSDCB); prodos ($2001); + +procedure DestroyGS (var parms: destroyOSDCB); prodos ($2002); + +procedure GetFileInfoGS (var parms: getFileInfoOSDCB); prodos ($2006); + +procedure OpenGS (var parms: openOSDCB); prodos ($2010); + +procedure WriteGS (var parms: readWriteOSDCB); prodos ($2013); + +{---------------------------------------------------------------} + +procedure PurgeObjBuffer; + +{ Spool any completed segments to the object file } + +var + len: longint; {# bytes to write} + sPtr: ptr; {start of object buffer} + wrRec: readWriteOSDCB; {WriteGS record} + + + procedure InitSpoolFile; + + { Set up the spool file } + + var + dsRec: destroyOSDCB; {DestroyGS record} + crRec: createOSDCB; {CreateGS record} + opRec: openOSDCB; {OpenGS record} + + begin {InitSpoolFile} + if memoryCompile then {make sure this is a disk-based compile} + TermError(11); + dsRec.pCount := 1; {destroy any old file} + dsRec.pathname := @objFile.theString; + DestroyGS(dsRec); + crRec.pCount := 5; {create a new file} + crRec.pathName := @objFile.theString; + crRec.access := $C3; + crRec.fileType := OBJ; + crRec.auxType := $0000; + crRec.storageType := 1; + CreateGS(crRec); + if ToolError <> 0 then + TermError(9); + opRec.pCount := 3; {open the file} + opRec.pathname := @objFile.theString; + opRec.requestAccess := 3; + OpenGS(opRec); + if ToolError <> 0 then + TermError(9); + spoolRefnum := opRec.refnum; + end; {InitSpoolFile} + + +begin {PurgeObjBuffer} +if spoolRefnum = 0 then {make sure the spool file exists} + InitSpoolFile; +sPtr := objHandle^; {determine size of completed segments} +len := ord4(segStart) - ord4(sPtr); +if len <> 0 then begin + wrRec.pcount := 4; {write completed segments} + wrRec.refnum := spoolRefnum; + wrRec.dataBuffer := pointer(sPtr); + wrRec.requestCount := len; + WriteGS(wrRec); + if ToolError <> 0 then {check for write errors} + TermError(9); + objLen := 0; {adjust file pointers} + BlockMove(segStart, sPtr, ord4(segDisp) & $00FFFF); + objPtr := sPtr; + segStart := sPtr; + end; {if} +end; {PurgeObjBuffer} + + +{---------------------------------------------------------------} + +procedure CloseObj; + +{ close the current obj file } +{ } +{ Note: Declared as extern in CGI.pas } + +var + clRec: closeOSDCB; {CloseGS record} + ffDCBGS: fastFileDCBGS; {dcb for fastfile call} + i: integer; {loop/index variable} + +begin {CloseObj} +if spoolRefnum <> 0 then begin + PurgeObjBuffer; + clRec.pCount := 1; + clRec.refnum := spoolRefnum; + CloseGS(clRec); + end {if} +else if objLen <> 0 then begin + {resize the buffer} + HUnLock(objHandle); + SetHandleSize(objLen, objHandle); + HLock(objHandle); + + {save the file} + ffDCBGS.pCount := 14; + ffDCBGS.fileHandle := objHandle; + ffDCBGS.pathName := @objFile.theString; + ffDCBGS.access := $C3; + ffDCBGS.fileType := OBJ; + ffDCBGS.auxType := 0; + ffDCBGS.storageType := 1; + for i := 1 to 8 do + ffDCBGS.createDate[i] := 0; + ffDCBGS.modDate := ffDCBGS.createDate; + ffDCBGS.option := nil; + ffDCBGS.fileLength := objLen; + if memoryCompile then begin + ffDCBGS.flags := 0; + ffDCBGS.action := 4; + end {if} + else begin + ffDCBGS.flags := $C000; + ffDCBGS.action := 3; + end; {else} + FastFileGS(ffDCBGS); + if ToolError <> 0 then + TermError(9) + else begin + ffDCBGS.PATHName := @objFile.theString; + ffDCBGS.action := 7; + FastFileGS(ffDCBGS); + end; {else} + end; {if} +end; {CloseObj} + + +procedure DestroySuffixes {var name: gsosOutString}; + +{ destroy the .a, .b, etc suffixes } +{ } +{ parameters: } +{ name - root name of file sequence to destroy } + +var + done: boolean; {loop termination flag} + dsDCBGS: destroyOSDCB; {dcb for destroy call} + giDCBGS: getFileInfoOSDCB; {dcb for Get_File_Info call} + suffix: char; {current suffix character} + + fName: gsosInString; {work file name} + +begin {DestroySuffixes} +suffix := 'a'; +done := false; +repeat + fName := name.theString; + if fName.size > maxPath-2 then + fName.size := maxPath-2; + fName.theString[fName.size+1] := '.'; + fName.theString[fName.size+2] := suffix; + fName.size := fName.size + 2; + giDCBGS.pCount := 12; + giDCBGS.optionList := nil; + giDCBGS.pathName := @fName; + GetFileInfoGS(giDCBGS); + if ToolError = 0 then begin + if giDCBGS.fileType = OBJ then begin + dsDCBGS.pCount := 1; + dsDCBGS.pathName := @fName; + DestroyGS(dsDCBGS); + end; {if} + end {if} + else + done := true; + suffix := succ(suffix); +until done; +end; {DestroySuffixes} + + +procedure CloseSeg; + +{ close out the current segment } +{ } +{ variables: } +{ objHandle - segment handle } +{ objLen - used bytes in the segment } +{ objPtr - set to point to a fresh segment } + +var + longPtr: ^longint; {used to set the block count} + +begin {CloseSeg} +longPtr := pointer(objPtr); {set the block count} +longPtr^ := ord4(segDisp) & $00FFFF; +objLen := objLen + (ord4(segDisp) & $00FFFF); {update the length of the obj file} +objPtr := pointer(ord4(objHandle^)+objLen); {set objPtr} +segStart := objPtr; +if objLen = buffSize then + PurgeObjBuffer; +end; {CloseSeg} + + +procedure FindSuffix {var name: gsosOutString; var ch: char}; + +{ find the next available alphabetic suffix } +{ } +{ parameters: } +{ ch - addr to place suffix character } +{ name - root name of suffix to find } + +var + done: boolean; {loop termination test} + giDCBGS: getFileInfoOSDCB; {dcb for Get_File_Info call} + + fName: gsosInString; {work file name} + +begin {FindSuffix} +ch := 'a'; +done := false; +repeat + fName := name.theString; + if fName.size > maxPath-2 then + fName.size := maxPath-2; + fName.theString[fName.size+1] := '.'; + fName.theString[fName.size+2] := ch; + fName.size := fName.size + 2; + giDCBGS.pCount := 12; + giDCBGS.optionList := nil; + giDCBGS.pathName := @fName; + GetFileInfoGS(giDCBGS); + if ToolError = 0 then + ch := succ(ch) + else + done := true; +until done; +end; {FindSuffix} + + +procedure Header {name: stringPtr; kind: integer; lengthCode: integer}; + +{ write a segment header to the output file } +{ } +{ parameters: } +{ name - name of the segment } +{ kind - segment kind } +{ lengthCode - code bank size code; bank size div $10000 } + + +var + i: integer; {loop var} + len: integer; {length of string} + +begin {Header} +OpenSeg; {start the new segment} +blkcnt := 0; segdisp := 0; +for i := 1 to 12 do {blkcnt,resspc,length} + Out(0); +Out(0); {unused} +Out(0); {lablen} +Out(4); {numlen} +Out(2); {version} +Out2(0); Out2(ord(lengthcode=0)); {cbanksize} +Out2(kind|segmentKind); {kind} +for i := 1 to 9 do {unused,org,align,numsex,unused,segnum,entry} + Out2(0); +len := length(name^); {dispname,dispdata} +Out2($30); Out2($3B+len); +Out2(0); Out2(0); {temporg} +for i := 1 to 10 do {write the segment name} + Out(ord(currentSegment[i])); +currentSegment := defaultSegment; {revert to default segment name} +Out(len); {segname} +for i := 1 to len do + Out(ord(name^[i])); +end; {Header} + + +procedure OpenSeg; + +{ create a new segment and mark its beginning } + +begin {OpenSeg} +segDisp := 0; +segStart := objPtr; +end; {OpenSeg} + + +procedure OpenObj {var name: gsosOutString}; + +{ open a new obj file with the indicated file name } +{ } +{ parameters: } +{ name - object file name } + +var + dsDCBGS: destroyOSDCB; {dcb for Destroy call} + giDCBGS: getFileInfoOSDCB; {dcb for Get_File_Info call} + +begin {OpenObj} +{the file is not spooled (yet)} +spoolRefnum := 0; + +{if there is an existing file, delete it} +if memoryCompile then begin + giDCBGS.pCount := 3; + giDCBGS.pathName := @name.theString; + GetFileInfoGS(giDCBGS); + if ToolError = 0 then + if giDCBGS.fileType = OBJ then begin + dsDCBGS.pCount := 1; + dsDCBGS.pathName := @name.theString; + DestroyGS(dsDCBGS); + end; {if} + end; {if} + +{allocate memory for an initial buffer} +objHandle := pointer(NewHandle(buffSize, userID, $8000, nil)); + +{set up the buffer variables} +if ToolError = 0 then begin + objLen := 0; + objPtr := objHandle^; + end {if} +else + TermError(5); + +{save the object file name} +objFile := name; +end; {OpenObj} + + +procedure Purge; + +{ write any constant bytes to the output buffer } + +var + i: integer; {loop variable} + +begin {Purge} +if cBuffLen <> 0 then begin + Out(cBuffLen); + for i := 0 to cBuffLen-1 do + COut(cBuff[i]); + cBuffLen := 0; + end; {if} +end; {Purge} + +end. + +{$append 'objout.asm'} diff --git a/ObjOut2.asm b/ObjOut2.asm old mode 100755 new mode 100644 index 75b3a8e..cd269d6 --- a/ObjOut2.asm +++ b/ObjOut2.asm @@ -1 +1,234 @@ - mcopy objout.macros **************************************************************** * * CnOut - write a byte to the constant buffer * * Inputs: * i - byte to write * **************************************************************** * CnOut start maxCBuffLen equ 191 max index into the constant buffer lda cBuffLen if cBuffLen = maxCBuffLen then cmp #maxCBuffLen bne lb1 jsl Purge Purge; lb1 phb cBuff[cBuffLen] := i; plx ply pla phy phx plb ldx cBuffLen short M sta cBuff,X long M inc cBuffLen cBuffLen := cBuffLen+1; rtl end **************************************************************** * * CnOut2 - write a word to the constant buffer * * Inputs: * i - word to write * **************************************************************** * CnOut2 start maxCBuffLen equ 191 max index into the constant buffer lda cBuffLen if cBuffLen+1 >= maxCBuffLen then inc A cmp #maxCBuffLen blt lb1 jsl Purge Purge; lb1 phb cBuff[cBuffLen] := i; plx ply pla phy phx plb ldx cBuffLen sta cBuff,X inx cBuffLen := cBuffLen+2; inx stx cBuffLen rtl end **************************************************************** * * COut - write a code byte to the object file * * Inputs: * b - byte to write (on stack) * **************************************************************** * COut start phb OutByte(b); pla ply plx phy pha plb jsr OutByte inc blkcnt blkcnt := blkcnt+1; inc4 pc pc := pc+1; rtl end **************************************************************** * * Out2 - write a word to the output file * * Inputs: * w - word to write (on stack) * **************************************************************** * Out2 start phb OutWord(w); pla ply plx phy pha plb jsr OutWord inc blkcnt blkcnt := blkcnt+2; inc blkcnt rtl end **************************************************************** * * Out - write a byte to the output file * * Inputs: * b - byte to write (on stack) * **************************************************************** * Out start phb OutByte(b); pla ply plx phy pha plb jsr OutByte inc blkcnt blkcnt := blkcnt+1; rtl end **************************************************************** * * OutByte - write a byte to the object file * * Inputs: * X - byte to write * **************************************************************** * OutByte private buffSize equ 16384 buffer size lda objLen if objLen+segDisp+1 = buffSize then sec adc segDisp cmp #buffSize blt lb2 phx PurgeObjBuffer; jsl PurgeObjBuffer plx lda objLen check for segment overflow sec adc segDisp cmp #buffSize bge lb2a lb2 ph4 objPtr p := pointer(ord4(objPtr)+segDisp); tsc p^ := b; phd tcd ldy segDisp short M txa sta [1],Y long M inc segDisp segDisp := segDisp+1; pld tsc clc adc #4 tcs rts lb2a lda #$1000 handle a segment buffer overflow sta segDisp ph2 #112 jsl Error rts end **************************************************************** * * OutWord - write a word to the object file * * Inputs: * X - word to write * **************************************************************** * OutWord private buffSize equ 16384 buffer size lda objLen if objLen+segDisp+2 = buffSize then sec adc segDisp cmp #buffSize-1 blt lb2 phx PurgeObjBuffer; jsl PurgeObjBuffer plx lda objLen check for segment overflow sec adc segDisp cmp #buffSize-1 bge lb3 lb2 ph4 objPtr p := pointer(ord4(objPtr)+segDisp); tsc p^ := b; phd tcd ldy segDisp txa sta [1],Y iny segDisp := segDisp+2; iny sty segDisp pld tsc clc adc #4 tcs rts lb3 ph2 #112 flag segment overflow error jsl Error lda #$1000 sta segDisp rts end \ No newline at end of file + mcopy objout.macros +**************************************************************** +* +* CnOut - write a byte to the constant buffer +* +* Inputs: +* i - byte to write +* +**************************************************************** +* +CnOut start +maxCBuffLen equ 191 max index into the constant buffer + + lda cBuffLen if cBuffLen = maxCBuffLen then + cmp #maxCBuffLen + bne lb1 + jsl Purge Purge; +lb1 phb cBuff[cBuffLen] := i; + plx + ply + pla + phy + phx + plb + ldx cBuffLen + short M + sta cBuff,X + long M + inc cBuffLen cBuffLen := cBuffLen+1; + rtl + end + +**************************************************************** +* +* CnOut2 - write a word to the constant buffer +* +* Inputs: +* i - word to write +* +**************************************************************** +* +CnOut2 start +maxCBuffLen equ 191 max index into the constant buffer + + lda cBuffLen if cBuffLen+1 >= maxCBuffLen then + inc A + cmp #maxCBuffLen + blt lb1 + jsl Purge Purge; +lb1 phb cBuff[cBuffLen] := i; + plx + ply + pla + phy + phx + plb + ldx cBuffLen + sta cBuff,X + inx cBuffLen := cBuffLen+2; + inx + stx cBuffLen + rtl + end + +**************************************************************** +* +* COut - write a code byte to the object file +* +* Inputs: +* b - byte to write (on stack) +* +**************************************************************** +* +COut start + + phb OutByte(b); + pla + ply + plx + phy + pha + plb + jsr OutByte + inc blkcnt blkcnt := blkcnt+1; + inc4 pc pc := pc+1; + rtl + end + +**************************************************************** +* +* Out2 - write a word to the output file +* +* Inputs: +* w - word to write (on stack) +* +**************************************************************** +* +Out2 start + + phb OutWord(w); + pla + ply + plx + phy + pha + plb + jsr OutWord + inc blkcnt blkcnt := blkcnt+2; + inc blkcnt + rtl + end + +**************************************************************** +* +* Out - write a byte to the output file +* +* Inputs: +* b - byte to write (on stack) +* +**************************************************************** +* +Out start + + phb OutByte(b); + pla + ply + plx + phy + pha + plb + jsr OutByte + inc blkcnt blkcnt := blkcnt+1; + rtl + end + +**************************************************************** +* +* OutByte - write a byte to the object file +* +* Inputs: +* X - byte to write +* +**************************************************************** +* +OutByte private +buffSize equ 16384 buffer size + + lda objLen if objLen+segDisp+1 = buffSize then + sec + adc segDisp + cmp #buffSize + blt lb2 + phx PurgeObjBuffer; + jsl PurgeObjBuffer + plx + lda objLen check for segment overflow + sec + adc segDisp + cmp #buffSize + bge lb2a +lb2 ph4 objPtr p := pointer(ord4(objPtr)+segDisp); + tsc p^ := b; + phd + tcd + ldy segDisp + short M + txa + sta [1],Y + long M + inc segDisp segDisp := segDisp+1; + + pld + tsc + clc + adc #4 + tcs + rts + +lb2a lda #$1000 handle a segment buffer overflow + sta segDisp + ph2 #112 + jsl Error + rts + end + +**************************************************************** +* +* OutWord - write a word to the object file +* +* Inputs: +* X - word to write +* +**************************************************************** +* +OutWord private +buffSize equ 16384 buffer size + + lda objLen if objLen+segDisp+2 = buffSize then + sec + adc segDisp + cmp #buffSize-1 + blt lb2 + phx PurgeObjBuffer; + jsl PurgeObjBuffer + plx + lda objLen check for segment overflow + sec + adc segDisp + cmp #buffSize-1 + bge lb3 +lb2 ph4 objPtr p := pointer(ord4(objPtr)+segDisp); + tsc p^ := b; + phd + tcd + ldy segDisp + txa + sta [1],Y + iny segDisp := segDisp+2; + iny + sty segDisp + + pld + tsc + clc + adc #4 + tcs + rts + +lb3 ph2 #112 flag segment overflow error + jsl Error + lda #$1000 + sta segDisp + rts + end diff --git a/ObjOut2.pas b/ObjOut2.pas old mode 100755 new mode 100644 index 7d63ace..0efd571 --- a/ObjOut2.pas +++ b/ObjOut2.pas @@ -1 +1,595 @@ -{$optimize 7} {---------------------------------------------------------------} { } { ObjOut } { } { This unit has the primitive routines used to actually } { create and write to object modules. A few low-level } { subroutines that need to be in assembly language for speed } { are also included here. } { } { External Subroutines: } { } { CloseObj - close the current obj file } { CloseSeg - close out the current segment } { COut - write a code byte to the object file } { CnOut - write a byte to the constant buffer } { CnOut2 - write a word to the constant buffer } { DestroySuffixes - destroy the .a, .b, etc suffixes } { FindSuffix - find the next available alphabetic suffix } { Header - write a segment header to the output file } { OpenObj - open a new obj file with the indicated file name } { OpenSeg - create a new segment and mark its beginning } { Out - write a byte to the output file } { Out2 - write a word to the output file } { Purge - write any constant bytes to the output buffer } { } {---------------------------------------------------------------} unit CCommon; interface {$LibPrefix '0/obj/'} uses CCommon, CGI, CGC; {$segment 'CodeGen'} procedure CloseObj; { close the current obj file } { } { Note: Declared as extern in CGI.pas } procedure COut (b: integer); extern; { write a code byte to the object file } { } { parameters: } { b - byte to write } procedure CnOut (i: integer); extern; { write a byte to the constant buffer } { } { parameters: } { i - byte to write } procedure CnOut2 (i: integer); extern; { write a word to the constant buffer } { } { parameters: } { i - word to write } procedure DestroySuffixes (var name: gsosOutString); { destroy the .a, .b, etc suffixes } { } { parameters: } { name - root name of file sequence to destroy } procedure CloseSeg; { close out the current segment } procedure FindSuffix (var name: gsosOutString; var ch: char); { find the next available alphabetic suffix } { } { parameters: } { ch - addr to place suffix character } { name - root name of suffix to find } procedure Header (name: stringPtr; kind: integer; lengthCode: integer); { write a segment header to the output file } { } { parameters: } { name - name of the segment } { kind - segment kind } { lengthCode - code bank size code; bank size div $10000 } procedure OpenSeg; { create a new segment and mark its beginning } procedure OpenObj (var name: gsosOutString); { open a new obj file with the indicated file name } { } { parameters: } { name - object file name } procedure Out (b: integer); extern; { write a byte to the output file } { } { parameters: } { b - byte to write } procedure Out2 (w: integer); extern; { write a word to the output file } { } { parameters: } { w - word to write } procedure Purge; { write any constant bytes to the output buffer } {---------------------------------------------------------------} implementation const {NOTE: OutByte and Outword assume } { buffSize is 16K } buffSize = 16384; {size of the obj buffer} maxCBuffLen = 191; {length of the constant buffer} OBJ = $B1; {object file type} type closeOSDCB = record {Close DCB} pcount: integer; refNum: integer; end; createOSDCB = record {Create DCB} pcount: integer; pathName: gsosInStringPtr; access: integer; fileType: integer; auxType: longint; storageType: integer; dataEOF: longint; resourceEOF: longint; end; destroyOSDCB = record {Destroy DCB} pcount: integer; pathName: gsosInStringPtr; end; getFileInfoOSDCB = record {GetFileInfo DCB} pcount: integer; pathName: gsosInStringPtr; access: integer; fileType: integer; auxType: longint; storageType: integer; createDateTime: timeField; modDateTime: timeField; optionList: optionListPtr; dataEOF: longint; blocksUsed: longint; resourceEOF: longint; resourceBlocks: longint; end; openOSDCB = record {Open DCB} pcount: integer; refNum: integer; pathName: gsosInStringPtr; requestAccess: integer; resourceNumber: integer; access: integer; fileType: integer; auxType: longint; storageType: integer; createDateTime: timeField; modDateTime: timeField; optionList: optionListPtr; dataEOF: longint; blocksUsed: longint; resourceEOF: longint; resourceBlocks: longint; end; readWriteOSDCB = record {WriteGS DCB} pcount: integer; refNum: integer; dataBuffer: ptr; requestCount: longint; transferCount: longint; cachePriority: integer; end; {---------------------------------------------------------------} var cBuff: array[0..maxCBuffLen] of byte; {constant buffer} objLen: longint; {# bytes used in obj buffer} objHandle: handle; {handle of the obj buffer} objPtr: ptr; {pointer to the next spot in the obj buffer} segStart: ptr; {points to first byte in current segment} spoolRefnum: integer; {reference number for open file} {---------------------------------------------------------------} {memory manager calls} {--------------------} procedure BlockMove (sourcPtr, destPtr: ptr; count: longint); tool ($02, $2B); function NewHandle (blockSize: longint; userID, memAttributes: integer; memLocation: ptr): handle; tool($02, $09); procedure SetHandleSize (newSize: longint; theHandle: handle); tool ($02, $19); procedure HUnLock (theHandle: handle); tool ($02, $22); procedure HLock (theHandle: handle); tool ($02, $20); {ProDOS calls} {------------} procedure CloseGS (var parms: closeOSDCB); prodos ($2014); procedure CreateGS (var parms: createOSDCB); prodos ($2001); procedure DestroyGS (var parms: destroyOSDCB); prodos ($2002); procedure GetFileInfoGS (var parms: getFileInfoOSDCB); prodos ($2006); procedure OpenGS (var parms: openOSDCB); prodos ($2010); procedure WriteGS (var parms: readWriteOSDCB); prodos ($2013); {---------------------------------------------------------------} procedure PurgeObjBuffer; { Spool any completed segments to the object file } var len: longint; {# bytes to write} sPtr: ptr; {start of object buffer} wrRec: readWriteOSDCB; {WriteGS record} procedure InitSpoolFile; { Set up the spool file } var dsRec: destroyOSDCB; {DestroyGS record} crRec: createOSDCB; {CreateGS record} opRec: openOSDCB; {OpenGS record} begin {InitSpoolFile} if memoryCompile then {make sure this is a disk-based compile} TermError(11); dsRec.pCount := 1; {destroy any old file} dsRec.pathname := @objFile.theString; DestroyGS(dsRec); crRec.pCount := 5; {create a new file} crRec.pathName := @objFile.theString; crRec.access := $C3; crRec.fileType := OBJ; crRec.auxType := $0000; crRec.storageType := 1; CreateGS(crRec); if ToolError <> 0 then TermError(9); opRec.pCount := 3; {open the file} opRec.pathname := @objFile.theString; opRec.requestAccess := 3; OpenGS(opRec); if ToolError <> 0 then TermError(9); spoolRefnum := opRec.refnum; end; {InitSpoolFile} begin {PurgeObjBuffer} if spoolRefnum = 0 then {make sure the spool file exists} InitSpoolFile; sPtr := objHandle^; {determine size of completed segments} len := ord4(segStart) - ord4(sPtr); if len <> 0 then begin wrRec.pcount := 4; {write completed segments} wrRec.refnum := spoolRefnum; wrRec.dataBuffer := pointer(sPtr); wrRec.requestCount := len; WriteGS(wrRec); if ToolError <> 0 then {check for write errors} TermError(9); objLen := 0; {adjust file pointers} BlockMove(segStart, sPtr, segDisp); objPtr := sPtr; segStart := sPtr; end; {if} end; {PurgeObjBuffer} {---------------------------------------------------------------} procedure CloseObj; { close the current obj file } { } { Note: Declared as extern in CGI.pas } var clRec: closeOSDCB; {CloseGS record} ffDCBGS: fastFileDCBGS; {dcb for fastfile call} i: integer; {loop/index variable} begin {CloseObj} if spoolRefnum <> 0 then begin PurgeObjBuffer; clRec.pCount := 1; clRec.refnum := spoolRefnum; CloseGS(clRec); end {if} else if objLen <> 0 then begin {resize the buffer} HUnLock(objHandle); SetHandleSize(objLen, objHandle); HLock(objHandle); {save the file} ffDCBGS.pCount := 14; ffDCBGS.fileHandle := objHandle; ffDCBGS.pathName := @objFile.theString; ffDCBGS.access := $C3; ffDCBGS.fileType := OBJ; ffDCBGS.auxType := 0; ffDCBGS.storageType := 1; for i := 1 to 8 do ffDCBGS.createDate[i] := 0; ffDCBGS.modDate := ffDCBGS.createDate; ffDCBGS.option := nil; ffDCBGS.fileLength := objLen; if memoryCompile then begin ffDCBGS.flags := 0; ffDCBGS.action := 4; end {if} else begin ffDCBGS.flags := $C000; ffDCBGS.action := 3; end; {else} FastFileGS(ffDCBGS); if ToolError <> 0 then TermError(9) else begin ffDCBGS.PATHName := @objFile.theString; ffDCBGS.action := 7; FastFileGS(ffDCBGS); end; {else} end; {if} end; {CloseObj} procedure DestroySuffixes {var name: gsosOutString}; { destroy the .a, .b, etc suffixes } { } { parameters: } { name - root name of file sequence to destroy } var done: boolean; {loop termination flag} dsDCBGS: destroyOSDCB; {dcb for destroy call} giDCBGS: getFileInfoOSDCB; {dcb for Get_File_Info call} suffix: char; {current suffix character} fName: gsosInString; {work file name} begin {DestroySuffixes} suffix := 'a'; done := false; repeat fName := name.theString; if fName.size > maxPath-2 then fName.size := maxPath-2; fName.theString[fName.size+1] := '.'; fName.theString[fName.size+2] := suffix; fName.size := fName.size + 2; giDCBGS.pCount := 12; giDCBGS.optionList := nil; giDCBGS.pathName := @fName; GetFileInfoGS(giDCBGS); if ToolError = 0 then begin if giDCBGS.fileType = OBJ then begin dsDCBGS.pCount := 1; dsDCBGS.pathName := @fName; DestroyGS(dsDCBGS); end; {if} end {if} else done := true; suffix := succ(suffix); until done; end; {DestroySuffixes} procedure CloseSeg; { close out the current segment } { } { variables: } { objHandle - segment handle } { objLen - used bytes in the segment } { objPtr - set to point to a fresh segment } var longPtr: ^longint; {used to set the block count} begin {CloseSeg} longPtr := pointer(objPtr); {set the block count} longPtr^ := segDisp; objLen := objLen + segDisp; {update the length of the obj file} objPtr := pointer(ord4(objHandle^)+objLen); {set objPtr} segStart := objPtr; if objLen = buffSize then PurgeObjBuffer; end; {CloseSeg} procedure FindSuffix {var name: gsosOutString; var ch: char}; { find the next available alphabetic suffix } { } { parameters: } { ch - addr to place suffix character } { name - root name of suffix to find } var done: boolean; {loop termination test} giDCBGS: getFileInfoOSDCB; {dcb for Get_File_Info call} fName: gsosInString; {work file name} begin {FindSuffix} ch := 'a'; done := false; repeat fName := name.theString; if fName.size > maxPath-2 then fName.size := maxPath-2; fName.theString[fName.size+1] := '.'; fName.theString[fName.size+2] := ch; fName.size := fName.size + 2; giDCBGS.pCount := 12; giDCBGS.optionList := nil; giDCBGS.pathName := @fName; GetFileInfoGS(giDCBGS); if ToolError = 0 then ch := succ(ch) else done := true; until done; end; {FindSuffix} procedure Header {name: stringPtr; kind: integer; lengthCode: integer}; { write a segment header to the output file } { } { parameters: } { name - name of the segment } { kind - segment kind } { lengthCode - code bank size code; bank size div $10000 } var i: integer; {loop var} len: integer; {length of string} begin {Header} OpenSeg; {start the new segment} blkcnt := 0; segdisp := 0; for i := 1 to 12 do {blkcnt,resspc,length} Out(0); Out(0); {unused} Out(0); {lablen} Out(4); {numlen} Out(2); {version} Out2(0); Out2(ord(lengthcode=0)); {cbanksize} Out2(kind|segmentKind); {kind} for i := 1 to 9 do {unused,org,align,numsex,unused,segnum,entry} Out2(0); len := length(name^); {dispname,dispdata} Out2($30); Out2($3B+len); Out2(0); Out2(0); {temporg} for i := 1 to 10 do {write the segment name} Out(ord(currentSegment[i])); currentSegment := defaultSegment; {revert to default segment name} Out(len); {segname} for i := 1 to len do Out(ord(name^[i])); end; {Header} procedure OpenSeg; { create a new segment and mark its beginning } begin {OpenSeg} segDisp := 0; segStart := objPtr; end; {OpenSeg} procedure OpenObj {var name: gsosOutString}; { open a new obj file with the indicated file name } { } { parameters: } { name - object file name } var dsDCBGS: destroyOSDCB; {dcb for Destroy call} giDCBGS: getFileInfoOSDCB; {dcb for Get_File_Info call} begin {OpenObj} {the file is not spooled (yet)} spoolRefnum := 0; {if there is an existing file, delete it} if memoryCompile then begin giDCBGS.pCount := 12; giDCBGS.pathName := @name.theString; GetFileInfoGS(giDCBGS); if ToolError = 0 then if giDCBGS.fileType = OBJ then begin dsDCBGS.pCount := 1; dsDCBGS.pathName := @name.theString; DestroyGS(dsDCBGS); end; {if} end; {if} {allocate memory for an initial buffer} objHandle := pointer(NewHandle(buffSize, userID, $8000, nil)); {set up the buffer variables} if ToolError = 0 then begin objLen := 0; objPtr := objHandle^; end {if} else TermError(5); {save the object file name} objFile := name; end; {OpenObj} procedure Purge; { write any constant bytes to the output buffer } var i: integer; {loop variable} begin {Purge} if cBuffLen <> 0 then begin Out(cBuffLen); for i := 0 to cBuffLen-1 do COut(cBuff[i]); cBuffLen := 0; end; {if} end; {Purge} end. {$append 'objout2.asm'} \ No newline at end of file +{$optimize 7} +{---------------------------------------------------------------} +{ } +{ ObjOut } +{ } +{ This unit has the primitive routines used to actually } +{ create and write to object modules. A few low-level } +{ subroutines that need to be in assembly language for speed } +{ are also included here. } +{ } +{ External Subroutines: } +{ } +{ CloseObj - close the current obj file } +{ CloseSeg - close out the current segment } +{ COut - write a code byte to the object file } +{ CnOut - write a byte to the constant buffer } +{ CnOut2 - write a word to the constant buffer } +{ DestroySuffixes - destroy the .a, .b, etc suffixes } +{ FindSuffix - find the next available alphabetic suffix } +{ Header - write a segment header to the output file } +{ OpenObj - open a new obj file with the indicated file name } +{ OpenSeg - create a new segment and mark its beginning } +{ Out - write a byte to the output file } +{ Out2 - write a word to the output file } +{ Purge - write any constant bytes to the output buffer } +{ } +{---------------------------------------------------------------} + +unit CCommon; + +interface + +{$LibPrefix '0/obj/'} + +uses CCommon, CGI, CGC; + +{$segment 'CodeGen'} + + +procedure CloseObj; + +{ close the current obj file } +{ } +{ Note: Declared as extern in CGI.pas } + + +procedure COut (b: integer); extern; + +{ write a code byte to the object file } +{ } +{ parameters: } +{ b - byte to write } + + +procedure CnOut (i: integer); extern; + +{ write a byte to the constant buffer } +{ } +{ parameters: } +{ i - byte to write } + + +procedure CnOut2 (i: integer); extern; + +{ write a word to the constant buffer } +{ } +{ parameters: } +{ i - word to write } + + +procedure DestroySuffixes (var name: gsosOutString); + +{ destroy the .a, .b, etc suffixes } +{ } +{ parameters: } +{ name - root name of file sequence to destroy } + + +procedure CloseSeg; + +{ close out the current segment } + + +procedure FindSuffix (var name: gsosOutString; var ch: char); + +{ find the next available alphabetic suffix } +{ } +{ parameters: } +{ ch - addr to place suffix character } +{ name - root name of suffix to find } + + +procedure Header (name: stringPtr; kind: integer; lengthCode: integer); + +{ write a segment header to the output file } +{ } +{ parameters: } +{ name - name of the segment } +{ kind - segment kind } +{ lengthCode - code bank size code; bank size div $10000 } + + +procedure OpenSeg; + +{ create a new segment and mark its beginning } + + +procedure OpenObj (var name: gsosOutString); + +{ open a new obj file with the indicated file name } +{ } +{ parameters: } +{ name - object file name } + + +procedure Out (b: integer); extern; + +{ write a byte to the output file } +{ } +{ parameters: } +{ b - byte to write } + + +procedure Out2 (w: integer); extern; + +{ write a word to the output file } +{ } +{ parameters: } +{ w - word to write } + + +procedure Purge; + +{ write any constant bytes to the output buffer } + +{---------------------------------------------------------------} + +implementation + +const + {NOTE: OutByte and Outword assume } + { buffSize is 16K } + buffSize = 16384; {size of the obj buffer} + maxCBuffLen = 191; {length of the constant buffer} + OBJ = $B1; {object file type} + +type + closeOSDCB = record {Close DCB} + pcount: integer; + refNum: integer; + end; + + createOSDCB = record {Create DCB} + pcount: integer; + pathName: gsosInStringPtr; + access: integer; + fileType: integer; + auxType: longint; + storageType: integer; + dataEOF: longint; + resourceEOF: longint; + end; + + destroyOSDCB = record {Destroy DCB} + pcount: integer; + pathName: gsosInStringPtr; + end; + + getFileInfoOSDCB = record {GetFileInfo DCB} + pcount: integer; + pathName: gsosInStringPtr; + access: integer; + fileType: integer; + auxType: longint; + storageType: integer; + createDateTime: timeField; + modDateTime: timeField; + optionList: optionListPtr; + dataEOF: longint; + blocksUsed: longint; + resourceEOF: longint; + resourceBlocks: longint; + end; + + openOSDCB = record {Open DCB} + pcount: integer; + refNum: integer; + pathName: gsosInStringPtr; + requestAccess: integer; + resourceNumber: integer; + access: integer; + fileType: integer; + auxType: longint; + storageType: integer; + createDateTime: timeField; + modDateTime: timeField; + optionList: optionListPtr; + dataEOF: longint; + blocksUsed: longint; + resourceEOF: longint; + resourceBlocks: longint; + end; + + readWriteOSDCB = record {WriteGS DCB} + pcount: integer; + refNum: integer; + dataBuffer: ptr; + requestCount: longint; + transferCount: longint; + cachePriority: integer; + end; + +{---------------------------------------------------------------} + +var + cBuff: array[0..maxCBuffLen] of byte; {constant buffer} + + objLen: longint; {# bytes used in obj buffer} + objHandle: handle; {handle of the obj buffer} + objPtr: ptr; {pointer to the next spot in the obj buffer} + + segStart: ptr; {points to first byte in current segment} + spoolRefnum: integer; {reference number for open file} + +{---------------------------------------------------------------} + + {memory manager calls} + {--------------------} + +procedure BlockMove (sourcPtr, destPtr: ptr; count: longint); tool ($02, $2B); + +function NewHandle (blockSize: longint; userID, memAttributes: integer; + memLocation: ptr): handle; tool($02, $09); + +procedure SetHandleSize (newSize: longint; theHandle: handle); tool ($02, $19); + +procedure HUnLock (theHandle: handle); tool ($02, $22); + +procedure HLock (theHandle: handle); tool ($02, $20); + + {ProDOS calls} + {------------} + +procedure CloseGS (var parms: closeOSDCB); prodos ($2014); + +procedure CreateGS (var parms: createOSDCB); prodos ($2001); + +procedure DestroyGS (var parms: destroyOSDCB); prodos ($2002); + +procedure GetFileInfoGS (var parms: getFileInfoOSDCB); prodos ($2006); + +procedure OpenGS (var parms: openOSDCB); prodos ($2010); + +procedure WriteGS (var parms: readWriteOSDCB); prodos ($2013); + +{---------------------------------------------------------------} + +procedure PurgeObjBuffer; + +{ Spool any completed segments to the object file } + +var + len: longint; {# bytes to write} + sPtr: ptr; {start of object buffer} + wrRec: readWriteOSDCB; {WriteGS record} + + + procedure InitSpoolFile; + + { Set up the spool file } + + var + dsRec: destroyOSDCB; {DestroyGS record} + crRec: createOSDCB; {CreateGS record} + opRec: openOSDCB; {OpenGS record} + + begin {InitSpoolFile} + if memoryCompile then {make sure this is a disk-based compile} + TermError(11); + dsRec.pCount := 1; {destroy any old file} + dsRec.pathname := @objFile.theString; + DestroyGS(dsRec); + crRec.pCount := 5; {create a new file} + crRec.pathName := @objFile.theString; + crRec.access := $C3; + crRec.fileType := OBJ; + crRec.auxType := $0000; + crRec.storageType := 1; + CreateGS(crRec); + if ToolError <> 0 then + TermError(9); + opRec.pCount := 3; {open the file} + opRec.pathname := @objFile.theString; + opRec.requestAccess := 3; + OpenGS(opRec); + if ToolError <> 0 then + TermError(9); + spoolRefnum := opRec.refnum; + end; {InitSpoolFile} + + +begin {PurgeObjBuffer} +if spoolRefnum = 0 then {make sure the spool file exists} + InitSpoolFile; +sPtr := objHandle^; {determine size of completed segments} +len := ord4(segStart) - ord4(sPtr); +if len <> 0 then begin + wrRec.pcount := 4; {write completed segments} + wrRec.refnum := spoolRefnum; + wrRec.dataBuffer := pointer(sPtr); + wrRec.requestCount := len; + WriteGS(wrRec); + if ToolError <> 0 then {check for write errors} + TermError(9); + objLen := 0; {adjust file pointers} + BlockMove(segStart, sPtr, segDisp); + objPtr := sPtr; + segStart := sPtr; + end; {if} +end; {PurgeObjBuffer} + + +{---------------------------------------------------------------} + +procedure CloseObj; + +{ close the current obj file } +{ } +{ Note: Declared as extern in CGI.pas } + +var + clRec: closeOSDCB; {CloseGS record} + ffDCBGS: fastFileDCBGS; {dcb for fastfile call} + i: integer; {loop/index variable} + +begin {CloseObj} +if spoolRefnum <> 0 then begin + PurgeObjBuffer; + clRec.pCount := 1; + clRec.refnum := spoolRefnum; + CloseGS(clRec); + end {if} +else if objLen <> 0 then begin + {resize the buffer} + HUnLock(objHandle); + SetHandleSize(objLen, objHandle); + HLock(objHandle); + + {save the file} + ffDCBGS.pCount := 14; + ffDCBGS.fileHandle := objHandle; + ffDCBGS.pathName := @objFile.theString; + ffDCBGS.access := $C3; + ffDCBGS.fileType := OBJ; + ffDCBGS.auxType := 0; + ffDCBGS.storageType := 1; + for i := 1 to 8 do + ffDCBGS.createDate[i] := 0; + ffDCBGS.modDate := ffDCBGS.createDate; + ffDCBGS.option := nil; + ffDCBGS.fileLength := objLen; + if memoryCompile then begin + ffDCBGS.flags := 0; + ffDCBGS.action := 4; + end {if} + else begin + ffDCBGS.flags := $C000; + ffDCBGS.action := 3; + end; {else} + FastFileGS(ffDCBGS); + if ToolError <> 0 then + TermError(9) + else begin + ffDCBGS.PATHName := @objFile.theString; + ffDCBGS.action := 7; + FastFileGS(ffDCBGS); + end; {else} + end; {if} +end; {CloseObj} + + +procedure DestroySuffixes {var name: gsosOutString}; + +{ destroy the .a, .b, etc suffixes } +{ } +{ parameters: } +{ name - root name of file sequence to destroy } + +var + done: boolean; {loop termination flag} + dsDCBGS: destroyOSDCB; {dcb for destroy call} + giDCBGS: getFileInfoOSDCB; {dcb for Get_File_Info call} + suffix: char; {current suffix character} + + fName: gsosInString; {work file name} + +begin {DestroySuffixes} +suffix := 'a'; +done := false; +repeat + fName := name.theString; + if fName.size > maxPath-2 then + fName.size := maxPath-2; + fName.theString[fName.size+1] := '.'; + fName.theString[fName.size+2] := suffix; + fName.size := fName.size + 2; + giDCBGS.pCount := 12; + giDCBGS.optionList := nil; + giDCBGS.pathName := @fName; + GetFileInfoGS(giDCBGS); + if ToolError = 0 then begin + if giDCBGS.fileType = OBJ then begin + dsDCBGS.pCount := 1; + dsDCBGS.pathName := @fName; + DestroyGS(dsDCBGS); + end; {if} + end {if} + else + done := true; + suffix := succ(suffix); +until done; +end; {DestroySuffixes} + + +procedure CloseSeg; + +{ close out the current segment } +{ } +{ variables: } +{ objHandle - segment handle } +{ objLen - used bytes in the segment } +{ objPtr - set to point to a fresh segment } + +var + longPtr: ^longint; {used to set the block count} + +begin {CloseSeg} +longPtr := pointer(objPtr); {set the block count} +longPtr^ := segDisp; +objLen := objLen + segDisp; {update the length of the obj file} +objPtr := pointer(ord4(objHandle^)+objLen); {set objPtr} +segStart := objPtr; +if objLen = buffSize then + PurgeObjBuffer; +end; {CloseSeg} + + +procedure FindSuffix {var name: gsosOutString; var ch: char}; + +{ find the next available alphabetic suffix } +{ } +{ parameters: } +{ ch - addr to place suffix character } +{ name - root name of suffix to find } + +var + done: boolean; {loop termination test} + giDCBGS: getFileInfoOSDCB; {dcb for Get_File_Info call} + + fName: gsosInString; {work file name} + +begin {FindSuffix} +ch := 'a'; +done := false; +repeat + fName := name.theString; + if fName.size > maxPath-2 then + fName.size := maxPath-2; + fName.theString[fName.size+1] := '.'; + fName.theString[fName.size+2] := ch; + fName.size := fName.size + 2; + giDCBGS.pCount := 12; + giDCBGS.optionList := nil; + giDCBGS.pathName := @fName; + GetFileInfoGS(giDCBGS); + if ToolError = 0 then + ch := succ(ch) + else + done := true; +until done; +end; {FindSuffix} + + +procedure Header {name: stringPtr; kind: integer; lengthCode: integer}; + +{ write a segment header to the output file } +{ } +{ parameters: } +{ name - name of the segment } +{ kind - segment kind } +{ lengthCode - code bank size code; bank size div $10000 } + + +var + i: integer; {loop var} + len: integer; {length of string} + +begin {Header} +OpenSeg; {start the new segment} +blkcnt := 0; segdisp := 0; +for i := 1 to 12 do {blkcnt,resspc,length} + Out(0); +Out(0); {unused} +Out(0); {lablen} +Out(4); {numlen} +Out(2); {version} +Out2(0); Out2(ord(lengthcode=0)); {cbanksize} +Out2(kind|segmentKind); {kind} +for i := 1 to 9 do {unused,org,align,numsex,unused,segnum,entry} + Out2(0); +len := length(name^); {dispname,dispdata} +Out2($30); Out2($3B+len); +Out2(0); Out2(0); {temporg} +for i := 1 to 10 do {write the segment name} + Out(ord(currentSegment[i])); +currentSegment := defaultSegment; {revert to default segment name} +Out(len); {segname} +for i := 1 to len do + Out(ord(name^[i])); +end; {Header} + + +procedure OpenSeg; + +{ create a new segment and mark its beginning } + +begin {OpenSeg} +segDisp := 0; +segStart := objPtr; +end; {OpenSeg} + + +procedure OpenObj {var name: gsosOutString}; + +{ open a new obj file with the indicated file name } +{ } +{ parameters: } +{ name - object file name } + +var + dsDCBGS: destroyOSDCB; {dcb for Destroy call} + giDCBGS: getFileInfoOSDCB; {dcb for Get_File_Info call} + +begin {OpenObj} +{the file is not spooled (yet)} +spoolRefnum := 0; + +{if there is an existing file, delete it} +if memoryCompile then begin + giDCBGS.pCount := 12; + giDCBGS.pathName := @name.theString; + GetFileInfoGS(giDCBGS); + if ToolError = 0 then + if giDCBGS.fileType = OBJ then begin + dsDCBGS.pCount := 1; + dsDCBGS.pathName := @name.theString; + DestroyGS(dsDCBGS); + end; {if} + end; {if} + +{allocate memory for an initial buffer} +objHandle := pointer(NewHandle(buffSize, userID, $8000, nil)); + +{set up the buffer variables} +if ToolError = 0 then begin + objLen := 0; + objPtr := objHandle^; + end {if} +else + TermError(5); + +{save the object file name} +objFile := name; +end; {OpenObj} + + +procedure Purge; + +{ write any constant bytes to the output buffer } + +var + i: integer; {loop variable} + +begin {Purge} +if cBuffLen <> 0 then begin + Out(cBuffLen); + for i := 0 to cBuffLen-1 do + COut(cBuff[i]); + cBuffLen := 0; + end; {if} +end; {Purge} + +end. + +{$append 'objout2.asm'} diff --git a/Parser.pas b/Parser.pas old mode 100755 new mode 100644 index 3272ed2..600cd1d --- a/Parser.pas +++ b/Parser.pas @@ -1 +1,3936 @@ -{$optimize 1} {---------------------------------------------------------------} { } { Parser } { } { External Subroutines: } { } { DoDeclaration - process a variable or function declaration } { DoStatement - process a statement from a function } { InitParser - initialize the parser } { Match - insure that the next token is of the specified type } { TermParser - shut down the parser } { TypeSpecifier - handle a type specifier } { } {---------------------------------------------------------------} unit Parser; {$LibPrefix '0/obj/'} interface uses CCommon, Table, MM, CGI, Scanner, Header, Symbol, Expression, Asm; {$segment 'parser'} {---------------------------------------------------------------} procedure DoDeclaration (doingPrototypes: boolean); { process a variable or function declaration } { } { parameters: } { doingPrototypes - are we processing a parameter list? } procedure DoStatement; { process a statement from a function } procedure InitParser; { Initialize the parser } procedure Match (kind: tokenEnum; err: integer); { insure that the next token is of the specified type } { } { parameters: } { kind - expected token kind } { err - error number if the expected token is not found } procedure TermParser; { shut down the parser } procedure TypeSpecifier (doingFieldList,isConstant: boolean); { handle a type specifier } { } { parameters: } { doingFieldList - are we processing a field list? } { isConstant - did we already find a constsy? } {---------------------------------------------------------------} implementation const maxBitField = 32; {max # of bits in a bit field} type identList = ^identNode; {list of ids; used for initializers} identNode = record next: identList; id: identPtr; end; { The switch record is used to record the values for the } { switch jump table. The linked list of entries is in order } { of increasing switch value (val). } switchPtr = ^switchRecord; {switch label table entry} switchRecord = record next,last: switchPtr; {doubly linked list (for inserts)} lab: integer; {label to branch to} val: longint; {switch value} end; {token stack} {-----------} tokenStackPtr = ^tokenStackRecord; tokenStackRecord = record next: tokenStackPtr; token: tokenType; end; {statement stack} {---------------} statementPtr = ^statementRecord; {kinds of nestable statements} statementKind = (compoundSt,ifSt,elseSt,doSt,whileSt,forSt,switchSt); statementRecord = record {element of the statement stack} next: statementPtr; {next element on the stack} breakLab, continueLab: integer; {branch points for break, continue} case kind: statementKind of compoundSt: ( doingDeclaration: boolean; {doing declarations? (or statements)} ); ifSt: ( ifLab: integer; {branch point} ); elseSt: ( elseLab: integer; {branch point} ); doSt: ( doLab: integer; {branch point} ); whileSt: ( whileTop: integer; {label at top of while loop} whileEnd: integer; {label at bottom of while loop} ); forSt: ( forLoop: integer; {branch here to loop} e3List: tokenStackPtr; {tokens for last expression} ); switchSt: ( maxVal: longint; {max switch value} isLong: boolean; {do long switch?} ln: integer; {temp var number} size: integer; {temp var size} labelCount: integer; {# of switch labels} switchExit: integer; {branch point} switchLab: integer; {branch point} switchList: switchPtr; {list of labels and values} switchDefault: integer; {default branch point} ); end; var doingMain: boolean; {are we processing the main function?} firstCompoundStatement: boolean; {are we doing a function level compound statement?} fType: typePtr; {return type of the current function} initializerList: identList; {list of initialized identifiers} isForwardDeclared: boolean; {is the field list component } { referenceing a forward struct/union? } isFunction: boolean; {is the declaration a function?} isPascal: boolean; {has the pascal modifier been used?} { (set by DoDeclaration)} returnLabel: integer; {label for exit point} skipDeclarator: boolean; {for enum,struct,union with no declarator} statementList: statementPtr; {list of open statements} {parameter processing variables} {------------------------------} lastParameter: identPtr; {next parameter to process} numberOfParameters: integer; {number of indeclared parameters} pfunc: identPtr; {func. for which parms are being defined} protoType: typePtr; {type from a parameter list} protoVariable: identPtr; {variable from a parameter list} {type info for the current declaration} {-------------------------------------} storageClass: tokenEnum; {storage class of the declaration} { typeSpec: typePtr; (in CCommon) {type specifier} {-- Parser Utility Procedures ----------------------------------} procedure Match {kind: tokenEnum; err: integer}; { insure that the next token is of the specified type } { } { parameters: } { kind - expected token kind } { err - error number if the expected token is not found } begin {Match} if token.kind = kind then NextToken else Error(err); end; {Match} procedure SkipStatement; { Skip the remainder of the current statement } var bracketCount: integer; {for error skip} begin {SkipStatement} bracketCount := 0; while (token.kind <> eofsy) and ((token.kind <> semicolonch) or (bracketCount <> 0)) do begin if token.kind = lbrackch then bracketCount := bracketCount+1; if token.kind = rbrackch then if bracketCount <> 0 then bracketCount := bracketCount-1; NextToken; end; {while} if token.kind = semicolonch then NextToken; end; {SkipStatement} procedure GotoLabel (op: pcodes); { Find a label in the goto label list, creating one if one } { does not already exist. Generate the label or a jump to it } { based on op. } { } { paremeters: } { op - operation code to create } label 1; var gt: gotoPtr; {work pointer} begin {GotoLabel} gt := gotoList; {try to find an existing label} while gt <> nil do begin if gt^.name^ = token.name^ then goto 1; gt := gt^.next; end; {while} gt := pointer(Malloc(sizeof(gotoRecord))); {no label record exists: create one} gt^.next := gotoList; gotoList := gt; gt^.name := token.name; gt^.lab := GenLabel; gt^.defined := false; 1: if op = dc_lab then begin if gt^.defined then Error(77) else begin gt^.defined := true; Gen1(dc_lab, gt^.lab); end; {else} end {if} else Gen1(pc_ujp, gt^.lab); end; {GotoLabel} {-- Statements -------------------------------------------------} procedure CompoundStatement (makeSymbols: boolean); { handle a compound statement } { } { Parameters: } { makeSymbols - create a symbol table? (False for a } { function's outer wrapper, true for imbeded statements) } var stPtr: statementPtr; {for creating a compound statement record} begin {CompoundStatement} Match(lbracech,27); {make sure there is an opening '{'} new(stPtr); {create a statement record} stPtr^.next := statementList; statementList := stPtr; stPtr^.kind := compoundSt; if makeSymbols then {create a symbol table} PushTable; stPtr^.doingDeclaration := true; {allow declarations} initializerList := nil; {no initializers, yet} end; {CompoundStatement} procedure EndCompoundStatement; { finish off a compound statement } var dumpLocal: boolean; {dump the local memory pool?} tl: tempPtr; {work pointer} stPtr: statementPtr; {work pointer} begin {EndCompoundStatement} dumpLocal := false; stPtr := statementList; {pop the statement record} statementList := stPtr^.next; doingFunction := statementList <> nil; {see if we're done with the function} if not doingFunction then begin {if so, finish it off} Gen1(dc_lab, returnLabel); with fType^ do {generate the pc_ret instruction} case kind of scalarType : Gen0t(pc_ret, baseType); arrayType : ; structType , unionType , pointerType : Gen0t(pc_ret, cgULong); functionType: ; enumConst : ; enumType : Gen0t(pc_ret, cgWord); definedType : ; otherwise: Error(57); end; {case} Gen0 (dc_enp); {finish the segment} CheckGotoList; {make sure all labels are declared} while tempList <> nil do begin {dump the local labels} tl := tempList; tempList := tl^.next; dispose(tl); end; {while} dumpLocal := true; {dump the local pool} nameFound := false; {no pc_nam for the next function (yet)} end; {if} PopTable; {remove this symbol table} dispose(stPtr); {dump the record} if dumpLocal then begin useGlobalPool := true; {start using the global memory pool} LInit; {dispose of the local memory pool} end; {if} NextToken; {remove the rbracech token} end; {EndCompoundStatement} procedure Statement; { handle a statement } label 1; var lToken,tToken: tokenType; {for look-ahead} lPrintMacroExpansions: boolean; {local copy of printMacroExpansions} function GetSwitchRecord: statementPtr; { Find the enclosing switch statement } { } { Returns a pointer to the closest switch statement record, } { or nil if there are none. } label 1; var stPtr: statementPtr; {work pointer} begin {GetSwitchRecord} stPtr := statementList; while stPtr <> nil do begin if stPtr^.kind = switchSt then goto 1; stPtr := stPtr^.next; end; {while} 1: GetSwitchRecord := stPtr; end; {GetSwitchRecord} procedure AssignmentStatement; { handle an asignment statement } begin {AssignmentStatement} if token.kind in startExpression then begin Expression(normalExpression, [semicolonch]); if expressionType^.baseType <> cgVoid then Gen0t(pc_pop, UsualUnaryConversions); if token.kind = semicolonch then NextToken else begin Error(22); SkipStatement; end; {else} end {if} else begin NextToken; Error(92); end; {else} end; {AssignmentStatement} procedure BreakStatement; { handle a break statement } label 1,2; var stPtr: statementPtr; {work pointer} begin {BreakStatement} stPtr := statementList; {find the proper statement} while stPtr <> nil do begin if stPtr^.kind in [whileSt,doSt,forSt,switchSt] then goto 1; stPtr := stPtr^.next; end; {while} Error(76); goto 2; 1: if stPtr^.breakLab = 0 then {if there is no break label, create one} stPtr^.breakLab := GenLabel; Gen1(pc_ujp, stPtr^.breakLab); {branch to the break label} 2: NextToken; {skip the 'break' token} Match(semicolonch,22); {insist on a closing ';'} end; {BreakStatement} procedure CaseStatement; { handle a case statement } var stPtr: statementPtr; {switch record for this case label} swPtr,swPtr2: switchPtr; {work pointers for inserting new entry} val: integer; {case label value} begin {CaseStatement} while token.kind = casesy do begin NextToken; {skip the 'case' token} stPtr := GetSwitchRecord; {get the proper switch record} Expression(arrayExpression, [colonch]); {evaluate the branch condition} val := long(expressionValue).lsw; if val <> expressionValue then if not stPtr^.isLong then Error(71); if stPtr = nil then Error(72) else begin new(swPtr2); {create the new label table entry} swPtr2^.lab := GenLabel; Gen1(dc_lab, swPtr2^.lab); swPtr2^.val := expressionValue; swPtr := stPtr^.switchList; if swPtr = nil then begin {enter it in the table} swPtr2^.last := nil; swPtr2^.next := nil; stPtr^.switchList := swPtr2; stPtr^.maxVal := expressionValue; stPtr^.labelCount := 1; end {if} else begin while (swPtr^.next <> nil) and (swPtr^.val < expressionValue) do swPtr := swPtr^.next; if swPtr^.val = expressionValue then Error(73) else if swPtr^.val > expressionValue then begin swPtr2^.next := swPtr; if swPtr^.last = nil then stPtr^.switchList := swPtr2 else swPtr^.last^.next := swPtr2; swPtr2^.last := swPtr^.last; swPtr^.last := swPtr2; end {else if} else begin {at end of list} swPtr2^.next := nil; swPtr2^.last := swPtr; swPtr^.next := swPtr2; stPtr^.maxVal := expressionValue; end; {else} stPtr^.labelCount := stPtr^.labelCount + 1; end; {else} end; {else} Match(colonch,29); {get the colon} end; {while} Statement; {process the labeled statement} end; {CaseStatement} procedure ContinueStatement; { handle a continue statement } label 1,2; var stPtr: statementPtr; {work pointer} begin {ContinueStatement} stPtr := statementList; {find the proper statement} while stPtr <> nil do begin if stPtr^.kind in [whileSt,doSt,forSt] then goto 1; stPtr := stPtr^.next; end; {while} Error(75); goto 2; 1: if stPtr^.continueLab = 0 then {if there is no continue label, create one} stPtr^.continueLab := GenLabel; Gen1(pc_ujp, stPtr^.continueLab); {branch to the continue label} 2: NextToken; {skip the 'continue' token} Match(semicolonch,22); {insist on a closing ';'} end; {ContinueStatement} procedure DefaultStatement; { handle a default statement } var stPtr: statementPtr; {work pointer} begin {DefaultStatement} NextToken; {skip the 'default' token} Match(colonch,29); {get the colon} stPtr := GetSwitchRecord; {record the presense of a default label} if stPtr = nil then Error(72) else if stPtr^.switchDefault <> 0 then Error(74) else begin stPtr^.switchDefault := GenLabel; Gen1(dc_lab, stPtr^.switchDefault); end; {else} Statement; {process the labeled statement} end; {DefaultStatement} procedure DoStatement; { handle a do statement } var lab: integer; {branch label} stPtr: statementPtr; {work pointer} begin {DoStatement} NextToken; {skip the 'do' token} new(stPtr); {create a statement record} stPtr^.next := statementList; statementList := stPtr; stPtr^.kind := doSt; lab := GenLabel; {create the branch label} Gen1(dc_lab, lab); stPtr^.doLab := lab; stPtr^.breakLab := 0; stPtr^.continueLab := 0; Statement; {process the first loop body statement} end; {DoStatement} procedure ForStatement; { handle a for statement } var errorFound: boolean; {did we find an error?} forLoop, continueLab, breakLab: integer; {branch points} lType: typePtr; {type of "left" expression} parencount: integer; {number of unmatched '(' chars} stPtr: statementPtr; {work pointer} tl,tk: tokenStackPtr; {for forming expression list} begin {ForStatement} NextToken; {skip the 'for' token} new(stPtr); {create a statement record} stPtr^.next := statementList; statementList := stPtr; stPtr^.kind := forSt; forLoop := GenLabel; {create the branch labels} continueLab := GenLabel; breakLab := GenLabel; stPtr^.forLoop := forLoop; stPtr^.continueLab := continueLab; stPtr^.breakLab := breakLab; Match(lparench,13); {evaluate the start condition} if token.kind <> semicolonch then begin Expression(normalExpression, [semicolonch]); Gen0t(pc_pop, UsualUnaryConversions); end; {if} Match(semicolonch,22); Gen1(dc_lab, forLoop); {this label points to the condition} if token.kind <> semicolonch then {handle the loop test} begin {evaluate the expression} Expression(normalExpression, [semicolonch]); CompareToZero(pc_neq); {Evaluate the condition} Gen1(pc_fjp, breakLab); end; {if} Match(semicolonch,22); tl := nil; {collect the tokens for the last expression} parencount := 0; errorFound := false; while (token.kind <> eofsy) and ((token.kind <> rparench) or (parencount <> 0)) and (token.kind <> semicolonch) do begin new(tk); {place the token in the list} tk^.next := tl; tl := tk; tk^.token := token; if token.kind = lparench then {allow parens in the expression} parencount := parencount+1 else if token.kind = rparench then parencount := parencount-1; NextToken; {next token} end; {while} if errorFound then {if an error was found, dump the list} while tl <> nil do begin tk := tl; tl := tl^.next; dispose(tk); end; {while} stPtr^.e3List := tl; {save the list} Match(rparench,12); {get the closing for loop paren} Statement; {process the first loop body statement} end; {ForStatement} procedure IfStatement; { handle an if statement } var lab: integer; {branch label} lType: typePtr; {type of "left" expression} stPtr: statementPtr; {work pointer} begin {IfStatement} NextToken; {skip the 'if' token} Match(lparench, 13); {evaluate the condition} Expression(normalExpression, [rparench]); Match(rparench, 12); lab := GenLabel; {create the branch label} CompareToZero(pc_neq); {evaluate the condition} Gen1(pc_fjp, lab); new(stPtr); {create a statement record} stPtr^.next := statementList; statementList := stPtr; stPtr^.kind := ifSt; stPtr^.ifLab := lab; Statement; {process the 'true' statement} end; {IfStatement} procedure GotoStatement; { handle a goto statement } begin {GotoStatement} NextToken; {skip the 'goto' token} if token.kind in [ident,typedef] then begin GotoLabel(pc_ujp); {jump to the label} NextToken; {skip the token} end {if} else Error(9); {flag the error} Match(semicolonch, 22); {insist on a closing ';'} end; {GotoStatement} procedure LabelStatement; { handle a labeled statement } begin {LabelStatement} GotoLabel(dc_lab); {define the label} NextToken; {skip the label} if token.kind = colonch then {if present, skip the colon} NextToken else begin {bad statement - flag error and skip it} Error(31); SkipStatement; end; {else} end; {LabelStatement} procedure ReturnStatement; { handle a return statement } var id: identPtr; {structure id} size: longint; {size of the struct/union} tk: tokenType; {structure name token} begin {ReturnStatement} NextToken; {skip the 'return' token} if token.kind <> semicolonch then {if present, evaluate the return value} begin if fType^.kind in [structType,unionType] then begin tk.kind := ident; tk.class := identifier; tk.name := @'@struct'; tk.symbolPtr := nil; id := FindSymbol(tk, variableSpace, false, true); Gen1Name(pc_lao, 0, id^.name); size := fType^.size; end; {if} Expression(normalExpression, [semicolonch]); AssignmentConversion(fType, expressionType, lastWasConst, lastConst, true, true); case fType^.kind of scalarType: Gen2t(pc_str, 0, 0, fType^.baseType); enumType: Gen2t(pc_str, 0, 0, cgWord); pointerType: Gen2t(pc_str, 0, 0, cgULong); structType, unionType: begin Gen2(pc_mov, long(size).msw, long(size).lsw); Gen0t(pc_pop, cgULong); end; otherwise: ; end; {case} end; {if} Gen1(pc_ujp, returnLabel); {branch to the exit point} Match(semicolonch, 22); {insist on a closing ';'} end; {ReturnStatement} procedure SwitchStatement; { handle a switch statement } var stPtr: statementPtr; {work pointer} tp: typePtr; {for checking type} begin {SwitchStatement} NextToken; {skip the 'switch' token} new(stPtr); {create a statement record} stPtr^.next := statementList; statementList := stPtr; stPtr^.kind := switchSt; stPtr^.maxVal := -maxint4; stPtr^.isLong := false; stPtr^.labelCount := 0; stPtr^.switchLab := GenLabel; stPtr^.switchExit := GenLabel; stPtr^.breakLab := stPtr^.switchExit; stPtr^.switchList := nil; stPtr^.switchDefault := 0; Match(lparench, 13); {evaluate the condition} Expression(normalExpression,[rparench]); Match(rparench, 12); tp := expressionType; {make sure the expression is integral} while tp^.kind = definedType do tp := tp^.dType; case tp^.kind of scalarType: if tp^.baseType in [cgLong,cgULong] then begin stPtr^.isLong := true; stPtr^.size := cgLongSize; stPtr^.ln := GetTemp(cgLongSize); Gen2t(pc_str, stPtr^.ln, 0, cgLong); end {if} else if tp^.baseType in [cgByte,cgUByte,cgWord,cgUWord] then begin stPtr^.isLong := false; stPtr^.size := cgWordSize; stPtr^.ln := GetTemp(cgWordSize); Gen2t(pc_str, stPtr^.ln, 0, cgWord); end {else if} else Error(71); enumType: begin stPtr^.isLong := false; stPtr^.size := cgWordSize; stPtr^.ln := GetTemp(cgWordSize); Gen2t(pc_str, stPtr^.ln, 0, cgWord); end; otherwise: Error(71); end; {case} Gen1(pc_ujp, stPtr^.switchLab); {branch to the xjp instruction} Statement; {process the loop body statement} end; {SwitchStatement} procedure WhileStatement; { handle a while statement } var lType: typePtr; {type of "left" expression} stPtr: statementPtr; {work pointer} top, endl: integer; {branch points} begin {WhileStatement} NextToken; {skip the 'while' token} new(stPtr); {create a statement record} stPtr^.next := statementList; statementList := stPtr; stPtr^.kind := whileSt; top := GenLabel; {create the branch labels} endl := GenLabel; stPtr^.whileTop := top; stPtr^.whileEnd := endl; stPtr^.breakLab := endl; stPtr^.continueLab := top; Gen1(dc_lab, top); {define the top label} Match(lparench, 13); {evaluate the condition} Expression(normalExpression, [rparench]); Match(rparench, 12); CompareToZero(pc_neq); {evaluate the condition} Gen1(pc_fjp, endl); Statement; {process the first loop body statement} end; {WhileStatement} begin {Statement} 1: {if trace names are enabled and a line # is due, generate it} if traceBack or debugFlag then if nameFound or debugFlag then if lastLine <> lineNumber then begin lastLine := lineNumber; Gen2(pc_lnm, lineNumber, ord(debugType)); end; {if} {handle the statement} case token.kind of asmsy: begin NextToken; AsmStatement; end; breaksy: BreakStatement; casesy: CaseStatement; continuesy: ContinueStatement; defaultsy: DefaultStatement; dosy: DoStatement; elsesy: begin Error(25); SkipStatement; end; forsy: ForStatement; gotosy: GotoStatement; typedef, ident: begin lPrintMacroExpansions := printMacroExpansions; printMacroExpansions := false; lToken := token; NextToken; tToken := token; PutBackToken(token, true); token := lToken; printMacroExpansions := lPrintMacroExpansions; if tToken.kind = colonch then begin LabelStatement; goto 1; end {if} else AssignmentStatement; end; ifsy: IfStatement; lbracech: CompoundStatement(true); returnsy: ReturnStatement; semicolonch: NextToken; switchsy: SwitchStatement; whilesy: WhileStatement; otherwise: AssignmentStatement; end; {case} end; {Statement} procedure EndDoStatement; { finish off a do statement } var lType: typePtr; {type of "left" expression} stPtr: statementPtr; {work pointer} begin {EndDoStatement} stPtr := statementList; {get the statement record} if token.kind = whilesy then begin {if a while clause exists, process it} NextToken; {skip the 'while' token} if stPtr^.continueLab <> 0 then {create the continue label} Gen1(dc_lab, stPtr^.continueLab); Match(lparench, 13); {evaluate the condition} Expression(normalExpression, [rparench]); Match(rparench, 12); CompareToZero(pc_equ); {evaluate the condition} Gen1(pc_fjp, stPtr^.doLab); Match(semicolonch, 22); {process the closing ';'} end {if} else Error(30); {'while' expected} if stPtr^.breakLab <> 0 then {create the break label} Gen1(dc_lab, stPtr^.breakLab); statementList := stPtr^.next; {pop the statement record} dispose(stPtr); end; {EndDoStatement} procedure EndIfStatement; { finish off an if statement } var lab1,lab2: integer; {branch labels} stPtr: statementPtr; {work pointer} begin {EndIfStatement} stPtr := statementList; {get the label to branch to} lab1 := stPtr^.ifLab; statementList := stPtr^.next; {pop the statement record} dispose(stPtr); if token.kind = elsesy then begin {if an else clause exists, process it} NextToken; {skip 'else'} lab2 := GenLabel; {create the branch label} Gen1(pc_ujp, lab2); {branch past the else clause} Gen1(dc_lab, lab1); {create label for if to branch to} new(stPtr); {create a statement record} stPtr^.next := statementList; statementList := stPtr; stPtr^.kind := elseSt; stPtr^.elseLab := lab2; Statement; {evaluate the else clause} end {if} else Gen1(dc_lab, lab1); {create label for if to branch to} end; {EndIfStatement} procedure EndElseStatement; { finish off an else clause } var stPtr: statementPtr; {work pointer} begin {EndElseStatement} stPtr := statementList; {create the label to branch to} Gen1(dc_lab, stPtr^.elseLab); statementList := stPtr^.next; {pop the statement record} dispose(stPtr); end; {EndElseStatement} procedure EndForStatement; { finish off a for statement } var ltoken: tokenType; {for putting ; on stack} stPtr: statementPtr; {work pointer} tl,tk: tokenStackPtr; {for forming expression list} lPrintMacroExpansions: boolean; {local copy of printMacroExpansions} begin {EndForStatement} stPtr := statementList; Gen1(dc_lab, stPtr^.continueLab); {define the continue label} tl := stPtr^.e3List; {place the expression back in the list} if tl <> nil then begin PutBackToken(token, false); ltoken.kind := semicolonch; ltoken.class := reservedSymbol; PutBackToken(ltoken, false); while tl <> nil do begin PutBackToken(tl^.token, false); tk := tl; tl := tl^.next; dispose(tk); end; {while} lPrintMacroExpansions := printMacroExpansions; {inhibit token echo} printMacroExpansions := false; NextToken; {evaluate the expression} Expression(normalExpression, [semicolonch]); Gen0t(pc_pop, UsualUnaryConversions); NextToken; {skip the seminolon} printMacroExpansions := lPrintMacroExpansions; end; {if} Gen1(pc_ujp, stPtr^.forLoop); {loop to the test} Gen1(dc_lab, stPtr^.breakLab); {create the exit label} statementList := stPtr^.next; {pop the statement record} dispose(stPtr); end; {EndForStatement} procedure EndSwitchStatement; { finish off a switch statement } const sparse = 5; {label to tableSize ratio for sparse table} var default: integer; {default label} ltp: baseTypeEnum; {base type} minVal: integer; {min switch value} stPtr: statementPtr; {work pointer} {copies of vars (for efficiency)} {-------------------------------} exitLab: integer; {label at the end of the jump table} isLong: boolean; {is the case expression long?} swPtr,swPtr2: switchPtr; {switch label table list} begin {EndSwitchStatement} stPtr := statementList; {get the statement record} exitLab := stPtr^.switchExit; {get the exit label} isLong := stPtr^.isLong; {get the long flag} swPtr := stPtr^.switchList; {Skip further generation if there were} if swPtr <> nil then begin { no labels. } default := stPtr^.switchDefault; {get a default label} if default = 0 then default := exitLab; Gen1(pc_ujp, exitLab); {branch past the indexed jump} Gen1(dc_lab, stPtr^.switchLab); {create the label for the xjp table} if isLong then {decide on a base type} ltp := cgLong else ltp := cgWord; if stPtr^.isLong or (((stPtr^.maxVal-swPtr^.val) div stPtr^.labelCount) > sparse) then begin {Long expressions and sparse switch statements are handled as a } {series of if-goto tests. } while swPtr <> nil do begin {generate the compares} if isLong then GenLdcLong(swPtr^.val) else Gen1t(pc_ldc, long(swPtr^.val).lsw, cgWord); Gen2t(pc_lod, stPtr^.ln, 0, ltp); Gen0t(pc_equ, ltp); Gen1(pc_tjp, swPtr^.lab); swPtr2 := swPtr; swPtr := swPtr^.next; dispose(swPtr2); end; {while} Gen1(pc_ujp, default); {anything else goes to default} end {if} else begin {compact word switch statements are handled with xjp} minVal := long(swPtr^.val).lsw; {record the min label value} Gen2t(pc_lod, stPtr^.ln, 0, ltp); {get the value} Gen1t(pc_dec, minVal, cgWord); {adjust the range} Gen1(pc_xjp, ord(stPtr^.maxVal-minVal+1)); {do the indexed jump} while swPtr <> nil do begin {generate the jump table} while minVal < swPtr^.val do begin Gen1(pc_add, default); minVal := minVal+1; end; {while} minVal := minVal+1; Gen1(pc_add, swPtr^.lab); swPtr2 := swPtr; swPtr := swPtr^.next; dispose(swPtr2); end; {while} Gen1(pc_add, default); end; {if} Gen1(dc_lab, exitLab); {generate the default label} end {if} else begin Gen1(pc_ujp, exitLab); {branch past the indexed jump} Gen1(dc_lab, stPtr^.switchLab); {create the label for the xjp table} default := stPtr^.switchDefault; {if there is one, jump to the default label} if default <> 0 then Gen1(pc_ujp, default); Gen1(dc_lab, exitLab); {generate the default label} end; {else} FreeTemp(stPtr^.ln, stPtr^.size); {release temp variable} statementList := stPtr^.next; {pop the statement record} dispose(stPtr); end; {EndSwitchStatement} procedure EndWhileStatement; { finish off a while statement } var stPtr: statementPtr; {work pointer} begin {EndWhileStatement} stPtr := statementList; {loop to the test} Gen1(pc_ujp, stPtr^.whileTop); Gen1(dc_lab, stPtr^.whileEnd); {create the exit label} statementList := stPtr^.next; {pop the statement record} dispose(stPtr); end; {EndWhileStatement} {-- Type declarations ------------------------------------------} procedure Declarator(tPtr: typePtr; var variable: identPtr; space: spaceType; doingPrototypes: boolean); { handle a declarator } { } { parameters: } { tPtr - pointer to the type to use } { variable - pointer to variable being defined } { space - variable space to use } { doingPrototypes - are we compiling prototype parameter } { declarations? } label 1; type typeDefPtr = ^typeDefRecord; {for stacking type records} typeDefRecord = record next: typeDefPtr; typeDef: typePtr; end; pointerListPtr = ^pointerList; {for stacking pointer types} pointerList = record next: pointerListPtr; isConstant: boolean; end; var i: integer; {loop variable} lastWasIdentifier: boolean; {for deciding if the declarator is a fuction} lastWasPointer: boolean; {was the last type a pointer?} newName: stringPtr; {new symbol name} parameterStorage: boolean; {is the new symbol in a parm list?} state: stateKind; {declaration state of the variable} tPtr2: typePtr; {work pointer} tsPtr: typeDefPtr; {work pointer} typeStack: typeDefPtr; {stack of type definitions} varParmList: boolean; {did we prototype a variable?} {for checking function compatibility} {-----------------------------------} checkParms: boolean; {do we need to do type checking on the parm?} compatible: boolean; {are the parameters compatible?} ftoken: tokenType; {for checking extern functions} p1,p2,p3: parameterPtr; {used to trace parameter lists} pt1,pt2: typePtr; {parameter types} t1: typePtr; {function type} tk1,tk2: typeKind; {parameter type kinds} unnamedParm: boolean; {is this an unnamed prototype?} procedure StackDeclarations (var varParmList: boolean); { stack the declaration operators } { } { Parameters: } { varParmList - did we create one? } var cp,cpList: pointerListPtr; {pointer list} done,done2: boolean; {for loop termination} isPtr: boolean; {is the parenthesized expr a ptr?} wp: parameterPtr; {used to build prototype var list} pvar: identPtr; {work pointer} tPtr2: typePtr; {work pointer} ttPtr: typeDefPtr; {work pointer} parencount: integer; {for skipping in parm list} lvarParmList: boolean; {did we prototype a variable?} {variables used to preserve states} { across recursive calls } {---------------------------------} lisFunction: boolean; {local copy of isFunction} lisPascal: boolean; {local copy of isPascal} lLastParameter: identPtr; {next parameter to process} lstorageClass: tokenEnum; {storage class of the declaration} ltypeSpec: typePtr; {type specifier} luseGlobalPool: boolean; {local copy of useGlobalPool} lPrintMacroExpansions: boolean; {local copy of printMacroExpansions} begin {StackDeclarations} varParmList := false; {no var parm list, yet} lastWasIdentifier := false; {used to see if the declaration is a fn} cpList := nil; if token.kind = typedef then token.kind := ident; case token.kind of ident: begin {handle 'ident'} if space = fieldListSpace then variable := nil else variable := FindSymbol(token, space, true, true); newName := token.name; if variable = nil then begin if storageClass = typedefsy then begin tPtr2 := pointer(Calloc(sizeof(typeRecord))); {tPtr2^.size := 0;} {tPtr2^.saveDisp := 0;} tPtr2^.kind := definedType; {tPtr^.isConstant := false;} tPtr2^.dType := tPtr; end {if} else tPtr2 := tPtr; if doingParameters then begin if not doingPrototypes then if not (tPtr2^.kind in [enumConst,structType,unionType,definedType,pointerType]) then Error(50); parameterStorage := true; end; {if} end {if} else checkParms := true; NextToken; if token.kind = eqch then state := initialized; lastWasIdentifier := true; end; asteriskch: begin {handle '*' 'declarator'} while token.kind = asteriskch do begin NextToken; new(cp); cp^.next := cpList; cpList := cp; cp^.isConstant := false; while token.kind in [unsignedsy,signedsy,intsy,longsy,charsy,shortsy,floatsy, doublesy,compsy,extendedsy,voidsy,enumsy,structsy,unionsy, volatilesy,constsy] do begin if token.kind = constsy then cpList^.isConstant := true else if token.kind = volatilesy then volatile := true else Error(9); NextToken; end; {while} end; {while} StackDeclarations(lvarParmList); end; lparench: begin {handle '(' 'declarator' ')'} NextToken; isPtr := token.kind = asteriskch; StackDeclarations(lvarParmList); Match(rparench,12); if isPtr then lastWasIdentifier := false; end; otherwise: if doingPrototypes then begin {allow for unnamed parameters} pvar := pointer(Calloc(sizeof(identRecord))); {pvar^.next := nil;} {pvar^.saved := 0;} pvar^.name := @'?'; pvar^.itype := tPtr; {pvar^.disp := 0;} {pvar^.bitDisp := 0;} {pvar^.bitsize := 0;} {pvar^.initialized := false;} {pvar^.iPtr := nil;} {pvar^.isForwardDeclared := false;} pvar^.class := autosy; pvar^.storage := parameter; variable := pvar; lastWasIdentifier := true; newName := nil; unnamedParm := true; end; {if} end; {case} while token.kind in [lparench,lbrackch] do begin {handle function declarations} if token.kind = lparench then begin lisPascal := isPascal; {preserve this flag} PushTable; {create a symbol table} {determine if it's a function} isFunction := lastWasIdentifier or isFunction; varParmList := not isFunction; tPtr2 := pointer(GCalloc(sizeof(typeRecord))); {create the function type} {tPtr2^.size := 0;} {tPtr2^.saveDisp := 0;} tPtr2^.kind := functionType; {tPtr2^.isConstant := false;} {tPtr2^.varargs := false;} {tPtr2^.prototyped := false;} {tPtr2^.overrideKR := false;} {tPtr2^.parameterList := nil;} {tPtr2^.isPascal := false;} {tPtr2^.toolNum := 0;} {tPtr2^.dispatcher := 0;} new(ttPtr); ttPtr^.next := typeStack; typeStack := ttPtr; ttPtr^.typeDef := tPtr2; NextToken; {skip the '(' token} if token.kind = voidsy then begin {check for a void prototype} lPrintMacroExpansions := printMacroExpansions; printMacroExpansions := false; NextToken; printMacroExpansions := lPrintMacroExpansions; if token.kind = rparench then begin PutBackToken(token, false); NextToken; tPtr2^.prototyped := true; end else begin PutBackToken(token, false); token.kind := voidsy; token.class := reservedSymbol; end; {else} end; {if} if token.kind in {see if we are doing a prototyped list} [autosy,externsy,registersy,staticsy,typedefsy,unsignedsy,intsy, longsy,charsy,shortsy,floatsy,doublesy,compsy,extendedsy,voidsy, enumsy,structsy,unionsy,typedef,signedsy,constsy] then begin {handle a prototype variable list} numberOfParameters := 0; {don't allow K&R parm declarations} luseGlobalPool := useGlobalPool; {use global memory} useGlobalPool := true; done2 := false; lisFunction := isFunction; {preserve global variables} ltypeSpec := typeSpec; lstorageClass := storageClass; with tPtr2^ do begin prototyped := true; {it is prototyped} repeat {collect the declarations} if (token.kind in [autosy,externsy,registersy,staticsy, typedefsy,unsignedsy,signedsy,intsy,longsy, charsy,shortsy,floatsy,doublesy,compsy, extendedsy,enumsy,structsy,unionsy, typedef,voidsy,volatilesy,constsy]) then begin lLastParameter := lastParameter; DoDeclaration(true); lastParameter := lLastParameter; if protoType <> nil then begin wp := pointer(Malloc(sizeof(parameterRecord))); wp^.next := parameterList; parameterList := wp; wp^.parameter := protoVariable; wp^.parameterType := protoType; if protoVariable <> nil then begin protoVariable^.pnext := lastParameter; lastParameter := protoVariable; end; {if} end; {if} if token.kind = commach then begin NextToken; if token.kind = dotch then begin NextToken; Match(dotch,89); Match(dotch,89); varargs := true; done2 := true; end; {if} end {if} else done2 := true; end {if} else begin Error(26); parencount := 0; while (token.kind <> eofsy) and ((parencount > 0) or (token.kind <> rparench)) do begin if token.kind = rparench then parencount := parencount-1 else if token.kind = lparench then parencount := parencount+1; NextToken; end; {while} done2 := true; end; {else} until done2; end; {with} isFunction := lisFunction; {restore global variables} storageClass := lstorageClass; typeSpec := ltypeSpec; useGlobalPool := luseGlobalPool; end {if prototype} else if token.kind = ident then begin {handle a K&R variable list} if (lint & lintNotPrototyped) <> 0 then Error(105); if doingFunction or doingPrototypes then Error(12) else begin numberOfParameters := 0; {no function parms yet} end; {else} repeat {make a list of parameters} if not doingFunction then begin if token.kind <> ident then begin Error(9); while not (token.kind in [rparench,commach,ident]) do NextToken; end; {if} if token.kind = ident then begin pvar := NewSymbol(token.name, nil, ident, variableSpace, declared); pvar^.storage := parameter; pvar^.pnext := lastParameter; lastParameter := pvar; numberOfParameters := numberOfParameters+1; pvar^.bitdisp := numberOfParameters; NextToken; end; {if} end; {if} if token.kind = commach then begin NextToken; done := false; end {if} else done := true; until done or (token.kind = eofsy); end {else if} else if (lint & lintNotPrototyped) <> 0 then if not tPtr2^.prototyped then Error(105); Match(rparench,12); {insist on a closing ')' token} isPascal := lisPascal; {restore this flag} end {if} {handle array declarations} else {if token.kind = lbrackch then} begin lastWasIdentifier := false; tPtr2 := pointer(Calloc(sizeof(typeRecord))); {tPtr2^.size := 0;} {tPtr2^.saveDisp := 0;} {tPtr2^.isConstant := false;} tPtr2^.kind := arrayType; {tPtr2^.elements := 0;} new(ttPtr); ttPtr^.next := typeStack; typeStack := ttPtr; ttPtr^.typeDef := tPtr2; NextToken; if token.kind <> rbrackch then begin Expression(arrayExpression, [rbrackch,semicolonch]); if expressionValue <= 0 then begin Error(45); expressionValue := 1; end; {if} tPtr2^.elements := expressionValue; end; {if} Match(rbrackch,24); end; {else if} end; {while} {stack pointer type records} while cpList <> nil do begin tPtr2 := pointer(Malloc(sizeof(typeRecord))); tPtr2^.size := cgPointerSize; tPtr2^.saveDisp := 0; tPtr2^.isConstant := cpList^.isConstant; tPtr2^.kind := pointerType; new(ttPtr); ttPtr^.next := typeStack; typeStack := ttPtr; ttPtr^.typeDef := tPtr2; cp := cpList; cpList := cp^.next; dispose(cp); end; {for} end; {StackDeclarations} begin {Declarator} newName := nil; {no identifier, yet} unnamedParm := false; {not an unnamed parameter} if storageClass = externsy then {decide on a storage state} state := declared else state := defined; typeStack := nil; {no types so far} parameterStorage := false; {symbol is not in a parameter list} checkParms := false; {assume we won't need to check for parameter type errors} StackDeclarations(varParmList); {stack the type records} while typeStack <> nil do begin {reverse the type stack} tsPtr := typeStack; typeStack := tsPtr^.next; if isFunction and (not useGlobalPool) then begin tPtr2 := pointer(GMalloc(sizeof(typeRecord))); tPtr2^ := tsPtr^.typeDef^; tPtr2^.saveDisp := 0; end {if} else tPtr2 := tsPtr^.typeDef; dispose(tsPtr); if tPtr^.kind = functionType then PopTable; case tPtr2^.kind of pointerType: begin tPtr2^.pType := tPtr; end; functionType: begin while tPtr^.kind = definedType do tPtr := tPtr^.dType; tPtr2^.fType := tPtr; if tPtr^.kind in [functionType,arrayType] then Error(103); end; arrayType: begin tPtr2^.size := tPtr^.size * tPtr2^.elements; tPtr2^.aType := tPtr; end; otherwise: ; end; {case} tPtr := tPtr2; end; {while} if checkParms then begin {check for parameter type conflicts} with variable^ do begin if doingParameters then begin if itype = nil then begin itype := tPtr; numberOfParameters := numberOfParameters-1; if pfunc^.itype^.prototyped then begin pfunc^.itype^.overrideKR := true; p1 := nil; for i := 1 to bitdisp do begin p2 := pfunc^.itype^.parameterList; while (p2^.next <> p1) and (p2 <> nil) do p2 := p2^.next; p1 := p2; end; {for} compatible := false; if CompTypes(p1^.parameterType, tPtr) then compatible := true else begin tk1 := p1^.parameterType^.kind; tk2 := tPtr^.kind; if (tk1 = arrayType) and (tk2 = pointerType) then compatible := CompTypes(p1^.parameterType^.aType, tPtr^.pType) else if (tk1 = pointerType) and (tk2 = arrayType) then compatible := CompTypes(p1^.parameterType^.pType, tPtr^.aType); end; {else} if not compatible then Error(47); end; {if} end {if} else Error(42); storage := parameter; parameterStorage := true; end; {if} end; {with} end {if} else if doingParameters then if pfunc^.itype^.prototyped then if not doingPrototypes then if tPtr^.kind in [enumConst,structType,unionType,definedType,pointerType] then Error(50); if tPtr^.kind = functionType then begin {declare the identifier} if variable <> nil then begin t1 := variable^.itype; if CompTypes(t1, tPtr) then begin if t1^.prototyped and tPtr^.prototyped then begin p2 := tptr^.parameterList; if isPascal then begin {reverse the parameter list} p1 := nil; while p2 <> nil do begin p3 := p2; p2 := p2^.next; p3^.next := p1; p1 := p3; end; {while} tPtr^.parameterList := p1; end; {if} p2 := tPtr^.parameterList; p1 := t1^.parameterList; while (p1 <> nil) and (p2 <> nil) do begin if p1^.parameter = nil then pt1 := p1^.parameterType else pt1 := p1^.parameter^.itype; if p2^.parameter = nil then pt2 := p2^.parameterType else pt2 := p2^.parameter^.itype; if not CompTypes(pt1, pt2) then begin Error(47); goto 1; end; {if} p1 := p1^.next; p2 := p2^.next; end; {while} if p1 <> p2 then Error(47); p2 := tptr^.parameterList; if isPascal then begin {reverse the parameter list} p1 := nil; while p2 <> nil do begin p3 := p2; p2 := p2^.next; p3^.next := p1; p1 := p3; end; {while} tPtr^.parameterList := p1; end; {if} end; {if} end {if} else Error(42); 1: end; {if} end; {if} if tPtr^.kind = functionType then state := declared; if newName <> nil then {declare the variable} variable := NewSymbol(newName, tPtr, storageClass, space, state) else if unnamedParm then variable^.itype := tPtr else begin if token.kind <> semicolonch then Error(9); variable := nil; end; {else} if variable <> nil then begin if parameterStorage then variable^.storage := parameter; if isForwardDeclared then begin {handle forward declarations} tPtr := variable^.itype; lastWasPointer := false; while tPtr^.kind in [pointerType,arrayType,functionType,definedType] do begin if tPtr^.kind = pointerType then lastWasPointer := true else if tPtr^.kind <> definedType then lastWasPointer := false; tPtr := tPtr^.pType; end; {while} if ((tPtr <> typeSpec) and (not (tPtr^.kind in [structType,unionType]))) then begin Error(107); SkipStatement; end; {if} variable^.isForwardDeclared := true; end; {if} end; {if} end; {Declarator} procedure Initializer (var variable: identPtr); { handle a variable initializer } { } { paramaters: } { variable - ptr to the identifier begin initialized } var bitcount: integer; {# if bits initialized} bitvalue: longint; {bit field initializer value} done: boolean; {for loop termination} errorFound: boolean; {used to remove bad initializations} iPtr,jPtr,kPtr: initializerPtr; {for reversing the list} ip: identList; {used to place an id in the list} luseGlobalPool: boolean; {local copy of useGlobalPool} procedure InitializeBitField; { If bit fields have been initialized, fill them in } { } { Inputs: } { bitcount - # of bits initialized } { bitvalue - value of initializer } var iPtr: initializerPtr; {for creating an initializer entry} begin {InitializeBitField} if bitcount <> 0 then begin {skip if there has been no initializer} { writeln('InitializeBitField; bitcount = ', bitcount:1); {debug} {create the initializer entry} iPtr := pointer(Malloc(sizeof(initializerRecord))); iPtr^.next := variable^.iPtr; variable^.iPtr := iPtr; iPtr^.isConstant := isConstant; iPtr^.count := 1; iPtr^.bitdisp := 0; iPtr^.bitsize := 0; iPtr^.isStruct := false; iPtr^.iVal := bitvalue; if bitcount > 16 then iPtr^.itype := cgULong else if bitcount > 8 then iPtr^.itype := cgUWord else iPtr^.itype := cgUByte; bitcount := 0; {reset the bit field values} bitvalue := 0; end; {if} end; {InitializeBitField} procedure GetInitializerValue (tp: typePtr; bitsize,bitdisp: integer); { get the value of an initializer from a single expression } { } { parameters: } { tp - type of the variable being initialized } { bitsize - size of bit field (0 for non-bit fields) } { bitdisp - disp of bit field; unused if bitsize = 0 } label 1,2,3; var bitmask: longint; {used to add a value to a bit field} bKind: baseTypeEnum; {type of constant} etype: typePtr; {expression type} i: integer; {loop variable} ip: identPtr; {ident in pointer constant} iPtr: initializerPtr; {for creating an initializer entry} kind: tokenEnum; {kind of constant} offset, offset2: longint; {integer offset from a pointer} operator: tokenEnum; {operator for constant pointers} tKind: typeKind; {type of constant} tree: tokenPtr; {for evaluating pointer constants} function Subscript (tree: tokenPtr): typePtr; { handle subscripts in a pointer constant } { } { parameters: } { tree - subscript operators } { } { returns: type of the variable } { } { variables: } { iPtr - initializer location to store the array name } { offset - bytes past the start of the array } var ip: identPtr; {ident pointer} rtree: tokenPtr; {work pointer} tp: typePtr; {for tracking types} select: longint; {selector size} size: longint; {subscript value} begin {Subscript} if tree^.token.kind = uasterisk then begin tree := tree^.left; if tree^.token.kind = plusch then begin rtree := tree^.right; if rtree^.token.kind in [intconst,uintconst] then size := rtree^.token.ival else if rtree^.token.kind in [longconst,ulongconst] then size := rtree^.token.lval else begin Error(18); errorFound := true; end; {else} tp := Subscript(tree^.left); if tp^.kind <> arrayType then Error(47) else begin tp := tp^.atype; offset := offset + size*tp^.size; Subscript := tp; end; {else} end {if} else begin Error(47); errorFound := true; Subscript := wordPtr; end; {else} end {if} else if tree^.token.kind = dotch then begin tp := Subscript(tree^.left); if tp^.kind in [structType,unionType] then begin DoSelection(tp, tree^.right, select); Subscript := expressionType; offset := offset+select; if isBitField then Error(106); end {if} else begin Error(47); errorFound := true; Subscript := wordPtr; end; {else} end {else if} else if tree^.token.kind = ident then begin ip := FindSymbol(tree^.token, allSpaces, false, true); if ip = nil then begin Error(31); errorFound := true; Subscript := wordPtr; iPtr^.pName := @'?'; end {if} else begin Subscript := ip^.itype; iPtr^.pName := ip^.name; end; {else} end {else if} else begin Error(47); errorFound := true; Subscript := wordPtr; end; {else} end; {Subscript} begin {GetInitializerValue} if variable^.storage = stackFrame then Expression(autoInitializerExpression, [commach,rparench,rbracech]) else Expression(initializerExpression, [commach,rparench,rbracech]); if bitsize = 0 then begin iPtr := pointer(Malloc(sizeof(initializerRecord))); iPtr^.next := variable^.iPtr; variable^.iPtr := iPtr; iPtr^.isConstant := isConstant; iPtr^.count := 1; iPtr^.bitdisp := 0; iPtr^.bitsize := 0; iPtr^.isStruct := false; end; {if} etype := expressionType; AssignmentConversion(tp, expressionType, isConstant, expressionValue, false, false); if variable^.storage = external then variable^.storage := global; if isConstant and (variable^.storage in [external,global,private]) then begin if bitsize = 0 then begin iPtr^.iVal := expressionValue; iPtr^.itype := tp^.baseType; InitializeBitField; end; {if} case tp^.kind of scalarType: begin bKind := tp^.baseType; if (bKind in [cgByte..cgULong]) and (etype^.baseType in [cgByte..cgULong]) then begin if bKind in [cgLong,cgULong] then if eType^.baseType = cgUByte then iPtr^.iVal := iPtr^.iVal & $000000FF else if eType^.baseType = cgUWord then iPtr^.iVal := iPtr^.iVal & $0000FFFF; goto 3; end; {if} if bKind in [cgReal,cgDouble,cgComp,cgExtended] then begin if etype^.baseType in [cgByte..cgULong] then iPtr^.rVal := expressionValue else if etype^.baseType in [cgReal,cgDouble,cgComp,cgExtended] then iPtr^.rval := realExpressionValue; goto 3; end; {if} Error(47); errorFound := true; goto 2; 3: if bitsize <> 0 then begin {set up a bit field value} if bitdisp < bitcount then InitializeBitField; bitmask := 0; for i := 1 to bitsize do bitmask := (bitmask << 1) | 1; bitmask := bitmask & expressionValue; for i := 1 to bitdisp do bitmask := bitmask << 1; bitvalue := bitvalue | bitmask; bitcount := bitcount + bitsize; end; {if} end; arrayType: begin if tp^.aType^.kind = scalarType then if tp^.aType^.baseType in [cgByte,cgUByte] then if eType^.baseType = cgString then goto 2; Error(46); errorFound := true; end; pointerType: if etype = stringTypePtr then begin iPtr^.isConstant := true; iPtr^.iType := ccPointer; iPtr^.pval := 0; iPtr^.pPlus := operator = plusch; iPtr^.isName := false; iPtr^.pStr := longstringPtr(expressionValue); end {if} else if etype^.kind = scalarType then if etype^.baseType in [cgByte..cgULong] then if expressionValue = 0 then iPtr^.iType := cgULong else begin Error(47); errorFound := true; end {else} else begin Error(48); errorFound := true; end {else} else if etype^.kind = pointerType then begin iPtr^.iType := cgULong; iPtr^.pval := expressionValue; end {else if} else begin Error(48); errorFound := true; end; {else} structType,enumType: begin Error(46); errorFound := true; end; otherwise: Error(57); end; {case} 2: DisposeTree(initializerTree); end {if} else begin if (tp^.kind = pointerType) or ((tp^.kind = scalarType) and (tp^.baseType in [cgLong,cgULong])) then begin iPtr^.iType := ccPointer; if variable^.storage in [external,global,private] then begin {do pointer constants with + or -} iPtr^.isConstant := true; tree := initializerTree; while tree^.token.kind = castoper do tree := tree^.left; offset := 0; operator := tree^.token.kind; while operator in [plusch,minusch] do begin with tree^.right^.token do if kind in [intConst,longConst] then begin if kind = intConst then offSet2 := ival else offset2 := lval; if operator = plusch then offset := offset + offset2 else offset := offset - offset2; end {if} else begin Error(47); errorFound := true; end; {else} tree := tree^.left; operator := tree^.token.kind; end; {if} kind := tree^.token.kind; if kind = ident then begin {handle names of functions or static arrays} ip := FindSymbol(tree^.token, allSpaces, false, true); if ip = nil then begin Error(31); errorFound := true; end {if} else begin tKind := ip^.itype^.kind; if tKind = functionType then begin if operator in [plusch,minusch] then begin Error(47); errorFound := true; end; {if} end {if} else if (tKind = arrayType) and (ip^.storage in [external,global,private]) then begin offset := offset*ip^.itype^.atype^.size; end {else if} else if tKind = pointerType then begin Error(48); errorFound := true; end {else if} else begin Error(47); errorFound := true; end; {else} iPtr^.pval := offset; iPtr^.pPlus := true; iPtr^.isName := true; iPtr^.pName := ip^.name; end; {if} end {if} else if kind = uand then begin tree := tree^.left; iPtr^.pPlus := operator = plusch; iPtr^.isName := true; if tree^.token.kind = ident then begin ip := FindSymbol(tree^.token, allSpaces, false, true); if ip = nil then begin Error(31); errorFound := true; end {if} else if ip^.storage in [external,global,private] then begin offset := offset*ip^.itype^.size; iPtr^.pName := ip^.name; end {if} else begin Error(47); errorFound := true; end; {else} end {if} else begin tp := Subscript(tree); if offset > 0 then iPtr^.pPlus := true else begin iPtr^.pPlus := false; offset := -offset; end; {else} end; {else} iPtr^.pval := offset; end {else if} else if kind in [dotch,uasterisk] then begin iPtr^.isName := true; tp := Subscript(tree); if offset > 0 then iPtr^.pPlus := true else begin iPtr^.pPlus := false; offset := -offset; end; {else} iPtr^.pval := offset; end {else if} else if kind = stringConst then begin iPtr^.pval := offset; iPtr^.pPlus := operator = plusch; iPtr^.isName := false; iPtr^.pStr := tree^.token.sval; end {else if} else begin Error(47); errorFound := true; end; {else} DisposeTree(initializerTree); goto 1; end; {if} end {if} else if tp^.kind = structType then iPtr^.isStruct := true; {handle auto variables} if bitsize <> 0 then begin iPtr := pointer(Malloc(sizeof(initializerRecord))); iPtr^.next := variable^.iPtr; variable^.iPtr := iPtr; iPtr^.isConstant := isConstant; iPtr^.count := 1; iPtr^.bitdisp := bitdisp; iPtr^.bitsize := bitsize; iPtr^.isStruct := false; end; {if} if variable^.storage in [external,global,private] then begin Error(41); errorFound := true; end; {else} iPtr^.isConstant := false; iPtr^.iTree := initializerTree; iPtr^.bitdisp := bitdisp; iPtr^.bitsize := bitsize; end; {else} 1: end; {GetInitializerValue} procedure InitializeTerm (tp: typePtr; bitsize,bitdisp: integer; main: boolean); { initialize one level of the type } { } { parameters: } { tp - pointer to the type being initialized } { bitsize - size of bit field (0 for non-bit fields) } { bitdisp - disp of bit field; unused if bitsize = 0 } { main - is this a call from the main level? } var bitCount: integer; {# of bits in a union} braces: boolean; {is the initializer inclosed in braces?} count,maxCount: longint; {for tracking the size of an initializer} ep: tokenPtr; {for forming string expression} iPtr: initializerPtr; {for creating an initializer entry} ip: identPtr; {for tracing field lists} kind: typeKind; {base type of an initializer} ktp: typePtr; {array type with definedTypes removed} procedure Fill (count: longint; tp: typePtr); { fill in unspecified space in an initialized array with 0 } { } { parameters: } { count - ^ elements of this type to create } { tp - ptr to type of elements to create } var i: longint; {loop variable} iPtr: initializerPtr; {for creating an initializer entry} tk: tokenPtr; {expression record} ip: identPtr; {pointer to next field in a structure} begin {Fill} { writeln('Fill tp^.kind = ', ord(tp^.kind):1, '; count = ', count:1); {debug} InitializeBitField; {if needed, do the bit field} if tp^.kind = arrayType then {fill an array} Fill(count*tp^.elements ,tp^.aType) else if tp^.kind = structType then begin {fill a structure} i := count; while i <> 0 do begin ip := tp^.fieldList; while ip <> nil do begin Fill(1, ip^.iType); ip := ip^.next; end; {while} i := i-1; end; {while} end {else if} else if tp^.kind = unionType then {fill a union} Fill(count, tp^.fieldList^.iType) else {fill a single value} while count <> 0 do begin iPtr := pointer(Calloc(sizeof(initializerRecord))); iPtr^.next := variable^.iPtr; variable^.iPtr := iPtr; iPtr^.isConstant := variable^.storage in [external,global,private]; {iPtr^.bitdisp := 0;} {iPtr^.bitsize := 0;} {iPtr^.isStruct := false;} if iPtr^.isConstant then begin if tp^.kind = scalarType then iPtr^.itype := tp^.baseType else if tp^.kind = pointertype then begin iPtr^.itype := cgULong; {iPtr^.iVal := 0;} end {else if} else begin iPtr^.itype := cgWord; Error(47); errorFound := true; end; {else} end {if} else begin new(tk); tk^.next := nil; tk^.left := nil; tk^.middle := nil; tk^.right := nil; tk^.token.kind := intconst; tk^.token.class := intConstant; tk^.token.ival := 0; iPtr^.iTree := tk; end; {else} if count < 16384 then begin iPtr^.count := long(count).lsw; count := 0; end {if} else begin iPtr^.count := 16384; count := count-16384; end; {else} end; {while} end; {Fill} procedure RecomputeSizes (tp: typePtr); { a size has been infered from an initializer - set the } { appropriate type size values } { } { parameters: } { tp - type to check } begin {RecomputeSizes} if tp^.aType^.kind = arrayType then RecomputeSizes(tp^.aType); with tp^ do size := aType^.size*elements; end; {RecomputeSizes} begin {InitializeTerm} braces := false; {allow for an opening brace} if token.kind = lbracech then begin NextToken; braces := true; end; {if} {handle arrays} while tp^.kind = definedType do tp := tp^.dType; kind := tp^.kind; if kind = arrayType then begin ktp := tp^.atype; while ktp^.kind = definedType do ktp := ktp^.dType; kind := ktp^.kind; {handle string constants} if (token.kind = stringConst) and (kind = scalarType) and (ktp^.baseType in [cgByte,cgUByte]) then begin if tp^.elements = 0 then begin tp^.elements := token.sval^.length + 1; RecomputeSizes(variable^.itype); end {if} else if tp^.elements < token.sval^.length then begin Error(44); errorFound := true; end; {else if} with ktp^ do begin iPtr := pointer(Malloc(sizeof(initializerRecord))); iPtr^.next := variable^.iPtr; variable^.iPtr := iPtr; iPtr^.count := 1; iPtr^.bitdisp := 0; iPtr^.bitsize := 0; iPtr^.isStruct := false; if (variable^.storage in [external,global,private]) then begin iPtr^.isConstant := true; iPtr^.itype := cgString; iPtr^.sval := token.sval; count := tp^.elements - token.sval^.length; if count <> 0 then Fill(count, bytePtr); end {if} else begin iPtr^.isConstant := false; new(ep); iPtr^.iTree := ep; ep^.next := nil; ep^.left := nil; ep^.middle := nil; ep^.right := nil; ep^.token := token; end; {else} end; {with} NextToken; end {if} {handle arrays of non-strings} else if kind in [scalarType,pointerType,enumType,arrayType,structType,unionType] then begin count := 0; {get the expressions|initializers} maxCount := tp^.elements; if token.kind <> rbracech then repeat InitializeTerm(ktp, 0, 0, false); count := count+1; if count <> maxCount then begin if token.kind = commach then begin NextToken; done := token.kind = rbracech; end {if} else done := true; end {if} else done := true; until done or (token.kind = eofsy) or (count = maxCount); if maxCount <> 0 then begin count := maxCount-count; if count <> 0 then {if there weren't enough initializers...} Fill(count,ktp); { fill in the blank spots} end {if} else begin tp^.elements := count; {set the array size} RecomputeSizes(variable^.itype); end; {else} end {else if} else begin Error(47); errorFound := true; end; {else} end {if} {handle structures} else if kind = structType then begin if braces or (not main) then begin count := tp^.size; ip := tp^.fieldList; bitCount := 0; while (ip <> nil) and (token.kind <> rbracech) do begin if ip^.isForwardDeclared then ResolveForwardReference(ip); InitializeTerm(ip^.itype, ip^.bitsize, ip^.bitdisp, false); if ip^.bitSize <> 0 then begin bitCount := bitCount + ip^.bitSize; if bitCount > maxBitField then begin count := count - (maxBitField div 8); bitCount := ip^.bitSize; end; {if} end {if} else begin if bitCount > 0 then begin bitCount := (bitCount+7) div 8; count := count-bitCount; bitCount := 0; end; {if} count := count-ip^.itype^.size; end; {else} { writeln('Initializer: ', ip^.bitsize:10, ip^.bitdisp:10, bitCount:10); {debug} ip := ip^.next; if token.kind = commach then begin if ip <> nil then NextToken; end {if} else ip := nil; end; {while} if bitCount > 0 then begin InitializeBitField; bitCount := (bitCount+7) div 8; count := count-bitCount; bitCount := 0; end; {if} if count > 0 then Fill(count, bytePtr); end {if} else {struct assignment initializer} GetInitializerValue(tp, bitsize, bitdisp); end {else if} {handle unions} else if kind = unionType then begin ip := tp^.fieldList; if ip^.isForwardDeclared then ResolveForwardReference(ip); InitializeTerm(ip^.itype, 0, 0, false); count := tp^.size - ip^.itype^.size; if count > 0 then Fill(count, bytePtr); end {else if} {handle single-valued types} else if kind in [scalarType,pointerType,enumType] then GetInitializerValue(tp, bitsize, bitdisp) else begin Error(47); errorFound := true; end; {else} if braces then begin {if there was an opening brace then } if token.kind = commach then { insist on a closing brace } NextToken; if token.kind = rbracech then NextToken else begin Error(23); while not (token.kind in [rbracech,eofsy]) do NextToken; NextToken; errorFound := true; end; {else} end; {if} end; {InitializeTerm} begin {Initializer} bitcount := 0; {set up for bit fields} bitvalue := 0; errorFound := false; {no errors found so far} luseGlobalPool := useGlobalPool; {use global memory for global vars} useGlobalPool := (variable^.storage in [external,global,private]) or useGlobalPool; {make sure a required '{' is there} if not (token.kind in [lbracech,stringConst]) then if variable^.itype^.kind = arrayType then begin Error(27); errorFound := true; end; {if} InitializeTerm(variable^.itype, 0, 0, true); {do the initialization} variable^.state := initialized; {mark the variable as initialized} iPtr := variable^.iPtr; {reverse the initializer list} jPtr := nil; while iPtr <> nil do begin kPtr := iPtr; iPtr := iPtr^.next; kPtr^.next := jPtr; jPtr := kPtr; end; {while} variable^.iPtr := jPtr; if errorFound then {eliminate bad initializers} variable^.state := defined; new(ip); {place the initializer in the list} ip^.next := initializerList; ip^.id := variable; initializerList := ip; useGlobalPool := luseGlobalPool; {restore useGlobalPool} end; {Initializer} procedure TypeSpecifier {doingFieldList,isConstant: boolean}; { handle a type specifier } { } { parameters: } { doingFieldList - are we processing a field list? } { isConstant - did we already find a constsy? } { } { outputs: } { isForwardDeclared - is the field list component } { referenceing a forward struct/union? } { skipDeclarator - for enum,struct,union with no } { declarator } { typespec - type specifier } label 1,2; var done: boolean; {for loop termination} enumVal: integer; {default value for the next enum constant} tPtr: typePtr; {for building types} variable: identPtr; {enumeration variable} structPtr: identPtr; {structure identifier} structTypePtr: typePtr; {structure type} tKind: typeKind; {defining structure or union?} ttoken: tokenType; {temp variable for struct name} lUseGlobalPool: boolean; {local copy of useGlobalPool} globalStruct: boolean; {did we force global pool use?} procedure FieldList (tp: typePtr; kind: typeKind); { handle a field list } { } { parameters } { tp - place to store the type pointer } var bitDisp: integer; {current bit disp} disp: longint; {current byte disp} done: boolean; {for loop termination} fl,tfl,ufl: identPtr; {field list} ldoingParameters: boolean; {local copy of doingParameters} lisForwardDeclared: boolean; {local copy of isForwardDeclared} lstorageClass: tokenEnum; {storage class of the declaration} maxDisp: longint; {for determining union sizes} variable: identPtr; {variable being defined} begin {FieldList} ldoingParameters := doingParameters; {allow fields in K&R dec. area} doingParameters := false; lisForwardDeclared := isForwardDeclared; {stack this value} lStorageClass := storageClass; {don't allow auto in a struct} storageClass := ident; bitDisp := 0; {start allocation from byte 0} disp := 0; maxDisp := 0; fl := nil; {nothing in the field list, yet} {check for no declarations} if not (token.kind in [unsignedsy,signedsy,intsy,longsy,charsy,shortsy, floatsy,doublesy,compsy,extendedsy,enumsy,structsy,unionsy,typedefsy, typedef,voidsy,constsy,volatilesy]) then Error(26); {while there are entries in the field list...} while token.kind in [unsignedsy,signedsy,intsy,longsy,charsy,shortsy,floatsy, doublesy,compsy,extendedsy,enumsy,structsy,unionsy,typedefsy,typedef, voidsy,constsy,volatilesy] do begin typeSpec := wordPtr; {default type specifier is an integer} TypeSpecifier(true,false); {get the type specifier} if not skipDeclarator then repeat {declare the variables...} variable := nil; if token.kind <> colonch then begin Declarator(typeSpec, variable, fieldListSpace, false); if variable <> nil then {enter the var in the field list} begin tfl := fl; {(check for dups)} while tfl <> nil do begin if tfl^.name^ = variable^.name^ then Error(42); tfl := tfl^.next; end; {while} variable^.next := fl; fl := variable; end; {if} end; {if} if token.kind = colonch then {handle a bit field} begin if kind = unionType then Error(56); NextToken; Expression(arrayExpression,[commach,semicolonch]); if (expressionValue >= maxBitField) or (expressionValue < 0) then begin Error(54); expressionValue := maxBitField-1; end; {if} if (bitdisp+long(expressionValue).lsw > maxBitField) or (long(expressionValue).lsw = 0) then begin disp := disp+((bitDisp+7) div 8); bitdisp := 0; if long(expressionValue).lsw = 0 then if variable <> nil then Error(55); end; {if} if variable <> nil then begin variable^.disp := disp; variable^.bitdisp := bitdisp; variable^.bitsize := long(expressionValue).lsw; bitdisp := bitdisp+long(expressionValue).lsw; end; {if} end {if} else if variable <> nil then begin if bitdisp <> 0 then begin disp := disp+((bitDisp+7) div 8); bitdisp := 0; end {if} else if kind = unionType then disp := 0; variable^.disp := disp; variable^.bitdisp := bitdisp; variable^.bitsize := 0; disp := disp + variable^.itype^.size; if disp > maxDisp then maxDisp := disp; end; {if} if token.kind = commach then {allow repeated declarations} begin NextToken; done := false; end {if} else done := true; until done or (token.kind = eofsy); Match(semicolonch,22); {insist on a closing ';'} end; {while} if fl <> nil then begin ufl := nil; {reverse the field list} while fl <> nil do begin tfl := fl; fl := fl^.next; tfl^.next := ufl; ufl := tfl; end; {while} if kind = structType then begin {return the field list} if bitdisp <> 0 then disp := disp+((bitDisp+7) div 8); tp^.size := disp; end {if} else tp^.size := maxDisp; tp^.fieldList := ufl; end; {if} storageClass := lStorageClass; {restore default storage class} isForwardDeclared := lisForwardDeclared; {restore the forward flag} doingParameters := ldoingParameters; {restore the parameters flag} end; {FieldList} procedure CheckConst; { Check the token to see if it is a const or volatile } begin {CheckConst} while token.kind in [constsy,volatilesy] do begin if token.kind = constsy then isConstant := true else volatile := true; NextToken; end; {while} end; {CheckConst} begin {TypeSpecifier} isForwardDeclared := false; {not doing a forward reference (yet)} skipDeclarator := false; {declarations are required (so far)} CheckConst; case token.kind of unsignedsy: begin {unsigned} NextToken; CheckConst; if token.kind = shortsy then begin NextToken; CheckConst; if token.kind = intsy then begin NextToken; CheckConst; end; {if} typeSpec := uWordPtr; end {if} else if token.kind = longsy then begin NextToken; CheckConst; if token.kind = intsy then begin NextToken; CheckConst; end; {if} typeSpec := uLongPtr; end {else if} else if token.kind = charsy then begin NextToken; CheckConst; typeSpec := uBytePtr; end {else if} else if token.kind = intsy then begin NextToken; CheckConst; if unix_1 then typeSpec := uLongPtr else typeSpec := uWordPtr; end {else if} else begin CheckConst; if unix_1 then typeSpec := uLongPtr else typeSpec := uWordPtr; end; {else if} end; signedsy: begin {signed} NextToken; CheckConst; if token.kind = shortsy then begin NextToken; CheckConst; if token.kind = intsy then begin NextToken; CheckConst; end; {if} typeSpec := wordPtr; end {if} else if token.kind = longsy then begin NextToken; CheckConst; if token.kind = intsy then begin NextToken; CheckConst; end; {if} typeSpec := longPtr; end {else if} else if token.kind = intsy then begin NextToken; CheckConst; if unix_1 then typeSpec := longPtr else typeSpec := wordPtr; end {else if} else if token.kind = charsy then begin NextToken; CheckConst; typeSpec := bytePtr; end; {else if} end; intsy: begin {int} NextToken; CheckConst; if unix_1 then typeSpec := longPtr else typeSpec := wordPtr; end; longsy: begin {long} NextToken; CheckConst; typeSpec := longPtr; if token.kind in [intsy,floatsy] then begin if token.kind = floatsy then typeSpec := doublePtr; NextToken; CheckConst; end {if} else if token.kind = doublesy then begin typeSpec := extendedPtr; NextToken; CheckConst; end; {else if} end; charsy: begin {char} NextToken; CheckConst; typeSpec := uBytePtr; end; shortsy: begin {short} NextToken; CheckConst; if token.kind = intsy then begin NextToken; CheckConst; end; {if} typeSpec := wordPtr; end; floatsy: begin {float} NextToken; CheckConst; typeSpec := realPtr; end; doublesy: begin {double} NextToken; CheckConst; typeSpec := doublePtr; end; compsy: begin {comp} NextToken; CheckConst; typeSpec := compPtr; end; extendedsy: begin {extended} NextToken; CheckConst; typeSpec := extendedPtr; end; voidsy: begin {void} NextToken; CheckConst; typeSpec := voidPtr; end; enumsy: begin {enum} NextToken; {skip the 'enum' token} if token.kind = ident then begin {handle a type definition} variable := FindSymbol(token, tagSpace, true, true); ttoken := token; NextToken; if variable <> nil then if variable^.itype^.kind = enumType then if token.kind <> lbracech then goto 1; tPtr := pointer(Malloc(sizeof(typeRecord))); tPtr^.size := cgWordSize; tPtr^.saveDisp := 0; tPtr^.isConstant := false; tPtr^.kind := enumType; variable := NewSymbol(ttoken.name, tPtr, storageClass, tagSpace, defined); CheckConst; end {if} else if token.kind <> lbracech then Error(9); enumVal := 0; {set the default value} if token.kind = lbracech then begin NextToken; {skip the '{'} repeat {declare the enum constants} tPtr := pointer(Malloc(sizeof(typeRecord))); tPtr^.size := cgWordSize; tPtr^.saveDisp := 0; tPtr^.isConstant := false; tPtr^.kind := enumConst; if token.kind = ident then begin variable := NewSymbol(token.name, tPtr, ident, variableSpace, defined); NextToken; end {if} else Error(9); if token.kind = eqch then begin {handle explicit enumeration values} NextToken; Expression(arrayExpression,[commach,rbracech]); enumVal := long(expressionValue).lsw; if enumVal <> expressionValue then Error(6); end; {if} tPtr^.eval := enumVal; {set the enumeration constant value} enumVal := enumVal+1; {inc the default enumeration value} if token.kind = commach then {next enumeration...} begin done := false; NextToken; end {if} else done := true; until done or (token.kind = eofsy); if token.kind = rbracech then NextToken else begin Error(23); SkipStatement; end; {else} end; {if} 1: skipDeclarator := token.kind = semicolonch; end; structsy, {struct} unionsy: begin {union} globalStruct := false; {we didn't make it global} if token.kind = structsy then {set the type kind to use} tKind := structType else tKind := unionType; structPtr := nil; {no record, yet} structTypePtr := defaultStruct; {use int as a default type} NextToken; {skip 'struct' or 'union'} if token.kind in [ident,typedef] {if there is a struct name then...} then begin {look up the name} structPtr := FindSymbol(token, tagSpace, true, true); ttoken := token; {record the structure name} NextToken; {skip the structure name} if structPtr = nil then begin {if the name hasn't been defined then...} if token.kind <> lbracech then structPtr := FindSymbol(ttoken, tagSpace, false, true); if structPtr <> nil then structTypePtr := structPtr^.itype else begin isForwardDeclared := true; globalStruct := doingParameters and (token.kind <> lbracech); if globalStruct then begin lUseGlobalPool := useGlobalPool; useGlobalPool := true; end; {if} structTypePtr := pointer(Calloc(sizeof(typeRecord))); {structTypePtr^.size := 0;} {structTypePtr^.saveDisp := 0;} {structTypePtr^.isConstant := false;} structTypePtr^.kind := tkind; {structTypePtr^.fieldList := nil;} {structTypePtr^.sName := nil;} structPtr := NewSymbol(ttoken.name, structTypePtr, ident, tagSpace, defined); structTypePtr^.sName := structPtr^.name; end; end {if} {the name has been defined, so...} else if structPtr^.itype^.kind <> tKind then begin Error(42); {it's an error if it's not a struct} structPtr := nil; end {else} else begin {record the existing structure type} structTypePtr := structPtr^.itype; CheckConst; end; {else} end {if} else if token.kind <> lbracech then Error(9); {its an error if there's no name or struct} 2: if token.kind = lbracech then {handle a structure definition...} begin {error if we already have one!} if (structTypePtr <> defaultStruct) and (structTypePtr^.fieldList <> nil) then begin Error(53); structPtr := nil; end; {if} NextToken; {skip the '{'} if structTypePtr = defaultStruct then begin structTypePtr := pointer(Calloc(sizeof(typeRecord))); {structTypePtr^.size := 0;} {structTypePtr^.saveDisp := 0;} {structTypePtr^.isConstant := false;} structTypePtr^.kind := tkind; {structTypePtr^.fieldList := nil;} {structTypePtr^.sName := nil;} end; {if} if structPtr <> nil then structPtr^.itype := structTypePtr; FieldList(structTypePtr,tKind); {define the fields} if token.kind = rbracech then {insist on a closing rbrace} NextToken else begin Error(23); SkipStatement; end; {else} end; {if} if globalStruct then useGlobalPool := lUseGlobalPool; typeSpec := structTypePtr; skipDeclarator := token.kind = semicolonch; end; typedef: begin {named type definition} typeSpec := token.symbolPtr^.itype; NextToken; end; otherwise: ; end; {case} if isconstant then begin {handle a constant type} new(tPtr); if typeSpec^.kind in [structType,unionType] then begin with tPtr^ do begin size := typeSpec^.size; kind := definedType; dType := typeSpec; end; {with} end {if} else tPtr^ := typeSpec^; tPtr^.isConstant := true; typeSpec := tPtr; end; {if} end; {TypeSpecifier} {-- Externally available subroutines ---------------------------} procedure DoDeclaration {doingPrototypes: boolean}; { process a variable or function declaration } { } { parameters: } { doingPrototypes - are we processing a parameter list? } label 1,2,3; var done: boolean; {for loop termination} foundConstsy: boolean; {did we find a constsy?} fName: stringPtr; {for forming uppercase names} i: integer; {loop variable} isAsm: boolean; {has the asm modifier been used?} lDoingParameters: boolean; {local copy of doingParameters} lisPascal: boolean; {local copy of isPascal} lp,tlp,tlp2: identPtr; {for tracing parameter list} ltypeSpec: typePtr; {copy of type specifier} lUseGlobalPool: boolean; {local copy of useGlobalPool} nextPdisp: integer; {for calculating parameter disps} noFDefinitions: boolean; {are function definitions inhibited?} p1,p2,p3: parameterPtr; {for reversing prototyped parameters} variable: identPtr; {pointer to the variable being declared} fnType: typePtr; {function type} segType: integer; {segment type} tp: typePtr; {for tracing type lists} tk: tokenType; {work token} typeFound: boolean; {has some type specifier been found?} procedure CheckArray (v: identPtr; firstVariable: boolean); { make sure all required array sizes are specified } { } { parameters: } { v - pointer to the identifier to check } { firstVariable - can the first array subscript be of a } { non-fixed size? } label 1; var tp: typePtr; {work pointer} begin {CheckArray} if v <> nil then begin {skip check if there's no variable} tp := v^.itype; {initialize the type pointer} while tp <> nil do begin {check all types} if tp^.kind = arrayType then {if it's an array with an unspecified } if tp^.elements = 0 then { size and an unspecified size is not } if not firstVariable then { allowed here, flag an error. } begin Error(49); goto 1; end; {if} firstVariable := false; {unspecified sizes are only allowed in } { the first subscript } case tp^.kind of {next type...} arrayType: tp := tp^.aType; pointerType: begin tp := tp^.pType; firstVariable := true; {(also allowed for pointers to arrays)} end; functionType: tp := tp^.fType; otherwise: tp := nil; end; {case} end; {while} end; {if} 1: end; {CheckArray} procedure SegmentStatement; { compile a segment statement } { } { statement syntax: } { } { 'segment' string-constant [',' 'dynamic'] } var i: integer; {loop variable} len: integer; {segment name length} begin {SegmentStatement} NextToken; if token.kind = stringConst then begin for i := 1 to 10 do begin defaultSegment[i] := chr(0); currentSegment[i] := chr(0); end; {for} len := token.sval^.length; if len > 10 then len := 10; for i := 1 to len do defaultSegment[i] := token.sval^.str[i]; for i := 1 to len do currentSegment[i] := token.sval^.str[i]; FlagPragmas(p_segment); NextToken; if token.kind = commach then begin NextToken; if token.kind = ident then begin if token.name^ = 'dynamic' then segmentKind := $8000 else Error(84); NextToken; end {if} else Error(84); end {if} else segmentKind := 0; Match(semicolonch,22); end {if} else begin Error(83); SkipStatement; end; {else} end; {SegmentStatement} function InPartialList (fName: stringPtr): boolean; { See if the function is in the partial compile list. } { } { If the function is in the list, the function name is } { removed from the list, and true is returned. If not, } { false is returned. } { } { parameters: } { fName - name of the function to check for } label 1,2; var ch: char; {work character} i,j: integer; {loop variable} len: integer; {length of fName} begin {InPartialList} i := partialFileGS.theString.size; {strip trailing blanks} while (i > 0) and (partialFileGS.theString.theString[i] = ' ') do begin partialFileGS.theString.theString[i] := chr(0); i := i-1; end; {while} while partialFileGS.theString.theString[1] = ' ' do {skip leading blanks} for i := 1 to partialFileGS.theString.size do partialFileGS.theString.theString[i] := partialFileGS.theString.theString[i+1]; InPartialList := true; {assume success} i := 1; {scan the name list} len := length(fName^); while partialFileGS.theString.theString[i] <> chr(0) do begin for j := 1 to len do begin if partialFileGS.theString.theString[i+j-1] <> fName^[j] then goto 1; end; {for} if partialFileGS.theString.theString[i+len] in [' ', chr(0)] then begin {found a match - remove from list & return} j := i+len; while partialFileGS.theString.theString[j] = ' ' do j := j+1; repeat ch := partialFileGS.theString.theString[j]; partialFileGS.theString.theString[i] := ch; i := i+1; j := j+1; until ch = chr(0); goto 2; end; {if} 1: {no match - skip to next name} while not (partialFileGS.theString.theString[i] in [chr(0), ' ']) do i := i+1; while partialFileGS.theString.theString[i] = ' ' do i := i+1; end; {while} InPartialList := false; {no match found} 2: end; {InPartialList} procedure SkipFunction (isAsm: boolean); { Skip a function body for a partial compile } { } { Parameters: } { isAsm - are we compiling an asm function? } var braceCount: integer; {# of unmatched { chars} doingAsm: boolean; {compiling an asm statement?} begin {SkipFunction} Match(lbracech,27); {skip to the closing rbrackch} braceCount := 1; doingAsm := false; if isAsm then charKinds[ord('#')] := ch_pound; while (not (token.kind = eofsy)) and (braceCount <> 0) do begin if token.kind = asmsy then begin doingAsm := true; charKinds[ord('#')] := ch_pound; end {if} else if token.kind = lbracech then braceCount := braceCount+1 else if token.kind = rbracech then begin braceCount := braceCount-1; if doingAsm then begin doingAsm := false; charKinds[ord('#')] := illegal; end; {if} end; {else if} NextToken; end; {while} nameFound := false; {no pc_nam for the next function (yet)} doingFunction := false; {no longer doing a function} charKinds[ord('#')] := illegal; {# is a preprocessor command} end; {SkipFunction} begin {DoDeclaration} lDoingParameters := doingParameters; {record the status} noFDefinitions := false; {are function definitions inhibited?} typeFound := false; {no explicit type found, yet} foundConstsy := false; {did not find a constsy} if doingPrototypes then {prototypes implies a parm list} doingParameters := true else lastParameter := nil; {init parm list if we're not doing prototypes} isFunction := false; {assume it's not a function} if not doingFunction then {handle any segment statements} while token.kind = segmentsy do SegmentStatement; inhibitHeader := true; {block imbedded includes in headers} if token.kind in [constsy,volatilesy] {handle leading constsy, volatile} then begin while token.kind in [constsy,volatilesy] do begin if token.kind = constsy then foundConstsy := true else volatile := true; NextToken; end; {while} end; {if} storageClass := ident; {handle a StorageClassSpecifier} lUseGlobalPool := useGlobalPool; if token.kind in [autosy,externsy,registersy,staticsy,typedefsy] then begin typeFound := true; storageClass := token.kind; if not doingFunction then if token.kind = autosy then Error(62); if doingParameters then begin if token.kind <> registersy then Error(87); end {if} else if storageClass in [staticsy,typedefsy] then useGlobalPool := true; NextToken; end; {if} isAsm := false; isPascal := false; while token.kind in [pascalsy,asmsy] do begin if token.kind = pascalsy then isPascal := true else isAsm := true; NextToken; end; {while} lisPascal := isPascal; typeSpec := wordPtr; {default type specifier is an integer} if token.kind in {handle a TypeSpecifier/declarator} [unsignedsy,signedsy,intsy,longsy,charsy,shortsy,floatsy,doublesy,compsy, extendedsy,voidsy,enumsy,structsy,unionsy,typedef,volatilesy,constsy] then begin typeFound := true; TypeSpecifier(false,foundConstsy); if not skipDeclarator then begin variable := nil; Declarator(typeSpec, variable, variableSpace, doingPrototypes); if variable = nil then begin inhibitHeader := false; if token.kind = semicolonch then NextToken else begin Error(22); SkipStatement; end; {else} goto 1; end; {if} end; {if} end {if} else begin variable := nil; Declarator (typeSpec, variable, variableSpace, doingPrototypes); if variable = nil then begin inhibitHeader := false; if token.kind = semicolonch then NextToken else begin Error(22); SkipStatement; end; {else} goto 1; end; {if} end; isPascal := lisPascal; {make sure variables have some type info} if isFunction then begin if not typeFound then if (lint & lintNoFnType) <> 0 then Error(104); end {if} else if not typeFound then Error(26); 3: {handle a function declaration} if isFunction then begin if doingParameters then {a function cannot be a parameter} Error(28); fnType := variable^.itype; {get the type of the function} while (fnType <> nil) and (fnType^.kind <> functionType) do case fnType^.kind of arrayType : fnType := fnType^.aType; pointerType: fnType := fnType^.pType; definedType: fnType := fnType^.dType; otherwise : fnType := nil; end; {case} if fnType = nil then begin SkipStatement; goto 1; end; {if} if isPascal then begin {reverse prototyped parameters} p1 := fnType^.parameterList; if p1 <> nil then begin p2 := nil; while p1 <> nil do begin p3 := p1; p1 := p1^.next; p3^.next := p2; p2 := p3; end; {while} fnType^.parameterList := p2; end; {if} end; {if} {handle functions in the parameter list} if doingPrototypes then PopTable {external or forward declaration} else if (storageClass = externsy) or (token.kind in [commach,semicolonch,inlinesy]) then begin fnType^.isPascal := isPascal; {note if we have pascal parms} if token.kind = inlinesy then {handle tool declarations} with fnType^ do begin NextToken; Match(lparench,13); if token.kind in [intconst,uintconst] then begin toolNum := token.ival; NextToken; end {if} else Error(18); Match(commach,86); if token.kind in [longconst,ulongconst] then begin dispatcher := token.lval; NextToken; end {if} else if token.kind in [intconst,uintconst] then begin dispatcher := token.ival; NextToken; end {if} else Error(18); Match(rparench,12); end; {with} doingParameters := doingPrototypes; {not doing parms any more} if token.kind = semicolonch then begin inhibitHeader := false; NextToken; {skip the trailing semicolon} end {if} else if (token.kind = commach) and (not doingPrototypes) then begin PopTable; {pop the symbol table} NextToken; {allow further declarations} variable := nil; isFunction := false; Declarator (typeSpec, variable, variableSpace, doingPrototypes); if variable = nil then begin inhibitHeader := false; if token.kind = semicolonch then NextToken else begin Error(22); SkipStatement; end; {else} goto 1; end; {if} goto 3; end {else if} else begin Error(22); SkipStatement; end; {else} PopTable; {pop the symbol table} end {if} {cannot imbed functions...} else if doingFunction then begin isPascal := false; Error(28); while token.kind <> eofsy do NextToken; end {if} {local declaration} else begin if noFDefinitions then Error(22); ftype := fnType^.ftype; {record the type of the function} while fType^.kind = definedType do fType := fType^.dType; variable^.state := defined; {note that the function is defined} pfunc := variable; {set the identifier for parm checks} fnType^.isPascal := isPascal; {note if we have pascal parms} doingFunction := true; {read the parameter list} doingParameters := true; {declare the parameters} lp := lastParameter; {(save now; it's volatile)} while not (token.kind in [lbracech,eofsy]) do if (token.kind in [autosy,externsy,registersy,staticsy,typedefsy, unsignedsy,signedsy,intsy,longsy,charsy,shortsy, floatsy,doublesy,compsy,extendedsy,enumsy, structsy,unionsy,typedef,voidsy,volatilesy, constsy,ident]) then DoDeclaration(false) else begin Error(27); NextToken; end; {else} if numberOfParameters <> 0 then {default K&R parm type is int} begin tlp := lp; while tlp <> nil do begin if tlp^.itype = nil then tlp^.itype := wordPtr; tlp := tlp^.pnext; end; {while} end; {if} tlp := lp; {make sure all parameters have an} while tlp <> nil do { identifier } if tlp^.name^ = '?' then begin Error(113); tlp := nil; end {if} else tlp := tlp^.pnext; doingParameters := false; fName := variable^.name; {skip if this is not needed for a } if doingPartial then { partial compile } if not InPartialList(fName) then begin SkipFunction(isAsm); goto 2; end; {if} TermHeader; {make sure the header file is closed} if progress then {write progress information} writeln('Compiling ', fName^); useGlobalPool := false; {start a local label pool} if not codegenStarted and (liDCBGS.kFlag <> 0) then begin {init the code generator (if it needs it)} CodeGenInit (outFileGS, liDCBGS.kFlag, doingPartial); liDCBGS.kFlag := 3; codegenStarted := true; end; {if} foundFunction := true; {got one...} segType := ord(variable^.class = staticsy) * $4000; if fnType^.isPascal then begin fName := pointer(Malloc(length(variable^.name^)+1)); CopyString(pointer(fName), pointer(variable^.name)); for i := 1 to length(fName^) do if fName^[i] in ['a'..'z'] then fName^[i] := chr(ord(fName^[i]) & $5F); Gen2Name (dc_str, segType, 0, fName); end {if} else Gen2Name (dc_str, segType, 0, variable^.name); doingMain := variable^.name^ = 'main'; firstCompoundStatement := true; Gen0 (dc_pin); if not isAsm then Gen0(pc_ent); nextLocalLabel := 1; {initialize GetLocalLabel} returnLabel := GenLabel; {set up an exit point} tempList := nil; {initialize the work label list} if not isAsm then {generate traceback, profile code} if traceBack or profileFlag then begin if traceBack then nameFound := true; GenPS(pc_nam, variable^.name); end; {if} nextPdisp := 0; {assign displacements to the parameters} if not fnType^.isPascal then begin tlp := lp; lp := nil; while tlp <> nil do begin tlp2 := tlp; tlp := tlp^.pnext; tlp2^.pnext := lp; lp := tlp2; end; {while} end; {if} while lp <> nil do begin lp^.pdisp := nextPdisp; if lp^.itype^.kind = arrayType then nextPdisp := nextPdisp + cgPointerSize else begin if lp^.itype^.kind = scalarType then if lp^.itype^.baseType in [cgReal,cgDouble,cgComp] then {all floating-points are passed as extended} lp^.itype := extendedPtr; nextPdisp := nextPdisp + long(lp^.itype^.size).lsw; if (long(lp^.itype^.size).lsw = 1) and (lp^.itype^.kind = scalarType) then nextPdisp := nextPdisp+1; end; {else} lp := lp^.pnext; end; {while} gotoList := nil; {initialize the label list} {set up struct/union area} if variable^.itype^.ftype^.kind in [structType,unionType] then begin lp := NewSymbol(@'@struct', variable^.itype^.ftype, staticsy, variablespace, declared); tk.kind := ident; tk.class := identifier; tk.name := @'@struct'; tk.symbolPtr := nil; lp := FindSymbol(tk, variableSpace, false, true); Gen1Name(pc_lao, 0, lp^.name); Gen2t(pc_str, 0, 0, cgULong); end; {if} if isAsm then begin AsmFunction(variable); {handle assembly language functions} PopTable; end {if} else begin {generate parameter labels} if fnType^.overrideKR then GenParameters(nil) else GenParameters(fnType^.parameterList); CompoundStatement(false); {process the statements} end; {else} end; {else} 2: ; end {if} {handle a variable declaration} else {if not isFunction then} begin noFDefinitions := true; if not SkipDeclarator then repeat if isPascal then begin tp := variable^.itype; while tp <> nil do case tp^.kind of scalarType, enumType, enumConst, definedType, structType, unionType: begin tp := nil; Error(94); end; arrayType: tp := tp^.atype; pointerType: tp := tp^.pType; functionType: begin tp^.isPascal := true; tp := nil; end; end; {case} end; {if} if token.kind = eqch then begin if storageClass = typedefsy then Error(52); if doingPrototypes then Error(88); NextToken; {handle an initializer} ltypeSpec := typeSpec; Initializer(variable); typeSpec := ltypeSpec; end; {if} {check to insure array sizes are specified} if storageClass <> typedefsy then CheckArray(variable, (storageClass = externsy) or doingParameters); {allocate space} if variable^.storage = stackFrame then begin variable^.lln := GetLocalLabel; Gen2(dc_loc, variable^.lln, long(variable^.itype^.size).lsw); end; {if} if (token.kind = commach) and (not doingPrototypes) then begin done := false; {allow multiple variables on one line} NextToken; variable := nil; Declarator(typeSpec, variable, variableSpace, doingPrototypes); if variable = nil then begin if token.kind = semicolonch then NextToken else begin Error(22); SkipStatement; end; {else} goto 1; end; {if} goto 3; end {if} else done := true; until done or (token.kind = eofsy); if doingPrototypes then begin protoVariable := variable; {make the var available to Declarator} if protoVariable = nil then protoType := typeSpec else protoType := protoVariable^.iType; end {if} else begin inhibitHeader := false; if token.kind = semicolonch then {must end with a semicolon} NextToken else begin Error(22); SkipStatement; end; {else} end; {else} end; {else} 1: doingParameters := lDoingParameters; {restore the status} useGlobalPool := lUseGlobalPool; inhibitHeader := false; end; {DoDeclaration} procedure DoStatement; { process a statement from a function } procedure AutoInit; { initialize auto variables } var count: integer; {initializer counter} ip: identPtr; {pointer to a symbol table entry} lp1,lp2: identList; {used to reverse, track the list} iPtr: initializerPtr; {pointer to the next initializer} procedure Initialize (id: identPtr; disp: longint; itype: typePtr); { initialize a variable } { } { parameters: } { id - pointer to the identifier } { disp - disp past the identifier to initialize } { itype - type of the variable to initialize } { } { variables: } { count - number of times to re-use the initializer } { ip - pointer to the initializer record to use } label 1; var elements: longint; {# array elements} fp: identPtr; {for tracing field lists} size: integer; {fill size} union: boolean; {are we doing a union?} {bit field manipulation} {----------------------} bitcount: integer; {# if bits so far} bitsize,bitdisp: integer; {defines size, location of a bit field} {assignment conversion} {---------------------} tree: tokenPtr; {expression tree} val: longint; {constant expression value} isConstant: boolean; {is the expression a constant?} procedure LoadAddress; { Load the address of the operand } begin {LoadAddress} with id^ do {load the base address} case storage of stackFrame: Gen2(pc_lda, lln, 0); parameter: if itype^.kind = arrayType then Gen2t(pc_lod, pln, 0, cgULong) else Gen2(pc_lda, pln, 0); external, global, private: Gen1Name(pc_lao, 0, name); otherwise: ; end; {case} if disp <> 0 then Gen1t(pc_inc, long(disp).lsw, cgULong) end; {LoadAddress} function ZeroFill (elements: longint; itype: typePtr; count: integer; iPtr: initializerPtr): boolean; { See if an array can be zero filled } { } { parameters: } { elements - elements in the array } { itype - type of each array element } { count - remaining initializer repititions } { iPtr - initializer record } begin {ZeroFill} ZeroFill := false; if not iPtr^.isConstant then if itype^.kind in [scalarType,enumType] then if count >= elements then with iPtr^.itree^ do if token.kind = intconst then if token.ival = 0 then ZeroFill := true; end; {ZeroFill} begin {Initialize} case itype^.kind of scalarType,pointerType,enumType,functionType: begin LoadAddress; {load the destination address} doDispose := count = 1; {generate the expression value} tree := iptr^.itree; {see if this is a constant} {do assignment conversions} while tree^.token.kind = castoper do tree := tree^.left; isConstant := tree^.token.class in [intConstant,longConstant]; if isConstant then if tree^.token.class = intConstant then val := tree^.token.ival else val := tree^.token.lval; { if isConstant then if tree^.token.class = intConstant then Writeln('loc 2: bitsize = ', iPtr^.bitsize:1, '; ival = ', tree^.token.ival:1) {debug} { else Writeln('loc 2: bitsize = ', iPtr^.bitsize:1, '; lval = ', tree^.token.lval:1) {debug} { else Writeln('loc 2: bitsize = ', iPtr^.bitsize:1); {debug} GenerateCode(iptr^.iTree); AssignmentConversion(itype, expressionType, isConstant, val, true, false); case itype^.kind of {save the value} scalarType: if iptr^.bitsize <> 0 then Gen2t(pc_sbf, iptr^.bitdisp, iptr^.bitsize, itype^.basetype) else Gen0t(pc_sto, itype^.baseType); enumType: Gen0t(pc_sto, cgWord); pointerType,functionType: Gen0t(pc_sto, cgULong); end; {case} end; arrayType: begin if itype^.aType^.kind = scalarType then if itype^.aType^.baseType in [cgByte,cgUByte] then if iPtr^.iTree^.token.kind = stringConst then begin GenLdcLong(itype^.elements); Gen0t(pc_stk, cgULong); GenS(pc_lca, iPtr^.iTree^.token.sval); Gen0t(pc_stk, cgULong); Gen0t(pc_bno, cgULong); LoadAddress; Gen0t(pc_stk, cgULong); Gen0t(pc_bno, cgULong); Gen1tName(pc_cup, 0, cgVoid, @'strncpy'); iPtr := iPtr^.next; goto 1; end; {if} elements := itype^.elements; itype := itype^.atype; if ZeroFill(elements, itype, count, iPtr) then begin if itype^.kind = enumType then size := cgWordSize else size := TypeSize(itype^.baseType); size := size * long(elements).lsw; LoadAddress; Gen0t(pc_stk, cgULong); Gen1t(pc_ldc, size, cgWord); Gen0t(pc_stk, cgWord); Gen0t(pc_bno, cgULong); Gen1tName(pc_cup, 0, cgVoid, @'~ZERO'); disp := disp + size; count := count - long(elements).lsw; if count = 0 then begin iPtr := iPtr^.next; count := iPtr^.count; end; {if} end {if} else begin while elements <> 0 do begin Initialize(id, disp, itype); if itype^.kind in [scalarType,pointerType,enumType] then begin count := count-1; if count = 0 then begin iPtr := iPtr^.next; count := iPtr^.count; end; {if} end; {if} disp := disp+itype^.size; elements := elements-1; end; {while} end; {else} 1: end; structType,unionType: begin if iPtr^.isStruct then begin LoadAddress; {load the destination address} GenerateCode(iptr^.iTree); {load the stuct address} {do the assignment} AssignmentConversion(itype, expressionType, isConstant, val, true, false); with expressionType^ do Gen2(pc_mov, long(size).msw, long(size).lsw); Gen0t(pc_pop, UsualUnaryConversions); end {if} else begin union := itype^.kind = unionType; fp := itype^.fieldList; bitsize := iPtr^.bitsize; bitdisp := iPtr^.bitdisp; bitcount := 0; while fp <> nil do begin itype := fp^.itype; { writeln('Initialize: disp = ', disp:3, '; fp^. Disp = ', fp^.disp:3, 'itype^.size = ', itype^.size:1); {debug} { writeln(' bitDisp = ', bitDisp:3, '; fp^.bitDisp = ', fp^.bitDisp:3); {debug} { writeln(' bitSize = ', bitSize:3, '; fp^.bitSize = ', fp^.bitSize:3); {debug} Initialize(id, disp, itype); if bitsize = 0 then begin if bitcount <> 0 then begin disp := disp + (bitcount+7) div 8; bitcount := 0; end {if} else if fp^.bitSize <> 0 then begin bitcount := 8; while (fp <> nil) and (bitcount > 0) do begin bitcount := bitcount - fp^.bitSize; if bitcount > 0 then if fp^.next <> nil then if fp^.next^.bitSize <> 0 then fp := fp^.next else bitcount := 0; end; {while} bitcount := 0; disp := disp + 1; end {else if} else disp := disp + itype^.size; end {if} else if fp^.bitSize = 0 then begin bitsize := 0; disp := disp + itype^.size; end {else if} else begin if bitsize + bitdisp < bitcount then disp := disp + (bitcount + 7) div 8; bitcount := bitsize + bitdisp; end; {else} if itype^.kind in [scalarType,pointerType,enumType] then begin count := count-1; if count = 0 then begin iPtr := iPtr^.next; count := iPtr^.count; bitsize := iPtr^.bitsize; bitdisp := iPtr^.bitdisp; end; {if} end; {if} if union then fp := nil else fp := fp^.next; end; {while} end; {else} end; otherwise: Error(57); end; {case} end; {Initialize} begin {AutoInit} lp1 := nil; {reverse the list} while initializerList <> nil do begin lp2 := initializerList; initializerList := lp2^.next; lp2^.next := lp1; lp1 := lp2; end; {while} while lp1 <> nil do begin {initialize the variables} ip := lp1^.id; iPtr := ip^.iPtr; count := iPtr^.count; if ip^.class <> staticsy then Initialize(ip, 0, ip^.itype); lp2 := lp1; lp1 := lp1^.next; dispose(lp2); end; {while} end; {AutoInit} begin {DoStatement} case statementList^.kind of compoundSt: begin if token.kind = rbracech then begin if statementList^.doingDeclaration then if initializerList <> nil then AutoInit; EndCompoundStatement; end {if} else if (statementList^.doingDeclaration = true) and (token.kind in [autosy,externsy,registersy,staticsy,typedefsy, unsignedsy,signedsy,intsy,longsy,charsy,shortsy, floatsy,doublesy,compsy,extendedsy,enumsy, structsy,unionsy,typedef,voidsy,volatilesy, constsy]) then DoDeclaration(false) else begin if statementList^.doingDeclaration then begin statementList^.doingDeclaration := false; if firstCompoundStatement then begin Gen1Name(dc_sym, ord(doingMain), pointer(table)); firstCompoundStatement := false; end; {if} if initializerList <> nil then AutoInit; end; {if} Statement; end; {else} end; ifSt: EndIfStatement; elseSt: EndElseStatement; doSt: EndDoStatement; whileSt: EndWhileStatement; forSt: EndForStatement; switchSt: EndSwitchStatement; otherwise: Error(57); end; {case} end; {DoStatement} procedure InitParser; { Initialize the parser } begin {InitParser} doingFunction := false; {not doing a function (yet)} doingParameters := false; {not processing parameters} lastLine := 0; {no pc_lnm generated yet} nameFound := false; {no pc_nam generated yet} statementList := nil; {no open statements} codegenStarted := false; {code generator is not started} end; {InitParser} procedure TermParser; { shut down the parser } begin {TermParser} if statementList <> nil then case statementList^.kind of compoundSt : Error(34); doSt : Error(33); elseSt : Error(67); forSt : Error(69); ifSt : Error(32); switchSt : Error(70); whileSt : Error(68); otherwise: Error(57); end; {case} end; {TermParser} end. \ No newline at end of file +{$optimize 1} +{---------------------------------------------------------------} +{ } +{ Parser } +{ } +{ External Subroutines: } +{ } +{ DoDeclaration - process a variable or function declaration } +{ DoStatement - process a statement from a function } +{ InitParser - initialize the parser } +{ Match - insure that the next token is of the specified type } +{ TermParser - shut down the parser } +{ TypeSpecifier - handle a type specifier } +{ } +{---------------------------------------------------------------} + +unit Parser; + +{$LibPrefix '0/obj/'} + +interface + +uses CCommon, Table, MM, CGI, Scanner, Header, Symbol, Expression, Asm; + +{$segment 'parser'} + +{---------------------------------------------------------------} + +procedure DoDeclaration (doingPrototypes: boolean); + +{ process a variable or function declaration } +{ } +{ parameters: } +{ doingPrototypes - are we processing a parameter list? } + + +procedure DoStatement; + +{ process a statement from a function } + + +procedure InitParser; + +{ Initialize the parser } + + +procedure Match (kind: tokenEnum; err: integer); + +{ insure that the next token is of the specified type } +{ } +{ parameters: } +{ kind - expected token kind } +{ err - error number if the expected token is not found } + + +procedure TermParser; + +{ shut down the parser } + + +procedure TypeSpecifier (doingFieldList,isConstant: boolean); + +{ handle a type specifier } +{ } +{ parameters: } +{ doingFieldList - are we processing a field list? } +{ isConstant - did we already find a constsy? } + +{---------------------------------------------------------------} + +implementation + +const + maxBitField = 32; {max # of bits in a bit field} + +type + + identList = ^identNode; {list of ids; used for initializers} + identNode = record + next: identList; + id: identPtr; + end; + + { The switch record is used to record the values for the } + { switch jump table. The linked list of entries is in order } + { of increasing switch value (val). } + + switchPtr = ^switchRecord; {switch label table entry} + switchRecord = record + next,last: switchPtr; {doubly linked list (for inserts)} + lab: integer; {label to branch to} + val: longint; {switch value} + end; + + {token stack} + {-----------} + tokenStackPtr = ^tokenStackRecord; + tokenStackRecord = record + next: tokenStackPtr; + token: tokenType; + end; + {statement stack} + {---------------} + statementPtr = ^statementRecord; + {kinds of nestable statements} + statementKind = (compoundSt,ifSt,elseSt,doSt,whileSt,forSt,switchSt); + statementRecord = record {element of the statement stack} + next: statementPtr; {next element on the stack} + breakLab, continueLab: integer; {branch points for break, continue} + case kind: statementKind of + compoundSt: ( + doingDeclaration: boolean; {doing declarations? (or statements)} + ); + ifSt: ( + ifLab: integer; {branch point} + ); + elseSt: ( + elseLab: integer; {branch point} + ); + doSt: ( + doLab: integer; {branch point} + ); + whileSt: ( + whileTop: integer; {label at top of while loop} + whileEnd: integer; {label at bottom of while loop} + ); + forSt: ( + forLoop: integer; {branch here to loop} + e3List: tokenStackPtr; {tokens for last expression} + ); + switchSt: ( + maxVal: longint; {max switch value} + isLong: boolean; {do long switch?} + ln: integer; {temp var number} + size: integer; {temp var size} + labelCount: integer; {# of switch labels} + switchExit: integer; {branch point} + switchLab: integer; {branch point} + switchList: switchPtr; {list of labels and values} + switchDefault: integer; {default branch point} + ); + end; + +var + doingMain: boolean; {are we processing the main function?} + firstCompoundStatement: boolean; {are we doing a function level compound statement?} + fType: typePtr; {return type of the current function} + initializerList: identList; {list of initialized identifiers} + isForwardDeclared: boolean; {is the field list component } + { referenceing a forward struct/union? } + isFunction: boolean; {is the declaration a function?} + isPascal: boolean; {has the pascal modifier been used?} + { (set by DoDeclaration)} + returnLabel: integer; {label for exit point} + skipDeclarator: boolean; {for enum,struct,union with no declarator} + statementList: statementPtr; {list of open statements} + + {parameter processing variables} + {------------------------------} + lastParameter: identPtr; {next parameter to process} + numberOfParameters: integer; {number of indeclared parameters} + pfunc: identPtr; {func. for which parms are being defined} + protoType: typePtr; {type from a parameter list} + protoVariable: identPtr; {variable from a parameter list} + + {type info for the current declaration} + {-------------------------------------} + storageClass: tokenEnum; {storage class of the declaration} +{ typeSpec: typePtr; (in CCommon) {type specifier} + +{-- Parser Utility Procedures ----------------------------------} + +procedure Match {kind: tokenEnum; err: integer}; + +{ insure that the next token is of the specified type } +{ } +{ parameters: } +{ kind - expected token kind } +{ err - error number if the expected token is not found } + +begin {Match} +if token.kind = kind then + NextToken +else + Error(err); +end; {Match} + + +procedure SkipStatement; + +{ Skip the remainder of the current statement } + +var + bracketCount: integer; {for error skip} + +begin {SkipStatement} +bracketCount := 0; +while (token.kind <> eofsy) and + ((token.kind <> semicolonch) or (bracketCount <> 0)) do begin + if token.kind = lbrackch then + bracketCount := bracketCount+1; + if token.kind = rbrackch then + if bracketCount <> 0 then + bracketCount := bracketCount-1; + NextToken; + end; {while} +if token.kind = semicolonch then + NextToken; +end; {SkipStatement} + + +procedure GotoLabel (op: pcodes); + +{ Find a label in the goto label list, creating one if one } +{ does not already exist. Generate the label or a jump to it } +{ based on op. } +{ } +{ paremeters: } +{ op - operation code to create } + +label 1; + +var + gt: gotoPtr; {work pointer} + +begin {GotoLabel} +gt := gotoList; {try to find an existing label} +while gt <> nil do begin + if gt^.name^ = token.name^ then + goto 1; + gt := gt^.next; + end; {while} +gt := pointer(Malloc(sizeof(gotoRecord))); {no label record exists: create one} +gt^.next := gotoList; +gotoList := gt; +gt^.name := token.name; +gt^.lab := GenLabel; +gt^.defined := false; +1: +if op = dc_lab then begin + if gt^.defined then + Error(77) + else begin + gt^.defined := true; + Gen1(dc_lab, gt^.lab); + end; {else} + end {if} +else + Gen1(pc_ujp, gt^.lab); +end; {GotoLabel} + + +{-- Statements -------------------------------------------------} + +procedure CompoundStatement (makeSymbols: boolean); + +{ handle a compound statement } +{ } +{ Parameters: } +{ makeSymbols - create a symbol table? (False for a } +{ function's outer wrapper, true for imbeded statements) } + +var + stPtr: statementPtr; {for creating a compound statement record} + +begin {CompoundStatement} +Match(lbracech,27); {make sure there is an opening '{'} +new(stPtr); {create a statement record} +stPtr^.next := statementList; +statementList := stPtr; +stPtr^.kind := compoundSt; +if makeSymbols then {create a symbol table} + PushTable; +stPtr^.doingDeclaration := true; {allow declarations} +initializerList := nil; {no initializers, yet} +end; {CompoundStatement} + + +procedure EndCompoundStatement; + +{ finish off a compound statement } + +var + dumpLocal: boolean; {dump the local memory pool?} + tl: tempPtr; {work pointer} + stPtr: statementPtr; {work pointer} + +begin {EndCompoundStatement} +dumpLocal := false; +stPtr := statementList; {pop the statement record} +statementList := stPtr^.next; +doingFunction := statementList <> nil; {see if we're done with the function} +if not doingFunction then begin {if so, finish it off} + Gen1(dc_lab, returnLabel); + with fType^ do {generate the pc_ret instruction} + case kind of + scalarType : Gen0t(pc_ret, baseType); + arrayType : ; + structType , + unionType , + pointerType : Gen0t(pc_ret, cgULong); + functionType: ; + enumConst : ; + enumType : Gen0t(pc_ret, cgWord); + definedType : ; + otherwise: Error(57); + end; {case} + Gen0 (dc_enp); {finish the segment} + CheckGotoList; {make sure all labels are declared} + while tempList <> nil do begin {dump the local labels} + tl := tempList; + tempList := tl^.next; + dispose(tl); + end; {while} + dumpLocal := true; {dump the local pool} + nameFound := false; {no pc_nam for the next function (yet)} + end; {if} +PopTable; {remove this symbol table} +dispose(stPtr); {dump the record} +if dumpLocal then begin + useGlobalPool := true; {start using the global memory pool} + LInit; {dispose of the local memory pool} + end; {if} +NextToken; {remove the rbracech token} +end; {EndCompoundStatement} + + +procedure Statement; + +{ handle a statement } + +label 1; + +var + lToken,tToken: tokenType; {for look-ahead} + lPrintMacroExpansions: boolean; {local copy of printMacroExpansions} + + + function GetSwitchRecord: statementPtr; + + { Find the enclosing switch statement } + { } + { Returns a pointer to the closest switch statement record, } + { or nil if there are none. } + + label 1; + + var + stPtr: statementPtr; {work pointer} + + begin {GetSwitchRecord} + stPtr := statementList; + while stPtr <> nil do begin + if stPtr^.kind = switchSt then + goto 1; + stPtr := stPtr^.next; + end; {while} +1: GetSwitchRecord := stPtr; + end; {GetSwitchRecord} + + + procedure AssignmentStatement; + + { handle an asignment statement } + + begin {AssignmentStatement} + if token.kind in startExpression then begin + Expression(normalExpression, [semicolonch]); + if expressionType^.baseType <> cgVoid then + Gen0t(pc_pop, UsualUnaryConversions); + if token.kind = semicolonch then + NextToken + else begin + Error(22); + SkipStatement; + end; {else} + end {if} + else begin + NextToken; + Error(92); + end; {else} + end; {AssignmentStatement} + + + procedure BreakStatement; + + { handle a break statement } + + label 1,2; + + var + stPtr: statementPtr; {work pointer} + + begin {BreakStatement} + stPtr := statementList; {find the proper statement} + while stPtr <> nil do begin + if stPtr^.kind in [whileSt,doSt,forSt,switchSt] then + goto 1; + stPtr := stPtr^.next; + end; {while} + Error(76); + goto 2; + +1: if stPtr^.breakLab = 0 then {if there is no break label, create one} + stPtr^.breakLab := GenLabel; + Gen1(pc_ujp, stPtr^.breakLab); {branch to the break label} +2: + NextToken; {skip the 'break' token} + Match(semicolonch,22); {insist on a closing ';'} + end; {BreakStatement} + + + procedure CaseStatement; + + { handle a case statement } + + var + stPtr: statementPtr; {switch record for this case label} + swPtr,swPtr2: switchPtr; {work pointers for inserting new entry} + val: integer; {case label value} + + begin {CaseStatement} + while token.kind = casesy do begin + NextToken; {skip the 'case' token} + stPtr := GetSwitchRecord; {get the proper switch record} + Expression(arrayExpression, [colonch]); {evaluate the branch condition} + val := long(expressionValue).lsw; + if val <> expressionValue then + if not stPtr^.isLong then + Error(71); + if stPtr = nil then + Error(72) + else begin + new(swPtr2); {create the new label table entry} + swPtr2^.lab := GenLabel; + Gen1(dc_lab, swPtr2^.lab); + swPtr2^.val := expressionValue; + swPtr := stPtr^.switchList; + if swPtr = nil then begin {enter it in the table} + swPtr2^.last := nil; + swPtr2^.next := nil; + stPtr^.switchList := swPtr2; + stPtr^.maxVal := expressionValue; + stPtr^.labelCount := 1; + end {if} + else begin + while (swPtr^.next <> nil) and (swPtr^.val < expressionValue) do + swPtr := swPtr^.next; + if swPtr^.val = expressionValue then + Error(73) + else if swPtr^.val > expressionValue then begin + swPtr2^.next := swPtr; + if swPtr^.last = nil then + stPtr^.switchList := swPtr2 + else + swPtr^.last^.next := swPtr2; + swPtr2^.last := swPtr^.last; + swPtr^.last := swPtr2; + end {else if} + else begin {at end of list} + swPtr2^.next := nil; + swPtr2^.last := swPtr; + swPtr^.next := swPtr2; + stPtr^.maxVal := expressionValue; + end; {else} + stPtr^.labelCount := stPtr^.labelCount + 1; + end; {else} + end; {else} + + Match(colonch,29); {get the colon} + end; {while} + Statement; {process the labeled statement} + end; {CaseStatement} + + + procedure ContinueStatement; + + { handle a continue statement } + + label 1,2; + + var + stPtr: statementPtr; {work pointer} + + begin {ContinueStatement} + stPtr := statementList; {find the proper statement} + while stPtr <> nil do begin + if stPtr^.kind in [whileSt,doSt,forSt] then + goto 1; + stPtr := stPtr^.next; + end; {while} + Error(75); + goto 2; + +1: if stPtr^.continueLab = 0 then {if there is no continue label, create one} + stPtr^.continueLab := GenLabel; + Gen1(pc_ujp, stPtr^.continueLab); {branch to the continue label} +2: + NextToken; {skip the 'continue' token} + Match(semicolonch,22); {insist on a closing ';'} + end; {ContinueStatement} + + + procedure DefaultStatement; + + { handle a default statement } + + var + stPtr: statementPtr; {work pointer} + + begin {DefaultStatement} + NextToken; {skip the 'default' token} + Match(colonch,29); {get the colon} + stPtr := GetSwitchRecord; {record the presense of a default label} + if stPtr = nil then + Error(72) + else if stPtr^.switchDefault <> 0 then + Error(74) + else begin + stPtr^.switchDefault := GenLabel; + Gen1(dc_lab, stPtr^.switchDefault); + end; {else} + Statement; {process the labeled statement} + end; {DefaultStatement} + + + procedure DoStatement; + + { handle a do statement } + + var + lab: integer; {branch label} + stPtr: statementPtr; {work pointer} + + begin {DoStatement} + NextToken; {skip the 'do' token} + new(stPtr); {create a statement record} + stPtr^.next := statementList; + statementList := stPtr; + stPtr^.kind := doSt; + lab := GenLabel; {create the branch label} + Gen1(dc_lab, lab); + stPtr^.doLab := lab; + stPtr^.breakLab := 0; + stPtr^.continueLab := 0; + Statement; {process the first loop body statement} + end; {DoStatement} + + + procedure ForStatement; + + { handle a for statement } + + var + errorFound: boolean; {did we find an error?} + forLoop, continueLab, breakLab: integer; {branch points} + lType: typePtr; {type of "left" expression} + parencount: integer; {number of unmatched '(' chars} + stPtr: statementPtr; {work pointer} + tl,tk: tokenStackPtr; {for forming expression list} + + begin {ForStatement} + NextToken; {skip the 'for' token} + new(stPtr); {create a statement record} + stPtr^.next := statementList; + statementList := stPtr; + stPtr^.kind := forSt; + forLoop := GenLabel; {create the branch labels} + continueLab := GenLabel; + breakLab := GenLabel; + stPtr^.forLoop := forLoop; + stPtr^.continueLab := continueLab; + stPtr^.breakLab := breakLab; + + Match(lparench,13); {evaluate the start condition} + if token.kind <> semicolonch then begin + Expression(normalExpression, [semicolonch]); + Gen0t(pc_pop, UsualUnaryConversions); + end; {if} + Match(semicolonch,22); + + Gen1(dc_lab, forLoop); {this label points to the condition} + if token.kind <> semicolonch then {handle the loop test} + begin {evaluate the expression} + Expression(normalExpression, [semicolonch]); + CompareToZero(pc_neq); {Evaluate the condition} + Gen1(pc_fjp, breakLab); + end; {if} + Match(semicolonch,22); + + tl := nil; {collect the tokens for the last expression} + parencount := 0; + errorFound := false; + while (token.kind <> eofsy) + and ((token.kind <> rparench) or (parencount <> 0)) + and (token.kind <> semicolonch) do begin + new(tk); {place the token in the list} + tk^.next := tl; + tl := tk; + tk^.token := token; + if token.kind = lparench then {allow parens in the expression} + parencount := parencount+1 + else if token.kind = rparench then + parencount := parencount-1; + NextToken; {next token} + end; {while} + if errorFound then {if an error was found, dump the list} + while tl <> nil do begin + tk := tl; + tl := tl^.next; + dispose(tk); + end; {while} + stPtr^.e3List := tl; {save the list} + Match(rparench,12); {get the closing for loop paren} + + Statement; {process the first loop body statement} + end; {ForStatement} + + + procedure IfStatement; + + { handle an if statement } + + var + lab: integer; {branch label} + lType: typePtr; {type of "left" expression} + stPtr: statementPtr; {work pointer} + + begin {IfStatement} + NextToken; {skip the 'if' token} + Match(lparench, 13); {evaluate the condition} + Expression(normalExpression, [rparench]); + Match(rparench, 12); + + lab := GenLabel; {create the branch label} + CompareToZero(pc_neq); {evaluate the condition} + Gen1(pc_fjp, lab); + + new(stPtr); {create a statement record} + stPtr^.next := statementList; + statementList := stPtr; + stPtr^.kind := ifSt; + stPtr^.ifLab := lab; + Statement; {process the 'true' statement} + end; {IfStatement} + + + procedure GotoStatement; + + { handle a goto statement } + + begin {GotoStatement} + NextToken; {skip the 'goto' token} + if token.kind in [ident,typedef] then begin + GotoLabel(pc_ujp); {jump to the label} + NextToken; {skip the token} + end {if} + else + Error(9); {flag the error} + Match(semicolonch, 22); {insist on a closing ';'} + end; {GotoStatement} + + + procedure LabelStatement; + + { handle a labeled statement } + + begin {LabelStatement} + GotoLabel(dc_lab); {define the label} + NextToken; {skip the label} + if token.kind = colonch then {if present, skip the colon} + NextToken + else begin {bad statement - flag error and skip it} + Error(31); + SkipStatement; + end; {else} + end; {LabelStatement} + + + procedure ReturnStatement; + + { handle a return statement } + + var + id: identPtr; {structure id} + size: longint; {size of the struct/union} + tk: tokenType; {structure name token} + + begin {ReturnStatement} + NextToken; {skip the 'return' token} + if token.kind <> semicolonch then {if present, evaluate the return value} + begin + if fType^.kind in [structType,unionType] then begin + tk.kind := ident; + tk.class := identifier; + tk.name := @'@struct'; + tk.symbolPtr := nil; + id := FindSymbol(tk, variableSpace, false, true); + Gen1Name(pc_lao, 0, id^.name); + size := fType^.size; + end; {if} + Expression(normalExpression, [semicolonch]); + AssignmentConversion(fType, expressionType, lastWasConst, lastConst, + true, true); + case fType^.kind of + scalarType: Gen2t(pc_str, 0, 0, fType^.baseType); + enumType: Gen2t(pc_str, 0, 0, cgWord); + pointerType: Gen2t(pc_str, 0, 0, cgULong); + structType, + unionType: begin + Gen2(pc_mov, long(size).msw, long(size).lsw); + Gen0t(pc_pop, cgULong); + end; + otherwise: ; + end; {case} + end; {if} + Gen1(pc_ujp, returnLabel); {branch to the exit point} + Match(semicolonch, 22); {insist on a closing ';'} + end; {ReturnStatement} + + + procedure SwitchStatement; + + { handle a switch statement } + + var + stPtr: statementPtr; {work pointer} + tp: typePtr; {for checking type} + + begin {SwitchStatement} + NextToken; {skip the 'switch' token} + new(stPtr); {create a statement record} + stPtr^.next := statementList; + statementList := stPtr; + stPtr^.kind := switchSt; + stPtr^.maxVal := -maxint4; + stPtr^.isLong := false; + stPtr^.labelCount := 0; + stPtr^.switchLab := GenLabel; + stPtr^.switchExit := GenLabel; + stPtr^.breakLab := stPtr^.switchExit; + stPtr^.switchList := nil; + stPtr^.switchDefault := 0; + Match(lparench, 13); {evaluate the condition} + Expression(normalExpression,[rparench]); + Match(rparench, 12); + tp := expressionType; {make sure the expression is integral} + while tp^.kind = definedType do + tp := tp^.dType; + case tp^.kind of + + scalarType: + if tp^.baseType in [cgLong,cgULong] then begin + stPtr^.isLong := true; + stPtr^.size := cgLongSize; + stPtr^.ln := GetTemp(cgLongSize); + Gen2t(pc_str, stPtr^.ln, 0, cgLong); + end {if} + else if tp^.baseType in [cgByte,cgUByte,cgWord,cgUWord] then begin + stPtr^.isLong := false; + stPtr^.size := cgWordSize; + stPtr^.ln := GetTemp(cgWordSize); + Gen2t(pc_str, stPtr^.ln, 0, cgWord); + end {else if} + else + Error(71); + + enumType: begin + stPtr^.isLong := false; + stPtr^.size := cgWordSize; + stPtr^.ln := GetTemp(cgWordSize); + Gen2t(pc_str, stPtr^.ln, 0, cgWord); + end; + + otherwise: + Error(71); + end; {case} + Gen1(pc_ujp, stPtr^.switchLab); {branch to the xjp instruction} + Statement; {process the loop body statement} + end; {SwitchStatement} + + + procedure WhileStatement; + + { handle a while statement } + + var + lType: typePtr; {type of "left" expression} + stPtr: statementPtr; {work pointer} + top, endl: integer; {branch points} + + begin {WhileStatement} + NextToken; {skip the 'while' token} + new(stPtr); {create a statement record} + stPtr^.next := statementList; + statementList := stPtr; + stPtr^.kind := whileSt; + top := GenLabel; {create the branch labels} + endl := GenLabel; + stPtr^.whileTop := top; + stPtr^.whileEnd := endl; + stPtr^.breakLab := endl; + stPtr^.continueLab := top; + Gen1(dc_lab, top); {define the top label} + Match(lparench, 13); {evaluate the condition} + Expression(normalExpression, [rparench]); + Match(rparench, 12); + CompareToZero(pc_neq); {evaluate the condition} + Gen1(pc_fjp, endl); + Statement; {process the first loop body statement} + end; {WhileStatement} + +begin {Statement} +1: +{if trace names are enabled and a line # is due, generate it} +if traceBack or debugFlag then + if nameFound or debugFlag then + if lastLine <> lineNumber then begin + lastLine := lineNumber; + Gen2(pc_lnm, lineNumber, ord(debugType)); + end; {if} + +{handle the statement} +case token.kind of + asmsy: begin + NextToken; + AsmStatement; + end; + breaksy: BreakStatement; + casesy: CaseStatement; + continuesy: ContinueStatement; + defaultsy: DefaultStatement; + dosy: DoStatement; + elsesy: begin Error(25); SkipStatement; end; + forsy: ForStatement; + gotosy: GotoStatement; + typedef, + ident: begin + lPrintMacroExpansions := printMacroExpansions; + printMacroExpansions := false; + lToken := token; + NextToken; + tToken := token; + PutBackToken(token, true); + token := lToken; + printMacroExpansions := lPrintMacroExpansions; + if tToken.kind = colonch then begin + LabelStatement; + goto 1; + end {if} + else + AssignmentStatement; + end; + ifsy: IfStatement; + lbracech: CompoundStatement(true); + returnsy: ReturnStatement; + semicolonch: NextToken; + switchsy: SwitchStatement; + whilesy: WhileStatement; + otherwise: AssignmentStatement; + end; {case} +end; {Statement} + + +procedure EndDoStatement; + +{ finish off a do statement } + +var + lType: typePtr; {type of "left" expression} + stPtr: statementPtr; {work pointer} + +begin {EndDoStatement} +stPtr := statementList; {get the statement record} +if token.kind = whilesy then begin {if a while clause exists, process it} + NextToken; {skip the 'while' token} + if stPtr^.continueLab <> 0 then {create the continue label} + Gen1(dc_lab, stPtr^.continueLab); + Match(lparench, 13); {evaluate the condition} + Expression(normalExpression, [rparench]); + Match(rparench, 12); + CompareToZero(pc_equ); {evaluate the condition} + Gen1(pc_fjp, stPtr^.doLab); + Match(semicolonch, 22); {process the closing ';'} + end {if} +else + Error(30); {'while' expected} +if stPtr^.breakLab <> 0 then {create the break label} + Gen1(dc_lab, stPtr^.breakLab); +statementList := stPtr^.next; {pop the statement record} +dispose(stPtr); +end; {EndDoStatement} + + +procedure EndIfStatement; + +{ finish off an if statement } + +var + lab1,lab2: integer; {branch labels} + stPtr: statementPtr; {work pointer} + +begin {EndIfStatement} +stPtr := statementList; {get the label to branch to} +lab1 := stPtr^.ifLab; +statementList := stPtr^.next; {pop the statement record} +dispose(stPtr); + +if token.kind = elsesy then begin {if an else clause exists, process it} + NextToken; {skip 'else'} + lab2 := GenLabel; {create the branch label} + Gen1(pc_ujp, lab2); {branch past the else clause} + Gen1(dc_lab, lab1); {create label for if to branch to} + new(stPtr); {create a statement record} + stPtr^.next := statementList; + statementList := stPtr; + stPtr^.kind := elseSt; + stPtr^.elseLab := lab2; + Statement; {evaluate the else clause} + end {if} +else + Gen1(dc_lab, lab1); {create label for if to branch to} +end; {EndIfStatement} + + +procedure EndElseStatement; + +{ finish off an else clause } + +var + stPtr: statementPtr; {work pointer} + +begin {EndElseStatement} +stPtr := statementList; {create the label to branch to} +Gen1(dc_lab, stPtr^.elseLab); +statementList := stPtr^.next; {pop the statement record} +dispose(stPtr); +end; {EndElseStatement} + + +procedure EndForStatement; + +{ finish off a for statement } + +var + ltoken: tokenType; {for putting ; on stack} + stPtr: statementPtr; {work pointer} + tl,tk: tokenStackPtr; {for forming expression list} + lPrintMacroExpansions: boolean; {local copy of printMacroExpansions} + +begin {EndForStatement} +stPtr := statementList; +Gen1(dc_lab, stPtr^.continueLab); {define the continue label} + +tl := stPtr^.e3List; {place the expression back in the list} +if tl <> nil then begin + PutBackToken(token, false); + ltoken.kind := semicolonch; + ltoken.class := reservedSymbol; + PutBackToken(ltoken, false); + while tl <> nil do begin + PutBackToken(tl^.token, false); + tk := tl; + tl := tl^.next; + dispose(tk); + end; {while} + lPrintMacroExpansions := printMacroExpansions; {inhibit token echo} + printMacroExpansions := false; + NextToken; {evaluate the expression} + Expression(normalExpression, [semicolonch]); + Gen0t(pc_pop, UsualUnaryConversions); + NextToken; {skip the seminolon} + printMacroExpansions := lPrintMacroExpansions; + end; {if} + +Gen1(pc_ujp, stPtr^.forLoop); {loop to the test} +Gen1(dc_lab, stPtr^.breakLab); {create the exit label} +statementList := stPtr^.next; {pop the statement record} +dispose(stPtr); +end; {EndForStatement} + + +procedure EndSwitchStatement; + +{ finish off a switch statement } + +const + sparse = 5; {label to tableSize ratio for sparse table} + +var + default: integer; {default label} + ltp: baseTypeEnum; {base type} + minVal: integer; {min switch value} + stPtr: statementPtr; {work pointer} + + {copies of vars (for efficiency)} + {-------------------------------} + exitLab: integer; {label at the end of the jump table} + isLong: boolean; {is the case expression long?} + swPtr,swPtr2: switchPtr; {switch label table list} + +begin {EndSwitchStatement} +stPtr := statementList; {get the statement record} +exitLab := stPtr^.switchExit; {get the exit label} +isLong := stPtr^.isLong; {get the long flag} +swPtr := stPtr^.switchList; {Skip further generation if there were} +if swPtr <> nil then begin { no labels. } + default := stPtr^.switchDefault; {get a default label} + if default = 0 then + default := exitLab; + Gen1(pc_ujp, exitLab); {branch past the indexed jump} + Gen1(dc_lab, stPtr^.switchLab); {create the label for the xjp table} + if isLong then {decide on a base type} + ltp := cgLong + else + ltp := cgWord; + if stPtr^.isLong + or (((stPtr^.maxVal-swPtr^.val) div stPtr^.labelCount) > sparse) then + begin + + {Long expressions and sparse switch statements are handled as a } + {series of if-goto tests. } + while swPtr <> nil do begin {generate the compares} + if isLong then + GenLdcLong(swPtr^.val) + else + Gen1t(pc_ldc, long(swPtr^.val).lsw, cgWord); + Gen2t(pc_lod, stPtr^.ln, 0, ltp); + Gen0t(pc_equ, ltp); + Gen1(pc_tjp, swPtr^.lab); + swPtr2 := swPtr; + swPtr := swPtr^.next; + dispose(swPtr2); + end; {while} + Gen1(pc_ujp, default); {anything else goes to default} + end {if} + else begin + + {compact word switch statements are handled with xjp} + minVal := long(swPtr^.val).lsw; {record the min label value} + Gen2t(pc_lod, stPtr^.ln, 0, ltp); {get the value} + Gen1t(pc_dec, minVal, cgWord); {adjust the range} + Gen1(pc_xjp, ord(stPtr^.maxVal-minVal+1)); {do the indexed jump} + while swPtr <> nil do begin {generate the jump table} + while minVal < swPtr^.val do begin + Gen1(pc_add, default); + minVal := minVal+1; + end; {while} + minVal := minVal+1; + Gen1(pc_add, swPtr^.lab); + swPtr2 := swPtr; + swPtr := swPtr^.next; + dispose(swPtr2); + end; {while} + Gen1(pc_add, default); + end; {if} + Gen1(dc_lab, exitLab); {generate the default label} + end {if} +else begin + Gen1(pc_ujp, exitLab); {branch past the indexed jump} + Gen1(dc_lab, stPtr^.switchLab); {create the label for the xjp table} + + default := stPtr^.switchDefault; {if there is one, jump to the default label} + if default <> 0 then + Gen1(pc_ujp, default); + + Gen1(dc_lab, exitLab); {generate the default label} + end; {else} +FreeTemp(stPtr^.ln, stPtr^.size); {release temp variable} +statementList := stPtr^.next; {pop the statement record} +dispose(stPtr); +end; {EndSwitchStatement} + + +procedure EndWhileStatement; + +{ finish off a while statement } + +var + stPtr: statementPtr; {work pointer} + +begin {EndWhileStatement} +stPtr := statementList; {loop to the test} +Gen1(pc_ujp, stPtr^.whileTop); +Gen1(dc_lab, stPtr^.whileEnd); {create the exit label} +statementList := stPtr^.next; {pop the statement record} +dispose(stPtr); +end; {EndWhileStatement} + +{-- Type declarations ------------------------------------------} + +procedure Declarator(tPtr: typePtr; var variable: identPtr; space: spaceType; + doingPrototypes: boolean); + +{ handle a declarator } +{ } +{ parameters: } +{ tPtr - pointer to the type to use } +{ variable - pointer to variable being defined } +{ space - variable space to use } +{ doingPrototypes - are we compiling prototype parameter } +{ declarations? } + +label 1; + +type + typeDefPtr = ^typeDefRecord; {for stacking type records} + typeDefRecord = record + next: typeDefPtr; + typeDef: typePtr; + end; + pointerListPtr = ^pointerList; {for stacking pointer types} + pointerList = record + next: pointerListPtr; + isConstant: boolean; + end; + +var + i: integer; {loop variable} + lastWasIdentifier: boolean; {for deciding if the declarator is a fuction} + lastWasPointer: boolean; {was the last type a pointer?} + newName: stringPtr; {new symbol name} + parameterStorage: boolean; {is the new symbol in a parm list?} + state: stateKind; {declaration state of the variable} + tPtr2: typePtr; {work pointer} + tsPtr: typeDefPtr; {work pointer} + typeStack: typeDefPtr; {stack of type definitions} + varParmList: boolean; {did we prototype a variable?} + + {for checking function compatibility} + {-----------------------------------} + checkParms: boolean; {do we need to do type checking on the parm?} + compatible: boolean; {are the parameters compatible?} + ftoken: tokenType; {for checking extern functions} + p1,p2,p3: parameterPtr; {used to trace parameter lists} + pt1,pt2: typePtr; {parameter types} + t1: typePtr; {function type} + tk1,tk2: typeKind; {parameter type kinds} + unnamedParm: boolean; {is this an unnamed prototype?} + + + procedure StackDeclarations (var varParmList: boolean); + + { stack the declaration operators } + { } + { Parameters: } + { varParmList - did we create one? } + + var + cp,cpList: pointerListPtr; {pointer list} + done,done2: boolean; {for loop termination} + isPtr: boolean; {is the parenthesized expr a ptr?} + wp: parameterPtr; {used to build prototype var list} + pvar: identPtr; {work pointer} + tPtr2: typePtr; {work pointer} + ttPtr: typeDefPtr; {work pointer} + parencount: integer; {for skipping in parm list} + lvarParmList: boolean; {did we prototype a variable?} + + {variables used to preserve states} + { across recursive calls } + {---------------------------------} + lisFunction: boolean; {local copy of isFunction} + lisPascal: boolean; {local copy of isPascal} + lLastParameter: identPtr; {next parameter to process} + lstorageClass: tokenEnum; {storage class of the declaration} + ltypeSpec: typePtr; {type specifier} + luseGlobalPool: boolean; {local copy of useGlobalPool} + lPrintMacroExpansions: boolean; {local copy of printMacroExpansions} + + begin {StackDeclarations} + varParmList := false; {no var parm list, yet} + lastWasIdentifier := false; {used to see if the declaration is a fn} + cpList := nil; + if token.kind = typedef then + token.kind := ident; + case token.kind of + + ident: begin {handle 'ident'} + if space = fieldListSpace then + variable := nil + else + variable := FindSymbol(token, space, true, true); + newName := token.name; + if variable = nil then begin + if storageClass = typedefsy then begin + tPtr2 := pointer(Calloc(sizeof(typeRecord))); + {tPtr2^.size := 0;} + {tPtr2^.saveDisp := 0;} + tPtr2^.kind := definedType; + {tPtr^.isConstant := false;} + tPtr2^.dType := tPtr; + end {if} + else + tPtr2 := tPtr; + if doingParameters then begin + if not doingPrototypes then + if not (tPtr2^.kind in + [enumConst,structType,unionType,definedType,pointerType]) + then Error(50); + parameterStorage := true; + end; {if} + end {if} + else + checkParms := true; + NextToken; + if token.kind = eqch then + state := initialized; + lastWasIdentifier := true; + end; + + asteriskch: begin {handle '*' 'declarator'} + while token.kind = asteriskch do begin + NextToken; + new(cp); + cp^.next := cpList; + cpList := cp; + cp^.isConstant := false; + while token.kind in + [unsignedsy,signedsy,intsy,longsy,charsy,shortsy,floatsy, + doublesy,compsy,extendedsy,voidsy,enumsy,structsy,unionsy, + volatilesy,constsy] do begin + if token.kind = constsy then + cpList^.isConstant := true + else if token.kind = volatilesy then + volatile := true + else + Error(9); + NextToken; + end; {while} + end; {while} + StackDeclarations(lvarParmList); + end; + + lparench: begin {handle '(' 'declarator' ')'} + NextToken; + isPtr := token.kind = asteriskch; + StackDeclarations(lvarParmList); + Match(rparench,12); + if isPtr then + lastWasIdentifier := false; + end; + + otherwise: + if doingPrototypes then begin {allow for unnamed parameters} + pvar := pointer(Calloc(sizeof(identRecord))); + {pvar^.next := nil;} + {pvar^.saved := 0;} + pvar^.name := @'?'; + pvar^.itype := tPtr; + {pvar^.disp := 0;} + {pvar^.bitDisp := 0;} + {pvar^.bitsize := 0;} + {pvar^.initialized := false;} + {pvar^.iPtr := nil;} + {pvar^.isForwardDeclared := false;} + pvar^.class := autosy; + pvar^.storage := parameter; + variable := pvar; + lastWasIdentifier := true; + newName := nil; + unnamedParm := true; + end; {if} + + end; {case} + + while token.kind in [lparench,lbrackch] do begin + + {handle function declarations} + if token.kind = lparench then begin + lisPascal := isPascal; {preserve this flag} + PushTable; {create a symbol table} + {determine if it's a function} + isFunction := lastWasIdentifier or isFunction; + varParmList := not isFunction; + tPtr2 := pointer(GCalloc(sizeof(typeRecord))); {create the function type} + {tPtr2^.size := 0;} + {tPtr2^.saveDisp := 0;} + tPtr2^.kind := functionType; + {tPtr2^.isConstant := false;} + {tPtr2^.varargs := false;} + {tPtr2^.prototyped := false;} + {tPtr2^.overrideKR := false;} + {tPtr2^.parameterList := nil;} + {tPtr2^.isPascal := false;} + {tPtr2^.toolNum := 0;} + {tPtr2^.dispatcher := 0;} + new(ttPtr); + ttPtr^.next := typeStack; + typeStack := ttPtr; + ttPtr^.typeDef := tPtr2; + NextToken; {skip the '(' token} + if token.kind = voidsy then begin {check for a void prototype} + lPrintMacroExpansions := printMacroExpansions; + printMacroExpansions := false; + NextToken; + printMacroExpansions := lPrintMacroExpansions; + if token.kind = rparench then begin + PutBackToken(token, false); + NextToken; + tPtr2^.prototyped := true; + end + else begin + PutBackToken(token, false); + token.kind := voidsy; + token.class := reservedSymbol; + end; {else} + end; {if} + if token.kind in {see if we are doing a prototyped list} + [autosy,externsy,registersy,staticsy,typedefsy,unsignedsy,intsy, + longsy,charsy,shortsy,floatsy,doublesy,compsy,extendedsy,voidsy, + enumsy,structsy,unionsy,typedef,signedsy,constsy] then begin + + {handle a prototype variable list} + numberOfParameters := 0; {don't allow K&R parm declarations} + luseGlobalPool := useGlobalPool; {use global memory} + useGlobalPool := true; + done2 := false; + lisFunction := isFunction; {preserve global variables} + ltypeSpec := typeSpec; + lstorageClass := storageClass; + with tPtr2^ do begin + prototyped := true; {it is prototyped} + repeat {collect the declarations} + if (token.kind in [autosy,externsy,registersy,staticsy, + typedefsy,unsignedsy,signedsy,intsy,longsy, + charsy,shortsy,floatsy,doublesy,compsy, + extendedsy,enumsy,structsy,unionsy, + typedef,voidsy,volatilesy,constsy]) + then begin + lLastParameter := lastParameter; + DoDeclaration(true); + lastParameter := lLastParameter; + if protoType <> nil then begin + wp := pointer(Malloc(sizeof(parameterRecord))); + wp^.next := parameterList; + parameterList := wp; + wp^.parameter := protoVariable; + wp^.parameterType := protoType; + if protoVariable <> nil then begin + protoVariable^.pnext := lastParameter; + lastParameter := protoVariable; + end; {if} + end; {if} + if token.kind = commach then begin + NextToken; + if token.kind = dotch then begin + NextToken; + Match(dotch,89); + Match(dotch,89); + varargs := true; + done2 := true; + end; {if} + end {if} + else + done2 := true; + end {if} + else begin + Error(26); + parencount := 0; + while (token.kind <> eofsy) + and ((parencount > 0) or (token.kind <> rparench)) do + begin + if token.kind = rparench then + parencount := parencount-1 + else if token.kind = lparench then + parencount := parencount+1; + NextToken; + end; {while} + done2 := true; + end; {else} + until done2; + end; {with} + isFunction := lisFunction; {restore global variables} + storageClass := lstorageClass; + typeSpec := ltypeSpec; + useGlobalPool := luseGlobalPool; + end {if prototype} + else if token.kind = ident then begin + + {handle a K&R variable list} + if (lint & lintNotPrototyped) <> 0 then + Error(105); + if doingFunction or doingPrototypes then + Error(12) + else begin + numberOfParameters := 0; {no function parms yet} + end; {else} + repeat {make a list of parameters} + if not doingFunction then begin + if token.kind <> ident then begin + Error(9); + while not (token.kind in [rparench,commach,ident]) do + NextToken; + end; {if} + if token.kind = ident then begin + pvar := NewSymbol(token.name, nil, ident, variableSpace, + declared); + pvar^.storage := parameter; + pvar^.pnext := lastParameter; + lastParameter := pvar; + numberOfParameters := numberOfParameters+1; + pvar^.bitdisp := numberOfParameters; + NextToken; + end; {if} + end; {if} + if token.kind = commach then begin + NextToken; + done := false; + end {if} + else + done := true; + until done or (token.kind = eofsy); + end {else if} + else if (lint & lintNotPrototyped) <> 0 then + if not tPtr2^.prototyped then + Error(105); + Match(rparench,12); {insist on a closing ')' token} + isPascal := lisPascal; {restore this flag} + end {if} + + {handle array declarations} + else {if token.kind = lbrackch then} begin + lastWasIdentifier := false; + tPtr2 := pointer(Calloc(sizeof(typeRecord))); + {tPtr2^.size := 0;} + {tPtr2^.saveDisp := 0;} + {tPtr2^.isConstant := false;} + tPtr2^.kind := arrayType; + {tPtr2^.elements := 0;} + new(ttPtr); + ttPtr^.next := typeStack; + typeStack := ttPtr; + ttPtr^.typeDef := tPtr2; + NextToken; + if token.kind <> rbrackch then begin + Expression(arrayExpression, [rbrackch,semicolonch]); + if expressionValue <= 0 then begin + Error(45); + expressionValue := 1; + end; {if} + tPtr2^.elements := expressionValue; + end; {if} + Match(rbrackch,24); + end; {else if} + end; {while} + + {stack pointer type records} + while cpList <> nil do begin + tPtr2 := pointer(Malloc(sizeof(typeRecord))); + tPtr2^.size := cgPointerSize; + tPtr2^.saveDisp := 0; + tPtr2^.isConstant := cpList^.isConstant; + tPtr2^.kind := pointerType; + new(ttPtr); + ttPtr^.next := typeStack; + typeStack := ttPtr; + ttPtr^.typeDef := tPtr2; + cp := cpList; + cpList := cp^.next; + dispose(cp); + end; {for} + end; {StackDeclarations} + +begin {Declarator} +newName := nil; {no identifier, yet} +unnamedParm := false; {not an unnamed parameter} +if storageClass = externsy then {decide on a storage state} + state := declared +else + state := defined; +typeStack := nil; {no types so far} +parameterStorage := false; {symbol is not in a parameter list} +checkParms := false; {assume we won't need to check for parameter type errors} +StackDeclarations(varParmList); {stack the type records} +while typeStack <> nil do begin {reverse the type stack} + tsPtr := typeStack; + typeStack := tsPtr^.next; + if isFunction and (not useGlobalPool) then begin + tPtr2 := pointer(GMalloc(sizeof(typeRecord))); + tPtr2^ := tsPtr^.typeDef^; + tPtr2^.saveDisp := 0; + end {if} + else + tPtr2 := tsPtr^.typeDef; + dispose(tsPtr); + if tPtr^.kind = functionType then + PopTable; + case tPtr2^.kind of + pointerType: begin + tPtr2^.pType := tPtr; + end; + functionType: begin + while tPtr^.kind = definedType do + tPtr := tPtr^.dType; + tPtr2^.fType := tPtr; + if tPtr^.kind in [functionType,arrayType] then + Error(103); + end; + arrayType: begin + tPtr2^.size := tPtr^.size * tPtr2^.elements; + tPtr2^.aType := tPtr; + end; + otherwise: ; + end; {case} + tPtr := tPtr2; + end; {while} + +if checkParms then begin {check for parameter type conflicts} + with variable^ do begin + if doingParameters then begin + if itype = nil then begin + itype := tPtr; + numberOfParameters := numberOfParameters-1; + if pfunc^.itype^.prototyped then begin + pfunc^.itype^.overrideKR := true; + p1 := nil; + for i := 1 to bitdisp do begin + p2 := pfunc^.itype^.parameterList; + while (p2^.next <> p1) and (p2 <> nil) do + p2 := p2^.next; + p1 := p2; + end; {for} + compatible := false; + if CompTypes(p1^.parameterType, tPtr) then + compatible := true + else begin + tk1 := p1^.parameterType^.kind; + tk2 := tPtr^.kind; + if (tk1 = arrayType) and (tk2 = pointerType) then + compatible := + CompTypes(p1^.parameterType^.aType, tPtr^.pType) + else if (tk1 = pointerType) and (tk2 = arrayType) then + compatible := + CompTypes(p1^.parameterType^.pType, tPtr^.aType); + end; {else} + if not compatible then + Error(47); + end; {if} + end {if} + else + Error(42); + storage := parameter; + parameterStorage := true; + end; {if} + end; {with} + end {if} +else if doingParameters then + if pfunc^.itype^.prototyped then + if not doingPrototypes then + if tPtr^.kind in + [enumConst,structType,unionType,definedType,pointerType] + then Error(50); + +if tPtr^.kind = functionType then begin {declare the identifier} + if variable <> nil then begin + t1 := variable^.itype; + if CompTypes(t1, tPtr) then begin + if t1^.prototyped and tPtr^.prototyped then begin + p2 := tptr^.parameterList; + if isPascal then begin + {reverse the parameter list} + p1 := nil; + while p2 <> nil do begin + p3 := p2; + p2 := p2^.next; + p3^.next := p1; + p1 := p3; + end; {while} + tPtr^.parameterList := p1; + end; {if} + p2 := tPtr^.parameterList; + p1 := t1^.parameterList; + while (p1 <> nil) and (p2 <> nil) do begin + if p1^.parameter = nil then + pt1 := p1^.parameterType + else + pt1 := p1^.parameter^.itype; + if p2^.parameter = nil then + pt2 := p2^.parameterType + else + pt2 := p2^.parameter^.itype; + if not CompTypes(pt1, pt2) then begin + Error(47); + goto 1; + end; {if} + p1 := p1^.next; + p2 := p2^.next; + end; {while} + if p1 <> p2 then + Error(47); + p2 := tptr^.parameterList; + if isPascal then begin + {reverse the parameter list} + p1 := nil; + while p2 <> nil do begin + p3 := p2; + p2 := p2^.next; + p3^.next := p1; + p1 := p3; + end; {while} + tPtr^.parameterList := p1; + end; {if} + end; {if} + end {if} + else + Error(42); +1: + end; {if} + end; {if} +if tPtr^.kind = functionType then + state := declared; +if newName <> nil then {declare the variable} + variable := NewSymbol(newName, tPtr, storageClass, space, state) +else if unnamedParm then + variable^.itype := tPtr +else begin + if token.kind <> semicolonch then + Error(9); + variable := nil; + end; {else} +if variable <> nil then begin + if parameterStorage then + variable^.storage := parameter; + if isForwardDeclared then begin {handle forward declarations} + tPtr := variable^.itype; + lastWasPointer := false; + while tPtr^.kind in + [pointerType,arrayType,functionType,definedType] do begin + if tPtr^.kind = pointerType then + lastWasPointer := true + else if tPtr^.kind <> definedType then + lastWasPointer := false; + tPtr := tPtr^.pType; + end; {while} + if ((tPtr <> typeSpec) and (not (tPtr^.kind in [structType,unionType]))) + then begin + Error(107); + SkipStatement; + end; {if} + variable^.isForwardDeclared := true; + end; {if} + end; {if} +end; {Declarator} + + +procedure Initializer (var variable: identPtr); + +{ handle a variable initializer } +{ } +{ paramaters: } +{ variable - ptr to the identifier begin initialized } + +var + bitcount: integer; {# if bits initialized} + bitvalue: longint; {bit field initializer value} + done: boolean; {for loop termination} + errorFound: boolean; {used to remove bad initializations} + iPtr,jPtr,kPtr: initializerPtr; {for reversing the list} + ip: identList; {used to place an id in the list} + luseGlobalPool: boolean; {local copy of useGlobalPool} + + + procedure InitializeBitField; + + { If bit fields have been initialized, fill them in } + { } + { Inputs: } + { bitcount - # of bits initialized } + { bitvalue - value of initializer } + + var + iPtr: initializerPtr; {for creating an initializer entry} + + begin {InitializeBitField} + if bitcount <> 0 then begin {skip if there has been no initializer} +{ writeln('InitializeBitField; bitcount = ', bitcount:1); {debug} + {create the initializer entry} + iPtr := pointer(Malloc(sizeof(initializerRecord))); + iPtr^.next := variable^.iPtr; + variable^.iPtr := iPtr; + iPtr^.isConstant := isConstant; + iPtr^.count := 1; + iPtr^.bitdisp := 0; + iPtr^.bitsize := 0; + iPtr^.isStruct := false; + iPtr^.iVal := bitvalue; + if bitcount > 16 then + iPtr^.itype := cgULong + else if bitcount > 8 then + iPtr^.itype := cgUWord + else + iPtr^.itype := cgUByte; + bitcount := 0; {reset the bit field values} + bitvalue := 0; + end; {if} + end; {InitializeBitField} + + + procedure GetInitializerValue (tp: typePtr; bitsize,bitdisp: integer); + + { get the value of an initializer from a single expression } + { } + { parameters: } + { tp - type of the variable being initialized } + { bitsize - size of bit field (0 for non-bit fields) } + { bitdisp - disp of bit field; unused if bitsize = 0 } + + label 1,2,3; + + var + bitmask: longint; {used to add a value to a bit field} + bKind: baseTypeEnum; {type of constant} + etype: typePtr; {expression type} + i: integer; {loop variable} + ip: identPtr; {ident in pointer constant} + iPtr: initializerPtr; {for creating an initializer entry} + kind: tokenEnum; {kind of constant} + offset, offset2: longint; {integer offset from a pointer} + operator: tokenEnum; {operator for constant pointers} + tKind: typeKind; {type of constant} + tree: tokenPtr; {for evaluating pointer constants} + + + function Subscript (tree: tokenPtr): typePtr; + + { handle subscripts in a pointer constant } + { } + { parameters: } + { tree - subscript operators } + { } + { returns: type of the variable } + { } + { variables: } + { iPtr - initializer location to store the array name } + { offset - bytes past the start of the array } + + var + ip: identPtr; {ident pointer} + rtree: tokenPtr; {work pointer} + tp: typePtr; {for tracking types} + select: longint; {selector size} + size: longint; {subscript value} + + begin {Subscript} + if tree^.token.kind = uasterisk then begin + tree := tree^.left; + if tree^.token.kind = plusch then begin + rtree := tree^.right; + if rtree^.token.kind in [intconst,uintconst] then + size := rtree^.token.ival + else if rtree^.token.kind in [longconst,ulongconst] then + size := rtree^.token.lval + else begin + Error(18); + errorFound := true; + end; {else} + tp := Subscript(tree^.left); + if tp^.kind <> arrayType then + Error(47) + else begin + tp := tp^.atype; + offset := offset + size*tp^.size; + Subscript := tp; + end; {else} + end {if} + else begin + Error(47); + errorFound := true; + Subscript := wordPtr; + end; {else} + end {if} + else if tree^.token.kind = dotch then begin + tp := Subscript(tree^.left); + if tp^.kind in [structType,unionType] then begin + DoSelection(tp, tree^.right, select); + Subscript := expressionType; + offset := offset+select; + if isBitField then + Error(106); + end {if} + else begin + Error(47); + errorFound := true; + Subscript := wordPtr; + end; {else} + end {else if} + else if tree^.token.kind = ident then begin + ip := FindSymbol(tree^.token, allSpaces, false, true); + if ip = nil then begin + Error(31); + errorFound := true; + Subscript := wordPtr; + iPtr^.pName := @'?'; + end {if} + else begin + Subscript := ip^.itype; + iPtr^.pName := ip^.name; + end; {else} + end {else if} + else begin + Error(47); + errorFound := true; + Subscript := wordPtr; + end; {else} + end; {Subscript} + + + begin {GetInitializerValue} + if variable^.storage = stackFrame then + Expression(autoInitializerExpression, [commach,rparench,rbracech]) + else + Expression(initializerExpression, [commach,rparench,rbracech]); + if bitsize = 0 then begin + iPtr := pointer(Malloc(sizeof(initializerRecord))); + iPtr^.next := variable^.iPtr; + variable^.iPtr := iPtr; + iPtr^.isConstant := isConstant; + iPtr^.count := 1; + iPtr^.bitdisp := 0; + iPtr^.bitsize := 0; + iPtr^.isStruct := false; + end; {if} + etype := expressionType; + AssignmentConversion(tp, expressionType, isConstant, expressionValue, + false, false); + if variable^.storage = external then + variable^.storage := global; + if isConstant and (variable^.storage in [external,global,private]) then begin + if bitsize = 0 then begin + iPtr^.iVal := expressionValue; + iPtr^.itype := tp^.baseType; + InitializeBitField; + end; {if} + case tp^.kind of + + scalarType: begin + bKind := tp^.baseType; + if (bKind in [cgByte..cgULong]) + and (etype^.baseType in [cgByte..cgULong]) then begin + if bKind in [cgLong,cgULong] then + if eType^.baseType = cgUByte then + iPtr^.iVal := iPtr^.iVal & $000000FF + else if eType^.baseType = cgUWord then + iPtr^.iVal := iPtr^.iVal & $0000FFFF; + goto 3; + end; {if} + if bKind in [cgReal,cgDouble,cgComp,cgExtended] then begin + if etype^.baseType in [cgByte..cgULong] then + iPtr^.rVal := expressionValue + else if etype^.baseType in + [cgReal,cgDouble,cgComp,cgExtended] then + iPtr^.rval := realExpressionValue; + goto 3; + end; {if} + Error(47); + errorFound := true; + goto 2; + +3: if bitsize <> 0 then begin + + {set up a bit field value} + if bitdisp < bitcount then + InitializeBitField; + bitmask := 0; + for i := 1 to bitsize do + bitmask := (bitmask << 1) | 1; + bitmask := bitmask & expressionValue; + for i := 1 to bitdisp do + bitmask := bitmask << 1; + bitvalue := bitvalue | bitmask; + bitcount := bitcount + bitsize; + end; {if} + end; + + arrayType: begin + if tp^.aType^.kind = scalarType then + if tp^.aType^.baseType in [cgByte,cgUByte] then + if eType^.baseType = cgString then + goto 2; + Error(46); + errorFound := true; + end; + + pointerType: + if etype = stringTypePtr then begin + iPtr^.isConstant := true; + iPtr^.iType := ccPointer; + iPtr^.pval := 0; + iPtr^.pPlus := operator = plusch; + iPtr^.isName := false; + iPtr^.pStr := longstringPtr(expressionValue); + end {if} + else if etype^.kind = scalarType then + if etype^.baseType in [cgByte..cgULong] then + if expressionValue = 0 then + iPtr^.iType := cgULong + else begin + Error(47); + errorFound := true; + end {else} + else begin + Error(48); + errorFound := true; + end {else} + else if etype^.kind = pointerType then begin + iPtr^.iType := cgULong; + iPtr^.pval := expressionValue; + end {else if} + else begin + Error(48); + errorFound := true; + end; {else} + + structType,enumType: begin + Error(46); + errorFound := true; + end; + + otherwise: + Error(57); + + end; {case} +2: DisposeTree(initializerTree); + end {if} + else begin + if (tp^.kind = pointerType) + or ((tp^.kind = scalarType) and (tp^.baseType in [cgLong,cgULong])) + then begin + iPtr^.iType := ccPointer; + if variable^.storage in [external,global,private] then begin + + {do pointer constants with + or -} + iPtr^.isConstant := true; + tree := initializerTree; + while tree^.token.kind = castoper do + tree := tree^.left; + offset := 0; + operator := tree^.token.kind; + while operator in [plusch,minusch] do begin + with tree^.right^.token do + if kind in [intConst,longConst] then begin + if kind = intConst then + offSet2 := ival + else + offset2 := lval; + if operator = plusch then + offset := offset + offset2 + else + offset := offset - offset2; + end {if} + else begin + Error(47); + errorFound := true; + end; {else} + tree := tree^.left; + operator := tree^.token.kind; + end; {if} + kind := tree^.token.kind; + if kind = ident then begin + + {handle names of functions or static arrays} + ip := FindSymbol(tree^.token, allSpaces, false, true); + if ip = nil then begin + Error(31); + errorFound := true; + end {if} + else begin + tKind := ip^.itype^.kind; + if tKind = functionType then begin + if operator in [plusch,minusch] then begin + Error(47); + errorFound := true; + end; {if} + end {if} + else if (tKind = arrayType) + and (ip^.storage in [external,global,private]) then begin + offset := offset*ip^.itype^.atype^.size; + end {else if} + else if tKind = pointerType then begin + Error(48); + errorFound := true; + end {else if} + else begin + Error(47); + errorFound := true; + end; {else} + iPtr^.pval := offset; + iPtr^.pPlus := true; + iPtr^.isName := true; + iPtr^.pName := ip^.name; + end; {if} + end {if} + else if kind = uand then begin + tree := tree^.left; + iPtr^.pPlus := operator = plusch; + iPtr^.isName := true; + if tree^.token.kind = ident then begin + ip := FindSymbol(tree^.token, allSpaces, false, true); + if ip = nil then begin + Error(31); + errorFound := true; + end {if} + else + if ip^.storage in [external,global,private] then begin + offset := offset*ip^.itype^.size; + iPtr^.pName := ip^.name; + end {if} + else begin + Error(47); + errorFound := true; + end; {else} + end {if} + else begin + tp := Subscript(tree); + if offset > 0 then + iPtr^.pPlus := true + else begin + iPtr^.pPlus := false; + offset := -offset; + end; {else} + end; {else} + iPtr^.pval := offset; + end {else if} + else if kind in [dotch,uasterisk] then begin + iPtr^.isName := true; + tp := Subscript(tree); + if offset > 0 then + iPtr^.pPlus := true + else begin + iPtr^.pPlus := false; + offset := -offset; + end; {else} + iPtr^.pval := offset; + end {else if} + else if kind = stringConst then begin + iPtr^.pval := offset; + iPtr^.pPlus := operator = plusch; + iPtr^.isName := false; + iPtr^.pStr := tree^.token.sval; + end {else if} + else begin + Error(47); + errorFound := true; + end; {else} + DisposeTree(initializerTree); + goto 1; + end; {if} + end {if} + else if tp^.kind = structType then + iPtr^.isStruct := true; + + {handle auto variables} + if bitsize <> 0 then begin + iPtr := pointer(Malloc(sizeof(initializerRecord))); + iPtr^.next := variable^.iPtr; + variable^.iPtr := iPtr; + iPtr^.isConstant := isConstant; + iPtr^.count := 1; + iPtr^.bitdisp := bitdisp; + iPtr^.bitsize := bitsize; + iPtr^.isStruct := false; + end; {if} + if variable^.storage in [external,global,private] then begin + Error(41); + errorFound := true; + end; {else} + iPtr^.isConstant := false; + iPtr^.iTree := initializerTree; + iPtr^.bitdisp := bitdisp; + iPtr^.bitsize := bitsize; + end; {else} +1: + end; {GetInitializerValue} + + + procedure InitializeTerm (tp: typePtr; bitsize,bitdisp: integer; + main: boolean); + + { initialize one level of the type } + { } + { parameters: } + { tp - pointer to the type being initialized } + { bitsize - size of bit field (0 for non-bit fields) } + { bitdisp - disp of bit field; unused if bitsize = 0 } + { main - is this a call from the main level? } + + var + bitCount: integer; {# of bits in a union} + braces: boolean; {is the initializer inclosed in braces?} + count,maxCount: longint; {for tracking the size of an initializer} + ep: tokenPtr; {for forming string expression} + iPtr: initializerPtr; {for creating an initializer entry} + ip: identPtr; {for tracing field lists} + kind: typeKind; {base type of an initializer} + ktp: typePtr; {array type with definedTypes removed} + + + procedure Fill (count: longint; tp: typePtr); + + { fill in unspecified space in an initialized array with 0 } + { } + { parameters: } + { count - ^ elements of this type to create } + { tp - ptr to type of elements to create } + + var + i: longint; {loop variable} + iPtr: initializerPtr; {for creating an initializer entry} + tk: tokenPtr; {expression record} + ip: identPtr; {pointer to next field in a structure} + + begin {Fill} +{ writeln('Fill tp^.kind = ', ord(tp^.kind):1, '; count = ', count:1); {debug} + InitializeBitField; {if needed, do the bit field} + if tp^.kind = arrayType then + + {fill an array} + Fill(count*tp^.elements ,tp^.aType) + else if tp^.kind = structType then begin + + {fill a structure} + i := count; + while i <> 0 do begin + ip := tp^.fieldList; + while ip <> nil do begin + Fill(1, ip^.iType); + ip := ip^.next; + end; {while} + i := i-1; + end; {while} + end {else if} + else if tp^.kind = unionType then + + {fill a union} + Fill(count, tp^.fieldList^.iType) + else + + {fill a single value} + while count <> 0 do begin + iPtr := pointer(Calloc(sizeof(initializerRecord))); + iPtr^.next := variable^.iPtr; + variable^.iPtr := iPtr; + iPtr^.isConstant := variable^.storage in [external,global,private]; + {iPtr^.bitdisp := 0;} + {iPtr^.bitsize := 0;} + {iPtr^.isStruct := false;} + if iPtr^.isConstant then begin + if tp^.kind = scalarType then + iPtr^.itype := tp^.baseType + else if tp^.kind = pointertype then begin + iPtr^.itype := cgULong; + {iPtr^.iVal := 0;} + end {else if} + else begin + iPtr^.itype := cgWord; + Error(47); + errorFound := true; + end; {else} + end {if} + else begin + new(tk); + tk^.next := nil; + tk^.left := nil; + tk^.middle := nil; + tk^.right := nil; + tk^.token.kind := intconst; + tk^.token.class := intConstant; + tk^.token.ival := 0; + iPtr^.iTree := tk; + end; {else} + if count < 16384 then begin + iPtr^.count := long(count).lsw; + count := 0; + end {if} + else begin + iPtr^.count := 16384; + count := count-16384; + end; {else} + end; {while} + end; {Fill} + + + procedure RecomputeSizes (tp: typePtr); + + { a size has been infered from an initializer - set the } + { appropriate type size values } + { } + { parameters: } + { tp - type to check } + + begin {RecomputeSizes} + if tp^.aType^.kind = arrayType then + RecomputeSizes(tp^.aType); + with tp^ do + size := aType^.size*elements; + end; {RecomputeSizes} + + begin {InitializeTerm} + braces := false; {allow for an opening brace} + if token.kind = lbracech then begin + NextToken; + braces := true; + end; {if} + + {handle arrays} + while tp^.kind = definedType do + tp := tp^.dType; + kind := tp^.kind; + if kind = arrayType then begin + ktp := tp^.atype; + while ktp^.kind = definedType do + ktp := ktp^.dType; + kind := ktp^.kind; + + {handle string constants} + if (token.kind = stringConst) and (kind = scalarType) + and (ktp^.baseType in [cgByte,cgUByte]) then begin + if tp^.elements = 0 then begin + tp^.elements := token.sval^.length + 1; + RecomputeSizes(variable^.itype); + end {if} + else if tp^.elements < token.sval^.length then begin + Error(44); + errorFound := true; + end; {else if} + with ktp^ do begin + iPtr := pointer(Malloc(sizeof(initializerRecord))); + iPtr^.next := variable^.iPtr; + variable^.iPtr := iPtr; + iPtr^.count := 1; + iPtr^.bitdisp := 0; + iPtr^.bitsize := 0; + iPtr^.isStruct := false; + if (variable^.storage in [external,global,private]) then begin + iPtr^.isConstant := true; + iPtr^.itype := cgString; + iPtr^.sval := token.sval; + count := tp^.elements - token.sval^.length; + if count <> 0 then + Fill(count, bytePtr); + end {if} + else begin + iPtr^.isConstant := false; + new(ep); + iPtr^.iTree := ep; + ep^.next := nil; + ep^.left := nil; + ep^.middle := nil; + ep^.right := nil; + ep^.token := token; + end; {else} + end; {with} + NextToken; + end {if} + + {handle arrays of non-strings} + else if kind in + [scalarType,pointerType,enumType,arrayType,structType,unionType] then + begin + count := 0; {get the expressions|initializers} + maxCount := tp^.elements; + if token.kind <> rbracech then + repeat + InitializeTerm(ktp, 0, 0, false); + count := count+1; + if count <> maxCount then begin + if token.kind = commach then begin + NextToken; + done := token.kind = rbracech; + end {if} + else + done := true; + end {if} + else + done := true; + until done or (token.kind = eofsy) or (count = maxCount); + if maxCount <> 0 then begin + count := maxCount-count; + if count <> 0 then {if there weren't enough initializers...} + Fill(count,ktp); { fill in the blank spots} + end {if} + else begin + tp^.elements := count; {set the array size} + RecomputeSizes(variable^.itype); + end; {else} + end {else if} + + else begin + Error(47); + errorFound := true; + end; {else} + end {if} + + {handle structures} + else if kind = structType then begin + if braces or (not main) then begin + count := tp^.size; + ip := tp^.fieldList; + bitCount := 0; + while (ip <> nil) and (token.kind <> rbracech) do begin + if ip^.isForwardDeclared then + ResolveForwardReference(ip); + InitializeTerm(ip^.itype, ip^.bitsize, ip^.bitdisp, false); + if ip^.bitSize <> 0 then begin + bitCount := bitCount + ip^.bitSize; + if bitCount > maxBitField then begin + count := count - (maxBitField div 8); + bitCount := ip^.bitSize; + end; {if} + end {if} + else begin + if bitCount > 0 then begin + bitCount := (bitCount+7) div 8; + count := count-bitCount; + bitCount := 0; + end; {if} + count := count-ip^.itype^.size; + end; {else} +{ writeln('Initializer: ', ip^.bitsize:10, ip^.bitdisp:10, bitCount:10); {debug} + ip := ip^.next; + if token.kind = commach then begin + if ip <> nil then + NextToken; + end {if} + else + ip := nil; + end; {while} + if bitCount > 0 then begin + InitializeBitField; + bitCount := (bitCount+7) div 8; + count := count-bitCount; + bitCount := 0; + end; {if} + if count > 0 then + Fill(count, bytePtr); + end {if} + else {struct assignment initializer} + GetInitializerValue(tp, bitsize, bitdisp); + end {else if} + + {handle unions} + else if kind = unionType then begin + ip := tp^.fieldList; + if ip^.isForwardDeclared then + ResolveForwardReference(ip); + InitializeTerm(ip^.itype, 0, 0, false); + count := tp^.size - ip^.itype^.size; + if count > 0 then + Fill(count, bytePtr); + end {else if} + + {handle single-valued types} + else if kind in [scalarType,pointerType,enumType] then + GetInitializerValue(tp, bitsize, bitdisp) + + else begin + Error(47); + errorFound := true; + end; {else} + + if braces then begin {if there was an opening brace then } + if token.kind = commach then { insist on a closing brace } + NextToken; + if token.kind = rbracech then + NextToken + else begin + Error(23); + while not (token.kind in [rbracech,eofsy]) do + NextToken; + NextToken; + errorFound := true; + end; {else} + end; {if} + end; {InitializeTerm} + +begin {Initializer} +bitcount := 0; {set up for bit fields} +bitvalue := 0; +errorFound := false; {no errors found so far} +luseGlobalPool := useGlobalPool; {use global memory for global vars} +useGlobalPool := (variable^.storage in [external,global,private]) + or useGlobalPool; + {make sure a required '{' is there} +if not (token.kind in [lbracech,stringConst]) then + if variable^.itype^.kind = arrayType then begin + Error(27); + errorFound := true; + end; {if} +InitializeTerm(variable^.itype, 0, 0, true); {do the initialization} +variable^.state := initialized; {mark the variable as initialized} +iPtr := variable^.iPtr; {reverse the initializer list} +jPtr := nil; +while iPtr <> nil do begin + kPtr := iPtr; + iPtr := iPtr^.next; + kPtr^.next := jPtr; + jPtr := kPtr; + end; {while} +variable^.iPtr := jPtr; +if errorFound then {eliminate bad initializers} + variable^.state := defined; +new(ip); {place the initializer in the list} +ip^.next := initializerList; +ip^.id := variable; +initializerList := ip; +useGlobalPool := luseGlobalPool; {restore useGlobalPool} +end; {Initializer} + + +procedure TypeSpecifier {doingFieldList,isConstant: boolean}; + +{ handle a type specifier } +{ } +{ parameters: } +{ doingFieldList - are we processing a field list? } +{ isConstant - did we already find a constsy? } +{ } +{ outputs: } +{ isForwardDeclared - is the field list component } +{ referenceing a forward struct/union? } +{ skipDeclarator - for enum,struct,union with no } +{ declarator } +{ typespec - type specifier } + +label 1,2; + +var + done: boolean; {for loop termination} + enumVal: integer; {default value for the next enum constant} + tPtr: typePtr; {for building types} + variable: identPtr; {enumeration variable} + + structPtr: identPtr; {structure identifier} + structTypePtr: typePtr; {structure type} + tKind: typeKind; {defining structure or union?} + + ttoken: tokenType; {temp variable for struct name} + lUseGlobalPool: boolean; {local copy of useGlobalPool} + globalStruct: boolean; {did we force global pool use?} + + + procedure FieldList (tp: typePtr; kind: typeKind); + + { handle a field list } + { } + { parameters } + { tp - place to store the type pointer } + + var + bitDisp: integer; {current bit disp} + disp: longint; {current byte disp} + done: boolean; {for loop termination} + fl,tfl,ufl: identPtr; {field list} + ldoingParameters: boolean; {local copy of doingParameters} + lisForwardDeclared: boolean; {local copy of isForwardDeclared} + lstorageClass: tokenEnum; {storage class of the declaration} + maxDisp: longint; {for determining union sizes} + variable: identPtr; {variable being defined} + + begin {FieldList} + ldoingParameters := doingParameters; {allow fields in K&R dec. area} + doingParameters := false; + lisForwardDeclared := isForwardDeclared; {stack this value} + lStorageClass := storageClass; {don't allow auto in a struct} + storageClass := ident; + bitDisp := 0; {start allocation from byte 0} + disp := 0; + maxDisp := 0; + fl := nil; {nothing in the field list, yet} + {check for no declarations} + if not (token.kind in [unsignedsy,signedsy,intsy,longsy,charsy,shortsy, + floatsy,doublesy,compsy,extendedsy,enumsy,structsy,unionsy,typedefsy, + typedef,voidsy,constsy,volatilesy]) then + Error(26); + {while there are entries in the field list...} + while token.kind in [unsignedsy,signedsy,intsy,longsy,charsy,shortsy,floatsy, + doublesy,compsy,extendedsy,enumsy,structsy,unionsy,typedefsy,typedef, + voidsy,constsy,volatilesy] do begin + typeSpec := wordPtr; {default type specifier is an integer} + TypeSpecifier(true,false); {get the type specifier} + if not skipDeclarator then + repeat {declare the variables...} + variable := nil; + if token.kind <> colonch then begin + Declarator(typeSpec, variable, fieldListSpace, false); + if variable <> nil then {enter the var in the field list} + begin + tfl := fl; {(check for dups)} + while tfl <> nil do begin + if tfl^.name^ = variable^.name^ then + Error(42); + tfl := tfl^.next; + end; {while} + variable^.next := fl; + fl := variable; + end; {if} + end; {if} + if token.kind = colonch then {handle a bit field} + begin + if kind = unionType then + Error(56); + NextToken; + Expression(arrayExpression,[commach,semicolonch]); + if (expressionValue >= maxBitField) or (expressionValue < 0) then + begin + Error(54); + expressionValue := maxBitField-1; + end; {if} + if (bitdisp+long(expressionValue).lsw > maxBitField) + or (long(expressionValue).lsw = 0) then begin + disp := disp+((bitDisp+7) div 8); + bitdisp := 0; + if long(expressionValue).lsw = 0 then + if variable <> nil then + Error(55); + end; {if} + if variable <> nil then begin + variable^.disp := disp; + variable^.bitdisp := bitdisp; + variable^.bitsize := long(expressionValue).lsw; + bitdisp := bitdisp+long(expressionValue).lsw; + end; {if} + end {if} + else if variable <> nil then begin + if bitdisp <> 0 then begin + disp := disp+((bitDisp+7) div 8); + bitdisp := 0; + end {if} + else if kind = unionType then + disp := 0; + variable^.disp := disp; + variable^.bitdisp := bitdisp; + variable^.bitsize := 0; + disp := disp + variable^.itype^.size; + if disp > maxDisp then + maxDisp := disp; + end; {if} + if token.kind = commach then {allow repeated declarations} + begin + NextToken; + done := false; + end {if} + else + done := true; + until done or (token.kind = eofsy); + Match(semicolonch,22); {insist on a closing ';'} + end; {while} + if fl <> nil then begin + ufl := nil; {reverse the field list} + while fl <> nil do begin + tfl := fl; + fl := fl^.next; + tfl^.next := ufl; + ufl := tfl; + end; {while} + if kind = structType then begin {return the field list} + if bitdisp <> 0 then + disp := disp+((bitDisp+7) div 8); + tp^.size := disp; + end {if} + else + tp^.size := maxDisp; + tp^.fieldList := ufl; + end; {if} + storageClass := lStorageClass; {restore default storage class} + isForwardDeclared := lisForwardDeclared; {restore the forward flag} + doingParameters := ldoingParameters; {restore the parameters flag} + end; {FieldList} + + + procedure CheckConst; + + { Check the token to see if it is a const or volatile } + + begin {CheckConst} + while token.kind in [constsy,volatilesy] do begin + if token.kind = constsy then + isConstant := true + else + volatile := true; + NextToken; + end; {while} + end; {CheckConst} + + +begin {TypeSpecifier} +isForwardDeclared := false; {not doing a forward reference (yet)} +skipDeclarator := false; {declarations are required (so far)} +CheckConst; +case token.kind of + unsignedsy: begin {unsigned} + NextToken; + CheckConst; + if token.kind = shortsy then begin + NextToken; + CheckConst; + if token.kind = intsy then begin + NextToken; + CheckConst; + end; {if} + typeSpec := uWordPtr; + end {if} + else if token.kind = longsy then begin + NextToken; + CheckConst; + if token.kind = intsy then begin + NextToken; + CheckConst; + end; {if} + typeSpec := uLongPtr; + end {else if} + else if token.kind = charsy then begin + NextToken; + CheckConst; + typeSpec := uBytePtr; + end {else if} + else if token.kind = intsy then begin + NextToken; + CheckConst; + if unix_1 then + typeSpec := uLongPtr + else + typeSpec := uWordPtr; + end {else if} + else begin + CheckConst; + if unix_1 then + typeSpec := uLongPtr + else + typeSpec := uWordPtr; + end; {else if} + end; + + signedsy: begin {signed} + NextToken; + CheckConst; + if token.kind = shortsy then begin + NextToken; + CheckConst; + if token.kind = intsy then begin + NextToken; + CheckConst; + end; {if} + typeSpec := wordPtr; + end {if} + else if token.kind = longsy then begin + NextToken; + CheckConst; + if token.kind = intsy then begin + NextToken; + CheckConst; + end; {if} + typeSpec := longPtr; + end {else if} + else if token.kind = intsy then begin + NextToken; + CheckConst; + if unix_1 then + typeSpec := longPtr + else + typeSpec := wordPtr; + end {else if} + else if token.kind = charsy then begin + NextToken; + CheckConst; + typeSpec := bytePtr; + end; {else if} + end; + + intsy: begin {int} + NextToken; + CheckConst; + if unix_1 then + typeSpec := longPtr + else + typeSpec := wordPtr; + end; + + longsy: begin {long} + NextToken; + CheckConst; + typeSpec := longPtr; + if token.kind in [intsy,floatsy] then begin + if token.kind = floatsy then + typeSpec := doublePtr; + NextToken; + CheckConst; + end {if} + else if token.kind = doublesy then begin + typeSpec := extendedPtr; + NextToken; + CheckConst; + end; {else if} + end; + + charsy: begin {char} + NextToken; + CheckConst; + typeSpec := uBytePtr; + end; + + shortsy: begin {short} + NextToken; + CheckConst; + if token.kind = intsy then begin + NextToken; + CheckConst; + end; {if} + typeSpec := wordPtr; + end; + + floatsy: begin {float} + NextToken; + CheckConst; + typeSpec := realPtr; + end; + + doublesy: begin {double} + NextToken; + CheckConst; + typeSpec := doublePtr; + end; + + compsy: begin {comp} + NextToken; + CheckConst; + typeSpec := compPtr; + end; + + extendedsy: begin {extended} + NextToken; + CheckConst; + typeSpec := extendedPtr; + end; + + voidsy: begin {void} + NextToken; + CheckConst; + typeSpec := voidPtr; + end; + + enumsy: begin {enum} + NextToken; {skip the 'enum' token} + if token.kind = ident then begin {handle a type definition} + variable := FindSymbol(token, tagSpace, true, true); + ttoken := token; + NextToken; + if variable <> nil then + if variable^.itype^.kind = enumType then + if token.kind <> lbracech then + goto 1; + tPtr := pointer(Malloc(sizeof(typeRecord))); + tPtr^.size := cgWordSize; + tPtr^.saveDisp := 0; + tPtr^.isConstant := false; + tPtr^.kind := enumType; + variable := + NewSymbol(ttoken.name, tPtr, storageClass, tagSpace, defined); + CheckConst; + end {if} + else if token.kind <> lbracech then + Error(9); + enumVal := 0; {set the default value} + if token.kind = lbracech then begin + NextToken; {skip the '{'} + repeat {declare the enum constants} + tPtr := pointer(Malloc(sizeof(typeRecord))); + tPtr^.size := cgWordSize; + tPtr^.saveDisp := 0; + tPtr^.isConstant := false; + tPtr^.kind := enumConst; + if token.kind = ident then begin + variable := + NewSymbol(token.name, tPtr, ident, variableSpace, defined); + NextToken; + end {if} + else + Error(9); + if token.kind = eqch then begin {handle explicit enumeration values} + NextToken; + Expression(arrayExpression,[commach,rbracech]); + enumVal := long(expressionValue).lsw; + if enumVal <> expressionValue then + Error(6); + end; {if} + tPtr^.eval := enumVal; {set the enumeration constant value} + enumVal := enumVal+1; {inc the default enumeration value} + if token.kind = commach then {next enumeration...} + begin + done := false; + NextToken; + end {if} + else + done := true; + until done or (token.kind = eofsy); + if token.kind = rbracech then + NextToken + else begin + Error(23); + SkipStatement; + end; {else} + end; {if} +1: skipDeclarator := token.kind = semicolonch; + end; + + structsy, {struct} + unionsy: begin {union} + globalStruct := false; {we didn't make it global} + if token.kind = structsy then {set the type kind to use} + tKind := structType + else + tKind := unionType; + structPtr := nil; {no record, yet} + structTypePtr := defaultStruct; {use int as a default type} + NextToken; {skip 'struct' or 'union'} + if token.kind in [ident,typedef] {if there is a struct name then...} + then begin + {look up the name} + structPtr := FindSymbol(token, tagSpace, true, true); + ttoken := token; {record the structure name} + NextToken; {skip the structure name} + if structPtr = nil then begin {if the name hasn't been defined then...} + if token.kind <> lbracech then + structPtr := FindSymbol(ttoken, tagSpace, false, true); + if structPtr <> nil then + structTypePtr := structPtr^.itype + else begin + isForwardDeclared := true; + globalStruct := doingParameters and (token.kind <> lbracech); + if globalStruct then begin + lUseGlobalPool := useGlobalPool; + useGlobalPool := true; + end; {if} + structTypePtr := pointer(Calloc(sizeof(typeRecord))); + {structTypePtr^.size := 0;} + {structTypePtr^.saveDisp := 0;} + {structTypePtr^.isConstant := false;} + structTypePtr^.kind := tkind; + {structTypePtr^.fieldList := nil;} + {structTypePtr^.sName := nil;} + structPtr := NewSymbol(ttoken.name, structTypePtr, ident, + tagSpace, defined); + structTypePtr^.sName := structPtr^.name; + end; + end {if} + {the name has been defined, so...} + else if structPtr^.itype^.kind <> tKind then begin + Error(42); {it's an error if it's not a struct} + structPtr := nil; + end {else} + else begin {record the existing structure type} + structTypePtr := structPtr^.itype; + CheckConst; + end; {else} + end {if} + else if token.kind <> lbracech then + Error(9); {its an error if there's no name or struct} +2: if token.kind = lbracech then {handle a structure definition...} + begin {error if we already have one!} + if (structTypePtr <> defaultStruct) + and (structTypePtr^.fieldList <> nil) then begin + Error(53); + structPtr := nil; + end; {if} + NextToken; {skip the '{'} + if structTypePtr = defaultStruct then begin + structTypePtr := pointer(Calloc(sizeof(typeRecord))); + {structTypePtr^.size := 0;} + {structTypePtr^.saveDisp := 0;} + {structTypePtr^.isConstant := false;} + structTypePtr^.kind := tkind; + {structTypePtr^.fieldList := nil;} + {structTypePtr^.sName := nil;} + end; {if} + if structPtr <> nil then + structPtr^.itype := structTypePtr; + FieldList(structTypePtr,tKind); {define the fields} + if token.kind = rbracech then {insist on a closing rbrace} + NextToken + else begin + Error(23); + SkipStatement; + end; {else} + end; {if} + if globalStruct then + useGlobalPool := lUseGlobalPool; + typeSpec := structTypePtr; + skipDeclarator := token.kind = semicolonch; + end; + + typedef: begin {named type definition} + typeSpec := token.symbolPtr^.itype; + NextToken; + end; + + otherwise: ; + end; {case} + +if isconstant then begin {handle a constant type} + new(tPtr); + if typeSpec^.kind in [structType,unionType] then begin + with tPtr^ do begin + size := typeSpec^.size; + kind := definedType; + dType := typeSpec; + end; {with} + end {if} + else + tPtr^ := typeSpec^; + tPtr^.isConstant := true; + typeSpec := tPtr; + end; {if} +end; {TypeSpecifier} + + +{-- Externally available subroutines ---------------------------} + +procedure DoDeclaration {doingPrototypes: boolean}; + +{ process a variable or function declaration } +{ } +{ parameters: } +{ doingPrototypes - are we processing a parameter list? } + +label 1,2,3; + +var + done: boolean; {for loop termination} + foundConstsy: boolean; {did we find a constsy?} + fName: stringPtr; {for forming uppercase names} + i: integer; {loop variable} + isAsm: boolean; {has the asm modifier been used?} + lDoingParameters: boolean; {local copy of doingParameters} + lisPascal: boolean; {local copy of isPascal} + lp,tlp,tlp2: identPtr; {for tracing parameter list} + ltypeSpec: typePtr; {copy of type specifier} + lUseGlobalPool: boolean; {local copy of useGlobalPool} + nextPdisp: integer; {for calculating parameter disps} + noFDefinitions: boolean; {are function definitions inhibited?} + p1,p2,p3: parameterPtr; {for reversing prototyped parameters} + variable: identPtr; {pointer to the variable being declared} + fnType: typePtr; {function type} + segType: integer; {segment type} + tp: typePtr; {for tracing type lists} + tk: tokenType; {work token} + typeFound: boolean; {has some type specifier been found?} + + + procedure CheckArray (v: identPtr; firstVariable: boolean); + + { make sure all required array sizes are specified } + { } + { parameters: } + { v - pointer to the identifier to check } + { firstVariable - can the first array subscript be of a } + { non-fixed size? } + + label 1; + + var + tp: typePtr; {work pointer} + + begin {CheckArray} + if v <> nil then begin {skip check if there's no variable} + tp := v^.itype; {initialize the type pointer} + while tp <> nil do begin {check all types} + if tp^.kind = arrayType then {if it's an array with an unspecified } + if tp^.elements = 0 then { size and an unspecified size is not } + if not firstVariable then { allowed here, flag an error. } + begin + Error(49); + goto 1; + end; {if} + firstVariable := false; {unspecified sizes are only allowed in } + { the first subscript } + case tp^.kind of {next type...} + arrayType: + tp := tp^.aType; + pointerType: begin + tp := tp^.pType; + firstVariable := true; {(also allowed for pointers to arrays)} + end; + functionType: + tp := tp^.fType; + otherwise: + tp := nil; + end; {case} + end; {while} + end; {if} +1: + end; {CheckArray} + + + procedure SegmentStatement; + + { compile a segment statement } + { } + { statement syntax: } + { } + { 'segment' string-constant [',' 'dynamic'] } + + var + i: integer; {loop variable} + len: integer; {segment name length} + + begin {SegmentStatement} + NextToken; + if token.kind = stringConst then begin + for i := 1 to 10 do begin + defaultSegment[i] := chr(0); + currentSegment[i] := chr(0); + end; {for} + len := token.sval^.length; + if len > 10 then + len := 10; + for i := 1 to len do + defaultSegment[i] := token.sval^.str[i]; + for i := 1 to len do + currentSegment[i] := token.sval^.str[i]; + FlagPragmas(p_segment); + NextToken; + if token.kind = commach then begin + NextToken; + if token.kind = ident then begin + if token.name^ = 'dynamic' then + segmentKind := $8000 + else Error(84); + NextToken; + end {if} + else Error(84); + end {if} + else + segmentKind := 0; + Match(semicolonch,22); + end {if} + else begin + Error(83); + SkipStatement; + end; {else} + end; {SegmentStatement} + + + function InPartialList (fName: stringPtr): boolean; + + { See if the function is in the partial compile list. } + { } + { If the function is in the list, the function name is } + { removed from the list, and true is returned. If not, } + { false is returned. } + { } + { parameters: } + { fName - name of the function to check for } + + label 1,2; + + var + ch: char; {work character} + i,j: integer; {loop variable} + len: integer; {length of fName} + + begin {InPartialList} + i := partialFileGS.theString.size; {strip trailing blanks} + while (i > 0) and (partialFileGS.theString.theString[i] = ' ') do begin + partialFileGS.theString.theString[i] := chr(0); + i := i-1; + end; {while} + while partialFileGS.theString.theString[1] = ' ' do {skip leading blanks} + for i := 1 to partialFileGS.theString.size do + partialFileGS.theString.theString[i] := + partialFileGS.theString.theString[i+1]; + InPartialList := true; {assume success} + i := 1; {scan the name list} + len := length(fName^); + while partialFileGS.theString.theString[i] <> chr(0) do begin + for j := 1 to len do begin + if partialFileGS.theString.theString[i+j-1] <> fName^[j] then + goto 1; + end; {for} + if partialFileGS.theString.theString[i+len] in [' ', chr(0)] then begin + + {found a match - remove from list & return} + j := i+len; + while partialFileGS.theString.theString[j] = ' ' do + j := j+1; + repeat + ch := partialFileGS.theString.theString[j]; + partialFileGS.theString.theString[i] := ch; + i := i+1; + j := j+1; + until ch = chr(0); + goto 2; + end; {if} +1: {no match - skip to next name} + while not (partialFileGS.theString.theString[i] in [chr(0), ' ']) do + i := i+1; + while partialFileGS.theString.theString[i] = ' ' do + i := i+1; + end; {while} + InPartialList := false; {no match found} +2: + end; {InPartialList} + + + procedure SkipFunction (isAsm: boolean); + + { Skip a function body for a partial compile } + { } + { Parameters: } + { isAsm - are we compiling an asm function? } + + var + braceCount: integer; {# of unmatched { chars} + doingAsm: boolean; {compiling an asm statement?} + + begin {SkipFunction} + Match(lbracech,27); {skip to the closing rbrackch} + braceCount := 1; + doingAsm := false; + if isAsm then + charKinds[ord('#')] := ch_pound; + while (not (token.kind = eofsy)) and (braceCount <> 0) do begin + if token.kind = asmsy then begin + doingAsm := true; + charKinds[ord('#')] := ch_pound; + end {if} + else if token.kind = lbracech then + braceCount := braceCount+1 + else if token.kind = rbracech then begin + braceCount := braceCount-1; + if doingAsm then begin + doingAsm := false; + charKinds[ord('#')] := illegal; + end; {if} + end; {else if} + NextToken; + end; {while} + nameFound := false; {no pc_nam for the next function (yet)} + doingFunction := false; {no longer doing a function} + charKinds[ord('#')] := illegal; {# is a preprocessor command} + end; {SkipFunction} + + +begin {DoDeclaration} +lDoingParameters := doingParameters; {record the status} +noFDefinitions := false; {are function definitions inhibited?} +typeFound := false; {no explicit type found, yet} +foundConstsy := false; {did not find a constsy} +if doingPrototypes then {prototypes implies a parm list} + doingParameters := true +else + lastParameter := nil; {init parm list if we're not doing prototypes} +isFunction := false; {assume it's not a function} +if not doingFunction then {handle any segment statements} + while token.kind = segmentsy do + SegmentStatement; +inhibitHeader := true; {block imbedded includes in headers} +if token.kind in [constsy,volatilesy] {handle leading constsy, volatile} + then begin + while token.kind in [constsy,volatilesy] do begin + if token.kind = constsy then + foundConstsy := true + else + volatile := true; + NextToken; + end; {while} + end; {if} +storageClass := ident; {handle a StorageClassSpecifier} +lUseGlobalPool := useGlobalPool; +if token.kind in [autosy,externsy,registersy,staticsy,typedefsy] then begin + typeFound := true; + storageClass := token.kind; + if not doingFunction then + if token.kind = autosy then + Error(62); + if doingParameters then begin + if token.kind <> registersy then + Error(87); + end {if} + else if storageClass in [staticsy,typedefsy] then + useGlobalPool := true; + NextToken; + end; {if} +isAsm := false; +isPascal := false; +while token.kind in [pascalsy,asmsy] do begin + if token.kind = pascalsy then + isPascal := true + else + isAsm := true; + NextToken; + end; {while} +lisPascal := isPascal; +typeSpec := wordPtr; {default type specifier is an integer} +if token.kind in {handle a TypeSpecifier/declarator} + [unsignedsy,signedsy,intsy,longsy,charsy,shortsy,floatsy,doublesy,compsy, + extendedsy,voidsy,enumsy,structsy,unionsy,typedef,volatilesy,constsy] then + begin + typeFound := true; + TypeSpecifier(false,foundConstsy); + if not skipDeclarator then begin + variable := nil; + Declarator(typeSpec, variable, variableSpace, doingPrototypes); + if variable = nil then begin + inhibitHeader := false; + if token.kind = semicolonch then + NextToken + else begin + Error(22); + SkipStatement; + end; {else} + goto 1; + end; {if} + end; {if} + end {if} +else begin + variable := nil; + Declarator (typeSpec, variable, variableSpace, doingPrototypes); + if variable = nil then begin + inhibitHeader := false; + if token.kind = semicolonch then + NextToken + else begin + Error(22); + SkipStatement; + end; {else} + goto 1; + end; {if} + end; +isPascal := lisPascal; + +{make sure variables have some type info} +if isFunction then begin + if not typeFound then + if (lint & lintNoFnType) <> 0 then + Error(104); + end {if} +else + if not typeFound then + Error(26); + +3: +{handle a function declaration} +if isFunction then begin + + if doingParameters then {a function cannot be a parameter} + Error(28); + fnType := variable^.itype; {get the type of the function} + while (fnType <> nil) and (fnType^.kind <> functionType) do + case fnType^.kind of + arrayType : fnType := fnType^.aType; + pointerType: fnType := fnType^.pType; + definedType: fnType := fnType^.dType; + otherwise : fnType := nil; + end; {case} + if fnType = nil then begin + SkipStatement; + goto 1; + end; {if} + if isPascal then begin {reverse prototyped parameters} + p1 := fnType^.parameterList; + if p1 <> nil then begin + p2 := nil; + while p1 <> nil do begin + p3 := p1; + p1 := p1^.next; + p3^.next := p2; + p2 := p3; + end; {while} + fnType^.parameterList := p2; + end; {if} + end; {if} + + {handle functions in the parameter list} + if doingPrototypes then + PopTable + + {external or forward declaration} + else if (storageClass = externsy) + or (token.kind in [commach,semicolonch,inlinesy]) then begin + fnType^.isPascal := isPascal; {note if we have pascal parms} + if token.kind = inlinesy then {handle tool declarations} + with fnType^ do begin + NextToken; + Match(lparench,13); + if token.kind in [intconst,uintconst] then begin + toolNum := token.ival; + NextToken; + end {if} + else + Error(18); + Match(commach,86); + if token.kind in [longconst,ulongconst] then begin + dispatcher := token.lval; + NextToken; + end {if} + else if token.kind in [intconst,uintconst] then begin + dispatcher := token.ival; + NextToken; + end {if} + else + Error(18); + Match(rparench,12); + end; {with} + doingParameters := doingPrototypes; {not doing parms any more} + if token.kind = semicolonch then begin + inhibitHeader := false; + NextToken; {skip the trailing semicolon} + end {if} + else if (token.kind = commach) and (not doingPrototypes) then begin + PopTable; {pop the symbol table} + NextToken; {allow further declarations} + variable := nil; + isFunction := false; + Declarator (typeSpec, variable, variableSpace, doingPrototypes); + if variable = nil then begin + inhibitHeader := false; + if token.kind = semicolonch then + NextToken + else begin + Error(22); + SkipStatement; + end; {else} + goto 1; + end; {if} + goto 3; + end {else if} + else begin + Error(22); + SkipStatement; + end; {else} + PopTable; {pop the symbol table} + end {if} + + {cannot imbed functions...} + else if doingFunction then begin + isPascal := false; + Error(28); + while token.kind <> eofsy do + NextToken; + end {if} + + {local declaration} + else begin + if noFDefinitions then + Error(22); + ftype := fnType^.ftype; {record the type of the function} + while fType^.kind = definedType do + fType := fType^.dType; + variable^.state := defined; {note that the function is defined} + pfunc := variable; {set the identifier for parm checks} + fnType^.isPascal := isPascal; {note if we have pascal parms} + doingFunction := true; {read the parameter list} + doingParameters := true; + {declare the parameters} + lp := lastParameter; {(save now; it's volatile)} + while not (token.kind in [lbracech,eofsy]) do + if (token.kind in [autosy,externsy,registersy,staticsy,typedefsy, + unsignedsy,signedsy,intsy,longsy,charsy,shortsy, + floatsy,doublesy,compsy,extendedsy,enumsy, + structsy,unionsy,typedef,voidsy,volatilesy, + constsy,ident]) then + DoDeclaration(false) + else begin + Error(27); + NextToken; + end; {else} + if numberOfParameters <> 0 then {default K&R parm type is int} + begin + tlp := lp; + while tlp <> nil do begin + if tlp^.itype = nil then + tlp^.itype := wordPtr; + tlp := tlp^.pnext; + end; {while} + end; {if} + tlp := lp; {make sure all parameters have an} + while tlp <> nil do { identifier } + if tlp^.name^ = '?' then begin + Error(113); + tlp := nil; + end {if} + else + tlp := tlp^.pnext; + doingParameters := false; + fName := variable^.name; {skip if this is not needed for a } + if doingPartial then { partial compile } + if not InPartialList(fName) then begin + SkipFunction(isAsm); + goto 2; + end; {if} + TermHeader; {make sure the header file is closed} + if progress then {write progress information} + writeln('Compiling ', fName^); + useGlobalPool := false; {start a local label pool} + if not codegenStarted and (liDCBGS.kFlag <> 0) then begin {init the code generator (if it needs it)} + CodeGenInit (outFileGS, liDCBGS.kFlag, doingPartial); + liDCBGS.kFlag := 3; + codegenStarted := true; + end; {if} + foundFunction := true; {got one...} + segType := ord(variable^.class = staticsy) * $4000; + if fnType^.isPascal then begin + fName := pointer(Malloc(length(variable^.name^)+1)); + CopyString(pointer(fName), pointer(variable^.name)); + for i := 1 to length(fName^) do + if fName^[i] in ['a'..'z'] then + fName^[i] := chr(ord(fName^[i]) & $5F); + Gen2Name (dc_str, segType, 0, fName); + end {if} + else + Gen2Name (dc_str, segType, 0, variable^.name); + doingMain := variable^.name^ = 'main'; + firstCompoundStatement := true; + Gen0 (dc_pin); + if not isAsm then + Gen0(pc_ent); + nextLocalLabel := 1; {initialize GetLocalLabel} + returnLabel := GenLabel; {set up an exit point} + tempList := nil; {initialize the work label list} + if not isAsm then {generate traceback, profile code} + if traceBack or profileFlag then begin + if traceBack then + nameFound := true; + GenPS(pc_nam, variable^.name); + end; {if} + nextPdisp := 0; {assign displacements to the parameters} + if not fnType^.isPascal then begin + tlp := lp; + lp := nil; + while tlp <> nil do begin + tlp2 := tlp; + tlp := tlp^.pnext; + tlp2^.pnext := lp; + lp := tlp2; + end; {while} + end; {if} + while lp <> nil do begin + lp^.pdisp := nextPdisp; + if lp^.itype^.kind = arrayType then + nextPdisp := nextPdisp + cgPointerSize + else begin + if lp^.itype^.kind = scalarType then + if lp^.itype^.baseType in [cgReal,cgDouble,cgComp] then + {all floating-points are passed as extended} + lp^.itype := extendedPtr; + nextPdisp := nextPdisp + long(lp^.itype^.size).lsw; + if (long(lp^.itype^.size).lsw = 1) + and (lp^.itype^.kind = scalarType) then + nextPdisp := nextPdisp+1; + end; {else} + lp := lp^.pnext; + end; {while} + gotoList := nil; {initialize the label list} + {set up struct/union area} + if variable^.itype^.ftype^.kind in [structType,unionType] then begin + lp := NewSymbol(@'@struct', variable^.itype^.ftype, staticsy, + variablespace, declared); + tk.kind := ident; + tk.class := identifier; + tk.name := @'@struct'; + tk.symbolPtr := nil; + lp := FindSymbol(tk, variableSpace, false, true); + Gen1Name(pc_lao, 0, lp^.name); + Gen2t(pc_str, 0, 0, cgULong); + end; {if} + if isAsm then begin + AsmFunction(variable); {handle assembly language functions} + PopTable; + end {if} + else begin + {generate parameter labels} + if fnType^.overrideKR then + GenParameters(nil) + else + GenParameters(fnType^.parameterList); + CompoundStatement(false); {process the statements} + end; {else} + end; {else} +2: ; + end {if} + +{handle a variable declaration} +else {if not isFunction then} begin + noFDefinitions := true; + if not SkipDeclarator then + repeat + if isPascal then begin + tp := variable^.itype; + while tp <> nil do + case tp^.kind of + scalarType, + enumType, + enumConst, + definedType, + structType, + unionType: begin tp := nil; Error(94); end; + arrayType: tp := tp^.atype; + pointerType: tp := tp^.pType; + functionType: begin tp^.isPascal := true; tp := nil; end; + end; {case} + end; {if} + if token.kind = eqch then begin + if storageClass = typedefsy then + Error(52); + if doingPrototypes then + Error(88); + NextToken; {handle an initializer} + ltypeSpec := typeSpec; + Initializer(variable); + typeSpec := ltypeSpec; + end; {if} + {check to insure array sizes are specified} + if storageClass <> typedefsy then + CheckArray(variable, (storageClass = externsy) or doingParameters); + {allocate space} + if variable^.storage = stackFrame then begin + variable^.lln := GetLocalLabel; + Gen2(dc_loc, variable^.lln, long(variable^.itype^.size).lsw); + end; {if} + if (token.kind = commach) and (not doingPrototypes) then begin + done := false; {allow multiple variables on one line} + NextToken; + variable := nil; + Declarator(typeSpec, variable, variableSpace, doingPrototypes); + if variable = nil then begin + if token.kind = semicolonch then + NextToken + else begin + Error(22); + SkipStatement; + end; {else} + goto 1; + end; {if} + goto 3; + end {if} + else + done := true; + until done or (token.kind = eofsy); + if doingPrototypes then begin + protoVariable := variable; {make the var available to Declarator} + if protoVariable = nil then + protoType := typeSpec + else + protoType := protoVariable^.iType; + end {if} + else begin + inhibitHeader := false; + if token.kind = semicolonch then {must end with a semicolon} + NextToken + else begin + Error(22); + SkipStatement; + end; {else} + end; {else} + end; {else} +1: +doingParameters := lDoingParameters; {restore the status} +useGlobalPool := lUseGlobalPool; +inhibitHeader := false; +end; {DoDeclaration} + + +procedure DoStatement; + +{ process a statement from a function } + + + procedure AutoInit; + + { initialize auto variables } + + var + count: integer; {initializer counter} + ip: identPtr; {pointer to a symbol table entry} + lp1,lp2: identList; {used to reverse, track the list} + iPtr: initializerPtr; {pointer to the next initializer} + + + procedure Initialize (id: identPtr; disp: longint; itype: typePtr); + + { initialize a variable } + { } + { parameters: } + { id - pointer to the identifier } + { disp - disp past the identifier to initialize } + { itype - type of the variable to initialize } + { } + { variables: } + { count - number of times to re-use the initializer } + { ip - pointer to the initializer record to use } + + label 1; + + var + elements: longint; {# array elements} + fp: identPtr; {for tracing field lists} + size: integer; {fill size} + union: boolean; {are we doing a union?} + + {bit field manipulation} + {----------------------} + bitcount: integer; {# if bits so far} + bitsize,bitdisp: integer; {defines size, location of a bit field} + + {assignment conversion} + {---------------------} + tree: tokenPtr; {expression tree} + val: longint; {constant expression value} + isConstant: boolean; {is the expression a constant?} + + + procedure LoadAddress; + + { Load the address of the operand } + + begin {LoadAddress} + with id^ do {load the base address} + case storage of + stackFrame: Gen2(pc_lda, lln, 0); + parameter: if itype^.kind = arrayType then + Gen2t(pc_lod, pln, 0, cgULong) + else + Gen2(pc_lda, pln, 0); + external, + global, + private: Gen1Name(pc_lao, 0, name); + otherwise: ; + end; {case} + if disp <> 0 then + Gen1t(pc_inc, long(disp).lsw, cgULong) + end; {LoadAddress} + + + function ZeroFill (elements: longint; itype: typePtr; + count: integer; iPtr: initializerPtr): boolean; + + { See if an array can be zero filled } + { } + { parameters: } + { elements - elements in the array } + { itype - type of each array element } + { count - remaining initializer repititions } + { iPtr - initializer record } + + begin {ZeroFill} + ZeroFill := false; + if not iPtr^.isConstant then + if itype^.kind in [scalarType,enumType] then + if count >= elements then + with iPtr^.itree^ do + if token.kind = intconst then + if token.ival = 0 then + ZeroFill := true; + end; {ZeroFill} + + + begin {Initialize} + case itype^.kind of + + scalarType,pointerType,enumType,functionType: begin + LoadAddress; {load the destination address} + doDispose := count = 1; {generate the expression value} + tree := iptr^.itree; {see if this is a constant} + {do assignment conversions} + while tree^.token.kind = castoper do + tree := tree^.left; + isConstant := tree^.token.class in [intConstant,longConstant]; + if isConstant then + if tree^.token.class = intConstant then + val := tree^.token.ival + else + val := tree^.token.lval; + +{ if isConstant then + if tree^.token.class = intConstant then + Writeln('loc 2: bitsize = ', iPtr^.bitsize:1, '; ival = ', tree^.token.ival:1) {debug} +{ else + Writeln('loc 2: bitsize = ', iPtr^.bitsize:1, '; lval = ', tree^.token.lval:1) {debug} +{ else + Writeln('loc 2: bitsize = ', iPtr^.bitsize:1); {debug} + + GenerateCode(iptr^.iTree); + AssignmentConversion(itype, expressionType, isConstant, val, true, + false); + case itype^.kind of {save the value} + scalarType: + if iptr^.bitsize <> 0 then + Gen2t(pc_sbf, iptr^.bitdisp, iptr^.bitsize, itype^.basetype) + else + Gen0t(pc_sto, itype^.baseType); + enumType: + Gen0t(pc_sto, cgWord); + pointerType,functionType: + Gen0t(pc_sto, cgULong); + end; {case} + end; + + arrayType: begin + if itype^.aType^.kind = scalarType then + if itype^.aType^.baseType in [cgByte,cgUByte] then + if iPtr^.iTree^.token.kind = stringConst then begin + GenLdcLong(itype^.elements); + Gen0t(pc_stk, cgULong); + GenS(pc_lca, iPtr^.iTree^.token.sval); + Gen0t(pc_stk, cgULong); + Gen0t(pc_bno, cgULong); + LoadAddress; + Gen0t(pc_stk, cgULong); + Gen0t(pc_bno, cgULong); + Gen1tName(pc_cup, 0, cgVoid, @'strncpy'); + iPtr := iPtr^.next; + goto 1; + end; {if} + elements := itype^.elements; + itype := itype^.atype; + if ZeroFill(elements, itype, count, iPtr) then begin + if itype^.kind = enumType then + size := cgWordSize + else + size := TypeSize(itype^.baseType); + size := size * long(elements).lsw; + LoadAddress; + Gen0t(pc_stk, cgULong); + Gen1t(pc_ldc, size, cgWord); + Gen0t(pc_stk, cgWord); + Gen0t(pc_bno, cgULong); + Gen1tName(pc_cup, 0, cgVoid, @'~ZERO'); + disp := disp + size; + count := count - long(elements).lsw; + if count = 0 then begin + iPtr := iPtr^.next; + count := iPtr^.count; + end; {if} + end {if} + else begin + while elements <> 0 do begin + Initialize(id, disp, itype); + if itype^.kind in [scalarType,pointerType,enumType] then begin + count := count-1; + if count = 0 then begin + iPtr := iPtr^.next; + count := iPtr^.count; + end; {if} + end; {if} + disp := disp+itype^.size; + elements := elements-1; + end; {while} + end; {else} +1: end; + + structType,unionType: begin + if iPtr^.isStruct then begin + LoadAddress; {load the destination address} + GenerateCode(iptr^.iTree); {load the stuct address} + {do the assignment} + AssignmentConversion(itype, expressionType, isConstant, val, + true, false); + with expressionType^ do + Gen2(pc_mov, long(size).msw, long(size).lsw); + Gen0t(pc_pop, UsualUnaryConversions); + end {if} + else begin + union := itype^.kind = unionType; + fp := itype^.fieldList; + bitsize := iPtr^.bitsize; + bitdisp := iPtr^.bitdisp; + bitcount := 0; + while fp <> nil do begin + itype := fp^.itype; +{ writeln('Initialize: disp = ', disp:3, '; fp^. Disp = ', fp^.disp:3, 'itype^.size = ', itype^.size:1); {debug} +{ writeln(' bitDisp = ', bitDisp:3, '; fp^.bitDisp = ', fp^.bitDisp:3); {debug} +{ writeln(' bitSize = ', bitSize:3, '; fp^.bitSize = ', fp^.bitSize:3); {debug} + Initialize(id, disp, itype); + if bitsize = 0 then begin + if bitcount <> 0 then begin + disp := disp + (bitcount+7) div 8; + bitcount := 0; + end {if} + else if fp^.bitSize <> 0 then begin + bitcount := 8; + while (fp <> nil) and (bitcount > 0) do begin + bitcount := bitcount - fp^.bitSize; + if bitcount > 0 then + if fp^.next <> nil then + if fp^.next^.bitSize <> 0 then + fp := fp^.next + else + bitcount := 0; + end; {while} + bitcount := 0; + disp := disp + 1; + end {else if} + else + disp := disp + itype^.size; + end {if} + else if fp^.bitSize = 0 then begin + bitsize := 0; + disp := disp + itype^.size; + end {else if} + else begin + if bitsize + bitdisp < bitcount then + disp := disp + (bitcount + 7) div 8; + bitcount := bitsize + bitdisp; + end; {else} + if itype^.kind in [scalarType,pointerType,enumType] then begin + count := count-1; + if count = 0 then begin + iPtr := iPtr^.next; + count := iPtr^.count; + bitsize := iPtr^.bitsize; + bitdisp := iPtr^.bitdisp; + end; {if} + end; {if} + if union then + fp := nil + else + fp := fp^.next; + end; {while} + end; {else} + end; + + otherwise: Error(57); + end; {case} + end; {Initialize} + + + begin {AutoInit} + lp1 := nil; {reverse the list} + while initializerList <> nil do begin + lp2 := initializerList; + initializerList := lp2^.next; + lp2^.next := lp1; + lp1 := lp2; + end; {while} + while lp1 <> nil do begin {initialize the variables} + ip := lp1^.id; + iPtr := ip^.iPtr; + count := iPtr^.count; + if ip^.class <> staticsy then + Initialize(ip, 0, ip^.itype); + lp2 := lp1; + lp1 := lp1^.next; + dispose(lp2); + end; {while} + end; {AutoInit} + + +begin {DoStatement} +case statementList^.kind of + + compoundSt: begin + if token.kind = rbracech then begin + if statementList^.doingDeclaration then + if initializerList <> nil then + AutoInit; + EndCompoundStatement; + end {if} + else if (statementList^.doingDeclaration = true) + and (token.kind in [autosy,externsy,registersy,staticsy,typedefsy, + unsignedsy,signedsy,intsy,longsy,charsy,shortsy, + floatsy,doublesy,compsy,extendedsy,enumsy, + structsy,unionsy,typedef,voidsy,volatilesy, + constsy]) + then + DoDeclaration(false) + else begin + if statementList^.doingDeclaration then begin + statementList^.doingDeclaration := false; + if firstCompoundStatement then begin + Gen1Name(dc_sym, ord(doingMain), pointer(table)); + firstCompoundStatement := false; + end; {if} + if initializerList <> nil then + AutoInit; + end; {if} + Statement; + end; {else} + end; + + ifSt: + EndIfStatement; + + elseSt: + EndElseStatement; + + doSt: + EndDoStatement; + + whileSt: + EndWhileStatement; + + forSt: + EndForStatement; + + switchSt: + EndSwitchStatement; + + otherwise: Error(57); + end; {case} +end; {DoStatement} + + +procedure InitParser; + +{ Initialize the parser } + +begin {InitParser} +doingFunction := false; {not doing a function (yet)} +doingParameters := false; {not processing parameters} +lastLine := 0; {no pc_lnm generated yet} +nameFound := false; {no pc_nam generated yet} +statementList := nil; {no open statements} +codegenStarted := false; {code generator is not started} +end; {InitParser} + + +procedure TermParser; + +{ shut down the parser } + +begin {TermParser} +if statementList <> nil then + case statementList^.kind of + compoundSt : Error(34); + doSt : Error(33); + elseSt : Error(67); + forSt : Error(69); + ifSt : Error(32); + switchSt : Error(70); + whileSt : Error(68); + otherwise: Error(57); + end; {case} +end; {TermParser} + +end. diff --git a/Scanner.asm b/Scanner.asm old mode 100755 new mode 100644 index 4ad3c07..46515c5 --- a/Scanner.asm +++ b/Scanner.asm @@ -1 +1,647 @@ - mcopy scanner.macros **************************************************************** * * Convertsl - Convert a string to a long integer * * Inputs: * str - pointer to the string * * Outputs: * Returns the value. * * Notes: * Assumes the string is valid. * **************************************************************** * Convertsl start val equ 0 return value subroutine (4:str),4 stz val initialize the number to zero stz val+2 lda [str] set X to the number of characters and #$00FF tax ldy #1 Y is the disp into the string lb1 asl val val := val*10 rol val+2 ph2 val+2 lda val asl val rol val+2 asl val rol val+2 adc val sta val pla adc val+2 sta val+2 lda [str],Y add in the new digit and #$000F adc val sta val bcc lb2 inc val+2 lb2 iny next character dex bne lb1 return 4:val end **************************************************************** * * KeyPress - Has a key been presed? * * If a key has not been pressed, this function returns * false. If a key has been pressed, it clears the key * strobe. If the key was an open-apple ., a terminal exit * is performed; otherwise, the function returns true. * **************************************************************** * KeyPress start KeyPressGS kpRec lda kpAvailable beq rts ReadKeyGS rkRec lda rkKey cmp #'.' bne lb1 lda rkModifiers and #$0100 beq lb1 ph2 #4 jsl TermError lb1 lda #1 rts rtl kpRec dc i'3' kpKey ds 2 kpModifiers ds 2 kpAvailable ds 2 rkRec dc i'2' rkKey ds 2 rkModifiers ds 2 end **************************************************************** * * NextCh - Read the next character from the file, skipping comments * * Outputs: * ch - character read * **************************************************************** * NextCh start eofChar equ 0 end of file character eolChar equ 13 end of line character stackFrameSize equ 14 size of the work space maxPath equ 255 max length of a path name fp equ 1 file record pointer; work pointer p1 equ 5 work pointer p2 equ 9 cch equ 13 enum (illegal,ch_special,ch_dash,ch_plus,ch_lt,ch_gt,ch_eq,ch_exc),0 enum (ch_and,ch_bar,ch_dot,ch_white,ch_eol,ch_eof,ch_char,ch_string) enum (ch_asterisk,ch_slash,ch_percent,ch_carot,ch_pound,letter,digit) tsc create stack frame sec sbc #stackFrameSize tcs phd tcd ! {flag for preprocessor check} ! if lastWasReturn then ! lastWasReturn := charKinds[ord(ch)] in [ch_eol,ch_white] ! else ! lastWasReturn := charKinds[ord(ch)] = ch_eol; lda ch asl A tax lda charKinds,X ldy #1 cmp #ch_eol beq pf2 ldx lastWasReturn beq pf1 cmp #ch_white beq pf2 pf1 dey pf2 sty lastWasReturn ! 1: lab1 anop ! if chPtr = eofPtr then begin {flag end of file if we're there} lda chPtr cmp eofPtr bne la1 lda chPtr+2 cmp eofPtr+2 beq la2 la1 brl lb5 la2 anop ! if not lastWasReturn then begin ! lastWasReturn := true; ! needWriteLine := true; ! ch := chr(eolChar); ! goto le2; ! end; {if} lda lastWasReturn bne la3 lda #1 sta lastWasReturn sta needWriteLine lda #eolChar sta ch brl le2 ! ch := chr(eofChar); la3 stz ch ! if needWriteLine then begin {do eol processing} ! WriteLine; ! lineNumber := lineNumber+1; ! firstPtr := chPtr; ! end; {if} lda needWriteLine beq lb1 jsl WriteLine inc lineNumber move4 chPtr,firstPtr lb1 anop ! if fileList = nil then begin lda fileList ora fileList+2 bne lb3 lb2 anop ! skipping := false; sta skipping ! end {if} brl le2 ! else begin lb3 anop ! {purge the current source file} ! with ffDCBGS do begin ! pCount := 5; lda #5 sta ffDCBGS ! action := 7; lda #7 sta ffDCBGS+2 ! name := @includeFileGS.theString lla ffDCBGS+12,includeFileGS+2 ! end; {with} ! FastFileGS(ffDCBGS); FastFileGS ffDCBGS ! fp := fileList; {open the file that included this one} move4 fileList,fp ! fileList := fp^.next; ldy #2 lda [fp] sta fileList lda [fp],Y sta fileList+2 ! includeFileGS := fp^.name; ! sourceFileGS := fp^.sname; add4 fp,#4,p1 add4 fp,#4+maxPath+4,p2 short M ldy #maxPath+3 lb4 lda [p1],Y sta includeFileGS,Y lda [p2],Y sta sourceFileGS,Y dey bpl lb4 long M ! lineNumber := fp^.lineNumber; ldy #4+maxPath+4+maxPath+4 lda [fp],Y sta lineNumber ! ReadFile; jsl ReadFile ! eofPtr := pointer(ord4(bofPtr) + ffDCBGS.fileLength); add4 bofPtr,ffDCBGS+46,eofPtr ! chPtr := pointer(ord4(bofPtr) + fp^.disp); ! includeChPtr := chPtr; ! firstPtr := chPtr; ldy #4+maxPath+4+maxPath+4+2 clc lda bofPtr adc [fp],Y sta chPtr sta firstPtr sta includeChPtr lda bofPtr+2 iny iny adc [fp],Y sta chPtr+2 sta firstPtr+2 sta includeChPtr+2 ! needWriteLine := false; stz needWriteLine ! dispose(fp); ph4 fp jsl ~Dispose ! includeCount := includeCount + 1; inc includeCount ! goto 1; brl lab1 ! end; {if} ! end {if} ! else begin lb5 anop ! ch := chr(chPtr^); {fetch the character} move4 chPtr,p1 lda [p1] and #$00FF sta ch ! if needWriteLine then begin {do eol processing} ! WriteLine; ! lineNumber := lineNumber+1; ! firstPtr := chPtr; ! end; {if} lda needWriteLine beq lb6 jsl WriteLine inc lineNumber move4 chPtr,firstPtr lb6 anop ! needWriteLine := charKinds[ord(ch)] = ch_eol; stz needWriteLine lda ch asl A tax lda charKinds,X cmp #ch_eol bne lb7 inc needWriteLine lb7 anop ! chPtr := pointer(ord4(chPtr) + 1); inc4 chPtr ! 2: if (ch = '\') and (charKinds[chPtr^] = ch_eol) then begin ! chPtr := pointer(ord4(chPtr) + 1); ! DebugCheck; ! needWriteLine := true; ! goto 1; ! end; {if} lab2 lda ch cmp #'\' bne lb8 move4 chPtr,p1 lda [p1] and #$00FF asl A tax lda charKinds,X cmp #ch_eol bne lb8 inc4 chPtr jsr DebugCheck lda #1 sta needWriteLine brl lab1 lb8 anop ! {check for debugger code} ! if needWriteLine then ! DebugCheck; lda needWriteLine beq lb9 jsr DebugCheck lb9 anop ! ! {if it's a comment, skip the comment } ! {characters and return a space. } ! if (not doingstring) and (ch = '/') and (chPtr <> eofPtr) ! and ((chr(chPtr^) = '*') ! or ((chr(chPtr^) = '/') and slashSlashComments))then begin lda doingstring jne lc6 lda ch cmp #'/' jne lc7 lda chPtr cmp eofPtr bne lc1 lda chPtr+2 cmp eofPtr+2 jeq lc6 lc1 move4 chPtr,p1 lda [p1] and #$00FF cmp #'*' beq lc1a cmp #'/' jne lc6 ldx slashSlashComments jeq lc6 ! cch := chr(chPtr^); lc1a sta cch ! chPtr := pointer(ord4(chPtr)+1); {skip the '*' or '/'} inc4 chPtr ! done := false; ! repeat lc2 anop ! if chPtr = eofPtr then {if at eof, we're done} ! done := true lda chPtr cmp eofPtr bne lc2a lda chPtr+2 cmp eofPtr+2 jeq lc5 ! else if (cch = '/') and (chPtr^ = return) then begin lc2a lda cch cmp #'/' bne lc2b ! if charKinds[ord(ch)] = ch_eol then ! done := true ! else ! chPtr := pointer(ord4(chPtr)+1); move4 chPtr,p1 lda [p1] and #$00FF asl A tax lda charKinds,X cmp #ch_eol jeq lc5 inc4 chPtr bra lc2 ! end {else if} ! else begin ! ch := chr(chPtr^); {check for terminating */} lc2b move4 chPtr,p1 lda [p1] and #$00FF sta ch ! if charKinds[ord(ch)] = ch_eol then begin ! WriteLine; ! lineNumber := lineNumber+1; ! firstPtr := pointer(ord4(chPtr)+1); ! end; {if} asl A tax lda charKinds,X cmp #ch_eol bne lc3 jsl WriteLine inc lineNumber add4 chPtr,#1,firstPtr lc3 anop ! chPtr := pointer(ord4(chPtr)+1); inc4 chPtr ! if ch = '*' then ! if (chr(chPtr^) = '/') and (chPtr <> eofPtr) then begin ! chPtr := pointer(ord4(chPtr)+1); ! done := true; ! end; {if} lda ch cmp #'*' jne lc2 lda chPtr cmp eofPtr bne lc4 lda chPtr+2 cmp eofPtr+2 jeq lc2 lc4 move4 chPtr,p1 lda [p1] and #$00FF cmp #'/' jne lc2 inc4 chPtr ! end; {else} ! until done; lc5 anop ! {return a space as the result} ! ch := ' '; lda #' ' sta ch ! end {if} brl le2 ! else if (ch = '?') and (chPtr <> eofPtr) and (chr(chPtr^) = '?') then begin lc6 lda ch lc7 cmp #'?' jne le2 lda chPtr cmp eofPtr bne lc8 lda chPtr+2 cmp eofPtr+2 jeq le2 lc8 move4 chPtr,p1 lda [p1] and #$00FF cmp #'?' jne le2 ! chPtr2 := pointer(ord4(chPtr) + 1); inc4 p1 ! if (chPtr2 <> eofPtr) lda p1 cmp eofPtr bne ld1 lda p1+2 cmp eofPtr+2 beq le2 ld1 anop ! and (chr(chPtr2^) in ['(','<','/','''','=',')','>','!','-']) then begin ! case chr(chPtr2^) of ! '(': ch := '['; lda [p1] and #$00FF cmp #'(' bne ld2 lda #'[' bra le1 ! '<': ch := '{'; ld2 cmp #'<' bne ld3 lda #'{' bra le1 ! '/': ch := '\'; ld3 cmp #'/' bne ld4 lda #'\' bra le1 ! '''': ch := '^'; ld4 cmp #'''' bne ld5 lda #'^' bra le1 ! '=': ch := '#'; ld5 cmp #'=' bne ld6 lda #'#' bra le1 ! ')': ch := ']'; ld6 cmp #')' bne ld7 lda #']' bra le1 ! '>': ch := '}'; ld7 cmp #'>' bne ld8 lda #'}' bra le1 ! '!': ch := '|'; ld8 cmp #'!' bne ld9 lda #'|' bra le1 ! '-': ch := '~'; ld9 cmp #'-' bne le2 lda #'~' ! end; {case} le1 sta ch ! chPtr := pointer(ord4(chPtr2) + 1); add4 chPtr,#2 ! goto 2; brl lab2 ! end; {if} ! end; {if} ! end; {else} le2 anop pld tsc clc adc #stackFrameSize tcs rtl ! end; {NextCh} ; ; Local subroutine ; enum (stop,break,autogo),0 line number debug types ! procedure DebugCheck; ! ! {Check for debugger characters; process if found } ! ! begin {DebugCheck} DebugCheck anop ! if chPtr = eofPtr then ! debugType := stop lda chPtr ldx chPtr+2 cmp eofPtr bne db1 cpx eofPtr+2 bne db1 stz debugType bra db5 ! else if ord(chPtr^) = $07 then begin db1 sta p1 stx p1+2 lda [p1] and #$00FF cmp #$07 bne db2 ! debugType := break lda #break sta debugType bra db3 ! else if ord(chPtr^) = $06 then db2 cmp #$06 bne db4 ! debugType := autoGo; lda #autoGo sta debugType ! chPtr := pointer(ord4(chPtr) + 1); db3 inc4 chPtr ! end {if} bra db5 ! else ! debugType := stop; db4 stz debugType ! end; {DebugCheck} db5 rts end **************************************************************** * * SetDateTime - set up the date/time strings * * Outputs: * dateStr - date * timeStr - time string * **************************************************************** * SetDateTime private pha get the date/time pha pha pha _ReadTimeHex lda 1,S set the minutes xba jsr convert sta time+5 pla set the seconds jsr convert sta time+8 lda 1,S set the hour jsr convert sta time+2 pla set the year xba jsr convert sta date+11 lda 1,S set the day inc A jsr convert sta date+6 pla set the month xba and #$00FF asl A asl A tax lda month,X sta date+2 lda month+1,X sta date+3 pla lla timeStr,time set the addresses lla dateStr,date rtl month dc c'Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec' date dc i'12',c'mmm dd 19yy',i1'0' time dc i'9',c'hh:mm:ss',i1'0' convert and #$00FF ldx #0 cv1 sec sbc #10 bcc cv2 inx bra cv1 cv2 clc adc #10 ora #'0' xba pha txa ora #'0' ora 1,S plx rts end \ No newline at end of file + mcopy scanner.macros +**************************************************************** +* +* Convertsl - Convert a string to a long integer +* +* Inputs: +* str - pointer to the string +* +* Outputs: +* Returns the value. +* +* Notes: +* Assumes the string is valid. +* +**************************************************************** +* +Convertsl start + +val equ 0 return value + + subroutine (4:str),4 + + stz val initialize the number to zero + stz val+2 + lda [str] set X to the number of characters + and #$00FF + tax + ldy #1 Y is the disp into the string +lb1 asl val val := val*10 + rol val+2 + ph2 val+2 + lda val + asl val + rol val+2 + asl val + rol val+2 + adc val + sta val + pla + adc val+2 + sta val+2 + lda [str],Y add in the new digit + and #$000F + adc val + sta val + bcc lb2 + inc val+2 +lb2 iny next character + dex + bne lb1 + + return 4:val + end + +**************************************************************** +* +* KeyPress - Has a key been presed? +* +* If a key has not been pressed, this function returns +* false. If a key has been pressed, it clears the key +* strobe. If the key was an open-apple ., a terminal exit +* is performed; otherwise, the function returns true. +* +**************************************************************** +* +KeyPress start + + KeyPressGS kpRec + lda kpAvailable + beq rts + ReadKeyGS rkRec + lda rkKey + cmp #'.' + bne lb1 + lda rkModifiers + and #$0100 + beq lb1 + ph2 #4 + jsl TermError + +lb1 lda #1 +rts rtl + +kpRec dc i'3' +kpKey ds 2 +kpModifiers ds 2 +kpAvailable ds 2 + +rkRec dc i'2' +rkKey ds 2 +rkModifiers ds 2 + end + +**************************************************************** +* +* NextCh - Read the next character from the file, skipping comments +* +* Outputs: +* ch - character read +* +**************************************************************** +* +NextCh start +eofChar equ 0 end of file character +eolChar equ 13 end of line character + +stackFrameSize equ 14 size of the work space +maxPath equ 255 max length of a path name + +fp equ 1 file record pointer; work pointer +p1 equ 5 work pointer +p2 equ 9 +cch equ 13 + + enum (illegal,ch_special,ch_dash,ch_plus,ch_lt,ch_gt,ch_eq,ch_exc),0 + enum (ch_and,ch_bar,ch_dot,ch_white,ch_eol,ch_eof,ch_char,ch_string) + enum (ch_asterisk,ch_slash,ch_percent,ch_carot,ch_pound,letter,digit) + + tsc create stack frame + sec + sbc #stackFrameSize + tcs + phd + tcd +! {flag for preprocessor check} +! if lastWasReturn then +! lastWasReturn := charKinds[ord(ch)] in [ch_eol,ch_white] +! else +! lastWasReturn := charKinds[ord(ch)] = ch_eol; + lda ch + asl A + tax + lda charKinds,X + ldy #1 + cmp #ch_eol + beq pf2 + ldx lastWasReturn + beq pf1 + cmp #ch_white + beq pf2 +pf1 dey +pf2 sty lastWasReturn +! 1: +lab1 anop +! if chPtr = eofPtr then begin {flag end of file if we're there} + lda chPtr + cmp eofPtr + bne la1 + lda chPtr+2 + cmp eofPtr+2 + beq la2 +la1 brl lb5 +la2 anop +! if not lastWasReturn then begin +! lastWasReturn := true; +! needWriteLine := true; +! ch := chr(eolChar); +! goto le2; +! end; {if} + lda lastWasReturn + bne la3 + lda #1 + sta lastWasReturn + sta needWriteLine + lda #eolChar + sta ch + brl le2 +! ch := chr(eofChar); +la3 stz ch + +! if needWriteLine then begin {do eol processing} +! WriteLine; +! lineNumber := lineNumber+1; +! firstPtr := chPtr; +! end; {if} + lda needWriteLine + beq lb1 + jsl WriteLine + inc lineNumber + move4 chPtr,firstPtr +lb1 anop + +! if fileList = nil then begin + lda fileList + ora fileList+2 + bne lb3 +lb2 anop +! skipping := false; + sta skipping +! end {if} + brl le2 +! else begin +lb3 anop +! {purge the current source file} +! with ffDCBGS do begin +! pCount := 5; + lda #5 + sta ffDCBGS +! action := 7; + lda #7 + sta ffDCBGS+2 +! name := @includeFileGS.theString + lla ffDCBGS+12,includeFileGS+2 +! end; {with} +! FastFileGS(ffDCBGS); + FastFileGS ffDCBGS +! fp := fileList; {open the file that included this one} + move4 fileList,fp +! fileList := fp^.next; + ldy #2 + lda [fp] + sta fileList + lda [fp],Y + sta fileList+2 +! includeFileGS := fp^.name; +! sourceFileGS := fp^.sname; + add4 fp,#4,p1 + add4 fp,#4+maxPath+4,p2 + short M + ldy #maxPath+3 +lb4 lda [p1],Y + sta includeFileGS,Y + lda [p2],Y + sta sourceFileGS,Y + dey + bpl lb4 + long M +! lineNumber := fp^.lineNumber; + ldy #4+maxPath+4+maxPath+4 + lda [fp],Y + sta lineNumber +! ReadFile; + jsl ReadFile +! eofPtr := pointer(ord4(bofPtr) + ffDCBGS.fileLength); + add4 bofPtr,ffDCBGS+46,eofPtr +! chPtr := pointer(ord4(bofPtr) + fp^.disp); +! includeChPtr := chPtr; +! firstPtr := chPtr; + ldy #4+maxPath+4+maxPath+4+2 + clc + lda bofPtr + adc [fp],Y + sta chPtr + sta firstPtr + sta includeChPtr + lda bofPtr+2 + iny + iny + adc [fp],Y + sta chPtr+2 + sta firstPtr+2 + sta includeChPtr+2 +! needWriteLine := false; + stz needWriteLine +! dispose(fp); + ph4 fp + jsl ~Dispose +! includeCount := includeCount + 1; + inc includeCount +! goto 1; + brl lab1 +! end; {if} +! end {if} + +! else begin +lb5 anop +! ch := chr(chPtr^); {fetch the character} + move4 chPtr,p1 + lda [p1] + and #$00FF + sta ch + +! if needWriteLine then begin {do eol processing} +! WriteLine; +! lineNumber := lineNumber+1; +! firstPtr := chPtr; +! end; {if} + lda needWriteLine + beq lb6 + jsl WriteLine + inc lineNumber + move4 chPtr,firstPtr +lb6 anop +! needWriteLine := charKinds[ord(ch)] = ch_eol; + stz needWriteLine + lda ch + asl A + tax + lda charKinds,X + cmp #ch_eol + bne lb7 + inc needWriteLine +lb7 anop +! chPtr := pointer(ord4(chPtr) + 1); + inc4 chPtr +! 2: if (ch = '\') and (charKinds[chPtr^] = ch_eol) then begin +! chPtr := pointer(ord4(chPtr) + 1); +! DebugCheck; +! needWriteLine := true; +! goto 1; +! end; {if} +lab2 lda ch + cmp #'\' + bne lb8 + move4 chPtr,p1 + lda [p1] + and #$00FF + asl A + tax + lda charKinds,X + cmp #ch_eol + bne lb8 + inc4 chPtr + jsr DebugCheck + lda #1 + sta needWriteLine + brl lab1 +lb8 anop +! {check for debugger code} +! if needWriteLine then +! DebugCheck; + lda needWriteLine + beq lb9 + jsr DebugCheck +lb9 anop +! +! {if it's a comment, skip the comment } +! {characters and return a space. } +! if (not doingstring) and (ch = '/') and (chPtr <> eofPtr) +! and ((chr(chPtr^) = '*') +! or ((chr(chPtr^) = '/') and slashSlashComments))then begin + lda doingstring + jne lc6 + lda ch + cmp #'/' + jne lc7 + lda chPtr + cmp eofPtr + bne lc1 + lda chPtr+2 + cmp eofPtr+2 + jeq lc6 +lc1 move4 chPtr,p1 + lda [p1] + and #$00FF + cmp #'*' + beq lc1a + cmp #'/' + jne lc6 + ldx slashSlashComments + jeq lc6 +! cch := chr(chPtr^); +lc1a sta cch +! chPtr := pointer(ord4(chPtr)+1); {skip the '*' or '/'} + inc4 chPtr +! done := false; +! repeat +lc2 anop +! if chPtr = eofPtr then {if at eof, we're done} +! done := true + lda chPtr + cmp eofPtr + bne lc2a + lda chPtr+2 + cmp eofPtr+2 + jeq lc5 +! else if (cch = '/') and (chPtr^ = return) then begin +lc2a lda cch + cmp #'/' + bne lc2b +! if charKinds[ord(ch)] = ch_eol then +! done := true +! else +! chPtr := pointer(ord4(chPtr)+1); + move4 chPtr,p1 + lda [p1] + and #$00FF + asl A + tax + lda charKinds,X + cmp #ch_eol + jeq lc5 + inc4 chPtr + bra lc2 +! end {else if} +! else begin +! ch := chr(chPtr^); {check for terminating */} +lc2b move4 chPtr,p1 + lda [p1] + and #$00FF + sta ch +! if charKinds[ord(ch)] = ch_eol then begin +! WriteLine; +! lineNumber := lineNumber+1; +! firstPtr := pointer(ord4(chPtr)+1); +! end; {if} + asl A + tax + lda charKinds,X + cmp #ch_eol + bne lc3 + jsl WriteLine + inc lineNumber + add4 chPtr,#1,firstPtr +lc3 anop +! chPtr := pointer(ord4(chPtr)+1); + inc4 chPtr +! if ch = '*' then +! if (chr(chPtr^) = '/') and (chPtr <> eofPtr) then begin +! chPtr := pointer(ord4(chPtr)+1); +! done := true; +! end; {if} + lda ch + cmp #'*' + jne lc2 + lda chPtr + cmp eofPtr + bne lc4 + lda chPtr+2 + cmp eofPtr+2 + jeq lc2 +lc4 move4 chPtr,p1 + lda [p1] + and #$00FF + cmp #'/' + jne lc2 + inc4 chPtr +! end; {else} +! until done; +lc5 anop +! {return a space as the result} +! ch := ' '; + lda #' ' + sta ch +! end {if} + brl le2 +! else if (ch = '?') and (chPtr <> eofPtr) and (chr(chPtr^) = '?') then begin +lc6 lda ch +lc7 cmp #'?' + jne le2 + lda chPtr + cmp eofPtr + bne lc8 + lda chPtr+2 + cmp eofPtr+2 + jeq le2 +lc8 move4 chPtr,p1 + lda [p1] + and #$00FF + cmp #'?' + jne le2 +! chPtr2 := pointer(ord4(chPtr) + 1); + inc4 p1 +! if (chPtr2 <> eofPtr) + lda p1 + cmp eofPtr + bne ld1 + lda p1+2 + cmp eofPtr+2 + beq le2 +ld1 anop +! and (chr(chPtr2^) in ['(','<','/','''','=',')','>','!','-']) then begin +! case chr(chPtr2^) of +! '(': ch := '['; + lda [p1] + and #$00FF + cmp #'(' + bne ld2 + lda #'[' + bra le1 +! '<': ch := '{'; +ld2 cmp #'<' + bne ld3 + lda #'{' + bra le1 +! '/': ch := '\'; +ld3 cmp #'/' + bne ld4 + lda #'\' + bra le1 +! '''': ch := '^'; +ld4 cmp #'''' + bne ld5 + lda #'^' + bra le1 +! '=': ch := '#'; +ld5 cmp #'=' + bne ld6 + lda #'#' + bra le1 +! ')': ch := ']'; +ld6 cmp #')' + bne ld7 + lda #']' + bra le1 +! '>': ch := '}'; +ld7 cmp #'>' + bne ld8 + lda #'}' + bra le1 +! '!': ch := '|'; +ld8 cmp #'!' + bne ld9 + lda #'|' + bra le1 +! '-': ch := '~'; +ld9 cmp #'-' + bne le2 + lda #'~' +! end; {case} +le1 sta ch +! chPtr := pointer(ord4(chPtr2) + 1); + add4 chPtr,#2 +! goto 2; + brl lab2 +! end; {if} +! end; {if} +! end; {else} +le2 anop + pld + tsc + clc + adc #stackFrameSize + tcs + rtl +! end; {NextCh} + +; +; Local subroutine +; + enum (stop,break,autogo),0 line number debug types +! procedure DebugCheck; +! +! {Check for debugger characters; process if found } +! +! begin {DebugCheck} +DebugCheck anop +! if chPtr = eofPtr then +! debugType := stop + lda chPtr + ldx chPtr+2 + cmp eofPtr + bne db1 + cpx eofPtr+2 + bne db1 + stz debugType + bra db5 +! else if ord(chPtr^) = $07 then begin +db1 sta p1 + stx p1+2 + lda [p1] + and #$00FF + cmp #$07 + bne db2 +! debugType := break + lda #break + sta debugType + bra db3 +! else if ord(chPtr^) = $06 then +db2 cmp #$06 + bne db4 +! debugType := autoGo; + lda #autoGo + sta debugType +! chPtr := pointer(ord4(chPtr) + 1); +db3 inc4 chPtr +! end {if} + bra db5 +! else +! debugType := stop; +db4 stz debugType +! end; {DebugCheck} +db5 rts + end + +**************************************************************** +* +* SetDateTime - set up the date/time strings +* +* Outputs: +* dateStr - date +* timeStr - time string +* +**************************************************************** +* +SetDateTime private + + pha get the date/time + pha + pha + pha + _ReadTimeHex + lda 1,S set the minutes + xba + jsr convert + sta time+5 + pla set the seconds + jsr convert + sta time+8 + lda 1,S set the hour + jsr convert + sta time+2 + pla set the year + xba + jsr convert + sta date+11 + lda 1,S set the day + inc A + jsr convert + sta date+6 + pla set the month + xba + and #$00FF + asl A + asl A + tax + lda month,X + sta date+2 + lda month+1,X + sta date+3 + pla + lla timeStr,time set the addresses + lla dateStr,date + rtl + +month dc c'Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec' +date dc i'12',c'mmm dd 19yy',i1'0' +time dc i'9',c'hh:mm:ss',i1'0' + +convert and #$00FF + ldx #0 +cv1 sec + sbc #10 + bcc cv2 + inx + bra cv1 +cv2 clc + adc #10 + ora #'0' + xba + pha + txa + ora #'0' + ora 1,S + plx + rts + end diff --git a/Scanner.debug b/Scanner.debug old mode 100755 new mode 100644 index 08bebf5..1ce29ce --- a/Scanner.debug +++ b/Scanner.debug @@ -1 +1,31 @@ -procedure PrintTokenList (tp: tokenListRecordPtr); {debug} begin if tp <> nil then begin PrintTokenList(tp^.next); PrintToken(tp^.token); end; {if} end; procedure PrintMacroTable; {debug} { print the macro definitions } var i: 0..hashSize; {loop/index variable} mp: macroRecordPtr; {used to trace macro lists} begin {PrintMacroTable} for i := 0 to hashSize do begin mp := macros^[i]; while mp <> nil do begin write(' ', mp^.name^, '(', mp^.parameters:1, ') ['); PrintTokenList(mp^.tokens); writeln(']'); mp := mp^.next; end; {while} end; {for} write('(Press RETURN to continue)'); readln; end; {PrintMacroTable} \ No newline at end of file +procedure PrintTokenList (tp: tokenListRecordPtr); {debug} + +begin +if tp <> nil then begin + PrintTokenList(tp^.next); + PrintToken(tp^.token); + end; {if} +end; + + +procedure PrintMacroTable; {debug} + +{ print the macro definitions } + +var + i: 0..hashSize; {loop/index variable} + mp: macroRecordPtr; {used to trace macro lists} + +begin {PrintMacroTable} +for i := 0 to hashSize do begin + mp := macros^[i]; + while mp <> nil do begin + write(' ', mp^.name^, '(', mp^.parameters:1, ') ['); + PrintTokenList(mp^.tokens); + writeln(']'); + mp := mp^.next; + end; {while} + end; {for} +write('(Press RETURN to continue)'); +readln; +end; {PrintMacroTable} diff --git a/Scanner.macros b/Scanner.macros old mode 100755 new mode 100644 index 1ace0d2..9bfff31 --- a/Scanner.macros +++ b/Scanner.macros @@ -1 +1,531 @@ - MACRO &LAB _READTIMEHEX &LAB LDX #$0D03 JSL $E10000 MEND MACRO &LAB LLA &AD1,&AD2 &LAB ANOP LCLA &L LCLB &LA AIF S:LONGA,.A REP #%00100000 LONGA ON &LA SETB 1 .A LDA #&AD2 &L SETA C:&AD1 .B STA &AD1(&L) &L SETA &L-1 AIF &L,^B LDA #^&AD2 &L SETA C:&AD1 .C STA 2+&AD1(&L) &L SETA &L-1 AIF &L,^C AIF &LA=0,.D SEP #%00100000 LONGA OFF .D MEND MACRO &lab subroutine &parms,&work &lab anop aif c:&work,.a lclc &work &work setc 0 .a gbla &totallen gbla &worklen &worklen seta &work &totallen seta 0 aif c:&parms=0,.e lclc &len lclc &p lcla &i &i seta c:&parms .b &p setc &parms(&i) &len amid &p,2,1 aif "&len"=":",.c &len amid &p,1,2 &p amid &p,4,l:&p-3 ago .d .c &len amid &p,1,1 &p amid &p,3,l:&p-2 .d &p equ &totallen+3+&work &totallen seta &totallen+&len &i seta &i-1 aif &i,^b .e tsc sec sbc #&work tcs inc a phd tcd mend MACRO &lab return &r &lab anop lclc &len aif c:&r,.a lclc &r &r setc 0 &len setc 0 ago .h .a &len amid &r,2,1 aif "&len"=":",.b &len amid &r,1,2 &r amid &r,4,l:&r-3 ago .c .b &len amid &r,1,1 &r amid &r,3,l:&r-2 .c aif &len<>2,.d ldy &r ago .h .d aif &len<>4,.e ldx &r+2 ldy &r ago .h .e aif &len<>10,.g aif &totallen=0,.f lda &worklen+1 sta &worklen+&totallen+1 lda &worklen sta &worklen+&totallen .f pld tsc clc adc #&worklen+&totallen tcs phb plx ply lda &r+8 pha lda &r+6 pha lda &r+4 pha lda &r+2 pha lda &r pha phy phx plb rtl mexit .g mnote 'Not a valid return length',16 mexit .h aif &totallen=0,.i lda &worklen+1 sta &worklen+&totallen+1 lda &worklen sta &worklen+&totallen .i pld tsc clc adc #&worklen+&totallen tcs aif &len=0,.j tya .j rtl mend MACRO &LAB PH2 &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"="#",.D AIF S:LONGA=1,.A REP #%00100000 .A AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 LDA (&N1) PHA AGO .E .B LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &LAB ENUM &LIST,&START &LAB ANOP AIF C:&~ENUM,.A GBLA &~ENUM .A AIF C:&START=0,.B &~ENUM SETA &START .B LCLA &CNT &CNT SETA 1 .C &LIST(&CNT) EQU &~ENUM &~ENUM SETA &~ENUM+1 &CNT SETA &CNT+1 AIF &CNT<=C:&LIST,^C MEND MACRO &LAB ADD4 &M1,&M2,&M3 LCLB &YISTWO LCLC &C &LAB ~SETM AIF C:&M3,.A &C AMID "&M2",1,1 AIF "&C"<>"#",.A &C AMID "&M1",1,1 AIF "&C"="{",.A AIF "&C"="[",.A &C AMID "&M2",2,L:&M2-1 AIF &C>=65536,.A CLC ~LDA &M1 ~OP ADC,&M2 ~STA &M1 BCC ~&SYSCNT ~OP.H INC,&M1 ~&SYSCNT ANOP AGO .C .A AIF C:&M3,.B LCLC &M3 &M3 SETC &M1 .B CLC ~LDA &M1 ~OP ADC,&M2 ~STA &M3 ~LDA.H &M1 ~OP.H ADC,&M2 ~STA.H &M3 .C ~RESTM MEND MACRO &LAB ~OP.H &OPC,&OP &LAB ANOP LCLC &C &C AMID "&OP",1,1 AIF "&C"="[",.B AIF "&C"<>"{",.D &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B AIF &YISTWO,.C &YISTWO SETB 1 LDY #2 &OP SETC "&OP,Y" .C &OPC &OP MEXIT .D AIF "&C"<>"#",.E &OP AMID "&OP",2,L:&OP-1 &OP SETC "#^&OP" &OPC &OP MEXIT .E &OPC 2+&OP MEND MACRO &LAB ~LDA.H &OP &LAB ANOP LCLC &C &C AMID "&OP",1,1 AIF "&C"="[",.B AIF "&C"<>"{",.D &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B AIF &YISTWO,.C &YISTWO SETB 1 LDY #2 &OP SETC "&OP,Y" .C LDA &OP MEXIT .D AIF "&C"<>"#",.E &OP AMID "&OP",2,L:&OP-1 &OP SETC "#^&OP" LDA &OP MEXIT .E LDA 2+&OP MEND MACRO &LAB ~STA.H &OP &LAB ANOP LCLC &C &C AMID "&OP",1,1 AIF "&C"="[",.B AIF "&C"<>"{",.D &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B AIF &YISTWO,.C &YISTWO SETB 1 LDY #2 &OP SETC "&OP,Y" .C STA &OP MEXIT .D STA 2+&OP MEND MACRO &LAB INC4 &A &LAB ~SETM INC &A BNE ~&SYSCNT INC 2+&A ~&SYSCNT ~RESTM MEND MACRO &LAB LONG &A,&B LCLB &I LCLB &M &A AMID &A,1,1 &M SETB ("&A"="M").OR.("&A"="m") &I SETB ("&A"="I").OR.("&A"="i") AIF C:&B=0,.A &B AMID &B,1,1 &M SETB ("&B"="M").OR.("&B"="m").OR.&M &I SETB ("&B"="I").OR.("&B"="i").OR.&I .A &LAB REP #&M*32+&I*16 AIF .NOT.&M,.B LONGA ON .B AIF .NOT.&I,.C LONGI ON .C MEND MACRO &LAB PH4 &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"="#",.D AIF S:LONGA=1,.A REP #%00100000 .A AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 LDY #2 LDA (&N1),Y PHA LDA (&N1) PHA AGO .E .B AIF "&C"<>"[",.C LDY #2 LDA &N1,Y PHA LDA &N1 PHA AGO .E .C LDA &N1+2 PHA LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA +(&N1)|-16 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &LAB SHORT &A,&B LCLB &I LCLB &M &A AMID &A,1,1 &M SETB ("&A"="M").OR.("&A"="m") &I SETB ("&A"="I").OR.("&A"="i") AIF C:&B=0,.A &B AMID &B,1,1 &M SETB ("&B"="M").OR.("&B"="m").OR.&M &I SETB ("&B"="I").OR.("&B"="i").OR.&I .A &LAB SEP #&M*32+&I*16 AIF .NOT.&M,.B LONGA OFF .B AIF .NOT.&I,.C LONGI OFF .C MEND MACRO &LAB MOVE4 &F,&T &LAB ~SETM LDA 2+&F STA 2+&T LDA &F STA &T ~RESTM MEND MACRO &LAB JNE &BP &LAB BEQ *+5 BRL &BP MEND MACRO &LAB JEQ &BP &LAB BNE *+5 BRL &BP MEND MACRO &LAB ~SETM &LAB ANOP AIF C:&~LA,.B GBLB &~LA GBLB &~LI .B &~LA SETB S:LONGA &~LI SETB S:LONGI AIF S:LONGA.AND.S:LONGI,.A REP #32*(.NOT.&~LA)+16*(.NOT.&~LI) LONGA ON LONGI ON .A MEND MACRO &LAB ~RESTM &LAB ANOP AIF (&~LA+&~LI)=2,.I SEP #32*(.NOT.&~LA)+16*(.NOT.&~LI) AIF &~LA,.H LONGA OFF .H AIF &~LI,.I LONGI OFF .I MEND MACRO &LAB ~LDA &OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB LDA &OP MEND MACRO &LAB ~STA &OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB STA &OP MEND MACRO &LAB ~OP &OPC,&OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB &OPC &OP MEND macro &l fastfilegs &p &l ~setm jsl $E100A8 dc i2'$014E' dc i4'&p' ~restm mend macro &l keypressgs &p &l ~setm jsl $E100A8 dc i2'$015E' dc i4'&p' ~restm mend macro &l readkeygs &p &l ~setm jsl $E100A8 dc i2'$015F' dc i4'&p' ~restm mend \ No newline at end of file + MACRO +&LAB _READTIMEHEX +&LAB LDX #$0D03 + JSL $E10000 + MEND + MACRO +&LAB LLA &AD1,&AD2 +&LAB ANOP + LCLA &L + LCLB &LA + AIF S:LONGA,.A + REP #%00100000 + LONGA ON +&LA SETB 1 +.A + LDA #&AD2 +&L SETA C:&AD1 +.B + STA &AD1(&L) +&L SETA &L-1 + AIF &L,^B + LDA #^&AD2 +&L SETA C:&AD1 +.C + STA 2+&AD1(&L) +&L SETA &L-1 + AIF &L,^C + AIF &LA=0,.D + SEP #%00100000 + LONGA OFF +.D + MEND + MACRO +&lab subroutine &parms,&work +&lab anop + aif c:&work,.a + lclc &work +&work setc 0 +.a + gbla &totallen + gbla &worklen +&worklen seta &work +&totallen seta 0 + aif c:&parms=0,.e + lclc &len + lclc &p + lcla &i +&i seta c:&parms +.b +&p setc &parms(&i) +&len amid &p,2,1 + aif "&len"=":",.c +&len amid &p,1,2 +&p amid &p,4,l:&p-3 + ago .d +.c +&len amid &p,1,1 +&p amid &p,3,l:&p-2 +.d +&p equ &totallen+3+&work +&totallen seta &totallen+&len +&i seta &i-1 + aif &i,^b +.e + tsc + sec + sbc #&work + tcs + inc a + phd + tcd + mend + MACRO +&lab return &r +&lab anop + lclc &len + aif c:&r,.a + lclc &r +&r setc 0 +&len setc 0 + ago .h +.a +&len amid &r,2,1 + aif "&len"=":",.b +&len amid &r,1,2 +&r amid &r,4,l:&r-3 + ago .c +.b +&len amid &r,1,1 +&r amid &r,3,l:&r-2 +.c + aif &len<>2,.d + ldy &r + ago .h +.d + aif &len<>4,.e + ldx &r+2 + ldy &r + ago .h +.e + aif &len<>10,.g + aif &totallen=0,.f + lda &worklen+1 + sta &worklen+&totallen+1 + lda &worklen + sta &worklen+&totallen +.f + pld + tsc + clc + adc #&worklen+&totallen + tcs + phb + plx + ply + lda &r+8 + pha + lda &r+6 + pha + lda &r+4 + pha + lda &r+2 + pha + lda &r + pha + phy + phx + plb + rtl + mexit +.g + mnote 'Not a valid return length',16 + mexit +.h + aif &totallen=0,.i + lda &worklen+1 + sta &worklen+&totallen+1 + lda &worklen + sta &worklen+&totallen +.i + pld + tsc + clc + adc #&worklen+&totallen + tcs + aif &len=0,.j + tya +.j + rtl + mend + MACRO +&LAB PH2 &N1 + LCLC &C +&LAB ANOP +&C AMID &N1,1,1 + AIF "&C"="#",.D + AIF S:LONGA=1,.A + REP #%00100000 +.A + AIF "&C"<>"{",.B +&C AMID &N1,L:&N1,1 + AIF "&C"<>"}",.G +&N1 AMID &N1,2,L:&N1-2 + LDA (&N1) + PHA + AGO .E +.B + LDA &N1 + PHA + AGO .E +.D +&N1 AMID &N1,2,L:&N1-1 + PEA &N1 + AGO .F +.E + AIF S:LONGA=1,.F + SEP #%00100000 +.F + MEXIT +.G + MNOTE "Missing closing '}'",16 + MEND + MACRO +&LAB ENUM &LIST,&START +&LAB ANOP + AIF C:&~ENUM,.A + GBLA &~ENUM +.A + AIF C:&START=0,.B +&~ENUM SETA &START +.B + LCLA &CNT +&CNT SETA 1 +.C +&LIST(&CNT) EQU &~ENUM +&~ENUM SETA &~ENUM+1 +&CNT SETA &CNT+1 + AIF &CNT<=C:&LIST,^C + MEND + MACRO +&LAB ADD4 &M1,&M2,&M3 + LCLB &YISTWO + LCLC &C +&LAB ~SETM + AIF C:&M3,.A +&C AMID "&M2",1,1 + AIF "&C"<>"#",.A +&C AMID "&M1",1,1 + AIF "&C"="{",.A + AIF "&C"="[",.A +&C AMID "&M2",2,L:&M2-1 + AIF &C>=65536,.A + CLC + ~LDA &M1 + ~OP ADC,&M2 + ~STA &M1 + BCC ~&SYSCNT + ~OP.H INC,&M1 +~&SYSCNT ANOP + AGO .C +.A + AIF C:&M3,.B + LCLC &M3 +&M3 SETC &M1 +.B + CLC + ~LDA &M1 + ~OP ADC,&M2 + ~STA &M3 + ~LDA.H &M1 + ~OP.H ADC,&M2 + ~STA.H &M3 +.C + ~RESTM + MEND + MACRO +&LAB ~OP.H &OPC,&OP +&LAB ANOP + LCLC &C +&C AMID "&OP",1,1 + AIF "&C"="[",.B + AIF "&C"<>"{",.D +&C AMID "&OP",L:&OP,1 + AIF "&C"="}",.A + MNOTE "Missing closing '}'",2 +&OP SETC &OP} +.A +&OP AMID "&OP",2,L:&OP-2 +&OP SETC (&OP) +.B + AIF &YISTWO,.C +&YISTWO SETB 1 + LDY #2 +&OP SETC "&OP,Y" +.C + &OPC &OP + MEXIT +.D + AIF "&C"<>"#",.E +&OP AMID "&OP",2,L:&OP-1 +&OP SETC "#^&OP" + &OPC &OP + MEXIT +.E + &OPC 2+&OP + MEND + MACRO +&LAB ~LDA.H &OP +&LAB ANOP + LCLC &C +&C AMID "&OP",1,1 + AIF "&C"="[",.B + AIF "&C"<>"{",.D +&C AMID "&OP",L:&OP,1 + AIF "&C"="}",.A + MNOTE "Missing closing '}'",2 +&OP SETC &OP} +.A +&OP AMID "&OP",2,L:&OP-2 +&OP SETC (&OP) +.B + AIF &YISTWO,.C +&YISTWO SETB 1 + LDY #2 +&OP SETC "&OP,Y" +.C + LDA &OP + MEXIT +.D + AIF "&C"<>"#",.E +&OP AMID "&OP",2,L:&OP-1 +&OP SETC "#^&OP" + LDA &OP + MEXIT +.E + LDA 2+&OP + MEND + MACRO +&LAB ~STA.H &OP +&LAB ANOP + LCLC &C +&C AMID "&OP",1,1 + AIF "&C"="[",.B + AIF "&C"<>"{",.D +&C AMID "&OP",L:&OP,1 + AIF "&C"="}",.A + MNOTE "Missing closing '}'",2 +&OP SETC &OP} +.A +&OP AMID "&OP",2,L:&OP-2 +&OP SETC (&OP) +.B + AIF &YISTWO,.C +&YISTWO SETB 1 + LDY #2 +&OP SETC "&OP,Y" +.C + STA &OP + MEXIT +.D + STA 2+&OP + MEND + MACRO +&LAB INC4 &A +&LAB ~SETM + INC &A + BNE ~&SYSCNT + INC 2+&A +~&SYSCNT ~RESTM + MEND + MACRO +&LAB LONG &A,&B + LCLB &I + LCLB &M +&A AMID &A,1,1 +&M SETB ("&A"="M").OR.("&A"="m") +&I SETB ("&A"="I").OR.("&A"="i") + AIF C:&B=0,.A +&B AMID &B,1,1 +&M SETB ("&B"="M").OR.("&B"="m").OR.&M +&I SETB ("&B"="I").OR.("&B"="i").OR.&I +.A +&LAB REP #&M*32+&I*16 + AIF .NOT.&M,.B + LONGA ON +.B + AIF .NOT.&I,.C + LONGI ON +.C + MEND + MACRO +&LAB PH4 &N1 + LCLC &C +&LAB ANOP +&C AMID &N1,1,1 + AIF "&C"="#",.D + AIF S:LONGA=1,.A + REP #%00100000 +.A + AIF "&C"<>"{",.B +&C AMID &N1,L:&N1,1 + AIF "&C"<>"}",.G +&N1 AMID &N1,2,L:&N1-2 + LDY #2 + LDA (&N1),Y + PHA + LDA (&N1) + PHA + AGO .E +.B + AIF "&C"<>"[",.C + LDY #2 + LDA &N1,Y + PHA + LDA &N1 + PHA + AGO .E +.C + LDA &N1+2 + PHA + LDA &N1 + PHA + AGO .E +.D +&N1 AMID &N1,2,L:&N1-1 + PEA +(&N1)|-16 + PEA &N1 + AGO .F +.E + AIF S:LONGA=1,.F + SEP #%00100000 +.F + MEXIT +.G + MNOTE "Missing closing '}'",16 + MEND + MACRO +&LAB SHORT &A,&B + LCLB &I + LCLB &M +&A AMID &A,1,1 +&M SETB ("&A"="M").OR.("&A"="m") +&I SETB ("&A"="I").OR.("&A"="i") + AIF C:&B=0,.A +&B AMID &B,1,1 +&M SETB ("&B"="M").OR.("&B"="m").OR.&M +&I SETB ("&B"="I").OR.("&B"="i").OR.&I +.A +&LAB SEP #&M*32+&I*16 + AIF .NOT.&M,.B + LONGA OFF +.B + AIF .NOT.&I,.C + LONGI OFF +.C + MEND + MACRO +&LAB MOVE4 &F,&T +&LAB ~SETM + LDA 2+&F + STA 2+&T + LDA &F + STA &T + ~RESTM + MEND + MACRO +&LAB JNE &BP +&LAB BEQ *+5 + BRL &BP + MEND + MACRO +&LAB JEQ &BP +&LAB BNE *+5 + BRL &BP + MEND + MACRO +&LAB ~SETM +&LAB ANOP + AIF C:&~LA,.B + GBLB &~LA + GBLB &~LI +.B +&~LA SETB S:LONGA +&~LI SETB S:LONGI + AIF S:LONGA.AND.S:LONGI,.A + REP #32*(.NOT.&~LA)+16*(.NOT.&~LI) + LONGA ON + LONGI ON +.A + MEND + MACRO +&LAB ~RESTM +&LAB ANOP + AIF (&~LA+&~LI)=2,.I + SEP #32*(.NOT.&~LA)+16*(.NOT.&~LI) + AIF &~LA,.H + LONGA OFF +.H + AIF &~LI,.I + LONGI OFF +.I + MEND + MACRO +&LAB ~LDA &OP + LCLC &C +&C AMID "&OP",1,1 + AIF "&C"<>"{",.B +&C AMID "&OP",L:&OP,1 + AIF "&C"="}",.A + MNOTE "Missing closing '}'",2 +&OP SETC &OP} +.A +&OP AMID "&OP",2,L:&OP-2 +&OP SETC (&OP) +.B +&LAB LDA &OP + MEND + MACRO +&LAB ~STA &OP + LCLC &C +&C AMID "&OP",1,1 + AIF "&C"<>"{",.B +&C AMID "&OP",L:&OP,1 + AIF "&C"="}",.A + MNOTE "Missing closing '}'",2 +&OP SETC &OP} +.A +&OP AMID "&OP",2,L:&OP-2 +&OP SETC (&OP) +.B +&LAB STA &OP + MEND + MACRO +&LAB ~OP &OPC,&OP + LCLC &C +&C AMID "&OP",1,1 + AIF "&C"<>"{",.B +&C AMID "&OP",L:&OP,1 + AIF "&C"="}",.A + MNOTE "Missing closing '}'",2 +&OP SETC &OP} +.A +&OP AMID "&OP",2,L:&OP-2 +&OP SETC (&OP) +.B +&LAB &OPC &OP + MEND + macro +&l fastfilegs &p +&l ~setm + jsl $E100A8 + dc i2'$014E' + dc i4'&p' + ~restm + mend + macro +&l keypressgs &p +&l ~setm + jsl $E100A8 + dc i2'$015E' + dc i4'&p' + ~restm + mend + macro +&l readkeygs &p +&l ~setm + jsl $E100A8 + dc i2'$015F' + dc i4'&p' + ~restm + mend diff --git a/Scanner.pas b/Scanner.pas old mode 100755 new mode 100644 index 7996de7..3496219 --- a/Scanner.pas +++ b/Scanner.pas @@ -1 +1,4050 @@ -{$optimize 7} {---------------------------------------------------------------} { } { Scanner } { } { External Variables: } { } { ch - next character to process } { printMacroExpansions - print the token list? } { reportEOL - report eolsy as a token? } { token - next token to process } { } { External Subroutines: } { } { Error - flag an error } { IsDefined - see if a macro name is in the macro table } { InitScanner - initialize the scanner } { NextCh - Read the next character from the file, skipping } { comments. } { NextToken - read the next token from the file } { PutBackToken - place a token into the token stream } { TermScanner - Shut down the scanner. } { } {---------------------------------------------------------------} unit Scanner; interface {$LibPrefix '0/obj/'} uses CCommon, Table, CGI, MM; {$segment 'scanner'} type pragmas = {kinds of pragmas} (p_startofenum,p_cda,p_cdev,p_float,p_keep, p_nda,p_debug,p_lint,p_memorymodel,p_expand, p_optimize,p_stacksize,p_toolparms,p_databank,p_rtl, p_noroot,p_path,p_ignore,p_segment,p_nba, p_xcmd,p_unix,p_line,p_endofenum); {preprocessor types} {------------------} tokenListRecordPtr = ^tokenListRecord; tokenListRecord = record {element of a list of tokens} next: tokenListRecordPtr; {next element in list} tokenString: longStringPtr; {string making up the token} token: tokenType; {token} expandEnabled: boolean; {can this token be macro expanded?} tokenStart,tokenEnd: ptr; {token start/end markers} end; macroRecordPtr = ^macroRecord; macroRecord = record {preprocessor macro definition} next: macroRecordPtr; saved: boolean; name: stringPtr; parameters: integer; tokens: tokenListRecordPtr; readOnly: boolean; algorithm: integer; end; macroTable = array[0..hashSize] of macroRecordPtr; {preprocessor macro list} {path name lists} {---------------} pathRecordPtr = ^pathRecord; pathRecord = record next: pathRecordPtr; path: stringPtr; end; var ch: char; {next character to process} macros: ^macroTable; {preprocessor macro list} pathList: pathRecordPtr; {additional search paths} printMacroExpansions: boolean; {print the token list?} reportEOL: boolean; {report eolsy as a token?} skipIllegalTokens: boolean; {skip flagging illegal tokens in skipped code?} slashSlashComments: boolean; {allow // comments?} token: tokenType; {next token to process} {---------------------------------------------------------------} procedure DoDefaultsDotH; { Handle the defaults.h file } procedure Error (err: integer); { flag an error } { } { err - error number } {procedure Error2 (loc, err: integer); {debug} { flag an error } { } { loc - error location } { err - error number } procedure InitScanner (start, endPtr: ptr); { initialize the scanner } { } { start - pointer to the first character in the file } { endPtr - points one byte past the last character in the file } function IsDefined (name: stringPtr): boolean; { See if a macro name is in the macro table } { } { The returned value is true if the macro exists, else false. } { } { parameters: } { name - name of the macro to search for } procedure NextCh; extern; { Read the next character from the file, skipping comments. } { } { Globals: } { ch - character read } procedure NextToken; { Read the next token from the file. } procedure PutBackToken (var token: tokenType; expandEnabled: boolean); { place a token into the token stream } { } { parameters: } { token - token to put back into the token stream } { expandEnabled - can macro expansion be performed? } procedure TermScanner; { Shut down the scanner. } {---------------------------------------------------------------} implementation const {special key values} {------------------} BS = 8; {backspace} FF = 12; {form feed} HT = 9; {horizontal tab} NEWLINE = 10; {newline} RETURN = 13; {RETURN key code} VT = 11; {vertical tab} {misc} {----} defaultName = '13:ORCACDefs:Defaults.h'; {default include file name} maxErr = 10; {max errors on one line} type errorType = record {record of a single error} num: integer; {error number} line: integer; {line number} col: integer; {column number} end; {file inclusion} {--------------} filePtr = ^fileRecord; fileRecord = record {NOTE: used in scanner.asm} next: filePtr; {next file in include stack} name: gsosOutString; {name of the file} sname: gsosOutString; {name of the file for __FILE__} lineNumber: integer; {line number at the #include} disp: longint; {disp of next character to process} end; getFileInfoOSDCB = record pcount: integer; pathName: gsosInStringPtr; access: integer; fileType: integer; auxType: longint; storageType: integer; createDateTime: timeField; modDateTime: timeField; optionList: optionListPtr; dataEOF: longint; blocksUsed: longint; resourceEOF: longint; resourceBlocks: longint; end; expandDevicesDCBGS = record pcount: integer; inName: gsosInStringPtr; outName: gsosOutStringPtr; end; {conditional compilation parsing} {-------------------------------} ifPtr = ^ifRecord; ifRecord = record next: ifPtr; {next record in if stack} status: {what are we doing?} (processing,skippingToEndif,skippingToElse); elseFound: boolean; {has an #else been found?} end; var dateStr: longStringPtr; {macro date string} doingstring: boolean; {used to supress comments in strings} errors: array[1..maxErr] of errorType; {errors in this line} eofPtr: ptr; {points one byte past the last char in the file} fileList: filePtr; {include file list} flagOverflows: boolean; {flag numeric overflows?} gettingFileName: boolean; {are we in GetFileName?} lastWasReturn: boolean; {was the last character an eol?} lineStr: string[5]; {string form of __LINE__} ifList: ifPtr; {points to the top prep. parse record} includeChPtr: ptr; {chPtr at start of current token} includeCount: 0..maxint; {nested include files (for EndInclude)} macroFound: macroRecordPtr; {last macro found by IsDefined} needWriteLine: boolean; {is there a line that needs to be written?} numErr: 0..maxErr; {number of errors in this line} oneStr: string[2]; {string form of __STDC__} ispstring: boolean; {is the current string a p-string?} saveNumber: boolean; {save the characters in a number?} skipping: boolean; {skipping tokens?} timeStr: longStringPtr; {macro time string} tokenColumn: 0..maxint; {column number at start of this token} tokenLine: 0..maxint; {line number at start of this token} tokenList: tokenListRecordPtr; {token putback buffer} tokenStart: ptr; {pointer to the first char in the token} tokenEnd: ptr; {pointer to the first char past the token} versionStrL: longStringPtr; {macro version string} workString: pstring; {for building strings and identifiers} {-- External procedures; see expresssion evaluator for notes ---} procedure EndInclude (chPtr: ptr); extern; { Saves symbols created by the include file } { } { Parameters: } { chPtr - chPtr when the file returned } { } { Notes: } { 1. Call this subroutine right after processing an } { include file. } { 2. Fron Header.pas } procedure ExpandDevicesGS (var parms: expandDevicesDCBGS); prodos ($0154); procedure Expression (kind: expressionKind; stopSym: tokenSet); extern; { handle an expression } function FindSymbol (var tk: tokenType; class: spaceType; oneLevel: boolean; staticAllowed: boolean): identPtr; extern; { locate a symbol in the symbol table } { } { parameters: } { tk - token record for the identifier to find } { class - the kind of variable space to search } { oneLevel - search one level only? (used to check for } { duplicate symbols) } { staticAllowed - can we check for static variables? } { } { returns: } { A pointer to the symbol table entry is returned. If } { there is no entry, nil is returned. } procedure FlagPragmas (pragma: pragmas); extern; { record the effects of a pragma } { } { parameters: } { pragma - pragma to record } { } { Notes: } { 1. From Header.pas } procedure GetFileInfoGS (var parms: getFileInfoOSDCB); prodos ($2006); procedure StartInclude (name: gsosOutStringPtr); extern; { Marks the start of an include file } { } { Notes: } { 1. Call this subroutine right after opening an include } { file. } { 2. From Header.pas } {-- Scanner support --------------------------------------------} procedure CheckDelimiters (var name: pString); { Check for delimiters, making sure they are ':' } { } { parameters: } { name - path name to check } label 1; var dc: char; {delimiter character} i: 0..255; {loop/index variable} begin {CheckDelimiters} dc := ':'; {determine what the delimiter is} for i := 1 to length(name) do if name[i] in [':','/'] then begin dc := name[i]; goto 1; end; {if} 1: ; if dc = '/' then {replace '/' delimiters with ':'} for i := 1 to length(name) do if name[i] = '/' then name[i] := ':'; end; {CheckDelimiters} procedure AddPath (name: pString); { Add a path name to the path name table } { } { parameters: } { name - path name to add } var pp, ppe: pathRecordPtr; {work pointers} begin {AddPath} if length(name) <> 0 then begin CheckDelimiters(name); {make sure ':' is used} if name[length(name)] <> ':' then {make sure there is a trailing delimiter} name := concat(name, ':'); {create the new path record} pp := pathRecordPtr(GMalloc(sizeof(pathRecord))); pp^.next := nil; pp^.path := stringPtr(GMalloc(length(name)+1)); pp^.path^ := name; if pathList = nil then {add the path to the path list} pathList := pp else begin ppe := pathList; while ppe^.next <> nil do ppe := ppe^.next; ppe^.next := pp; end; {else} end; {if} end; {AddPath} function Convertsl(var str: pString): longint; extern; { Return the integer equivalent of the string. Assumes a valid } { 4-byte integer string; supporst unsigned values. } procedure SetDateTime; extern; { set up the macro date/time strings } function KeyPress: boolean; extern; { Has a key been presed? } { } { If a key has not been pressed, this function returns } { false. If a key has been pressed, it clears the key } { strobe. If the key was an open-apple ., a terminal exit } { is performed; otherwise, the function returns true. } function IsDefined {name: stringPtr): boolean}; { See if a macro name is in the macro table } { } { The returned value is true if the macro exists, else false. } { } { parameters: } { name - name of the macro to search for } { } { outputs: } { macroFound - pointer to the macro found } label 1; var bPtr: ^macroRecordPtr; {pointer to hash bucket} mPtr: macroRecordPtr; {for checking list of macros} begin {IsDefined} IsDefined := false; bPtr := pointer(ord4(macros) + Hash(name)); mPtr := bPtr^; while mPtr <> nil do begin if mPtr^.name^ = name^ then begin IsDefined := true; goto 1; end; {if} mPtr := mPtr^.next; end; {while} 1: macroFound := mPtr; end; {IsDefined} procedure PutBackToken {var token: tokenType; expandEnabled: boolean}; { place a token into the token stream } { } { parameters: } { token - token to put back into the token stream } { expandEnabled - can macro expansion be performed? } var tPtr: tokenListRecordPtr; {work pointer} begin {PutBackToken} new(tPtr); tPtr^.next := tokenList; tokenList := tPtr; tPtr^.token := token; tPtr^.expandEnabled := expandEnabled; tPtr^.tokenStart := tokenStart; tPtr^.tokenEnd := tokenEnd; end; {PutBackToken} procedure WriteLine; { Write the current character to the screen. } { } { Global Variables: } { firstPtr - points to the first char in the line } { chPtr - points to the end of line character } var cl: 0..maxint; {column number loop index} cp: ptr; {work pointer} i: 1..maxErr; {error loop index} msg: stringPtr; {pointer to the error message} begin {WriteLine} if list or (numErr <> 0) then begin write(lineNumber:4, ' '); {write the line #} cp := firstPtr; {write the characters in the line} while cp <> chPtr do begin if cp^ <> RETURN then write(chr(cp^)); cp := pointer(ord4(cp) + 1); end; {while} writeln; {write the end of line character} for i := 1 to numErr do {write any errors} with errors[i] do begin if line = lineNumber then begin for cl := 1 to col+4 do write(' '); write('^ '); end {if} else write(' Error in column ', col:1, ' of line ', line:1, ': '); case num of 1 : msg := @'illegal character'; 2 : msg := @'a character constant must contain exactly one character'; 3 : msg := @'no end was found to the string'; 4 : msg := @'further errors suppressed'; 5 : msg := @'cannot redefine a macro'; 6 : msg := @'integer overflow'; 7 : msg := @'''8'' and ''9'' cannot be used in octal constants'; 8 : msg := @'unknown preprocessor command'; 9 : msg := @'identifier expected'; 10: msg := @'cannot undefine standard macros'; 11: msg := @'end of line expected'; 12: msg := @''')'' expected'; 13: msg := @'''('' expected'; 14: msg := @'incorrect number of macro parameters'; 15: msg := @'''>'' expected'; 16: msg := @'file name is too long'; 17: msg := @'keep must appear before any functions'; 18: msg := @'integer constant expected'; 19: msg := @'only one #else may be used per #if'; 20: msg := @'there is no #if for this directive'; 21: msg := @'an #if had no closing #endif'; 22: msg := @''';'' expected'; 23: msg := @'''}'' expected'; 24: msg := @''']'' expected'; 25: msg := @'the else has no matching if'; 26: msg := @'type expected'; 27: msg := @'''{'' expected'; 28: msg := @'a function cannot be defined here'; 29: msg := @''':'' expected'; 30: msg := @'''while'' expected'; 31: msg := @'undeclared identifier'; 32: msg := @'the last if statement was not finished'; 33: msg := @'the last do statement was not finished'; 34: msg := @'the last compound statement was not finished'; 35: msg := @'expression expected'; 36: msg := @'expression syntax error'; 37: msg := @'operand expected'; 38: msg := @'operation expected'; 39: msg := @'no matching ''?'' found for this '':'' operator'; 40: msg := @'illegal type cast'; 41: msg := @'illegal operand in a constant expression'; 42: msg := @'duplicate symbol'; 43: msg := @'the function''s type must match the previous declaration'; 44: msg := @'too many initializers'; 45: msg := @'the number of array elements must be greater than 0'; 46: msg := @'you must initialize the individual elements of a struct, union, or non-char array'; 47: msg := @'type conflict'; 48: msg := @'pointer initializers must resolve to an integer, address or string'; 49: msg := @'the array size could not be determined'; 50: msg := @'only parameters or types may be declared here'; 51: msg := @'lint: undefined function'; 52: msg := @'you cannot initialize a type'; 53: msg := @'the structure has already been defined'; 54: msg := @'bit fields must be less than 32 bits wide'; 55: msg := @'a value cannot be zero bits wide'; 56: msg := @'unions cannot have bit fields'; 57: msg := @'compiler error'; 58: msg := @'implementation restriction: too many local labels'; 59: msg := @'file name expected'; 60: msg := @'implementation restriction: string space exhausted'; 61: msg := @'implementation restriction: run-time stack space exhausted'; 62: msg := @'auto or register can only be used in a function body'; 63: msg := @'token merging produced an illegal token'; 64: msg := @'assignment to an array is not allowed'; 65: msg := @'assignment to void is not allowed'; 66: msg := @'the operation cannot be performed on operands of the type given'; 67: msg := @'the last else clause was not finished'; 68: msg := @'the last while statement was not finished'; 69: msg := @'the last for statement was not finished'; 70: msg := @'the last switch statement was not finished'; 71: msg := @'switch expressions must evaluate to integers'; 72: msg := @'case and default labels must appear in a switch statement'; 73: msg := @'duplicate case label'; 74: msg := @'only one default label is allowed in a switch statement'; 75: msg := @'continue must appear in a while, do or for loop'; 76: msg := @'break must appear in a while, do, for or switch statement'; 77: msg := @'duplicate label'; 78: msg := @'l-value required'; 79: msg := @'illegal operand for the indirection operator'; 80: msg := @'the selection operator must be used on a structure or union'; 81: msg := @'the selected field does not exist in the structure or union'; 82: msg := @'''('', ''['' or ''*'' expected'; 83: msg := @'string constant expected'; 84: msg := @'''dynamic'' expected'; 85: msg := @'the number of parameters does not agree with the prototype'; 86: msg := @''','' expected'; 87: msg := @'invalid storage type for a parameter'; 88: msg := @'you cannot initialize a parameter'; 89: msg := @'''.'' expected'; 90: msg := @'string too long'; 91: msg := @'real constants cannot be unsigned'; 92: msg := @'statement expected'; 93: msg := @'assignment to const is not allowed'; 94: msg := @'pascal qualifier is only allowed on functions'; 95: msg := @'unidentified operation code'; 96: msg := @'incorrect operand size'; 97: msg := @'operand syntax error'; 98: msg := @'invalid operand'; 99: msg := @'comp data type is not supported by the 68881'; 100: msg := @'integer constants cannot use the f designator'; 101: msg := @'digits expected in the exponent'; {102: msg := @'extern variables cannot be initialized';} 103: msg := @'functions cannot return functions or arrays'; 104: msg := @'lint: missing function type'; 105: msg := @'lint: parameter list not prototyped'; 106: msg := @'cannot take the address of a bit field'; 107: msg := @'illegal use of forward declaration'; 108: msg := @'unknown cc= option on command line'; 109: msg := @'illegal math operation in a constant expression'; 110: msg := @'lint: unknown pragma'; 111: msg := @'the & operator cannot be applied to arrays'; 112: msg := @'segment buffer overflow'; 113: msg := @'all parameters must have a name'; 114: msg := @'a function call was made to a non-function'; otherwise: Error(57); end; {case} writeln(msg^); if terminalErrors then begin if enterEditor then ExitToEditor(msg, ord4(firstPtr)+col-ord4(bofPtr)-1) else TermError(0); end; {if} end; {with} {handle pauses} if ((numErr <> 0) and wait) or KeyPress then begin DrawHourglass; while not KeyPress do {nothing}; ClearHourglass; end; {if} numErr := 0; {no errors on next line...} end {if} else if KeyPress then begin {handle pauses} DrawHourglass; while not KeyPress do {nothing}; ClearHourglass; end; {if} Spin; {twirl the spinner} end; {WriteLine} procedure PrintToken (token: tokenType); { Write a token to standard out } { } { parameters: } { token - token to print } label 1; var ch: char; {work character} i: integer; {loop counter} procedure PrintHexDigit(i: integer); { Print a digit as a hex character } { } { Parameters: } { i: value to print in least significant 4 bits } begin {PrintHexDigit} i := i & $000F; if i < 10 then write(chr(i | ord('0'))) else write(chr(i + ord('A') - 10)); end; {PrintHexDigit} begin {PrintToken} case token.kind of typedef, ident: write(token.name^); intconst, uintconst: write(token.ival:1); longConst, ulongConst: write(token.lval:1); doubleConst: write(token.rval:1); stringConst: begin write('"'); for i := 1 to token.sval^.length do begin ch := token.sval^.str[i]; if ch in [' '..'~'] then write(ch) else begin write('\x0'); PrintHexDigit(ord(ch)>>4); PrintHexDigit(ord(ch)); end; {else} end; {for} write('"'); end; autosy,asmsy,breaksy,casesy,charsy, continuesy,constsy,compsy,defaultsy,dosy, doublesy,elsesy,enumsy,externsy,extendedsy, floatsy,forsy,gotosy,ifsy,intsy, inlinesy,longsy,pascalsy,registersy,returnsy, shortsy,sizeofsy,staticsy,structsy,switchsy, segmentsy,signedsy,typedefsy,unionsy,unsignedsy, voidsy,volatilesy,whilesy: write(reservedWords[token.kind]); tildech,questionch,lparench,rparench,lbrackch,rbrackch,lbracech, rbracech,commach,semicolonch,colonch,poundch: begin for i := minChar to maxChar do if charSym[i] = token.kind then begin write(chr(i)); goto 1; end; {if} end; minusch: write('-'); plusch: write('+'); ltch: write('<'); gtch: write('>'); eqch: write('='); excch: write('!'); andch: write('&'); barch: write('|'); percentch: write('%'); carotch: write('^'); asteriskch: write('*'); slashch: write('/'); dotch: write('.'); minusgtop: write('->'); opplusplus, plusplusop: write('++'); opminusminus, minusminusop: write('--'); ltltop: write('<<'); gtgtop: write('>>'); lteqop: write('<='); gteqop: write('>='); eqeqop: write('=='); exceqop: write('!='); andandop: write('&&'); barbarop: write('||'); pluseqop: write('+='); minuseqop: write('-='); asteriskeqop: write('*='); slasheqop: write('/='); percenteqop: write('%='); ltlteqop: write('<<='); gtgteqop: write('>>='); andeqop: write('&='); caroteqop: write('^='); bareqop: write('!='); uminus: write('-'); uand: write('+'); uasterisk: write('*'); macroParm: write('$', token.pnum:1); poundpoundop, parameteroper, castoper, eolsy, eofsy: ; end; {case} 1: write(' '); end; {PrintToken} { copy 'Scanner.debug'} {debug} {-- The Preprocessor -------------------------------------------} procedure CheckIdentifier; forward; { See if an identifier is a reserved word, macro or typedef } procedure DoNumber (scanWork: boolean); forward; { The current character starts a number - scan it } { } { Parameters: } { scanWork - get characters from workString? } { } { Globals: } { ch - first character in sequence; set to first char } { after sequence } { workString - string to take numbers from } function GetFileType (var name: pString): integer; forward; { Checks to see if a file exists } { } { parameters: } { name - file name to check for } { } { Returns: File type if the file exists, or -1 if the file does } { not exist (or if GetFileInfo returns an error) } function OpenFile (doInclude, default: boolean): boolean; forward; { Open a new file and start scanning it } { } { Parameters: } { doInclude - are we doing a #include? } { default - use the name ? } { } { Returns: result from GetFileName } function FindMacro (name: stringPtr): macroRecordPtr; { If the current token is a macro, find the macro table entry } { } { Parameters: } { name - name of the suspected macro } { } { Returns: } { Pointer to macro table entry; nil for none } label 1; var bPtr: ^macroRecordPtr; {pointer to hash bucket} mPtr: macroRecordPtr; {pointer to macro entry} begin {FindMacro} FindMacro := nil; bPtr := pointer(ord4(macros)+Hash(name)); mPtr := bPtr^; while mPtr <> nil do begin if mPtr^.name^ = name^ then begin if mPtr^.parameters = -1 then FindMacro := mPtr else if tokenList = nil then begin while charKinds[ord(ch)] in [ch_white, ch_eol] do begin if printMacroExpansions then if charKinds[ord(ch)] = ch_eol then writeln else write(ch); NextCh; end; {while} if ch = '(' then FindMacro := mPtr; end {else if} else if tokenList^.token.kind = lparench then FindMacro := mPtr; goto 1; end; {if} mPtr := mPtr^.next; end; {while} 1: end; {FindMacro} procedure LongToPString (pstr: stringPtr; lstr: longStringPtr); { Convert a long string into a p string } { } { Parameters: } { pstr - pointer to the p-string } { lstr - pointer to the long string } var i: integer; {loop variable} len: integer; {string length} begin {LongToPString} len := lstr^.length; if len > 255 then len := 255; pstr^[0] := chr(len); for i := 1 to len do pstr^[i] := lstr^.str[i]; end; {LongToPString} procedure Merge (var tk1: tokenType; tk2: tokenType); { Merge two tokens } { } { Parameters: } { tk1 - first token; result is stored here } { tk2 - second token } label 1; var class1,class2: tokenClass; {token classes} cp: longstringPtr; {pointer to work string} i: integer; {loop variable} kind1,kind2: tokenEnum; {token kinds} len,len1: integer; {length of strings} lt: tokenType; {local copy of token} str1,str2: stringPtr; {identifier strings} begin {Merge} kind1 := tk1.kind; class1 := tk1.class; kind2 := tk2.kind; class2 := tk2.class; if class1 in [identifier,reservedWord] then begin if class1 = identifier then str1 := tk1.name else str1 := @reservedWords[kind1]; if class2 = identifier then str2 := tk2.name else if class2 = reservedWord then str2 := @reservedWords[kind2] else if class2 in [intConstant,longConstant,doubleConstant] then str2 := tk2.numString else begin Error(63); goto 1; end; {else} workString := concat(str1^, str2^); for i := 1 to length(workString) do if not (charKinds[ord(workString[i])] in [letter,digit]) then begin Error(63); goto 1; end; {if} lt := token; token.kind := ident; token.class := identifier; token.numString := nil; token.name := @workString; token.symbolPtr := nil; CheckIdentifier; tk1 := token; token := lt; goto 1; end {class1 in [identifier,reservedWord]} else if class1 in [intConstant,longConstant,doubleConstant] then begin if class2 in [intConstant,longConstant,doubleConstant] then str2 := tk2.numString else if class2 = identifier then str2 := tk2.name else if class2 = reservedWord then str2 := @reservedWords[kind2] else if kind2 = dotch then str2 := @'.' else begin Error(63); goto 1; end; {else} workString := concat(tk1.numString^, str2^); lt := token; DoNumber(true); tk1 := token; token := lt; goto 1; end {else if class1 in [intConstant,longConstant,doubleConstant]} else if class1 = stringConstant then begin if class2 = stringConstant then begin len1 := tk1.sval^.length; len := len1+tk2.sval^.length; cp := pointer(Malloc(len+2)); for i := 1 to len1 do cp^.str[i] := tk1.sval^.str[i]; for i := 1 to len-len1 do cp^.str[i+len1] := tk2.sval^.str[i]; cp^.length := len; if tk1.ispstring then cp^.str[1] := chr(len-1); tk1.sval := cp; goto 1; end; {if} end {else if} else if kind1 = dotch then begin if class2 in [intConstant,longConstant,doubleConstant] then begin workString := concat(tk1.numString^, tk2.numString^); lt := token; DoNumber(true); tk1 := token; token := lt; goto 1; end; {if} end {else if class1 in [intConstant,longConstant,doubleConstant]} else if kind1 = poundch then begin if kind2 = poundch then begin tk1.kind := poundpoundop; goto 1; end; {if} end {else if} else if kind1 = minusch then begin if kind2 = gtch then begin tk1.kind := minusgtop; goto 1; end {if} else if kind2 = minusch then begin tk1.kind := minusminusop; goto 1; end {else if} else if kind2 = eqch then begin tk1.kind := minuseqop; goto 1; end; {else if} end {else if} else if kind1 = plusch then begin if kind2 = plusch then begin tk1.kind := plusplusop; goto 1; end {else if} else if kind2 = eqch then begin tk1.kind := pluseqop; goto 1; end; {else if} end {else if} else if kind1 = ltch then begin if kind2 = ltch then begin tk1.kind := ltltop; goto 1; end {if} else if kind2 = lteqop then begin tk1.kind := ltlteqop; goto 1; end {else if} else if kind2 = eqch then begin tk1.kind := lteqop; goto 1; end; {else if} end {else if} else if kind1 = ltltop then begin if kind2 = eqch then begin tk1.kind := ltlteqop; goto 1; end; {if} end {else if} else if kind1 = gtch then begin if kind2 = gtch then begin tk1.kind := gtgtop; goto 1; end {if} else if kind2 = gteqop then begin tk1.kind := gtgteqop; goto 1; end {else if} else if kind2 = eqch then begin tk1.kind := gteqop; goto 1; end; {else if} end {else if} else if kind1 = gtgtop then begin if kind2 = eqch then begin tk1.kind := gtgteqop; goto 1; end; {if} end {else if} else if kind1 = eqch then begin if kind2 = eqch then begin tk1.kind := eqeqop; goto 1; end; {if} end {else if} else if kind1 = excch then begin if kind2 = eqch then begin tk1.kind := exceqop; goto 1; end; {if} end {else if} else if kind1 = andch then begin if kind2 = andch then begin tk1.kind := andandop; goto 1; end {if} else if kind2 = eqch then begin tk1.kind := andeqop; goto 1; end; {else if} end {else if} else if kind1 = barch then begin if kind2 = barch then begin tk1.kind := barbarop; goto 1; end {if} else if kind2 = eqch then begin tk1.kind := bareqop; goto 1; end; {else if} end {else if} else if kind1 = percentch then begin if kind2 = eqch then begin tk1.kind := percenteqop; goto 1; end; {if} end {else if} else if kind1 = carotch then begin if kind2 = eqch then begin tk1.kind := caroteqop; goto 1; end; {if} end {else if} else if kind1 = asteriskch then begin if kind2 = eqch then begin tk1.kind := asteriskeqop; goto 1; end; {if} end {else if} else if kind1 = slashch then begin if kind2 = eqch then begin tk1.kind := slasheqop; goto 1; end; {if} end; {else if} Error(63); 1: end; {Merge} procedure BuildStringToken (cp: ptr; len: integer); { Create a string token from a string } { } { Used to stringize macros. } { } { Parameters: } { cp - pointer to the first character } { len - number of characters in the string } var i: integer; {loop variable} begin {BuildStringToken} token.kind := stringconst; token.class := stringConstant; token.ispstring := false; token.sval := pointer(GMalloc(len+2)); for i := 1 to len do begin token.sval^.str[i] := chr(cp^); cp := pointer(ord4(cp)+1); end; {for} token.sval^.length := len; PutBackToken(token, true); end; {BuildStringToken} procedure DoInclude (default: boolean); { #include } { } { Parameters: } { default - open ? } var fp: filePtr; {pointer to an include file} begin {DoInclude} new(fp); {get a file record for the current file} fp^.next := fileList; fileList := fp; fp^.name := includeFileGS; fp^.sname := sourceFileGS; fp^.lineNumber := lineNumber+1; if OpenFile(true, default) then begin {open a new file and proceed from there} lineNumber := 1; StartInclude(@includeFileGS); end {if} else begin {handle a file name error} fileList := fp^.next; dispose(fp); end; {else} end; {DoInclude} procedure Expand (macro: macroRecordPtr); { Expand a preprocessor macro } { } { Expands a preprocessor macro by putting tokens from the macro } { definition into the scanner's putback buffer. } { } { Parameters: } { macro - pointer to the macro to expand } { } { Globals: } { macroList - scanner putback buffer } type parameterPtr = ^parameterRecord; parameterRecord = record {parameter list element} next: parameterPtr; {next parameter} tokens: tokenListRecordPtr; {token list} tokenStart,tokenEnd: ptr; {source pointers (for stringization)} end; var bPtr: ^macroRecordPtr; {pointer to hash bucket} done: boolean; {used to check for loop termination} expandEnabled: boolean; {can the token be expanded?} i: integer; {loop counter} inhibit: boolean; {inhibit parameter expansion?} lexpandMacros: boolean; {local copy of expandMacros} lPrintMacroExpansions: boolean; {local copy of printMacroExpansions} mPtr: macroRecordPtr; {for checking list of macros} newParm: parameterPtr; {for building a new parameter entry} tlPtr, tPtr, tcPtr, lastPtr: tokenListRecordPtr; {work pointers} paramCount: integer; {# of parameters found in the invocation} parenCount: integer; {paren count; for balancing parenthesis} parmEnd: parameterPtr; {for building a parameter list} parms: parameterPtr; {points to the list of parameters} pptr: parameterPtr; {work pointer for tracing parms list} sp: longStringPtr; {work pointer} stringization: boolean; {are we stringizing a parameter?} begin {Expand} lPrintMacroExpansions := printMacroExpansions; {inhibit token printing} printMacroExpansions := false; lexpandMacros := expandMacros; {prevent expansion of parameters} expandMacros := false; saveNumber := true; {save numeric strings} parms := nil; {no parms so far} if macro^.parameters >= 0 then begin {find the values of the parameters} NextToken; {get the '(' (we hope...)} if token.kind = lparench then begin NextToken; {skip the '('} paramCount := 0; {process the parameters} parmEnd := nil; repeat done := true; if token.kind <> rparench then begin parenCount := 0; paramCount := paramCount+1; new(newParm); newParm^.next := nil; if parmEnd = nil then parms := newParm else parmEnd^.next := newParm; parmEnd := newParm; newParm^.tokens := nil; while (token.kind <> eofsy) and ((parenCount <> 0) or (not (token.kind in [rparench,commach]))) do begin new(tPtr); tPtr^.next := newParm^.tokens; newParm^.tokens := tPtr; tPtr^.token := token; tPtr^.tokenStart := tokenStart; tPtr^.tokenEnd := tokenEnd; if token.kind = lparench then parenCount := parenCount+1 else if token.kind = rparench then parenCount := parenCount-1; NextToken; end; {while} if token.kind = commach then begin NextToken; done := false; end; {if} end; {if} until done; if paramCount <> macro^.parameters then Error(14); if token.kind = rparench then {insist on a closing ')'} begin if not gettingFileName then NextToken end {if} else Error(12); end {if} else Error(13); if not gettingFileName then {put back the source stream token} PutBackToken(token, true); end; {if} if macro^.readOnly then begin {handle special macros} case macro^.algorithm of 1: begin {__LINE__} token.kind := intconst; token.numString := @lineStr; token.class := intconstant; token.ival := lineNumber; lineStr := cnvis(token.ival); tokenStart := @lineStr[1]; tokenEnd := pointer(ord4(tokenStart)+length(lineStr)); end; 2: begin {__FILE__} token.kind := stringConst; token.class := stringConstant; token.ispstring := false; sp := pointer(Malloc(5+sourceFileGS.theString.size)); sp^.length := sourceFileGS.theString.size; for i := 1 to sourceFileGS.theString.size do sp^.str[i] := sourceFileGS.theString.theString[i]; token.sval := sp; tokenStart := @sp^.str; tokenEnd := pointer(ord4(tokenStart)+sp^.length); end; 3: begin {__DATE__} token.kind := stringConst; token.class := stringConstant; token.ispstring := false; token.sval := dateStr; tokenStart := @dateStr^.str; tokenEnd := pointer(ord4(tokenStart)+dateStr^.length); end; 4: begin {__TIME__} token.kind := stringConst; token.class := stringConstant; token.ispstring := false; token.sval := timeStr; tokenStart := @timeStr^.str; tokenEnd := pointer(ord4(tokenStart)+timeStr^.length); end; 5: begin {__STDC__} token.kind := intConst; {__ORCAC__} token.numString := @oneStr; token.class := intConstant; token.ival := 1; oneStr := '1'; tokenStart := @oneStr[1]; tokenEnd := pointer(ord4(tokenStart)+1); end; 6: begin {__VERSION__} token.kind := stringConst; token.class := stringConstant; token.ispstring := false; token.sval := versionStrL; tokenStart := @versionStrL^.str; tokenEnd := pointer(ord4(tokenStart)+versionStrL^.length); end; otherwise: Error(57); end; {case} PutBackToken(token, true); end {if} else begin {expand the macro} tlPtr := macro^.tokens; {place the tokens in the buffer...} lastPtr := nil; while tlPtr <> nil do begin if tlPtr^.token.kind = macroParm then begin pptr := parms; {find the correct parameter} for i := 1 to tlPtr^.token.pnum do if pptr <> nil then pptr := pptr^.next; if pptr <> nil then begin {see if the macro is stringized} stringization := false; if tlPtr^.next <> nil then stringization := tlPtr^.next^.token.kind = poundch; {handle macro stringization} if stringization then begin tcPtr := pptr^.tokens; while tcPtr <> nil do begin if tcPtr^.token.kind = stringconst then BuildStringToken(@tcPtr^.token.sval^.str, tcPtr^.token.sval^.length) else BuildStringToken(tcPtr^.tokenStart, ord(ord4(tcPtr^.tokenEnd)-ord4(tcPtr^.tokenStart))); tcPtr := tcPtr^.next; end; {while} tlPtr := tlPtr^.next; end {if} {expand a macro parameter} else begin tcPtr := pptr^.tokens; while tcPtr <> nil do begin tokenStart := tcPtr^.tokenStart; tokenEnd := tcPtr^.tokenEnd; if tcPtr^.token.kind = ident then begin mPtr := FindMacro(tcPtr^.token.name); inhibit := false; if tlPtr^.next <> nil then if tlPtr^.next^.token.kind = poundpoundop then inhibit := true; if lastPtr <> nil then if lastPtr^.token.kind = poundpoundop then inhibit := true; if (mPtr <> nil) and (not inhibit) then Expand(mPtr) else PutBackToken(tcPtr^.token, true); end {if} else PutBackToken(tcPtr^.token, true); tcPtr := tcPtr^.next; end; {while} end; {else} end; {if pptr <> nil} end {if tlPtr^.token.kind = macroParm} else begin {place an explicit parm in the token list} expandEnabled := true; if tlPtr^.token.kind = ident then if tlPtr^.token.name^ = macro^.name^ then expandEnabled := false; tokenStart := tlPtr^.tokenStart; tokenEnd := tlPtr^.tokenEnd; PutBackToken(tlPtr^.token, expandEnabled); end; {else} lastPtr := tlPtr; tlPtr := tlPtr^.next; end; {while} end; {else} while parms <> nil do begin {dispose of the parameter list} tPtr := parms^.tokens; while tPtr <> nil do begin tlPtr := tPtr^.next; dispose(tPtr); tPtr := tlPtr; end; {while} parmEnd := parms^.next; dispose(parms); parms := parmEnd; end; {while} expandMacros := lexpandMacros; {restore the flags} printMacroExpansions := lPrintMacroExpansions; saveNumber := false; {stop saving numeric strings} end; {Expand} function GetFileName (mustExist: boolean): boolean; { Read a file name from a directive line } { } { parameters: } { mustExist - should we look for an existing file? } { } { Returns true if successful, false if not. } { } { Note: The file name is placed in workString. } const SRC = $B0; {source file type} var i,j: integer; {string index & loop vars} procedure Expand (var name: pString); { Expands a name to a full pathname } { } { parameters: } { name - file name to expand } var exRec: expandDevicesDCBGS; {expand devices} begin {Expand} exRec.pcount := 2; new(exRec.inName); exRec.inName^.theString := name; exRec.inName^.size := length(name); new(exRec.outName); exRec.outName^.maxSize := maxPath+4; ExpandDevicesGS(exRec); if toolerror = 0 then with exRec.outName^.theString do begin if size < maxPath then theString[size+1] := chr(0); name := theString; end; {with} dispose(exRec.inName); dispose(exRec.outName); end; {Expand} function GetLibraryName (var name: pstring): boolean; { See if a library pathname is available } { } { Parameters: } { name - file name; set to pathname if result is true } { } { Returns: True if a name is available, else false } var lname: pString; {local copy of name} begin {GetLibraryName} lname := concat('13:ORCACDefs:', name); Expand(lname); if GetFileType(lname) = SRC then begin name := lname; GetLibraryName := true; end {if} else GetLibraryName := false; end; {GetLibraryName} function GetLocalName (var name: pstring): boolean; { See if a local pathname is available } { } { Parameters: } { name - file name; set to pathname if result is true } { } { Returns: True if a name is available, else false } var lname: pstring; {work string} pp: pathRecordPtr; {used to trace the path list} begin {GetLocalName} lname := name; Expand(lname); if GetFileType(lname) = SRC then begin GetLocalName := true; name := lname; end {if} else begin GetLocalName := false; pp := pathList; while pp <> nil do begin lname := concat(pp^.path^, name); if GetFileType(lname) = SRC then begin GetLocalName := true; name := lname; Expand(name); pp := nil; end {if} else pp := pp^.next; end; {while} end; {else} end; {GetLocalName} procedure MakeLibraryName (var name: pstring); { Create the library path name for an error message } { } { Parameters: } { name - file name; set to pathname } begin {MakeLibraryName} name := concat('13:ORCACDefs:', name); Expand(name); end; {MakeLibraryName} procedure MakeLocalName (var name: pstring); { Create the local path name for an error message } { } { Parameters: } { name - file name; set to pathname } begin {MakeLocalName} Expand(name); end; {MakeLocalName} begin {GetFileName} GetFileName := true; gettingFileName := true; {in GetFileName} while charKinds[ord(ch)] = ch_white do {finish processing the current line} NextCh; if ch = '<' then begin {process a library file...} NextToken; {skip the '<'} token.kind := stringconst; {convert a <> style name to a string} token.class := stringConstant; token.ispstring := false; i := 0; while not (charKinds[ord(ch)] in [ch_eol,ch_gt]) do begin i := i+1; if (i = maxLine) then begin Error(16); GetFileName := false; i := 0; end; workString[i] := ch; NextCh; end; {while} workString[0] := chr(i); CheckDelimiters(workString); if mustExist then begin if not GetLibraryName(workString) then if not GetLocalName(workString) then MakeLibraryName(workString); end {if} else MakeLibraryName(workString); if ch = '>' then NextCh else begin Error(15); GetFileName := false; end; {else} end {if} else begin {handle file names that are strings or macro expansions} expandMacros := true; {allow macros to be used in the name} NextToken; {skip the command name} if token.kind = stringConst then begin LongToPString(@workString, token.sval); CheckDelimiters(workString); if mustExist then begin if not GetLocalName(workString) then if not GetLibraryName(workString) then MakeLocalName(workString); end {if} else MakeLocalName(workString); end {if} else if token.kind = ltch then begin {expand a macro to create a form name} NextToken; workString[0] := chr(0); while (token.class in [reservedWord,intconstant,longconstant,doubleconstant]) or (token.kind in [dotch,ident]) do begin if token.kind = ident then workstring := concat(workstring, token.name^) else if token.kind = dotch then workstring := concat(workstring, '.') else if token.class = reservedWord then workstring := concat(workstring, reservedWords[token.kind]) else {if token.class in [intconst,longconst,doubleconst] then} workstring := concat(workstring, token.numstring^); NextToken; end; {while} CheckDelimiters(workString); if mustExist then begin if not GetLibraryName(workString) then if not GetLocalName(workString) then MakeLibraryName(workString); end {if} else MakeLibraryName(workString); if token.kind <> gtch then begin Error(15); GetFileName := false; end; {if} end {else if} else begin Error(59); GetFileName := false; end; {else} end; {else} while charKinds[ord(ch)] = ch_white {finish processing the current line} do NextCh; if charKinds[ord(ch)] <> ch_eol then {check for extra stuff on the line} begin Error(11); GetFileName := false; end; {if} gettingFileName := false; {not in GetFileName} end; {GetFileName} function GetFileType {var name: pString): integer}; { Checks to see if a file exists } { } { parameters: } { name - file name to check for } { } { Returns: File type if the file exists, or -1 if the file does } { not exist (or if GetFileInfo returns an error) } var pathname: gsosInString; {GS/OS style name} giRec: getFileInfoOSDCB; {GetFileInfo record} begin {GetFileType} giRec.pcount := 3; giRec.pathName := @pathname; pathname.theString := name; pathname.size := length(name); GetFileInfoGS(giRec); if ToolError = 0 then GetFileType := giRec.fileType else GetFileType := -1; end; {GetFileType} function OpenFile {doInclude, default: boolean): boolean}; { Open a new file and start scanning it } { } { Parameters: } { doInclude - are we doing a #include? } { default - use the name ? } { } { Returns: result from GetFileName } var gotName: boolean; {did we get a file name?} begin {OpenFile} if default then begin {get the file name} workString := defaultName; gotName := true; end {if} else gotName := GetFileName(true); if gotName then begin {read the file name from the line} OpenFile := true; {we opened it} if doInclude and progress then {note our progress} writeln('Including ', workString); WriteLine; {write the source line} lineNumber := lineNumber+1; firstPtr := pointer(ord4(chPtr)+2); needWriteLine := false; if doInclude then {set the disp in the file} fileList^.disp := ord4(chPtr)-ord4(bofPtr); with ffDCBGS do begin {purge the source file} pCount := 5; action := 7; pathName := @includeFileGS.theString; end; {with} FastFileGS(ffDCBGS); oldincludeFileGS := includeFileGS; {set the file name} includeFileGS.theString.theString := workString; includeFileGS.theString.size := length(workString); ReadFile; {read the file} chPtr := bofPtr; {set the start, end pointers} eofPtr := pointer(ord4(bofPtr)+ffDCBGS.fileLength); firstPtr := chPtr; {first char in line} ch := chr(RETURN); {set the initial character} if languageNumber <> long(ffDCBGS.auxType).lsw then begin switchLanguages := true; {switch languages} chPtr := eofPtr; if doInclude then TermError(7); if fileList <> nil then TermError(8); end; {if} end {if} else OpenFile := false; {we failed to opened it} end; {OpenFile} procedure PreProcess; { Handle preprocessor commands } label 2; var lPrintMacroExpansions: boolean; {local copy of printMacroExpansions} lReportEOL: boolean; {local copy of reportEOL} tSkipping: boolean; {temp copy of the skipping variable} val: integer; {expression value} function Defined: boolean; { See if a macro is defined } begin {Defined} expandMacros := false; {block expansions} NextToken; {skip the command name} if token.class in [reservedWord,identifier] then begin Defined := IsDefined(token.name); {see if the macro is defined} expandMacros := true; {enable expansions} NextToken; {skip the macro name} if token.kind <> eolsy then {check for extra stuff on the line} Error(11); end {if} else Error(9); end; {Defined} procedure NumericDirective; { Process a constant expression for a directive that has a } { single number as the operand. } { } { Notes: The expression evaluator returns the value in the } { global variable expressionValue. } begin {NumericDirective} NextToken; {skip the directive name} Expression(preprocessorExpression, []); {evaluate the expression} end; {NumericDirective} procedure ProcessIf (skip: boolean); { handle the processing for #if, #ifdef and #ifndef } { } { parameter: } { skip - should we skip to the #else } var ip: ifPtr; {used to create a new if record} begin {ProcessIf} if token.kind <> eolsy then {check for extra stuff on the line} Error(11); new(ip); {create a new if record} ip^.next := ifList; ifList := ip; if tSkipping then {set the status of the record} ip^.status := skippingToEndif else if skip then ip^.status := skippingToElse else ip^.status := processing; ip^.elseFound := false; {no else has been found...} tSkipping := ip^.status <> processing; {decide if we should be skipping} end; {ProcessIf} procedure DoAppend; { #append } var tbool: boolean; {temp boolean} begin {DoAppend} tbool := OpenFile(false, false); {open a new file and proceed from there} lineNumber := 1; end; {DoAppend} procedure DoCDA; { #pragma cda NAME START SHUTDOWN } begin {DoCDA} FlagPragmas(p_cda); isClassicDeskAcc := true; NextToken; {skip the command name} if token.kind = stringconst then {get the name} begin LongToPString(@menuLine, token.sval); NextToken; end {if} else begin isClassicDeskAcc := false; Error(83); end; {else} if token.kind = ident then begin {get the start name} openName := token.name; NextToken; end {if} else begin isClassicDeskAcc := false; Error(9); end; {else} if token.kind = ident then begin {get the shutdown name} closeName := token.name; NextToken; end {if} else begin isClassicDeskAcc := false; Error(9); end; {else} if token.kind <> eolsy then {make sure there is nothing else on the line} Error(11); end; {DoCDA} procedure DoCDev; { #pragma cdev START } begin {DoCDev} FlagPragmas(p_cdev); isCDev := true; NextToken; {skip the command name} if token.kind = ident then begin {get the start name} openName := token.name; NextToken; end {if} else begin isCDev := false; Error(9); end; {else} if token.kind <> eolsy then {make sure there is nothing else on the line} Error(11); end; {DoCDev} procedure DoDefine; { #define } { } { The way parameters are handled is a bit obtuse. Parameters } { have their own token type, with the token having an } { associated parameter number, pnum. Pnum is the number of } { parameters to skip to get to the parameter in the parameter } { list. } { } { In the macro record, parameters indicates how many } { parameters there are in the definition. -1 indicates that } { there is no parameter list, while 0 indicates that a list } { must exist, but that there are no parameters in the list. } label 1,2,3; type stringListPtr = ^stringList; stringList = record {for the parameter list} next: stringListPtr; str: pString; end; var bPtr: ^macroRecordPtr; {pointer to head of hash bucket} done: boolean; {used to test for loop termination} i: integer; {loop variable} mf: macroRecordPtr; {pointer to existing macro record} mPtr: macroRecordPtr; {pointer to new macro record} np: stringListPtr; {new parameter} parameterList: stringListPtr; {list of parameter names} parameters: integer; {local copy of mPtr^.parameters} ple: stringListPtr; {pointer to the last element in parameterList} pnum: integer; {for counting parameters} tPtr,tk1,tk2: tokenListRecordPtr; {pointer to a token} {for building token strings} sptr: longStringPtr; {token string work pointer} tcp: ptr; {temp character pointer} slen: integer; {token string length} begin {DoDefine} expandMacros := false; {block expansions} saveNumber := true; {save characters in numeric tokens} parameterList := nil; {no parameters yet} NextToken; {get the token name} {convert reserved words to identifiers} if token.class = reservedWord then begin token.name := @reservedWords[token.kind]; token.kind := ident; token.class := identifier; end {if} else if token.kind = typedef then token.kind := ident; if token.kind = ident then begin {we have a name...} mPtr := pointer(GMalloc(sizeof(macroRecord))); {create a macro record} mPtr^.name := token.name; {record the name} mPtr^.saved := false; {not saved in symbol file} mPtr^.tokens := nil; {no tokens yet} charKinds[ord('#')] := ch_pound; {allow # as a token} if ch = '(' then begin {scan the parameter list...} NextToken; {done with the name token...} NextToken; {skip the opening '('} parameters := 0; {no parameters yet} ple := nil; repeat {get the parameter names} done := true; if token.class = reservedWord then begin token.name := @reservedWords[token.kind]; token.kind := ident; token.class := identifier; end {if} else if token.kind = typedef then token.kind := ident; if token.kind = ident then begin new(np); np^.next := nil; np^.str := token.name^; if ple = nil then parameterList := np else ple^.next := np; ple := np; NextToken; parameters := parameters+1; if token.kind = commach then begin NextToken; done := false; end; {if} end; {if} until done; if token.kind = rparench then {insist on a matching ')'} NextToken else Error(12); end {if} else begin parameters := -1; {no parameter list exists} NextToken; {done with the name token...} end; {else} mPtr^.parameters := parameters; {record the # of parameters} while token.kind <> eolsy do begin {place tokens in the replace list...} if token.class = reservedWord then begin token.name := @reservedWords[token.kind]; token.kind := ident; token.class := identifier; end {if} else if token.kind = typedef then token.kind := ident; if token.kind = ident then begin {special handling for identifiers} np := parameterList; {change parameters to macroParm} pnum := 0; while np <> nil do begin if np^.str = token.name^ then begin token.kind := macroParm; token.class := macroParameter; token.pnum := pnum; goto 1; end; {if} pnum := pnum+1; np := np^.next; end; {while} end; {if} 1: tPtr := pointer(GMalloc(sizeof(tokenListRecord))); tPtr^.next := mPtr^.tokens; mPtr^.tokens := tPtr; tPtr^.token := token; tPtr^.tokenStart := tokenStart; tPtr^.tokenEnd := tokenEnd; slen := ord(ord4(chPtr) - ord4(tokenStart)); sptr := pointer(GMalloc(slen+2)); sptr^.length := slen; tcp := tokenStart; for i := 1 to slen do begin sptr^.str[i] := chr(tcp^); tcp := pointer(ord4(tcp)+1); end; {for} tPtr^.tokenString := sptr; NextToken; end; {while} mPtr^.readOnly := false; mPtr^.algorithm := 0; if IsDefined(mPtr^.name) then begin mf := macroFound; if mf^.parameters = mPtr^.parameters then begin tk1 := mf^.tokens; tk2 := mPtr^.tokens; while (tk1 <> nil) and (tk2 <> nil) do begin if tk1^.token.kind <> tk2^.token.kind then goto 3; if tk1^.token.class = tk2^.token.class then case tk1^.token.class of reservedWord, reservedSymbol: ; identifier: if tk1^.token.name^ <> tk2^.token.name^ then goto 3; intConstant: if tk1^.token.ival <> tk2^.token.ival then goto 3; longConstant: if tk1^.token.lval <> tk2^.token.lval then goto 3; doubleConstant: if tk1^.token.rval <> tk2^.token.rval then goto 3; stringConstant: begin if tk1^.token.sval^.length <> tk2^.token.sval^.length then goto 3; for i := 1 to tk1^.token.sval^.length do if tk1^.token.sval^.str[i] <> tk2^.token.sval^.str[i] then goto 3; end; macroParameter: if tk1^.token.pnum <> tk2^.token.pnum then goto 3; otherwise: Error(57); end; {case} tk1 := tk1^.next; tk2 := tk2^.next; end; {while} if (tk1 = nil) and (tk2 = nil) then goto 2; end; {if} 3: Error(5); goto 2; end; {if} {insert the macro in the macro list} bPtr := pointer(ord4(macros) + Hash(mPtr^.name)); mPtr^.next := bPtr^; bPtr^ := mPtr; end {if} else Error(9); {identifier expected} 2: expandMacros := true; {enable expansions} while parameterList <> nil do begin {dump the parameter names} np := parameterList; parameterList := np^.next; dispose(np); end; {while} charKinds[ord('#')] := illegal; {don't allow # as a token} saveNumber := false; {stop saving numeric strings} end; {DoDefine} procedure DoElif; { #elif expression } var ip: ifPtr; {temp; for efficiency} begin {DoElif} ip := ifList; if ip <> nil then begin {decide if we should be skipping} tSkipping := ip^.status <> skippingToElse; if tSkipping then ip^.status := skippingToEndif else begin {evaluate the condition} NumericDirective; {evaluate the condition} if token.kind <> eolsy then {check for extra stuff on the line} Error(11); if expressionValue = 0 then ip^.status := skippingToElse else ip^.status := processing; tSkipping := ip^.status <> processing; {decide if we should be skipping} end; {else} end else Error(20); end; {DoElif} procedure DoElse; { #else } begin {DoElse} NextToken; {skip the command name} if token.kind <> eolsy then {check for extra stuff on the line} Error(11); if ifList <> nil then begin if ifList^.elseFound then {check for multiple elses} Error(19) else ifList^.elseFound := true; {decide if we should be skipping} tSkipping := ifList^.status <> skippingToElse; if tSkipping then {set the status} ifList^.status := skippingToEndif else ifList^.status := processing; end else Error(20); end; {DoElse} procedure DoEndif; { #endif } var ip: ifPtr; {used to create a new if record} begin {DoEndif} NextToken; {skip the command name} if token.kind <> eolsy then {check for extra stuff on the line} Error(11); if ifList <> nil then begin ip := ifList; {remove the top if record from the list} ifList := ip^.next; dispose(ip); if ifList = nil then {decide if we should be skipping} tSkipping := false else tSkipping := ifList^.status <> processing; end {if} else Error(20); end; {DoEndif} procedure DoError; { #error STRING } var i: integer; {loop variable} len: integer; {string length} msg: stringPtr; {error message ptr} begin {DoError} NextToken; {skip the command name} if token.kind = stringConst then begin numErrors := numErrors+1; new(msg); len := token.sval^.length; if len > 246 then len := 246; msg^ := '#error: '; for i := 1 to len do msg^ := concat(msg^, token.sval^.str[i]); writeln(msg^); if terminalErrors then begin if enterEditor then ExitToEditor(msg, ord4(firstPtr)-ord4(bofPtr)) else TermError(0); end; {if} end {if} else Error(83); NextToken; {skip the command name} if token.kind <> eolsy then {check for extra stuff on the line} Error(11); end; {DoError} procedure DoFloat; { #pragma float NUMBER NUMBER } begin {DoFloat} FlagPragmas(p_float); NextToken; if token.kind in [intconst,uintconst] then begin floatCard := token.ival; NextToken; end {if} else Error(18); if token.kind in [intconst,uintconst] then begin floatSlot := $C080 | (token.ival << 4); NextToken; end {if} else Error(18); end; {DoFloat} procedure DoKeep; { #pragma keep FILENAME } begin {DoKeep} FlagPragmas(p_keep); if GetFileName(false) then begin {read the file name} if foundFunction then Error(17); if liDCBGS.kFlag = 0 then begin {use the old name if there is one...} liDCBGS.kFlag := 1; outFileGS.theString.theString := workString; outFileGS.theString.size := length(workString); end; {if} end; {if} end; {DoKeep} procedure DoNBA; { #pragma nba MAIN } begin {DoNBA} FlagPragmas(p_nba); isNBA := true; NextToken; {skip the command name} if token.kind = ident then begin {get the open name} openName := token.name; NextToken; end {if} else begin isNBA := false; Error(9); end; {else} if token.kind <> eolsy then {make sure there is nothing else on the line} Error(11); end; {DoNBA} procedure DoNDA; { #pragma nda OPEN CLOSE ACTION INIT PERIOD EVENTMASK MENULINE} function GetInteger: integer; { Get a signed integer constant } var isNegative: boolean; {is the value negative?} value: integer; {value to return} begin {GetInteger} isNegative := false; value := 0; if token.kind = plusch then NextToken else if token.kind = minusch then begin NextToken; isNegative := true; end; {else if} if token.kind in [intconst,uintconst] then begin value := token.ival; NextToken; end {if} else begin isNewDeskAcc := false; Error(18); end; {else} if isNegative then GetInteger := -value else GetInteger := value; end; {GetInteger} begin {DoNDA} FlagPragmas(p_nda); isNewDeskAcc := true; NextToken; {skip the command name} if token.kind = ident then begin {get the open name} openName := token.name; NextToken; end {if} else begin isNewDeskAcc := false; Error(9); end; {else} if token.kind = ident then begin {get the close name} closeName := token.name; NextToken; end {if} else begin isNewDeskAcc := false; Error(9); end; {else} if token.kind = ident then begin {get the action name} actionName := token.name; NextToken; end {if} else begin isNewDeskAcc := false; Error(9); end; {else} if token.kind = ident then begin {get the init name} initName := token.name; NextToken; end {if} else begin isNewDeskAcc := false; Error(9); end; {else} refreshPeriod := GetInteger; {get the period} eventMask := GetInteger; {get the event Mask} if token.kind = stringconst then {get the name} begin LongToPString(@menuLine, token.sval); NextToken; end {if} else begin isNewDeskAcc := false; Error(83); end; {else} if token.kind <> eolsy then {make sure there is nothing else on the line} Error(11); end; {DoNDA} procedure DoUndef; { #undef } label 1; var bPtr: ^macroRecordPtr; {hash bucket pointer} mPtr,lastPtr: macroRecordPtr; {work pointers} begin {DoUndef} expandMacros := false; {block expansions} NextToken; {get the token name} {convert reserved words to identifiers} if token.class = reservedWord then begin token.name := @reservedWords[token.kind]; token.kind := ident; token.class := identifier; end; {if} if token.kind = ident then begin {find the bucket to search} bPtr := pointer(ord4(macros)+Hash(token.name)); lastPtr := nil; {find and delete the macro entry} mPtr := bPtr^; while mPtr <> nil do begin if mPtr^.name^ = token.name^ then begin if mPtr^.readOnly then Error(10) else begin if lastPtr = nil then bPtr^ := mPtr^.next else lastPtr^.next := mPtr^.next; end; {else} goto 1; end; {if} lastPtr := mPtr; mPtr := mPtr^.next; end; {while} end {if} else Error(9); {identifier expected} 1: expandMacros := true; {enable expansions} NextToken; {skip the macro name} if token.kind <> eolsy then {make sure there's no junk on the line} Error(11); end; {DoUndef} procedure DoXCMD; { #pragma xcmd MAIN } begin {DoXCMD} FlagPragmas(p_xcmd); isXCMD := true; NextToken; {skip the command name} if token.kind = ident then begin {get the open name} openName := token.name; NextToken; end {if} else begin isXCMD := false; Error(9); end; {else} if token.kind <> eolsy then {make sure there is nothing else on the line} Error(11); end; {DoXCMD} begin {PreProcess} lPrintMacroExpansions := printMacroExpansions; {inhibit token printing} printMacroExpansions := false; lReportEOL := reportEOL; {we need to see eol's} reportEOL := true; tSkipping := skipping; {don't skip the directive name!} skipping := false; NextCh; {skip the '#' char} while charKinds[ord(ch)] = ch_white do {skip white space} NextCh; if ch in ['a','d','e','i','l','p','u'] then begin NextToken; case token.kind of ifsy: begin NumericDirective; ProcessIf(expressionValue = 0); goto 2; end; elsesy: begin DoElse; goto 2; end; ident: begin case token.name^[1] of 'a': if token.name^ = 'append' then begin if tskipping then goto 2; DoAppend; goto 2; end; {if} 'd': if token.name^ = 'define' then begin if tskipping then goto 2; DoDefine; goto 2; end; {if} 'e': if token.name^ = 'endif' then begin DoEndif; goto 2; end {if} else if token.name^ = 'else' then begin DoElse; goto 2; end {else if} else if token.name^ = 'elif' then begin DoElif; goto 2; end {else if} else if token.name^ = 'error' then begin if tskipping then goto 2; DoError; goto 2; end; {else if} 'i': if token.name^ = 'if' then begin NumericDirective; ProcessIf(expressionValue = 0); goto 2; end {if} else if token.name^ = 'ifdef' then begin ProcessIf(not Defined); goto 2; end {else} else if token.name^ = 'ifndef' then begin ProcessIf(Defined); goto 2; end {else} else if token.name^ = 'include' then begin if tskipping then goto 2; DoInclude(false); goto 2; end; {else} 'l': if token.name^ = 'line' then begin if tskipping then goto 2; FlagPragmas(p_line); NextToken; if token.kind = intconst then begin lineNumber := token.ival; NextToken; end {if} else Error(18); if lineNumber < 0 then lineNumber := 0; if token.kind = stringconst then begin LongToPString( pointer(ord4(@sourceFileGS.theString)+1), token.sval); sourceFileGS.theString.size := token.sval^.length; NextToken; end; {if} if token.kind <> eolsy then Error(11); goto 2; end; {if} 'p': if token.name^ = 'pragma' then begin if tskipping then goto 2; NextToken; if token.name^ = 'keep' then DoKeep else if token.name^ = 'debug' then begin { debug bits: } { 1 - range checking } { 2 - create debug code } { 4 - generate profiles } { 8 - generate traceback code } { 16 - check for stack errors } FlagPragmas(p_debug); NumericDirective; val := long(expressionValue).lsw; rangeCheck := odd(val); debugFlag := odd(val >> 1); profileFlag := odd(val >> 2); traceBack := odd(val >> 3); checkStack := odd(val >> 4); profileFlag := profileFlag or debugFlag; if token.kind <> eolsy then Error(11); goto 2; end {else} else if token.name^ = 'lint' then begin FlagPragmas(p_lint); NumericDirective; lint := long(expressionValue).lsw; if token.kind <> eolsy then Error(11); goto 2; end {else} else if token.name^ = 'memorymodel' then begin FlagPragmas(p_memorymodel); NumericDirective; smallMemoryModel := expressionValue = 0; if token.kind <> eolsy then Error(11); end {else if} else if token.name^ = 'expand' then begin FlagPragmas(p_expand); NumericDirective; lPrintMacroExpansions := expressionValue <> 0; if token.kind <> eolsy then Error(11); end {else if} else if token.name^ = 'optimize' then begin { optimize bits: } { 1 - intermediate code peephole } { 2 - native peephole } { 4 - register value tracking } { 8 - remove stack checks } { 16 - common subexpression elimination } { 32 - loop invariant removal } FlagPragmas(p_optimize); NumericDirective; val := long(expressionValue).lsw; peepHole := odd(val); npeepHole := odd(val >> 1); registers := odd(val >> 2); saveStack := not odd(val >> 3); commonSubexpression := odd(val >> 4); loopOptimizations := odd(val >> 5); strictVararg := not odd(val >> 6); if saveStack or strictVararg then npeepHole := false; if token.kind <> eolsy then Error(11); end {else if} else if token.name^ = 'unix' then begin { unix bits: } { 1 - int is 32 bits } FlagPragmas(p_unix); NumericDirective; val := long(expressionValue).lsw; unix_1 := odd(val); if token.kind <> eolsy then Error(11); end {else if} else if token.name^ = 'stacksize' then begin FlagPragmas(p_stacksize); NumericDirective; stackSize := long(expressionValue).lsw; if token.kind <> eolsy then Error(11); end {else if} else if token.name^ = 'cda' then DoCDA else if token.name^ = 'cdev' then DoCDev else if token.name^ = 'nda' then DoNDA else if token.name^ = 'nba' then DoNBA else if token.name^ = 'xcmd' then DoXCMD else if token.name^ = 'toolparms' then begin FlagPragmas(p_toolparms); NumericDirective; toolParms := expressionValue <> 0; if token.kind <> eolsy then Error(11); end {else if} else if token.name^ = 'databank' then begin FlagPragmas(p_databank); NumericDirective; dataBank := expressionValue <> 0; if token.kind <> eolsy then Error(11); end {else if} else if token.name^ = 'float' then DoFloat else if token.name^ = 'rtl' then begin FlagPragmas(p_rtl); rtl := true; NextToken; if token.kind <> eolsy then Error(11); end {else if} else if token.name^ = 'noroot' then begin FlagPragmas(p_noroot); noroot := true; NextToken; if token.kind <> eolsy then Error(11); end {else if} { else if token.name^ = 'printmacros' then begin {debug} { PrintMacroTable; NextToken; if token.kind <> eolsy then Error(11); end {else if} else if token.name^ = 'path' then begin NextToken; if token.kind = stringConst then begin LongToPString(workString, token.sval); AddPath(workString); NextToken; end {if} else Error(83); if token.kind <> eolsy then Error(11); end {else if} else if token.name^ = 'ignore' then begin { ignore bits: } { 1 - don't flag illegal tokens in skipped source } { 8 - allow // comments } FlagPragmas(p_ignore); NumericDirective; val := long(expressionValue).lsw; skipIllegalTokens := odd(val); slashSlashComments := odd(val >> 3); if token.kind <> eolsy then Error(11); end {else if} else if (lint & lintPragmas) <> 0 then Error(110); goto 2; end; {if} 'u': if token.name^ = 'undef' then begin if tskipping then goto 2; DoUndef; goto 2; end; {if} otherwise: Error(57); end; {case} end; otherwise: ; end; {case} end {if} else if charKinds[ord(ch)] = ch_eol {allow null commands} then begin NextToken; goto 2; end; {else if} Error(8); {bad preprocessor command} 2: charKinds[ord('#')] := ch_pound; {allow # as a token} expandMacros := false; {skip to the end of the line} flagOverflows := false; skipping := tSkipping; while not (token.kind in [eolsy,eofsy]) do NextToken; flagOverflows := true; expandMacros := true; charKinds[ord('#')] := illegal; {don't allow # as a token} reportEOL := lReportEOL; {restore flags} printMacroExpansions := lPrintMacroExpansions; skipping := tskipping; end; {PreProcess} {-- Externally available routines ------------------------------} procedure DoDefaultsDotH; { Handle the defaults.h file } var name: pString; {name of the default file} begin {DoDefaultsDotH} name := defaultName; if GetFileType(name) <> -1 then DoInclude(true); end; {DoDefaultsDotH} procedure Error {err: integer}; { flag an error } { } { err - error number } begin {Error} if numErr = maxErr then {set the error number} errors[maxErr].num := 4 else begin numErr := numErr+1; numErrors := numErrors+1; liDCBGS.merrf := 16; errors[numErr].num := err; end; {else} with errors[numErr] do begin {record the position of the error} line := tokenLine; col := tokenColumn; end; {with} codeGeneration := false; {inhibit code generation} end; {Error} {procedure Error2 {loc, err: integer} {debug} { flag an error } { } { loc - error location } { err - error number } {begin {Error2} {writeln('Error ', err:1, ' flagged at location ', loc:1); Error(err); end; {Error2} procedure DoNumber {scanWork: boolean}; { The current character starts a number - scan it } { } { Parameters: } { scanWork - get characters from workString? } { } { Globals: } { ch - first character in sequence; set to first char } { after sequence } { workString - string to take numbers from } label 1; var c2: char; {next character to process} i: integer; {loop index} isHex: boolean; {is the value a hex number?} isLong: boolean; {is the value a long number?} isReal: boolean; {is the value a real number?} numIndex: 0..maxLine; {index into workString} sp: stringPtr; {for saving identifier names} stringIndex: 0..maxLine; {length of the number string} unsigned: boolean; {is the number unsigned?} val: integer; {value of a digit} numString: pString; {characters in the number} procedure NextChar; { Return the next character that is a part of the number } begin {NextChar} if scanWork then begin if ord(workString[0]) <> numIndex then begin numIndex := numIndex+1; c2 := workString[numIndex]; end {if} else c2 := ' '; end {if} else begin NextCh; c2 := ch; end; {else} end; {NextChar} procedure GetDigits; { Read in a digit stream } { } { Variables: } { c2 - next character to process } { numString - digit sequence added to this string } { stringIndex - length of the string } begin {GetDigits} while (charKinds[ord(c2)] = digit) or (isHex and (c2 in ['a'..'f','A'..'F'])) do begin if c2 in ['a'..'f'] then c2 := chr(ord(c2) & $5F); stringIndex := stringIndex+1; if stringIndex > 255 then begin Error(6); stringIndex := 1; end; {if} numString[stringIndex] := c2; NextChar; end; {while} end; {GetDigits} begin {DoNumber} isHex := false; {assume it's not hex} isReal := false; {assume it's an integer} isLong := false; {assume a short integer} unsigned := false; {assume signed numbers} stringIndex := 0; {no digits so far...} if scanWork then begin {set up the scanner} numIndex := 0; NextChar; end {if} else c2 := ch; if c2 = '.' then begin {handle the case of no leading digits} stringIndex := 1; numString[1] := '0'; end {if} else begin GetDigits; {read the leading digit stream} if c2 in ['x','X'] then {detect hex numbers} if stringIndex = 1 then if numString[1] = '0' then begin stringIndex := 2; numString[2] := 'X'; NextChar; isHex := true; GetDigits; goto 1; end; {if} end; if c2 = '.' then begin {handle a decimal} stringIndex := stringIndex+1; numString[stringIndex] := '.'; NextChar; isReal := true; if charKinds[ord(c2)] = digit then GetDigits else if stringIndex = 2 then begin numString[3] := '0'; stringIndex := 3; end; {else} end; {if} if c2 in ['e','E'] then begin {handle an exponent} stringIndex := stringIndex+1; numString[stringIndex] := 'e'; NextChar; isReal := true; if c2 in ['+','-'] then begin stringIndex := stringIndex+1; numString[stringIndex] := c2; NextChar; end; {if} if c2 in ['0'..'9'] then GetDigits else begin stringIndex := stringIndex+1; numString[stringIndex] := '0'; Error(101); end; {else} end; {if} 1: while c2 in ['l','u','L','U'] do {check for long or unsigned} if c2 in ['l','L'] then begin NextChar; if not isReal then isLong := true; end {if} else {if c2 in ['u','U'] then} begin NextChar; unsigned := true; if isReal then Error(91); end; {else} if c2 in ['f','F'] then begin {allow F designator on reals} if unsigned then Error(91); if not isReal then begin Error(100); isReal := true; end; {if} NextChar; end; {if} numString[0] := chr(stringIndex); {set the length of the string} if isReal then begin {convert a real constant} token.kind := doubleConst; token.class := doubleConstant; if stringIndex > 80 then begin Error(6); token.rval := 0.0; end {if} else token.rval := cnvsd(numString); end {if} else if numString[1] <> '0' then begin {convert a decimal integer} if (stringIndex > 5) or (not unsigned and (stringIndex = 5) and (numString > '32767')) or (unsigned and (stringIndex = 5) and (numString > '65535')) then isLong := true; if (stringIndex > 10) or ((stringIndex = 10) and (numString > '4294967295')) then begin numString := '0'; if flagOverflows then Error(6); end; {if} if isLong then begin token.class := longConstant; token.lval := Convertsl(numString); if unsigned then token.kind := ulongConst else begin token.kind := longConst; if token.lval < 0 then token.kind := ulongConst; end; {else} end {if} else begin if unsigned then token.kind := uintConst else token.kind := intConst; token.class := intConstant; token.lval := Convertsl(numString); end; {else} end {else if} else begin {hex & octal} token.lval := 0; if isHex then begin i := 3; while i <= length(numString) do begin if token.lval & $F0000000 <> 0 then begin i := maxint; if flagOverflows then Error(6); end {if} else begin if numString[i] > '9' then val := (ord(numString[i])-7) & $000F else val := ord(numString[i]) & $000F; token.lval := (token.lval << 4) | val; i := i+1; end; {else} end; {while} end {if} else begin i := 1; while i <= length(numString) do begin if token.lval & $E0000000 <> 0 then begin i := maxint; if flagOverflows then Error(6); end {if} else begin if numString[i] in ['8','9'] then Error(7); token.lval := (token.lval << 3) | (ord(numString[i]) & $0007); i := i+1; end; {else} end; {while} end; {else} if long(token.lval).msw <> 0 then isLong := true; if isLong then begin if unsigned then token.kind := ulongConst else token.kind := longConst; token.class := longConstant; end {if} else begin if (long(token.lval).lsw & $8000) <> 0 then unsigned := true; if unsigned then token.kind := uintConst else token.kind := intConst; token.class := intConstant; end; {else} end; {else} if saveNumber then begin sp := pointer(GMalloc(length(numString)+1)); CopyString(pointer(sp), @numString); token.numString := sp; end; {if} if scanWork then {make sure we read all characters} if ord(workString[0]) <> numIndex then Error(63); end; {DoNumber} procedure InitScanner {start, end: ptr}; { initialize the scanner } { } { start - pointer to the first character in the file } { end - points one byte past the last character in the file } var chi: minChar..maxChar; {loop variable} lch: char; {next command line character} cp: ptr; {character pointer} i: 0..hashSize; {loop variable} negative: boolean; {is a number nagative?} mp: macroRecordPtr; {for building the predefined macros} bp: ^macroRecordPtr; timeString: packed array[1..20] of char; {time from misc. tools} procedure NextCh; { Get the next character from the command line } begin {NextCh} lch := chr(cp^); cp := pointer(ord4(cp)+1); tokenColumn := tokenColumn+1; if tokenColumn > infoStringGS.theString.size then lch := chr(0); end; {NextCh} function GetWord: stringPtr; { Read a word from the command line } var i: integer; {string index} sp: stringPtr; {string pointer} begin {GetWord} i := 0; while not (lch in [' ', chr(0), chr(9), '=']) do begin i := i+1; workString[i] := lch; NextCh; end; {while} workString[0] := chr(i); sp := pointer(malloc(length(workString)+1)); CopyString(pointer(sp), @workString); GetWord := sp; end; {GetWord} function EscapeCh: integer; { Find and return the next character in a string or char } { constant. Handle escape sequences if they are found. } { (The character is returned as an ordinal value.) } { } { Globals: } { lch - first character in sequence; set to first char } { after sequence } label 1; var dig: 0..15; {value of a hex digit} skipChar: boolean; {get next char when done?} val: 0..4095; {hex escape code value (scaled to 0..255)} begin {EscapeCh} 1: skipChar := true; if lch = '\' then begin NextCh; if lch in ['0'..'7','a','b','t','n','v','f','p','r','x'] then case lch of '0','1','2','3','4','5','6','7': begin val := 0; while lch in ['0'..'7'] do begin val := (val << 3) | (ord(lch) & 7); NextCh; end; {while} EscapeCh := val & $FF; skipChar := false; end; 'a': EscapeCh := 7; 'b': EscapeCh := 8; 't': EscapeCh := 9; 'n': EscapeCh := 10; 'v': EscapeCh := 11; 'f': EscapeCh := 12; 'p': begin EscapeCh := ord('p'); ispstring := true; end; 'r': EscapeCh := 13; 'x': begin val := 0; NextCh; while lch in ['0'..'9','a'..'f','A'..'F'] do begin if lch in ['0'..'9'] then dig := ord(lch) & $0F else begin lch := chr(ord(lch)&$5F); dig := ord(lch)-ord('A')+10; end; {else} val := (val << 4) | dig; NextCh; end; {while} skipChar := false; EscapeCh := val & $FF; end; otherwise: Error(57); end {case} else EscapeCh := ord(lch); end {if} else EscapeCh := ord(lch); if skipChar then NextCh; end; {EscapeCh} procedure GetString; { read a string token from the command line } var i: integer; {string length} setLength: boolean; {is the current string a p-string?} sPtr: longstringPtr; {work string pointer} begin {GetString} token.kind := stringconst; {set up the token} token.class := stringConstant; i := 0; {set up for the string scan} ispstring := false; setLength := false; new(sPtr); NextCh; {skip the opening "} {read the characters} while not (charKinds[ord(lch)] in [ch_string,ch_eol,ch_eof]) do begin i := i+1; if i = longstringlen then begin i := 1001; Error(90); end; {if} sPtr^.str[i] := chr(EscapeCh); if (i = 1) and ispstring then setLength := true; end; {while} if lch = '"' then {process the end of the string} NextCh else Error(3); if setLength then {check for a p-string} sPtr^.str[1] := chr(i-1); token.ispstring := setLength; sPtr^.length := i; {set the string length} token.sval := pointer(Malloc(i+3)); {put the string in the string pool} CopyLongString(token.sval, pointer(sPtr)); dispose(sPtr); token.sval^.str[i+1] := chr(0); {add null in case the string is extended} end; {GetString} begin {InitScanner} printMacroExpansions := false; {don't print the token list} skipIllegalTokens := false; {flag illegal tokens in skipped code} slashSlashComments := true; {allow // comments} foundFunction := false; {no functions found so far} fileList := nil; {no included files} gettingFileName := false; {not in GetFileName} ifList := nil; {no conditional comp. records} skipping := false; {not skipping tokens} flagOverflows := true; {flag overflow errors?} new(macros); {no preprocessor macros so far} for i := 0 to hashSize do macros^[i] := nil; pathList := nil; {no additional search paths} charKinds[ord('#')] := illegal; {don't allow # as a token} tokenList := nil; {nothing in putback buffer} saveNumber := false; {don't save numbers} expandMacros := true; {enable macro expansion} reportEOL := false; {report eolsy as a token?} lineNumber := 1; {start the line counter} chPtr := start; {set the start, end pointers} eofPtr := endPtr; firstPtr := start; {first char in line} numErr := 0; {no errors so far} numErrors := 0; includeCount := 0; {no pending calls to EndInclude} lint := 0; {turn off lint checks} ch := chr(RETURN); {set the initial character} needWriteLine := false; {no lines are pending} switchLanguages := false; {not switching languages} lastWasReturn := false; {last char was not return} doingstring := false; {not doing a string} unix_1 := false; {int is 16 bits} new(mp); {__LINE__} mp^.name := @'__LINE__'; mp^.parameters := -1; mp^.tokens := nil; mp^.readOnly := true; mp^.algorithm := 1; bp := pointer(ord4(macros) + hash(mp^.name)); mp^.next := bp^; bp^ := mp; new(mp); {__FILE__} mp^.name := @'__FILE__'; mp^.parameters := -1; mp^.tokens := nil; mp^.readOnly := true; mp^.algorithm := 2; bp := pointer(ord4(macros) + hash(mp^.name)); mp^.next := bp^; bp^ := mp; new(mp); {__DATE__} mp^.name := @'__DATE__'; mp^.parameters := -1; mp^.tokens := nil; mp^.readOnly := true; mp^.algorithm := 3; bp := pointer(ord4(macros) + hash(mp^.name)); mp^.next := bp^; bp^ := mp; new(mp); {__TIME__} mp^.name := @'__TIME__'; mp^.parameters := -1; mp^.tokens := nil; mp^.readOnly := true; mp^.algorithm := 4; bp := pointer(ord4(macros) + hash(mp^.name)); mp^.next := bp^; bp^ := mp; new(mp); {__STDC__} mp^.name := @'__STDC__'; mp^.parameters := -1; mp^.tokens := nil; mp^.readOnly := true; mp^.algorithm := 5; bp := pointer(ord4(macros) + hash(mp^.name)); mp^.next := bp^; bp^ := mp; new(mp); {__ORCAC__} mp^.name := @'__ORCAC__'; mp^.parameters := -1; mp^.tokens := nil; mp^.readOnly := true; mp^.algorithm := 5; bp := pointer(ord4(macros) + hash(mp^.name)); mp^.next := bp^; bp^ := mp; new(mp); {__VERSION__} mp^.name := @'__VERSION__'; mp^.parameters := -1; mp^.tokens := nil; mp^.readOnly := true; mp^.algorithm := 6; bp := pointer(ord4(macros) + hash(mp^.name)); mp^.next := bp^; bp^ := mp; SetDateTime; {set up the macro date/time strings} {set up the version string} versionStrL := pointer(GMalloc(3 + length(versionStr))); versionStrL^.length := length(versionStr); versionStrL^.str := versionStr; {Scan the command line options} cp := @infoStringGS.theString.theString; tokenLine := 0; tokenColumn := 0; NextCh; repeat while lch in [' ', chr(9)] do {skip leading blanks} NextCh; if lch = '-' then begin {see if we have found one} NextCh; if lch in ['d','D'] then begin NextCh; {yes -> get the name} new(mp); {form the macro table entry} mp^.name := GetWord; mp^.parameters := -1; mp^.tokens := nil; mp^.readOnly := false; bp := pointer(ord4(macros) + hash(mp^.name)); mp^.next := bp^; bp^ := mp; if lch = '=' then begin NextCh; {record the value} token.numString := nil; if lch in ['a'..'z', 'A'..'Z', '_'] then begin token.kind := ident; token.class := identifier; token.name := GetWord; token.symbolPtr := nil; end {if} else if lch in ['+','-'] then begin negative := lch = '-'; NextCh; if lch in ['.','0'..'9'] then begin token.name := GetWord; DoNumber(true); if negative then case token.class of intConstant : token.ival := -token.ival; longConstant : token.lval := -token.lval; doubleConstant: token.rval := -token.rval; otherwise: ; end; {case} end {if} else begin token.kind := intconst; token.numString := nil; token.class := intConstant; token.ival := 0; end; {else} end {else if} else if lch in ['.','0'..'9'] then begin token.name := GetWord; DoNumber(true); end {else if} else if lch = '"' then GetString else Error(108); end {if} else begin token.kind := intconst; {create the default value} token.numString := nil; token.class := intConstant; token.ival := 1; end; {else} new(mp^.tokens); {add the value to the definition} with mp^.tokens^ do begin next := nil; tokenString := nil; expandEnabled := true; tokenStart := nil; tokenEnd := nil; end; {with} mp^.tokens^.token := token; end {if} else if lch in ['i','I'] then begin NextCh; {gat the pathname} if lch = '"' then begin GetString; LongToPString(workString, token.sval); AddPath(workString); end {if} else Error(103); end {if} else {not -p, -i: flag the error} Error(108); end {if} else if lch <> chr(0) then begin Error(108); {unknown option: flag the error} lch := chr(0); end; {else} until lch = chr(0); {if more characters, loop} end; {InitScanner} procedure CheckIdentifier; { See if an identifier is a reserved word, macro or typedef } label 1; var bPtr: ^macroRecordPtr; {pointer to hash bucket} mPtr: macroRecordPtr; {for checking list of macros} rword: tokenEnum; {loop variable} sp: stringPtr; {for saving identifier names} lPrintMacroExpansions: boolean; {local copy of printMacroExpansions} begin {CheckIdentifier} if expandMacros then {handle macro expansions} if not skipping then begin mPtr := FindMacro(@workstring); if mPtr <> nil then begin Expand(mPtr); lPrintMacroExpansions := printMacroExpansions; printMacroExpansions := false; NextToken; printMacroExpansions := lPrintMacroExpansions; goto 1; end; end; {if} {see if it's a reserved word} if workString[1] in ['a'..'g','i','l','p','r'..'w'] then for rword := wordHash[ord(workString[1])-ord('a')] to pred(wordHash[ord(succ(workString[1]))-ord('a')]) do if reservedWords[rword] = workString then begin token.kind := rword; token.class := reservedWord; goto 1; end; {if} token.symbolPtr := nil; {see if it's a typedef name} if FindSymbol(token,allSpaces,false,false) <> nil then begin if token.symbolPtr^.class = typedefsy then token.kind := typedef; token.name := token.symbolPtr^.name; {use the old name} end {if} else begin {record the name} sp := pointer(Malloc(length(workString)+1)); CopyString(pointer(sp), @workString); token.name := sp; end; {else} 1: end; {CheckIdentifier} procedure NextToken; { Read the next token from the file. } label 1,2,3,4; type three = (s100,s1000,s4000); {these declarations are used for a} gstringPtr = ^gstringRecord; { variable length string record } gstringRecord = record case three of s100: (len1: integer; str1: packed array[1..100] of char; ); s1000: (len2: integer; str2: packed array[1..1000] of char; ); s4000: (len3: integer; str3: packed array[1..longstringlen] of char; ); end; var done: boolean; {loop termination} expandEnabled: boolean; {can a token be expanded?} i: 0..maxint; {loop/index counter} inhibit: boolean; {inhibit macro expansion?} lPrintMacroExpansions: boolean; {local copy of printMacroExpansions} mPtr: macroRecordPtr; {for checking list of macros} setLength: boolean; {is the current string a p-string?} tPtr: tokenListRecordPtr; {for removing tokens from putback buffer} tToken: tokenType; {for merging tokens} sPtr,tsPtr: gstringPtr; {for forming string constants} function EscapeCh: integer; { Find and return the next character in a string or char } { constant. Handle escape sequences if they are found. } { (The character is returned as an ordinal value.) } { } { Globals: } { ch - first character in sequence; set to first char } { after sequence } label 1; var dig: 0..15; {value of a hex digit} skipChar: boolean; {get next char when done?} val: 0..4095; {hex escape code value (scaled to 0..255)} begin {EscapeCh} 1: skipChar := true; if ch = '\' then begin NextCh; if ch in ['0'..'7','a','b','t','n','v','f','p','r','x'] then case ch of '0','1','2','3','4','5','6','7': begin val := 0; while ch in ['0'..'7'] do begin val := (val << 3) | (ord(ch) & 7); NextCh; end; {while} EscapeCh := val & $FF; skipChar := false; end; 'a': EscapeCh := 7; 'b': EscapeCh := 8; 't': EscapeCh := 9; 'n': EscapeCh := 10; 'v': EscapeCh := 11; 'f': EscapeCh := 12; 'p': begin EscapeCh := ord('p'); ispstring := true; end; 'r': EscapeCh := 13; 'x': begin val := 0; NextCh; while ch in ['0'..'9','a'..'f','A'..'F'] do begin if ch in ['0'..'9'] then dig := ord(ch) & $0F else begin ch := chr(ord(ch)&$5F); dig := ord(ch)-ord('A')+10; end; {else} val := (val << 4) | dig; NextCh; end; {while} skipChar := false; EscapeCh := val & $FF; end; otherwise: Error(57); end {case} else EscapeCh := ord(ch); end {if} else EscapeCh := ord(ch); if skipChar then NextCh; end; {EscapeCh} begin {NextToken} if ifList = nil then {do pending EndInclude calls} while includeCount <> 0 do begin EndInclude(includeChPtr); includeCount := includeCount - 1; end; {while} includeChPtr := chPtr; 3: token.numstring := nil; {wipe out old numstrings} if tokenList <> nil then begin {get a token put back by a macro} tPtr := tokenList; tokenList := tPtr^.next; expandEnabled := tPtr^.expandEnabled; token := tPtr^.token; tokenStart := tPtr^.tokenStart; tokenEnd := tPtr^.tokenEnd; dispose(tPtr); if token.kind = typedef then {allow for typedefs in a macro} token.kind := ident; if token.kind = ident then begin CopyString(@workString, token.name); CheckIdentifier; end; {if} { dead code if token.kind = ident then if FindSymbol(token,allSpaces,false,false) <> nil then if token.symbolPtr^.class = typedefsy then token.kind := typedef; } 4: while (token.kind = stringconst) and (tokenList <> nil) and (tokenList^.token.kind = stringconst) do begin Merge(token, tokenList^.token); tPtr := tokenList; tokenList := tPtr^.next; dispose(tPtr); end; {while} if expandMacros and expandEnabled and (not skipping) then if token.kind = ident then begin {handle macro expansions} inhibit := false; if tokenList <> nil then if tokenList^.token.kind = poundpoundop then inhibit := true; if not inhibit then begin mPtr := FindMacro(token.name); if mPtr <> nil then begin Expand(mPtr); goto 3; end; {if} end; {if} end; {if} if tokenList <> nil then if tokenList^.token.kind = poundpoundop then begin tPtr := tokenList; tokenList := tPtr^.next; dispose(tPtr); if tokenList <> nil then begin tPtr := tokenList; tToken := token; Merge(tToken, tPtr^.token); tokenList := tPtr^.next; token := tToken; dispose(tPtr); goto 4; end; {if} end; {if} goto 2; end; {if} {skip white space} while charKinds[ord(ch)] in [illegal,ch_white,ch_eol] do begin if charKinds[ord(ch)] = illegal then begin if (ch = '#') and (lastWasReturn or (token.kind = eolsy)) then PreProcess {call the preprocessor} else begin tokenLine := lineNumber; {record a # token} tokenColumn := ord(ord4(chPtr)-ord4(firstPtr)); tokenStart := pointer(ord4(chPtr)-1); tokenEnd := chPtr; if (not skipping) or (not (skipIllegalTokens or (ch = '#'))) then Error(1); NextCh; end; {else} end {if} else if (charKinds[ord(ch)] = ch_eol) and reportEOL then begin token.class := reservedSymbol; {record an eol token} token.kind := eolsy; tokenLine := lineNumber; tokenColumn := ord(ord4(chPtr)-ord4(firstPtr)); tokenStart := pointer(ord4(chPtr)-1); tokenEnd := chPtr; NextCh; goto 2; end {if} else begin {skip white space} if printMacroExpansions then if charKinds[ord(ch)] = ch_eol then writeln else write(ch); NextCh; end; end; {while} tokenLine := lineNumber; {record the position of the token} tokenColumn := ord(ord4(chPtr)-ord4(firstPtr)); tokenStart := pointer(ord4(chPtr)-1); token.class := reservedSymbol; {default to the most common class} case charKinds[ord(ch)] of ch_special : begin token.kind := charSym[ord(ch)]; NextCh; end; ch_eof: {end of file} token.kind := eofsy; ch_pound : begin {tokens that start with '#'} NextCh; if ch = '#' then begin token.kind := poundpoundop; NextCh; end else token.kind := poundch; end; ch_dash : begin {tokens that start with '-'} NextCh; if ch = '>' then begin token.kind := minusgtop; NextCh; end else if ch = '-' then begin token.kind := minusminusop; NextCh; end else if ch = '=' then begin token.kind := minuseqop; NextCh; end else token.kind := minusch; end; ch_plus : begin {tokens that start with '+'} NextCh; if ch = '+' then begin token.kind := plusplusop; NextCh; end else if ch = '=' then begin token.kind := pluseqop; NextCh; end else token.kind := plusch; end; ch_lt : begin {tokens that start with '<'} NextCh; if ch = '<' then begin NextCh; if ch = '=' then begin token.kind := ltlteqop; NextCh; end else token.kind := ltltop; end else if ch = '=' then begin token.kind := lteqop; NextCh; end else token.kind := ltch; end; ch_gt : begin {tokens that start with '>'} NextCh; if ch = '>' then begin NextCh; if ch = '=' then begin token.kind := gtgteqop; NextCh; end else token.kind := gtgtop; end else if ch = '=' then begin token.kind := gteqop; NextCh; end else token.kind := gtch; end; ch_eq : begin {tokens that start with '='} NextCh; if ch = '=' then begin token.kind := eqeqop; NextCh; end else token.kind := eqch; end; ch_exc : begin {tokens that start with '!'} NextCh; if ch = '=' then begin token.kind := exceqop; NextCh; end else token.kind := excch; end; ch_and : begin {tokens that start with '&'} NextCh; if ch = '&' then begin token.kind := andandop; NextCh; end else if ch = '=' then begin token.kind := andeqop; NextCh; end else token.kind := andch; end; ch_bar : begin {tokens that start with '|'} NextCh; if ch = '|' then begin token.kind := barbarop; NextCh; end else if ch = '=' then begin token.kind := bareqop; NextCh; end else token.kind := barch; end; ch_percent: begin {tokens that start with '%'} NextCh; if ch = '=' then begin token.kind := percenteqop; NextCh; end else token.kind := percentch; end; ch_carot : begin {tokens that start with '^'} NextCh; if ch = '=' then begin token.kind := caroteqop; NextCh; end else token.kind := carotch; end; ch_asterisk: begin {tokens that start with '*'} NextCh; if ch = '=' then begin token.kind := asteriskeqop; NextCh; end else token.kind := asteriskch; end; ch_slash : begin {tokens that start with '/'} NextCh; if ch = '=' then begin token.kind := slasheqop; NextCh; end else token.kind := slashch; end; ch_dot : begin {tokens that start with '.'} if charKinds[chPtr^] = digit then DoNumber(false) else begin NextCh; token.kind := dotch; end; {else} end; ch_char : begin {character constants} NextCh; token.kind := intconst; token.class := intConstant; if ch = '''' then begin if (not skipping) or (not skipIllegalTokens) then Error(2); token.ival := ord(' '); end {if} else token.ival := EscapeCh; if ch = '''' then NextCh else if (not skipping) or (not skipIllegalTokens) then Error(2); end; ch_string: begin {string constants} doingstring := true; {change character scanning} token.kind := stringconst; {set up the token} token.class := stringConstant; i := 0; {set up for the string scan} ispstring := false; setLength := false; new(sPtr,s100); NextCh; {skip the opening "} {read the characters} while not (charKinds[ord(ch)] in [ch_string,ch_eol,ch_eof]) do begin i := i+1; if i = 101 then begin sPtr^.len1 := 100; new(tsPtr,s1000); CopyLongString(pointer(tsPtr), pointer(sPtr)); dispose(sPtr); sPtr := tsPtr; end {if} else if i = 1001 then begin sPtr^.len2 := 1000; new(tsPtr,s4000); CopyLongString(pointer(tsPtr), pointer(sPtr)); dispose(sPtr); sPtr := tsPtr; end {else if} else if i = longstringlen then begin i := 1001; Error(90); end; {else if} sPtr^.str1[i] := chr(EscapeCh); if (i = 1) and ispstring then setLength := true; end; {while} doingstring := false; {process the end of the string} if ch = '"' then NextCh else Error(3); if setLength then {check for a p-string} sPtr^.str1[1] := chr(i-1); token.ispstring := setLength; sPtr^.len1 := i; {set the string length} token.sval := pointer(Malloc(i+3)); {put the string in the string pool} CopyLongString(token.sval, pointer(sPtr)); dispose(sPtr); doingstring := false; token.sval^.str[i+1] := chr(0); {add null in case the string is extended} end; letter: begin {reserved words and identifiers} token.kind := ident; token.class := identifier; token.name := @workString; i := 0; while charKinds[ord(ch)] in [letter,digit] do begin i := i+1; workString[i] := ch; NextCh; end; {while} workString[0] := chr(i); CheckIdentifier; end; digit : {numeric constants} DoNumber(false); otherwise: Error(57); end; {case} tokenEnd := pointer(ord4(chPtr)-1); {record the end of the token} 2: if skipping then {conditional compilation branch} if not (token.kind in [eofsy,eolsy]) then goto 3; if token.kind = stringconst then {handle adjacent strings} repeat if reportEOL then begin while charKinds[ord(ch)] = ch_white do NextCh; if charKinds[ord(ch)] = ch_eol then goto 1; end; {if} tToken := token; lPrintMacroExpansions := printMacroExpansions; printMacroExpansions := false; NextToken; printMacroExpansions := lPrintMacroExpansions; if token.kind = stringconst then begin Merge(tToken, token); done := false; end {if} else begin PutBackToken(token, true); done := true; end; {else} token := tToken; until done; 1: if printMacroExpansions then {print the token stream} PrintToken(token); end; {NextToken} procedure TermScanner; { Shut down the scanner. } begin {TermScanner} if ifList <> nil then Error(21); if numErr <> 0 then begin {write any pending errors} firstPtr := chPtr; WriteLine; end; {if} end; {TermScanner} end. {$append 'scanner.asm'} \ No newline at end of file +{$optimize 7} +{---------------------------------------------------------------} +{ } +{ Scanner } +{ } +{ External Variables: } +{ } +{ ch - next character to process } +{ printMacroExpansions - print the token list? } +{ reportEOL - report eolsy as a token? } +{ token - next token to process } +{ } +{ External Subroutines: } +{ } +{ Error - flag an error } +{ IsDefined - see if a macro name is in the macro table } +{ InitScanner - initialize the scanner } +{ NextCh - Read the next character from the file, skipping } +{ comments. } +{ NextToken - read the next token from the file } +{ PutBackToken - place a token into the token stream } +{ TermScanner - Shut down the scanner. } +{ } +{---------------------------------------------------------------} + +unit Scanner; + +interface + +{$LibPrefix '0/obj/'} + +uses CCommon, Table, CGI, MM; + +{$segment 'scanner'} + +type + pragmas = {kinds of pragmas} + (p_startofenum,p_cda,p_cdev,p_float,p_keep, + p_nda,p_debug,p_lint,p_memorymodel,p_expand, + p_optimize,p_stacksize,p_toolparms,p_databank,p_rtl, + p_noroot,p_path,p_ignore,p_segment,p_nba, + p_xcmd,p_unix,p_line,p_endofenum); + + {preprocessor types} + {------------------} + tokenListRecordPtr = ^tokenListRecord; + tokenListRecord = record {element of a list of tokens} + next: tokenListRecordPtr; {next element in list} + tokenString: longStringPtr; {string making up the token} + token: tokenType; {token} + expandEnabled: boolean; {can this token be macro expanded?} + tokenStart,tokenEnd: ptr; {token start/end markers} + end; + macroRecordPtr = ^macroRecord; + macroRecord = record {preprocessor macro definition} + next: macroRecordPtr; + saved: boolean; + name: stringPtr; + parameters: integer; + tokens: tokenListRecordPtr; + readOnly: boolean; + algorithm: integer; + end; + macroTable = array[0..hashSize] of macroRecordPtr; {preprocessor macro list} + + {path name lists} + {---------------} + pathRecordPtr = ^pathRecord; + pathRecord = record + next: pathRecordPtr; + path: stringPtr; + end; + +var + ch: char; {next character to process} + macros: ^macroTable; {preprocessor macro list} + pathList: pathRecordPtr; {additional search paths} + printMacroExpansions: boolean; {print the token list?} + reportEOL: boolean; {report eolsy as a token?} + skipIllegalTokens: boolean; {skip flagging illegal tokens in skipped code?} + slashSlashComments: boolean; {allow // comments?} + token: tokenType; {next token to process} + +{---------------------------------------------------------------} + +procedure DoDefaultsDotH; + +{ Handle the defaults.h file } + + +procedure Error (err: integer); + +{ flag an error } +{ } +{ err - error number } + + +{procedure Error2 (loc, err: integer); {debug} + +{ flag an error } +{ } +{ loc - error location } +{ err - error number } + + +procedure InitScanner (start, endPtr: ptr); + +{ initialize the scanner } +{ } +{ start - pointer to the first character in the file } +{ endPtr - points one byte past the last character in the file } + + +function IsDefined (name: stringPtr): boolean; + +{ See if a macro name is in the macro table } +{ } +{ The returned value is true if the macro exists, else false. } +{ } +{ parameters: } +{ name - name of the macro to search for } + + +procedure NextCh; extern; + +{ Read the next character from the file, skipping comments. } +{ } +{ Globals: } +{ ch - character read } + + +procedure NextToken; + +{ Read the next token from the file. } + + +procedure PutBackToken (var token: tokenType; expandEnabled: boolean); + +{ place a token into the token stream } +{ } +{ parameters: } +{ token - token to put back into the token stream } +{ expandEnabled - can macro expansion be performed? } + + +procedure TermScanner; + +{ Shut down the scanner. } + +{---------------------------------------------------------------} + +implementation + +const + {special key values} + {------------------} + BS = 8; {backspace} + FF = 12; {form feed} + HT = 9; {horizontal tab} + NEWLINE = 10; {newline} + RETURN = 13; {RETURN key code} + VT = 11; {vertical tab} + + {misc} + {----} + defaultName = '13:ORCACDefs:Defaults.h'; {default include file name} + maxErr = 10; {max errors on one line} + +type + errorType = record {record of a single error} + num: integer; {error number} + line: integer; {line number} + col: integer; {column number} + end; + + {file inclusion} + {--------------} + filePtr = ^fileRecord; + fileRecord = record {NOTE: used in scanner.asm} + next: filePtr; {next file in include stack} + name: gsosOutString; {name of the file} + sname: gsosOutString; {name of the file for __FILE__} + lineNumber: integer; {line number at the #include} + disp: longint; {disp of next character to process} + end; + + getFileInfoOSDCB = record + pcount: integer; + pathName: gsosInStringPtr; + access: integer; + fileType: integer; + auxType: longint; + storageType: integer; + createDateTime: timeField; + modDateTime: timeField; + optionList: optionListPtr; + dataEOF: longint; + blocksUsed: longint; + resourceEOF: longint; + resourceBlocks: longint; + end; + + expandDevicesDCBGS = record + pcount: integer; + inName: gsosInStringPtr; + outName: gsosOutStringPtr; + end; + + {conditional compilation parsing} + {-------------------------------} + ifPtr = ^ifRecord; + ifRecord = record + next: ifPtr; {next record in if stack} + status: {what are we doing?} + (processing,skippingToEndif,skippingToElse); + elseFound: boolean; {has an #else been found?} + end; + +var + dateStr: longStringPtr; {macro date string} + doingstring: boolean; {used to supress comments in strings} + errors: array[1..maxErr] of errorType; {errors in this line} + eofPtr: ptr; {points one byte past the last char in the file} + fileList: filePtr; {include file list} + flagOverflows: boolean; {flag numeric overflows?} + gettingFileName: boolean; {are we in GetFileName?} + lastWasReturn: boolean; {was the last character an eol?} + lineStr: string[5]; {string form of __LINE__} + ifList: ifPtr; {points to the top prep. parse record} + includeChPtr: ptr; {chPtr at start of current token} + includeCount: 0..maxint; {nested include files (for EndInclude)} + macroFound: macroRecordPtr; {last macro found by IsDefined} + needWriteLine: boolean; {is there a line that needs to be written?} + numErr: 0..maxErr; {number of errors in this line} + oneStr: string[2]; {string form of __STDC__} + ispstring: boolean; {is the current string a p-string?} + saveNumber: boolean; {save the characters in a number?} + skipping: boolean; {skipping tokens?} + timeStr: longStringPtr; {macro time string} + tokenColumn: 0..maxint; {column number at start of this token} + tokenLine: 0..maxint; {line number at start of this token} + tokenList: tokenListRecordPtr; {token putback buffer} + tokenStart: ptr; {pointer to the first char in the token} + tokenEnd: ptr; {pointer to the first char past the token} + versionStrL: longStringPtr; {macro version string} + workString: pstring; {for building strings and identifiers} + +{-- External procedures; see expresssion evaluator for notes ---} + +procedure EndInclude (chPtr: ptr); extern; + +{ Saves symbols created by the include file } +{ } +{ Parameters: } +{ chPtr - chPtr when the file returned } +{ } +{ Notes: } +{ 1. Call this subroutine right after processing an } +{ include file. } +{ 2. Fron Header.pas } + + +procedure ExpandDevicesGS (var parms: expandDevicesDCBGS); prodos ($0154); + + +procedure Expression (kind: expressionKind; stopSym: tokenSet); extern; + +{ handle an expression } + + +function FindSymbol (var tk: tokenType; class: spaceType; oneLevel: boolean; + staticAllowed: boolean): identPtr; extern; + +{ locate a symbol in the symbol table } +{ } +{ parameters: } +{ tk - token record for the identifier to find } +{ class - the kind of variable space to search } +{ oneLevel - search one level only? (used to check for } +{ duplicate symbols) } +{ staticAllowed - can we check for static variables? } +{ } +{ returns: } +{ A pointer to the symbol table entry is returned. If } +{ there is no entry, nil is returned. } + + +procedure FlagPragmas (pragma: pragmas); extern; + +{ record the effects of a pragma } +{ } +{ parameters: } +{ pragma - pragma to record } +{ } +{ Notes: } +{ 1. From Header.pas } + + +procedure GetFileInfoGS (var parms: getFileInfoOSDCB); prodos ($2006); + + +procedure StartInclude (name: gsosOutStringPtr); extern; + +{ Marks the start of an include file } +{ } +{ Notes: } +{ 1. Call this subroutine right after opening an include } +{ file. } +{ 2. From Header.pas } + +{-- Scanner support --------------------------------------------} + +procedure CheckDelimiters (var name: pString); + +{ Check for delimiters, making sure they are ':' } +{ } +{ parameters: } +{ name - path name to check } + +label 1; + +var + dc: char; {delimiter character} + i: 0..255; {loop/index variable} + +begin {CheckDelimiters} +dc := ':'; {determine what the delimiter is} +for i := 1 to length(name) do + if name[i] in [':','/'] then begin + dc := name[i]; + goto 1; + end; {if} +1: ; +if dc = '/' then {replace '/' delimiters with ':'} + for i := 1 to length(name) do + if name[i] = '/' then + name[i] := ':'; +end; {CheckDelimiters} + + +procedure AddPath (name: pString); + +{ Add a path name to the path name table } +{ } +{ parameters: } +{ name - path name to add } + +var + pp, ppe: pathRecordPtr; {work pointers} + +begin {AddPath} +if length(name) <> 0 then begin + CheckDelimiters(name); {make sure ':' is used} + if name[length(name)] <> ':' then {make sure there is a trailing delimiter} + name := concat(name, ':'); + {create the new path record} + pp := pathRecordPtr(GMalloc(sizeof(pathRecord))); + pp^.next := nil; + pp^.path := stringPtr(GMalloc(length(name)+1)); + pp^.path^ := name; + if pathList = nil then {add the path to the path list} + pathList := pp + else begin + ppe := pathList; + while ppe^.next <> nil do + ppe := ppe^.next; + ppe^.next := pp; + end; {else} + end; {if} +end; {AddPath} + + +function Convertsl(var str: pString): longint; extern; + +{ Return the integer equivalent of the string. Assumes a valid } +{ 4-byte integer string; supporst unsigned values. } + + +procedure SetDateTime; extern; + +{ set up the macro date/time strings } + + +function KeyPress: boolean; extern; + +{ Has a key been presed? } +{ } +{ If a key has not been pressed, this function returns } +{ false. If a key has been pressed, it clears the key } +{ strobe. If the key was an open-apple ., a terminal exit } +{ is performed; otherwise, the function returns true. } + + +function IsDefined {name: stringPtr): boolean}; + +{ See if a macro name is in the macro table } +{ } +{ The returned value is true if the macro exists, else false. } +{ } +{ parameters: } +{ name - name of the macro to search for } +{ } +{ outputs: } +{ macroFound - pointer to the macro found } + +label 1; + +var + bPtr: ^macroRecordPtr; {pointer to hash bucket} + mPtr: macroRecordPtr; {for checking list of macros} + +begin {IsDefined} +IsDefined := false; +bPtr := pointer(ord4(macros) + Hash(name)); +mPtr := bPtr^; +while mPtr <> nil do begin + if mPtr^.name^ = name^ then begin + IsDefined := true; + goto 1; + end; {if} + mPtr := mPtr^.next; + end; {while} +1: +macroFound := mPtr; +end; {IsDefined} + + +procedure PutBackToken {var token: tokenType; expandEnabled: boolean}; + +{ place a token into the token stream } +{ } +{ parameters: } +{ token - token to put back into the token stream } +{ expandEnabled - can macro expansion be performed? } + +var + tPtr: tokenListRecordPtr; {work pointer} + +begin {PutBackToken} +new(tPtr); +tPtr^.next := tokenList; +tokenList := tPtr; +tPtr^.token := token; +tPtr^.expandEnabled := expandEnabled; +tPtr^.tokenStart := tokenStart; +tPtr^.tokenEnd := tokenEnd; +end; {PutBackToken} + + +procedure WriteLine; + +{ Write the current character to the screen. } +{ } +{ Global Variables: } +{ firstPtr - points to the first char in the line } +{ chPtr - points to the end of line character } + +var + cl: 0..maxint; {column number loop index} + cp: ptr; {work pointer} + i: 1..maxErr; {error loop index} + msg: stringPtr; {pointer to the error message} + +begin {WriteLine} +if list or (numErr <> 0) then begin + write(lineNumber:4, ' '); {write the line #} + cp := firstPtr; {write the characters in the line} + while cp <> chPtr do begin + if cp^ <> RETURN then + write(chr(cp^)); + cp := pointer(ord4(cp) + 1); + end; {while} + writeln; {write the end of line character} + for i := 1 to numErr do {write any errors} + with errors[i] do begin + if line = lineNumber then begin + for cl := 1 to col+4 do + write(' '); + write('^ '); + end {if} + else + write(' Error in column ', col:1, ' of line ', line:1, ': '); + case num of + 1 : msg := @'illegal character'; + 2 : msg := @'a character constant must contain exactly one character'; + 3 : msg := @'no end was found to the string'; + 4 : msg := @'further errors suppressed'; + 5 : msg := @'cannot redefine a macro'; + 6 : msg := @'integer overflow'; + 7 : msg := @'''8'' and ''9'' cannot be used in octal constants'; + 8 : msg := @'unknown preprocessor command'; + 9 : msg := @'identifier expected'; + 10: msg := @'cannot undefine standard macros'; + 11: msg := @'end of line expected'; + 12: msg := @''')'' expected'; + 13: msg := @'''('' expected'; + 14: msg := @'incorrect number of macro parameters'; + 15: msg := @'''>'' expected'; + 16: msg := @'file name is too long'; + 17: msg := @'keep must appear before any functions'; + 18: msg := @'integer constant expected'; + 19: msg := @'only one #else may be used per #if'; + 20: msg := @'there is no #if for this directive'; + 21: msg := @'an #if had no closing #endif'; + 22: msg := @''';'' expected'; + 23: msg := @'''}'' expected'; + 24: msg := @''']'' expected'; + 25: msg := @'the else has no matching if'; + 26: msg := @'type expected'; + 27: msg := @'''{'' expected'; + 28: msg := @'a function cannot be defined here'; + 29: msg := @''':'' expected'; + 30: msg := @'''while'' expected'; + 31: msg := @'undeclared identifier'; + 32: msg := @'the last if statement was not finished'; + 33: msg := @'the last do statement was not finished'; + 34: msg := @'the last compound statement was not finished'; + 35: msg := @'expression expected'; + 36: msg := @'expression syntax error'; + 37: msg := @'operand expected'; + 38: msg := @'operation expected'; + 39: msg := @'no matching ''?'' found for this '':'' operator'; + 40: msg := @'illegal type cast'; + 41: msg := @'illegal operand in a constant expression'; + 42: msg := @'duplicate symbol'; + 43: msg := @'the function''s type must match the previous declaration'; + 44: msg := @'too many initializers'; + 45: msg := @'the number of array elements must be greater than 0'; + 46: msg := @'you must initialize the individual elements of a struct, union, or non-char array'; + 47: msg := @'type conflict'; + 48: msg := @'pointer initializers must resolve to an integer, address or string'; + 49: msg := @'the array size could not be determined'; + 50: msg := @'only parameters or types may be declared here'; + 51: msg := @'lint: undefined function'; + 52: msg := @'you cannot initialize a type'; + 53: msg := @'the structure has already been defined'; + 54: msg := @'bit fields must be less than 32 bits wide'; + 55: msg := @'a value cannot be zero bits wide'; + 56: msg := @'unions cannot have bit fields'; + 57: msg := @'compiler error'; + 58: msg := @'implementation restriction: too many local labels'; + 59: msg := @'file name expected'; + 60: msg := @'implementation restriction: string space exhausted'; + 61: msg := @'implementation restriction: run-time stack space exhausted'; + 62: msg := @'auto or register can only be used in a function body'; + 63: msg := @'token merging produced an illegal token'; + 64: msg := @'assignment to an array is not allowed'; + 65: msg := @'assignment to void is not allowed'; + 66: msg := @'the operation cannot be performed on operands of the type given'; + 67: msg := @'the last else clause was not finished'; + 68: msg := @'the last while statement was not finished'; + 69: msg := @'the last for statement was not finished'; + 70: msg := @'the last switch statement was not finished'; + 71: msg := @'switch expressions must evaluate to integers'; + 72: msg := @'case and default labels must appear in a switch statement'; + 73: msg := @'duplicate case label'; + 74: msg := @'only one default label is allowed in a switch statement'; + 75: msg := @'continue must appear in a while, do or for loop'; + 76: msg := @'break must appear in a while, do, for or switch statement'; + 77: msg := @'duplicate label'; + 78: msg := @'l-value required'; + 79: msg := @'illegal operand for the indirection operator'; + 80: msg := @'the selection operator must be used on a structure or union'; + 81: msg := @'the selected field does not exist in the structure or union'; + 82: msg := @'''('', ''['' or ''*'' expected'; + 83: msg := @'string constant expected'; + 84: msg := @'''dynamic'' expected'; + 85: msg := @'the number of parameters does not agree with the prototype'; + 86: msg := @''','' expected'; + 87: msg := @'invalid storage type for a parameter'; + 88: msg := @'you cannot initialize a parameter'; + 89: msg := @'''.'' expected'; + 90: msg := @'string too long'; + 91: msg := @'real constants cannot be unsigned'; + 92: msg := @'statement expected'; + 93: msg := @'assignment to const is not allowed'; + 94: msg := @'pascal qualifier is only allowed on functions'; + 95: msg := @'unidentified operation code'; + 96: msg := @'incorrect operand size'; + 97: msg := @'operand syntax error'; + 98: msg := @'invalid operand'; + 99: msg := @'comp data type is not supported by the 68881'; + 100: msg := @'integer constants cannot use the f designator'; + 101: msg := @'digits expected in the exponent'; + {102: msg := @'extern variables cannot be initialized';} + 103: msg := @'functions cannot return functions or arrays'; + 104: msg := @'lint: missing function type'; + 105: msg := @'lint: parameter list not prototyped'; + 106: msg := @'cannot take the address of a bit field'; + 107: msg := @'illegal use of forward declaration'; + 108: msg := @'unknown cc= option on command line'; + 109: msg := @'illegal math operation in a constant expression'; + 110: msg := @'lint: unknown pragma'; + 111: msg := @'the & operator cannot be applied to arrays'; + 112: msg := @'segment buffer overflow'; + 113: msg := @'all parameters must have a name'; + 114: msg := @'a function call was made to a non-function'; + otherwise: Error(57); + end; {case} + writeln(msg^); + if terminalErrors then begin + if enterEditor then + ExitToEditor(msg, ord4(firstPtr)+col-ord4(bofPtr)-1) + else + TermError(0); + end; {if} + end; {with} + {handle pauses} + if ((numErr <> 0) and wait) or KeyPress then begin + DrawHourglass; + while not KeyPress do {nothing}; + ClearHourglass; + end; {if} + numErr := 0; {no errors on next line...} + end {if} +else + if KeyPress then begin {handle pauses} + DrawHourglass; + while not KeyPress do {nothing}; + ClearHourglass; + end; {if} +Spin; {twirl the spinner} +end; {WriteLine} + + +procedure PrintToken (token: tokenType); + +{ Write a token to standard out } +{ } +{ parameters: } +{ token - token to print } + +label 1; + +var + ch: char; {work character} + i: integer; {loop counter} + + + procedure PrintHexDigit(i: integer); + + { Print a digit as a hex character } + { } + { Parameters: } + { i: value to print in least significant 4 bits } + + begin {PrintHexDigit} + i := i & $000F; + if i < 10 then + write(chr(i | ord('0'))) + else + write(chr(i + ord('A') - 10)); + end; {PrintHexDigit} + + +begin {PrintToken} +case token.kind of + typedef, + ident: write(token.name^); + + intconst, + uintconst: write(token.ival:1); + + longConst, + ulongConst: write(token.lval:1); + + doubleConst: write(token.rval:1); + + stringConst: begin + write('"'); + for i := 1 to token.sval^.length do begin + ch := token.sval^.str[i]; + if ch in [' '..'~'] then + write(ch) + else begin + write('\x0'); + PrintHexDigit(ord(ch)>>4); + PrintHexDigit(ord(ch)); + end; {else} + end; {for} + write('"'); + end; + + autosy,asmsy,breaksy,casesy,charsy, + continuesy,constsy,compsy,defaultsy,dosy, + doublesy,elsesy,enumsy,externsy,extendedsy, + floatsy,forsy,gotosy,ifsy,intsy, + inlinesy,longsy,pascalsy,registersy,returnsy, + shortsy,sizeofsy,staticsy,structsy,switchsy, + segmentsy,signedsy,typedefsy,unionsy,unsignedsy, + voidsy,volatilesy,whilesy: + write(reservedWords[token.kind]); + + tildech,questionch,lparench,rparench,lbrackch,rbrackch,lbracech, + rbracech,commach,semicolonch,colonch,poundch: + begin + for i := minChar to maxChar do + if charSym[i] = token.kind then begin + write(chr(i)); + goto 1; + end; {if} + end; + + minusch: write('-'); + + plusch: write('+'); + + ltch: write('<'); + + gtch: write('>'); + + eqch: write('='); + + excch: write('!'); + + andch: write('&'); + + barch: write('|'); + + percentch: write('%'); + + carotch: write('^'); + + asteriskch: write('*'); + + slashch: write('/'); + + dotch: write('.'); + + minusgtop: write('->'); + + opplusplus, + plusplusop: write('++'); + + opminusminus, + minusminusop: write('--'); + + ltltop: write('<<'); + + gtgtop: write('>>'); + + lteqop: write('<='); + + gteqop: write('>='); + + eqeqop: write('=='); + + exceqop: write('!='); + + andandop: write('&&'); + + barbarop: write('||'); + + pluseqop: write('+='); + + minuseqop: write('-='); + + asteriskeqop: write('*='); + + slasheqop: write('/='); + + percenteqop: write('%='); + + ltlteqop: write('<<='); + + gtgteqop: write('>>='); + + andeqop: write('&='); + + caroteqop: write('^='); + + bareqop: write('!='); + + uminus: write('-'); + + uand: write('+'); + + uasterisk: write('*'); + + macroParm: write('$', token.pnum:1); + + poundpoundop, + parameteroper, + castoper, + eolsy, + eofsy: ; + end; {case} +1: +write(' '); +end; {PrintToken} + +{ copy 'Scanner.debug'} {debug} + +{-- The Preprocessor -------------------------------------------} + +procedure CheckIdentifier; forward; + +{ See if an identifier is a reserved word, macro or typedef } + + +procedure DoNumber (scanWork: boolean); forward; + +{ The current character starts a number - scan it } +{ } +{ Parameters: } +{ scanWork - get characters from workString? } +{ } +{ Globals: } +{ ch - first character in sequence; set to first char } +{ after sequence } +{ workString - string to take numbers from } + + +function GetFileType (var name: pString): integer; forward; + +{ Checks to see if a file exists } +{ } +{ parameters: } +{ name - file name to check for } +{ } +{ Returns: File type if the file exists, or -1 if the file does } +{ not exist (or if GetFileInfo returns an error) } + + +function OpenFile (doInclude, default: boolean): boolean; forward; + +{ Open a new file and start scanning it } +{ } +{ Parameters: } +{ doInclude - are we doing a #include? } +{ default - use the name ? } +{ } +{ Returns: result from GetFileName } + + +function FindMacro (name: stringPtr): macroRecordPtr; + +{ If the current token is a macro, find the macro table entry } +{ } +{ Parameters: } +{ name - name of the suspected macro } +{ } +{ Returns: } +{ Pointer to macro table entry; nil for none } + +label 1; + +var + bPtr: ^macroRecordPtr; {pointer to hash bucket} + mPtr: macroRecordPtr; {pointer to macro entry} + +begin {FindMacro} +FindMacro := nil; +bPtr := pointer(ord4(macros)+Hash(name)); +mPtr := bPtr^; +while mPtr <> nil do begin + if mPtr^.name^ = name^ then begin + if mPtr^.parameters = -1 then + FindMacro := mPtr + else if tokenList = nil then begin + while charKinds[ord(ch)] in [ch_white, ch_eol] do begin + if printMacroExpansions then + if charKinds[ord(ch)] = ch_eol then + writeln + else + write(ch); + NextCh; + end; {while} + if ch = '(' then + FindMacro := mPtr; + end {else if} + else if tokenList^.token.kind = lparench then + FindMacro := mPtr; + goto 1; + end; {if} + mPtr := mPtr^.next; + end; {while} +1: +end; {FindMacro} + + +procedure LongToPString (pstr: stringPtr; lstr: longStringPtr); + +{ Convert a long string into a p string } +{ } +{ Parameters: } +{ pstr - pointer to the p-string } +{ lstr - pointer to the long string } + +var + i: integer; {loop variable} + len: integer; {string length} + +begin {LongToPString} +len := lstr^.length; +if len > 255 then + len := 255; +pstr^[0] := chr(len); +for i := 1 to len do + pstr^[i] := lstr^.str[i]; +end; {LongToPString} + + +procedure Merge (var tk1: tokenType; tk2: tokenType); + +{ Merge two tokens } +{ } +{ Parameters: } +{ tk1 - first token; result is stored here } +{ tk2 - second token } + +label 1; + +var + class1,class2: tokenClass; {token classes} + cp: longstringPtr; {pointer to work string} + i: integer; {loop variable} + kind1,kind2: tokenEnum; {token kinds} + len,len1: integer; {length of strings} + lt: tokenType; {local copy of token} + str1,str2: stringPtr; {identifier strings} + +begin {Merge} +kind1 := tk1.kind; +class1 := tk1.class; +kind2 := tk2.kind; +class2 := tk2.class; +if class1 in [identifier,reservedWord] then begin + if class1 = identifier then + str1 := tk1.name + else + str1 := @reservedWords[kind1]; + if class2 = identifier then + str2 := tk2.name + else if class2 = reservedWord then + str2 := @reservedWords[kind2] + else if class2 in [intConstant,longConstant,doubleConstant] then + str2 := tk2.numString + else begin + Error(63); + goto 1; + end; {else} + workString := concat(str1^, str2^); + for i := 1 to length(workString) do + if not (charKinds[ord(workString[i])] in [letter,digit]) then begin + Error(63); + goto 1; + end; {if} + lt := token; + token.kind := ident; + token.class := identifier; + token.numString := nil; + token.name := @workString; + token.symbolPtr := nil; + CheckIdentifier; + tk1 := token; + token := lt; + goto 1; + end {class1 in [identifier,reservedWord]} + +else if class1 in [intConstant,longConstant,doubleConstant] then begin + if class2 in [intConstant,longConstant,doubleConstant] then + str2 := tk2.numString + else if class2 = identifier then + str2 := tk2.name + else if class2 = reservedWord then + str2 := @reservedWords[kind2] + else if kind2 = dotch then + str2 := @'.' + else begin + Error(63); + goto 1; + end; {else} + workString := concat(tk1.numString^, str2^); + lt := token; + DoNumber(true); + tk1 := token; + token := lt; + goto 1; + end {else if class1 in [intConstant,longConstant,doubleConstant]} + +else if class1 = stringConstant then begin + if class2 = stringConstant then begin + len1 := tk1.sval^.length; + len := len1+tk2.sval^.length; + cp := pointer(Malloc(len+2)); + for i := 1 to len1 do + cp^.str[i] := tk1.sval^.str[i]; + for i := 1 to len-len1 do + cp^.str[i+len1] := tk2.sval^.str[i]; + cp^.length := len; + if tk1.ispstring then + cp^.str[1] := chr(len-1); + tk1.sval := cp; + goto 1; + end; {if} + end {else if} + +else if kind1 = dotch then begin + if class2 in [intConstant,longConstant,doubleConstant] then begin + workString := concat(tk1.numString^, tk2.numString^); + lt := token; + DoNumber(true); + tk1 := token; + token := lt; + goto 1; + end; {if} + end {else if class1 in [intConstant,longConstant,doubleConstant]} + +else if kind1 = poundch then begin + if kind2 = poundch then begin + tk1.kind := poundpoundop; + goto 1; + end; {if} + end {else if} + +else if kind1 = minusch then begin + if kind2 = gtch then begin + tk1.kind := minusgtop; + goto 1; + end {if} + else if kind2 = minusch then begin + tk1.kind := minusminusop; + goto 1; + end {else if} + else if kind2 = eqch then begin + tk1.kind := minuseqop; + goto 1; + end; {else if} + end {else if} + +else if kind1 = plusch then begin + if kind2 = plusch then begin + tk1.kind := plusplusop; + goto 1; + end {else if} + else if kind2 = eqch then begin + tk1.kind := pluseqop; + goto 1; + end; {else if} + end {else if} + +else if kind1 = ltch then begin + if kind2 = ltch then begin + tk1.kind := ltltop; + goto 1; + end {if} + else if kind2 = lteqop then begin + tk1.kind := ltlteqop; + goto 1; + end {else if} + else if kind2 = eqch then begin + tk1.kind := lteqop; + goto 1; + end; {else if} + end {else if} + +else if kind1 = ltltop then begin + if kind2 = eqch then begin + tk1.kind := ltlteqop; + goto 1; + end; {if} + end {else if} + +else if kind1 = gtch then begin + if kind2 = gtch then begin + tk1.kind := gtgtop; + goto 1; + end {if} + else if kind2 = gteqop then begin + tk1.kind := gtgteqop; + goto 1; + end {else if} + else if kind2 = eqch then begin + tk1.kind := gteqop; + goto 1; + end; {else if} + end {else if} + +else if kind1 = gtgtop then begin + if kind2 = eqch then begin + tk1.kind := gtgteqop; + goto 1; + end; {if} + end {else if} + +else if kind1 = eqch then begin + if kind2 = eqch then begin + tk1.kind := eqeqop; + goto 1; + end; {if} + end {else if} + +else if kind1 = excch then begin + if kind2 = eqch then begin + tk1.kind := exceqop; + goto 1; + end; {if} + end {else if} + +else if kind1 = andch then begin + if kind2 = andch then begin + tk1.kind := andandop; + goto 1; + end {if} + else if kind2 = eqch then begin + tk1.kind := andeqop; + goto 1; + end; {else if} + end {else if} + +else if kind1 = barch then begin + if kind2 = barch then begin + tk1.kind := barbarop; + goto 1; + end {if} + else if kind2 = eqch then begin + tk1.kind := bareqop; + goto 1; + end; {else if} + end {else if} + +else if kind1 = percentch then begin + if kind2 = eqch then begin + tk1.kind := percenteqop; + goto 1; + end; {if} + end {else if} + +else if kind1 = carotch then begin + if kind2 = eqch then begin + tk1.kind := caroteqop; + goto 1; + end; {if} + end {else if} + +else if kind1 = asteriskch then begin + if kind2 = eqch then begin + tk1.kind := asteriskeqop; + goto 1; + end; {if} + end {else if} + +else if kind1 = slashch then begin + if kind2 = eqch then begin + tk1.kind := slasheqop; + goto 1; + end; {if} + end; {else if} + +Error(63); +1: +end; {Merge} + + +procedure BuildStringToken (cp: ptr; len: integer); + +{ Create a string token from a string } +{ } +{ Used to stringize macros. } +{ } +{ Parameters: } +{ cp - pointer to the first character } +{ len - number of characters in the string } + +var + i: integer; {loop variable} + +begin {BuildStringToken} +token.kind := stringconst; +token.class := stringConstant; +token.ispstring := false; +token.sval := pointer(GMalloc(len+2)); +for i := 1 to len do begin + token.sval^.str[i] := chr(cp^); + cp := pointer(ord4(cp)+1); + end; {for} +token.sval^.length := len; +PutBackToken(token, true); +end; {BuildStringToken} + + +procedure DoInclude (default: boolean); + +{ #include } +{ } +{ Parameters: } +{ default - open ? } + +var + fp: filePtr; {pointer to an include file} + +begin {DoInclude} +new(fp); {get a file record for the current file} +fp^.next := fileList; +fileList := fp; +fp^.name := includeFileGS; +fp^.sname := sourceFileGS; +fp^.lineNumber := lineNumber+1; +if OpenFile(true, default) then begin {open a new file and proceed from there} + lineNumber := 1; + StartInclude(@includeFileGS); + end {if} +else begin {handle a file name error} + fileList := fp^.next; + dispose(fp); + end; {else} +end; {DoInclude} + + +procedure Expand (macro: macroRecordPtr); + +{ Expand a preprocessor macro } +{ } +{ Expands a preprocessor macro by putting tokens from the macro } +{ definition into the scanner's putback buffer. } +{ } +{ Parameters: } +{ macro - pointer to the macro to expand } +{ } +{ Globals: } +{ macroList - scanner putback buffer } + +type + parameterPtr = ^parameterRecord; + parameterRecord = record {parameter list element} + next: parameterPtr; {next parameter} + tokens: tokenListRecordPtr; {token list} + tokenStart,tokenEnd: ptr; {source pointers (for stringization)} + end; + +var + bPtr: ^macroRecordPtr; {pointer to hash bucket} + done: boolean; {used to check for loop termination} + expandEnabled: boolean; {can the token be expanded?} + i: integer; {loop counter} + inhibit: boolean; {inhibit parameter expansion?} + lexpandMacros: boolean; {local copy of expandMacros} + lPrintMacroExpansions: boolean; {local copy of printMacroExpansions} + mPtr: macroRecordPtr; {for checking list of macros} + newParm: parameterPtr; {for building a new parameter entry} + tlPtr, tPtr, tcPtr, lastPtr: tokenListRecordPtr; {work pointers} + paramCount: integer; {# of parameters found in the invocation} + parenCount: integer; {paren count; for balancing parenthesis} + parmEnd: parameterPtr; {for building a parameter list} + parms: parameterPtr; {points to the list of parameters} + pptr: parameterPtr; {work pointer for tracing parms list} + sp: longStringPtr; {work pointer} + stringization: boolean; {are we stringizing a parameter?} + +begin {Expand} +lPrintMacroExpansions := printMacroExpansions; {inhibit token printing} +printMacroExpansions := false; +lexpandMacros := expandMacros; {prevent expansion of parameters} +expandMacros := false; +saveNumber := true; {save numeric strings} +parms := nil; {no parms so far} +if macro^.parameters >= 0 then begin {find the values of the parameters} + NextToken; {get the '(' (we hope...)} + if token.kind = lparench then begin + NextToken; {skip the '('} + paramCount := 0; {process the parameters} + parmEnd := nil; + repeat + done := true; + if token.kind <> rparench then begin + parenCount := 0; + paramCount := paramCount+1; + new(newParm); + newParm^.next := nil; + if parmEnd = nil then + parms := newParm + else + parmEnd^.next := newParm; + parmEnd := newParm; + newParm^.tokens := nil; + while (token.kind <> eofsy) + and ((parenCount <> 0) + or (not (token.kind in [rparench,commach]))) do begin + new(tPtr); + tPtr^.next := newParm^.tokens; + newParm^.tokens := tPtr; + tPtr^.token := token; + tPtr^.tokenStart := tokenStart; + tPtr^.tokenEnd := tokenEnd; + if token.kind = lparench then + parenCount := parenCount+1 + else if token.kind = rparench then + parenCount := parenCount-1; + NextToken; + end; {while} + if token.kind = commach then begin + NextToken; + done := false; + end; {if} + end; {if} + until done; + if paramCount <> macro^.parameters then + Error(14); + if token.kind = rparench then {insist on a closing ')'} + begin + if not gettingFileName then + NextToken + end {if} + else + Error(12); + end {if} + else + Error(13); + if not gettingFileName then {put back the source stream token} + PutBackToken(token, true); + end; {if} +if macro^.readOnly then begin {handle special macros} + case macro^.algorithm of + + 1: begin {__LINE__} + token.kind := intconst; + token.numString := @lineStr; + token.class := intconstant; + token.ival := lineNumber; + lineStr := cnvis(token.ival); + tokenStart := @lineStr[1]; + tokenEnd := pointer(ord4(tokenStart)+length(lineStr)); + end; + + 2: begin {__FILE__} + token.kind := stringConst; + token.class := stringConstant; + token.ispstring := false; + sp := pointer(Malloc(5+sourceFileGS.theString.size)); + sp^.length := sourceFileGS.theString.size; + for i := 1 to sourceFileGS.theString.size do + sp^.str[i] := sourceFileGS.theString.theString[i]; + token.sval := sp; + tokenStart := @sp^.str; + tokenEnd := pointer(ord4(tokenStart)+sp^.length); + end; + + 3: begin {__DATE__} + token.kind := stringConst; + token.class := stringConstant; + token.ispstring := false; + token.sval := dateStr; + tokenStart := @dateStr^.str; + tokenEnd := pointer(ord4(tokenStart)+dateStr^.length); + end; + + 4: begin {__TIME__} + token.kind := stringConst; + token.class := stringConstant; + token.ispstring := false; + token.sval := timeStr; + tokenStart := @timeStr^.str; + tokenEnd := pointer(ord4(tokenStart)+timeStr^.length); + end; + + 5: begin {__STDC__} + token.kind := intConst; {__ORCAC__} + token.numString := @oneStr; + token.class := intConstant; + token.ival := 1; + oneStr := '1'; + tokenStart := @oneStr[1]; + tokenEnd := pointer(ord4(tokenStart)+1); + end; + + 6: begin {__VERSION__} + token.kind := stringConst; + token.class := stringConstant; + token.ispstring := false; + token.sval := versionStrL; + tokenStart := @versionStrL^.str; + tokenEnd := pointer(ord4(tokenStart)+versionStrL^.length); + end; + + otherwise: Error(57); + + end; {case} + PutBackToken(token, true); + end {if} +else begin + + {expand the macro} + tlPtr := macro^.tokens; {place the tokens in the buffer...} + lastPtr := nil; + while tlPtr <> nil do begin + if tlPtr^.token.kind = macroParm then begin + pptr := parms; {find the correct parameter} + for i := 1 to tlPtr^.token.pnum do + if pptr <> nil then + pptr := pptr^.next; + if pptr <> nil then begin + + {see if the macro is stringized} + stringization := false; + if tlPtr^.next <> nil then + stringization := tlPtr^.next^.token.kind = poundch; + + {handle macro stringization} + if stringization then begin + tcPtr := pptr^.tokens; + while tcPtr <> nil do begin + if tcPtr^.token.kind = stringconst then + BuildStringToken(@tcPtr^.token.sval^.str, + tcPtr^.token.sval^.length) + else + BuildStringToken(tcPtr^.tokenStart, + ord(ord4(tcPtr^.tokenEnd)-ord4(tcPtr^.tokenStart))); + tcPtr := tcPtr^.next; + end; {while} + tlPtr := tlPtr^.next; + end {if} + + {expand a macro parameter} + else begin + tcPtr := pptr^.tokens; + while tcPtr <> nil do begin + tokenStart := tcPtr^.tokenStart; + tokenEnd := tcPtr^.tokenEnd; + if tcPtr^.token.kind = ident then begin + mPtr := FindMacro(tcPtr^.token.name); + inhibit := false; + if tlPtr^.next <> nil then + if tlPtr^.next^.token.kind = poundpoundop then + inhibit := true; + if lastPtr <> nil then + if lastPtr^.token.kind = poundpoundop then + inhibit := true; + if (mPtr <> nil) and (not inhibit) then + Expand(mPtr) + else + PutBackToken(tcPtr^.token, true); + end {if} + else + PutBackToken(tcPtr^.token, true); + tcPtr := tcPtr^.next; + end; {while} + end; {else} + end; {if pptr <> nil} + end {if tlPtr^.token.kind = macroParm} + else begin + + {place an explicit parm in the token list} + expandEnabled := true; + if tlPtr^.token.kind = ident then + if tlPtr^.token.name^ = macro^.name^ then + expandEnabled := false; + tokenStart := tlPtr^.tokenStart; + tokenEnd := tlPtr^.tokenEnd; + PutBackToken(tlPtr^.token, expandEnabled); + end; {else} + lastPtr := tlPtr; + tlPtr := tlPtr^.next; + end; {while} + end; {else} +while parms <> nil do begin {dispose of the parameter list} + tPtr := parms^.tokens; + while tPtr <> nil do begin + tlPtr := tPtr^.next; + dispose(tPtr); + tPtr := tlPtr; + end; {while} + parmEnd := parms^.next; + dispose(parms); + parms := parmEnd; + end; {while} +expandMacros := lexpandMacros; {restore the flags} +printMacroExpansions := lPrintMacroExpansions; +saveNumber := false; {stop saving numeric strings} +end; {Expand} + + +function GetFileName (mustExist: boolean): boolean; + +{ Read a file name from a directive line } +{ } +{ parameters: } +{ mustExist - should we look for an existing file? } +{ } +{ Returns true if successful, false if not. } +{ } +{ Note: The file name is placed in workString. } + +const + SRC = $B0; {source file type} + +var + i,j: integer; {string index & loop vars} + + + procedure Expand (var name: pString); + + { Expands a name to a full pathname } + { } + { parameters: } + { name - file name to expand } + + var + exRec: expandDevicesDCBGS; {expand devices} + + begin {Expand} + exRec.pcount := 2; + new(exRec.inName); + exRec.inName^.theString := name; + exRec.inName^.size := length(name); + new(exRec.outName); + exRec.outName^.maxSize := maxPath+4; + ExpandDevicesGS(exRec); + if toolerror = 0 then + with exRec.outName^.theString do begin + if size < maxPath then + theString[size+1] := chr(0); + name := theString; + end; {with} + dispose(exRec.inName); + dispose(exRec.outName); + end; {Expand} + + + function GetLibraryName (var name: pstring): boolean; + + { See if a library pathname is available } + { } + { Parameters: } + { name - file name; set to pathname if result is true } + { } + { Returns: True if a name is available, else false } + + var + lname: pString; {local copy of name} + + begin {GetLibraryName} + lname := concat('13:ORCACDefs:', name); + Expand(lname); + if GetFileType(lname) = SRC then begin + name := lname; + GetLibraryName := true; + end {if} + else + GetLibraryName := false; + end; {GetLibraryName} + + + function GetLocalName (var name: pstring): boolean; + + { See if a local pathname is available } + { } + { Parameters: } + { name - file name; set to pathname if result is true } + { } + { Returns: True if a name is available, else false } + + var + lname: pstring; {work string} + pp: pathRecordPtr; {used to trace the path list} + + begin {GetLocalName} + lname := name; + Expand(lname); + if GetFileType(lname) = SRC then begin + GetLocalName := true; + name := lname; + end {if} + else begin + GetLocalName := false; + pp := pathList; + while pp <> nil do begin + lname := concat(pp^.path^, name); + if GetFileType(lname) = SRC then begin + GetLocalName := true; + name := lname; + Expand(name); + pp := nil; + end {if} + else + pp := pp^.next; + end; {while} + end; {else} + end; {GetLocalName} + + + procedure MakeLibraryName (var name: pstring); + + { Create the library path name for an error message } + { } + { Parameters: } + { name - file name; set to pathname } + + begin {MakeLibraryName} + name := concat('13:ORCACDefs:', name); + Expand(name); + end; {MakeLibraryName} + + + procedure MakeLocalName (var name: pstring); + + { Create the local path name for an error message } + { } + { Parameters: } + { name - file name; set to pathname } + + begin {MakeLocalName} + Expand(name); + end; {MakeLocalName} + + +begin {GetFileName} +GetFileName := true; +gettingFileName := true; {in GetFileName} +while charKinds[ord(ch)] = ch_white do {finish processing the current line} + NextCh; +if ch = '<' then begin {process a library file...} + NextToken; {skip the '<'} + token.kind := stringconst; {convert a <> style name to a string} + token.class := stringConstant; + token.ispstring := false; + i := 0; + while not (charKinds[ord(ch)] in [ch_eol,ch_gt]) do begin + i := i+1; + if (i = maxLine) then begin + Error(16); + GetFileName := false; + i := 0; + end; + workString[i] := ch; + NextCh; + end; {while} + workString[0] := chr(i); + CheckDelimiters(workString); + if mustExist then begin + if not GetLibraryName(workString) then + if not GetLocalName(workString) then + MakeLibraryName(workString); + end {if} + else + MakeLibraryName(workString); + if ch = '>' then + NextCh + else begin + Error(15); + GetFileName := false; + end; {else} + end {if} +else begin + + {handle file names that are strings or macro expansions} + expandMacros := true; {allow macros to be used in the name} + NextToken; {skip the command name} + if token.kind = stringConst then begin + LongToPString(@workString, token.sval); + CheckDelimiters(workString); + if mustExist then begin + if not GetLocalName(workString) then + if not GetLibraryName(workString) then + MakeLocalName(workString); + end {if} + else + MakeLocalName(workString); + end {if} + else if token.kind = ltch then begin + + {expand a macro to create a form name} + NextToken; + workString[0] := chr(0); + while + (token.class in [reservedWord,intconstant,longconstant,doubleconstant]) + or (token.kind in [dotch,ident]) do begin + if token.kind = ident then + workstring := concat(workstring, token.name^) + else if token.kind = dotch then + workstring := concat(workstring, '.') + else if token.class = reservedWord then + workstring := concat(workstring, reservedWords[token.kind]) + else {if token.class in [intconst,longconst,doubleconst] then} + workstring := concat(workstring, token.numstring^); + NextToken; + end; {while} + CheckDelimiters(workString); + if mustExist then begin + if not GetLibraryName(workString) then + if not GetLocalName(workString) then + MakeLibraryName(workString); + end {if} + else + MakeLibraryName(workString); + if token.kind <> gtch then begin + Error(15); + GetFileName := false; + end; {if} + end {else if} + else begin + Error(59); + GetFileName := false; + end; {else} + end; {else} +while charKinds[ord(ch)] = ch_white {finish processing the current line} + do NextCh; +if charKinds[ord(ch)] <> ch_eol then {check for extra stuff on the line} + begin + Error(11); + GetFileName := false; + end; {if} +gettingFileName := false; {not in GetFileName} +end; {GetFileName} + + +function GetFileType {var name: pString): integer}; + +{ Checks to see if a file exists } +{ } +{ parameters: } +{ name - file name to check for } +{ } +{ Returns: File type if the file exists, or -1 if the file does } +{ not exist (or if GetFileInfo returns an error) } + +var + pathname: gsosInString; {GS/OS style name} + giRec: getFileInfoOSDCB; {GetFileInfo record} + +begin {GetFileType} +giRec.pcount := 3; +giRec.pathName := @pathname; +pathname.theString := name; +pathname.size := length(name); +GetFileInfoGS(giRec); +if ToolError = 0 then + GetFileType := giRec.fileType +else + GetFileType := -1; +end; {GetFileType} + + +function OpenFile {doInclude, default: boolean): boolean}; + +{ Open a new file and start scanning it } +{ } +{ Parameters: } +{ doInclude - are we doing a #include? } +{ default - use the name ? } +{ } +{ Returns: result from GetFileName } + +var + gotName: boolean; {did we get a file name?} + +begin {OpenFile} +if default then begin {get the file name} + workString := defaultName; + gotName := true; + end {if} +else + gotName := GetFileName(true); + +if gotName then begin {read the file name from the line} + OpenFile := true; {we opened it} + if doInclude and progress then {note our progress} + writeln('Including ', workString); + WriteLine; {write the source line} + lineNumber := lineNumber+1; + firstPtr := pointer(ord4(chPtr)+2); + needWriteLine := false; + if doInclude then {set the disp in the file} + fileList^.disp := ord4(chPtr)-ord4(bofPtr); + with ffDCBGS do begin {purge the source file} + pCount := 5; + action := 7; + pathName := @includeFileGS.theString; + end; {with} + FastFileGS(ffDCBGS); + oldincludeFileGS := includeFileGS; {set the file name} + includeFileGS.theString.theString := workString; + includeFileGS.theString.size := length(workString); + ReadFile; {read the file} + chPtr := bofPtr; {set the start, end pointers} + eofPtr := pointer(ord4(bofPtr)+ffDCBGS.fileLength); + firstPtr := chPtr; {first char in line} + ch := chr(RETURN); {set the initial character} + if languageNumber <> long(ffDCBGS.auxType).lsw then begin + switchLanguages := true; {switch languages} + chPtr := eofPtr; + if doInclude then + TermError(7); + if fileList <> nil then + TermError(8); + end; {if} + end {if} +else + OpenFile := false; {we failed to opened it} +end; {OpenFile} + + +procedure PreProcess; + +{ Handle preprocessor commands } + +label 2; + +var + lPrintMacroExpansions: boolean; {local copy of printMacroExpansions} + lReportEOL: boolean; {local copy of reportEOL} + tSkipping: boolean; {temp copy of the skipping variable} + val: integer; {expression value} + + + function Defined: boolean; + + { See if a macro is defined } + + begin {Defined} + expandMacros := false; {block expansions} + NextToken; {skip the command name} + if token.class in [reservedWord,identifier] then begin + Defined := IsDefined(token.name); {see if the macro is defined} + expandMacros := true; {enable expansions} + NextToken; {skip the macro name} + if token.kind <> eolsy then {check for extra stuff on the line} + Error(11); + end {if} + else + Error(9); + end; {Defined} + + + procedure NumericDirective; + + { Process a constant expression for a directive that has a } + { single number as the operand. } + { } + { Notes: The expression evaluator returns the value in the } + { global variable expressionValue. } + + begin {NumericDirective} + NextToken; {skip the directive name} + Expression(preprocessorExpression, []); {evaluate the expression} + end; {NumericDirective} + + + procedure ProcessIf (skip: boolean); + + { handle the processing for #if, #ifdef and #ifndef } + { } + { parameter: } + { skip - should we skip to the #else } + + var + ip: ifPtr; {used to create a new if record} + + begin {ProcessIf} + if token.kind <> eolsy then {check for extra stuff on the line} + Error(11); + new(ip); {create a new if record} + ip^.next := ifList; + ifList := ip; + if tSkipping then {set the status of the record} + ip^.status := skippingToEndif + else if skip then + ip^.status := skippingToElse + else + ip^.status := processing; + ip^.elseFound := false; {no else has been found...} + tSkipping := ip^.status <> processing; {decide if we should be skipping} + end; {ProcessIf} + + + procedure DoAppend; + + { #append } + + var + tbool: boolean; {temp boolean} + + begin {DoAppend} + tbool := OpenFile(false, false); {open a new file and proceed from there} + lineNumber := 1; + end; {DoAppend} + + + procedure DoCDA; + + { #pragma cda NAME START SHUTDOWN } + + begin {DoCDA} + FlagPragmas(p_cda); + isClassicDeskAcc := true; + NextToken; {skip the command name} + if token.kind = stringconst then {get the name} + begin + LongToPString(@menuLine, token.sval); + NextToken; + end {if} + else begin + isClassicDeskAcc := false; + Error(83); + end; {else} + if token.kind = ident then begin {get the start name} + openName := token.name; + NextToken; + end {if} + else begin + isClassicDeskAcc := false; + Error(9); + end; {else} + if token.kind = ident then begin {get the shutdown name} + closeName := token.name; + NextToken; + end {if} + else begin + isClassicDeskAcc := false; + Error(9); + end; {else} + if token.kind <> eolsy then {make sure there is nothing else on the line} + Error(11); + end; {DoCDA} + + + procedure DoCDev; + + { #pragma cdev START } + + begin {DoCDev} + FlagPragmas(p_cdev); + isCDev := true; + NextToken; {skip the command name} + if token.kind = ident then begin {get the start name} + openName := token.name; + NextToken; + end {if} + else begin + isCDev := false; + Error(9); + end; {else} + if token.kind <> eolsy then {make sure there is nothing else on the line} + Error(11); + end; {DoCDev} + + + procedure DoDefine; + + { #define } + { } + { The way parameters are handled is a bit obtuse. Parameters } + { have their own token type, with the token having an } + { associated parameter number, pnum. Pnum is the number of } + { parameters to skip to get to the parameter in the parameter } + { list. } + { } + { In the macro record, parameters indicates how many } + { parameters there are in the definition. -1 indicates that } + { there is no parameter list, while 0 indicates that a list } + { must exist, but that there are no parameters in the list. } + + label 1,2,3; + + type + stringListPtr = ^stringList; + stringList = record {for the parameter list} + next: stringListPtr; + str: pString; + end; + + var + bPtr: ^macroRecordPtr; {pointer to head of hash bucket} + done: boolean; {used to test for loop termination} + i: integer; {loop variable} + mf: macroRecordPtr; {pointer to existing macro record} + mPtr: macroRecordPtr; {pointer to new macro record} + np: stringListPtr; {new parameter} + parameterList: stringListPtr; {list of parameter names} + parameters: integer; {local copy of mPtr^.parameters} + ple: stringListPtr; {pointer to the last element in parameterList} + pnum: integer; {for counting parameters} + tPtr,tk1,tk2: tokenListRecordPtr; {pointer to a token} + + {for building token strings} + sptr: longStringPtr; {token string work pointer} + tcp: ptr; {temp character pointer} + slen: integer; {token string length} + + begin {DoDefine} + expandMacros := false; {block expansions} + saveNumber := true; {save characters in numeric tokens} + parameterList := nil; {no parameters yet} + NextToken; {get the token name} + {convert reserved words to identifiers} + if token.class = reservedWord then begin + token.name := @reservedWords[token.kind]; + token.kind := ident; + token.class := identifier; + end {if} + else if token.kind = typedef then + token.kind := ident; + + if token.kind = ident then begin {we have a name...} + mPtr := pointer(GMalloc(sizeof(macroRecord))); {create a macro record} + mPtr^.name := token.name; {record the name} + mPtr^.saved := false; {not saved in symbol file} + mPtr^.tokens := nil; {no tokens yet} + charKinds[ord('#')] := ch_pound; {allow # as a token} + if ch = '(' then begin {scan the parameter list...} + NextToken; {done with the name token...} + NextToken; {skip the opening '('} + parameters := 0; {no parameters yet} + ple := nil; + repeat {get the parameter names} + done := true; + + if token.class = reservedWord then begin + token.name := @reservedWords[token.kind]; + token.kind := ident; + token.class := identifier; + end {if} + else if token.kind = typedef then + token.kind := ident; + + if token.kind = ident then begin + new(np); + np^.next := nil; + np^.str := token.name^; + if ple = nil then + parameterList := np + else + ple^.next := np; + ple := np; + NextToken; + parameters := parameters+1; + if token.kind = commach then begin + NextToken; + done := false; + end; {if} + end; {if} + until done; + if token.kind = rparench then {insist on a matching ')'} + NextToken + else + Error(12); + end {if} + else begin + parameters := -1; {no parameter list exists} + NextToken; {done with the name token...} + end; {else} + mPtr^.parameters := parameters; {record the # of parameters} + while token.kind <> eolsy do begin {place tokens in the replace list...} + + if token.class = reservedWord then begin + token.name := @reservedWords[token.kind]; + token.kind := ident; + token.class := identifier; + end {if} + else if token.kind = typedef then + token.kind := ident; + + if token.kind = ident then begin {special handling for identifiers} + np := parameterList; {change parameters to macroParm} + pnum := 0; + while np <> nil do begin + if np^.str = token.name^ then begin + token.kind := macroParm; + token.class := macroParameter; + token.pnum := pnum; + goto 1; + end; {if} + pnum := pnum+1; + np := np^.next; + end; {while} + end; {if} +1: tPtr := pointer(GMalloc(sizeof(tokenListRecord))); + tPtr^.next := mPtr^.tokens; + mPtr^.tokens := tPtr; + tPtr^.token := token; + tPtr^.tokenStart := tokenStart; + tPtr^.tokenEnd := tokenEnd; + slen := ord(ord4(chPtr) - ord4(tokenStart)); + sptr := pointer(GMalloc(slen+2)); + sptr^.length := slen; + tcp := tokenStart; + for i := 1 to slen do begin + sptr^.str[i] := chr(tcp^); + tcp := pointer(ord4(tcp)+1); + end; {for} + tPtr^.tokenString := sptr; + NextToken; + end; {while} + mPtr^.readOnly := false; + mPtr^.algorithm := 0; + if IsDefined(mPtr^.name) then begin + mf := macroFound; + if mf^.parameters = mPtr^.parameters then begin + tk1 := mf^.tokens; + tk2 := mPtr^.tokens; + while (tk1 <> nil) and (tk2 <> nil) do begin + if tk1^.token.kind <> tk2^.token.kind then + goto 3; + if tk1^.token.class = tk2^.token.class then + case tk1^.token.class of + reservedWord, reservedSymbol: ; + identifier: + if tk1^.token.name^ <> tk2^.token.name^ then + goto 3; + intConstant: + if tk1^.token.ival <> tk2^.token.ival then + goto 3; + longConstant: + if tk1^.token.lval <> tk2^.token.lval then + goto 3; + doubleConstant: + if tk1^.token.rval <> tk2^.token.rval then + goto 3; + stringConstant: begin + if tk1^.token.sval^.length <> tk2^.token.sval^.length + then goto 3; + for i := 1 to tk1^.token.sval^.length do + if tk1^.token.sval^.str[i] <> + tk2^.token.sval^.str[i] then + goto 3; + end; + macroParameter: + if tk1^.token.pnum <> tk2^.token.pnum then + goto 3; + otherwise: + Error(57); + end; {case} + tk1 := tk1^.next; + tk2 := tk2^.next; + end; {while} + if (tk1 = nil) and (tk2 = nil) then + goto 2; + end; {if} +3: Error(5); + goto 2; + end; {if} + {insert the macro in the macro list} + bPtr := pointer(ord4(macros) + Hash(mPtr^.name)); + mPtr^.next := bPtr^; + bPtr^ := mPtr; + end {if} + else + Error(9); {identifier expected} +2: + expandMacros := true; {enable expansions} + while parameterList <> nil do begin {dump the parameter names} + np := parameterList; + parameterList := np^.next; + dispose(np); + end; {while} + charKinds[ord('#')] := illegal; {don't allow # as a token} + saveNumber := false; {stop saving numeric strings} + end; {DoDefine} + + + procedure DoElif; + + { #elif expression } + + var + ip: ifPtr; {temp; for efficiency} + + begin {DoElif} + ip := ifList; + if ip <> nil then begin + {decide if we should be skipping} + tSkipping := ip^.status <> skippingToElse; + if tSkipping then + ip^.status := skippingToEndif + else begin + {evaluate the condition} + NumericDirective; {evaluate the condition} + if token.kind <> eolsy then {check for extra stuff on the line} + Error(11); + if expressionValue = 0 then + ip^.status := skippingToElse + else + ip^.status := processing; + tSkipping := ip^.status <> processing; {decide if we should be skipping} + end; {else} + end + else + Error(20); + end; {DoElif} + + + procedure DoElse; + + { #else } + + begin {DoElse} + NextToken; {skip the command name} + if token.kind <> eolsy then {check for extra stuff on the line} + Error(11); + if ifList <> nil then begin + if ifList^.elseFound then {check for multiple elses} + Error(19) + else + ifList^.elseFound := true; + {decide if we should be skipping} + tSkipping := ifList^.status <> skippingToElse; + if tSkipping then {set the status} + ifList^.status := skippingToEndif + else + ifList^.status := processing; + end + else + Error(20); + end; {DoElse} + + + procedure DoEndif; + + { #endif } + + var + ip: ifPtr; {used to create a new if record} + + begin {DoEndif} + NextToken; {skip the command name} + if token.kind <> eolsy then {check for extra stuff on the line} + Error(11); + if ifList <> nil then begin + ip := ifList; {remove the top if record from the list} + ifList := ip^.next; + dispose(ip); + if ifList = nil then {decide if we should be skipping} + tSkipping := false + else + tSkipping := ifList^.status <> processing; + end {if} + else + Error(20); + end; {DoEndif} + + + procedure DoError; + + { #error STRING } + + var + i: integer; {loop variable} + len: integer; {string length} + msg: stringPtr; {error message ptr} + + begin {DoError} + NextToken; {skip the command name} + if token.kind = stringConst then begin + numErrors := numErrors+1; + new(msg); + len := token.sval^.length; + if len > 246 then + len := 246; + msg^ := '#error: '; + for i := 1 to len do + msg^ := concat(msg^, token.sval^.str[i]); + writeln(msg^); + if terminalErrors then begin + if enterEditor then + ExitToEditor(msg, ord4(firstPtr)-ord4(bofPtr)) + else + TermError(0); + end; {if} + end {if} + else + Error(83); + NextToken; {skip the command name} + if token.kind <> eolsy then {check for extra stuff on the line} + Error(11); + end; {DoError} + + + procedure DoFloat; + + { #pragma float NUMBER NUMBER } + + begin {DoFloat} + FlagPragmas(p_float); + NextToken; + if token.kind in [intconst,uintconst] then begin + floatCard := token.ival; + NextToken; + end {if} + else + Error(18); + if token.kind in [intconst,uintconst] then begin + floatSlot := $C080 | (token.ival << 4); + NextToken; + end {if} + else + Error(18); + end; {DoFloat} + + + procedure DoKeep; + + { #pragma keep FILENAME } + + begin {DoKeep} + FlagPragmas(p_keep); + if GetFileName(false) then begin {read the file name} + if foundFunction then + Error(17); + if liDCBGS.kFlag = 0 then begin {use the old name if there is one...} + liDCBGS.kFlag := 1; + outFileGS.theString.theString := workString; + outFileGS.theString.size := length(workString); + end; {if} + end; {if} + end; {DoKeep} + + + procedure DoNBA; + + { #pragma nba MAIN } + + begin {DoNBA} + FlagPragmas(p_nba); + isNBA := true; + NextToken; {skip the command name} + if token.kind = ident then begin {get the open name} + openName := token.name; + NextToken; + end {if} + else begin + isNBA := false; + Error(9); + end; {else} + if token.kind <> eolsy then {make sure there is nothing else on the line} + Error(11); + end; {DoNBA} + + + procedure DoNDA; + + { #pragma nda OPEN CLOSE ACTION INIT PERIOD EVENTMASK MENULINE} + + + function GetInteger: integer; + + { Get a signed integer constant } + + var + isNegative: boolean; {is the value negative?} + value: integer; {value to return} + + begin {GetInteger} + isNegative := false; + value := 0; + if token.kind = plusch then + NextToken + else if token.kind = minusch then begin + NextToken; + isNegative := true; + end; {else if} + if token.kind in [intconst,uintconst] then begin + value := token.ival; + NextToken; + end {if} + else begin + isNewDeskAcc := false; + Error(18); + end; {else} + if isNegative then + GetInteger := -value + else + GetInteger := value; + end; {GetInteger} + + + begin {DoNDA} + FlagPragmas(p_nda); + isNewDeskAcc := true; + NextToken; {skip the command name} + if token.kind = ident then begin {get the open name} + openName := token.name; + NextToken; + end {if} + else begin + isNewDeskAcc := false; + Error(9); + end; {else} + if token.kind = ident then begin {get the close name} + closeName := token.name; + NextToken; + end {if} + else begin + isNewDeskAcc := false; + Error(9); + end; {else} + if token.kind = ident then begin {get the action name} + actionName := token.name; + NextToken; + end {if} + else begin + isNewDeskAcc := false; + Error(9); + end; {else} + if token.kind = ident then begin {get the init name} + initName := token.name; + NextToken; + end {if} + else begin + isNewDeskAcc := false; + Error(9); + end; {else} + refreshPeriod := GetInteger; {get the period} + eventMask := GetInteger; {get the event Mask} + if token.kind = stringconst then {get the name} + begin + LongToPString(@menuLine, token.sval); + NextToken; + end {if} + else begin + isNewDeskAcc := false; + Error(83); + end; {else} + if token.kind <> eolsy then {make sure there is nothing else on the line} + Error(11); + end; {DoNDA} + + + procedure DoUndef; + + { #undef } + + label 1; + + var + bPtr: ^macroRecordPtr; {hash bucket pointer} + mPtr,lastPtr: macroRecordPtr; {work pointers} + + begin {DoUndef} + expandMacros := false; {block expansions} + NextToken; {get the token name} + {convert reserved words to identifiers} + if token.class = reservedWord then begin + token.name := @reservedWords[token.kind]; + token.kind := ident; + token.class := identifier; + end; {if} + if token.kind = ident then begin + {find the bucket to search} + bPtr := pointer(ord4(macros)+Hash(token.name)); + lastPtr := nil; {find and delete the macro entry} + mPtr := bPtr^; + while mPtr <> nil do begin + if mPtr^.name^ = token.name^ then begin + if mPtr^.readOnly then + Error(10) + else begin + if lastPtr = nil then + bPtr^ := mPtr^.next + else + lastPtr^.next := mPtr^.next; + end; {else} + goto 1; + end; {if} + lastPtr := mPtr; + mPtr := mPtr^.next; + end; {while} + end {if} + else + Error(9); {identifier expected} +1: + expandMacros := true; {enable expansions} + NextToken; {skip the macro name} + if token.kind <> eolsy then {make sure there's no junk on the line} + Error(11); + end; {DoUndef} + + + procedure DoXCMD; + + { #pragma xcmd MAIN } + + begin {DoXCMD} + FlagPragmas(p_xcmd); + isXCMD := true; + NextToken; {skip the command name} + if token.kind = ident then begin {get the open name} + openName := token.name; + NextToken; + end {if} + else begin + isXCMD := false; + Error(9); + end; {else} + if token.kind <> eolsy then {make sure there is nothing else on the line} + Error(11); + end; {DoXCMD} + + +begin {PreProcess} +lPrintMacroExpansions := printMacroExpansions; {inhibit token printing} +printMacroExpansions := false; +lReportEOL := reportEOL; {we need to see eol's} +reportEOL := true; +tSkipping := skipping; {don't skip the directive name!} +skipping := false; +NextCh; {skip the '#' char} +while charKinds[ord(ch)] = ch_white do {skip white space} + NextCh; +if ch in ['a','d','e','i','l','p','u'] then begin + NextToken; + case token.kind of + ifsy: begin + NumericDirective; + ProcessIf(expressionValue = 0); + goto 2; + end; + elsesy: begin + DoElse; + goto 2; + end; + ident: begin + case token.name^[1] of + 'a': + if token.name^ = 'append' then begin + if tskipping then goto 2; + DoAppend; + goto 2; + end; {if} + 'd': + if token.name^ = 'define' then begin + if tskipping then goto 2; + DoDefine; + goto 2; + end; {if} + 'e': + if token.name^ = 'endif' then begin + DoEndif; + goto 2; + end {if} + else if token.name^ = 'else' then begin + DoElse; + goto 2; + end {else if} + else if token.name^ = 'elif' then begin + DoElif; + goto 2; + end {else if} + else if token.name^ = 'error' then begin + if tskipping then goto 2; + DoError; + goto 2; + end; {else if} + 'i': + if token.name^ = 'if' then begin + NumericDirective; + ProcessIf(expressionValue = 0); + goto 2; + end {if} + else if token.name^ = 'ifdef' then begin + ProcessIf(not Defined); + goto 2; + end {else} + else if token.name^ = 'ifndef' then begin + ProcessIf(Defined); + goto 2; + end {else} + else if token.name^ = 'include' then begin + if tskipping then goto 2; + DoInclude(false); + goto 2; + end; {else} + 'l': + if token.name^ = 'line' then begin + if tskipping then goto 2; + FlagPragmas(p_line); + NextToken; + if token.kind = intconst then begin + lineNumber := token.ival; + NextToken; + end {if} + else + Error(18); + if lineNumber < 0 then + lineNumber := 0; + if token.kind = stringconst then begin + LongToPString( + pointer(ord4(@sourceFileGS.theString)+1), + token.sval); + sourceFileGS.theString.size := token.sval^.length; + NextToken; + end; {if} + if token.kind <> eolsy then + Error(11); + goto 2; + end; {if} + 'p': + if token.name^ = 'pragma' then begin + if tskipping then goto 2; + NextToken; + if token.name^ = 'keep' then + DoKeep + else if token.name^ = 'debug' then begin + { debug bits: } + { 1 - range checking } + { 2 - create debug code } + { 4 - generate profiles } + { 8 - generate traceback code } + { 16 - check for stack errors } + FlagPragmas(p_debug); + NumericDirective; + val := long(expressionValue).lsw; + rangeCheck := odd(val); + debugFlag := odd(val >> 1); + profileFlag := odd(val >> 2); + traceBack := odd(val >> 3); + checkStack := odd(val >> 4); + profileFlag := profileFlag or debugFlag; + if token.kind <> eolsy then + Error(11); + goto 2; + end {else} + else if token.name^ = 'lint' then begin + FlagPragmas(p_lint); + NumericDirective; + lint := long(expressionValue).lsw; + if token.kind <> eolsy then + Error(11); + goto 2; + end {else} + else if token.name^ = 'memorymodel' then begin + FlagPragmas(p_memorymodel); + NumericDirective; + smallMemoryModel := expressionValue = 0; + if token.kind <> eolsy then + Error(11); + end {else if} + else if token.name^ = 'expand' then begin + FlagPragmas(p_expand); + NumericDirective; + lPrintMacroExpansions := expressionValue <> 0; + if token.kind <> eolsy then + Error(11); + end {else if} + else if token.name^ = 'optimize' then begin + { optimize bits: } + { 1 - intermediate code peephole } + { 2 - native peephole } + { 4 - register value tracking } + { 8 - remove stack checks } + { 16 - common subexpression elimination } + { 32 - loop invariant removal } + FlagPragmas(p_optimize); + NumericDirective; + val := long(expressionValue).lsw; + peepHole := odd(val); + npeepHole := odd(val >> 1); + registers := odd(val >> 2); + saveStack := not odd(val >> 3); + commonSubexpression := odd(val >> 4); + loopOptimizations := odd(val >> 5); + strictVararg := not odd(val >> 6); + if saveStack or strictVararg then + npeepHole := false; + if token.kind <> eolsy then + Error(11); + end {else if} + else if token.name^ = 'unix' then begin + { unix bits: } + { 1 - int is 32 bits } + FlagPragmas(p_unix); + NumericDirective; + val := long(expressionValue).lsw; + unix_1 := odd(val); + if token.kind <> eolsy then + Error(11); + end {else if} + else if token.name^ = 'stacksize' then begin + FlagPragmas(p_stacksize); + NumericDirective; + stackSize := long(expressionValue).lsw; + if token.kind <> eolsy then + Error(11); + end {else if} + else if token.name^ = 'cda' then + DoCDA + else if token.name^ = 'cdev' then + DoCDev + else if token.name^ = 'nda' then + DoNDA + else if token.name^ = 'nba' then + DoNBA + else if token.name^ = 'xcmd' then + DoXCMD + else if token.name^ = 'toolparms' then begin + FlagPragmas(p_toolparms); + NumericDirective; + toolParms := expressionValue <> 0; + if token.kind <> eolsy then + Error(11); + end {else if} + else if token.name^ = 'databank' then begin + FlagPragmas(p_databank); + NumericDirective; + dataBank := expressionValue <> 0; + if token.kind <> eolsy then + Error(11); + end {else if} + else if token.name^ = 'float' then + DoFloat + else if token.name^ = 'rtl' then begin + FlagPragmas(p_rtl); + rtl := true; + NextToken; + if token.kind <> eolsy then + Error(11); + end {else if} + else if token.name^ = 'noroot' then begin + FlagPragmas(p_noroot); + noroot := true; + NextToken; + if token.kind <> eolsy then + Error(11); + end {else if} +{ else if token.name^ = 'printmacros' then begin {debug} +{ PrintMacroTable; + NextToken; + if token.kind <> eolsy then + Error(11); + end {else if} + else if token.name^ = 'path' then begin + NextToken; + if token.kind = stringConst then begin + LongToPString(workString, token.sval); + AddPath(workString); + NextToken; + end {if} + else + Error(83); + if token.kind <> eolsy then + Error(11); + end {else if} + else if token.name^ = 'ignore' then begin + { ignore bits: } + { 1 - don't flag illegal tokens in skipped source } + { 8 - allow // comments } + FlagPragmas(p_ignore); + NumericDirective; + val := long(expressionValue).lsw; + skipIllegalTokens := odd(val); + slashSlashComments := odd(val >> 3); + if token.kind <> eolsy then + Error(11); + end {else if} + else if (lint & lintPragmas) <> 0 then + Error(110); + goto 2; + end; {if} + 'u': + if token.name^ = 'undef' then begin + if tskipping then goto 2; + DoUndef; + goto 2; + end; {if} + otherwise: Error(57); + end; {case} + end; + otherwise: ; + end; {case} + end {if} +else if charKinds[ord(ch)] = ch_eol {allow null commands} + then begin + NextToken; + goto 2; + end; {else if} +Error(8); {bad preprocessor command} +2: +charKinds[ord('#')] := ch_pound; {allow # as a token} +expandMacros := false; {skip to the end of the line} +flagOverflows := false; +skipping := tSkipping; +while not (token.kind in [eolsy,eofsy]) do + NextToken; +flagOverflows := true; +expandMacros := true; +charKinds[ord('#')] := illegal; {don't allow # as a token} +reportEOL := lReportEOL; {restore flags} +printMacroExpansions := lPrintMacroExpansions; +skipping := tskipping; +end; {PreProcess} + +{-- Externally available routines ------------------------------} + +procedure DoDefaultsDotH; + +{ Handle the defaults.h file } + +var + name: pString; {name of the default file} + +begin {DoDefaultsDotH} +name := defaultName; +if GetFileType(name) <> -1 then + DoInclude(true); +end; {DoDefaultsDotH} + + +procedure Error {err: integer}; + +{ flag an error } +{ } +{ err - error number } + +begin {Error} +if numErr = maxErr then {set the error number} + errors[maxErr].num := 4 +else begin + numErr := numErr+1; + numErrors := numErrors+1; + liDCBGS.merrf := 16; + errors[numErr].num := err; + end; {else} +with errors[numErr] do begin {record the position of the error} + line := tokenLine; + col := tokenColumn; + end; {with} +codeGeneration := false; {inhibit code generation} +end; {Error} + + +{procedure Error2 {loc, err: integer} {debug} + +{ flag an error } +{ } +{ loc - error location } +{ err - error number } + +{begin {Error2} +{writeln('Error ', err:1, ' flagged at location ', loc:1); +Error(err); +end; {Error2} + + +procedure DoNumber {scanWork: boolean}; + +{ The current character starts a number - scan it } +{ } +{ Parameters: } +{ scanWork - get characters from workString? } +{ } +{ Globals: } +{ ch - first character in sequence; set to first char } +{ after sequence } +{ workString - string to take numbers from } + +label 1; + +var + c2: char; {next character to process} + i: integer; {loop index} + isHex: boolean; {is the value a hex number?} + isLong: boolean; {is the value a long number?} + isReal: boolean; {is the value a real number?} + numIndex: 0..maxLine; {index into workString} + sp: stringPtr; {for saving identifier names} + stringIndex: 0..maxLine; {length of the number string} + unsigned: boolean; {is the number unsigned?} + val: integer; {value of a digit} + + numString: pString; {characters in the number} + + + procedure NextChar; + + { Return the next character that is a part of the number } + + begin {NextChar} + if scanWork then begin + if ord(workString[0]) <> numIndex then begin + numIndex := numIndex+1; + c2 := workString[numIndex]; + end {if} + else + c2 := ' '; + end {if} + else begin + NextCh; + c2 := ch; + end; {else} + end; {NextChar} + + + procedure GetDigits; + + { Read in a digit stream } + { } + { Variables: } + { c2 - next character to process } + { numString - digit sequence added to this string } + { stringIndex - length of the string } + + begin {GetDigits} + while (charKinds[ord(c2)] = digit) or + (isHex and (c2 in ['a'..'f','A'..'F'])) do begin + if c2 in ['a'..'f'] then + c2 := chr(ord(c2) & $5F); + stringIndex := stringIndex+1; + if stringIndex > 255 then begin + Error(6); + stringIndex := 1; + end; {if} + numString[stringIndex] := c2; + NextChar; + end; {while} + end; {GetDigits} + + +begin {DoNumber} +isHex := false; {assume it's not hex} +isReal := false; {assume it's an integer} +isLong := false; {assume a short integer} +unsigned := false; {assume signed numbers} +stringIndex := 0; {no digits so far...} +if scanWork then begin {set up the scanner} + numIndex := 0; + NextChar; + end {if} +else + c2 := ch; +if c2 = '.' then begin {handle the case of no leading digits} + stringIndex := 1; + numString[1] := '0'; + end {if} +else begin + GetDigits; {read the leading digit stream} + if c2 in ['x','X'] then {detect hex numbers} + if stringIndex = 1 then + if numString[1] = '0' then begin + stringIndex := 2; + numString[2] := 'X'; + NextChar; + isHex := true; + GetDigits; + goto 1; + end; {if} + end; +if c2 = '.' then begin {handle a decimal} + stringIndex := stringIndex+1; + numString[stringIndex] := '.'; + NextChar; + isReal := true; + if charKinds[ord(c2)] = digit then + GetDigits + else if stringIndex = 2 then begin + numString[3] := '0'; + stringIndex := 3; + end; {else} + end; {if} +if c2 in ['e','E'] then begin {handle an exponent} + stringIndex := stringIndex+1; + numString[stringIndex] := 'e'; + NextChar; + isReal := true; + if c2 in ['+','-'] then begin + stringIndex := stringIndex+1; + numString[stringIndex] := c2; + NextChar; + end; {if} + if c2 in ['0'..'9'] then + GetDigits + else begin + stringIndex := stringIndex+1; + numString[stringIndex] := '0'; + Error(101); + end; {else} + end; {if} +1: +while c2 in ['l','u','L','U'] do {check for long or unsigned} + if c2 in ['l','L'] then begin + NextChar; + if not isReal then + isLong := true; + end {if} + else {if c2 in ['u','U'] then} begin + NextChar; + unsigned := true; + if isReal then + Error(91); + end; {else} +if c2 in ['f','F'] then begin {allow F designator on reals} + if unsigned then + Error(91); + if not isReal then begin + Error(100); + isReal := true; + end; {if} + NextChar; + end; {if} +numString[0] := chr(stringIndex); {set the length of the string} +if isReal then begin {convert a real constant} + token.kind := doubleConst; + token.class := doubleConstant; + if stringIndex > 80 then begin + Error(6); + token.rval := 0.0; + end {if} + else + token.rval := cnvsd(numString); + end {if} +else if numString[1] <> '0' then begin {convert a decimal integer} + if (stringIndex > 5) + or (not unsigned and (stringIndex = 5) and (numString > '32767')) + or (unsigned and (stringIndex = 5) and (numString > '65535')) then + isLong := true; + if (stringIndex > 10) or + ((stringIndex = 10) and (numString > '4294967295')) then begin + numString := '0'; + if flagOverflows then + Error(6); + end; {if} + if isLong then begin + token.class := longConstant; + token.lval := Convertsl(numString); + if unsigned then + token.kind := ulongConst + else begin + token.kind := longConst; + if token.lval < 0 then + token.kind := ulongConst; + end; {else} + end {if} + else begin + if unsigned then + token.kind := uintConst + else + token.kind := intConst; + token.class := intConstant; + token.lval := Convertsl(numString); + end; {else} + end {else if} +else begin {hex & octal} + token.lval := 0; + if isHex then begin + i := 3; + while i <= length(numString) do begin + if token.lval & $F0000000 <> 0 then begin + i := maxint; + if flagOverflows then + Error(6); + end {if} + else begin + if numString[i] > '9' then + val := (ord(numString[i])-7) & $000F + else + val := ord(numString[i]) & $000F; + token.lval := (token.lval << 4) | val; + i := i+1; + end; {else} + end; {while} + end {if} + else begin + i := 1; + while i <= length(numString) do begin + if token.lval & $E0000000 <> 0 then begin + i := maxint; + if flagOverflows then + Error(6); + end {if} + else begin + if numString[i] in ['8','9'] then + Error(7); + token.lval := (token.lval << 3) | (ord(numString[i]) & $0007); + i := i+1; + end; {else} + end; {while} + end; {else} + if long(token.lval).msw <> 0 then + isLong := true; + if isLong then begin + if unsigned then + token.kind := ulongConst + else + token.kind := longConst; + token.class := longConstant; + end {if} + else begin + if (long(token.lval).lsw & $8000) <> 0 then + unsigned := true; + if unsigned then + token.kind := uintConst + else + token.kind := intConst; + token.class := intConstant; + end; {else} + end; {else} +if saveNumber then begin + sp := pointer(GMalloc(length(numString)+1)); + CopyString(pointer(sp), @numString); + token.numString := sp; + end; {if} +if scanWork then {make sure we read all characters} + if ord(workString[0]) <> numIndex then + Error(63); +end; {DoNumber} + + +procedure InitScanner {start, end: ptr}; + +{ initialize the scanner } +{ } +{ start - pointer to the first character in the file } +{ end - points one byte past the last character in the file } + +var + chi: minChar..maxChar; {loop variable} + lch: char; {next command line character} + cp: ptr; {character pointer} + i: 0..hashSize; {loop variable} + negative: boolean; {is a number nagative?} + + mp: macroRecordPtr; {for building the predefined macros} + bp: ^macroRecordPtr; + + timeString: packed array[1..20] of char; {time from misc. tools} + + + procedure NextCh; + + { Get the next character from the command line } + + begin {NextCh} + lch := chr(cp^); + cp := pointer(ord4(cp)+1); + tokenColumn := tokenColumn+1; + if tokenColumn > infoStringGS.theString.size then + lch := chr(0); + end; {NextCh} + + + function GetWord: stringPtr; + + { Read a word from the command line } + + var + i: integer; {string index} + sp: stringPtr; {string pointer} + + begin {GetWord} + i := 0; + while not (lch in [' ', chr(0), chr(9), '=']) do begin + i := i+1; + workString[i] := lch; + NextCh; + end; {while} + workString[0] := chr(i); + sp := pointer(malloc(length(workString)+1)); + CopyString(pointer(sp), @workString); + GetWord := sp; + end; {GetWord} + + + function EscapeCh: integer; + + { Find and return the next character in a string or char } + { constant. Handle escape sequences if they are found. } + { (The character is returned as an ordinal value.) } + { } + { Globals: } + { lch - first character in sequence; set to first char } + { after sequence } + + label 1; + + var + dig: 0..15; {value of a hex digit} + skipChar: boolean; {get next char when done?} + val: 0..4095; {hex escape code value (scaled to 0..255)} + + begin {EscapeCh} +1: skipChar := true; + if lch = '\' then begin + NextCh; + if lch in ['0'..'7','a','b','t','n','v','f','p','r','x'] then + case lch of + '0','1','2','3','4','5','6','7': begin + val := 0; + while lch in ['0'..'7'] do begin + val := (val << 3) | (ord(lch) & 7); + NextCh; + end; {while} + EscapeCh := val & $FF; + skipChar := false; + end; + 'a': EscapeCh := 7; + 'b': EscapeCh := 8; + 't': EscapeCh := 9; + 'n': EscapeCh := 10; + 'v': EscapeCh := 11; + 'f': EscapeCh := 12; + 'p': begin + EscapeCh := ord('p'); + ispstring := true; + end; + 'r': EscapeCh := 13; + 'x': begin + val := 0; + NextCh; + while lch in ['0'..'9','a'..'f','A'..'F'] do begin + if lch in ['0'..'9'] then + dig := ord(lch) & $0F + else begin + lch := chr(ord(lch)&$5F); + dig := ord(lch)-ord('A')+10; + end; {else} + val := (val << 4) | dig; + NextCh; + end; {while} + skipChar := false; + EscapeCh := val & $FF; + end; + otherwise: Error(57); + end {case} + else + EscapeCh := ord(lch); + end {if} + else + EscapeCh := ord(lch); + if skipChar then + NextCh; + end; {EscapeCh} + + + procedure GetString; + + { read a string token from the command line } + + var + i: integer; {string length} + setLength: boolean; {is the current string a p-string?} + sPtr: longstringPtr; {work string pointer} + + begin {GetString} + token.kind := stringconst; {set up the token} + token.class := stringConstant; + i := 0; {set up for the string scan} + ispstring := false; + setLength := false; + new(sPtr); + NextCh; {skip the opening "} + {read the characters} + while not (charKinds[ord(lch)] in [ch_string,ch_eol,ch_eof]) do begin + i := i+1; + if i = longstringlen then begin + i := 1001; + Error(90); + end; {if} + sPtr^.str[i] := chr(EscapeCh); + if (i = 1) and ispstring then + setLength := true; + end; {while} + if lch = '"' then {process the end of the string} + NextCh + else + Error(3); + if setLength then {check for a p-string} + sPtr^.str[1] := chr(i-1); + token.ispstring := setLength; + sPtr^.length := i; {set the string length} + token.sval := pointer(Malloc(i+3)); {put the string in the string pool} + CopyLongString(token.sval, pointer(sPtr)); + dispose(sPtr); + token.sval^.str[i+1] := chr(0); {add null in case the string is extended} + end; {GetString} + + +begin {InitScanner} +printMacroExpansions := false; {don't print the token list} +skipIllegalTokens := false; {flag illegal tokens in skipped code} +slashSlashComments := true; {allow // comments} +foundFunction := false; {no functions found so far} +fileList := nil; {no included files} +gettingFileName := false; {not in GetFileName} +ifList := nil; {no conditional comp. records} +skipping := false; {not skipping tokens} +flagOverflows := true; {flag overflow errors?} +new(macros); {no preprocessor macros so far} +for i := 0 to hashSize do + macros^[i] := nil; +pathList := nil; {no additional search paths} +charKinds[ord('#')] := illegal; {don't allow # as a token} +tokenList := nil; {nothing in putback buffer} +saveNumber := false; {don't save numbers} +expandMacros := true; {enable macro expansion} +reportEOL := false; {report eolsy as a token?} +lineNumber := 1; {start the line counter} +chPtr := start; {set the start, end pointers} +eofPtr := endPtr; +firstPtr := start; {first char in line} +numErr := 0; {no errors so far} +numErrors := 0; +includeCount := 0; {no pending calls to EndInclude} +lint := 0; {turn off lint checks} +ch := chr(RETURN); {set the initial character} +needWriteLine := false; {no lines are pending} +switchLanguages := false; {not switching languages} +lastWasReturn := false; {last char was not return} +doingstring := false; {not doing a string} +unix_1 := false; {int is 16 bits} + +new(mp); {__LINE__} +mp^.name := @'__LINE__'; +mp^.parameters := -1; +mp^.tokens := nil; +mp^.readOnly := true; +mp^.algorithm := 1; +bp := pointer(ord4(macros) + hash(mp^.name)); +mp^.next := bp^; +bp^ := mp; +new(mp); {__FILE__} +mp^.name := @'__FILE__'; +mp^.parameters := -1; +mp^.tokens := nil; +mp^.readOnly := true; +mp^.algorithm := 2; +bp := pointer(ord4(macros) + hash(mp^.name)); +mp^.next := bp^; +bp^ := mp; +new(mp); {__DATE__} +mp^.name := @'__DATE__'; +mp^.parameters := -1; +mp^.tokens := nil; +mp^.readOnly := true; +mp^.algorithm := 3; +bp := pointer(ord4(macros) + hash(mp^.name)); +mp^.next := bp^; +bp^ := mp; +new(mp); {__TIME__} +mp^.name := @'__TIME__'; +mp^.parameters := -1; +mp^.tokens := nil; +mp^.readOnly := true; +mp^.algorithm := 4; +bp := pointer(ord4(macros) + hash(mp^.name)); +mp^.next := bp^; +bp^ := mp; +new(mp); {__STDC__} +mp^.name := @'__STDC__'; +mp^.parameters := -1; +mp^.tokens := nil; +mp^.readOnly := true; +mp^.algorithm := 5; +bp := pointer(ord4(macros) + hash(mp^.name)); +mp^.next := bp^; +bp^ := mp; +new(mp); {__ORCAC__} +mp^.name := @'__ORCAC__'; +mp^.parameters := -1; +mp^.tokens := nil; +mp^.readOnly := true; +mp^.algorithm := 5; +bp := pointer(ord4(macros) + hash(mp^.name)); +mp^.next := bp^; +bp^ := mp; +new(mp); {__VERSION__} +mp^.name := @'__VERSION__'; +mp^.parameters := -1; +mp^.tokens := nil; +mp^.readOnly := true; +mp^.algorithm := 6; +bp := pointer(ord4(macros) + hash(mp^.name)); +mp^.next := bp^; +bp^ := mp; +SetDateTime; {set up the macro date/time strings} + {set up the version string} +versionStrL := pointer(GMalloc(3 + length(versionStr))); +versionStrL^.length := length(versionStr); +versionStrL^.str := versionStr; + +{Scan the command line options} +cp := @infoStringGS.theString.theString; +tokenLine := 0; +tokenColumn := 0; +NextCh; +repeat + while lch in [' ', chr(9)] do {skip leading blanks} + NextCh; + if lch = '-' then begin {see if we have found one} + NextCh; + if lch in ['d','D'] then begin + NextCh; {yes -> get the name} + new(mp); {form the macro table entry} + mp^.name := GetWord; + mp^.parameters := -1; + mp^.tokens := nil; + mp^.readOnly := false; + bp := pointer(ord4(macros) + hash(mp^.name)); + mp^.next := bp^; + bp^ := mp; + if lch = '=' then begin + NextCh; {record the value} + token.numString := nil; + if lch in ['a'..'z', 'A'..'Z', '_'] then begin + token.kind := ident; + token.class := identifier; + token.name := GetWord; + token.symbolPtr := nil; + end {if} + else if lch in ['+','-'] then begin + negative := lch = '-'; + NextCh; + if lch in ['.','0'..'9'] then begin + token.name := GetWord; + DoNumber(true); + if negative then + case token.class of + intConstant : token.ival := -token.ival; + longConstant : token.lval := -token.lval; + doubleConstant: token.rval := -token.rval; + otherwise: ; + end; {case} + end {if} + else begin + token.kind := intconst; + token.numString := nil; + token.class := intConstant; + token.ival := 0; + end; {else} + end {else if} + else if lch in ['.','0'..'9'] then begin + token.name := GetWord; + DoNumber(true); + end {else if} + else if lch = '"' then + GetString + else + Error(108); + end {if} + else begin + token.kind := intconst; {create the default value} + token.numString := nil; + token.class := intConstant; + token.ival := 1; + end; {else} + new(mp^.tokens); {add the value to the definition} + with mp^.tokens^ do begin + next := nil; + tokenString := nil; + expandEnabled := true; + tokenStart := nil; + tokenEnd := nil; + end; {with} + mp^.tokens^.token := token; + end {if} + else if lch in ['i','I'] then begin + NextCh; {gat the pathname} + if lch = '"' then begin + GetString; + LongToPString(workString, token.sval); + AddPath(workString); + end {if} + else + Error(103); + end {if} + else {not -p, -i: flag the error} + Error(108); + end {if} + else if lch <> chr(0) then begin + Error(108); {unknown option: flag the error} + lch := chr(0); + end; {else} +until lch = chr(0); {if more characters, loop} +end; {InitScanner} + + +procedure CheckIdentifier; + +{ See if an identifier is a reserved word, macro or typedef } + +label 1; + +var + bPtr: ^macroRecordPtr; {pointer to hash bucket} + mPtr: macroRecordPtr; {for checking list of macros} + rword: tokenEnum; {loop variable} + sp: stringPtr; {for saving identifier names} + lPrintMacroExpansions: boolean; {local copy of printMacroExpansions} + +begin {CheckIdentifier} +if expandMacros then {handle macro expansions} + if not skipping then begin + mPtr := FindMacro(@workstring); + if mPtr <> nil then begin + Expand(mPtr); + lPrintMacroExpansions := printMacroExpansions; + printMacroExpansions := false; + NextToken; + printMacroExpansions := lPrintMacroExpansions; + goto 1; + end; + end; {if} + {see if it's a reserved word} +if workString[1] in ['a'..'g','i','l','p','r'..'w'] then + for rword := wordHash[ord(workString[1])-ord('a')] to + pred(wordHash[ord(succ(workString[1]))-ord('a')]) do + if reservedWords[rword] = workString then begin + token.kind := rword; + token.class := reservedWord; + goto 1; + end; {if} +token.symbolPtr := nil; {see if it's a typedef name} +if FindSymbol(token,allSpaces,false,false) <> nil then begin + if token.symbolPtr^.class = typedefsy then + token.kind := typedef; + token.name := token.symbolPtr^.name; {use the old name} + end {if} +else begin {record the name} + sp := pointer(Malloc(length(workString)+1)); + CopyString(pointer(sp), @workString); + token.name := sp; + end; {else} +1: +end; {CheckIdentifier} + + +procedure NextToken; + +{ Read the next token from the file. } + +label 1,2,3,4; + +type + three = (s100,s1000,s4000); {these declarations are used for a} + gstringPtr = ^gstringRecord; { variable length string record } + gstringRecord = record + case three of + s100: (len1: integer; + str1: packed array[1..100] of char; + ); + s1000: (len2: integer; + str2: packed array[1..1000] of char; + ); + s4000: (len3: integer; + str3: packed array[1..longstringlen] of char; + ); + end; + +var + done: boolean; {loop termination} + expandEnabled: boolean; {can a token be expanded?} + i: 0..maxint; {loop/index counter} + inhibit: boolean; {inhibit macro expansion?} + lPrintMacroExpansions: boolean; {local copy of printMacroExpansions} + mPtr: macroRecordPtr; {for checking list of macros} + setLength: boolean; {is the current string a p-string?} + tPtr: tokenListRecordPtr; {for removing tokens from putback buffer} + tToken: tokenType; {for merging tokens} + sPtr,tsPtr: gstringPtr; {for forming string constants} + + + function EscapeCh: integer; + + { Find and return the next character in a string or char } + { constant. Handle escape sequences if they are found. } + { (The character is returned as an ordinal value.) } + { } + { Globals: } + { ch - first character in sequence; set to first char } + { after sequence } + + label 1; + + var + dig: 0..15; {value of a hex digit} + skipChar: boolean; {get next char when done?} + val: 0..4095; {hex escape code value (scaled to 0..255)} + + begin {EscapeCh} +1: skipChar := true; + if ch = '\' then begin + NextCh; + if ch in ['0'..'7','a','b','t','n','v','f','p','r','x'] then + case ch of + '0','1','2','3','4','5','6','7': begin + val := 0; + while ch in ['0'..'7'] do begin + val := (val << 3) | (ord(ch) & 7); + NextCh; + end; {while} + EscapeCh := val & $FF; + skipChar := false; + end; + 'a': EscapeCh := 7; + 'b': EscapeCh := 8; + 't': EscapeCh := 9; + 'n': EscapeCh := 10; + 'v': EscapeCh := 11; + 'f': EscapeCh := 12; + 'p': begin + EscapeCh := ord('p'); + ispstring := true; + end; + 'r': EscapeCh := 13; + 'x': begin + val := 0; + NextCh; + while ch in ['0'..'9','a'..'f','A'..'F'] do begin + if ch in ['0'..'9'] then + dig := ord(ch) & $0F + else begin + ch := chr(ord(ch)&$5F); + dig := ord(ch)-ord('A')+10; + end; {else} + val := (val << 4) | dig; + NextCh; + end; {while} + skipChar := false; + EscapeCh := val & $FF; + end; + otherwise: Error(57); + end {case} + else + EscapeCh := ord(ch); + end {if} + else + EscapeCh := ord(ch); + if skipChar then + NextCh; + end; {EscapeCh} + + +begin {NextToken} +if ifList = nil then {do pending EndInclude calls} + while includeCount <> 0 do begin + EndInclude(includeChPtr); + includeCount := includeCount - 1; + end; {while} +includeChPtr := chPtr; +3: +token.numstring := nil; {wipe out old numstrings} +if tokenList <> nil then begin {get a token put back by a macro} + tPtr := tokenList; + tokenList := tPtr^.next; + expandEnabled := tPtr^.expandEnabled; + token := tPtr^.token; + tokenStart := tPtr^.tokenStart; + tokenEnd := tPtr^.tokenEnd; + dispose(tPtr); + if token.kind = typedef then {allow for typedefs in a macro} + token.kind := ident; + if token.kind = ident then begin + CopyString(@workString, token.name); + CheckIdentifier; + end; {if} +{ dead code + if token.kind = ident then + if FindSymbol(token,allSpaces,false,false) <> nil then + if token.symbolPtr^.class = typedefsy then + token.kind := typedef; +} +4: + while (token.kind = stringconst) + and (tokenList <> nil) + and (tokenList^.token.kind = stringconst) do begin + Merge(token, tokenList^.token); + tPtr := tokenList; + tokenList := tPtr^.next; + dispose(tPtr); + end; {while} + if expandMacros and expandEnabled and (not skipping) then + if token.kind = ident then begin {handle macro expansions} + inhibit := false; + if tokenList <> nil then + if tokenList^.token.kind = poundpoundop then + inhibit := true; + if not inhibit then begin + mPtr := FindMacro(token.name); + if mPtr <> nil then begin + Expand(mPtr); + goto 3; + end; {if} + end; {if} + end; {if} + if tokenList <> nil then + if tokenList^.token.kind = poundpoundop then begin + tPtr := tokenList; + tokenList := tPtr^.next; + dispose(tPtr); + if tokenList <> nil then begin + tPtr := tokenList; + tToken := token; + Merge(tToken, tPtr^.token); + tokenList := tPtr^.next; + token := tToken; + dispose(tPtr); + goto 4; + end; {if} + end; {if} + goto 2; + end; {if} + {skip white space} +while charKinds[ord(ch)] in [illegal,ch_white,ch_eol] do begin + if charKinds[ord(ch)] = illegal then begin + if (ch = '#') and (lastWasReturn or (token.kind = eolsy)) then + PreProcess {call the preprocessor} + else begin + tokenLine := lineNumber; {record a # token} + tokenColumn := ord(ord4(chPtr)-ord4(firstPtr)); + tokenStart := pointer(ord4(chPtr)-1); + tokenEnd := chPtr; + if (not skipping) or (not (skipIllegalTokens or (ch = '#'))) then + Error(1); + NextCh; + end; {else} + end {if} + else if (charKinds[ord(ch)] = ch_eol) and reportEOL then begin + token.class := reservedSymbol; {record an eol token} + token.kind := eolsy; + tokenLine := lineNumber; + tokenColumn := ord(ord4(chPtr)-ord4(firstPtr)); + tokenStart := pointer(ord4(chPtr)-1); + tokenEnd := chPtr; + NextCh; + goto 2; + end {if} + else begin {skip white space} + if printMacroExpansions then + if charKinds[ord(ch)] = ch_eol then + writeln + else + write(ch); + NextCh; + end; + end; {while} +tokenLine := lineNumber; {record the position of the token} +tokenColumn := ord(ord4(chPtr)-ord4(firstPtr)); +tokenStart := pointer(ord4(chPtr)-1); +token.class := reservedSymbol; {default to the most common class} +case charKinds[ord(ch)] of + + ch_special : begin + token.kind := charSym[ord(ch)]; + NextCh; + end; + + ch_eof: {end of file} + token.kind := eofsy; + + ch_pound : begin {tokens that start with '#'} + NextCh; + if ch = '#' then begin + token.kind := poundpoundop; + NextCh; + end + else + token.kind := poundch; + end; + + ch_dash : begin {tokens that start with '-'} + NextCh; + if ch = '>' then begin + token.kind := minusgtop; + NextCh; + end + else if ch = '-' then begin + token.kind := minusminusop; + NextCh; + end + else if ch = '=' then begin + token.kind := minuseqop; + NextCh; + end + else + token.kind := minusch; + end; + + ch_plus : begin {tokens that start with '+'} + NextCh; + if ch = '+' then begin + token.kind := plusplusop; + NextCh; + end + else if ch = '=' then begin + token.kind := pluseqop; + NextCh; + end + else + token.kind := plusch; + end; + + ch_lt : begin {tokens that start with '<'} + NextCh; + if ch = '<' then begin + NextCh; + if ch = '=' then begin + token.kind := ltlteqop; + NextCh; + end + else + token.kind := ltltop; + end + else if ch = '=' then begin + token.kind := lteqop; + NextCh; + end + else + token.kind := ltch; + end; + + ch_gt : begin {tokens that start with '>'} + NextCh; + if ch = '>' then begin + NextCh; + if ch = '=' then begin + token.kind := gtgteqop; + NextCh; + end + else + token.kind := gtgtop; + end + else if ch = '=' then begin + token.kind := gteqop; + NextCh; + end + else + token.kind := gtch; + end; + + ch_eq : begin {tokens that start with '='} + NextCh; + if ch = '=' then begin + token.kind := eqeqop; + NextCh; + end + else + token.kind := eqch; + end; + + ch_exc : begin {tokens that start with '!'} + NextCh; + if ch = '=' then begin + token.kind := exceqop; + NextCh; + end + else + token.kind := excch; + end; + + ch_and : begin {tokens that start with '&'} + NextCh; + if ch = '&' then begin + token.kind := andandop; + NextCh; + end + else if ch = '=' then begin + token.kind := andeqop; + NextCh; + end + else + token.kind := andch; + end; + + ch_bar : begin {tokens that start with '|'} + NextCh; + if ch = '|' then begin + token.kind := barbarop; + NextCh; + end + else if ch = '=' then begin + token.kind := bareqop; + NextCh; + end + else + token.kind := barch; + end; + + ch_percent: begin {tokens that start with '%'} + NextCh; + if ch = '=' then begin + token.kind := percenteqop; + NextCh; + end + else + token.kind := percentch; + end; + + ch_carot : begin {tokens that start with '^'} + NextCh; + if ch = '=' then begin + token.kind := caroteqop; + NextCh; + end + else + token.kind := carotch; + end; + + ch_asterisk: begin {tokens that start with '*'} + NextCh; + if ch = '=' then begin + token.kind := asteriskeqop; + NextCh; + end + else + token.kind := asteriskch; + end; + + ch_slash : begin {tokens that start with '/'} + NextCh; + if ch = '=' then begin + token.kind := slasheqop; + NextCh; + end + else + token.kind := slashch; + end; + + ch_dot : begin {tokens that start with '.'} + if charKinds[chPtr^] = digit then + DoNumber(false) + else begin + NextCh; + token.kind := dotch; + end; {else} + end; + + ch_char : begin {character constants} + NextCh; + token.kind := intconst; + token.class := intConstant; + if ch = '''' then begin + if (not skipping) or (not skipIllegalTokens) then + Error(2); + token.ival := ord(' '); + end {if} + else + token.ival := EscapeCh; + if ch = '''' then + NextCh + else + if (not skipping) or (not skipIllegalTokens) then + Error(2); + end; + + ch_string: begin {string constants} + doingstring := true; {change character scanning} + token.kind := stringconst; {set up the token} + token.class := stringConstant; + i := 0; {set up for the string scan} + ispstring := false; + setLength := false; + new(sPtr,s100); + NextCh; {skip the opening "} + {read the characters} + while not (charKinds[ord(ch)] in [ch_string,ch_eol,ch_eof]) do begin + i := i+1; + if i = 101 then begin + sPtr^.len1 := 100; + new(tsPtr,s1000); + CopyLongString(pointer(tsPtr), pointer(sPtr)); + dispose(sPtr); + sPtr := tsPtr; + end {if} + else if i = 1001 then begin + sPtr^.len2 := 1000; + new(tsPtr,s4000); + CopyLongString(pointer(tsPtr), pointer(sPtr)); + dispose(sPtr); + sPtr := tsPtr; + end {else if} + else if i = longstringlen then begin + i := 1001; + Error(90); + end; {else if} + sPtr^.str1[i] := chr(EscapeCh); + if (i = 1) and ispstring then + setLength := true; + end; {while} + doingstring := false; {process the end of the string} + if ch = '"' then + NextCh + else + Error(3); + if setLength then {check for a p-string} + sPtr^.str1[1] := chr(i-1); + token.ispstring := setLength; + sPtr^.len1 := i; {set the string length} + token.sval := pointer(Malloc(i+3)); {put the string in the string pool} + CopyLongString(token.sval, pointer(sPtr)); + dispose(sPtr); + doingstring := false; + token.sval^.str[i+1] := chr(0); {add null in case the string is extended} + end; + + letter: begin {reserved words and identifiers} + token.kind := ident; + token.class := identifier; + token.name := @workString; + i := 0; + while charKinds[ord(ch)] in [letter,digit] do begin + i := i+1; + workString[i] := ch; + NextCh; + end; {while} + workString[0] := chr(i); + CheckIdentifier; + end; + + digit : {numeric constants} + DoNumber(false); + + otherwise: Error(57); + end; {case} +tokenEnd := pointer(ord4(chPtr)-1); {record the end of the token} +2: +if skipping then {conditional compilation branch} + if not (token.kind in [eofsy,eolsy]) then + goto 3; +if token.kind = stringconst then {handle adjacent strings} + repeat + if reportEOL then begin + while charKinds[ord(ch)] = ch_white do + NextCh; + if charKinds[ord(ch)] = ch_eol then + goto 1; + end; {if} + tToken := token; + lPrintMacroExpansions := printMacroExpansions; + printMacroExpansions := false; + NextToken; + printMacroExpansions := lPrintMacroExpansions; + if token.kind = stringconst then begin + Merge(tToken, token); + done := false; + end {if} + else begin + PutBackToken(token, true); + done := true; + end; {else} + token := tToken; + until done; +1: +if printMacroExpansions then {print the token stream} + PrintToken(token); +end; {NextToken} + + +procedure TermScanner; + +{ Shut down the scanner. } + +begin {TermScanner} +if ifList <> nil then + Error(21); +if numErr <> 0 then begin {write any pending errors} + firstPtr := chPtr; + WriteLine; + end; {if} +end; {TermScanner} + +end. + +{$append 'scanner.asm'} diff --git a/Symbol.Print b/Symbol.Print old mode 100755 new mode 100644 index fff86ff..3ca0cc9 --- a/Symbol.Print +++ b/Symbol.Print @@ -1 +1,103 @@ -procedure PrintOneSymbol {ip: identPtr}; { Print a symbol } { } { Parameters: } { ip - identifier to print } procedure PrintClass (class: tokenEnum); { Print the class of a symbol } { } { Parameters: } { class - class of the symbol } begin {PrintClass} case class of autosy: write('auto'); externsy: write('extern'); ident: write('ident'); otherwise: write(ord(class):1); end; {case} end; {PrintClass} procedure PrintType (tp: typePtr); { Print a type } { } { Parameters: } { tp - type pointer } begin {PrintType} with tp^ do begin write(' ', size:1, ' byte '); if isConstant then write('constant '); case kind of scalarType : writeln('scalar'); arrayType : begin writeln(elements: 1, ' element array of'); PrintType(aType); end; pointerType : begin writeln(' pointer to'); PrintType(pType); end; functionType: begin writeln(' function returning'); PrintType(fType); end; enumConst : writeln('enumeration (', eval: 1, ')'); enumType : writeln('enum type'); definedType : begin writeln('defined type of'); PrintType(dType); end; structType : writeln('struct: ', ord4(tp):1); unionType : writeln('union'); end; {case} end; {with} end; {PrintType} begin {PrintOneSymbol} with ip^ do begin writeln; {start with a blank line} write(name^, {write id info} ': isForwardDeclared = ', isForwardDeclared, '; class = '); PrintClass(class); writeln; PrintType(iType); {print type info} end; {with} end; {PrintOneSymbol} procedure PrintTable {sym: symbolTablePtr}; { print a symbol table } { } { parameters: } { sym - symbol table to print } var i: integer; {loop variable} ip: identPtr; {current symbol} begin {PrintTable} if sym <> nil then begin writeln; {write header} writeln('Symbols:'); writeln('========'); for i := 0 to hashSize do begin {loop over all hash buckets} ip := sym^.buckets[i]; {trace through all symbols in this bucket} while ip <> nil do begin PrintOneSymbol(ip); {print a symbol} ip := ip^.next; {next symbol} end; {while} end; {for} end; {if} end; {PrintTable} \ No newline at end of file +procedure PrintOneSymbol {ip: identPtr}; + +{ Print a symbol } +{ } +{ Parameters: } +{ ip - identifier to print } + + + procedure PrintClass (class: tokenEnum); + + { Print the class of a symbol } + { } + { Parameters: } + { class - class of the symbol } + + begin {PrintClass} + case class of + autosy: write('auto'); + externsy: write('extern'); + ident: write('ident'); + otherwise: write(ord(class):1); + end; {case} + end; {PrintClass} + + + procedure PrintType (tp: typePtr); + + { Print a type } + { } + { Parameters: } + { tp - type pointer } + + begin {PrintType} + with tp^ do begin + write(' ', size:1, ' byte '); + if isConstant then + write('constant '); + case kind of + scalarType : writeln('scalar'); + arrayType : begin + writeln(elements: 1, ' element array of'); + PrintType(aType); + end; + pointerType : begin + writeln(' pointer to'); + PrintType(pType); + end; + functionType: begin + writeln(' function returning'); + PrintType(fType); + end; + enumConst : writeln('enumeration (', eval: 1, ')'); + enumType : writeln('enum type'); + definedType : begin + writeln('defined type of'); + PrintType(dType); + end; + structType : writeln('struct: ', ord4(tp):1); + unionType : writeln('union'); + end; {case} + end; {with} + end; {PrintType} + + +begin {PrintOneSymbol} +with ip^ do begin + writeln; {start with a blank line} + write(name^, {write id info} + ': isForwardDeclared = ', isForwardDeclared, + '; class = '); + PrintClass(class); + writeln; + + PrintType(iType); {print type info} + end; {with} +end; {PrintOneSymbol} + + +procedure PrintTable {sym: symbolTablePtr}; + +{ print a symbol table } +{ } +{ parameters: } +{ sym - symbol table to print } + +var + i: integer; {loop variable} + ip: identPtr; {current symbol} + +begin {PrintTable} +if sym <> nil then begin + writeln; {write header} + writeln('Symbols:'); + writeln('========'); + for i := 0 to hashSize do begin {loop over all hash buckets} + ip := sym^.buckets[i]; {trace through all symbols in this bucket} + while ip <> nil do begin + PrintOneSymbol(ip); {print a symbol} + ip := ip^.next; {next symbol} + end; {while} + end; {for} + end; {if} +end; {PrintTable} diff --git a/Symbol.asm b/Symbol.asm old mode 100755 new mode 100644 index abfc655..fcccc44 --- a/Symbol.asm +++ b/Symbol.asm @@ -1 +1,24 @@ - mcopy symbol.macros **************************************************************** * * ClearTable - set the symbol table to zeros * * Inputs: * table - symbol table address * **************************************************************** * ClearTable private tableSize equ 7026 sizeof(symbolTable) subroutine (4:table),0 ldy #tableSize-2 lda #0 lb1 sta [table],Y dey dey bpl lb1 return end \ No newline at end of file + mcopy symbol.macros +**************************************************************** +* +* ClearTable - set the symbol table to zeros +* +* Inputs: +* table - symbol table address +* +**************************************************************** +* +ClearTable private +tableSize equ 7026 sizeof(symbolTable) + + subroutine (4:table),0 + + ldy #tableSize-2 + lda #0 +lb1 sta [table],Y + dey + dey + bpl lb1 + + return + end diff --git a/Symbol.macros b/Symbol.macros old mode 100755 new mode 100644 index 33a7632..1a00d44 --- a/Symbol.macros +++ b/Symbol.macros @@ -1 +1,118 @@ - MACRO &lab subroutine &parms,&work &lab anop aif c:&work,.a lclc &work &work setc 0 .a gbla &totallen gbla &worklen &worklen seta &work &totallen seta 0 aif c:&parms=0,.e lclc &len lclc &p lcla &i &i seta c:&parms .b &p setc &parms(&i) &len amid &p,2,1 aif "&len"=":",.c &len amid &p,1,2 &p amid &p,4,l:&p-3 ago .d .c &len amid &p,1,1 &p amid &p,3,l:&p-2 .d &p equ &totallen+3+&work &totallen seta &totallen+&len &i seta &i-1 aif &i,^b .e tsc sec sbc #&work tcs inc a phd tcd mend MACRO &lab return &r &lab anop lclc &len aif c:&r,.a lclc &r &r setc 0 &len setc 0 ago .h .a &len amid &r,2,1 aif "&len"=":",.b &len amid &r,1,2 &r amid &r,4,l:&r-3 ago .c .b &len amid &r,1,1 &r amid &r,3,l:&r-2 .c aif &len<>2,.d ldy &r ago .h .d aif &len<>4,.e ldx &r+2 ldy &r ago .h .e aif &len<>10,.g aif &totallen=0,.f lda &worklen+1 sta &worklen+&totallen+1 lda &worklen sta &worklen+&totallen .f pld tsc clc adc #&worklen+&totallen tcs phb plx ply lda &r+8 pha lda &r+6 pha lda &r+4 pha lda &r+2 pha lda &r pha phy phx plb rtl mexit .g mnote 'Not a valid return length',16 mexit .h aif &totallen=0,.i lda &worklen+1 sta &worklen+&totallen+1 lda &worklen sta &worklen+&totallen .i pld tsc clc adc #&worklen+&totallen tcs aif &len=0,.j tya .j rtl mend \ No newline at end of file + MACRO +&lab subroutine &parms,&work +&lab anop + aif c:&work,.a + lclc &work +&work setc 0 +.a + gbla &totallen + gbla &worklen +&worklen seta &work +&totallen seta 0 + aif c:&parms=0,.e + lclc &len + lclc &p + lcla &i +&i seta c:&parms +.b +&p setc &parms(&i) +&len amid &p,2,1 + aif "&len"=":",.c +&len amid &p,1,2 +&p amid &p,4,l:&p-3 + ago .d +.c +&len amid &p,1,1 +&p amid &p,3,l:&p-2 +.d +&p equ &totallen+3+&work +&totallen seta &totallen+&len +&i seta &i-1 + aif &i,^b +.e + tsc + sec + sbc #&work + tcs + inc a + phd + tcd + mend + MACRO +&lab return &r +&lab anop + lclc &len + aif c:&r,.a + lclc &r +&r setc 0 +&len setc 0 + ago .h +.a +&len amid &r,2,1 + aif "&len"=":",.b +&len amid &r,1,2 +&r amid &r,4,l:&r-3 + ago .c +.b +&len amid &r,1,1 +&r amid &r,3,l:&r-2 +.c + aif &len<>2,.d + ldy &r + ago .h +.d + aif &len<>4,.e + ldx &r+2 + ldy &r + ago .h +.e + aif &len<>10,.g + aif &totallen=0,.f + lda &worklen+1 + sta &worklen+&totallen+1 + lda &worklen + sta &worklen+&totallen +.f + pld + tsc + clc + adc #&worklen+&totallen + tcs + phb + plx + ply + lda &r+8 + pha + lda &r+6 + pha + lda &r+4 + pha + lda &r+2 + pha + lda &r + pha + phy + phx + plb + rtl + mexit +.g + mnote 'Not a valid return length',16 + mexit +.h + aif &totallen=0,.i + lda &worklen+1 + sta &worklen+&totallen+1 + lda &worklen + sta &worklen+&totallen +.i + pld + tsc + clc + adc #&worklen+&totallen + tcs + aif &len=0,.j + tya +.j + rtl + mend diff --git a/Symbol.pas b/Symbol.pas old mode 100755 new mode 100644 index 781d17a..0432b59 --- a/Symbol.pas +++ b/Symbol.pas @@ -1 +1,1535 @@ -{$optimize 7} {---------------------------------------------------------------} { } { Symbol Table } { } { Handle the symbol table. } { } { External Subroutines: } { } { CheckStaticFunctions - check for undefined functions } { CompTypes - Determine if the two types are compatible } { DoGlobals - declare the ~globals and ~arrays segments } { FindSymbol - locate a symbol in the symbol table } { GenParameters - Generate labels and space for the parameters } { GenSymbols - generate a symbol table for the debugger } { InitSymbol - initialize the symbol table handler } { NewSymbol - insert a new symbol in the symbol table } { PopTable - Pop a symbol table (remove definitions local to a } { block) } { PushTable - Create a new symbol table, pushing the old one } { ResolveForwardReference - resolve a forward reference } { } { External Variables: } { } { noDeclarations - have we declared anything at this level? } { table - current symbol table } { } { bytePtr - pointer to the base type for bytes } { uBytePtr - pointer to the base type for unsigned bytes } { wordPtr - pointer to the base type for words } { uWordPtr - pointer to the base type for unsigned words } { longPtr - pointer to the base type for long words } { uLongPtr - pointer to the base type for unsigned long words } { realPtr - pointer to the base type for reals } { doublePtr - pointer to the base type for double precision } { reals } { compPtr - pointer to the base type for comp reals } { extendedPtr - pointer to the base type for extended reals } { voidPtr - pointer to the base type for void } { voidPtrPtr - typeless pointer, for some type casting } { stringTypePtr - pointer to the base type for string } { constants } { defaultStruc - default for structures with errors } { } {---------------------------------------------------------------} unit Symbol; {$LibPrefix '0/obj/'} interface uses CCommon, CGI, MM, Scanner; {$segment 'cc'} {---------------------------------------------------------------} type symbolTablePtr = ^symbolTable; symbolTable = record {a symbol table} {NOTE: the array of buckets must come first in the record!} buckets: array[0..hashSize2] of identPtr; {hash buckets} next: symbolTablePtr; {next symbol table} staticNum: packed array[1..6] of char; {staticNum at start of table} end; var noDeclarations: boolean; {have we declared anything at this level?} table: symbolTablePtr; {current symbol table} globalTable: symbolTablePtr; {global symbol table} bytePtr,uBytePtr,wordPtr,uWordPtr, {base types} longPtr,uLongPtr,realPtr,doublePtr,compPtr,extendedPtr, stringTypePtr,voidPtr,voidPtrPtr,defaultStruct: typePtr; {---------------------------------------------------------------} procedure CheckStaticFunctions; { check for undefined functions } function CompTypes (t1, t2: typePtr): boolean; { Determine if the two types are compatible } procedure DoGlobals; { declare the ~globals and ~arrays segments } function FindSymbol (var tk: tokenType; class: spaceType; oneLevel: boolean; staticAllowed: boolean): identPtr; { locate a symbol in the symbol table } { } { parameters: } { tk - token record for the identifier to find } { class - the kind of variable space to search } { oneLevel - search one level only? (used to check for } { duplicate symbols) } { staticAllowed - can we check for static variables? } { } { returns: } { A pointer to the symbol table entry is returned. If } { there is no entry, nil is returned. } procedure GenParameters (pp: parameterPtr); { Generate labels and space for the parameters } { } { parameters: } { pp - pointer to first parameter } procedure GenSymbols (sym: symbolTablePtr; doGlobals: boolean); { generate a symbol table for the debugger } { } { parameters: } { sym - symbol table to generate } { doGlobals - include global symbols in the table } { } { outputs: } { symLength - length of debug symbol table } procedure InitSymbol; { Initialize the symbol table module } function LabelToDisp (lab: integer): integer; extern; { convert a local label number to a stack frame displacement } { } { parameters: } { lab - label number } function NewSymbol (name: stringPtr; itype: typePtr; class: tokenEnum; space: spaceType; state: stateKind): identPtr; { insert a new symbol in the symbol table } { } { parameters: } { name - pointer to the symbol name } { itype - pointer to the symbol type } { class - storage class } { space - the kind of variable space to put the } { identifier in } { state - variable declaration state } { } { returns: pointer to the inserted symbol } procedure PopTable; { Pop a symbol table (remove definitions local to a block) } {procedure PrintOneSymbol (ip: identPtr); {debug} { Print a symbol } { } { Parameters: } { ip - identifier to print } {procedure PrintTable (sym: symbolTablePtr); {debug} { print a symbol table } { } { parameters: } { sym - symbol table to print } procedure PushTable; { Create a new symbol table, pushing the old one } procedure ResolveForwardReference (iPtr: identPtr); { resolve a forward reference } { } { parameters: } { iPtr - ptr to the forward declared identifier } {---------------------------------------------------------------} implementation var staticNum, {static variable number} firstStaticNum: packed array[1..6] of char; {staticNum at start of function} {- Imported from expression.pas --------------------------------} procedure GenerateCode (tree: tokenPtr); extern; { generate code from a fully formed expression tree } { } { parameters: } { tree - top of the expression tree to generate code from } { } { variables: } { expressionType - result type of the expression } function UsualUnaryConversions: baseTypeEnum; extern; { performs the usual unary conversions } { } { inputs: } { expressionType - type of the operand } { } { result: } { The base type of the operation to perform is returned. } { Any conversion code necessary has been generated. } { } { outputs: } { expressionType - set to result type } {---------------------------------------------------------------} procedure CnOut (i: integer); extern; { write a byte to the constant buffer } { } { parameters: } { i - byte to write } procedure CnOut2 (i: integer); extern; { write a word to the constant buffer } { } { parameters: } { i - word to write } procedure Out (b: integer); extern; { write a byte to the output file } { } { parameters: } { b - byte to write } procedure Out2 (w: integer); extern; { write a word to the output file } { } { parameters: } { w - word to write } procedure RefName (lab: stringPtr; disp, len, shift: integer); extern; { handle a reference to a named label } { } { parameters: } { lab - label name } { disp - displacement past the label } { len - number of bytes in the reference } { shift - shift factor } procedure LabelSearch (lab: integer; len, shift, disp: integer); extern; { resolve a label reference } { } { parameters: } { lab - label number } { len - # bytes for the generated code } { shift - shift factor } { disp - disp past the label } { } { Note 1: maxlabel is reserved for use as the start of the } { string space } { Note 2: negative length indicates relative branch } { Note 3: zero length indicates 2 byte addr -1 } procedure Purge; extern; { write any constant bytes to the output buffer } {---------------------------------------------------------------} procedure ClearTable (table: symbolTable); extern; { clear the symbol table to all zeros } {---------------------------------------------------------------} procedure CheckStaticFunctions; { check for undefined functions } var i: 0..hashSize; {loop variable} sp: identPtr; {pointer to a symbol table entry} msg: stringPtr; {error message ptr} begin {CheckStaticFunctions} for i := 0 to hashSize do begin sp := globalTable^.buckets[i]; while sp <> nil do begin if sp^.storage = private then if sp^.itype^.kind = functionType then if sp^.state <> defined then begin numErrors := numErrors+1; new(msg); msg^ := concat('The static function ', sp^.name^, ' was not defined.'); writeln('*** ', msg^); if terminalErrors then begin if enterEditor then ExitToEditor(msg, ord4(firstPtr)-ord4(bofPtr)) else TermError(0); end; {if} liDCBGS.merrf := 16; end; {if} sp := sp^.next; end; {while} end; {for} end; {CheckStaticFunctions} function CompTypes {t1, t2: typePtr): boolean}; { Determine if the two types are compatible } label 1; var el1,el2: longint; {array sizes} kind1,kind2: typeKind; {temp variables (for speed)} p1, p2: parameterPtr; {for tracing parameter lists} pt1,pt2: typePtr; {pointer types} function IsVoid (tp: typePtr): boolean; { Check to see if a type is void } { } { Parameters: } { tp - type to check } { } { Returns: True if the type is void, else false } begin {IsVoid} IsVoid := false; if tp = voidPtr then IsVoid := true else if tp^.kind = scalarType then if tp^.baseType = cgVoid then IsVoid := true; end; {IsVoid} begin {CompTypes} CompTypes := false; {assume the types are not compatible} kind1 := t1^.kind; {get these for efficiency} kind2 := t2^.kind; if kind2 = definedType then {scan past type definitions} CompTypes := CompTypes(t1, t2^.dType) else if kind1 = definedType then CompTypes := CompTypes(t1^.dType, t2) else case kind1 of scalarType: if kind2 = scalarType then CompTypes := t1^.baseType = t2^.baseType else if kind2 = enumType then CompTypes := t1^.baseType = cgWord; arrayType: if kind2 = arrayType then begin el1 := t1^.elements; el2 := t2^.elements; if el1 = 0 then el1 := el2 else if el2 = 0 then el2 := el1; if el1 = el2 then CompTypes := CompTypes(t1^.atype, t2^.atype); end; {if} functionType: if kind2 = functionType then CompTypes := CompTypes(t1^.ftype,t2^.ftype) else if kind2 = pointerType then if t2^.ptype^.kind = functionType then CompTypes := CompTypes(t1, t2^.ptype); pointerType: begin if IsVoid(t1^.ptype) or IsVoid(t2^.ptype) then begin CompTypes := true; goto 1; end; {if} if kind2 = pointertype then CompTypes := CompTypes(t1^.ptype, t2^.ptype) else if kind2 = functionType then CompTypes := CompTypes(t1^.ptype, t2); end; enumType: if kind2 = scalarType then CompTypes := t2^.baseType = cgWord else if kind2 = enumType then CompTypes := true; structType,unionType: CompTypes := t1 = t2; otherwise: ; end; {case t1^.kind} 1: end; {CompTypes} procedure DoGlobals; { declare the ~globals and ~arrays segments } procedure GenArrays; { define global arrays } var didOne: boolean; {have we found an array yet?} i: 0..hashSize; {loop variable} ip: initializerPtr; {used to trace initializer lists} lval: longint; {for converting types} size: longint; {size of the array} sp: identPtr; {pointer to a symbol table entry} begin {GenArrays} didOne := false; for i := 0 to hashSize do begin sp := table^.buckets[i]; while sp <> nil do begin if sp^.storage in [global,private] then if sp^.itype^.kind in [arrayType,structType,unionType] then begin if not didOne then begin if smallMemoryModel then currentSegment := ' ' else currentSegment := '~ARRAYS '; Gen2Name(dc_str, $4000, 1, @'~ARRAYS'); didOne := true; end; {if} if sp^.state = initialized then begin Gen2Name(dc_glb, 0, ord(sp^.storage = private), sp^.name); ip := sp^.iPtr; while ip <> nil do begin case ip^.itype of cgByte,cgUByte,cgWord,cgUWord: begin lval := ip^.ival; Gen2t(dc_cns, long(lval).lsw, ip^.count, ip^.itype); end; cgLong,cgULong: GenL1(dc_cns, ip^.ival, ip^.count); cgReal,cgDouble,cgComp,cgExtended: GenR1t(dc_cns, ip^.rval, ip^.count, ip^.itype); cgString: GenS(dc_cns, ip^.sval); ccPointer: begin code^.optype := ccPointer; code^.r := ord(ip^.pPlus); code^.q := ip^.count; code^.pVal := ip^.pVal; if ip^.isName then begin code^.lab := ip^.pName; code^.pstr := nil; end {if} else code^.pstr := ip^.pstr; Gen0(dc_cns); end; otherwise: Error(57); end; {case} ip := ip^.next; end; {while} end {if} else begin size := sp^.itype^.size; Gen2Name(dc_glb, long(size).lsw & $7FFF, ord(sp^.storage = private), sp^.name); size := size & $FFFF8000; while size <> 0 do begin Gen1(dc_dst, 16384); size := size-16384; end; {while} end; {else} end; {if} sp := sp^.next; end; {while} end; {for} if didOne then Gen0(dc_enp); end; {GenArrays} procedure GenGlobals; { define non-array global variables } var i: 0..hashSize; {loop variable} ip: initializerPtr; {used to trace initializer lists} lval: longint; {for extracting lsw} sp: identPtr; {pointer to a symbol table entry} begin {GenGlobals} Gen2t(dc_cns, 0, 1, cgByte); for i := 0 to hashSize do begin sp := table^.buckets[i]; while sp <> nil do begin if sp^.storage in [global,private] then if sp^.itype^.kind in [scalarType,pointerType] then begin if sp^.state = initialized then begin Gen2Name(dc_glb, 0, ord(sp^.storage = private), sp^.name); ip := sp^.iPtr; case ip^.itype of cgByte,cgUByte,cgWord,cgUWord: begin lval := ip^.ival; Gen2t(dc_cns, long(lval).lsw, 1, ip^.itype); end; cgLong,cgULong: GenL1(dc_cns, ip^.ival, 1); cgReal,cgDouble,cgComp,cgExtended: GenR1t(dc_cns, ip^.rval, 1, ip^.itype); cgString: GenS(dc_cns, ip^.sval); ccPointer: begin code^.optype := ccPointer; code^.q := 1; code^.r := ord(ip^.pPlus); code^.pVal := ip^.pVal; if ip^.isName then begin code^.lab := ip^.pName; code^.pstr := nil; end {if} else code^.pstr := ip^.pstr; Gen0(dc_cns); end; otherwise: Error(57); end; {case} end {if} else Gen2Name(dc_glb, ord(sp^.itype^.size), ord(sp^.storage = private), sp^.name); end; sp := sp^.next; end; {while} end; {for} end; {GenGlobals} begin {DoGlobals} {print the global symbol table} {if printSymbols then {debug} { PrintTable(globalTable); {debug} {these segments are not dynamic!} segmentKind := 0; {declare the ~globals segment, which holds non-array data types} if smallMemoryModel then currentSegment := ' ' else currentSegment := '~GLOBALS '; Gen2Name(dc_str, $4000, 0, @'~GLOBALS'); GenGlobals; Gen0(dc_enp); {declare the ~arrays segment, which holds global arrays} GenArrays; end; {DoGlobals} function FindSymbol {var tk: tokenType; class: spaceType; oneLevel: boolean; staticAllowed: boolean): identPtr}; { locate a symbol in the symbol table } { } { parameters: } { tk - token record for the identifier to find } { class - the kind of variable space to search } { oneLevel - search one level only? (used to check for } { duplicate symbols) } { staticAllowed - can we check for static variables? } { } { returns: } { A pointer to the symbol table entry is returned. If } { there is no entry, nil is returned. } label 1; var doTagSpace: boolean; {do we still need to do the tags?} hashDisp: longint; {disp into the hash table} i: integer; {loop variable} iHandle: ^identPtr; {pointer to start of hash bucket} iPtr: identPtr; {pointer to the current symbol} match: boolean; {for comparing substrings} name: stringPtr; {name to search for} np: stringPtr; {for searching for static variables} sPtr: symbolTablePtr; {^ to current symbol table} begin {FindSymbol} {get ready to search} staticAllowed := staticAllowed and (staticNum <> '~0000'); name := tk.name; {use a local variable} hashDisp := Hash(name); {get the disp into the symbol table} sPtr := table; {initialize the address of the sym. tbl} FindSymbol := nil; {assume we won't find it} np := nil; {no string buffer, yet} {check for the variable} while sPtr <> nil do begin iHandle := pointer(hashDisp+ord4(sPtr)); if class = tagSpace then iHandle := pointer(ord4(iHandle) + (hashSize+1)*4); doTagSpace := class = allSpaces; iPtr := iHandle^; if iPtr = nil then if doTagSpace then begin iHandle := pointer(ord4(iHandle) + (hashSize+1)*4); iPtr := iHandle^; doTagSpace := false; end; {if} {scan the hash bucket for a global or auto variable} while iPtr <> nil do begin if iPtr^.name^ = name^ then begin FindSymbol := iPtr; if iPtr^.isForwardDeclared then ResolveForwardReference(iPtr); tk.symbolPtr := iPtr; goto 1; end; {if} iPtr := iPtr^.next; if iPtr = nil then if doTagSpace then begin iHandle := pointer(ord4(iHandle) + (hashSize+1)*4); iPtr := iHandle^; doTagSpace := false; end; {if} end; {while} {rescan for a static variable} if staticAllowed then begin if np = nil then begin {form the static name} if length(name^) < 251 then begin new(np); np^[0] := chr(5+length(name^)); for i := 1 to 5 do np^[i] := sPtr^.staticNum[i]; for i := 1 to length(name^) do np^[i+5] := name^[i]; end; {if} end {if} else for i := 2 to 5 do np^[i] := sPtr^.StaticNum[i]; {scan the hash bucket for the identifier} iHandle := pointer(hashDisp+ord4(globalTable)); if class = tagSpace then iHandle := pointer(ord4(iHandle) + (hashSize+1)*4); iPtr := iHandle^; while iPtr <> nil do begin if iPtr^.name^ = np^ then begin FindSymbol := iPtr; if iPtr^.isForwardDeclared then ResolveForwardReference(iPtr); tk.symbolPtr := iPtr; goto 1; end; {if} iPtr := iPtr^.next; end; {while} end; {if staticAllowed} if oneLevel then sPtr := nil else sPtr := sPtr^.next; end; {while} 1: if np <> nil then dispose(np); end; {FindSymbol} procedure GenParameters {pp: parameterPtr}; { Generate labels and space for the parameters } { } { parameters: } { pp - pointer to first parameter } var i: 0..hashSize; {loop variable} pln: integer; {label number} size: integer; {size of the parameter} sp: identPtr; {symbol pointer} tk: tokenType; {symbol name token} begin {GenParameters} if pp <> nil then begin {prototyped parameters} tk.kind := ident; tk.numString := nil; tk.class := identifier; while pp <> nil do begin pln := GetLocalLabel; tk.name := pp^.parameter^.name; tk.symbolPtr := nil; sp := FindSymbol(tk, variableSpace, true, false); if sp = nil then sp := pp^.parameter; if sp^.itype^.kind = arrayType then Gen3(dc_prm, pln, cgPointerSize, sp^.pdisp) else begin size := long(sp^.itype^.size).lsw; if (size = 1) and (sp^.itype^.kind = scalarType) then size := 2; Gen3(dc_prm, pln, size, sp^.pdisp); end; {else} sp^.pln := pln; pp := pp^.next; end; {while} end {if} else begin {K&R parameters} for i := 0 to hashSize do begin sp := table^.buckets[i]; while sp <> nil do begin if sp^.storage = parameter then begin sp^.pln := GetLocalLabel; if sp^.itype^.kind = arrayType then Gen3(dc_prm, sp^.lln, cgPointerSize, sp^.pdisp) else begin size := long(sp^.itype^.size).lsw; if (size = 1) and (sp^.itype^.kind = scalarType) then size := 2; Gen3(dc_prm, sp^.lln, size, sp^.pdisp); end; {else} end; {if} sp := sp^.next; end; {while} end; {for} end; {else} end; {GenParameters} procedure GenSymbols {sym: symbolTablePtr; doGlobals: boolean}; { generate a symbol table for the debugger } { } { parameters: } { sym - symbol table to generate } { doGlobals - include global symbols in the table } { } { outputs: } { symLength - length of debug symbol table } const noDisp = -1; {disp returned by GetTypeDisp if the type was not found} type tpPtr = ^tpRecord; {type list displacements} tpRecord = record next: tpPtr; tp: typePtr; disp: integer; end; var i: 0..hashSize; {loop/index variable} ip: identPtr; {used to trace identifier lists} tpList,tp2: tpPtr; {type displacement list} function GetTypeDisp (tp: typePtr): integer; { Look for an existing entry for this type } { } { Parameters: } { tp - type to look for } { } { Returns: Disp to a variable of the same type, or noDisp if } { there is no such entry. } { } { Notes: If the type is not in the type list, it is entered } { in the list by this call. } var tp1, tp2: tpPtr; {used to manipulate type list} begin {GetTypeDisp} tp1 := tpList; {look for the type} tp2 := nil; while tp1 <> nil do if tp1^.tp = tp then begin tp2 := tp1; tp1 := nil; end {if} else tp1 := tp1^.next; if tp2 <> nil then GetTypeDisp := tp2^.disp {return disp to entry} else begin GetTypeDisp := noDisp; {no entry} new(tp1); {create a new entry} tp1^.next := tpList; tpList := tp1; tp1^.tp := tp; tp1^.disp := symLength; end; {else} end; {GetTypeDisp} procedure GenSymbol (ip: identPtr; storage: storageType); { Generate a single symbol or struct field } { } { parameters: } { ip - identifier to generate } { storage - storage type; none for struct/union fields } var disp: integer; {disp to symbol of same type} procedure WriteAddress (ip: identPtr); { Write the address and DP flag } { } { parameters: } { ip - identifier } var size: longint; {used to break apart longints} begin {WriteAddress} if storage in [external,global,private] then begin RefName(ip^.name, 0, 4, 0); CnOut(1); end {if} else if storage = none then begin size := ip^.disp; CnOut2(long(size).lsw); CnOut2(long(size).msw); CnOut(ord(ip^.next <> nil)); end {else if} else begin CnOut2(LabelToDisp(ip^.lln)); CnOut2(0); CnOut(0); end; {else} end; {WriteAddress} procedure WriteName (ip: identPtr); { Write the name field for an identifier } { } { parameters: } { ip - identifier } var len: 0..maxint; {string length} j: 0..maxint; {loop/index variable} begin {WriteName} Purge; {generate the address of the variable } Out(235); Out(4); { name } LabelSearch(maxLabel, 4, 0, 0); if stringsize <> 0 then begin Out(129); Out2(stringsize); Out2(0); Out(1); end; {if} Out(0); len := length(ip^.name^); {place the name in the string buffer} if maxstring-stringsize >= len+1 then begin stringspace[stringsize+1] := chr(len); for j := 1 to len do stringspace[j+stringsize+1] := ip^.name^[j]; stringsize := stringsize+len+1; end {if} else Error(60); end; {WriteName} procedure WriteScalarType (tp: typePtr; modifiers, subscripts: integer); { Write a scalar type and subscipt field } { } { parameters: } { tp - type pointer } { modifiers - value to or with the type code } { subscripts - number of subscripts } var val: integer; {type value} begin {WriteScalarType} case tp^.baseType of cgByte: val := $40; cgUByte: val := $00; cgWord: val := $01; cgUWord: val := $41; cgLong: val := $02; cgULong: val := $42; cgReal: val := $03; cgDouble: val := $04; cgComp: val := $0A; cgExtended: val := $05; otherwise: val := $01; end; {case} CnOut(val | modifiers); {write the format byte} CnOut2(subscripts); {write the # of subscripts} end; {WriteScalarType} procedure WritePointerType (tp: typePtr; subscripts: integer); { write a pointer type field } { } { parameters: } { tp - pointer type } { subscripts - number of subscript fields } begin {WritePointerType} case tp^.ptype^.kind of scalarType: WriteScalarType(tp^.ptype, $80, subscripts); enumType, functionType: WriteScalarType(wordPtr, $80, subscripts); otherwise: begin CnOut(11); CnOut2(subscripts); end; end; {case} end; {WritePointerType} procedure ExpandPointerType (tp: typePtr); forward; procedure ExpandStructType (tp: typePtr); { write the type entries for a struct or union } { } { parameters: } { tp - struct/union type } var ip: identPtr; {used to trace the field list} begin {ExpandStructType} ip := tp^.fieldList; while ip <> nil do begin GenSymbol(ip, none); ip := ip^.next; end; {while} end; {ExpandStructType} procedure WriteArrays (tp: typePtr); { handle an array type } { } { parameters: } { tp - array type } var count: 0..maxint; {# of subscripts} size: longint; {for converting long numbers} tp2: typePtr; {used to trace array type list} begin {WriteArrays} count := 0; {count the subscripts} tp2 := tp; while tp2^.kind = arrayType do begin count := count+1; tp2 := tp2^.aType; end; {while} if tp2^.kind = scalarType then {write the type code} if tp2^.baseType in [cgByte,cgUByte] then begin count := count-1; CnOut(6); CnOut2(count); end {if} else WriteScalarType(tp2, 0, count) else if tp2^.kind = enumType then WriteScalarType(wordPtr, 0, count) else if tp2^.kind = pointerType then WritePointerType(tp2, count) else begin CnOut(12); CnOut2(count); end; {else if} while count <> 0 do begin {write the subscript entries} CnOut2(0); CnOut2(0); if tp^.elements = 0 then size := $00FFFFFF else size := tp^.elements-1; CnOut2(long(size).lsw); CnOut2(long(size).msw); size := tp^.aType^.size; CnOut2(long(size).lsw); CnOut2(long(size).msw); symLength := symLength+12; tp := tp^.aType; count := count-1; end; {while} if tp2^.kind = pointerType then {expand complex types} ExpandPointerType(tp2) else if tp2^.kind in [structtype,uniontype] then ExpandStructType(tp2); end; {WriteArrays} procedure ExpandPointerType {tp: typePtr}; { write the type entries for complex pointer types } { } { parameters: } { tp - pointer type } var disp: integer; {disp to symbol of same type} begin {ExpandPointerType} if tp^.ptype^.kind in [pointerType,arrayType,structType,unionType] then begin symLength := symLength+12; CnOut2(0); CnOut2(0); CnOut2(0); CnOut2(0); CnOut(0); case tp^.ptype^.kind of pointerType: begin WritePointerType(tp^.ptype, 0); ExpandPointerType(tp^.ptype); end; arrayType: WriteArrays(tp^.ptype); structType, unionType: begin disp := GetTypeDisp(tp^.ptype); if disp = noDisp then begin CnOut(12); CnOut2(0); ExpandStructType(tp^.ptype); end {if} else begin CnOut(13); CnOut2(disp); end; {else} end; end; {case} end; {if} end; {ExpandPointerType} begin {GenSymbol} if ip^.itype^.kind in [scalarType,arrayType,pointerType,enumType,structType,unionType] then begin WriteName(ip); {write the name field} WriteAddress(ip); {write the address field} case ip^.itype^.kind of scalarType: WriteScalarType(ip^.itype, 0, 0); enumType: WriteScalarType(wordPtr, 0, 0); pointerType: begin WritePointerType(ip^.itype, 0); ExpandPointerType(ip^.itype); end; arrayType: WriteArrays(ip^.itype); structType, unionType: begin disp := GetTypeDisp(ip^.itype); if disp = noDisp then begin CnOut(12); CnOut2(0); ExpandStructType(ip^.itype); end {if} else begin CnOut(13); CnOut2(disp); end; {else} end; end; {case} symLength := symLength+12; {update length of symbol table} end; {if} end; {GenSymbol} begin {GenSymbols} tpList := nil; {no types so far} if sym <> nil then for i := 0 to hashSize do begin {loop over all hash buckets} ip := sym^.buckets[i]; {trace through all symbols in this bucket} while ip <> nil do begin if ip^.storage <> none then GenSymbol(ip, ip^.storage); ip := ip^.next; {next symbol} end; {while} end; {for} while tpList <> nil do begin {dispose of type list} tp2 := tpList; tpList := tp2^.next; dispose(tp2); end; {while} if doGlobals then {do globals} GenSymbols(globalTable, false); end; {GenSymbols} procedure InitSymbol; { Initialize the symbol table module } var i: 0..hashSize; {loop variable} begin {InitSymbol} staticNum := '~0000'; {no functions processed} table := nil; {initialize the global symbol table} PushTable; globalTable := table; noDeclarations := false; {declare base types} new(bytePtr); {byte} with bytePtr^ do begin size := cgByteSize; saveDisp := 0; isConstant := false; kind := scalarType; baseType := cgByte; end; {with} new(uBytePtr); {unsigned byte} with uBytePtr^ do begin size := cgByteSize; saveDisp := 0; isConstant := false; kind := scalarType; baseType := cgUByte; end; {with} new(wordPtr); {word} with wordPtr^ do begin size := cgWordSize; saveDisp := 0; isConstant := false; kind := scalarType; baseType := cgWord; end; {with} new(uWordPtr); {unsigned word} with uWordPtr^ do begin size := cgWordSize; saveDisp := 0; isConstant := false; kind := scalarType; baseType := cgUWord; end; {with} new(longPtr); {long} with longPtr^ do begin size := cgLongSize; saveDisp := 0; isConstant := false; kind := scalarType; baseType := cgLong; end; {with} new(uLongPtr); {unsigned long} with uLongPtr^ do begin size := cgLongSize; saveDisp := 0; isConstant := false; kind := scalarType; baseType := cgULong; end; {with} new(realPtr); {real} with realPtr^ do begin size := cgRealSize; saveDisp := 0; isConstant := false; kind := scalarType; baseType := cgReal; end; {with} new(doublePtr); {double} with doublePtr^ do begin size := cgDoubleSize; saveDisp := 0; isConstant := false; kind := scalarType; baseType := cgDouble; end; {with} new(compPtr); {comp} with compPtr^ do begin size := cgCompSize; saveDisp := 0; isConstant := false; kind := scalarType; baseType := cgComp; end; {with} new(extendedPtr); {extended} with extendedPtr^ do begin size := cgExtendedSize; saveDisp := 0; isConstant := false; kind := scalarType; baseType := cgExtended; end; {with} new(stringTypePtr); {string constant type} with stringTypePtr^ do begin size := 0; saveDisp := 0; isConstant := false; kind := arrayType; aType := uBytePtr; elements := 1; end; {with} new(voidPtr); {void} with voidPtr^ do begin size := 0; saveDisp := 0; isConstant := false; kind := scalarType; baseType := cgVoid; end; {with} new(voidPtrPtr); {typeless pointer} with voidPtrPtr^ do begin size := 4; saveDisp := 0; isConstant := false; kind := pointerType; pType := voidPtr; end; {with} new(defaultStruct); {default structure} with defaultStruct^ do begin {(for structures with errors)} size := cgWordSize; saveDisp := 0; isConstant := false; kind := structType; sName := nil; new(fieldList); with fieldlist^ do begin next := nil; name := @'field'; itype := wordPtr; class := ident; state := declared; disp := 0; bitdisp := 0; end; {with} end; {with} end; {InitSymbol} function NewSymbol {name: stringPtr; itype: typePtr; class: tokenEnum; space: spaceType; state: stateKind): identPtr}; { insert a new symbol in the symbol table } { } { parameters: } { name - pointer to the symbol name } { itype - pointer to the symbol type } { class - storage class } { space - the kind of variable space to put the } { identifier in } { state - variable declaration state } { } { returns: pointer to the inserted symbol } var cs: identPtr; {current symbol} hashPtr: ^identPtr; {pointer to hash bucket in symbol table} i: integer; {loop variable} isGlobal: boolean; {are we using the global table?} lUseGlobalPool: boolean; {use the global symbol pool?} needSymbol: boolean; {do we need to declare it?} np: stringPtr; {for forming static name} p: identPtr; {work pointer} tk: tokenType; {fake token; for FindSymbol} begin {NewSymbol} needSymbol := true; {assume we need a symbol} cs := nil; {no current symbol found} isGlobal := false; {set up defaults} lUseGlobalPool := useGlobalPool; tk.name := name; tk.symbolPtr := nil; if space <> fieldListSpace then begin {are we defining a function?} if itype^.kind = functionType then begin isGlobal := true; useGlobalPool := true; if class in [autosy, ident] then class := externsy; if not lUseGlobalPool then begin np := pointer(Malloc(length(name^)+1)); CopyString(pointer(np), pointer(name)); tk.name := np; name := np; end; {if} cs := FindSymbol(tk, space, false, true); if cs <> nil then begin if cs^.state = defined then if state = defined then Error(42); p := cs; needSymbol := false; if not itype^.prototyped then begin itype^.prototyped := cs^.itype^.prototyped; itype^.parameterList := cs^.itype^.parameterList; end; {if} end; {if} end {if} else if (itype^.kind in [structType,unionType]) and (itype^.fieldList = nil) and doingParameters then begin isGlobal := true; useGlobalPool := true; end; {else if} if noDeclarations then begin {if we need a symbol table, create it} if not isGlobal then noDeclarations := false; end {if} else begin {check for duplicates} cs := FindSymbol(tk, space, true, false); if cs <> nil then begin if (not CompTypes(cs^.itype, itype)) or ((cs^.state = initialized) and (state = initialized)) or (globalTable <> table) then if (not doingParameters) or (cs^.state <> declared) then Error(42); p := cs; needSymbol := false; end; {if} end; {else} end; {if} if class = staticsy then {statics go in the global symbol table} if not isGLobal then if globalTable <> table then begin cs := FindSymbol(tk, space, true, true); if cs <> nil then begin {check for duplicates} if (not CompTypes(cs^.itype, itype)) or ((cs^.state = defined) and (state <> initialized)) or (cs^.state = initialized) then Error(42); p := cs; needSymbol := false; end; {if} isGlobal := true; {note that we will use the global table} useGlobalPool := true; np := pointer(GMalloc(length(name^)+6)); np^[0] := chr(5+length(name^)); for i := 1 to 5 do np^[i] := table^.staticNum[i]; for i := 1 to length(name^) do np^[i+5] := name^[i]; name := np; end; {if} if needSymbol then begin p := pointer(Calloc(sizeof(identRecord))); {get space for the record} {p^.iPtr := nil;} {no initializers, yet} {p^.saved := 0;} {not saved} p^.state := state; {set the state} {p^.isForwardDeclared := false;} {assume no forward declarations are used} p^.name := name; {record the name} if space <> fieldListSpace then {insert the symbol in the hash bucket} begin if itype = nil then hashPtr := pointer(ord4(table)+Hash(name)) else if isGlobal then hashPtr := pointer(ord4(globalTable)+Hash(name)) else hashPtr := pointer(ord4(table)+Hash(name)); if space = tagSpace then hashPtr := pointer(ord4(hashPtr) + 4*(hashSize+1)); p^.next := hashPtr^; hashPtr^ := p; end {if} else p^.next := nil; end; {if} if class in [autosy,registersy] then {check and set the storage class} begin if doingFunction or doingParameters then begin p^.storage := stackFrame; class := ident; end {if} else begin p^.storage := global; Error(62); end; {else} end {if} else if class = ident then begin if doingFunction then begin p^.storage := stackFrame; class := autosy; end {if} else p^.storage := global; end {else if} else if class = externsy then p^.storage := external else if class = staticsy then p^.storage := private else p^.storage := none; p^.class := class; p^.itype := itype; {set the symbol field values} NewSymbol := p; {return a pointer to the new entry} useGlobalPool := lUseGlobalPool; {restore the useGlobalPool variable} end; {NewSymbol} procedure PopTable; { Pop a symbol table (remove definitions local to a block) } var tPtr: symbolTablePtr; {work pointer} begin {PopTable} tPtr := table; {if printSymbols then {debug} { PrintTable(tPtr); {debug} if tPtr^.next <> nil then begin table := table^.next; dispose(tPtr); end; {if} end; {PopTable} { copy 'symbol.print'} {debug} procedure PushTable; { Create a new symbol table, pushing the old one } var done: boolean; {loop termination} i: integer; {loop index} tPtr: symbolTablePtr; {work pointer} begin {PushTable} i := 5; {increment the static var number} repeat staticNum[i] := succ(staticNum[i]); done := staticNum[i] <> succ('9'); if not done then begin staticNum[i] := '0'; i := i-1; done := i = 1; end; {if} until done; if table = globalTable then {update fistStaticNum} firstStaticNum := staticNum; new(tPtr); {create a new symbol table} ClearTable(tPtr^); tPtr^.next := table; table := tPtr; tPtr^.staticNum := staticNum; {record the static symbol table number} end; {PushTable} procedure ResolveForwardReference {iPtr: identPtr}; { resolve a forward reference } { } { parameters: } { iPtr - ptr to the forward declared identifier } var fl: identPtr; {for tracing field lists} ltk: tokenType; {for searching for forward refs} sym: identPtr; {for finding forward refs} lPtr,tPtr: typePtr; {for tracing forward declared types} begin {ResolveForwardReference} iPtr^.isForwardDeclared := false; {we will succeeed or flag an error...} tPtr := iPtr^.itype; {skip to the struct/union type} while tPtr^.kind in [pointerType,arrayType,functionType,definedType] do begin lPtr := tPtr; tPtr := tPtr^.pType; end; if tPtr^.sName <> nil then begin {resolve the forward reference} ltk.name := tPtr^.sName; ltk.symbolPtr := nil; sym := FindSymbol(ltk,tagSpace,false,true); if sym <> nil then begin if sym^.itype^.kind <> tPtr^.kind then Error(107) else begin if sym^.itype = tPtr then tPtr^.sName := nil else lPtr^.ptype := sym^.itype; end; {else} end; {if} end; {if} tPtr := lPtr^.pType; {check the field list for other fwd refs} while tPtr^.kind in [pointerType,arrayType,functionType,definedType] do tPtr := tPtr^.pType; if tPtr^.kind in [structType,unionType] then begin fl := tPtr^.fieldList; while fl <> nil do begin if fl^.isForwardDeclared then ResolveForwardReference(fl); fl := fl^.next; end; {while} end; {if} end; {ResolveForwardReference} end. {$append 'symbol.asm'} \ No newline at end of file +{$optimize 7} +{---------------------------------------------------------------} +{ } +{ Symbol Table } +{ } +{ Handle the symbol table. } +{ } +{ External Subroutines: } +{ } +{ CheckStaticFunctions - check for undefined functions } +{ CompTypes - Determine if the two types are compatible } +{ DoGlobals - declare the ~globals and ~arrays segments } +{ FindSymbol - locate a symbol in the symbol table } +{ GenParameters - Generate labels and space for the parameters } +{ GenSymbols - generate a symbol table for the debugger } +{ InitSymbol - initialize the symbol table handler } +{ NewSymbol - insert a new symbol in the symbol table } +{ PopTable - Pop a symbol table (remove definitions local to a } +{ block) } +{ PushTable - Create a new symbol table, pushing the old one } +{ ResolveForwardReference - resolve a forward reference } +{ } +{ External Variables: } +{ } +{ noDeclarations - have we declared anything at this level? } +{ table - current symbol table } +{ } +{ bytePtr - pointer to the base type for bytes } +{ uBytePtr - pointer to the base type for unsigned bytes } +{ wordPtr - pointer to the base type for words } +{ uWordPtr - pointer to the base type for unsigned words } +{ longPtr - pointer to the base type for long words } +{ uLongPtr - pointer to the base type for unsigned long words } +{ realPtr - pointer to the base type for reals } +{ doublePtr - pointer to the base type for double precision } +{ reals } +{ compPtr - pointer to the base type for comp reals } +{ extendedPtr - pointer to the base type for extended reals } +{ voidPtr - pointer to the base type for void } +{ voidPtrPtr - typeless pointer, for some type casting } +{ stringTypePtr - pointer to the base type for string } +{ constants } +{ defaultStruc - default for structures with errors } +{ } +{---------------------------------------------------------------} + +unit Symbol; + +{$LibPrefix '0/obj/'} + +interface + +uses CCommon, CGI, MM, Scanner; + +{$segment 'cc'} + +{---------------------------------------------------------------} + +type + symbolTablePtr = ^symbolTable; + symbolTable = record {a symbol table} + {NOTE: the array of buckets must come first in the record!} + buckets: array[0..hashSize2] of identPtr; {hash buckets} + next: symbolTablePtr; {next symbol table} + staticNum: packed array[1..6] of char; {staticNum at start of table} + end; + +var + noDeclarations: boolean; {have we declared anything at this level?} + table: symbolTablePtr; {current symbol table} + globalTable: symbolTablePtr; {global symbol table} + + bytePtr,uBytePtr,wordPtr,uWordPtr, {base types} + longPtr,uLongPtr,realPtr,doublePtr,compPtr,extendedPtr, + stringTypePtr,voidPtr,voidPtrPtr,defaultStruct: typePtr; + +{---------------------------------------------------------------} + +procedure CheckStaticFunctions; + +{ check for undefined functions } + + +function CompTypes (t1, t2: typePtr): boolean; + +{ Determine if the two types are compatible } + + +procedure DoGlobals; + +{ declare the ~globals and ~arrays segments } + + +function FindSymbol (var tk: tokenType; class: spaceType; oneLevel: boolean; + staticAllowed: boolean): identPtr; + +{ locate a symbol in the symbol table } +{ } +{ parameters: } +{ tk - token record for the identifier to find } +{ class - the kind of variable space to search } +{ oneLevel - search one level only? (used to check for } +{ duplicate symbols) } +{ staticAllowed - can we check for static variables? } +{ } +{ returns: } +{ A pointer to the symbol table entry is returned. If } +{ there is no entry, nil is returned. } + + +procedure GenParameters (pp: parameterPtr); + +{ Generate labels and space for the parameters } +{ } +{ parameters: } +{ pp - pointer to first parameter } + + +procedure GenSymbols (sym: symbolTablePtr; doGlobals: boolean); + +{ generate a symbol table for the debugger } +{ } +{ parameters: } +{ sym - symbol table to generate } +{ doGlobals - include global symbols in the table } +{ } +{ outputs: } +{ symLength - length of debug symbol table } + + +procedure InitSymbol; + +{ Initialize the symbol table module } + + +function LabelToDisp (lab: integer): integer; extern; + +{ convert a local label number to a stack frame displacement } +{ } +{ parameters: } +{ lab - label number } + + +function NewSymbol (name: stringPtr; itype: typePtr; class: tokenEnum; + space: spaceType; state: stateKind): identPtr; + +{ insert a new symbol in the symbol table } +{ } +{ parameters: } +{ name - pointer to the symbol name } +{ itype - pointer to the symbol type } +{ class - storage class } +{ space - the kind of variable space to put the } +{ identifier in } +{ state - variable declaration state } +{ } +{ returns: pointer to the inserted symbol } + + +procedure PopTable; + +{ Pop a symbol table (remove definitions local to a block) } + + +{procedure PrintOneSymbol (ip: identPtr); {debug} + +{ Print a symbol } +{ } +{ Parameters: } +{ ip - identifier to print } + + +{procedure PrintTable (sym: symbolTablePtr); {debug} + +{ print a symbol table } +{ } +{ parameters: } +{ sym - symbol table to print } + + +procedure PushTable; + +{ Create a new symbol table, pushing the old one } + + +procedure ResolveForwardReference (iPtr: identPtr); + +{ resolve a forward reference } +{ } +{ parameters: } +{ iPtr - ptr to the forward declared identifier } + +{---------------------------------------------------------------} + +implementation + +var + staticNum, {static variable number} + firstStaticNum: packed array[1..6] of char; {staticNum at start of function} + +{- Imported from expression.pas --------------------------------} + +procedure GenerateCode (tree: tokenPtr); extern; + +{ generate code from a fully formed expression tree } +{ } +{ parameters: } +{ tree - top of the expression tree to generate code from } +{ } +{ variables: } +{ expressionType - result type of the expression } + + +function UsualUnaryConversions: baseTypeEnum; extern; + +{ performs the usual unary conversions } +{ } +{ inputs: } +{ expressionType - type of the operand } +{ } +{ result: } +{ The base type of the operation to perform is returned. } +{ Any conversion code necessary has been generated. } +{ } +{ outputs: } +{ expressionType - set to result type } + +{---------------------------------------------------------------} + +procedure CnOut (i: integer); extern; + +{ write a byte to the constant buffer } +{ } +{ parameters: } +{ i - byte to write } + + +procedure CnOut2 (i: integer); extern; + +{ write a word to the constant buffer } +{ } +{ parameters: } +{ i - word to write } + + +procedure Out (b: integer); extern; + +{ write a byte to the output file } +{ } +{ parameters: } +{ b - byte to write } + + +procedure Out2 (w: integer); extern; + +{ write a word to the output file } +{ } +{ parameters: } +{ w - word to write } + + +procedure RefName (lab: stringPtr; disp, len, shift: integer); extern; + +{ handle a reference to a named label } +{ } +{ parameters: } +{ lab - label name } +{ disp - displacement past the label } +{ len - number of bytes in the reference } +{ shift - shift factor } + + +procedure LabelSearch (lab: integer; len, shift, disp: integer); extern; + +{ resolve a label reference } +{ } +{ parameters: } +{ lab - label number } +{ len - # bytes for the generated code } +{ shift - shift factor } +{ disp - disp past the label } +{ } +{ Note 1: maxlabel is reserved for use as the start of the } +{ string space } +{ Note 2: negative length indicates relative branch } +{ Note 3: zero length indicates 2 byte addr -1 } + + +procedure Purge; extern; + +{ write any constant bytes to the output buffer } + +{---------------------------------------------------------------} + +procedure ClearTable (table: symbolTable); extern; + +{ clear the symbol table to all zeros } + +{---------------------------------------------------------------} + + +procedure CheckStaticFunctions; + +{ check for undefined functions } + +var + i: 0..hashSize; {loop variable} + sp: identPtr; {pointer to a symbol table entry} + + msg: stringPtr; {error message ptr} + +begin {CheckStaticFunctions} +for i := 0 to hashSize do begin + sp := globalTable^.buckets[i]; + while sp <> nil do begin + if sp^.storage = private then + if sp^.itype^.kind = functionType then + if sp^.state <> defined then begin + numErrors := numErrors+1; + new(msg); + msg^ := concat('The static function ', sp^.name^, + ' was not defined.'); + writeln('*** ', msg^); + if terminalErrors then begin + if enterEditor then + ExitToEditor(msg, ord4(firstPtr)-ord4(bofPtr)) + else + TermError(0); + end; {if} + liDCBGS.merrf := 16; + end; {if} + sp := sp^.next; + end; {while} + end; {for} +end; {CheckStaticFunctions} + + +function CompTypes {t1, t2: typePtr): boolean}; + +{ Determine if the two types are compatible } + +label 1; + +var + el1,el2: longint; {array sizes} + kind1,kind2: typeKind; {temp variables (for speed)} + p1, p2: parameterPtr; {for tracing parameter lists} + pt1,pt2: typePtr; {pointer types} + + + function IsVoid (tp: typePtr): boolean; + + { Check to see if a type is void } + { } + { Parameters: } + { tp - type to check } + { } + { Returns: True if the type is void, else false } + + begin {IsVoid} + IsVoid := false; + if tp = voidPtr then + IsVoid := true + else if tp^.kind = scalarType then + if tp^.baseType = cgVoid then + IsVoid := true; + end; {IsVoid} + + +begin {CompTypes} +CompTypes := false; {assume the types are not compatible} +kind1 := t1^.kind; {get these for efficiency} +kind2 := t2^.kind; +if kind2 = definedType then {scan past type definitions} + CompTypes := CompTypes(t1, t2^.dType) +else if kind1 = definedType then + CompTypes := CompTypes(t1^.dType, t2) + +else + case kind1 of + + scalarType: + if kind2 = scalarType then + CompTypes := t1^.baseType = t2^.baseType + else if kind2 = enumType then + CompTypes := t1^.baseType = cgWord; + + arrayType: + if kind2 = arrayType then begin + el1 := t1^.elements; + el2 := t2^.elements; + if el1 = 0 then + el1 := el2 + else if el2 = 0 then + el2 := el1; + if el1 = el2 then + CompTypes := CompTypes(t1^.atype, t2^.atype); + end; {if} + + functionType: + if kind2 = functionType then + CompTypes := CompTypes(t1^.ftype,t2^.ftype) + else if kind2 = pointerType then + if t2^.ptype^.kind = functionType then + CompTypes := CompTypes(t1, t2^.ptype); + + pointerType: begin + if IsVoid(t1^.ptype) or IsVoid(t2^.ptype) then begin + CompTypes := true; + goto 1; + end; {if} + if kind2 = pointertype then + CompTypes := CompTypes(t1^.ptype, t2^.ptype) + else if kind2 = functionType then + CompTypes := CompTypes(t1^.ptype, t2); + end; + + enumType: + if kind2 = scalarType then + CompTypes := t2^.baseType = cgWord + else if kind2 = enumType then + CompTypes := true; + + structType,unionType: + CompTypes := t1 = t2; + + otherwise: ; + + end; {case t1^.kind} +1: +end; {CompTypes} + + +procedure DoGlobals; + +{ declare the ~globals and ~arrays segments } + + + procedure GenArrays; + + { define global arrays } + + var + didOne: boolean; {have we found an array yet?} + i: 0..hashSize; {loop variable} + ip: initializerPtr; {used to trace initializer lists} + lval: longint; {for converting types} + size: longint; {size of the array} + sp: identPtr; {pointer to a symbol table entry} + + begin {GenArrays} + didOne := false; + for i := 0 to hashSize do begin + sp := table^.buckets[i]; + while sp <> nil do begin + if sp^.storage in [global,private] then + if sp^.itype^.kind in [arrayType,structType,unionType] then begin + if not didOne then begin + if smallMemoryModel then + currentSegment := ' ' + else + currentSegment := '~ARRAYS '; + Gen2Name(dc_str, $4000, 1, @'~ARRAYS'); + didOne := true; + end; {if} + if sp^.state = initialized then begin + Gen2Name(dc_glb, 0, ord(sp^.storage = private), sp^.name); + ip := sp^.iPtr; + while ip <> nil do begin + case ip^.itype of + cgByte,cgUByte,cgWord,cgUWord: begin + lval := ip^.ival; + Gen2t(dc_cns, long(lval).lsw, ip^.count, ip^.itype); + end; + cgLong,cgULong: + GenL1(dc_cns, ip^.ival, ip^.count); + cgReal,cgDouble,cgComp,cgExtended: + GenR1t(dc_cns, ip^.rval, ip^.count, ip^.itype); + cgString: + GenS(dc_cns, ip^.sval); + ccPointer: begin + code^.optype := ccPointer; + code^.r := ord(ip^.pPlus); + code^.q := ip^.count; + code^.pVal := ip^.pVal; + if ip^.isName then begin + code^.lab := ip^.pName; + code^.pstr := nil; + end {if} + else + code^.pstr := ip^.pstr; + Gen0(dc_cns); + end; + otherwise: Error(57); + end; {case} + ip := ip^.next; + end; {while} + end {if} + else begin + size := sp^.itype^.size; + Gen2Name(dc_glb, long(size).lsw & $7FFF, + ord(sp^.storage = private), sp^.name); + size := size & $FFFF8000; + while size <> 0 do begin + Gen1(dc_dst, 16384); + size := size-16384; + end; {while} + end; {else} + end; {if} + sp := sp^.next; + end; {while} + end; {for} + if didOne then + Gen0(dc_enp); + end; {GenArrays} + + + procedure GenGlobals; + + { define non-array global variables } + + var + i: 0..hashSize; {loop variable} + ip: initializerPtr; {used to trace initializer lists} + lval: longint; {for extracting lsw} + sp: identPtr; {pointer to a symbol table entry} + + begin {GenGlobals} + Gen2t(dc_cns, 0, 1, cgByte); + for i := 0 to hashSize do begin + sp := table^.buckets[i]; + while sp <> nil do begin + if sp^.storage in [global,private] then + if sp^.itype^.kind in [scalarType,pointerType] then begin + if sp^.state = initialized then begin + Gen2Name(dc_glb, 0, ord(sp^.storage = private), sp^.name); + ip := sp^.iPtr; + case ip^.itype of + cgByte,cgUByte,cgWord,cgUWord: begin + lval := ip^.ival; + Gen2t(dc_cns, long(lval).lsw, 1, ip^.itype); + end; + cgLong,cgULong: + GenL1(dc_cns, ip^.ival, 1); + cgReal,cgDouble,cgComp,cgExtended: + GenR1t(dc_cns, ip^.rval, 1, ip^.itype); + cgString: + GenS(dc_cns, ip^.sval); + ccPointer: begin + code^.optype := ccPointer; + code^.q := 1; + code^.r := ord(ip^.pPlus); + code^.pVal := ip^.pVal; + if ip^.isName then begin + code^.lab := ip^.pName; + code^.pstr := nil; + end {if} + else + code^.pstr := ip^.pstr; + Gen0(dc_cns); + end; + otherwise: Error(57); + end; {case} + end {if} + else + Gen2Name(dc_glb, ord(sp^.itype^.size), + ord(sp^.storage = private), sp^.name); + end; + sp := sp^.next; + end; {while} + end; {for} + end; {GenGlobals} + +begin {DoGlobals} +{print the global symbol table} +{if printSymbols then {debug} +{ PrintTable(globalTable); {debug} + +{these segments are not dynamic!} +segmentKind := 0; + +{declare the ~globals segment, which holds non-array data types} +if smallMemoryModel then + currentSegment := ' ' +else + currentSegment := '~GLOBALS '; +Gen2Name(dc_str, $4000, 0, @'~GLOBALS'); +GenGlobals; +Gen0(dc_enp); + +{declare the ~arrays segment, which holds global arrays} +GenArrays; +end; {DoGlobals} + + +function FindSymbol {var tk: tokenType; class: spaceType; oneLevel: boolean; + staticAllowed: boolean): identPtr}; + +{ locate a symbol in the symbol table } +{ } +{ parameters: } +{ tk - token record for the identifier to find } +{ class - the kind of variable space to search } +{ oneLevel - search one level only? (used to check for } +{ duplicate symbols) } +{ staticAllowed - can we check for static variables? } +{ } +{ returns: } +{ A pointer to the symbol table entry is returned. If } +{ there is no entry, nil is returned. } + +label 1; + +var + doTagSpace: boolean; {do we still need to do the tags?} + hashDisp: longint; {disp into the hash table} + i: integer; {loop variable} + iHandle: ^identPtr; {pointer to start of hash bucket} + iPtr: identPtr; {pointer to the current symbol} + match: boolean; {for comparing substrings} + name: stringPtr; {name to search for} + np: stringPtr; {for searching for static variables} + sPtr: symbolTablePtr; {^ to current symbol table} + +begin {FindSymbol} +{get ready to search} +staticAllowed := staticAllowed and (staticNum <> '~0000'); +name := tk.name; {use a local variable} +hashDisp := Hash(name); {get the disp into the symbol table} +sPtr := table; {initialize the address of the sym. tbl} +FindSymbol := nil; {assume we won't find it} +np := nil; {no string buffer, yet} + +{check for the variable} +while sPtr <> nil do begin + iHandle := pointer(hashDisp+ord4(sPtr)); + if class = tagSpace then + iHandle := pointer(ord4(iHandle) + (hashSize+1)*4); + doTagSpace := class = allSpaces; + iPtr := iHandle^; + if iPtr = nil then + if doTagSpace then begin + iHandle := pointer(ord4(iHandle) + (hashSize+1)*4); + iPtr := iHandle^; + doTagSpace := false; + end; {if} + + {scan the hash bucket for a global or auto variable} + while iPtr <> nil do begin + if iPtr^.name^ = name^ then begin + FindSymbol := iPtr; + if iPtr^.isForwardDeclared then + ResolveForwardReference(iPtr); + tk.symbolPtr := iPtr; + goto 1; + end; {if} + iPtr := iPtr^.next; + if iPtr = nil then + if doTagSpace then begin + iHandle := pointer(ord4(iHandle) + (hashSize+1)*4); + iPtr := iHandle^; + doTagSpace := false; + end; {if} + end; {while} + + {rescan for a static variable} + if staticAllowed then begin + if np = nil then begin {form the static name} + if length(name^) < 251 then begin + new(np); + np^[0] := chr(5+length(name^)); + for i := 1 to 5 do + np^[i] := sPtr^.staticNum[i]; + for i := 1 to length(name^) do + np^[i+5] := name^[i]; + end; {if} + end {if} + else + for i := 2 to 5 do + np^[i] := sPtr^.StaticNum[i]; + + {scan the hash bucket for the identifier} + iHandle := pointer(hashDisp+ord4(globalTable)); + if class = tagSpace then + iHandle := pointer(ord4(iHandle) + (hashSize+1)*4); + iPtr := iHandle^; + + while iPtr <> nil do begin + if iPtr^.name^ = np^ then begin + FindSymbol := iPtr; + if iPtr^.isForwardDeclared then + ResolveForwardReference(iPtr); + tk.symbolPtr := iPtr; + goto 1; + end; {if} + iPtr := iPtr^.next; + end; {while} + end; {if staticAllowed} + + if oneLevel then + sPtr := nil + else + sPtr := sPtr^.next; + end; {while} + +1: +if np <> nil then + dispose(np); +end; {FindSymbol} + + +procedure GenParameters {pp: parameterPtr}; + +{ Generate labels and space for the parameters } +{ } +{ parameters: } +{ pp - pointer to first parameter } + +var + i: 0..hashSize; {loop variable} + pln: integer; {label number} + size: integer; {size of the parameter} + sp: identPtr; {symbol pointer} + tk: tokenType; {symbol name token} + +begin {GenParameters} +if pp <> nil then begin {prototyped parameters} + tk.kind := ident; + tk.numString := nil; + tk.class := identifier; + while pp <> nil do begin + pln := GetLocalLabel; + tk.name := pp^.parameter^.name; + tk.symbolPtr := nil; + sp := FindSymbol(tk, variableSpace, true, false); + if sp = nil then + sp := pp^.parameter; + if sp^.itype^.kind = arrayType then + Gen3(dc_prm, pln, cgPointerSize, sp^.pdisp) + else begin + size := long(sp^.itype^.size).lsw; + if (size = 1) and (sp^.itype^.kind = scalarType) then + size := 2; + Gen3(dc_prm, pln, size, sp^.pdisp); + end; {else} + sp^.pln := pln; + pp := pp^.next; + end; {while} + end {if} +else begin {K&R parameters} + for i := 0 to hashSize do begin + sp := table^.buckets[i]; + while sp <> nil do begin + if sp^.storage = parameter then begin + sp^.pln := GetLocalLabel; + if sp^.itype^.kind = arrayType then + Gen3(dc_prm, sp^.lln, cgPointerSize, sp^.pdisp) + else begin + size := long(sp^.itype^.size).lsw; + if (size = 1) and (sp^.itype^.kind = scalarType) then + size := 2; + Gen3(dc_prm, sp^.lln, size, sp^.pdisp); + end; {else} + end; {if} + sp := sp^.next; + end; {while} + end; {for} + end; {else} +end; {GenParameters} + + +procedure GenSymbols {sym: symbolTablePtr; doGlobals: boolean}; + +{ generate a symbol table for the debugger } +{ } +{ parameters: } +{ sym - symbol table to generate } +{ doGlobals - include global symbols in the table } +{ } +{ outputs: } +{ symLength - length of debug symbol table } + +const + noDisp = -1; {disp returned by GetTypeDisp if the type was not found} + +type + tpPtr = ^tpRecord; {type list displacements} + tpRecord = record + next: tpPtr; + tp: typePtr; + disp: integer; + end; + +var + i: 0..hashSize; {loop/index variable} + ip: identPtr; {used to trace identifier lists} + tpList,tp2: tpPtr; {type displacement list} + + + function GetTypeDisp (tp: typePtr): integer; + + { Look for an existing entry for this type } + { } + { Parameters: } + { tp - type to look for } + { } + { Returns: Disp to a variable of the same type, or noDisp if } + { there is no such entry. } + { } + { Notes: If the type is not in the type list, it is entered } + { in the list by this call. } + + var + tp1, tp2: tpPtr; {used to manipulate type list} + + begin {GetTypeDisp} + tp1 := tpList; {look for the type} + tp2 := nil; + while tp1 <> nil do + if tp1^.tp = tp then begin + tp2 := tp1; + tp1 := nil; + end {if} + else + tp1 := tp1^.next; + if tp2 <> nil then + GetTypeDisp := tp2^.disp {return disp to entry} + else begin + GetTypeDisp := noDisp; {no entry} + new(tp1); {create a new entry} + tp1^.next := tpList; + tpList := tp1; + tp1^.tp := tp; + tp1^.disp := symLength; + end; {else} + end; {GetTypeDisp} + + + procedure GenSymbol (ip: identPtr; storage: storageType); + + { Generate a single symbol or struct field } + { } + { parameters: } + { ip - identifier to generate } + { storage - storage type; none for struct/union fields } + + var + disp: integer; {disp to symbol of same type} + + + procedure WriteAddress (ip: identPtr); + + { Write the address and DP flag } + { } + { parameters: } + { ip - identifier } + + var + size: longint; {used to break apart longints} + + begin {WriteAddress} + if storage in [external,global,private] then begin + RefName(ip^.name, 0, 4, 0); + CnOut(1); + end {if} + else if storage = none then begin + size := ip^.disp; + CnOut2(long(size).lsw); + CnOut2(long(size).msw); + CnOut(ord(ip^.next <> nil)); + end {else if} + else begin + CnOut2(LabelToDisp(ip^.lln)); + CnOut2(0); + CnOut(0); + end; {else} + end; {WriteAddress} + + + procedure WriteName (ip: identPtr); + + { Write the name field for an identifier } + { } + { parameters: } + { ip - identifier } + + var + len: 0..maxint; {string length} + j: 0..maxint; {loop/index variable} + + begin {WriteName} + Purge; {generate the address of the variable } + Out(235); Out(4); { name } + LabelSearch(maxLabel, 4, 0, 0); + if stringsize <> 0 then begin + Out(129); + Out2(stringsize); Out2(0); + Out(1); + end; {if} + Out(0); + len := length(ip^.name^); {place the name in the string buffer} + if maxstring-stringsize >= len+1 then begin + stringspace[stringsize+1] := chr(len); + for j := 1 to len do + stringspace[j+stringsize+1] := ip^.name^[j]; + stringsize := stringsize+len+1; + end {if} + else + Error(60); + end; {WriteName} + + + procedure WriteScalarType (tp: typePtr; modifiers, subscripts: integer); + + { Write a scalar type and subscipt field } + { } + { parameters: } + { tp - type pointer } + { modifiers - value to or with the type code } + { subscripts - number of subscripts } + + var + val: integer; {type value} + + begin {WriteScalarType} + case tp^.baseType of + cgByte: val := $40; + cgUByte: val := $00; + cgWord: val := $01; + cgUWord: val := $41; + cgLong: val := $02; + cgULong: val := $42; + cgReal: val := $03; + cgDouble: val := $04; + cgComp: val := $0A; + cgExtended: val := $05; + otherwise: val := $01; + end; {case} + CnOut(val | modifiers); {write the format byte} + CnOut2(subscripts); {write the # of subscripts} + end; {WriteScalarType} + + + procedure WritePointerType (tp: typePtr; subscripts: integer); + + { write a pointer type field } + { } + { parameters: } + { tp - pointer type } + { subscripts - number of subscript fields } + + begin {WritePointerType} + case tp^.ptype^.kind of + scalarType: WriteScalarType(tp^.ptype, $80, subscripts); + enumType, + functionType: WriteScalarType(wordPtr, $80, subscripts); + otherwise: begin + CnOut(11); + CnOut2(subscripts); + end; + end; {case} + end; {WritePointerType} + + + procedure ExpandPointerType (tp: typePtr); forward; + + + procedure ExpandStructType (tp: typePtr); + + { write the type entries for a struct or union } + { } + { parameters: } + { tp - struct/union type } + + var + ip: identPtr; {used to trace the field list} + + begin {ExpandStructType} + ip := tp^.fieldList; + while ip <> nil do begin + GenSymbol(ip, none); + ip := ip^.next; + end; {while} + end; {ExpandStructType} + + + procedure WriteArrays (tp: typePtr); + + { handle an array type } + { } + { parameters: } + { tp - array type } + + var + count: 0..maxint; {# of subscripts} + size: longint; {for converting long numbers} + tp2: typePtr; {used to trace array type list} + + begin {WriteArrays} + count := 0; {count the subscripts} + tp2 := tp; + while tp2^.kind = arrayType do begin + count := count+1; + tp2 := tp2^.aType; + end; {while} + if tp2^.kind = scalarType then {write the type code} + if tp2^.baseType in [cgByte,cgUByte] then begin + count := count-1; + CnOut(6); + CnOut2(count); + end {if} + else + WriteScalarType(tp2, 0, count) + else if tp2^.kind = enumType then + WriteScalarType(wordPtr, 0, count) + else if tp2^.kind = pointerType then + WritePointerType(tp2, count) + else begin + CnOut(12); + CnOut2(count); + end; {else if} + while count <> 0 do begin {write the subscript entries} + CnOut2(0); CnOut2(0); + if tp^.elements = 0 then + size := $00FFFFFF + else + size := tp^.elements-1; + CnOut2(long(size).lsw); CnOut2(long(size).msw); + size := tp^.aType^.size; + CnOut2(long(size).lsw); CnOut2(long(size).msw); + symLength := symLength+12; + tp := tp^.aType; + count := count-1; + end; {while} + if tp2^.kind = pointerType then {expand complex types} + ExpandPointerType(tp2) + else if tp2^.kind in [structtype,uniontype] then + ExpandStructType(tp2); + end; {WriteArrays} + + + procedure ExpandPointerType {tp: typePtr}; + + { write the type entries for complex pointer types } + { } + { parameters: } + { tp - pointer type } + + var + disp: integer; {disp to symbol of same type} + + begin {ExpandPointerType} + if tp^.ptype^.kind in [pointerType,arrayType,structType,unionType] then + begin + symLength := symLength+12; + CnOut2(0); CnOut2(0); + CnOut2(0); CnOut2(0); + CnOut(0); + case tp^.ptype^.kind of + pointerType: begin + WritePointerType(tp^.ptype, 0); + ExpandPointerType(tp^.ptype); + end; + arrayType: WriteArrays(tp^.ptype); + structType, + unionType: begin + disp := GetTypeDisp(tp^.ptype); + if disp = noDisp then begin + CnOut(12); + CnOut2(0); + ExpandStructType(tp^.ptype); + end {if} + else begin + CnOut(13); + CnOut2(disp); + end; {else} + end; + end; {case} + end; {if} + end; {ExpandPointerType} + + + begin {GenSymbol} + if ip^.itype^.kind in + [scalarType,arrayType,pointerType,enumType,structType,unionType] + then begin + WriteName(ip); {write the name field} + WriteAddress(ip); {write the address field} + case ip^.itype^.kind of + scalarType: WriteScalarType(ip^.itype, 0, 0); + enumType: WriteScalarType(wordPtr, 0, 0); + pointerType: begin + WritePointerType(ip^.itype, 0); + ExpandPointerType(ip^.itype); + end; + arrayType: WriteArrays(ip^.itype); + structType, + unionType: begin + disp := GetTypeDisp(ip^.itype); + if disp = noDisp then begin + CnOut(12); + CnOut2(0); + ExpandStructType(ip^.itype); + end {if} + else begin + CnOut(13); + CnOut2(disp); + end; {else} + end; + end; {case} + symLength := symLength+12; {update length of symbol table} + end; {if} + end; {GenSymbol} + + +begin {GenSymbols} +tpList := nil; {no types so far} +if sym <> nil then + for i := 0 to hashSize do begin {loop over all hash buckets} + ip := sym^.buckets[i]; {trace through all symbols in this bucket} + while ip <> nil do begin + if ip^.storage <> none then + GenSymbol(ip, ip^.storage); + ip := ip^.next; {next symbol} + end; {while} + end; {for} +while tpList <> nil do begin {dispose of type list} + tp2 := tpList; + tpList := tp2^.next; + dispose(tp2); + end; {while} +if doGlobals then {do globals} + GenSymbols(globalTable, false); +end; {GenSymbols} + + +procedure InitSymbol; + +{ Initialize the symbol table module } + +var + i: 0..hashSize; {loop variable} + +begin {InitSymbol} +staticNum := '~0000'; {no functions processed} +table := nil; {initialize the global symbol table} +PushTable; +globalTable := table; +noDeclarations := false; + {declare base types} +new(bytePtr); {byte} +with bytePtr^ do begin + size := cgByteSize; + saveDisp := 0; + isConstant := false; + kind := scalarType; + baseType := cgByte; + end; {with} +new(uBytePtr); {unsigned byte} +with uBytePtr^ do begin + size := cgByteSize; + saveDisp := 0; + isConstant := false; + kind := scalarType; + baseType := cgUByte; + end; {with} +new(wordPtr); {word} +with wordPtr^ do begin + size := cgWordSize; + saveDisp := 0; + isConstant := false; + kind := scalarType; + baseType := cgWord; + end; {with} +new(uWordPtr); {unsigned word} +with uWordPtr^ do begin + size := cgWordSize; + saveDisp := 0; + isConstant := false; + kind := scalarType; + baseType := cgUWord; + end; {with} +new(longPtr); {long} +with longPtr^ do begin + size := cgLongSize; + saveDisp := 0; + isConstant := false; + kind := scalarType; + baseType := cgLong; + end; {with} +new(uLongPtr); {unsigned long} +with uLongPtr^ do begin + size := cgLongSize; + saveDisp := 0; + isConstant := false; + kind := scalarType; + baseType := cgULong; + end; {with} +new(realPtr); {real} +with realPtr^ do begin + size := cgRealSize; + saveDisp := 0; + isConstant := false; + kind := scalarType; + baseType := cgReal; + end; {with} +new(doublePtr); {double} +with doublePtr^ do begin + size := cgDoubleSize; + saveDisp := 0; + isConstant := false; + kind := scalarType; + baseType := cgDouble; + end; {with} +new(compPtr); {comp} +with compPtr^ do begin + size := cgCompSize; + saveDisp := 0; + isConstant := false; + kind := scalarType; + baseType := cgComp; + end; {with} +new(extendedPtr); {extended} +with extendedPtr^ do begin + size := cgExtendedSize; + saveDisp := 0; + isConstant := false; + kind := scalarType; + baseType := cgExtended; + end; {with} +new(stringTypePtr); {string constant type} +with stringTypePtr^ do begin + size := 0; + saveDisp := 0; + isConstant := false; + kind := arrayType; + aType := uBytePtr; + elements := 1; + end; {with} +new(voidPtr); {void} +with voidPtr^ do begin + size := 0; + saveDisp := 0; + isConstant := false; + kind := scalarType; + baseType := cgVoid; + end; {with} +new(voidPtrPtr); {typeless pointer} +with voidPtrPtr^ do begin + size := 4; + saveDisp := 0; + isConstant := false; + kind := pointerType; + pType := voidPtr; + end; {with} +new(defaultStruct); {default structure} +with defaultStruct^ do begin {(for structures with errors)} + size := cgWordSize; + saveDisp := 0; + isConstant := false; + kind := structType; + sName := nil; + new(fieldList); + with fieldlist^ do begin + next := nil; + name := @'field'; + itype := wordPtr; + class := ident; + state := declared; + disp := 0; + bitdisp := 0; + end; {with} + end; {with} +end; {InitSymbol} + + +function NewSymbol {name: stringPtr; itype: typePtr; class: tokenEnum; + space: spaceType; state: stateKind): identPtr}; + +{ insert a new symbol in the symbol table } +{ } +{ parameters: } +{ name - pointer to the symbol name } +{ itype - pointer to the symbol type } +{ class - storage class } +{ space - the kind of variable space to put the } +{ identifier in } +{ state - variable declaration state } +{ } +{ returns: pointer to the inserted symbol } + +var + cs: identPtr; {current symbol} + hashPtr: ^identPtr; {pointer to hash bucket in symbol table} + i: integer; {loop variable} + isGlobal: boolean; {are we using the global table?} + lUseGlobalPool: boolean; {use the global symbol pool?} + needSymbol: boolean; {do we need to declare it?} + np: stringPtr; {for forming static name} + p: identPtr; {work pointer} + tk: tokenType; {fake token; for FindSymbol} + +begin {NewSymbol} +needSymbol := true; {assume we need a symbol} +cs := nil; {no current symbol found} +isGlobal := false; {set up defaults} +lUseGlobalPool := useGlobalPool; +tk.name := name; +tk.symbolPtr := nil; +if space <> fieldListSpace then begin {are we defining a function?} + if itype^.kind = functionType then begin + isGlobal := true; + useGlobalPool := true; + if class in [autosy, ident] then + class := externsy; + if not lUseGlobalPool then begin + np := pointer(Malloc(length(name^)+1)); + CopyString(pointer(np), pointer(name)); + tk.name := np; + name := np; + end; {if} + cs := FindSymbol(tk, space, false, true); + if cs <> nil then begin + if cs^.state = defined then + if state = defined then + Error(42); + p := cs; + needSymbol := false; + if not itype^.prototyped then begin + itype^.prototyped := cs^.itype^.prototyped; + itype^.parameterList := cs^.itype^.parameterList; + end; {if} + end; {if} + end {if} + else if (itype^.kind in [structType,unionType]) and (itype^.fieldList = nil) + and doingParameters then begin + isGlobal := true; + useGlobalPool := true; + end; {else if} + if noDeclarations then begin {if we need a symbol table, create it} + if not isGlobal then + noDeclarations := false; + end {if} + else begin {check for duplicates} + cs := FindSymbol(tk, space, true, false); + if cs <> nil then begin + if (not CompTypes(cs^.itype, itype)) + or ((cs^.state = initialized) and (state = initialized)) + or (globalTable <> table) then + if (not doingParameters) or (cs^.state <> declared) then + Error(42); + p := cs; + needSymbol := false; + end; {if} + end; {else} + end; {if} +if class = staticsy then {statics go in the global symbol table} + if not isGLobal then + if globalTable <> table then begin + cs := FindSymbol(tk, space, true, true); + if cs <> nil then begin {check for duplicates} + if (not CompTypes(cs^.itype, itype)) + or ((cs^.state = defined) and (state <> initialized)) + or (cs^.state = initialized) then + Error(42); + p := cs; + needSymbol := false; + end; {if} + isGlobal := true; {note that we will use the global table} + useGlobalPool := true; + np := pointer(GMalloc(length(name^)+6)); + np^[0] := chr(5+length(name^)); + for i := 1 to 5 do + np^[i] := table^.staticNum[i]; + for i := 1 to length(name^) do + np^[i+5] := name^[i]; + name := np; + end; {if} +if needSymbol then begin + p := pointer(Calloc(sizeof(identRecord))); {get space for the record} + {p^.iPtr := nil;} {no initializers, yet} + {p^.saved := 0;} {not saved} + p^.state := state; {set the state} + {p^.isForwardDeclared := false;} {assume no forward declarations are used} + p^.name := name; {record the name} + if space <> fieldListSpace then {insert the symbol in the hash bucket} + begin + if itype = nil then + hashPtr := pointer(ord4(table)+Hash(name)) + else if isGlobal then + hashPtr := pointer(ord4(globalTable)+Hash(name)) + else + hashPtr := pointer(ord4(table)+Hash(name)); + if space = tagSpace then + hashPtr := pointer(ord4(hashPtr) + 4*(hashSize+1)); + p^.next := hashPtr^; + hashPtr^ := p; + end {if} + else + p^.next := nil; + end; {if} +if class in [autosy,registersy] then {check and set the storage class} + begin + if doingFunction or doingParameters then begin + p^.storage := stackFrame; + class := ident; + end {if} + else begin + p^.storage := global; + Error(62); + end; {else} + end {if} +else if class = ident then begin + if doingFunction then begin + p^.storage := stackFrame; + class := autosy; + end {if} + else + p^.storage := global; + end {else if} +else if class = externsy then + p^.storage := external +else if class = staticsy then + p^.storage := private +else + p^.storage := none; +p^.class := class; +p^.itype := itype; {set the symbol field values} +NewSymbol := p; {return a pointer to the new entry} +useGlobalPool := lUseGlobalPool; {restore the useGlobalPool variable} +end; {NewSymbol} + + +procedure PopTable; + +{ Pop a symbol table (remove definitions local to a block) } + +var + tPtr: symbolTablePtr; {work pointer} + +begin {PopTable} +tPtr := table; +{if printSymbols then {debug} +{ PrintTable(tPtr); {debug} +if tPtr^.next <> nil then begin + table := table^.next; + dispose(tPtr); + end; {if} +end; {PopTable} + + +{ copy 'symbol.print'} {debug} + + +procedure PushTable; + +{ Create a new symbol table, pushing the old one } + +var + done: boolean; {loop termination} + i: integer; {loop index} + tPtr: symbolTablePtr; {work pointer} + +begin {PushTable} +i := 5; {increment the static var number} +repeat + staticNum[i] := succ(staticNum[i]); + done := staticNum[i] <> succ('9'); + if not done then begin + staticNum[i] := '0'; + i := i-1; + done := i = 1; + end; {if} +until done; +if table = globalTable then {update fistStaticNum} + firstStaticNum := staticNum; +new(tPtr); {create a new symbol table} +ClearTable(tPtr^); +tPtr^.next := table; +table := tPtr; +tPtr^.staticNum := staticNum; {record the static symbol table number} +end; {PushTable} + + +procedure ResolveForwardReference {iPtr: identPtr}; + +{ resolve a forward reference } +{ } +{ parameters: } +{ iPtr - ptr to the forward declared identifier } + +var + fl: identPtr; {for tracing field lists} + ltk: tokenType; {for searching for forward refs} + sym: identPtr; {for finding forward refs} + lPtr,tPtr: typePtr; {for tracing forward declared types} + +begin {ResolveForwardReference} +iPtr^.isForwardDeclared := false; {we will succeeed or flag an error...} +tPtr := iPtr^.itype; {skip to the struct/union type} +while tPtr^.kind in [pointerType,arrayType,functionType,definedType] do begin + lPtr := tPtr; + tPtr := tPtr^.pType; + end; +if tPtr^.sName <> nil then begin {resolve the forward reference} + ltk.name := tPtr^.sName; + ltk.symbolPtr := nil; + sym := FindSymbol(ltk,tagSpace,false,true); + if sym <> nil then begin + if sym^.itype^.kind <> tPtr^.kind then + Error(107) + else begin + if sym^.itype = tPtr then + tPtr^.sName := nil + else + lPtr^.ptype := sym^.itype; + end; {else} + end; {if} + end; {if} +tPtr := lPtr^.pType; {check the field list for other fwd refs} +while tPtr^.kind in [pointerType,arrayType,functionType,definedType] do + tPtr := tPtr^.pType; +if tPtr^.kind in [structType,unionType] then begin + fl := tPtr^.fieldList; + while fl <> nil do begin + if fl^.isForwardDeclared then + ResolveForwardReference(fl); + fl := fl^.next; + end; {while} + end; {if} +end; {ResolveForwardReference} + +end. + +{$append 'symbol.asm'} diff --git a/Table.asm b/Table.asm old mode 100755 new mode 100644 index 8ffcf31..fc62fab --- a/Table.asm +++ b/Table.asm @@ -1 +1,876 @@ - mcopy table.macros **************************************************************** * * Table * * This segment contains the assembly language code for the * various initialized arrays and records in the program. This * file creates the object file linked into the program. * TABLE.PAS creates the interface file that informs the * other segments in the compiler what is in this segment. * **************************************************************** * root start dummy (.root) segment end charKinds start character set enum (illegal,ch_special,ch_dash,ch_plus,ch_lt,ch_gt,ch_eq,ch_exc),0 enum (ch_and,ch_bar,ch_dot,ch_white,ch_eol,ch_eof,ch_char,ch_string) enum (ch_asterisk,ch_slash,ch_percent,ch_carot,ch_pound,letter,digit) ! STANDARD dc i'ch_eof' nul dc i'illegal' soh dc i'illegal' stx dc i'illegal' etx dc i'illegal' eot dc i'illegal' enq dc i'illegal' ack dc i'illegal' bel dc i'ch_white' bs dc i'ch_white' ht dc i'ch_eol' lf dc i'ch_eol' vt dc i'ch_eol' ff dc i'ch_eol' cr dc i'illegal' co dc i'illegal' si dc i'illegal' dle dc i'illegal' dc1 dc i'illegal' dc2 dc i'illegal' dc3 dc i'illegal' dc4 dc i'illegal' nak dc i'illegal' syn dc i'illegal' etb dc i'illegal' can dc i'illegal' em dc i'illegal' sub dc i'illegal' esc dc i'illegal' fs dc i'illegal' gs dc i'illegal' rs dc i'illegal' us dc i'ch_white' space dc i'ch_exc' ! dc i'ch_string' " dc i'illegal' # dc i'illegal' $ dc i'ch_percent' % dc i'ch_and' & dc i'ch_char' ' dc i'ch_special' ( dc i'ch_special' ) dc i'ch_asterisk' * dc i'ch_plus' + dc i'ch_special' , dc i'ch_dash' - dc i'ch_dot' . dc i'ch_slash' / dc i'digit' 0 dc i'digit' 1 dc i'digit' 2 dc i'digit' 3 dc i'digit' 4 dc i'digit' 5 dc i'digit' 6 dc i'digit' 7 dc i'digit' 8 dc i'digit' 9 dc i'ch_special' : dc i'ch_special' ; dc i'ch_lt' < dc i'ch_eq' = dc i'ch_gt' > dc i'ch_special' ? dc i'illegal' @ dc i'letter' A dc i'letter' B dc i'letter' C dc i'letter' D dc i'letter' E dc i'letter' F dc i'letter' G dc i'letter' H dc i'letter' I dc i'letter' J dc i'letter' K dc i'letter' L dc i'letter' M dc i'letter' N dc i'letter' O dc i'letter' P dc i'letter' Q dc i'letter' R dc i'letter' S dc i'letter' T dc i'letter' U dc i'letter' V dc i'letter' W dc i'letter' X dc i'letter' Y dc i'letter' Z dc i'ch_special' [ dc i'illegal' \ dc i'ch_special' ] dc i'ch_carot' ^ dc i'letter' _ dc i'illegal' ` dc i'letter' a dc i'letter' b dc i'letter' c dc i'letter' d dc i'letter' e dc i'letter' f dc i'letter' g dc i'letter' h dc i'letter' i dc i'letter' j dc i'letter' k dc i'letter' l dc i'letter' m dc i'letter' n dc i'letter' o dc i'letter' p dc i'letter' q dc i'letter' r dc i'letter' s dc i'letter' t dc i'letter' u dc i'letter' v dc i'letter' w dc i'letter' x dc i'letter' y dc i'letter' z dc i'ch_special' { dc i'ch_bar' | dc i'ch_special' } dc i'ch_special' ~ dc i'illegal' rub ! EXTENDED dc i'letter' nul dc i'letter' soh dc i'letter' stx dc i'letter' etx dc i'letter' eot dc i'letter' enq dc i'letter' ack dc i'letter' bel dc i'letter' bs dc i'letter' ht dc i'letter' lf dc i'letter' vt dc i'letter' ff dc i'letter' cr dc i'letter' co dc i'letter' si dc i'letter' dle dc i'letter' dc1 dc i'letter' dc2 dc i'letter' dc3 dc i'letter' dc4 dc i'letter' nak dc i'letter' syn dc i'letter' etb dc i'letter' can dc i'letter' em dc i'letter' sub dc i'letter' esc dc i'letter' fs dc i'letter' gs dc i'letter' rs dc i'letter' us dc i'illegal' space dc i'illegal' ! dc i'illegal' " dc i'illegal' # dc i'illegal' $ dc i'illegal' % dc i'illegal' & dc i'letter' ' dc i'illegal' ( dc i'illegal' ) dc i'illegal' * dc i'illegal' + dc i'illegal' , dc i'ch_special' - dc i'letter' . dc i'letter' / dc i'illegal' 0 dc i'illegal' 1 dc i'ch_special' 2 dc i'ch_special' 3 dc i'letter' 4 dc i'letter' 5 dc i'letter' 6 dc i'letter' 7 dc i'letter' 8 dc i'letter' 9 dc i'illegal' : dc i'letter' ; dc i'letter' < dc i'letter' = dc i'letter' > dc i'letter' ? dc i'illegal' @ dc i'illegal' A dc i'illegal' B dc i'illegal' C dc i'letter' D dc i'illegal' E dc i'letter' F dc i'ch_special' G dc i'ch_special' H dc i'illegal' I dc i'ch_white' J dc i'letter' K dc i'letter' L dc i'letter' M dc i'letter' N dc i'letter' O dc i'illegal' P dc i'illegal' Q dc i'illegal' R dc i'illegal' S dc i'illegal' T dc i'illegal' U dc i'ch_special' V dc i'illegal' W dc i'letter' X dc i'illegal' Y dc i'illegal' Z dc i'illegal' [ dc i'illegal' \ dc i'illegal' ] dc i'letter' ^ dc i'letter' _ dc i'illegal' ` dc i'illegal' a dc i'illegal' b dc i'illegal' c dc i'illegal' d dc i'illegal' e dc i'illegal' f dc i'illegal' g dc i'illegal' h dc i'illegal' i dc i'illegal' j dc i'illegal' k dc i'illegal' l dc i'illegal' m dc i'illegal' n dc i'illegal' o dc i'illegal' p dc i'illegal' q dc i'illegal' r dc i'illegal' s dc i'illegal' t dc i'illegal' u dc i'illegal' v dc i'illegal' w dc i'illegal' x dc i'illegal' y dc i'illegal' z dc i'illegal' { dc i'illegal' | dc i'illegal' } dc i'illegal' ~ dc i'illegal' rub end charSym start single character symbols enum ident,0 identifiers ! constants enum (intconst,uintconst,longconst,ulongconst,doubleconst) enum stringconst ! reserved words enum (autosy,asmsy,breaksy,casesy,charsy) enum (continuesy,constsy,compsy,defaultsy,dosy) enum (doublesy,elsesy,enumsy,externsy,extendedsy) enum (floatsy,forsy,gotosy,ifsy,intsy) enum (inlinesy,longsy,pascalsy,registersy,returnsy) enum (shortsy,sizeofsy,staticsy,structsy,switchsy) enum (segmentsy,signedsy,typedefsy,unionsy,unsignedsy) enum (voidsy,volatilesy,whilesy) ! reserved symbols enum (excch,percentch,carotch,andch,asteriskch) enum (minusch,plusch,eqch,tildech,barch) enum (dotch,ltch,gtch,slashch,questionch) enum (lparench,rparench,lbrackch,rbrackch,lbracech) enum (rbracech,commach,semicolonch,colonch,poundch) enum (minusgtop,plusplusop,minusminusop,ltltop,gtgtop) enum (lteqop,gteqop,eqeqop,exceqop,andandop) enum (barbarop,pluseqop,minuseqop,asteriskeqop,slasheqop) enum (percenteqop,ltlteqop,gtgteqop,andeqop,caroteqop) enum (bareqop,poundpoundop) enum (eolsy,eofsy) control characters enum (typedef) user types enum (uminus,uand,uasterisk) converted operations enum (parameteroper,castoper,opplusplus,opminusminus) enum (macroParm) macro language dc i'0,0,0,0,0,0,0,0' nul-bel dc i'0,0,0,0,0,0,0,0' bs-si dc i'0,0,0,0,0,0,0,0' dle-etb dc i'0,0,0,0,0,0,0,0' can-us dc i'0,0,0,poundch,0,0,0,0' space-' dc i'lparench,rparench,0,0,commach,0,dotch,0' (-/ dc i'0,0,0,0,0,0,0,0' 0-7 dc i'0,0,colonch,semicolonch,0,0,0,questionch' 8-? dc i'0,0,0,0,0,0,0,0' @-G dc i'0,0,0,0,0,0,0,0' H-O dc i'0,0,0,0,0,0,0,0' P-W dc i'0,0,0,lbrackch,0,rbrackch,0,0' X-_ dc i'0,0,0,0,0,0,0,0' `-g dc i'0,0,0,0,0,0,0,0' h-o dc i'0,0,0,0,0,0,0,0' p-w dc i'0,0,0,lbracech,0,rbracech,tildech,0' x-rub dc i'0,0,0,0,0,0,0,0' nul-bel dc i'0,0,0,0,0,0,0,0' bs-si dc i'0,0,0,0,0,0,0,0' dle-etb dc i'0,0,0,0,0,0,0,0' can-us dc i'0,0,0,0,0,0,0,0' space-' dc i'0,0,0,0,0,exceqop,0,0' (-/ dc i'0,0,lteqop,gteqop,0,0,0,0' 0-7 dc i'0,0,0,0,0,0,0,0' 8-? dc i'0,0,0,0,0,0,0,ltltop' @-G dc i'gtgtop,0,0,0,0,0,0,0' H-O dc i'0,0,0,0,0,0,slashch,0' P-W dc i'0,0,0,0,0,0,0,0' X-_ dc i'0,0,0,0,0,0,0,0' `-g dc i'0,0,0,0,0,0,0,0' h-o dc i'0,0,0,0,0,0,0,0' p-w dc i'0,0,0,0,0,0,0,0' x-rub end icp start in comming priority for expression ! assumes notAnOperation = 200 dc i1'200' ident dc i1'200' intconst dc i1'200' uintconst dc i1'200' longconst dc i1'200' ulongconst dc i1'200' doubleconst dc i1'200' stringconst dc i1'200' autosy dc i1'200' asmsy dc i1'200' breaksy dc i1'200' casesy dc i1'200' charsy dc i1'200' continuesy dc i1'200' constsy dc i1'200' compsy dc i1'200' defaultsy dc i1'200' dosy dc i1'200' doublesy dc i1'200' elsesy dc i1'200' enumsy dc i1'200' externsy dc i1'200' extendedsy dc i1'200' floatsy dc i1'200' forsy dc i1'200' gotosy dc i1'200' ifsy dc i1'200' intsy dc i1'200' inlinesy dc i1'200' longsy dc i1'200' pascalsy dc i1'200' registersy dc i1'200' returnsy dc i1'200' shortsy dc i1'16' sizeofsy dc i1'200' staticsy dc i1'200' structsy dc i1'200' switchsy dc i1'200' segmentsy dc i1'200' signedsy dc i1'200' typedefsy dc i1'200' unionsy dc i1'200' unsignedsy dc i1'200' voidsy dc i1'200' volatilesy dc i1'200' whilesy dc i1'16' excch dc i1'15' percentch dc i1'9' carotch dc i1'10' andch dc i1'15' asteriskch dc i1'14' minusch dc i1'14' plusch dc i1'3' eqch dc i1'16' tildech dc i1'8' barch dc i1'200' dotch dc i1'12' ltch dc i1'12' gtch dc i1'15' slashch dc i1'5' questionch dc i1'16' lparench dc i1'200' rparench dc i1'200' lbrackch dc i1'200' rbrackch dc i1'200' lbracech dc i1'200' rbracech dc i1'1' commach dc i1'200' semicolonch dc i1'5' colonch dc i1'200' poundch dc i1'200' minusgtop dc i1'16' plusplusop dc i1'16' minusminusop dc i1'13' ltltop dc i1'13' gtgtop dc i1'12' lteqop dc i1'12' gteqop dc i1'11' eqeqop dc i1'11' exceqop dc i1'7' andandop dc i1'6' barbarop dc i1'3' pluseqop dc i1'3' minuseqop dc i1'3' asteriskeqop dc i1'3' slasheqop dc i1'3' percenteqop dc i1'3' ltlteqop dc i1'3' gtgteqop dc i1'3' andeqop dc i1'3' caroteqop dc i1'3' bareqop dc i1'200' poundpoundop dc i1'200' eolsy dc i1'200' eofsy dc i1'200' typedef dc i1'16' uminus dc i1'16' uand dc i1'16' uasterisk dc i1'200' parameteroper dc i1'16' castoper dc i1'16' opplusplus dc i1'16' opminusminus dc i1'200' macroParm end iopcodes start implied operand operation codes dc i1'$18' clc dc i1'$D8' cld dc i1'$58' cli dc i1'$B8' clv dc i1'$CA' dex dc i1'$88' dey dc i1'$E8' inx dc i1'$C8' iny dc i1'$EA' nop dc i1'$48' pha dc i1'$8B' phb dc i1'$0B' phd dc i1'$4B' phk dc i1'$08' php dc i1'$DA' phx dc i1'$5A' phy dc i1'$68' pla dc i1'$AB' plb dc i1'$2B' pld dc i1'$28' plp dc i1'$FA' plx dc i1'$7A' ply dc i1'$40' rti dc i1'$6B' rtl dc i1'$60' rts dc i1'$38' sec dc i1'$F8' sed dc i1'$78' sei dc i1'$DB' stp dc i1'$AA' tax dc i1'$A8' tay dc i1'$5B' tcd dc i1'$1B' tcs dc i1'$7B' tdc dc i1'$3B' tsc dc i1'$BA' tsx dc i1'$8A' txa dc i1'$9A' txs dc i1'$9B' txy dc i1'$98' tya dc i1'$BB' tyx dc i1'$CB' wai dc i1'$EB' xba dc i1'$FB' xce end isp start in stack priority for expression dc i1'0' ident dc i1'0' intconst dc i1'0' uintconst dc i1'0' longconst dc i1'0' ulongconst dc i1'0' doubleconst dc i1'0' stringconst dc i1'0' autosy dc i1'0' asmsy dc i1'0' breaksy dc i1'0' casesy dc i1'0' charsy dc i1'0' continuesy dc i1'0' constsy dc i1'0' compsy dc i1'0' defaultsy dc i1'0' dosy dc i1'0' doublesy dc i1'0' elsesy dc i1'0' enumsy dc i1'0' externsy dc i1'0' extendedsy dc i1'0' floatsy dc i1'0' forsy dc i1'0' gotosy dc i1'0' ifsy dc i1'0' intsy dc i1'0' inlinesy dc i1'0' longsy dc i1'0' pascalsy dc i1'0' registersy dc i1'0' returnsy dc i1'0' shortsy dc i1'16' sizeofsy dc i1'0' staticsy dc i1'0' structsy dc i1'0' switchsy dc i1'0' segmentsy dc i1'0' signedsy dc i1'0' typedefsy dc i1'0' unionsy dc i1'0' unsignedsy dc i1'0' voidsy dc i1'0' volatilesy dc i1'0' whilesy dc i1'16' excch dc i1'15' percentch dc i1'9' carotch dc i1'10' andch dc i1'15' asteriskch dc i1'14' minusch dc i1'14' plusch dc i1'2' eqch dc i1'16' tildech dc i1'8' barch dc i1'0' dotch dc i1'12' ltch dc i1'12' gtch dc i1'15' slashch dc i1'0' questionch dc i1'0' lparench dc i1'0' rparench dc i1'0' lbrackch dc i1'0' rbrackch dc i1'0' lbracech dc i1'0' rbracech dc i1'1' commach dc i1'0' semicolonch dc i1'4' colonch dc i1'0' poundch dc i1'0' minusgtop dc i1'16' plusplusop dc i1'16' minusminusop dc i1'13' ltltop dc i1'13' gtgtop dc i1'12' lteqop dc i1'12' gteqop dc i1'11' eqeqop dc i1'11' exceqop dc i1'7' andandop dc i1'6' barbarop dc i1'2' pluseqop dc i1'2' minuseqop dc i1'2' asteriskeqop dc i1'2' slasheqop dc i1'2' percenteqop dc i1'2' ltlteqop dc i1'2' gtgteqop dc i1'2' andeqop dc i1'2' caroteqop dc i1'2' bareqop dc i1'0' poundpoundop dc i1'0' eolsy dc i1'0' eofsy dc i1'0' typedef dc i1'16' uminus dc i1'16' uand dc i1'16' uasterisk dc i1'0' parameteroper dc i1'16' castoper dc i1'16' opplusplus dc i1'16' opminusminus dc i1'0' macroParm end names start mini-assembler op code names dc c'adcandaslbitcmpcopcpxcpydeceor' dc c'incjmljmpjsljsrldaldxldylsrora' dc c'peapeireprolrorsbcsepstastxsty' dc c'stztrbtsb' dc c'dcbdcwdcl' dc c'brk' dc c'mvnmvp' dc c'bccbcsbeqbmibnebplbrabrlperbvc' dc c'bvs' dc c'clccldcliclvdexdeyinxinynoppha' dc c'phbphdphkphpphxphyplaplbpldplp' dc c'plxplyrtirtlrtssecsedseistptax' dc c'taytcdtcstdctsctsxtxatxstxytya' dc c'tyxwaixbaxce' end nopcodes start ! acc imm dp dp_x dp_y operand order ! op op_x op_y i_dp_x i_dp_y ! dp_s li_dp la i_dp i_op ! i_la i_op_x i_dp_s_y li_dp_y long_x dc i1'0 ,$69 ,$65 ,$75 ,0 ' adc dc i1'$6D ,$7D ,$79 ,$61 ,$71 ' dc i1'$63 ,$67 ,$6F ,$72 ,0 ' dc i1'0 ,0 ,$73 ,$77 ,$7F ' dc i1'0 ,$29 ,$25 ,$35 ,0 ' and dc i1'$2D ,$3D ,$39 ,$21 ,$31 ' dc i1'$23 ,$27 ,$2F ,$32 ,0 ' dc i1'0 ,0 ,$33 ,$37 ,$3F ' dc i1'$0A ,0 ,$06 ,$16 ,0 ' asl dc i1'$0E ,$1E ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,$89 ,$24 ,$34 ,0 ' bit dc i1'$2C ,$3C ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,$C9 ,$C5 ,$D5 ,0 ' cmp dc i1'$CD ,$DD ,$D9 ,$C1 ,$D1 ' dc i1'$C3 ,$C7 ,$CF ,$D2 ,0 ' dc i1'0 ,0 ,$D3 ,$D7 ,$DF ' dc i1'0 ,0 ,$02 ,0 ,0 ' cop dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,$E0 ,$E4 ,0 ,0 ' cpx dc i1'$EC ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,$C0 ,$C4 ,0 ,0 ' cpy dc i1'$CC ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'$3A ,0 ,$C6 ,$D6 ,0 ' dec dc i1'$CE ,$DE ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,$49 ,$45 ,$55 ,0 ' eor dc i1'$4D ,$5D ,$59 ,$41 ,$51 ' dc i1'$43 ,$47 ,$4F ,$52 ,0 ' dc i1'0 ,0 ,$53 ,$57 ,$5F ' dc i1'$1A ,0 ,$E6 ,$F6 ,0 ' inc dc i1'$EE ,$FE ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' jml dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,$5C ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' jmp dc i1'$4C ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,$5C ,0 ,$6C ' dc i1'$DC ,$7C ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' jsl dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,$22 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' jsr dc i1'$20 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,$22 ,0 ,0 ' dc i1'0 ,$FC ,0 ,0 ,0 ' dc i1'0 ,$A9 ,$A5 ,$B5 ,0 ' lda dc i1'$AD ,$BD ,$B9 ,$A1 ,$B1 ' dc i1'$A3 ,$A7 ,$AF ,$B2 ,0 ' dc i1'0 ,0 ,$B3 ,$B7 ,$BF ' dc i1'0 ,$A2 ,$A6 ,0 ,$B6 ' ldx dc i1'$AE ,0 ,$BE ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,$A0 ,$A4 ,$B4 ,0 ' ldy dc i1'$AC ,$BC ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'$4A ,0 ,$46 ,$56 ,0 ' lsr dc i1'$4E ,$5E ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,$09 ,$05 ,$15 ,0 ' ora dc i1'$0D ,$1D ,$19 ,$01 ,$11 ' dc i1'$03 ,$07 ,$0F ,$12 ,0 ' dc i1'0 ,0 ,$13 ,$17 ,$1F ' dc i1'0 ,0 ,0 ,0 ,0 ' pea dc i1'$F4 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,$D4 ,0 ,0 ' pei dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,$D4 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,$C2 ,0 ,0 ,0 ' rep dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'$2A ,0 ,$26 ,$36 ,0 ' rol dc i1'$2E ,$3E ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'$6A ,0 ,$66 ,$76 ,0 ' ror dc i1'$6E ,$7E ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,$E9 ,$E5 ,$F5 ,0 ' sbc dc i1'$ED ,$FD ,$F9 ,$E1 ,$F1 ' dc i1'$E3 ,$E7 ,$EF ,$F2 ,0 ' dc i1'0 ,0 ,$F3 ,$F7 ,$FF ' dc i1'0 ,$E2 ,0 ,0 ,0 ' sep dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,$85 ,$95 ,0 ' sta dc i1'$8D ,$9D ,$99 ,$81 ,$91 ' dc i1'$83 ,$87 ,$8F ,$92 ,0 ' dc i1'0 ,0 ,$93 ,$97 ,$9F ' dc i1'0 ,0 ,$86 ,0 ,$96 ' stx dc i1'$8E ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,$84 ,$94 ,0 ' sty dc i1'$8C ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,$64 ,$74 ,0 ' stz dc i1'$9C ,$9E ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,$14 ,0 ,0 ' trb dc i1'$1C ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,$04 ,0 ,0 ' tsb dc i1'$0C ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' dc i1'0 ,0 ,0 ,0 ,0 ' end reservedWords start reserved word names str8 auto str8 asm str8 break str8 case str8 char str8 continue str8 const str8 comp str8 default str8 do str8 double str8 else str8 enum str8 extern str8 extended str8 float str8 for str8 goto str8 if str8 int str8 inline str8 long str8 pascal str8 register str8 return str8 short str8 sizeof str8 static str8 struct str8 switch str8 segment str8 signed str8 typedef str8 union str8 unsigned str8 void str8 volatile str8 while end ropcodes start dc i1'$90' bcc dc i1'$B0' bcs dc i1'$F0' beq dc i1'$30' bmi dc i1'$D0' bne dc i1'$10' bpl dc i1'$80' bra dc i1'$82' brl dc i1'$62' per dc i1'$50' bvc dc i1'$70' bvs end wordHash start reserved word hash table enum ident,0 identifiers ! constants enum (intconst,uintconst,longconst,ulongconst,doubleconst) enum stringconst ! reserved words enum (autosy,asmsy,breaksy,casesy,charsy) enum (continuesy,constsy,compsy,defaultsy,dosy) enum (doublesy,elsesy,enumsy,externsy,extendedsy) enum (floatsy,forsy,gotosy,ifsy,intsy) enum (inlinesy,longsy,pascalsy,registersy,returnsy) enum (shortsy,sizeofsy,staticsy,structsy,switchsy) enum (segmentsy,signedsy,typedefsy,unionsy,unsignedsy) enum (voidsy,volatilesy,whilesy,succwhilesy) dc i'autosy,breaksy,casesy,defaultsy,elsesy,floatsy' dc i'gotosy,ifsy,ifsy,longsy,longsy,longsy' dc i'pascalsy,pascalsy,pascalsy,pascalsy,registersy,registersy' dc i'shortsy,typedefsy,unionsy,voidsy,whilesy,succwhilesy' end \ No newline at end of file + mcopy table.macros +**************************************************************** +* +* Table +* +* This segment contains the assembly language code for the +* various initialized arrays and records in the program. This +* file creates the object file linked into the program. +* TABLE.PAS creates the interface file that informs the +* other segments in the compiler what is in this segment. +* +**************************************************************** +* +root start dummy (.root) segment + + end + +charKinds start character set + enum (illegal,ch_special,ch_dash,ch_plus,ch_lt,ch_gt,ch_eq,ch_exc),0 + enum (ch_and,ch_bar,ch_dot,ch_white,ch_eol,ch_eof,ch_char,ch_string) + enum (ch_asterisk,ch_slash,ch_percent,ch_carot,ch_pound,letter,digit) + +! STANDARD + dc i'ch_eof' nul + dc i'illegal' soh + dc i'illegal' stx + dc i'illegal' etx + dc i'illegal' eot + dc i'illegal' enq + dc i'illegal' ack + dc i'illegal' bel + dc i'ch_white' bs + dc i'ch_white' ht + dc i'ch_eol' lf + dc i'ch_eol' vt + dc i'ch_eol' ff + dc i'ch_eol' cr + dc i'illegal' co + dc i'illegal' si + dc i'illegal' dle + dc i'illegal' dc1 + dc i'illegal' dc2 + dc i'illegal' dc3 + dc i'illegal' dc4 + dc i'illegal' nak + dc i'illegal' syn + dc i'illegal' etb + dc i'illegal' can + dc i'illegal' em + dc i'illegal' sub + dc i'illegal' esc + dc i'illegal' fs + dc i'illegal' gs + dc i'illegal' rs + dc i'illegal' us + dc i'ch_white' space + dc i'ch_exc' ! + dc i'ch_string' " + dc i'illegal' # + dc i'illegal' $ + dc i'ch_percent' % + dc i'ch_and' & + dc i'ch_char' ' + dc i'ch_special' ( + dc i'ch_special' ) + dc i'ch_asterisk' * + dc i'ch_plus' + + dc i'ch_special' , + dc i'ch_dash' - + dc i'ch_dot' . + dc i'ch_slash' / + dc i'digit' 0 + dc i'digit' 1 + dc i'digit' 2 + dc i'digit' 3 + dc i'digit' 4 + dc i'digit' 5 + dc i'digit' 6 + dc i'digit' 7 + dc i'digit' 8 + dc i'digit' 9 + dc i'ch_special' : + dc i'ch_special' ; + dc i'ch_lt' < + dc i'ch_eq' = + dc i'ch_gt' > + dc i'ch_special' ? + dc i'illegal' @ + dc i'letter' A + dc i'letter' B + dc i'letter' C + dc i'letter' D + dc i'letter' E + dc i'letter' F + dc i'letter' G + dc i'letter' H + dc i'letter' I + dc i'letter' J + dc i'letter' K + dc i'letter' L + dc i'letter' M + dc i'letter' N + dc i'letter' O + dc i'letter' P + dc i'letter' Q + dc i'letter' R + dc i'letter' S + dc i'letter' T + dc i'letter' U + dc i'letter' V + dc i'letter' W + dc i'letter' X + dc i'letter' Y + dc i'letter' Z + dc i'ch_special' [ + dc i'illegal' \ + dc i'ch_special' ] + dc i'ch_carot' ^ + dc i'letter' _ + dc i'illegal' ` + dc i'letter' a + dc i'letter' b + dc i'letter' c + dc i'letter' d + dc i'letter' e + dc i'letter' f + dc i'letter' g + dc i'letter' h + dc i'letter' i + dc i'letter' j + dc i'letter' k + dc i'letter' l + dc i'letter' m + dc i'letter' n + dc i'letter' o + dc i'letter' p + dc i'letter' q + dc i'letter' r + dc i'letter' s + dc i'letter' t + dc i'letter' u + dc i'letter' v + dc i'letter' w + dc i'letter' x + dc i'letter' y + dc i'letter' z + dc i'ch_special' { + dc i'ch_bar' | + dc i'ch_special' } + dc i'ch_special' ~ + dc i'illegal' rub +! EXTENDED + dc i'letter' nul + dc i'letter' soh + dc i'letter' stx + dc i'letter' etx + dc i'letter' eot + dc i'letter' enq + dc i'letter' ack + dc i'letter' bel + dc i'letter' bs + dc i'letter' ht + dc i'letter' lf + dc i'letter' vt + dc i'letter' ff + dc i'letter' cr + dc i'letter' co + dc i'letter' si + dc i'letter' dle + dc i'letter' dc1 + dc i'letter' dc2 + dc i'letter' dc3 + dc i'letter' dc4 + dc i'letter' nak + dc i'letter' syn + dc i'letter' etb + dc i'letter' can + dc i'letter' em + dc i'letter' sub + dc i'letter' esc + dc i'letter' fs + dc i'letter' gs + dc i'letter' rs + dc i'letter' us + dc i'illegal' space + dc i'illegal' ! + dc i'illegal' " + dc i'illegal' # + dc i'illegal' $ + dc i'illegal' % + dc i'illegal' & + dc i'letter' ' + dc i'illegal' ( + dc i'illegal' ) + dc i'illegal' * + dc i'illegal' + + dc i'illegal' , + dc i'ch_special' - + dc i'letter' . + dc i'letter' / + dc i'illegal' 0 + dc i'illegal' 1 + dc i'ch_special' 2 + dc i'ch_special' 3 + dc i'letter' 4 + dc i'letter' 5 + dc i'letter' 6 + dc i'letter' 7 + dc i'letter' 8 + dc i'letter' 9 + dc i'illegal' : + dc i'letter' ; + dc i'letter' < + dc i'letter' = + dc i'letter' > + dc i'letter' ? + dc i'illegal' @ + dc i'illegal' A + dc i'illegal' B + dc i'illegal' C + dc i'letter' D + dc i'illegal' E + dc i'letter' F + dc i'ch_special' G + dc i'ch_special' H + dc i'illegal' I + dc i'ch_white' J + dc i'letter' K + dc i'letter' L + dc i'letter' M + dc i'letter' N + dc i'letter' O + dc i'illegal' P + dc i'illegal' Q + dc i'illegal' R + dc i'illegal' S + dc i'illegal' T + dc i'illegal' U + dc i'ch_special' V + dc i'illegal' W + dc i'letter' X + dc i'illegal' Y + dc i'illegal' Z + dc i'illegal' [ + dc i'illegal' \ + dc i'illegal' ] + dc i'letter' ^ + dc i'letter' _ + dc i'illegal' ` + dc i'illegal' a + dc i'illegal' b + dc i'illegal' c + dc i'illegal' d + dc i'illegal' e + dc i'illegal' f + dc i'illegal' g + dc i'illegal' h + dc i'illegal' i + dc i'illegal' j + dc i'illegal' k + dc i'illegal' l + dc i'illegal' m + dc i'illegal' n + dc i'illegal' o + dc i'illegal' p + dc i'illegal' q + dc i'illegal' r + dc i'illegal' s + dc i'illegal' t + dc i'illegal' u + dc i'illegal' v + dc i'illegal' w + dc i'illegal' x + dc i'illegal' y + dc i'illegal' z + dc i'illegal' { + dc i'illegal' | + dc i'illegal' } + dc i'illegal' ~ + dc i'illegal' rub + end + +charSym start single character symbols + enum ident,0 identifiers +! constants + enum (intconst,uintconst,longconst,ulongconst,doubleconst) + enum stringconst +! reserved words + enum (autosy,asmsy,breaksy,casesy,charsy) + enum (continuesy,constsy,compsy,defaultsy,dosy) + enum (doublesy,elsesy,enumsy,externsy,extendedsy) + enum (floatsy,forsy,gotosy,ifsy,intsy) + enum (inlinesy,longsy,pascalsy,registersy,returnsy) + enum (shortsy,sizeofsy,staticsy,structsy,switchsy) + enum (segmentsy,signedsy,typedefsy,unionsy,unsignedsy) + enum (voidsy,volatilesy,whilesy) +! reserved symbols + enum (excch,percentch,carotch,andch,asteriskch) + enum (minusch,plusch,eqch,tildech,barch) + enum (dotch,ltch,gtch,slashch,questionch) + enum (lparench,rparench,lbrackch,rbrackch,lbracech) + enum (rbracech,commach,semicolonch,colonch,poundch) + enum (minusgtop,plusplusop,minusminusop,ltltop,gtgtop) + enum (lteqop,gteqop,eqeqop,exceqop,andandop) + enum (barbarop,pluseqop,minuseqop,asteriskeqop,slasheqop) + enum (percenteqop,ltlteqop,gtgteqop,andeqop,caroteqop) + enum (bareqop,poundpoundop) + enum (eolsy,eofsy) control characters + enum (typedef) user types + enum (uminus,uand,uasterisk) converted operations + enum (parameteroper,castoper,opplusplus,opminusminus) + enum (macroParm) macro language + + dc i'0,0,0,0,0,0,0,0' nul-bel + dc i'0,0,0,0,0,0,0,0' bs-si + dc i'0,0,0,0,0,0,0,0' dle-etb + dc i'0,0,0,0,0,0,0,0' can-us + dc i'0,0,0,poundch,0,0,0,0' space-' + dc i'lparench,rparench,0,0,commach,0,dotch,0' (-/ + dc i'0,0,0,0,0,0,0,0' 0-7 + dc i'0,0,colonch,semicolonch,0,0,0,questionch' 8-? + dc i'0,0,0,0,0,0,0,0' @-G + dc i'0,0,0,0,0,0,0,0' H-O + dc i'0,0,0,0,0,0,0,0' P-W + dc i'0,0,0,lbrackch,0,rbrackch,0,0' X-_ + dc i'0,0,0,0,0,0,0,0' `-g + dc i'0,0,0,0,0,0,0,0' h-o + dc i'0,0,0,0,0,0,0,0' p-w + dc i'0,0,0,lbracech,0,rbracech,tildech,0' x-rub + + dc i'0,0,0,0,0,0,0,0' nul-bel + dc i'0,0,0,0,0,0,0,0' bs-si + dc i'0,0,0,0,0,0,0,0' dle-etb + dc i'0,0,0,0,0,0,0,0' can-us + dc i'0,0,0,0,0,0,0,0' space-' + dc i'0,0,0,0,0,exceqop,0,0' (-/ + dc i'0,0,lteqop,gteqop,0,0,0,0' 0-7 + dc i'0,0,0,0,0,0,0,0' 8-? + dc i'0,0,0,0,0,0,0,ltltop' @-G + dc i'gtgtop,0,0,0,0,0,0,0' H-O + dc i'0,0,0,0,0,0,slashch,0' P-W + dc i'0,0,0,0,0,0,0,0' X-_ + dc i'0,0,0,0,0,0,0,0' `-g + dc i'0,0,0,0,0,0,0,0' h-o + dc i'0,0,0,0,0,0,0,0' p-w + dc i'0,0,0,0,0,0,0,0' x-rub + end + +icp start in comming priority for expression +! assumes notAnOperation = 200 + dc i1'200' ident + dc i1'200' intconst + dc i1'200' uintconst + dc i1'200' longconst + dc i1'200' ulongconst + dc i1'200' doubleconst + dc i1'200' stringconst + dc i1'200' autosy + dc i1'200' asmsy + dc i1'200' breaksy + dc i1'200' casesy + dc i1'200' charsy + dc i1'200' continuesy + dc i1'200' constsy + dc i1'200' compsy + dc i1'200' defaultsy + dc i1'200' dosy + dc i1'200' doublesy + dc i1'200' elsesy + dc i1'200' enumsy + dc i1'200' externsy + dc i1'200' extendedsy + dc i1'200' floatsy + dc i1'200' forsy + dc i1'200' gotosy + dc i1'200' ifsy + dc i1'200' intsy + dc i1'200' inlinesy + dc i1'200' longsy + dc i1'200' pascalsy + dc i1'200' registersy + dc i1'200' returnsy + dc i1'200' shortsy + dc i1'16' sizeofsy + dc i1'200' staticsy + dc i1'200' structsy + dc i1'200' switchsy + dc i1'200' segmentsy + dc i1'200' signedsy + dc i1'200' typedefsy + dc i1'200' unionsy + dc i1'200' unsignedsy + dc i1'200' voidsy + dc i1'200' volatilesy + dc i1'200' whilesy + dc i1'16' excch + dc i1'15' percentch + dc i1'9' carotch + dc i1'10' andch + dc i1'15' asteriskch + dc i1'14' minusch + dc i1'14' plusch + dc i1'3' eqch + dc i1'16' tildech + dc i1'8' barch + dc i1'200' dotch + dc i1'12' ltch + dc i1'12' gtch + dc i1'15' slashch + dc i1'5' questionch + dc i1'16' lparench + dc i1'200' rparench + dc i1'200' lbrackch + dc i1'200' rbrackch + dc i1'200' lbracech + dc i1'200' rbracech + dc i1'1' commach + dc i1'200' semicolonch + dc i1'5' colonch + dc i1'200' poundch + dc i1'200' minusgtop + dc i1'16' plusplusop + dc i1'16' minusminusop + dc i1'13' ltltop + dc i1'13' gtgtop + dc i1'12' lteqop + dc i1'12' gteqop + dc i1'11' eqeqop + dc i1'11' exceqop + dc i1'7' andandop + dc i1'6' barbarop + dc i1'3' pluseqop + dc i1'3' minuseqop + dc i1'3' asteriskeqop + dc i1'3' slasheqop + dc i1'3' percenteqop + dc i1'3' ltlteqop + dc i1'3' gtgteqop + dc i1'3' andeqop + dc i1'3' caroteqop + dc i1'3' bareqop + dc i1'200' poundpoundop + dc i1'200' eolsy + dc i1'200' eofsy + dc i1'200' typedef + dc i1'16' uminus + dc i1'16' uand + dc i1'16' uasterisk + dc i1'200' parameteroper + dc i1'16' castoper + dc i1'16' opplusplus + dc i1'16' opminusminus + dc i1'200' macroParm + end + +iopcodes start implied operand operation codes + + dc i1'$18' clc + dc i1'$D8' cld + dc i1'$58' cli + dc i1'$B8' clv + dc i1'$CA' dex + dc i1'$88' dey + dc i1'$E8' inx + dc i1'$C8' iny + dc i1'$EA' nop + dc i1'$48' pha + dc i1'$8B' phb + dc i1'$0B' phd + dc i1'$4B' phk + dc i1'$08' php + dc i1'$DA' phx + dc i1'$5A' phy + dc i1'$68' pla + dc i1'$AB' plb + dc i1'$2B' pld + dc i1'$28' plp + dc i1'$FA' plx + dc i1'$7A' ply + dc i1'$40' rti + dc i1'$6B' rtl + dc i1'$60' rts + dc i1'$38' sec + dc i1'$F8' sed + dc i1'$78' sei + dc i1'$DB' stp + dc i1'$AA' tax + dc i1'$A8' tay + dc i1'$5B' tcd + dc i1'$1B' tcs + dc i1'$7B' tdc + dc i1'$3B' tsc + dc i1'$BA' tsx + dc i1'$8A' txa + dc i1'$9A' txs + dc i1'$9B' txy + dc i1'$98' tya + dc i1'$BB' tyx + dc i1'$CB' wai + dc i1'$EB' xba + dc i1'$FB' xce + end + +isp start in stack priority for expression + dc i1'0' ident + dc i1'0' intconst + dc i1'0' uintconst + dc i1'0' longconst + dc i1'0' ulongconst + dc i1'0' doubleconst + dc i1'0' stringconst + dc i1'0' autosy + dc i1'0' asmsy + dc i1'0' breaksy + dc i1'0' casesy + dc i1'0' charsy + dc i1'0' continuesy + dc i1'0' constsy + dc i1'0' compsy + dc i1'0' defaultsy + dc i1'0' dosy + dc i1'0' doublesy + dc i1'0' elsesy + dc i1'0' enumsy + dc i1'0' externsy + dc i1'0' extendedsy + dc i1'0' floatsy + dc i1'0' forsy + dc i1'0' gotosy + dc i1'0' ifsy + dc i1'0' intsy + dc i1'0' inlinesy + dc i1'0' longsy + dc i1'0' pascalsy + dc i1'0' registersy + dc i1'0' returnsy + dc i1'0' shortsy + dc i1'16' sizeofsy + dc i1'0' staticsy + dc i1'0' structsy + dc i1'0' switchsy + dc i1'0' segmentsy + dc i1'0' signedsy + dc i1'0' typedefsy + dc i1'0' unionsy + dc i1'0' unsignedsy + dc i1'0' voidsy + dc i1'0' volatilesy + dc i1'0' whilesy + dc i1'16' excch + dc i1'15' percentch + dc i1'9' carotch + dc i1'10' andch + dc i1'15' asteriskch + dc i1'14' minusch + dc i1'14' plusch + dc i1'2' eqch + dc i1'16' tildech + dc i1'8' barch + dc i1'0' dotch + dc i1'12' ltch + dc i1'12' gtch + dc i1'15' slashch + dc i1'0' questionch + dc i1'0' lparench + dc i1'0' rparench + dc i1'0' lbrackch + dc i1'0' rbrackch + dc i1'0' lbracech + dc i1'0' rbracech + dc i1'1' commach + dc i1'0' semicolonch + dc i1'4' colonch + dc i1'0' poundch + dc i1'0' minusgtop + dc i1'16' plusplusop + dc i1'16' minusminusop + dc i1'13' ltltop + dc i1'13' gtgtop + dc i1'12' lteqop + dc i1'12' gteqop + dc i1'11' eqeqop + dc i1'11' exceqop + dc i1'7' andandop + dc i1'6' barbarop + dc i1'2' pluseqop + dc i1'2' minuseqop + dc i1'2' asteriskeqop + dc i1'2' slasheqop + dc i1'2' percenteqop + dc i1'2' ltlteqop + dc i1'2' gtgteqop + dc i1'2' andeqop + dc i1'2' caroteqop + dc i1'2' bareqop + dc i1'0' poundpoundop + dc i1'0' eolsy + dc i1'0' eofsy + dc i1'0' typedef + dc i1'16' uminus + dc i1'16' uand + dc i1'16' uasterisk + dc i1'0' parameteroper + dc i1'16' castoper + dc i1'16' opplusplus + dc i1'16' opminusminus + dc i1'0' macroParm + end + +names start mini-assembler op code names + + dc c'adcandaslbitcmpcopcpxcpydeceor' + dc c'incjmljmpjsljsrldaldxldylsrora' + dc c'peapeireprolrorsbcsepstastxsty' + dc c'stztrbtsb' + dc c'dcbdcwdcl' + dc c'brk' + dc c'mvnmvp' + dc c'bccbcsbeqbmibnebplbrabrlperbvc' + dc c'bvs' + dc c'clccldcliclvdexdeyinxinynoppha' + dc c'phbphdphkphpphxphyplaplbpldplp' + dc c'plxplyrtirtlrtssecsedseistptax' + dc c'taytcdtcstdctsctsxtxatxstxytya' + dc c'tyxwaixbaxce' + end + +nopcodes start +! acc imm dp dp_x dp_y operand order +! op op_x op_y i_dp_x i_dp_y +! dp_s li_dp la i_dp i_op +! i_la i_op_x i_dp_s_y li_dp_y long_x + + dc i1'0 ,$69 ,$65 ,$75 ,0 ' adc + dc i1'$6D ,$7D ,$79 ,$61 ,$71 ' + dc i1'$63 ,$67 ,$6F ,$72 ,0 ' + dc i1'0 ,0 ,$73 ,$77 ,$7F ' + + dc i1'0 ,$29 ,$25 ,$35 ,0 ' and + dc i1'$2D ,$3D ,$39 ,$21 ,$31 ' + dc i1'$23 ,$27 ,$2F ,$32 ,0 ' + dc i1'0 ,0 ,$33 ,$37 ,$3F ' + + dc i1'$0A ,0 ,$06 ,$16 ,0 ' asl + dc i1'$0E ,$1E ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + + dc i1'0 ,$89 ,$24 ,$34 ,0 ' bit + dc i1'$2C ,$3C ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + + dc i1'0 ,$C9 ,$C5 ,$D5 ,0 ' cmp + dc i1'$CD ,$DD ,$D9 ,$C1 ,$D1 ' + dc i1'$C3 ,$C7 ,$CF ,$D2 ,0 ' + dc i1'0 ,0 ,$D3 ,$D7 ,$DF ' + + dc i1'0 ,0 ,$02 ,0 ,0 ' cop + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + + dc i1'0 ,$E0 ,$E4 ,0 ,0 ' cpx + dc i1'$EC ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + + dc i1'0 ,$C0 ,$C4 ,0 ,0 ' cpy + dc i1'$CC ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + + dc i1'$3A ,0 ,$C6 ,$D6 ,0 ' dec + dc i1'$CE ,$DE ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + + dc i1'0 ,$49 ,$45 ,$55 ,0 ' eor + dc i1'$4D ,$5D ,$59 ,$41 ,$51 ' + dc i1'$43 ,$47 ,$4F ,$52 ,0 ' + dc i1'0 ,0 ,$53 ,$57 ,$5F ' + + dc i1'$1A ,0 ,$E6 ,$F6 ,0 ' inc + dc i1'$EE ,$FE ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + + dc i1'0 ,0 ,0 ,0 ,0 ' jml + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,$5C ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + + dc i1'0 ,0 ,0 ,0 ,0 ' jmp + dc i1'$4C ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,$5C ,0 ,$6C ' + dc i1'$DC ,$7C ,0 ,0 ,0 ' + + dc i1'0 ,0 ,0 ,0 ,0 ' jsl + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,$22 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + + dc i1'0 ,0 ,0 ,0 ,0 ' jsr + dc i1'$20 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,$22 ,0 ,0 ' + dc i1'0 ,$FC ,0 ,0 ,0 ' + + dc i1'0 ,$A9 ,$A5 ,$B5 ,0 ' lda + dc i1'$AD ,$BD ,$B9 ,$A1 ,$B1 ' + dc i1'$A3 ,$A7 ,$AF ,$B2 ,0 ' + dc i1'0 ,0 ,$B3 ,$B7 ,$BF ' + + dc i1'0 ,$A2 ,$A6 ,0 ,$B6 ' ldx + dc i1'$AE ,0 ,$BE ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + + dc i1'0 ,$A0 ,$A4 ,$B4 ,0 ' ldy + dc i1'$AC ,$BC ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + + dc i1'$4A ,0 ,$46 ,$56 ,0 ' lsr + dc i1'$4E ,$5E ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + + dc i1'0 ,$09 ,$05 ,$15 ,0 ' ora + dc i1'$0D ,$1D ,$19 ,$01 ,$11 ' + dc i1'$03 ,$07 ,$0F ,$12 ,0 ' + dc i1'0 ,0 ,$13 ,$17 ,$1F ' + + dc i1'0 ,0 ,0 ,0 ,0 ' pea + dc i1'$F4 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + + dc i1'0 ,0 ,$D4 ,0 ,0 ' pei + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,$D4 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + + dc i1'0 ,$C2 ,0 ,0 ,0 ' rep + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + + dc i1'$2A ,0 ,$26 ,$36 ,0 ' rol + dc i1'$2E ,$3E ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + + dc i1'$6A ,0 ,$66 ,$76 ,0 ' ror + dc i1'$6E ,$7E ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + + dc i1'0 ,$E9 ,$E5 ,$F5 ,0 ' sbc + dc i1'$ED ,$FD ,$F9 ,$E1 ,$F1 ' + dc i1'$E3 ,$E7 ,$EF ,$F2 ,0 ' + dc i1'0 ,0 ,$F3 ,$F7 ,$FF ' + + dc i1'0 ,$E2 ,0 ,0 ,0 ' sep + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + + dc i1'0 ,0 ,$85 ,$95 ,0 ' sta + dc i1'$8D ,$9D ,$99 ,$81 ,$91 ' + dc i1'$83 ,$87 ,$8F ,$92 ,0 ' + dc i1'0 ,0 ,$93 ,$97 ,$9F ' + + dc i1'0 ,0 ,$86 ,0 ,$96 ' stx + dc i1'$8E ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + + dc i1'0 ,0 ,$84 ,$94 ,0 ' sty + dc i1'$8C ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + + dc i1'0 ,0 ,$64 ,$74 ,0 ' stz + dc i1'$9C ,$9E ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + + dc i1'0 ,0 ,$14 ,0 ,0 ' trb + dc i1'$1C ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + + dc i1'0 ,0 ,$04 ,0 ,0 ' tsb + dc i1'$0C ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + dc i1'0 ,0 ,0 ,0 ,0 ' + end + +reservedWords start reserved word names + str8 auto + str8 asm + str8 break + str8 case + str8 char + str8 continue + str8 const + str8 comp + str8 default + str8 do + str8 double + str8 else + str8 enum + str8 extern + str8 extended + str8 float + str8 for + str8 goto + str8 if + str8 int + str8 inline + str8 long + str8 pascal + str8 register + str8 return + str8 short + str8 sizeof + str8 static + str8 struct + str8 switch + str8 segment + str8 signed + str8 typedef + str8 union + str8 unsigned + str8 void + str8 volatile + str8 while + end + +ropcodes start + + dc i1'$90' bcc + dc i1'$B0' bcs + dc i1'$F0' beq + dc i1'$30' bmi + dc i1'$D0' bne + dc i1'$10' bpl + dc i1'$80' bra + dc i1'$82' brl + dc i1'$62' per + dc i1'$50' bvc + dc i1'$70' bvs + end + +wordHash start reserved word hash table + + enum ident,0 identifiers +! constants + enum (intconst,uintconst,longconst,ulongconst,doubleconst) + enum stringconst +! reserved words + enum (autosy,asmsy,breaksy,casesy,charsy) + enum (continuesy,constsy,compsy,defaultsy,dosy) + enum (doublesy,elsesy,enumsy,externsy,extendedsy) + enum (floatsy,forsy,gotosy,ifsy,intsy) + enum (inlinesy,longsy,pascalsy,registersy,returnsy) + enum (shortsy,sizeofsy,staticsy,structsy,switchsy) + enum (segmentsy,signedsy,typedefsy,unionsy,unsignedsy) + enum (voidsy,volatilesy,whilesy,succwhilesy) + + dc i'autosy,breaksy,casesy,defaultsy,elsesy,floatsy' + dc i'gotosy,ifsy,ifsy,longsy,longsy,longsy' + dc i'pascalsy,pascalsy,pascalsy,pascalsy,registersy,registersy' + dc i'shortsy,typedefsy,unionsy,voidsy,whilesy,succwhilesy' + end diff --git a/Table.macros b/Table.macros old mode 100755 new mode 100644 index e4f329a..929820f --- a/Table.macros +++ b/Table.macros @@ -1 +1,24 @@ - MACRO &LAB ENUM &LIST,&START &LAB ANOP AIF C:&~ENUM,.A GBLA &~ENUM .A AIF C:&START=0,.B &~ENUM SETA &START .B LCLA &CNT &CNT SETA 1 .C &LIST(&CNT) EQU &~ENUM &~ENUM SETA &~ENUM+1 &CNT SETA &CNT+1 AIF &CNT<=C:&LIST,^C MEND MACRO &LAB STR8 &STR &LAB DC I1'L:A&SYSCNT' A&SYSCNT DC C'&STR' DS 8-L:A&SYSCNT MEND \ No newline at end of file + MACRO +&LAB ENUM &LIST,&START +&LAB ANOP + AIF C:&~ENUM,.A + GBLA &~ENUM +.A + AIF C:&START=0,.B +&~ENUM SETA &START +.B + LCLA &CNT +&CNT SETA 1 +.C +&LIST(&CNT) EQU &~ENUM +&~ENUM SETA &~ENUM+1 +&CNT SETA &CNT+1 + AIF &CNT<=C:&LIST,^C + MEND + + MACRO +&LAB STR8 &STR +&LAB DC I1'L:A&SYSCNT' +A&SYSCNT DC C'&STR' + DS 8-L:A&SYSCNT + MEND diff --git a/Table.pas b/Table.pas old mode 100755 new mode 100644 index 64fe3d0..fe6b64a --- a/Table.pas +++ b/Table.pas @@ -1 +1,43 @@ -{$optimize 7} {---------------------------------------------------------------} { } { Table } { } { Initialized arrays and records. } { } {---------------------------------------------------------------} unit Table; {$LibPrefix '0/obj/'} interface uses CCommon; var {from scanner.pas} {----------------} charKinds: array[minChar..maxChar] of charEnum; {character kinds} charSym: array[minChar..maxChar] of tokenEnum; {symbols for single char symbols} reservedWords: array[autosy..whilesy] of string[8]; {reserved word strings} wordHash: array[0..23] of tokenEnum; {for hashing reserved words} {from ASM.PAS} {------------} {names of the opcodes} names: array[opcode] of packed array[1..3] of char; {binary values for the opcodes} iOpcodes: array[o_clc..o_xce] of byte; rOpcodes: array[o_bcc..o_bvs] of byte; nOpcodes: array[o_adc..o_tsb,operands] of byte; {from EXPRESSION.PAS} {-------------------} icp: array[tokenEnum] of byte; {in-commong priorities} isp: array[tokenEnum] of byte; {in-stack priorities} implementation end. \ No newline at end of file +{$optimize 7} +{---------------------------------------------------------------} +{ } +{ Table } +{ } +{ Initialized arrays and records. } +{ } +{---------------------------------------------------------------} + +unit Table; + +{$LibPrefix '0/obj/'} + +interface + +uses CCommon; + +var + {from scanner.pas} + {----------------} + charKinds: array[minChar..maxChar] of charEnum; {character kinds} + charSym: array[minChar..maxChar] of tokenEnum; {symbols for single char symbols} + reservedWords: array[autosy..whilesy] of string[8]; {reserved word strings} + wordHash: array[0..23] of tokenEnum; {for hashing reserved words} + + {from ASM.PAS} + {------------} + {names of the opcodes} + names: array[opcode] of packed array[1..3] of char; + + {binary values for the opcodes} + iOpcodes: array[o_clc..o_xce] of byte; + rOpcodes: array[o_bcc..o_bvs] of byte; + nOpcodes: array[o_adc..o_tsb,operands] of byte; + + {from EXPRESSION.PAS} + {-------------------} + icp: array[tokenEnum] of byte; {in-commong priorities} + isp: array[tokenEnum] of byte; {in-stack priorities} + +implementation + +end. diff --git a/Tests/Conformance/C11.4.2.1.CC b/Tests/Conformance/C11.4.2.1.CC old mode 100755 new mode 100644 index 67dfd76..45e3eb5 --- a/Tests/Conformance/C11.4.2.1.CC +++ b/Tests/Conformance/C11.4.2.1.CC @@ -1 +1,23 @@ -/* Conformance Test 11.4.2.1: Type qualifiers should be allowed both in */ /* type casts and in the type-specifiers for */ /* field lists. */ #include struct foo { int i; const j; volatile k; } ; main () { int i,j; j = 4; i = (const) j; i = (volatile) j; printf ("Passed Conformance Test 11.4.2.1\n"); } \ No newline at end of file +/* Conformance Test 11.4.2.1: Type qualifiers should be allowed both in */ +/* type casts and in the type-specifiers for */ +/* field lists. */ + +#include + +struct foo { + int i; + const j; + volatile k; + } ; + +main () + +{ +int i,j; + +j = 4; +i = (const) j; +i = (volatile) j; + +printf ("Passed Conformance Test 11.4.2.1\n"); +} diff --git a/Tests/Conformance/C13.1.0.1.CC b/Tests/Conformance/C13.1.0.1.CC old mode 100755 new mode 100644 index 986bb2e..1d74359 --- a/Tests/Conformance/C13.1.0.1.CC +++ b/Tests/Conformance/C13.1.0.1.CC @@ -1 +1,43 @@ -/* Conformance Test 13.1.0.1: Verification of standard library types and */ /* NULL */ #include extended e1 [800]; main () { int i [10] = { 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 }; int *i1 = i; int *i2 = &i [2]; long diff; unsigned long size; static ptrdiff_t TestPtrdiff_t (int *int1Ptr, int *int2Ptr); diff = TestPtrdiff_t (i2, i1); if (diff != 2) goto Fail; size = sizeof(e1); if (size != 8000) goto Fail; if (NULL != 0) goto Fail; printf ("Passed Conformance Test 13.1.0.1\n"); return; Fail: printf ("Failed Conformance Test 13.1.0.1\n"); } /*****************************************************************************/ static ptrdiff_t TestPtrdiff_t (int *int1Ptr, int *int2Ptr) { return int1Ptr - int2Ptr; } \ No newline at end of file +/* Conformance Test 13.1.0.1: Verification of standard library types and */ +/* NULL */ + +#include + +extended e1 [800]; + +main () + { + int i [10] = { 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 }; + int *i1 = i; + int *i2 = &i [2]; + long diff; + unsigned long size; + + static ptrdiff_t TestPtrdiff_t (int *int1Ptr, int *int2Ptr); + + + diff = TestPtrdiff_t (i2, i1); + if (diff != 2) + goto Fail; + + size = sizeof(e1); + if (size != 8000) + goto Fail; + + if (NULL != 0) + goto Fail; + + printf ("Passed Conformance Test 13.1.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 13.1.0.1\n"); + } + + +/*****************************************************************************/ + +static ptrdiff_t TestPtrdiff_t (int *int1Ptr, int *int2Ptr) + { + return int1Ptr - int2Ptr; + } diff --git a/Tests/Conformance/C14.1.0.1.CC b/Tests/Conformance/C14.1.0.1.CC old mode 100755 new mode 100644 index f6363f0..76e8029 --- a/Tests/Conformance/C14.1.0.1.CC +++ b/Tests/Conformance/C14.1.0.1.CC @@ -1 +1,148 @@ -/* Conformance Test 14.1.0.1: Verification of isalnum, isalpha, isascii, */ /* and iscntrl */ #include main () { int i, j; char ch; short k; long L; unsigned int ui1; unsigned long ul1; unsigned char uc; /* isalnum: returns 0 if char is not in ['0'..'9', 'a'..'z', 'A'..'Z'] */ for (ch = '0'; ch <= '9'; ch++) { j = isalnum (ch); if (j == 0) goto Fail; } for (uc = 'a'; uc <= 'z'; uc++) { j = isalnum (uc); if (j == 0) goto Fail; } for (uc = 'A'; uc <= 'Z'; uc++) { j = isalnum (uc); if (j == 0) goto Fail; } j = isalnum ('~'); if (j != 0) goto Fail; /* isalpha: returns 0 if char is not in ['a'..'z', 'A'..'Z'] */ for (ch = '0'; ch <= '9'; ch++) { j = isalpha (ch); if (j != 0) goto Fail; } for (uc = 'a'; uc <= 'z'; uc++) { j = isalpha (uc); if (j == 0) goto Fail; } for (uc = 'A'; uc <= 'Z'; uc++) { j = isalpha (uc); if (j == 0) goto Fail; } j = isalpha ('~'); if (j != 0) goto Fail; /* isascii: returns 0 if int is not in the range 0..128 */ for (k = 0, i = 0; i < 20; k++, i++) { j = isascii (k); if (j == 0) goto Fail; } for (uc = 20, i = 20; i < 39; uc++, i++) { j = isascii (uc); if (j == 0) goto Fail; } for (ch = 39, i = 39; i < 57; ch++, i++) { j = isascii (ch); if (j == 0) goto Fail; } for (L = 57, i = 57; i < 75; L++, i++) { j = isascii (L); if (j == 0) goto Fail; } for (ui1 = 75, i = 75; i < 93; ui1++, i++) { j = isascii (ui1); if (j == 0) goto Fail; } for (ul1 = 93, i = 93; i < 128; ul1++, i++) { j = isascii (ul1); if (j == 0) goto Fail; } for (i = 128; i < 256; i++) { j = isascii (i); if (j != 0) goto Fail; } /* iscntrl: returns 0 if char is not in [0..31, 127] */ for (i = 0; i <= 31; i++) { j = iscntrl ( (char) (i) ); if (j == 0) goto Fail; } if ( (j = iscntrl (127)) == 0 ) goto Fail; for (i = 32; i < 127; i++) { if ( (j = iscntrl ( (char) (i) )) != 0 ) goto Fail; } printf ("Passed Conformance Test 14.1.0.1\n"); return; Fail: printf ("Failed Conformance Test 14.1.0.1\n"); } \ No newline at end of file +/* Conformance Test 14.1.0.1: Verification of isalnum, isalpha, isascii, */ +/* and iscntrl */ + +#include + +main () + { + int i, j; + char ch; + short k; + long L; + unsigned int ui1; + unsigned long ul1; + unsigned char uc; + + + /* isalnum: returns 0 if char is not in ['0'..'9', 'a'..'z', 'A'..'Z'] */ + + for (ch = '0'; ch <= '9'; ch++) + { + j = isalnum (ch); + if (j == 0) + goto Fail; + } + + for (uc = 'a'; uc <= 'z'; uc++) + { + j = isalnum (uc); + if (j == 0) + goto Fail; + } + + for (uc = 'A'; uc <= 'Z'; uc++) + { + j = isalnum (uc); + if (j == 0) + goto Fail; + } + + j = isalnum ('~'); + if (j != 0) + goto Fail; + + + /* isalpha: returns 0 if char is not in ['a'..'z', 'A'..'Z'] */ + + for (ch = '0'; ch <= '9'; ch++) + { + j = isalpha (ch); + if (j != 0) + goto Fail; + } + + for (uc = 'a'; uc <= 'z'; uc++) + { + j = isalpha (uc); + if (j == 0) + goto Fail; + } + + for (uc = 'A'; uc <= 'Z'; uc++) + { + j = isalpha (uc); + if (j == 0) + goto Fail; + } + + j = isalpha ('~'); + if (j != 0) + goto Fail; + + + /* isascii: returns 0 if int is not in the range 0..128 */ + + for (k = 0, i = 0; i < 20; k++, i++) + { + j = isascii (k); + if (j == 0) + goto Fail; + } + + for (uc = 20, i = 20; i < 39; uc++, i++) + { + j = isascii (uc); + if (j == 0) + goto Fail; + } + + for (ch = 39, i = 39; i < 57; ch++, i++) + { + j = isascii (ch); + if (j == 0) + goto Fail; + } + + for (L = 57, i = 57; i < 75; L++, i++) + { + j = isascii (L); + if (j == 0) + goto Fail; + } + + for (ui1 = 75, i = 75; i < 93; ui1++, i++) + { + j = isascii (ui1); + if (j == 0) + goto Fail; + } + + for (ul1 = 93, i = 93; i < 128; ul1++, i++) + { + j = isascii (ul1); + if (j == 0) + goto Fail; + } + + for (i = 128; i < 256; i++) + { + j = isascii (i); + if (j != 0) + goto Fail; + } + + + /* iscntrl: returns 0 if char is not in [0..31, 127] */ + + for (i = 0; i <= 31; i++) + { + j = iscntrl ( (char) (i) ); + if (j == 0) + goto Fail; + } + + if ( (j = iscntrl (127)) == 0 ) + goto Fail; + + for (i = 32; i < 127; i++) + { + if ( (j = iscntrl ( (char) (i) )) != 0 ) + goto Fail; + } + + printf ("Passed Conformance Test 14.1.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 14.1.0.1\n"); + } diff --git a/Tests/Conformance/C14.2.0.1.CC b/Tests/Conformance/C14.2.0.1.CC old mode 100755 new mode 100644 index 6bfd2e8..0bb8930 --- a/Tests/Conformance/C14.2.0.1.CC +++ b/Tests/Conformance/C14.2.0.1.CC @@ -1 +1,61 @@ -/* Conformance Test 14.2.0.1: Verification of iscsym, iscymf */ #include main () { int i, j; char ch; unsigned char uc; /* iscsym: returns 0 if char is not in ['0'..'9', 'a'..'z', 'A'..'Z', '_'] */ /* iscsymf: returns 0 if char is not in ['a'..'z', 'A'..'Z', '_'] */ for (ch = '0'; ch <= '9'; ch++) { j = iscsym (ch); if (j == 0) goto Fail; j = iscsymf (ch); if (j != 0) goto Fail; } for (uc = 'a'; uc <= 'z'; uc++) { j = iscsym (uc); if (j == 0) goto Fail; j = iscsymf (uc); if (j == 0) goto Fail; } for (uc = 'A'; uc <= 'Z'; uc++) { j = iscsym (uc); if (j == 0) goto Fail; j = iscsymf (uc); if (j == 0) goto Fail; } j = iscsym ('_'); if (j == 0) goto Fail; j = iscsymf ('_'); if (j == 0) goto Fail; j = iscsym ('~'); if (j != 0) goto Fail; printf ("Passed Conformance Test 14.2.0.1\n"); return; Fail: printf ("Failed Conformance Test 14.2.0.1\n"); } \ No newline at end of file +/* Conformance Test 14.2.0.1: Verification of iscsym, iscymf */ + +#include + +main () + { + int i, j; + char ch; + unsigned char uc; + + + /* iscsym: returns 0 if char is not in ['0'..'9', 'a'..'z', 'A'..'Z', '_'] */ + /* iscsymf: returns 0 if char is not in ['a'..'z', 'A'..'Z', '_'] */ + + for (ch = '0'; ch <= '9'; ch++) + { + j = iscsym (ch); + if (j == 0) + goto Fail; + j = iscsymf (ch); + if (j != 0) + goto Fail; + } + + for (uc = 'a'; uc <= 'z'; uc++) + { + j = iscsym (uc); + if (j == 0) + goto Fail; + j = iscsymf (uc); + if (j == 0) + goto Fail; + } + + for (uc = 'A'; uc <= 'Z'; uc++) + { + j = iscsym (uc); + if (j == 0) + goto Fail; + j = iscsymf (uc); + if (j == 0) + goto Fail; + } + + j = iscsym ('_'); + if (j == 0) + goto Fail; + j = iscsymf ('_'); + if (j == 0) + goto Fail; + + j = iscsym ('~'); + if (j != 0) + goto Fail; + + printf ("Passed Conformance Test 14.2.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 14.2.0.1\n"); + } diff --git a/Tests/Conformance/C14.3.0.1.CC b/Tests/Conformance/C14.3.0.1.CC old mode 100755 new mode 100644 index 32ca3fb..c8b0ec6 --- a/Tests/Conformance/C14.3.0.1.CC +++ b/Tests/Conformance/C14.3.0.1.CC @@ -1 +1,87 @@ -/* Conformance Test 14.3.0.1: Verification of isdigit, isodigit, isxdigit */ #include main () { int i, j; char ch; unsigned char uc; /* isdigit: returns 0 if char is not in ['0'..'9'] */ /* isodigit: returns 0 if char is not in ['0'..'7'] */ /* isxdigit: returns 0 if char is not in ['0'..'9', 'a'..'f', 'A'..'F'] */ for (ch = '0'; ch < '8'; ch++) { j = isdigit (ch); if (j == 0) goto Fail; j = isodigit (ch); if (j == 0) goto Fail; j = isxdigit (ch); if (j == 0) goto Fail; } for (ch = '8'; ch <= '9'; ch++) { j = isdigit (ch); if (j == 0) goto Fail; j = isodigit (ch); if (j != 0) goto Fail; j = isxdigit (ch); if (j == 0) goto Fail; } for (uc = 'a'; uc <= 'f'; uc++) { j = isdigit (uc); if (j != 0) goto Fail; j = isodigit (uc); if (j != 0) goto Fail; j = isxdigit (uc); if (j == 0) goto Fail; } for (uc = 'A'; uc <= 'F'; uc++) { j = isdigit (uc); if (j != 0) goto Fail; j = isodigit (uc); if (j != 0) goto Fail; j = isxdigit (uc); if (j == 0) goto Fail; } for (uc = 'G'; uc <= 'Z'; uc++) { j = isdigit (uc); if (j != 0) goto Fail; j = isodigit (uc); if (j != 0) goto Fail; j = isxdigit (uc); if (j != 0) goto Fail; } printf ("Passed Conformance Test 14.3.0.1\n"); return; Fail: printf ("Failed Conformance Test 14.3.0.1\n"); } \ No newline at end of file +/* Conformance Test 14.3.0.1: Verification of isdigit, isodigit, isxdigit */ + +#include + +main () + { + int i, j; + char ch; + unsigned char uc; + + + /* isdigit: returns 0 if char is not in ['0'..'9'] */ + /* isodigit: returns 0 if char is not in ['0'..'7'] */ + /* isxdigit: returns 0 if char is not in ['0'..'9', 'a'..'f', 'A'..'F'] */ + + for (ch = '0'; ch < '8'; ch++) + { + j = isdigit (ch); + if (j == 0) + goto Fail; + j = isodigit (ch); + if (j == 0) + goto Fail; + j = isxdigit (ch); + if (j == 0) + goto Fail; + } + + for (ch = '8'; ch <= '9'; ch++) + { + j = isdigit (ch); + if (j == 0) + goto Fail; + j = isodigit (ch); + if (j != 0) + goto Fail; + j = isxdigit (ch); + if (j == 0) + goto Fail; + } + + for (uc = 'a'; uc <= 'f'; uc++) + { + j = isdigit (uc); + if (j != 0) + goto Fail; + j = isodigit (uc); + if (j != 0) + goto Fail; + j = isxdigit (uc); + if (j == 0) + goto Fail; + } + + for (uc = 'A'; uc <= 'F'; uc++) + { + j = isdigit (uc); + if (j != 0) + goto Fail; + j = isodigit (uc); + if (j != 0) + goto Fail; + j = isxdigit (uc); + if (j == 0) + goto Fail; + } + + for (uc = 'G'; uc <= 'Z'; uc++) + { + j = isdigit (uc); + if (j != 0) + goto Fail; + j = isodigit (uc); + if (j != 0) + goto Fail; + j = isxdigit (uc); + if (j != 0) + goto Fail; + } + + + printf ("Passed Conformance Test 14.3.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 14.3.0.1\n"); + } diff --git a/Tests/Conformance/C14.5.0.1.CC b/Tests/Conformance/C14.5.0.1.CC old mode 100755 new mode 100644 index 4aa691f..dae4f65 --- a/Tests/Conformance/C14.5.0.1.CC +++ b/Tests/Conformance/C14.5.0.1.CC @@ -1 +1,40 @@ -/* Conformance Test 14.5.0.1: Verification of islower, isupper */ #include main () { int i, j; char ch; unsigned char uc; /* islower: returns 0 if char is not in ['a'..'z'] */ /* isupper: returns 0 if char is not in ['A'..'Z'] */ for (uc = 'a'; uc <= 'z'; uc++) { j = islower (uc); if (j == 0) goto Fail; j = isupper (uc); if (j != 0) goto Fail; } for (ch = 'A'; ch <= 'Z'; ch++) { j = islower (ch); if (j != 0) goto Fail; j = isupper (ch); if (j == 0) goto Fail; } printf ("Passed Conformance Test 14.5.0.1\n"); return; Fail: printf ("Failed Conformance Test 14.5.0.1\n"); } \ No newline at end of file +/* Conformance Test 14.5.0.1: Verification of islower, isupper */ + +#include + +main () + { + int i, j; + char ch; + unsigned char uc; + + + /* islower: returns 0 if char is not in ['a'..'z'] */ + /* isupper: returns 0 if char is not in ['A'..'Z'] */ + + for (uc = 'a'; uc <= 'z'; uc++) + { + j = islower (uc); + if (j == 0) + goto Fail; + j = isupper (uc); + if (j != 0) + goto Fail; + } + + for (ch = 'A'; ch <= 'Z'; ch++) + { + j = islower (ch); + if (j != 0) + goto Fail; + j = isupper (ch); + if (j == 0) + goto Fail; + } + + printf ("Passed Conformance Test 14.5.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 14.5.0.1\n"); + } diff --git a/Tests/Conformance/C14.6.0.1.CC b/Tests/Conformance/C14.6.0.1.CC old mode 100755 new mode 100644 index 7a6bdd6..1d3f19b --- a/Tests/Conformance/C14.6.0.1.CC +++ b/Tests/Conformance/C14.6.0.1.CC @@ -1 +1,37 @@ -/* Conformance Test 14.6.0.1: Verification of isspace function */ #include main () { int i, j; char ch; unsigned char uc; /* isspace: returns 0 if char is not in [ \t \r \n \v \f] */ j = isspace (' '); if (j == 0) goto Fail; for (uc = 9; uc <= '\r'; uc++) { j = isspace (uc); if (j == 0) goto Fail; } for (ch = 'A'; ch <= 'Z'; ch++) { j = isspace (ch); if (j != 0) goto Fail; } printf ("Passed Conformance Test 14.6.0.1\n"); return; Fail: printf ("Failed Conformance Test 14.6.0.1\n"); } \ No newline at end of file +/* Conformance Test 14.6.0.1: Verification of isspace function */ + +#include + +main () + { + int i, j; + char ch; + unsigned char uc; + + + /* isspace: returns 0 if char is not in [ \t \r \n \v \f] */ + + j = isspace (' '); + if (j == 0) + goto Fail; + + for (uc = 9; uc <= '\r'; uc++) + { + j = isspace (uc); + if (j == 0) + goto Fail; + } + + for (ch = 'A'; ch <= 'Z'; ch++) + { + j = isspace (ch); + if (j != 0) + goto Fail; + } + + printf ("Passed Conformance Test 14.6.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 14.6.0.1\n"); + } diff --git a/Tests/Conformance/C14.7.0.1.CC b/Tests/Conformance/C14.7.0.1.CC old mode 100755 new mode 100644 index 7c7c189..2f63882 --- a/Tests/Conformance/C14.7.0.1.CC +++ b/Tests/Conformance/C14.7.0.1.CC @@ -1 +1,74 @@ -/* Conformance Test 14.7.0.1: Verification of toascii function */ #include main () { int i, j; char ch; short k; long L; unsigned int ui1; unsigned long ul1; unsigned char uc; /* toascii: returns ASCII value of any integral value by returning only */ /* the 7 low order bits */ for (k = 0, i = 0; i < 20; k++, i++) { j = toascii (k); if (j != k) goto Fail; } for (uc = 20, i = 20; i < 39; uc++, i++) { j = toascii (uc); if (j != uc) goto Fail; } for (ch = 39, i = 39; i < 57; ch++, i++) { j = toascii (ch); if (j != ch) goto Fail; } for (L = 57, i = 57; i < 75; L++, i++) { j = toascii (L); if (j != L) goto Fail; } for (ui1 = 75, i = 75; i < 93; ui1++, i++) { j = toascii (ui1); if (j != ui1) goto Fail; } for (ul1 = 93, i = 93; i < 128; ul1++, i++) { j = toascii (ul1); if (j != ul1) goto Fail; } for (k = 0, i = 128; i < 256; k++, i++) /* check truncation */ { j = toascii (i); if (j != k) goto Fail; } printf ("Passed Conformance Test 14.7.0.1\n"); return; Fail: printf ("Failed Conformance Test 14.7.0.1\n"); } \ No newline at end of file +/* Conformance Test 14.7.0.1: Verification of toascii function */ + +#include + +main () + { + int i, j; + char ch; + short k; + long L; + unsigned int ui1; + unsigned long ul1; + unsigned char uc; + + + /* toascii: returns ASCII value of any integral value by returning only */ + /* the 7 low order bits */ + + for (k = 0, i = 0; i < 20; k++, i++) + { + j = toascii (k); + if (j != k) + goto Fail; + } + + for (uc = 20, i = 20; i < 39; uc++, i++) + { + j = toascii (uc); + if (j != uc) + goto Fail; + } + + for (ch = 39, i = 39; i < 57; ch++, i++) + { + j = toascii (ch); + if (j != ch) + goto Fail; + } + + for (L = 57, i = 57; i < 75; L++, i++) + { + j = toascii (L); + if (j != L) + goto Fail; + } + + for (ui1 = 75, i = 75; i < 93; ui1++, i++) + { + j = toascii (ui1); + if (j != ui1) + goto Fail; + } + + for (ul1 = 93, i = 93; i < 128; ul1++, i++) + { + j = toascii (ul1); + if (j != ul1) + goto Fail; + } + + for (k = 0, i = 128; i < 256; k++, i++) /* check truncation */ + { + j = toascii (i); + if (j != k) + goto Fail; + } + + + printf ("Passed Conformance Test 14.7.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 14.7.0.1\n"); + } diff --git a/Tests/Conformance/C14.8.0.1.CC b/Tests/Conformance/C14.8.0.1.CC old mode 100755 new mode 100644 index 6531104..c2d5424 --- a/Tests/Conformance/C14.8.0.1.CC +++ b/Tests/Conformance/C14.8.0.1.CC @@ -1 +1,49 @@ -/* Conformance Test 14.8.0.1: Verification of toint function */ #include #include main () { int i, j; char ch; unsigned char uc; /* toint: returns 0-9 for char in ['0'..'9'] and 10-15 for char in */ /* ['a'..'f'] or ['A'..'F'] */ for (uc = '0', i = 0; i < 10; uc++, i++) { j = toint (uc); if (j != i) goto Fail; } for (ch = 'A', i = 10; ch <= 'F'; ch++, i++) { j = toint (ch); if (j != i) goto Fail; } for (ch = 'a', i = 10; ch <= 'f'; ch++, i++) { j = toint (ch); if (j != i) goto Fail; } for (ch = 'G'; ch <= 'Z'; ch++) { j = toint (ch); if (j != EOF) goto Fail; } printf ("Passed Conformance Test 14.8.0.1\n"); return; Fail: printf ("Failed Conformance Test 14.8.0.1\n"); } \ No newline at end of file +/* Conformance Test 14.8.0.1: Verification of toint function */ + +#include +#include + +main () + { + int i, j; + char ch; + unsigned char uc; + + + /* toint: returns 0-9 for char in ['0'..'9'] and 10-15 for char in */ + /* ['a'..'f'] or ['A'..'F'] */ + + for (uc = '0', i = 0; i < 10; uc++, i++) + { + j = toint (uc); + if (j != i) + goto Fail; + } + + for (ch = 'A', i = 10; ch <= 'F'; ch++, i++) + { + j = toint (ch); + if (j != i) + goto Fail; + } + + for (ch = 'a', i = 10; ch <= 'f'; ch++, i++) + { + j = toint (ch); + if (j != i) + goto Fail; + } + + for (ch = 'G'; ch <= 'Z'; ch++) + { + j = toint (ch); + if (j != EOF) + goto Fail; + } + + printf ("Passed Conformance Test 14.8.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 14.8.0.1\n"); + } diff --git a/Tests/Conformance/C14.9.0.1.CC b/Tests/Conformance/C14.9.0.1.CC old mode 100755 new mode 100644 index 1df27aa..95a62e8 --- a/Tests/Conformance/C14.9.0.1.CC +++ b/Tests/Conformance/C14.9.0.1.CC @@ -1 +1,60 @@ -/* Conformance Test 14.9.0.1: Verification of tolower, _tolower, toupper, */ /* _toupper functions */ #include main () { int i, j; char ch; unsigned char uc; /* tolower: converts uppercase letter to lowercase letter; if character */ /* is not alphabetic, then just returns character unchanged */ for (ch = 'A', uc = 'a'; uc <= 'z'; ch++, uc++) { j = tolower (ch); if (j != uc) goto Fail; j = _tolower (ch); if (j != uc) goto Fail; j = tolower (uc); if (j != uc) goto Fail; j = _tolower (uc); if (j != uc) goto Fail; } /* toupper: converts lowercase letter to uppercase letter; if character */ /* is not alphabetic, then just returns character unchanged */ for (ch = 'A', uc = 'a'; uc <= 'z'; ch++, uc++) { j = toupper (uc); if (j != ch) goto Fail; j = _toupper (uc); if (j != ch) goto Fail; j = toupper (ch); if (j != ch) goto Fail; j = _toupper (ch); if (j != ch) goto Fail; } printf ("Passed Conformance Test 14.9.0.1\n"); return; Fail: printf ("Failed Conformance Test 14.9.0.1\n"); } \ No newline at end of file +/* Conformance Test 14.9.0.1: Verification of tolower, _tolower, toupper, */ +/* _toupper functions */ + +#include + +main () + { + int i, j; + char ch; + unsigned char uc; + + + /* tolower: converts uppercase letter to lowercase letter; if character */ + /* is not alphabetic, then just returns character unchanged */ + + for (ch = 'A', uc = 'a'; uc <= 'z'; ch++, uc++) + { + j = tolower (ch); + if (j != uc) + goto Fail; + j = _tolower (ch); + if (j != uc) + goto Fail; + + j = tolower (uc); + if (j != uc) + goto Fail; + j = _tolower (uc); + if (j != uc) + goto Fail; + } + + + /* toupper: converts lowercase letter to uppercase letter; if character */ + /* is not alphabetic, then just returns character unchanged */ + + for (ch = 'A', uc = 'a'; uc <= 'z'; ch++, uc++) + { + j = toupper (uc); + if (j != ch) + goto Fail; + j = _toupper (uc); + if (j != ch) + goto Fail; + + j = toupper (ch); + if (j != ch) + goto Fail; + j = _toupper (ch); + if (j != ch) + goto Fail; + } + + + printf ("Passed Conformance Test 14.9.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 14.9.0.1\n"); + } diff --git a/Tests/Conformance/C15.1.0.1.CC b/Tests/Conformance/C15.1.0.1.CC old mode 100755 new mode 100644 index 1213ca7..a9b33bb --- a/Tests/Conformance/C15.1.0.1.CC +++ b/Tests/Conformance/C15.1.0.1.CC @@ -1 +1,45 @@ -/* Conformance Test 15.1.0.1: Verification of strcat, strncat functions */ #include main () { char s1 [80] = "this is the first string argument"; char s2 [80] = ", and this is the second string argument!"; char s3 [160] = ""; strcpy(s3, strcat (s1, s2)); if (strlen (s3) != 74) goto Fail; if (strcmp (s3, "this is the first string argument, and this is the \ second string argument!")) goto Fail; strcpy(s1, "this is the first string argument"); strcpy(s3, strncat (s1, s2, 17)); if (strlen (s3) != 50) goto Fail; if (strcmp (s3, "this is the first string argument, and this is the")) goto Fail; strcpy(s1, "this is the first string argument"); strcpy(s3, strncat (s1, s2, 50)); if (strlen (s3) != 74) goto Fail; if (strcmp (s3, "this is the first string argument, and this is the \ second string argument!")) goto Fail; strcpy(s1, "this is the first string argument"); strcpy(s1, strncat (s1, s2, -5)); if (strcmp (s1, "this is the first string argument")) goto Fail; printf ("Passed Conformance Test 15.1.0.1\n"); return; Fail: printf ("Failed Conformance Test 15.1.0.1\n"); } \ No newline at end of file +/* Conformance Test 15.1.0.1: Verification of strcat, strncat functions */ + +#include + +main () + { + char s1 [80] = "this is the first string argument"; + char s2 [80] = ", and this is the second string argument!"; + char s3 [160] = ""; + + + strcpy(s3, strcat (s1, s2)); + if (strlen (s3) != 74) + goto Fail; + if (strcmp (s3, "this is the first string argument, and this is the \ +second string argument!")) + goto Fail; + + strcpy(s1, "this is the first string argument"); + strcpy(s3, strncat (s1, s2, 17)); + if (strlen (s3) != 50) + goto Fail; + if (strcmp (s3, "this is the first string argument, and this is the")) + goto Fail; + + strcpy(s1, "this is the first string argument"); + strcpy(s3, strncat (s1, s2, 50)); + if (strlen (s3) != 74) + goto Fail; + if (strcmp (s3, "this is the first string argument, and this is the \ +second string argument!")) + goto Fail; + + strcpy(s1, "this is the first string argument"); + strcpy(s1, strncat (s1, s2, -5)); + if (strcmp (s1, "this is the first string argument")) + goto Fail; + + + printf ("Passed Conformance Test 15.1.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 15.1.0.1\n"); + } diff --git a/Tests/Conformance/C15.2.0.1.CC b/Tests/Conformance/C15.2.0.1.CC old mode 100755 new mode 100644 index ddd3288..484f7d3 --- a/Tests/Conformance/C15.2.0.1.CC +++ b/Tests/Conformance/C15.2.0.1.CC @@ -1 +1,39 @@ -/* Conformance Test 15.2.0.1: Verification of strcmp, strncmp functions */ #include main () { int i; char s1 [] = "this is a string argument "; char s2 [] = "this is a string argument!"; char s3 [160] = ""; i = strcmp (s1, s2); /* ensure strcmp reports s1 < s2 */ if (i >= 0) goto Fail; i = strcmp (s2, s1); if (i <= 0) goto Fail; i = strncmp (s1, s2, 100); /* should compare all chars */ if (i >= 0) goto Fail; i = strncmp (s1, s2, 25); /* should compare 1st 25 chars */ if (i != 0) goto Fail; i = strncmp (s1, s2, -90L); /* should just return 0 */ if (i != 0) goto Fail; printf ("Passed Conformance Test 15.2.0.1\n"); return; Fail: printf ("Failed Conformance Test 15.2.0.1\n"); } \ No newline at end of file +/* Conformance Test 15.2.0.1: Verification of strcmp, strncmp functions */ + +#include + +main () + { + int i; + + char s1 [] = "this is a string argument "; + char s2 [] = "this is a string argument!"; + char s3 [160] = ""; + + + i = strcmp (s1, s2); /* ensure strcmp reports s1 < s2 */ + if (i >= 0) + goto Fail; + + i = strcmp (s2, s1); + if (i <= 0) + goto Fail; + + i = strncmp (s1, s2, 100); /* should compare all chars */ + if (i >= 0) + goto Fail; + + i = strncmp (s1, s2, 25); /* should compare 1st 25 chars */ + if (i != 0) + goto Fail; + + i = strncmp (s1, s2, -90L); /* should just return 0 */ + if (i != 0) + goto Fail; + + printf ("Passed Conformance Test 15.2.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 15.2.0.1\n"); + } diff --git a/Tests/Conformance/C15.3.0.1.CC b/Tests/Conformance/C15.3.0.1.CC old mode 100755 new mode 100644 index 2179959..ed54734 --- a/Tests/Conformance/C15.3.0.1.CC +++ b/Tests/Conformance/C15.3.0.1.CC @@ -1 +1,39 @@ -/* Conformance Test 15.3.0.1: Verification of strcpy, strncpy functions */ #include #include main () { char s1 [80] = "this is the first string argument"; char s2 [80] = ", and this is the second string argument!"; char *strPtr; size_t i; strPtr = strcpy (s1, s2); if (( (i = strlen (strPtr)) != 41 ) || (strPtr != s1)) goto Fail; if (strcmp (s1, ", and this is the second string argument!")) goto Fail; strcpy(s1, "this is the first string argument"); strPtr = strncpy (s1, s2, 10); if (( (i = strlen (strPtr)) != 33 ) || (strPtr != s1)) goto Fail; if (strcmp (s1, ", and thise first string argument")) goto Fail; strcpy (s1, ", and thise first string argument"); strPtr = strncpy (s1, s2, -9L); if (( (i = strlen (strPtr)) != 33 ) || (strPtr != s1)) goto Fail; if (strcmp (s1, ", and thise first string argument")) goto Fail; printf ("Passed Conformance Test 15.3.0.1\n"); return; Fail: printf ("Failed Conformance Test 15.3.0.1\n"); } \ No newline at end of file +/* Conformance Test 15.3.0.1: Verification of strcpy, strncpy functions */ + +#include +#include + +main () + { + char s1 [80] = "this is the first string argument"; + char s2 [80] = ", and this is the second string argument!"; + char *strPtr; + size_t i; + + strPtr = strcpy (s1, s2); + if (( (i = strlen (strPtr)) != 41 ) || (strPtr != s1)) + goto Fail; + if (strcmp (s1, ", and this is the second string argument!")) + goto Fail; + + strcpy(s1, "this is the first string argument"); + strPtr = strncpy (s1, s2, 10); + if (( (i = strlen (strPtr)) != 33 ) || (strPtr != s1)) + goto Fail; + if (strcmp (s1, ", and thise first string argument")) + goto Fail; + + strcpy (s1, ", and thise first string argument"); + strPtr = strncpy (s1, s2, -9L); + if (( (i = strlen (strPtr)) != 33 ) || (strPtr != s1)) + goto Fail; + if (strcmp (s1, ", and thise first string argument")) + goto Fail; + + + printf ("Passed Conformance Test 15.3.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 15.3.0.1\n"); + } diff --git a/Tests/Conformance/C15.5.0.1.CC b/Tests/Conformance/C15.5.0.1.CC old mode 100755 new mode 100644 index 15b862a..a02de2e --- a/Tests/Conformance/C15.5.0.1.CC +++ b/Tests/Conformance/C15.5.0.1.CC @@ -1 +1,62 @@ -/* Conformance Test 15.5.0.1: Verification of strchr, strpos, strrchr, and */ /* strrpos functions */ #include #include main () { char s1 [80] = "this is the first string argument"; char *strPtr; size_t i; strPtr = strchr (s1, 's'); /* search s1 for 1st occurrence of 's' */ if (strPtr == NULL) goto Fail; if (strPtr != &(s1 [3])) goto Fail; strPtr = strchr (s1, 'z'); /* search s1 for char not in s1 */ if (strPtr != NULL) goto Fail; i = strpos (s1, 'f'); /* find position of 1st 'f' in s1 */ if (i != 12) goto Fail; i = strpos (s1, 'x'); /* find position of char not in s1 */ if (i != -1) goto Fail; i = strpos (s1, '\0'); /* find position of terminating null */ if (i != 33) goto Fail; strPtr = strrchr (s1, 's'); /* search s1 for last occurrence of 's' */ if (strPtr == NULL) goto Fail; if (strPtr != &(s1 [18])) goto Fail; strPtr = strrchr (s1, 'z'); /* search s1 for char not in s1 */ if (strPtr != NULL) goto Fail; i = strrpos (s1, 'g'); /* find position of last 'g' in s1 */ if (i != 27) goto Fail; i = strrpos (s1, 'x'); /* find position of char not in s1 */ if (i != -1) goto Fail; i = strrpos (s1, '\0'); /* find position of terminating null */ if (i != 33) goto Fail; printf ("Passed Conformance Test 15.5.0.1\n"); return; Fail: printf ("Failed Conformance Test 15.5.0.1\n"); } \ No newline at end of file +/* Conformance Test 15.5.0.1: Verification of strchr, strpos, strrchr, and */ +/* strrpos functions */ + +#include +#include + +main () + { + char s1 [80] = "this is the first string argument"; + char *strPtr; + size_t i; + + strPtr = strchr (s1, 's'); /* search s1 for 1st occurrence of 's' */ + if (strPtr == NULL) + goto Fail; + if (strPtr != &(s1 [3])) + goto Fail; + + strPtr = strchr (s1, 'z'); /* search s1 for char not in s1 */ + if (strPtr != NULL) + goto Fail; + + i = strpos (s1, 'f'); /* find position of 1st 'f' in s1 */ + if (i != 12) + goto Fail; + + i = strpos (s1, 'x'); /* find position of char not in s1 */ + if (i != -1) + goto Fail; + + i = strpos (s1, '\0'); /* find position of terminating null */ + if (i != 33) + goto Fail; + + strPtr = strrchr (s1, 's'); /* search s1 for last occurrence of 's' */ + if (strPtr == NULL) + goto Fail; + if (strPtr != &(s1 [18])) + goto Fail; + + strPtr = strrchr (s1, 'z'); /* search s1 for char not in s1 */ + if (strPtr != NULL) + goto Fail; + + i = strrpos (s1, 'g'); /* find position of last 'g' in s1 */ + if (i != 27) + goto Fail; + + i = strrpos (s1, 'x'); /* find position of char not in s1 */ + if (i != -1) + goto Fail; + + i = strrpos (s1, '\0'); /* find position of terminating null */ + if (i != 33) + goto Fail; + + printf ("Passed Conformance Test 15.5.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 15.5.0.1\n"); + } diff --git a/Tests/Conformance/C15.6.0.1.CC b/Tests/Conformance/C15.6.0.1.CC old mode 100755 new mode 100644 index a8bd28c..d5cc965 --- a/Tests/Conformance/C15.6.0.1.CC +++ b/Tests/Conformance/C15.6.0.1.CC @@ -1 +1,79 @@ -/* Conformance Test 15.6.0.1: Verification of strspn, strcspn, strpbrk, and */ /* strrpbrk functions */ #include #include main () { char s1 [80] = "a b c d e f g h i j k : ' - _ + "; char *strPtr; size_t i; /* strspn: find length of first run of chars from set */ i = strspn (s1, " abcde cbad "); /* search s1 for only chars in set */ if (i != 10) goto Fail; i = strspn (s1, " +_-':kjihgfedcba"); /* all chars in set are in s1 */ if (i != 32) /* should return length (s1) */ goto Fail; i = strspn (s1, ""); /* should return 0 */ if (i != 0) goto Fail; /* strcspn: find length of first run of chars not in set */ i = strcspn (s1, "fg:"); /* search s1 for chars not in set */ if (i != 10) goto Fail; i = strcspn (s1, " +_-':kjihgfedcba"); /* all chars in set are in s1 */ if (i != 0) /* should return 0 */ goto Fail; i = strcspn (s1, ""); /* should return strlen */ if (i != strlen(s1)) goto Fail; /* strpbrk: return pointer to 1st char in set */ strPtr = strpbrk (s1, "fg:"); /* search s1 for chars not in set */ if (strPtr != &(s1 [10])) goto Fail; strPtr = strpbrk (s1, " +_-':kjihgfedcba"); /* all chars in set are in s1 */ if (strPtr != s1) /* should return ptr to start*/ goto Fail; strPtr = strpbrk (s1, ""); /* should return NULL */ if (strPtr != NULL) goto Fail; /* strrpbrk: return pointer to last char in set */ strPtr = strrpbrk (s1, "fg:"); /* search s1 for last char in set */ if (strPtr != &(s1 [22])) goto Fail; strPtr = strrpbrk (s1, " +_-':kjihgfedcba"); /* all chars in set are in s1 */ if (strPtr != &(s1[31])) goto Fail; strPtr = strrpbrk (s1, ""); /* should return ptr to end of string */ if (strPtr != NULL) goto Fail; printf ("Passed Conformance Test 15.6.0.1\n"); return; Fail: printf ("Failed Conformance Test 15.6.0.1\n"); } \ No newline at end of file +/* Conformance Test 15.6.0.1: Verification of strspn, strcspn, strpbrk, and */ +/* strrpbrk functions */ + +#include +#include + +main () + { + char s1 [80] = "a b c d e f g h i j k : ' - _ + "; + char *strPtr; + size_t i; + + + /* strspn: find length of first run of chars from set */ + + i = strspn (s1, " abcde cbad "); /* search s1 for only chars in set */ + if (i != 10) + goto Fail; + + i = strspn (s1, " +_-':kjihgfedcba"); /* all chars in set are in s1 */ + if (i != 32) /* should return length (s1) */ + goto Fail; + + i = strspn (s1, ""); /* should return 0 */ + if (i != 0) + goto Fail; + + + /* strcspn: find length of first run of chars not in set */ + + i = strcspn (s1, "fg:"); /* search s1 for chars not in set */ + if (i != 10) + goto Fail; + + i = strcspn (s1, " +_-':kjihgfedcba"); /* all chars in set are in s1 */ + if (i != 0) /* should return 0 */ + goto Fail; + + i = strcspn (s1, ""); /* should return strlen */ + if (i != strlen(s1)) + goto Fail; + + + /* strpbrk: return pointer to 1st char in set */ + + strPtr = strpbrk (s1, "fg:"); /* search s1 for chars not in set */ + if (strPtr != &(s1 [10])) + goto Fail; + + strPtr = strpbrk (s1, " +_-':kjihgfedcba"); /* all chars in set are in s1 */ + if (strPtr != s1) /* should return ptr to start*/ + goto Fail; + + strPtr = strpbrk (s1, ""); /* should return NULL */ + if (strPtr != NULL) + goto Fail; + + + /* strrpbrk: return pointer to last char in set */ + + strPtr = strrpbrk (s1, "fg:"); /* search s1 for last char in set */ + if (strPtr != &(s1 [22])) + goto Fail; + + strPtr = strrpbrk (s1, " +_-':kjihgfedcba"); /* all chars in set are in s1 */ + if (strPtr != &(s1[31])) + goto Fail; + + strPtr = strrpbrk (s1, ""); /* should return ptr to end of string */ + if (strPtr != NULL) + goto Fail; + + + printf ("Passed Conformance Test 15.6.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 15.6.0.1\n"); + } diff --git a/Tests/Conformance/C15.7.0.1.CC b/Tests/Conformance/C15.7.0.1.CC old mode 100755 new mode 100644 index c2b3cee..86b58cc --- a/Tests/Conformance/C15.7.0.1.CC +++ b/Tests/Conformance/C15.7.0.1.CC @@ -1 +1,25 @@ -/* Conformance Test 15.7.0.1: Verification of strstr function */ #include #include main () { char string [] = " this is the source string, a source string"; char *strPtr; strPtr = strstr (string, "source string"); if (strPtr != (&( (string) [(13)] )) ) goto Fail; strPtr = strstr (string, "source string!"); if (strPtr != NULL) goto Fail; printf ("Passed Conformance Test 15.7.0.1\n"); return; Fail: printf ("Failed Conformance Test 15.7.0.1\n"); } \ No newline at end of file +/* Conformance Test 15.7.0.1: Verification of strstr function */ + +#include +#include + +main () + { + char string [] = " this is the source string, a source string"; + char *strPtr; + + + strPtr = strstr (string, "source string"); + if (strPtr != (&( (string) [(13)] )) ) + goto Fail; + + strPtr = strstr (string, "source string!"); + if (strPtr != NULL) + goto Fail; + + printf ("Passed Conformance Test 15.7.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 15.7.0.1\n"); + } diff --git a/Tests/Conformance/C15.7.0.2.CC b/Tests/Conformance/C15.7.0.2.CC old mode 100755 new mode 100644 index 813c949..9f9e5e5 --- a/Tests/Conformance/C15.7.0.2.CC +++ b/Tests/Conformance/C15.7.0.2.CC @@ -1 +1,106 @@ -/* Conformance Test 15.7.0.2: Verification of strtok function */ #include #include main () { char string [] = " this is the source string, so creative! oh, yes"; char *strPtr; /* First call to strtok pass the string to be parsed; subsequent calls */ /* just pass a NULL pointer. Separating character is space to start. */ strPtr = strtok (string, " "); if (strPtr != (&( (string) [(1)] )) ) goto Fail; strPtr = strtok (NULL, " "); if (strPtr != &string [6]) goto Fail; strPtr = strtok (NULL, " "); if (strPtr != &string [9]) goto Fail; strPtr = strtok (NULL, " "); if (strPtr != &string [13]) goto Fail; strPtr = strtok (NULL, ","); /* now change the separator set */ if (strPtr != &string [20]) goto Fail; strPtr = strtok (NULL, ","); if (strPtr != &string [27]) goto Fail; strPtr = strtok (NULL, "! &*"); /* make last calls to strtok */ if (strPtr != &string [45]) /* address of '\0' at end of string */ goto Fail; strPtr = strtok (NULL, " "); if (strPtr != NULL) goto Fail; /* Check tokenized string created by successive calls to strtok. */ strcpy(string, " this is the source string, so creative! oh, yes"); strPtr = strtok (string, " "); if (strcmp (strPtr, "this")) goto Fail; strPtr = strtok (NULL, " "); if (strcmp (strPtr, "is")) goto Fail; strPtr = strtok (NULL, " "); if (strcmp (strPtr, "the")) goto Fail; strPtr = strtok (NULL, " "); if (strcmp (strPtr, "source")) goto Fail; strPtr = strtok (NULL, " "); if (strcmp (strPtr, "string,")) goto Fail; strPtr = strtok (NULL, " "); if (strcmp (strPtr, "so")) goto Fail; strPtr = strtok (NULL, " "); if (strcmp (strPtr, "creative!")) goto Fail; strPtr = strtok (NULL, " "); if (strcmp (strPtr, "oh,")) goto Fail; strPtr = strtok (NULL, " "); if (strcmp (strPtr, "yes")) goto Fail; /* Check "special" cases: string is the null string, and the string */ /* contains only separator characters */ strPtr = strtok ("", " "); if (strPtr != NULL) goto Fail; strPtr = strtok ("abc", "abc"); if (strPtr != NULL) goto Fail; printf ("Passed Conformance Test 15.7.0.2\n"); return; Fail: printf ("Failed Conformance Test 15.7.0.2\n"); } \ No newline at end of file +/* Conformance Test 15.7.0.2: Verification of strtok function */ + +#include +#include + +main () + { + char string [] = " this is the source string, so creative! oh, yes"; + char *strPtr; + + + /* First call to strtok pass the string to be parsed; subsequent calls */ + /* just pass a NULL pointer. Separating character is space to start. */ + + strPtr = strtok (string, " "); + if (strPtr != (&( (string) [(1)] )) ) + goto Fail; + + strPtr = strtok (NULL, " "); + if (strPtr != &string [6]) + goto Fail; + + strPtr = strtok (NULL, " "); + if (strPtr != &string [9]) + goto Fail; + + strPtr = strtok (NULL, " "); + if (strPtr != &string [13]) + goto Fail; + + strPtr = strtok (NULL, ","); /* now change the separator set */ + if (strPtr != &string [20]) + goto Fail; + + strPtr = strtok (NULL, ","); + if (strPtr != &string [27]) + goto Fail; + + strPtr = strtok (NULL, "! &*"); /* make last calls to strtok */ + if (strPtr != &string [45]) /* address of '\0' at end of string */ + goto Fail; + + strPtr = strtok (NULL, " "); + if (strPtr != NULL) + goto Fail; + + + /* Check tokenized string created by successive calls to strtok. */ + + strcpy(string, " this is the source string, so creative! oh, yes"); + + strPtr = strtok (string, " "); + if (strcmp (strPtr, "this")) + goto Fail; + + strPtr = strtok (NULL, " "); + if (strcmp (strPtr, "is")) + goto Fail; + + strPtr = strtok (NULL, " "); + if (strcmp (strPtr, "the")) + goto Fail; + + strPtr = strtok (NULL, " "); + if (strcmp (strPtr, "source")) + goto Fail; + + strPtr = strtok (NULL, " "); + if (strcmp (strPtr, "string,")) + goto Fail; + + strPtr = strtok (NULL, " "); + if (strcmp (strPtr, "so")) + goto Fail; + + strPtr = strtok (NULL, " "); + if (strcmp (strPtr, "creative!")) + goto Fail; + + strPtr = strtok (NULL, " "); + if (strcmp (strPtr, "oh,")) + goto Fail; + + strPtr = strtok (NULL, " "); + if (strcmp (strPtr, "yes")) + goto Fail; + + + /* Check "special" cases: string is the null string, and the string */ + /* contains only separator characters */ + + strPtr = strtok ("", " "); + if (strPtr != NULL) + goto Fail; + + strPtr = strtok ("abc", "abc"); + if (strPtr != NULL) + goto Fail; + + + printf ("Passed Conformance Test 15.7.0.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 15.7.0.2\n"); + } diff --git a/Tests/Conformance/C15.8.0.1.CC b/Tests/Conformance/C15.8.0.1.CC old mode 100755 new mode 100644 index e3b26c5..53b730f --- a/Tests/Conformance/C15.8.0.1.CC +++ b/Tests/Conformance/C15.8.0.1.CC @@ -1 +1,37 @@ -/* Conformance Test 15.8.0.1: Verification of strtod library function */ #include #include #include main () { double d1; char string [] = " -32767 0567 -3.4e+2 "; char *strPtr; d1 = strtod (string, &strPtr); if (fabs(d1 - -32767.0) > 0.00001) goto Fail; if (strPtr != &string [8]) goto Fail; d1 = strtod (strPtr, &strPtr); if (fabs(d1 - 567.00) > 0.00001) goto Fail; if (strPtr != &string [14]) goto Fail; d1 = strtod (strPtr, &strPtr); if (fabs(d1 - (-340.00)) > 0.00001) goto Fail; if (strPtr != &string [23]) goto Fail; printf ("Passed Conformance Test 15.8.0.1\n"); return; Fail: printf ("Failed Conformance Test 15.8.0.1\n"); } \ No newline at end of file +/* Conformance Test 15.8.0.1: Verification of strtod library function */ + +#include +#include +#include + +main () + { + double d1; + char string [] = " -32767 0567 -3.4e+2 "; + char *strPtr; + + + d1 = strtod (string, &strPtr); + if (fabs(d1 - -32767.0) > 0.00001) + goto Fail; + if (strPtr != &string [8]) + goto Fail; + + d1 = strtod (strPtr, &strPtr); + if (fabs(d1 - 567.00) > 0.00001) + goto Fail; + if (strPtr != &string [14]) + goto Fail; + + d1 = strtod (strPtr, &strPtr); + if (fabs(d1 - (-340.00)) > 0.00001) + goto Fail; + if (strPtr != &string [23]) + goto Fail; + + printf ("Passed Conformance Test 15.8.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 15.8.0.1\n"); + } diff --git a/Tests/Conformance/C15.8.0.2.CC b/Tests/Conformance/C15.8.0.2.CC old mode 100755 new mode 100644 index 3cc4fdf..ab26e26 --- a/Tests/Conformance/C15.8.0.2.CC +++ b/Tests/Conformance/C15.8.0.2.CC @@ -1 +1,63 @@ -/* Conformance Test 15.8.0.2: Verification of strtol, strtoul functions */ #include #include #include #include #include void main (void) { long L1; unsigned long UL1; char string [] = " -2147483647 0xfFfFfFfF 1111 077 0xffffffffff zz "; char *strPtr; L1 = strtol (string, &strPtr, 0); if (L1 != -(0x7fFfFfff)) goto Fail; if (strPtr != &string [13]) goto Fail; UL1 = strtoul (strPtr, &strPtr, 16); /* bases 10-36 can be letters */ if (UL1 != 4294967295ul) goto Fail; if (strPtr != &string [25]) goto Fail; L1 = strtol (strPtr, &strPtr, 2); if (L1 != 15) goto Fail; if (strPtr != &string [31]) goto Fail; UL1 = strtoul (strPtr, &strPtr, 8); if (UL1 != 63) goto Fail; if (strPtr != &string [36]) goto Fail; L1 = strtol (strPtr, &strPtr, 16); if (errno != ERANGE) goto Fail; UL1 = strtoul (strPtr, &strPtr, 16); if (errno != ERANGE) goto Fail; L1 = strtol ("zz", &strPtr, 0); if (errno != ERANGE) goto Fail; UL1 = strtoul ("xx", &strPtr, 0); if (errno != ERANGE) goto Fail; printf ("Passed Conformance Test 15.8.0.2\n"); return; Fail: printf ("Failed Conformance Test 15.8.0.2\n"); } \ No newline at end of file +/* Conformance Test 15.8.0.2: Verification of strtol, strtoul functions */ + +#include +#include +#include +#include +#include + +void main (void) + { + long L1; + unsigned long UL1; + + char string [] = " -2147483647 0xfFfFfFfF 1111 077 0xffffffffff zz "; + char *strPtr; + + + L1 = strtol (string, &strPtr, 0); + if (L1 != -(0x7fFfFfff)) + goto Fail; + if (strPtr != &string [13]) + goto Fail; + + UL1 = strtoul (strPtr, &strPtr, 16); /* bases 10-36 can be letters */ + if (UL1 != 4294967295ul) + goto Fail; + if (strPtr != &string [25]) + goto Fail; + + L1 = strtol (strPtr, &strPtr, 2); + if (L1 != 15) + goto Fail; + if (strPtr != &string [31]) + goto Fail; + + UL1 = strtoul (strPtr, &strPtr, 8); + if (UL1 != 63) + goto Fail; + if (strPtr != &string [36]) + goto Fail; + + L1 = strtol (strPtr, &strPtr, 16); + if (errno != ERANGE) + goto Fail; + + UL1 = strtoul (strPtr, &strPtr, 16); + if (errno != ERANGE) + goto Fail; + + L1 = strtol ("zz", &strPtr, 0); + if (errno != ERANGE) + goto Fail; + + UL1 = strtoul ("xx", &strPtr, 0); + if (errno != ERANGE) + goto Fail; + + printf ("Passed Conformance Test 15.8.0.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 15.8.0.2\n"); + } diff --git a/Tests/Conformance/C15.9.0.1.CC b/Tests/Conformance/C15.9.0.1.CC old mode 100755 new mode 100644 index c49d888..05e172a --- a/Tests/Conformance/C15.9.0.1.CC +++ b/Tests/Conformance/C15.9.0.1.CC @@ -1 +1,29 @@ -/* Conformance Test 15.9.0.1: Verification of atof, atoi, atol functions */ #include main () { double d1; int i; long L; d1 = atof ("3.5e-22"); if (d1 != 3.5e-22) goto Fail; i = atoi ("-32765"); if (i != -32765) goto Fail; L = atol ("100000"); if (L != 100000) goto Fail; printf ("Passed Conformance Test 15.9.0.1\n"); return; Fail: printf ("Failed Conformance Test 15.9.0.1\n"); } \ No newline at end of file +/* Conformance Test 15.9.0.1: Verification of atof, atoi, atol functions */ + +#include + +main () + { + double d1; + int i; + long L; + + + d1 = atof ("3.5e-22"); + if (d1 != 3.5e-22) + goto Fail; + + i = atoi ("-32765"); + if (i != -32765) + goto Fail; + + L = atol ("100000"); + if (L != 100000) + goto Fail; + + printf ("Passed Conformance Test 15.9.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 15.9.0.1\n"); + } diff --git a/Tests/Conformance/C16.1.0.1.CC b/Tests/Conformance/C16.1.0.1.CC old mode 100755 new mode 100644 index 79aa086..9127490 --- a/Tests/Conformance/C16.1.0.1.CC +++ b/Tests/Conformance/C16.1.0.1.CC @@ -1 +1,68 @@ -/* Conformance Test 16.1.0.1: Verification of memchr, memcmp, memcpy, memmove */ /* library functions */ #include #include #include main () { int i; char *rgn, *ptr1; char string [] = "Here is a string to copy to the first region!!! "; rgn = (char *) malloc (512); /* allocate some memory for test */ if (rgn == NULL) goto Fail1; /* Copy the string into the allocated area. */ ptr1 = (char *) (memcpy (rgn, string, sizeof(string)+1)); if (strcmp(ptr1,string)) goto Fail; /* Ensure memmove works for overlapping regions. */ memmove (rgn+40, rgn, sizeof(string)+1); if (strcmp(string, rgn+40)) goto Fail; /* Test memchr by searching region for characters. */ ptr1 = (char *) memchr (string, 'n', 50); if (ptr1 != string+14) goto Fail; ptr1 = (char *) (memchr (string, 'Z', 88)); if (ptr1 != NULL) goto Fail; /* Verify that the region has the correct characters. */ i = memcmp ( (char *) (rgn), (char *) (rgn + 40), 39); if (i) goto Fail; i = memcmp ( string, "Here is a string", 17); if (i <= 0) goto Fail; free (rgn); printf ("Passed Conformance Test 16.1.0.1\n"); return; Fail: printf ("Failed Conformance Test 16.1.0.1\n"); return; Fail1: printf ("Unable to allocate memory for Conformance Test 16.1.0.1\n"); return; } \ No newline at end of file +/* Conformance Test 16.1.0.1: Verification of memchr, memcmp, memcpy, memmove */ +/* library functions */ + +#include +#include +#include + +main () + { + int i; + char *rgn, *ptr1; + char string [] = "Here is a string to copy to the first region!!! "; + + + rgn = (char *) malloc (512); /* allocate some memory for test */ + if (rgn == NULL) + goto Fail1; + + + /* Copy the string into the allocated area. */ + + ptr1 = (char *) (memcpy (rgn, string, sizeof(string)+1)); + if (strcmp(ptr1,string)) + goto Fail; + + + /* Ensure memmove works for overlapping regions. */ + + memmove (rgn+40, rgn, sizeof(string)+1); + if (strcmp(string, rgn+40)) + goto Fail; + + + /* Test memchr by searching region for characters. */ + + ptr1 = (char *) memchr (string, 'n', 50); + if (ptr1 != string+14) + goto Fail; + + ptr1 = (char *) (memchr (string, 'Z', 88)); + if (ptr1 != NULL) + goto Fail; + + + /* Verify that the region has the correct characters. */ + + i = memcmp ( (char *) (rgn), (char *) (rgn + 40), 39); + if (i) + goto Fail; + + i = memcmp ( string, "Here is a string", 17); + if (i <= 0) + goto Fail; + + free (rgn); + + + printf ("Passed Conformance Test 16.1.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 16.1.0.1\n"); + return; + +Fail1: + printf ("Unable to allocate memory for Conformance Test 16.1.0.1\n"); + return; + } diff --git a/Tests/Conformance/C16.4.0.1.CC b/Tests/Conformance/C16.4.0.1.CC old mode 100755 new mode 100644 index 9c791e9..ef74dbb --- a/Tests/Conformance/C16.4.0.1.CC +++ b/Tests/Conformance/C16.4.0.1.CC @@ -1 +1,36 @@ -/* Conformance Test 16.4.0.1: Verification of memset library function */ #include #include #include main () { char *rgn, *ptr1; rgn = (char *) malloc (1024); if (rgn == NULL) goto Fail1; ptr1 = (char *) memset (rgn, 'a', 1024); if (ptr1 != rgn) goto Fail; for (; rgn != ptr1; rgn++) if (*rgn != 'a') goto Fail; free (rgn); printf ("Passed Conformance Test 16.4.0.1\n"); return; Fail: printf ("Failed Conformance Test 16.4.0.1\n"); return; Fail1: printf ("Unable to allocate memory for Conformance Test 16.4.0.1\n"); return; } \ No newline at end of file +/* Conformance Test 16.4.0.1: Verification of memset library function */ + +#include +#include +#include + +main () + { + char *rgn, *ptr1; + + + rgn = (char *) malloc (1024); + if (rgn == NULL) + goto Fail1; + + ptr1 = (char *) memset (rgn, 'a', 1024); + if (ptr1 != rgn) + goto Fail; + + for (; rgn != ptr1; rgn++) + if (*rgn != 'a') + goto Fail; + + free (rgn); + + printf ("Passed Conformance Test 16.4.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 16.4.0.1\n"); + return; + +Fail1: + printf ("Unable to allocate memory for Conformance Test 16.4.0.1\n"); + return; + } diff --git a/Tests/Conformance/C17.10.0.1.CC b/Tests/Conformance/C17.10.0.1.CC old mode 100755 new mode 100644 index 1f07d57..fb88c85 --- a/Tests/Conformance/C17.10.0.1.CC +++ b/Tests/Conformance/C17.10.0.1.CC @@ -1 +1,73 @@ -/* Conformance Test 17.10.0.1: Verification of fputs and puts */ #include main () { FILE *f1; int i,j; char string [255], *strPtr; f1 = fopen ("3/tmp", "w+"); /* open output file for test */ if (f1 == NULL) goto Fail1; /* Redirect standard output to a file */ stdout = freopen ("3/tmp2", "w+", stdout); if (stdout == NULL) goto Fail3; /* Write strings to output files. */ j = fputs ("this is the first string\n", f1); if (j) goto Fail; j = puts ("and this is the second string"); if (j) goto Fail; /* Check files' contents. */ rewind (f1); rewind (stdout); strPtr = fgets (string, 100, f1); if (strPtr != string) goto Fail; if (strcmp (string, "this is the first string\n")) goto Fail; strPtr = fgets (string, 100, stdout); if (strPtr != string) goto Fail; if (strcmp (string, "and this is the second string\n")) goto Fail; fclose(stdout); /* reset standard out */ i = fclose (f1); /* close the update file */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.10.0.1\n"); return; Fail: fprintf (stderr, "Failed Conformance Test 17.10.0.1\n"); return; Fail1: fprintf (stderr, "Unable to open input file for Conformance Test 17.10.0.1\n"); return; Fail2: fprintf (stderr, "Unable to close input file for Conformance Test 17.10.0.1\n"); return; Fail3: fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.10.0.1\n"); return; } \ No newline at end of file +/* Conformance Test 17.10.0.1: Verification of fputs and puts */ + +#include + +main () + { + FILE *f1; + int i,j; + char string [255], *strPtr; + + + f1 = fopen ("3/tmp", "w+"); /* open output file for test */ + if (f1 == NULL) + goto Fail1; + + /* Redirect standard output to a file */ + + stdout = freopen ("3/tmp2", "w+", stdout); + if (stdout == NULL) + goto Fail3; + + + /* Write strings to output files. */ + + j = fputs ("this is the first string\n", f1); + if (j) + goto Fail; + j = puts ("and this is the second string"); + if (j) + goto Fail; + + + /* Check files' contents. */ + + rewind (f1); + rewind (stdout); + strPtr = fgets (string, 100, f1); + if (strPtr != string) + goto Fail; + if (strcmp (string, "this is the first string\n")) + goto Fail; + strPtr = fgets (string, 100, stdout); + if (strPtr != string) + goto Fail; + if (strcmp (string, "and this is the second string\n")) + goto Fail; + + + fclose(stdout); /* reset standard out */ + + i = fclose (f1); /* close the update file */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.10.0.1\n"); + return; + +Fail: + fprintf (stderr, "Failed Conformance Test 17.10.0.1\n"); + return; + +Fail1: + fprintf (stderr, "Unable to open input file for Conformance Test 17.10.0.1\n"); + return; + +Fail2: + fprintf (stderr, "Unable to close input file for Conformance Test 17.10.0.1\n"); + return; + +Fail3: + fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.10.0.1\n"); + return; + } diff --git a/Tests/Conformance/C17.11.0.1.CC b/Tests/Conformance/C17.11.0.1.CC old mode 100755 new mode 100644 index b738756..48a2ac3 --- a/Tests/Conformance/C17.11.0.1.CC +++ b/Tests/Conformance/C17.11.0.1.CC @@ -1 +1,102 @@ -/* Conformance Test 17.11.0.1: Verification of fprintf, printf, sprintf: */ /* d, i format codes */ #include #include main () { FILE *f1; short i1; int i; int i2, i3; long L1; char string [80], sstring [80]; f1 = fopen ("3/tmp", "w+"); /* open output file for test */ if (f1 == NULL) goto Fail1; stdout = freopen ("3/tmp2", "w+", stdout); /* redirect stdout to a file */ if (stdout == NULL) goto Fail4; i1 = 32767; i2 = 0; L1 = -32767; i3 = 8; /* Write formatted output as string to the output files and sstring. */ i = fprintf (f1, " %-0+10.8hd %0 10.*i %5.d %10.8li %#-*li M\n", i1, i3, i1, i2, L1, i3, L1); if (i != 56) goto Fail; i = printf (" %-0+10.8hd %0 10.*i %5.d %10.8li %#-*li M\n", i1, i3, i1, i2, L1, i3, L1); if (i != 56) goto Fail; i = sprintf (sstring, " %-0+10.8hd %0 10.*i %5.d %10.8li %#-*li M\n", i1, i3, i1, i2, L1, i3, L1); if (i != 56) goto Fail; /* Check the string written. */ rewind (f1); i = fscanf (f1, "%55c", string); if (i != 1) goto Fail3; string [55] = '\0'; if (strcmp (string, " +000032767 000032767 -00032767\ -32767 M")) goto Fail; rewind (stdout); i = fscanf (stdout, "%55c", string); if (i != 1) goto Fail3; string [55] = '\0'; if (strcmp (string, " +000032767 000032767 -00032767\ -32767 M")) goto Fail; if (strcmp (sstring, " +000032767 000032767 -00032767\ -32767 M\n")) goto Fail; fclose(stdout); /* redirect stdout to screen */ i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.11.0.1\n"); return; Fail: fprintf (stderr, "Failed Conformance Test 17.11.0.1\n"); return; Fail1: fprintf (stderr, "Unable to open output file for Conformance Test 17.11.0.1\n"); return; Fail2: fprintf (stderr, "Unable to close output file for Conformance Test 17.11.0.1\n"); return; Fail3: fprintf (stderr, "Unable to read output file for Conformance Test 17.11.0.1\n"); return; Fail4: fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.11.0.1\n"); return; } \ No newline at end of file +/* Conformance Test 17.11.0.1: Verification of fprintf, printf, sprintf: */ +/* d, i format codes */ + +#include +#include + +main () + { + FILE *f1; + short i1; + int i; + int i2, i3; + long L1; + char string [80], sstring [80]; + + + f1 = fopen ("3/tmp", "w+"); /* open output file for test */ + if (f1 == NULL) + goto Fail1; + + stdout = freopen ("3/tmp2", "w+", stdout); /* redirect stdout to a file */ + if (stdout == NULL) + goto Fail4; + + + i1 = 32767; + i2 = 0; + L1 = -32767; + i3 = 8; + + /* Write formatted output as string to the output files and sstring. */ + + i = fprintf (f1, " %-0+10.8hd %0 10.*i %5.d %10.8li %#-*li M\n", + i1, i3, i1, i2, L1, i3, L1); + if (i != 56) + goto Fail; + + i = printf (" %-0+10.8hd %0 10.*i %5.d %10.8li %#-*li M\n", + i1, i3, i1, i2, L1, i3, L1); + if (i != 56) + goto Fail; + + i = sprintf (sstring, " %-0+10.8hd %0 10.*i %5.d %10.8li %#-*li M\n", + i1, i3, i1, i2, L1, i3, L1); + if (i != 56) + goto Fail; + + + /* Check the string written. */ + + rewind (f1); + i = fscanf (f1, "%55c", string); + if (i != 1) + goto Fail3; + string [55] = '\0'; + if (strcmp (string, " +000032767 000032767 -00032767\ + -32767 M")) + goto Fail; + + rewind (stdout); + i = fscanf (stdout, "%55c", string); + if (i != 1) + goto Fail3; + string [55] = '\0'; + if (strcmp (string, " +000032767 000032767 -00032767\ + -32767 M")) + goto Fail; + + if (strcmp (sstring, " +000032767 000032767 -00032767\ + -32767 M\n")) + goto Fail; + + + fclose(stdout); /* redirect stdout to screen */ + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.11.0.1\n"); + return; + +Fail: + fprintf (stderr, "Failed Conformance Test 17.11.0.1\n"); + return; + +Fail1: + fprintf (stderr, "Unable to open output file for Conformance Test 17.11.0.1\n"); + return; + +Fail2: + fprintf (stderr, "Unable to close output file for Conformance Test 17.11.0.1\n"); + return; + +Fail3: + fprintf (stderr, "Unable to read output file for Conformance Test 17.11.0.1\n"); + return; + +Fail4: + fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.11.0.1\n"); + return; + } diff --git a/Tests/Conformance/C17.11.0.10.CC b/Tests/Conformance/C17.11.0.10.CC old mode 100755 new mode 100644 index 2e7191e..3739492 --- a/Tests/Conformance/C17.11.0.10.CC +++ b/Tests/Conformance/C17.11.0.10.CC @@ -1 +1,99 @@ -/* Conformance Test 17.11.0.10: Verification of fprintf, printf, sprintf: */ /* g,G format codes */ #include main () { FILE *f1; int i; int i1, i2, i3; float fl1; double d1; extended e1; char string [80], sstring [80]; f1 = fopen ("3/tmp", "w+"); /* open output file for test */ if (f1 == NULL) goto Fail1; stdout = freopen ("3/tmp2", "w+", stdout); /* redirect stdout to file */ if (stdout == NULL) goto Fail4; fl1 = 9.0; d1 = -123.456e-20; e1 = 9876543210.0; i1 = 15; i2 = 8; /* Write formatted output as string to the output files and sstring. */ i = fprintf (f1, " %+0 #5.g %-0*.*G %13.10Lg G\n", fl1, i1, i2, d1, e1); if (i != 42) goto Fail; i = printf (" %+0 #5.g %-0*.*G %13.10Lg G\n", fl1, i1, i2, d1, e1); if (i != 42) goto Fail; i = sprintf (sstring, " %+0 #5.g %-0*.*G %13.10Lg G\n", fl1, i1, i2, d1, e1); if (i != 42) goto Fail; /* Check the string written. */ rewind (f1); i = fscanf (f1, "%41c", string); if (i != 1) goto Fail3; string [41] = '\0'; if (strcmp (string, " +009. -0001.23456E-18 9876543210 G")) goto Fail; rewind (stdout); i = fscanf (stdout, "%41c", string); if (i != 1) goto Fail3; string [41] = '\0'; if (strcmp (string, " +009. -0001.23456E-18 9876543210 G")) goto Fail; if (strcmp (sstring, " +009. -0001.23456E-18 9876543210 G\n")) goto Fail; fclose(stdout); /* redirect stdout to screen */ i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.11.0.10\n"); return; Fail: fprintf (stderr, "Failed Conformance Test 17.11.0.10\n"); return; Fail1: fprintf (stderr, "Unable to open output file for Conformance Test 17.11.0.10\n"); return; Fail2: fprintf (stderr, "Unable to close output file for Conformance Test 17.11.0.10\n"); return; Fail3: fprintf (stderr, "Unable to read output file for Conformance Test 17.11.0.10\n"); return; Fail4: fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.11.0.10\n"); return; } \ No newline at end of file +/* Conformance Test 17.11.0.10: Verification of fprintf, printf, sprintf: */ +/* g,G format codes */ + +#include + +main () + { + FILE *f1; + int i; + int i1, i2, i3; + float fl1; + double d1; + extended e1; + + char string [80], sstring [80]; + + + f1 = fopen ("3/tmp", "w+"); /* open output file for test */ + if (f1 == NULL) + goto Fail1; + + stdout = freopen ("3/tmp2", "w+", stdout); /* redirect stdout to file */ + if (stdout == NULL) + goto Fail4; + + + fl1 = 9.0; + d1 = -123.456e-20; + e1 = 9876543210.0; + i1 = 15; + i2 = 8; + + + /* Write formatted output as string to the output files and sstring. */ + + i = fprintf (f1, " %+0 #5.g %-0*.*G %13.10Lg G\n", fl1, i1, i2, d1, e1); + if (i != 42) + goto Fail; + + i = printf (" %+0 #5.g %-0*.*G %13.10Lg G\n", fl1, i1, i2, d1, e1); + if (i != 42) + goto Fail; + + i = sprintf (sstring, " %+0 #5.g %-0*.*G %13.10Lg G\n", fl1, i1, i2, d1, e1); + if (i != 42) + goto Fail; + + + /* Check the string written. */ + + rewind (f1); + i = fscanf (f1, "%41c", string); + if (i != 1) + goto Fail3; + string [41] = '\0'; + if (strcmp (string, " +009. -0001.23456E-18 9876543210 G")) + goto Fail; + + rewind (stdout); + i = fscanf (stdout, "%41c", string); + if (i != 1) + goto Fail3; + string [41] = '\0'; + if (strcmp (string, " +009. -0001.23456E-18 9876543210 G")) + goto Fail; + + if (strcmp (sstring, " +009. -0001.23456E-18 9876543210 G\n")) + goto Fail; + + + fclose(stdout); /* redirect stdout to screen */ + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.11.0.10\n"); + return; + +Fail: + fprintf (stderr, "Failed Conformance Test 17.11.0.10\n"); + return; + +Fail1: + fprintf (stderr, "Unable to open output file for Conformance Test 17.11.0.10\n"); + return; + +Fail2: + fprintf (stderr, "Unable to close output file for Conformance Test 17.11.0.10\n"); + return; + +Fail3: + fprintf (stderr, "Unable to read output file for Conformance Test 17.11.0.10\n"); + return; + +Fail4: + fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.11.0.10\n"); + return; + } diff --git a/Tests/Conformance/C17.11.0.11.CC b/Tests/Conformance/C17.11.0.11.CC old mode 100755 new mode 100644 index 356eee6..b579f15 --- a/Tests/Conformance/C17.11.0.11.CC +++ b/Tests/Conformance/C17.11.0.11.CC @@ -1 +1,105 @@ -/* Conformance Test 17.11.0.11: Verification of fprintf, printf, sprintf: */ /* n and % format codes */ #include main () { FILE *f1; int i, i1, i2; short sh; long l1; extended e1; char string [80], sstring [80]; f1 = fopen ("3/tmp", "w+"); /* open output file for test */ if (f1 == NULL) goto Fail1; stdout = freopen ("3/tmp2", "w+", stdout); /* redirect stdout to file */ if (stdout == NULL) goto Fail4; e1 = 123.456e-205; i1 = 6; i2 = 16; /* Write formatted output as string to the output files and sstring. */ i = fprintf (f1, "%% %hn %0+*.*le %s %% %ln N\n", &sh, i1, i2, e1, "a string", &l1); if (i != 48) goto Fail; if ((sh != 3) || (l1 != 44)) /* check return values for n format */ goto Fail; i = printf ("%% %hn %0+*.*le %s %% %ln N\n", &sh, i1, i2, e1, "a string", &l1); if (i != 48) goto Fail; if ((sh != 3) || (l1 != 44)) /* check return values for n format */ goto Fail; i = sprintf (sstring, "%% %hn %0+*.*le %s %% %ln N\n", &sh, i1, i2, e1, "a string", &l1); if (i != 48) goto Fail; if ((sh != 3) || (l1 != 44)) /* check return values for n format */ goto Fail; /* Check the string written. */ rewind (f1); i = fscanf (f1, "%47c", string); if (i != 1) goto Fail3; string [47] = '\0'; if (strcmp (string, "% +1.2345599999999999e-203 a string % N")) goto Fail; rewind (stdout); i = fscanf (stdout, "%47c", string); if (i != 1) goto Fail3; string [47] = '\0'; if (strcmp (string, "% +1.2345599999999999e-203 a string % N")) goto Fail; if (strcmp (sstring, "% +1.2345599999999999e-203 a string % N\n")) goto Fail; fclose(stdout); /* redirect stdout to screen */ i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.11.0.11\n"); return; Fail: fprintf (stderr, "Failed Conformance Test 17.11.0.11\n"); return; Fail1: fprintf (stderr, "Unable to open output file for Conformance Test 17.11.0.11\n"); return; Fail2: fprintf (stderr, "Unable to close output file for Conformance Test 17.11.0.11\n"); return; Fail3: fprintf (stderr, "Unable to read output file for Conformance Test 17.11.0.11\n"); return; Fail4: fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.11.0.11\n"); return; } \ No newline at end of file +/* Conformance Test 17.11.0.11: Verification of fprintf, printf, sprintf: */ +/* n and % format codes */ + +#include + +main () + { + FILE *f1; + int i, i1, i2; + short sh; + long l1; + extended e1; + + char string [80], sstring [80]; + + + f1 = fopen ("3/tmp", "w+"); /* open output file for test */ + if (f1 == NULL) + goto Fail1; + + stdout = freopen ("3/tmp2", "w+", stdout); /* redirect stdout to file */ + if (stdout == NULL) + goto Fail4; + + + e1 = 123.456e-205; + i1 = 6; + i2 = 16; + + + /* Write formatted output as string to the output files and sstring. */ + + i = fprintf (f1, "%% %hn %0+*.*le %s %% %ln N\n", &sh, i1, i2, e1, + "a string", &l1); + if (i != 48) + goto Fail; + if ((sh != 3) || (l1 != 44)) /* check return values for n format */ + goto Fail; + + i = printf ("%% %hn %0+*.*le %s %% %ln N\n", &sh, i1, i2, e1, + "a string", &l1); + if (i != 48) + goto Fail; + if ((sh != 3) || (l1 != 44)) /* check return values for n format */ + goto Fail; + + i = sprintf (sstring, "%% %hn %0+*.*le %s %% %ln N\n", &sh, i1, i2, e1, + "a string", &l1); + if (i != 48) + goto Fail; + if ((sh != 3) || (l1 != 44)) /* check return values for n format */ + goto Fail; + + + /* Check the string written. */ + + rewind (f1); + i = fscanf (f1, "%47c", string); + if (i != 1) + goto Fail3; + string [47] = '\0'; + if (strcmp (string, "% +1.2345599999999999e-203 a string % N")) + goto Fail; + + rewind (stdout); + i = fscanf (stdout, "%47c", string); + if (i != 1) + goto Fail3; + string [47] = '\0'; + if (strcmp (string, "% +1.2345599999999999e-203 a string % N")) + goto Fail; + + if (strcmp (sstring, "% +1.2345599999999999e-203 a string % N\n")) + goto Fail; + + + fclose(stdout); /* redirect stdout to screen */ + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.11.0.11\n"); + return; + +Fail: + fprintf (stderr, "Failed Conformance Test 17.11.0.11\n"); + return; + +Fail1: + fprintf (stderr, "Unable to open output file for Conformance Test 17.11.0.11\n"); + return; + +Fail2: + fprintf (stderr, "Unable to close output file for Conformance Test 17.11.0.11\n"); + return; + +Fail3: + fprintf (stderr, "Unable to read output file for Conformance Test 17.11.0.11\n"); + return; + +Fail4: + fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.11.0.11\n"); + return; + } diff --git a/Tests/Conformance/C17.11.0.2.CC b/Tests/Conformance/C17.11.0.2.CC old mode 100755 new mode 100644 index bb3f64c..afefbde --- a/Tests/Conformance/C17.11.0.2.CC +++ b/Tests/Conformance/C17.11.0.2.CC @@ -1 +1,103 @@ -/* Conformance Test 17.11.0.2: Verification of fprintf, sprintf, printf: */ /* u format code */ #include main () { FILE *f1; int i, i1, i2; unsigned int ui1, ui2; unsigned long ul1; char string [80], sstring [80]; f1 = fopen ("3/tmp", "w+"); /* open output file for test */ if (f1 == NULL) goto Fail1; stdout = freopen ("3/tmp2", "w+", stdout); /* redirect stdout to a file */ if (stdout == NULL) goto Fail4; ui1 = 65535; ui2 = 0; ul1 = 4294967295u; i1 = 12; i2 = 16; /* Write formatted output as string to the output files and sstring. */ i = fprintf (f1, " %-11.10hu %# +07.4lu %.0u %-*.*lu A\n", ui1, (long) ui1, ui2, i1, i2, ul1); if (i != 45) goto Fail; i = printf (" %-11.10hu %# +07.4lu %.0u %-*.*lu A\n", ui1, (long) ui1, ui2, i1, i2, ul1); if (i != 45) goto Fail; i = sprintf (sstring, " %-11.10hu %# +07.4lu %.0u %-*.*lu A\n", ui1, (long) ui1, ui2, i1, i2, ul1); if (i != 45) goto Fail; /* Check the string written. */ rewind (f1); i = fscanf (f1, "%44c", string); if (i != 1) goto Fail3; string [44] = '\0'; i = fprintf (f1, " %-11.10hu %# +07.4lu %.0u %-*.*lu A\n", ui1, (long) ui1, ui2, i1, i2, ul1); if (strcmp (string, " 0000065535 +065535 0000004294967295 A")) goto Fail; rewind (stdout); i = fscanf (stdout, "%44c", string); if (i != 1) goto Fail3; string [44] = '\0'; if (strcmp (string, " 0000065535 +065535 0000004294967295 A")) goto Fail; if (strcmp (sstring, " 0000065535 +065535 0000004294967295 A\n")) goto Fail; fclose(stdout); /* redirect stdout to screen */ i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.11.0.2\n"); return; Fail: fprintf (stderr, "Failed Conformance Test 17.11.0.2\n"); return; Fail1: fprintf (stderr, "Unable to open output file for Conformance Test 17.11.0.2\n"); return; Fail2: fprintf (stderr, "Unable to close output file for Conformance Test 17.11.0.2\n"); return; Fail3: fprintf (stderr, "Unable to read output file for Conformance Test 17.11.0.2\n"); return; Fail4: fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.11.0.2\n"); return; } \ No newline at end of file +/* Conformance Test 17.11.0.2: Verification of fprintf, sprintf, printf: */ +/* u format code */ + +#include + +main () + { + FILE *f1; + int i, i1, i2; + unsigned int ui1, ui2; + unsigned long ul1; + char string [80], sstring [80]; + + + f1 = fopen ("3/tmp", "w+"); /* open output file for test */ + if (f1 == NULL) + goto Fail1; + + stdout = freopen ("3/tmp2", "w+", stdout); /* redirect stdout to a file */ + if (stdout == NULL) + goto Fail4; + + + ui1 = 65535; + ui2 = 0; + ul1 = 4294967295u; + i1 = 12; + i2 = 16; + + /* Write formatted output as string to the output files and sstring. */ + + i = fprintf (f1, " %-11.10hu %# +07.4lu %.0u %-*.*lu A\n", + ui1, (long) ui1, ui2, i1, i2, ul1); + if (i != 45) + goto Fail; + + i = printf (" %-11.10hu %# +07.4lu %.0u %-*.*lu A\n", + ui1, (long) ui1, ui2, i1, i2, ul1); + if (i != 45) + goto Fail; + + i = sprintf (sstring, " %-11.10hu %# +07.4lu %.0u %-*.*lu A\n", + ui1, (long) ui1, ui2, i1, i2, ul1); + if (i != 45) + goto Fail; + + + /* Check the string written. */ + + rewind (f1); + i = fscanf (f1, "%44c", string); + if (i != 1) + goto Fail3; + string [44] = '\0'; + i = fprintf (f1, " %-11.10hu %# +07.4lu %.0u %-*.*lu A\n", + ui1, (long) ui1, ui2, i1, i2, ul1); + if (strcmp (string, " 0000065535 +065535 0000004294967295 A")) + goto Fail; + + rewind (stdout); + i = fscanf (stdout, "%44c", string); + if (i != 1) + goto Fail3; + string [44] = '\0'; + if (strcmp (string, " 0000065535 +065535 0000004294967295 A")) + goto Fail; + + if (strcmp (sstring, " 0000065535 +065535 0000004294967295 A\n")) + goto Fail; + + + fclose(stdout); /* redirect stdout to screen */ + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.11.0.2\n"); + return; + +Fail: + fprintf (stderr, "Failed Conformance Test 17.11.0.2\n"); + return; + +Fail1: + fprintf (stderr, + "Unable to open output file for Conformance Test 17.11.0.2\n"); + return; + +Fail2: + fprintf (stderr, "Unable to close output file for Conformance Test 17.11.0.2\n"); + return; + +Fail3: + fprintf (stderr, + "Unable to read output file for Conformance Test 17.11.0.2\n"); + return; + +Fail4: + fprintf (stderr, + "Unable to redirect stdout for Conformance Test 17.11.0.2\n"); + return; + } diff --git a/Tests/Conformance/C17.11.0.3.CC b/Tests/Conformance/C17.11.0.3.CC old mode 100755 new mode 100644 index 070d009..7326e0e --- a/Tests/Conformance/C17.11.0.3.CC +++ b/Tests/Conformance/C17.11.0.3.CC @@ -1 +1,99 @@ -/* Conformance Test 17.11.0.3: Verification of fprintf, printf, sprintf: */ /* o format code */ #include main () { FILE *f1; int i, i1, i2; unsigned int ui1, ui2; unsigned long ul1; char string [80], sstring [80]; f1 = fopen ("3/tmp", "w+"); /* open output file for test */ if (f1 == NULL) goto Fail1; stdout = freopen ("3/tmp2", "w+", stdout); /* redirect stdout to a file */ if (stdout == NULL) goto Fail4; ui1 = 65535; ui2 = 0; ul1 = 4294967295u; i1 = 6; i2 = 9; /* Write formatted output as string to the output files and sstring. */ i = fprintf (f1, " %-+ #10.5ho %#0*.*o %o %-12lo B\n", ui1, i1, i2, ui1, ui2, ul1); if (i != 43) goto Fail; i = printf (" %-+ #10.5ho %#0*.*o %o %-12lo B\n", ui1, i1, i2, ui1, ui2, ul1); if (i != 43) goto Fail; i = sprintf (sstring, " %-+ #10.5ho %#0*.*o %o %-12lo B\n", ui1, i1, i2, ui1, ui2, ul1); if (i != 43) goto Fail; /* Check the string written. */ rewind (f1); i = fscanf (f1, "%42c", string); if (i != 1) goto Fail3; string [42] = '\0'; if (strcmp (string, " 0177777 000177777 0 37777777777 B")) goto Fail; rewind (stdout); i = fscanf (stdout, "%42c", string); if (i != 1) goto Fail3; string [42] = '\0'; if (strcmp (string, " 0177777 000177777 0 37777777777 B")) goto Fail; if (strcmp (sstring, " 0177777 000177777 0 37777777777 B\n")) goto Fail; fclose(stdout); /* redirect stdout to screen */ i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.11.0.3\n"); return; Fail: fprintf (stderr, "Failed Conformance Test 17.11.0.3\n"); return; Fail1: fprintf (stderr, "Unable to open output file for Conformance Test 17.11.0.3\n"); return; Fail2: fprintf (stderr, "Unable to close output file for Conformance Test 17.11.0.3\n"); return; Fail3: fprintf (stderr, "Unable to read output file for Conformance Test 17.11.0.3\n"); return; Fail4: fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.11.0.3\n"); return; } \ No newline at end of file +/* Conformance Test 17.11.0.3: Verification of fprintf, printf, sprintf: */ +/* o format code */ + +#include + +main () + { + FILE *f1; + int i, i1, i2; + unsigned int ui1, ui2; + unsigned long ul1; + char string [80], sstring [80]; + + + f1 = fopen ("3/tmp", "w+"); /* open output file for test */ + if (f1 == NULL) + goto Fail1; + + stdout = freopen ("3/tmp2", "w+", stdout); /* redirect stdout to a file */ + if (stdout == NULL) + goto Fail4; + + + ui1 = 65535; + ui2 = 0; + ul1 = 4294967295u; + i1 = 6; + i2 = 9; + + + /* Write formatted output as string to the output files and sstring. */ + + i = fprintf (f1, " %-+ #10.5ho %#0*.*o %o %-12lo B\n", + ui1, i1, i2, ui1, ui2, ul1); + if (i != 43) + goto Fail; + + i = printf (" %-+ #10.5ho %#0*.*o %o %-12lo B\n", + ui1, i1, i2, ui1, ui2, ul1); + if (i != 43) + goto Fail; + + i = sprintf (sstring, " %-+ #10.5ho %#0*.*o %o %-12lo B\n", + ui1, i1, i2, ui1, ui2, ul1); + if (i != 43) + goto Fail; + + + /* Check the string written. */ + + rewind (f1); + i = fscanf (f1, "%42c", string); + if (i != 1) + goto Fail3; + string [42] = '\0'; + if (strcmp (string, " 0177777 000177777 0 37777777777 B")) + goto Fail; + + rewind (stdout); + i = fscanf (stdout, "%42c", string); + if (i != 1) + goto Fail3; + string [42] = '\0'; + if (strcmp (string, " 0177777 000177777 0 37777777777 B")) + goto Fail; + + if (strcmp (sstring, " 0177777 000177777 0 37777777777 B\n")) + goto Fail; + + + fclose(stdout); /* redirect stdout to screen */ + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.11.0.3\n"); + return; + +Fail: + fprintf (stderr, "Failed Conformance Test 17.11.0.3\n"); + return; + +Fail1: + fprintf (stderr, "Unable to open output file for Conformance Test 17.11.0.3\n"); + return; + +Fail2: + fprintf (stderr, "Unable to close output file for Conformance Test 17.11.0.3\n"); + return; + +Fail3: + fprintf (stderr, "Unable to read output file for Conformance Test 17.11.0.3\n"); + return; + +Fail4: + fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.11.0.3\n"); + return; + } diff --git a/Tests/Conformance/C17.11.0.4.CC b/Tests/Conformance/C17.11.0.4.CC old mode 100755 new mode 100644 index 528dc75..b752505 --- a/Tests/Conformance/C17.11.0.4.CC +++ b/Tests/Conformance/C17.11.0.4.CC @@ -1 +1,99 @@ -/* Conformance Test 17.11.0.4: Verification of fprintf, printf, sprintf: */ /* x,X format codes */ #include main () { FILE *f1; int i, i1, i2; unsigned int ui1, ui2; unsigned long ul1; char string [80], sstring [80]; f1 = fopen ("3/tmp", "w+"); /* open output file for test */ if (f1 == NULL) goto Fail1; stdout = freopen ("3/tmp2", "w+", stdout); /* redirect stdout to a file */ if (stdout == NULL) goto Fail4; ui1 = 65535u; ui2 = 0; ul1 = 4294967295u; i1 = 12; i2 = 10; /* Write formatted output as string to the output file. */ i = fprintf (f1, " %#+ -10.10x %#+ 09.8X %.0x %+ *.*lx C\n", ui1, ui1, ui2, i1, i2, ul1); if (i != 45) goto Fail; i = printf (" %#+ -10.10x %#+ 09.8X %.0x %+ *.*lx C\n", ui1, ui1, ui2, i1, i2, ul1); if (i != 45) goto Fail; i = sprintf (sstring, " %#+ -10.10x %#+ 09.8X %.0x %+ *.*lx C\n", ui1, ui1, ui2, i1, i2, ul1); if (i != 45) goto Fail; /* Check the string written. */ rewind (f1); i = fscanf (f1, "%44c", string); if (i != 1) goto Fail3; string [44] = '\0'; if (strcmp (string, " 0x000000ffff 0X0000FFFF 00ffffffff C")) goto Fail; rewind (stdout); i = fscanf (stdout, "%44c", string); if (i != 1) goto Fail3; string [44] = '\0'; if (strcmp (string, " 0x000000ffff 0X0000FFFF 00ffffffff C")) goto Fail; if (strcmp (sstring, " 0x000000ffff 0X0000FFFF 00ffffffff C\n")) goto Fail; fclose(stdout); /* redirect stdout to screen */ i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.11.0.4\n"); return; Fail: fprintf (stderr, "Failed Conformance Test 17.11.0.4\n"); return; Fail1: fprintf (stderr, "Unable to open output file for Conformance Test 17.11.0.4\n"); return; Fail2: fprintf (stderr, "Unable to close output file for Conformance Test 17.11.0.4\n"); return; Fail3: fprintf (stderr, "Unable to read output file for Conformance Test 17.11.0.4\n"); return; Fail4: fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.11.0.4\n"); return; } \ No newline at end of file +/* Conformance Test 17.11.0.4: Verification of fprintf, printf, sprintf: */ +/* x,X format codes */ + +#include + +main () + { + FILE *f1; + int i, i1, i2; + unsigned int ui1, ui2; + unsigned long ul1; + char string [80], sstring [80]; + + + f1 = fopen ("3/tmp", "w+"); /* open output file for test */ + if (f1 == NULL) + goto Fail1; + + stdout = freopen ("3/tmp2", "w+", stdout); /* redirect stdout to a file */ + if (stdout == NULL) + goto Fail4; + + + ui1 = 65535u; + ui2 = 0; + ul1 = 4294967295u; + i1 = 12; + i2 = 10; + + + /* Write formatted output as string to the output file. */ + + i = fprintf (f1, " %#+ -10.10x %#+ 09.8X %.0x %+ *.*lx C\n", + ui1, ui1, ui2, i1, i2, ul1); + if (i != 45) + goto Fail; + + i = printf (" %#+ -10.10x %#+ 09.8X %.0x %+ *.*lx C\n", + ui1, ui1, ui2, i1, i2, ul1); + if (i != 45) + goto Fail; + + i = sprintf (sstring, " %#+ -10.10x %#+ 09.8X %.0x %+ *.*lx C\n", + ui1, ui1, ui2, i1, i2, ul1); + if (i != 45) + goto Fail; + + + /* Check the string written. */ + + rewind (f1); + i = fscanf (f1, "%44c", string); + if (i != 1) + goto Fail3; + string [44] = '\0'; +if (strcmp (string, " 0x000000ffff 0X0000FFFF 00ffffffff C")) + goto Fail; + + rewind (stdout); + i = fscanf (stdout, "%44c", string); + if (i != 1) + goto Fail3; + string [44] = '\0'; +if (strcmp (string, " 0x000000ffff 0X0000FFFF 00ffffffff C")) + goto Fail; + +if (strcmp (sstring, " 0x000000ffff 0X0000FFFF 00ffffffff C\n")) + goto Fail; + + + fclose(stdout); /* redirect stdout to screen */ + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.11.0.4\n"); + return; + +Fail: + fprintf (stderr, "Failed Conformance Test 17.11.0.4\n"); + return; + +Fail1: + fprintf (stderr, "Unable to open output file for Conformance Test 17.11.0.4\n"); + return; + +Fail2: + fprintf (stderr, "Unable to close output file for Conformance Test 17.11.0.4\n"); + return; + +Fail3: + fprintf (stderr, "Unable to read output file for Conformance Test 17.11.0.4\n"); + return; + +Fail4: + fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.11.0.4\n"); + return; + } diff --git a/Tests/Conformance/C17.11.0.5.CC b/Tests/Conformance/C17.11.0.5.CC old mode 100755 new mode 100644 index de18661..0c54162 --- a/Tests/Conformance/C17.11.0.5.CC +++ b/Tests/Conformance/C17.11.0.5.CC @@ -1 +1,97 @@ -/* Conformance Test 17.11.0.5: Verification of fprintf, printf, sprintf: */ /* c format code */ #include main () { FILE *f1; int i, i1, i2; unsigned int ui1, ui2; char string [80], sstring [80]; f1 = fopen ("3/tmp", "w+"); /* open output file for test */ if (f1 == NULL) goto Fail1; stdout = freopen ("3/tmp2", "w+", stdout); /* redirect stdout to a file */ if (stdout == NULL) goto Fail4; ui1 = 'a'; ui2 = 'b'; i1 = 3; i2 = 2; /* Write formatted output as string to the output file. */ i = fprintf (f1, " %#+ -010.10c %05.7hc %.6lc %+ *.*lc D\n", ui1, ui1, ui2, i1, i2, 'd'); if (i != 30) goto Fail; i = printf (" %#+ -010.10c %05.7hc %.6lc %+ *.*lc D\n", ui1, ui1, ui2, i1, i2, 'd'); if (i != 30) goto Fail; i = sprintf (sstring, " %#+ -010.10c %05.7hc %.6lc %+ *.*lc D\n", ui1, ui1, ui2, i1, i2, 'd'); if (i != 30) goto Fail; /* Check the string written. */ rewind (f1); i = fscanf (f1, "%29c", string); if (i != 1) goto Fail3; string [29] = '\0'; if (strcmp (string, " a a b d D")) goto Fail; rewind (stdout); i = fscanf (stdout, "%29c", string); if (i != 1) goto Fail3; string [29] = '\0'; if (strcmp (string, " a a b d D")) goto Fail; if (strcmp (sstring, " a a b d D\n")) goto Fail; fclose(stdout); /* redirect stdout to screen */ i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.11.0.5\n"); return; Fail: fprintf (stderr, "Failed Conformance Test 17.11.0.5\n"); return; Fail1: fprintf (stderr, "Unable to open output file for Conformance Test 17.11.0.5\n"); return; Fail2: fprintf (stderr, "Unable to close output file for Conformance Test 17.11.0.5\n"); return; Fail3: fprintf (stderr, "Unable to read output file for Conformance Test 17.11.0.5\n"); return; Fail4: fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.11.0.5\n"); return; } \ No newline at end of file +/* Conformance Test 17.11.0.5: Verification of fprintf, printf, sprintf: */ +/* c format code */ + +#include + +main () + { + FILE *f1; + int i, i1, i2; + unsigned int ui1, ui2; + char string [80], sstring [80]; + + + f1 = fopen ("3/tmp", "w+"); /* open output file for test */ + if (f1 == NULL) + goto Fail1; + + stdout = freopen ("3/tmp2", "w+", stdout); /* redirect stdout to a file */ + if (stdout == NULL) + goto Fail4; + + + ui1 = 'a'; + ui2 = 'b'; + i1 = 3; + i2 = 2; + + + /* Write formatted output as string to the output file. */ + + i = fprintf (f1, " %#+ -010.10c %05.7hc %.6lc %+ *.*lc D\n", + ui1, ui1, ui2, i1, i2, 'd'); + if (i != 30) + goto Fail; + + i = printf (" %#+ -010.10c %05.7hc %.6lc %+ *.*lc D\n", + ui1, ui1, ui2, i1, i2, 'd'); + if (i != 30) + goto Fail; + + i = sprintf (sstring, " %#+ -010.10c %05.7hc %.6lc %+ *.*lc D\n", + ui1, ui1, ui2, i1, i2, 'd'); + if (i != 30) + goto Fail; + + + /* Check the string written. */ + + rewind (f1); + i = fscanf (f1, "%29c", string); + if (i != 1) + goto Fail3; + string [29] = '\0'; + if (strcmp (string, " a a b d D")) + goto Fail; + + rewind (stdout); + i = fscanf (stdout, "%29c", string); + if (i != 1) + goto Fail3; + string [29] = '\0'; + if (strcmp (string, " a a b d D")) + goto Fail; + + if (strcmp (sstring, " a a b d D\n")) + goto Fail; + + + fclose(stdout); /* redirect stdout to screen */ + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.11.0.5\n"); + return; + +Fail: + fprintf (stderr, "Failed Conformance Test 17.11.0.5\n"); + return; + +Fail1: + fprintf (stderr, "Unable to open output file for Conformance Test 17.11.0.5\n"); + return; + +Fail2: + fprintf (stderr, "Unable to close output file for Conformance Test 17.11.0.5\n"); + return; + +Fail3: + fprintf (stderr, "Unable to read output file for Conformance Test 17.11.0.5\n"); + return; + +Fail4: + fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.11.0.5\n"); + return; + } diff --git a/Tests/Conformance/C17.11.0.6.CC b/Tests/Conformance/C17.11.0.6.CC old mode 100755 new mode 100644 index feac8b3..e0db182 --- a/Tests/Conformance/C17.11.0.6.CC +++ b/Tests/Conformance/C17.11.0.6.CC @@ -1 +1,99 @@ -/* Conformance Test 17.11.0.6: Verification of fprintf, printf, sprintf: */ /* s format code */ #include main () { FILE *f1; int i, j, k; char sstring [80]; char string [80], arg1 [] = "first string argument", arg2 [] = "second string argument "; f1 = fopen ("3/tmp", "w+"); /* open output file for test */ if (f1 == NULL) goto Fail1; stdout = freopen ("3/tmp2", "w+", stdout); /* redirect stdout to a file */ if (stdout == NULL) goto Fail4; j = 15; k = 30; /* Write formatted output as string to the output files and sstring. */ i = fprintf (f1, " %#+ -10.10s %015.7hs %*.*s %s E\n", arg1, arg1, j, k, arg2, "very short string"); if (i != 77) goto Fail; i = printf (" %#+ -10.10s %015.7hs %*.*s %s E\n", arg1, arg1, j, k, arg2, "very short string"); if (i != 77) goto Fail; i = sprintf (sstring, " %#+ -10.10s %015.7hs %*.*s %s E\n", arg1, arg1, j, k, arg2, "very short string"); if (i != 77) goto Fail; /* Check the string written. */ rewind (f1); i = fscanf (f1, "%76c", string); if (i != 1) goto Fail3; string [76] = '\0'; if (strcmp (string, " first stri first s second string argument \ very short string E")) goto Fail; rewind (stdout); i = fscanf (stdout, "%76c", string); if (i != 1) goto Fail3; string [76] = '\0'; if (strcmp (string, " first stri first s second string argument \ very short string E")) goto Fail; if (strcmp (sstring, " first stri first s second string argument \ very short string E\n")) goto Fail; fclose(stdout); /* redirect stdout to screen */ i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.11.0.6\n"); return; Fail: fprintf (stderr, "Failed Conformance Test 17.11.0.6\n"); return; Fail1: fprintf (stderr, "Unable to open output file for Conformance Test 17.11.0.6\n"); return; Fail2: fprintf (stderr, "Unable to close output file for Conformance Test 17.11.0.6\n"); return; Fail3: fprintf (stderr, "Unable to read output file for Conformance Test 17.11.0.6\n"); return; Fail4: fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.11.0.6\n"); return; } \ No newline at end of file +/* Conformance Test 17.11.0.6: Verification of fprintf, printf, sprintf: */ +/* s format code */ + +#include + +main () + { + FILE *f1; + int i, j, k; + char sstring [80]; + char string [80], arg1 [] = "first string argument", + arg2 [] = "second string argument "; + + + f1 = fopen ("3/tmp", "w+"); /* open output file for test */ + if (f1 == NULL) + goto Fail1; + + stdout = freopen ("3/tmp2", "w+", stdout); /* redirect stdout to a file */ + if (stdout == NULL) + goto Fail4; + + + j = 15; + k = 30; + + + /* Write formatted output as string to the output files and sstring. */ + + i = fprintf (f1, " %#+ -10.10s %015.7hs %*.*s %s E\n", + arg1, arg1, j, k, arg2, "very short string"); + if (i != 77) + goto Fail; + + i = printf (" %#+ -10.10s %015.7hs %*.*s %s E\n", + arg1, arg1, j, k, arg2, "very short string"); + if (i != 77) + goto Fail; + + i = sprintf (sstring, " %#+ -10.10s %015.7hs %*.*s %s E\n", + arg1, arg1, j, k, arg2, "very short string"); + if (i != 77) + goto Fail; + + + /* Check the string written. */ + + rewind (f1); + i = fscanf (f1, "%76c", string); + if (i != 1) + goto Fail3; + string [76] = '\0'; + if (strcmp (string, " first stri first s second string argument \ + very short string E")) + goto Fail; + + rewind (stdout); + i = fscanf (stdout, "%76c", string); + if (i != 1) + goto Fail3; + string [76] = '\0'; + if (strcmp (string, " first stri first s second string argument \ + very short string E")) + goto Fail; + + if (strcmp (sstring, " first stri first s second string argument \ + very short string E\n")) + goto Fail; + + + fclose(stdout); /* redirect stdout to screen */ + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.11.0.6\n"); + return; + +Fail: + fprintf (stderr, "Failed Conformance Test 17.11.0.6\n"); + return; + +Fail1: + fprintf (stderr, "Unable to open output file for Conformance Test 17.11.0.6\n"); + return; + +Fail2: + fprintf (stderr, "Unable to close output file for Conformance Test 17.11.0.6\n"); + return; + +Fail3: + fprintf (stderr, "Unable to read output file for Conformance Test 17.11.0.6\n"); + return; + +Fail4: + fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.11.0.6\n"); + return; + } diff --git a/Tests/Conformance/C17.11.0.7.CC b/Tests/Conformance/C17.11.0.7.CC old mode 100755 new mode 100644 index 2b02f15..48aaf9c --- a/Tests/Conformance/C17.11.0.7.CC +++ b/Tests/Conformance/C17.11.0.7.CC @@ -1 +1,99 @@ -/* Conformance Test 17.11.0.7: Verification of fprintf, printf, sprintf: */ /* p format code */ #include main () { FILE *f1; int i, j, k; char sstring [80]; char string [80], arg1 [] = "\pfirst string argument", arg2 [] = "\psecond string argument "; f1 = fopen ("3/tmp", "w+"); /* open output file for test */ if (f1 == NULL) goto Fail1; stdout = freopen ("3/tmp2", "w+", stdout); /* redirect stdout to file */ if (stdout == NULL) goto Fail4; j = 15; k = 30; /* Write formatted output as string to the output file. */ i = fprintf (f1, " %#+ -10.10b %015.7hb %*.*b %b E\n", arg1, arg1, j, k, arg2, "\pvery short string"); if (i != 77) goto Fail; i = printf (" %#+ -10.10b %015.7hb %*.*b %b E\n", arg1, arg1, j, k, arg2, "\pvery short string"); if (i != 77) goto Fail; i = sprintf (sstring, " %#+ -10.10b %015.7hb %*.*b %b E\n", arg1, arg1, j, k, arg2, "\pvery short string"); if (i != 77) goto Fail; /* Check the string written. */ rewind (f1); i = fscanf (f1, "%76c", string); if (i != 1) goto Fail3; string [76] = '\0'; if (strcmp (string, " first stri first s second string argument \ very short string E")) goto Fail; rewind (stdout); i = fscanf (stdout, "%76c", string); if (i != 1) goto Fail3; string [76] = '\0'; if (strcmp (string, " first stri first s second string argument \ very short string E")) goto Fail; if (strcmp (sstring, " first stri first s second string argument \ very short string E\n")) goto Fail; fclose(stdout); /* redirect stdout to screen */ i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.11.0.7\n"); return; Fail: fprintf (stderr, "Failed Conformance Test 17.11.0.7\n"); return; Fail1: fprintf (stderr, "Unable to open output file for Conformance Test 17.11.0.7\n"); return; Fail2: fprintf (stderr, "Unable to close output file for Conformance Test 17.11.0.7\n"); return; Fail3: fprintf (stderr, "Unable to read output file for Conformance Test 17.11.0.7\n"); return; Fail4: fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.11.0.7\n"); return; } \ No newline at end of file +/* Conformance Test 17.11.0.7: Verification of fprintf, printf, sprintf: */ +/* p format code */ + +#include + +main () + { + FILE *f1; + int i, j, k; + char sstring [80]; + char string [80], arg1 [] = "\pfirst string argument", + arg2 [] = "\psecond string argument "; + + + f1 = fopen ("3/tmp", "w+"); /* open output file for test */ + if (f1 == NULL) + goto Fail1; + + stdout = freopen ("3/tmp2", "w+", stdout); /* redirect stdout to file */ + if (stdout == NULL) + goto Fail4; + + + j = 15; + k = 30; + + + /* Write formatted output as string to the output file. */ + + i = fprintf (f1, " %#+ -10.10b %015.7hb %*.*b %b E\n", + arg1, arg1, j, k, arg2, "\pvery short string"); + if (i != 77) + goto Fail; + + i = printf (" %#+ -10.10b %015.7hb %*.*b %b E\n", + arg1, arg1, j, k, arg2, "\pvery short string"); + if (i != 77) + goto Fail; + + i = sprintf (sstring, " %#+ -10.10b %015.7hb %*.*b %b E\n", + arg1, arg1, j, k, arg2, "\pvery short string"); + if (i != 77) + goto Fail; + + + /* Check the string written. */ + + rewind (f1); + i = fscanf (f1, "%76c", string); + if (i != 1) + goto Fail3; + string [76] = '\0'; + if (strcmp (string, " first stri first s second string argument \ + very short string E")) + goto Fail; + + rewind (stdout); + i = fscanf (stdout, "%76c", string); + if (i != 1) + goto Fail3; + string [76] = '\0'; + if (strcmp (string, " first stri first s second string argument \ + very short string E")) + goto Fail; + + if (strcmp (sstring, " first stri first s second string argument \ + very short string E\n")) + goto Fail; + + + fclose(stdout); /* redirect stdout to screen */ + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.11.0.7\n"); + return; + +Fail: + fprintf (stderr, "Failed Conformance Test 17.11.0.7\n"); + return; + +Fail1: + fprintf (stderr, "Unable to open output file for Conformance Test 17.11.0.7\n"); + return; + +Fail2: + fprintf (stderr, "Unable to close output file for Conformance Test 17.11.0.7\n"); + return; + +Fail3: + fprintf (stderr, "Unable to read output file for Conformance Test 17.11.0.7\n"); + return; + +Fail4: + fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.11.0.7\n"); + return; + } diff --git a/Tests/Conformance/C17.11.0.8.CC b/Tests/Conformance/C17.11.0.8.CC old mode 100755 new mode 100644 index cb0493a..850fe2e --- a/Tests/Conformance/C17.11.0.8.CC +++ b/Tests/Conformance/C17.11.0.8.CC @@ -1 +1,97 @@ -/* Conformance Test 17.11.0.8: Verification of fprintf, printf, sprintf: */ /* f format code */ #include main () { FILE *f1; int i; int i2, i3; float fl1; double d1; extended e1; char string [80], sstring [80]; f1 = fopen ("3/tmp", "w+"); /* open output file for test */ if (f1 == NULL) goto Fail1; stdout = freopen ("3/tmp2", "w+", stdout); /* redirect stdout to file */ if (stdout == NULL) goto Fail4; fl1 = 45.0; d1 = 123.456e-2; e1 = 99.999; /* Write formatted output as string to the output files and sstring. */ i = fprintf (f1, " %# +012.7f %+-8.f %# 011lf T\n", d1, fl1, e1); if (i != 40) goto Fail; i = printf (" %# +012.7f %+-8.f %# 011lf T\n", d1, fl1, e1); if (i != 40) goto Fail; i = sprintf (sstring, " %# +012.7f %+-8.f %# 011lf T\n", d1, fl1, e1); if (i != 40) goto Fail; /* Check the string written. */ rewind (f1); i = fscanf (f1, "%39c", string); if (i != 1) goto Fail3; string [39] = '\0'; if (strcmp (string, " +001.2345600 +45 099.999000 T")) goto Fail; rewind (stdout); i = fscanf (stdout, "%39c", string); if (i != 1) goto Fail3; string [39] = '\0'; if (strcmp (string, " +001.2345600 +45 099.999000 T")) goto Fail; if (strcmp (sstring, " +001.2345600 +45 099.999000 T\n")) goto Fail; fclose(stdout); /* redirect stdout to screen */ i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.11.0.8\n"); return; Fail: fprintf (stderr, "Failed Conformance Test 17.11.0.8\n"); return; Fail1: fprintf (stderr, "Unable to open output file for Conformance Test 17.11.0.8\n"); return; Fail2: fprintf (stderr, "Unable to close output file for Conformance Test 17.11.0.8\n"); return; Fail3: fprintf (stderr, "Unable to read output file for Conformance Test 17.11.0.8\n"); return; Fail4: fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.11.0.8\n"); return; } \ No newline at end of file +/* Conformance Test 17.11.0.8: Verification of fprintf, printf, sprintf: */ +/* f format code */ + +#include + +main () + { + FILE *f1; + int i; + int i2, i3; + float fl1; + double d1; + extended e1; + + char string [80], sstring [80]; + + + f1 = fopen ("3/tmp", "w+"); /* open output file for test */ + if (f1 == NULL) + goto Fail1; + + stdout = freopen ("3/tmp2", "w+", stdout); /* redirect stdout to file */ + if (stdout == NULL) + goto Fail4; + + + fl1 = 45.0; + d1 = 123.456e-2; + e1 = 99.999; + + + /* Write formatted output as string to the output files and sstring. */ + + i = fprintf (f1, " %# +012.7f %+-8.f %# 011lf T\n", d1, fl1, e1); + if (i != 40) + goto Fail; + + i = printf (" %# +012.7f %+-8.f %# 011lf T\n", d1, fl1, e1); + if (i != 40) + goto Fail; + + i = sprintf (sstring, " %# +012.7f %+-8.f %# 011lf T\n", d1, fl1, e1); + if (i != 40) + goto Fail; + + + /* Check the string written. */ + + rewind (f1); + i = fscanf (f1, "%39c", string); + if (i != 1) + goto Fail3; + string [39] = '\0'; + if (strcmp (string, " +001.2345600 +45 099.999000 T")) + goto Fail; + + rewind (stdout); + i = fscanf (stdout, "%39c", string); + if (i != 1) + goto Fail3; + string [39] = '\0'; + if (strcmp (string, " +001.2345600 +45 099.999000 T")) + goto Fail; + + if (strcmp (sstring, " +001.2345600 +45 099.999000 T\n")) + goto Fail; + + + fclose(stdout); /* redirect stdout to screen */ + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.11.0.8\n"); + return; + +Fail: + fprintf (stderr, "Failed Conformance Test 17.11.0.8\n"); + return; + +Fail1: + fprintf (stderr, "Unable to open output file for Conformance Test 17.11.0.8\n"); + return; + +Fail2: + fprintf (stderr, "Unable to close output file for Conformance Test 17.11.0.8\n"); + return; + +Fail3: + fprintf (stderr, "Unable to read output file for Conformance Test 17.11.0.8\n"); + return; + +Fail4: + fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.11.0.8\n"); + return; + } diff --git a/Tests/Conformance/C17.11.0.9.CC b/Tests/Conformance/C17.11.0.9.CC old mode 100755 new mode 100644 index c85210a..e44bfc8 --- a/Tests/Conformance/C17.11.0.9.CC +++ b/Tests/Conformance/C17.11.0.9.CC @@ -1 +1,99 @@ -/* Conformance Test 17.11.0.9: Verification of fprintf, printf, sprintf: */ /* e, E format codes */ #include main () { FILE *f1; int i; int i1, i2, i3; float fl1; double d1; extended e1; char string [80], sstring [80]; f1 = fopen ("3/tmp", "w+"); /* open output file for test */ if (f1 == NULL) goto Fail1; stdout = freopen ("3/tmp2", "w+", stdout); /* redirect stdout to file */ if (stdout == NULL) goto Fail4; fl1 = 5.0; d1 = -4.7; e1 = 123.456e-205; i1 = 6; i2 = 16; /* Write formatted output as string to the output files and sstring. */ i = fprintf (f1, " %0+*.*le %- 15E %#0 .e E\n", i1, i2, e1, d1, fl1); if (i != 54) goto Fail; i = printf (" %0+*.*le %- 15E %#0 .e E\n", i1, i2, e1, d1, fl1); if (i != 54) goto Fail; i = sprintf (sstring, " %0+*.*le %- 15E %#0 .e E\n", i1, i2, e1, d1, fl1); if (i != 54) goto Fail; /* Check the string written. */ rewind (f1); i = fscanf (f1, "%53c", string); if (i != 1) goto Fail3; string [53] = '\0'; if (strcmp (string, " +1.2345599999999999e-203 -4.700000E+00 5e+00 E")) goto Fail; rewind (stdout); i = fscanf (stdout, "%53c", string); if (i != 1) goto Fail3; string [53] = '\0'; if (strcmp (string, " +1.2345599999999999e-203 -4.700000E+00 5e+00 E")) goto Fail; if (strcmp (sstring, " +1.2345599999999999e-203 -4.700000E+00 5e+00 E\n")) goto Fail; fclose(stdout); /* redirect stdout to screen */ i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.11.0.9\n"); return; Fail: fprintf (stderr, "Failed Conformance Test 17.11.0.9\n"); return; Fail1: fprintf (stderr, "Unable to open output file for Conformance Test 17.11.0.9\n"); return; Fail2: fprintf (stderr, "Unable to close output file for Conformance Test 17.11.0.9\n"); return; Fail3: fprintf (stderr, "Unable to read output file for Conformance Test 17.11.0.9\n"); return; Fail4: fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.11.0.9\n"); return; } \ No newline at end of file +/* Conformance Test 17.11.0.9: Verification of fprintf, printf, sprintf: */ +/* e, E format codes */ + +#include + +main () + { + FILE *f1; + int i; + int i1, i2, i3; + float fl1; + double d1; + extended e1; + + char string [80], sstring [80]; + + + f1 = fopen ("3/tmp", "w+"); /* open output file for test */ + if (f1 == NULL) + goto Fail1; + + stdout = freopen ("3/tmp2", "w+", stdout); /* redirect stdout to file */ + if (stdout == NULL) + goto Fail4; + + + fl1 = 5.0; + d1 = -4.7; + e1 = 123.456e-205; + i1 = 6; + i2 = 16; + + + /* Write formatted output as string to the output files and sstring. */ + + i = fprintf (f1, " %0+*.*le %- 15E %#0 .e E\n", i1, i2, e1, d1, fl1); + if (i != 54) + goto Fail; + + i = printf (" %0+*.*le %- 15E %#0 .e E\n", i1, i2, e1, d1, fl1); + if (i != 54) + goto Fail; + + i = sprintf (sstring, " %0+*.*le %- 15E %#0 .e E\n", i1, i2, e1, d1, fl1); + if (i != 54) + goto Fail; + + + /* Check the string written. */ + + rewind (f1); + i = fscanf (f1, "%53c", string); + if (i != 1) + goto Fail3; + string [53] = '\0'; + if (strcmp (string, " +1.2345599999999999e-203 -4.700000E+00 5e+00 E")) + goto Fail; + + rewind (stdout); + i = fscanf (stdout, "%53c", string); + if (i != 1) + goto Fail3; + string [53] = '\0'; + if (strcmp (string, " +1.2345599999999999e-203 -4.700000E+00 5e+00 E")) + goto Fail; + + if (strcmp (sstring, " +1.2345599999999999e-203 -4.700000E+00 5e+00 E\n")) + goto Fail; + + + fclose(stdout); /* redirect stdout to screen */ + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.11.0.9\n"); + return; + +Fail: + fprintf (stderr, "Failed Conformance Test 17.11.0.9\n"); + return; + +Fail1: + fprintf (stderr, "Unable to open output file for Conformance Test 17.11.0.9\n"); + return; + +Fail2: + fprintf (stderr, "Unable to close output file for Conformance Test 17.11.0.9\n"); + return; + +Fail3: + fprintf (stderr, "Unable to read output file for Conformance Test 17.11.0.9\n"); + return; + +Fail4: + fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.11.0.9\n"); + return; + } diff --git a/Tests/Conformance/C17.13.0.1.CC b/Tests/Conformance/C17.13.0.1.CC old mode 100755 new mode 100644 index 3f8d119..387683a --- a/Tests/Conformance/C17.13.0.1.CC +++ b/Tests/Conformance/C17.13.0.1.CC @@ -1 +1,77 @@ -/* Conformance Test 17.13.0.1: Verification of fread and fwrite */ #include #include struct S { int i; float f; char c; }; main () { struct S s [3] = { 1, 1.0, 'a', 2, 2.0, 'b', 3, 3.0, 'c' }; struct S buff [3]; FILE *f = fopen ("3/tmp", "w+b"); int i; /* Write the elements to the file. */ if (f == NULL) goto Fail1; i = fwrite ((void *) s, sizeof (struct S), 3, f); if (i != 3) goto Fail; /* Read the elements from the file. */ rewind (f); i = fread ((void *) buff, sizeof (struct S), 3, f); if (i != 3) goto Fail; if ((s [0].i != 1) || (s [1].i != 2) || (s [2].i != 3)) goto Fail; if ((fabs(s [0].f - 1.0) > 0.00001) || (fabs(s [1].f - 2.0) > 0.00001) || (fabs(s [2].f - 3.0) > 0.00001)) goto Fail; if ((s [0].c != 'a') || (s [1].c != 'b') || (s [2].c != 'c')) goto Fail; /* Ensure that a count or element_size of 0 causes no chars to be written. */ i = fwrite ((void *) s, sizeof (struct S), 0, f); if (i != 0) goto Fail; i = fwrite ((void *) s, 0, 2, f); if (i != 2) goto Fail; rewind (f); i = fread ((void *) s, sizeof (struct S), 0, f); if (i != 0) goto Fail; i = fread ((void *) s, 0, 2, f); if (i != 0) goto Fail; i = fclose (f); /* close the file and quit */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.13.0.1\n"); return; Fail: printf ("Failed Conformance Test 17.13.0.1\n"); return; Fail1: printf ("Unable to open temp file for Conformance Test 17.13.0.1\n"); return; Fail2: printf ("Unable to close output file for Conformance Test 17.13.0.1\n"); return; } \ No newline at end of file +/* Conformance Test 17.13.0.1: Verification of fread and fwrite */ + +#include +#include + +struct S { int i; + float f; + char c; }; + +main () + { + struct S s [3] = { 1, 1.0, 'a', 2, 2.0, 'b', 3, 3.0, 'c' }; + struct S buff [3]; + FILE *f = fopen ("3/tmp", "w+b"); + int i; + + + /* Write the elements to the file. */ + + if (f == NULL) + goto Fail1; + i = fwrite ((void *) s, sizeof (struct S), 3, f); + if (i != 3) + goto Fail; + + + /* Read the elements from the file. */ + + rewind (f); + i = fread ((void *) buff, sizeof (struct S), 3, f); + if (i != 3) + goto Fail; + if ((s [0].i != 1) || (s [1].i != 2) || (s [2].i != 3)) + goto Fail; + if ((fabs(s [0].f - 1.0) > 0.00001) || (fabs(s [1].f - 2.0) > 0.00001) || + (fabs(s [2].f - 3.0) > 0.00001)) + goto Fail; + if ((s [0].c != 'a') || (s [1].c != 'b') || (s [2].c != 'c')) + goto Fail; + + + /* Ensure that a count or element_size of 0 causes no chars to be written. */ + + i = fwrite ((void *) s, sizeof (struct S), 0, f); + if (i != 0) + goto Fail; + i = fwrite ((void *) s, 0, 2, f); + if (i != 2) + goto Fail; + rewind (f); + i = fread ((void *) s, sizeof (struct S), 0, f); + if (i != 0) + goto Fail; + i = fread ((void *) s, 0, 2, f); + if (i != 0) + goto Fail; + + + i = fclose (f); /* close the file and quit */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.13.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.13.0.1\n"); + return; + +Fail1: + printf ("Unable to open temp file for Conformance Test 17.13.0.1\n"); + return; + +Fail2: + printf ("Unable to close output file for Conformance Test 17.13.0.1\n"); + return; + } diff --git a/Tests/Conformance/C17.14.0.1.CC b/Tests/Conformance/C17.14.0.1.CC old mode 100755 new mode 100644 index b3c5bb3..9fb3307 --- a/Tests/Conformance/C17.14.0.1.CC +++ b/Tests/Conformance/C17.14.0.1.CC @@ -1 +1,63 @@ -/* Conformance Test 17.14.0.1: Verification of ferror and clearerr */ #include struct S { int i; float f; char c; }; main () { struct S s [3] = { 1, 1.0, 'a', 2, 2.0, 'b', 3, 3.0, 'c' }; struct S buff [3]; FILE *f = fopen ("3/tmp", "w+b"); int i; /* Write the elements to the file. */ if (f == NULL) goto Fail1; i = fwrite ((void *) s, sizeof (struct S), 3, f); if (i != 3) goto Fail; /* Cause an error to occur. */ rewind (f); i = fread ((void *) buff, sizeof (struct S), 5, f); if (i != 3) goto Fail; i = ferror (f); if (i != 0) goto Fail; i = feof (f); if (i == 0) goto Fail; /* clear the error */ clearerr (f); i = feof (f); if (i != 0) goto Fail; i = fclose (f); /* close the file and quit */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.14.0.1\n"); return; Fail: printf ("Failed Conformance Test 17.14.0.1\n"); return; Fail1: printf ("Unable to open temp file for Conformance Test 17.14.0.1\n"); return; Fail2: printf ("Unable to close output file for Conformance Test 17.14.0.1\n"); return; } \ No newline at end of file +/* Conformance Test 17.14.0.1: Verification of ferror and clearerr */ + +#include + +struct S { int i; + float f; + char c; }; + +main () + { + struct S s [3] = { 1, 1.0, 'a', 2, 2.0, 'b', 3, 3.0, 'c' }; + struct S buff [3]; + FILE *f = fopen ("3/tmp", "w+b"); + int i; + + + /* Write the elements to the file. */ + + if (f == NULL) + goto Fail1; + i = fwrite ((void *) s, sizeof (struct S), 3, f); + if (i != 3) + goto Fail; + + + /* Cause an error to occur. */ + rewind (f); + i = fread ((void *) buff, sizeof (struct S), 5, f); + if (i != 3) + goto Fail; + i = ferror (f); + if (i != 0) + goto Fail; + i = feof (f); + if (i == 0) + goto Fail; + + /* clear the error */ + clearerr (f); + i = feof (f); + if (i != 0) + goto Fail; + + + i = fclose (f); /* close the file and quit */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.14.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.14.0.1\n"); + return; + +Fail1: + printf ("Unable to open temp file for Conformance Test 17.14.0.1\n"); + return; + +Fail2: + printf ("Unable to close output file for Conformance Test 17.14.0.1\n"); + return; + } diff --git a/Tests/Conformance/C17.15.0.1.CC b/Tests/Conformance/C17.15.0.1.CC old mode 100755 new mode 100644 index 197986f..c229a72 --- a/Tests/Conformance/C17.15.0.1.CC +++ b/Tests/Conformance/C17.15.0.1.CC @@ -1 +1,54 @@ -/* Conformance Test 17.15.0.1: Verification of remove and rename */ #include struct S { int i; float f; char c; }; main () { struct S s [3] = { 1, 1.0, 'a', 2, 2.0, 'b', 3, 3.0, 'c' }; struct S buff [3]; FILE *f = fopen ("3/tmp", "wb"); int i; /* Write the elements to the file. */ if (f == NULL) goto Fail1; i = fwrite ((void *) s, sizeof (struct S), 3, f); if (i != 3) goto Fail; i = fclose (f); /* close the file */ if (i == EOF) goto Fail2; /* Rename and then delete the file. */ i = remove ("3/temp"); i = rename ("3/tmp", "3/temp"); if (i) goto Fail; i = remove ("3/temp"); if (i) goto Fail; printf ("Passed Conformance Test 17.15.0.1\n"); return; Fail: printf ("Failed Conformance Test 17.15.0.1\n"); return; Fail1: printf ("Unable to open temp file for Conformance Test 17.15.0.1\n"); return; Fail2: printf ("Unable to close output file for Conformance Test 17.15.0.1\n"); return; } \ No newline at end of file +/* Conformance Test 17.15.0.1: Verification of remove and rename */ + +#include + +struct S { int i; + float f; + char c; }; + +main () + { + struct S s [3] = { 1, 1.0, 'a', 2, 2.0, 'b', 3, 3.0, 'c' }; + struct S buff [3]; + FILE *f = fopen ("3/tmp", "wb"); + int i; + + + /* Write the elements to the file. */ + + if (f == NULL) + goto Fail1; + i = fwrite ((void *) s, sizeof (struct S), 3, f); + if (i != 3) + goto Fail; + + i = fclose (f); /* close the file */ + if (i == EOF) + goto Fail2; + + + /* Rename and then delete the file. */ + + i = remove ("3/temp"); + i = rename ("3/tmp", "3/temp"); + if (i) + goto Fail; + i = remove ("3/temp"); + if (i) + goto Fail; + + printf ("Passed Conformance Test 17.15.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.15.0.1\n"); + return; + +Fail1: + printf ("Unable to open temp file for Conformance Test 17.15.0.1\n"); + return; + +Fail2: + printf ("Unable to close output file for Conformance Test 17.15.0.1\n"); + return; + } diff --git a/Tests/Conformance/C17.16.0.1.CC b/Tests/Conformance/C17.16.0.1.CC old mode 100755 new mode 100644 index d4143d2..57e6aa4 --- a/Tests/Conformance/C17.16.0.1.CC +++ b/Tests/Conformance/C17.16.0.1.CC @@ -1 +1,103 @@ -/* Conformance Test 17.16.0.1: Verification of tmpfile function */ #include struct S { int i; float f; char c; }; main () { struct S s [3] = { 1, 1.0, 'a', 2, 2.0, 'b', 3, 3.0, 'c' }; struct S buff [3]; FILE *f1, *f2, *f3; int i; /* Create 3 temp files and write the elements to the files. */ f1 = tmpfile (); if (f1 == NULL) goto Fail1; i = fwrite ((void *) s, sizeof (struct S), 3, f1); if (i != 3) goto Fail; f2 = tmpfile (); if (f2 == NULL) goto Fail1; i = fwrite ((void *) s, sizeof (struct S), 3, f2); if (i != 3) goto Fail; f3 = tmpfile (); if (f3 == NULL) goto Fail1; i = fwrite ((void *) s, sizeof (struct S), 3, f3); if (i != 3) goto Fail; /* Read the elements from the files. */ rewind (f1); i = fread ((void *) buff, sizeof (struct S), 3, f1); if (i != 3) goto Fail; if ((s [0].i != 1) || (s [1].i != 2) || (s [2].i != 3)) goto Fail; if ((s [0].f != 1.0) || (s [1].f != 2.0) || (s [2].f != 3.0)) goto Fail; if ((s [0].c != 'a') || (s [1].c != 'b') || (s [2].c != 'c')) goto Fail; rewind (f2); i = fread ((void *) buff, sizeof (struct S), 3, f2); if (i != 3) goto Fail; if ((s [0].i != 1) || (s [1].i != 2) || (s [2].i != 3)) goto Fail; if ((s [0].f != 1.0) || (s [1].f != 2.0) || (s [2].f != 3.0)) goto Fail; if ((s [0].c != 'a') || (s [1].c != 'b') || (s [2].c != 'c')) goto Fail; rewind (f2); i = fread ((void *) buff, sizeof (struct S), 3, f2); if (i != 3) goto Fail; if ((s [0].i != 1) || (s [1].i != 2) || (s [2].i != 3)) goto Fail; if ((s [0].f != 1.0) || (s [1].f != 2.0) || (s [2].f != 3.0)) goto Fail; if ((s [0].c != 'a') || (s [1].c != 'b') || (s [2].c != 'c')) goto Fail; i = fclose (f1); /* close the files and quit */ if (i == EOF) goto Fail2; i = fclose (f2); if (i == EOF) goto Fail2; i = fclose (f3); if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.16.0.1\n"); return; Fail: printf ("Failed Conformance Test 17.16.0.1\n"); return; Fail1: printf ("Unable to open temp file for Conformance Test 17.16.0.1\n"); return; Fail2: printf ("Unable to close output file for Conformance Test 17.16.0.1\n"); return; } \ No newline at end of file +/* Conformance Test 17.16.0.1: Verification of tmpfile function */ + +#include + +struct S { int i; + float f; + char c; }; + +main () + { + struct S s [3] = { 1, 1.0, 'a', 2, 2.0, 'b', 3, 3.0, 'c' }; + struct S buff [3]; + FILE *f1, *f2, *f3; + int i; + + + /* Create 3 temp files and write the elements to the files. */ + + f1 = tmpfile (); + if (f1 == NULL) + goto Fail1; + i = fwrite ((void *) s, sizeof (struct S), 3, f1); + if (i != 3) + goto Fail; + + f2 = tmpfile (); + if (f2 == NULL) + goto Fail1; + i = fwrite ((void *) s, sizeof (struct S), 3, f2); + if (i != 3) + goto Fail; + + f3 = tmpfile (); + if (f3 == NULL) + goto Fail1; + i = fwrite ((void *) s, sizeof (struct S), 3, f3); + if (i != 3) + goto Fail; + + + /* Read the elements from the files. */ + + rewind (f1); + i = fread ((void *) buff, sizeof (struct S), 3, f1); + if (i != 3) + goto Fail; + if ((s [0].i != 1) || (s [1].i != 2) || (s [2].i != 3)) + goto Fail; + if ((s [0].f != 1.0) || (s [1].f != 2.0) || (s [2].f != 3.0)) + goto Fail; + if ((s [0].c != 'a') || (s [1].c != 'b') || (s [2].c != 'c')) + goto Fail; + + rewind (f2); + i = fread ((void *) buff, sizeof (struct S), 3, f2); + if (i != 3) + goto Fail; + if ((s [0].i != 1) || (s [1].i != 2) || (s [2].i != 3)) + goto Fail; + if ((s [0].f != 1.0) || (s [1].f != 2.0) || (s [2].f != 3.0)) + goto Fail; + if ((s [0].c != 'a') || (s [1].c != 'b') || (s [2].c != 'c')) + goto Fail; + + rewind (f2); + i = fread ((void *) buff, sizeof (struct S), 3, f2); + if (i != 3) + goto Fail; + if ((s [0].i != 1) || (s [1].i != 2) || (s [2].i != 3)) + goto Fail; + if ((s [0].f != 1.0) || (s [1].f != 2.0) || (s [2].f != 3.0)) + goto Fail; + if ((s [0].c != 'a') || (s [1].c != 'b') || (s [2].c != 'c')) + goto Fail; + + + i = fclose (f1); /* close the files and quit */ + if (i == EOF) + goto Fail2; + + i = fclose (f2); + if (i == EOF) + goto Fail2; + + i = fclose (f3); + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.16.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.16.0.1\n"); + return; + +Fail1: + printf ("Unable to open temp file for Conformance Test 17.16.0.1\n"); + return; + +Fail2: + printf ("Unable to close output file for Conformance Test 17.16.0.1\n"); + return; + } diff --git a/Tests/Conformance/C17.5.0.1.CC b/Tests/Conformance/C17.5.0.1.CC old mode 100755 new mode 100644 index 4b6be47..9a04ef1 --- a/Tests/Conformance/C17.5.0.1.CC +++ b/Tests/Conformance/C17.5.0.1.CC @@ -1 +1,112 @@ -/* Conformance Test 17.5.0.1: Verification of fseek function */ #include main () { FILE *f1; /* file pointer */ int i, j, k, m; f1 = fopen ("3/tmp", "w+b"); /* create binary file to work on */ if (f1 == NULL) goto Fail1; for (i = 0; i < 100; i++) /* write 100 integers to the file */ { j = fprintf (f1, "%2d ", i); if (j == EOF) goto Fail2; } i = fseek (f1, 50, SEEK_END); /* extend file by extra 50 bytes */ if (i) goto Fail; rewind (f1); /* position at beginning of file */ i = 0; while ((j = fgetc (f1)) != EOF) i += 1; if (! (j = feof (f1)) ) goto Fail3; if (i != 450) /* check size of file in bytes */ goto Fail; /* Test seek from beginning of file. */ for (k = 0, i = 0; i < 100; i++) { j = fseek (f1, k, SEEK_SET); if (j) goto Fail; j = fscanf (f1, "%d", &m); if (j == EOF) goto Fail3; if (m != i) goto Fail; k += 4; } /* Test seek from end of file. */ j = fseek (f1, -54, SEEK_END); /* start 54 bytes from end of file */ if (j) goto Fail; for (k = -54, i = 99; i > 0; i--) { j = fscanf (f1, "%d", &m); if (j == EOF) goto Fail3; if (m != i) goto Fail; k -= 4; j = fseek (f1, k, SEEK_END); if (j) goto Fail; } /* Test seek from current position in file. */ j = fseek (f1, 12, SEEK_CUR); if (j) goto Fail; j = fscanf (f1, "%d", &m); if (j == EOF) goto Fail3; if (m != 3) goto Fail; j = fseek (f1, 12, SEEK_CUR); if (j) goto Fail; j = fscanf (f1, "%d", &m); if (j == EOF) goto Fail3; if (m != 7) goto Fail; /* Close the file and quit. */ j = fclose (f1); if (j == EOF) goto Fail4; printf ("Passed Conformance Test 17.5.0.1\n"); return; Fail: printf ("Failed Conformance Test 17.5.0.1\n"); return; Fail1: printf ("Could not open tmp file for Conformance Test 17.5.0.1\n"); return; Fail2: printf ("Could not write to file for Conformance Test 17.5.0.1\n"); return; Fail3: printf ("Error while reading file for Conformance Test 17.5.0.1\n"); return; Fail4: printf ("Could not close file for Conformance Test 17.5.0.1\n"); return; } \ No newline at end of file +/* Conformance Test 17.5.0.1: Verification of fseek function */ + +#include + +main () + { + FILE *f1; /* file pointer */ + int i, j, k, m; + + f1 = fopen ("3/tmp", "w+b"); /* create binary file to work on */ + if (f1 == NULL) + goto Fail1; + for (i = 0; i < 100; i++) /* write 100 integers to the file */ + { + j = fprintf (f1, "%2d ", i); + if (j == EOF) + goto Fail2; + } + + i = fseek (f1, 50, SEEK_END); /* extend file by extra 50 bytes */ + if (i) + goto Fail; + rewind (f1); /* position at beginning of file */ + i = 0; + while ((j = fgetc (f1)) != EOF) + i += 1; + if (! (j = feof (f1)) ) + goto Fail3; + if (i != 450) /* check size of file in bytes */ + goto Fail; + + /* Test seek from beginning of file. */ + + for (k = 0, i = 0; i < 100; i++) + { + j = fseek (f1, k, SEEK_SET); + if (j) + goto Fail; + j = fscanf (f1, "%d", &m); + if (j == EOF) + goto Fail3; + if (m != i) + goto Fail; + k += 4; + } + + /* Test seek from end of file. */ + + j = fseek (f1, -54, SEEK_END); /* start 54 bytes from end of file */ + if (j) + goto Fail; + for (k = -54, i = 99; i > 0; i--) + { + j = fscanf (f1, "%d", &m); + if (j == EOF) + goto Fail3; + if (m != i) + goto Fail; + k -= 4; + j = fseek (f1, k, SEEK_END); + if (j) + goto Fail; + } + + /* Test seek from current position in file. */ + j = fseek (f1, 12, SEEK_CUR); + if (j) + goto Fail; + j = fscanf (f1, "%d", &m); + if (j == EOF) + goto Fail3; + if (m != 3) + goto Fail; + + j = fseek (f1, 12, SEEK_CUR); + if (j) + goto Fail; + j = fscanf (f1, "%d", &m); + if (j == EOF) + goto Fail3; + if (m != 7) + goto Fail; + + /* Close the file and quit. */ + + j = fclose (f1); + if (j == EOF) + goto Fail4; + + printf ("Passed Conformance Test 17.5.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.5.0.1\n"); + return; + +Fail1: + printf ("Could not open tmp file for Conformance Test 17.5.0.1\n"); + return; + +Fail2: + printf ("Could not write to file for Conformance Test 17.5.0.1\n"); + return; + +Fail3: + printf ("Error while reading file for Conformance Test 17.5.0.1\n"); + return; + +Fail4: + printf ("Could not close file for Conformance Test 17.5.0.1\n"); + return; + } diff --git a/Tests/Conformance/C17.5.0.2.CC b/Tests/Conformance/C17.5.0.2.CC old mode 100755 new mode 100644 index 4f88866..a2aa1ed --- a/Tests/Conformance/C17.5.0.2.CC +++ b/Tests/Conformance/C17.5.0.2.CC @@ -1 +1,132 @@ -/* Conformance Test 17.5.0.2: Verification of fseek, rewind, and ftell */ /* functions for text files */ #include main () { FILE *f1; /* file pointer */ int i, j, m; long L1; char s [254], ch1; char ch [254] = "a.b.c.d.e.f.g.h.i.j.k.l.m.n.o.p.q.r.s.t.u.v.w.x.y.z." "a.b.c.d.e.f.g.h.i.j.k.l.m.n.o.p.q.r.s.t.u.v.w.x.y.z." "a.b.c.d.e.f.g.h.i.j.k.l.m.n.o.p.q.r.s.t.u.v.w.x.y.z." "a.b.c.d.e.f.g.h.i.j.k.l.m.n.o.p.q.r.s.t.u.v.w.x.y.z." "A.B.C.D.E.F.G.H.I.J.K.L.M.N.O.P.Q.R.S.T.U.V."; f1 = fopen ("14:tmp", "w+"); /* create temporary file to work on */ if (f1 == NULL) goto Fail1; for (i = 0; i < 100; i++) /* write 100 lines to the file */ { j = fprintf (f1, "%s\n", ch); if (j == EOF) goto Fail2; } /* Test seek from beginning of file. */ j = fseek (f1, 0L, SEEK_SET); if (j) goto Fail; for (i = 0; i < 100; i++) { j = fscanf (f1, "%s", s); if (j == EOF) goto Fail3; if (strcmp (s, ch)) goto Fail; } /* Test seek from end of file. */ j = fseek (f1, 0L, SEEK_END); if (j) goto Fail; j = fscanf (f1, "%c", &m); if (j != EOF) goto Fail3; /* Test ftell function. */ L1 = ftell (f1); if (L1 != 25300) goto Fail; rewind (f1); L1 = ftell (f1); if (L1 != 0) goto Fail; ch1 = fgetc (f1); if (ch1 == EOF) goto Fail3; if (ch1 != 'a') goto Fail; ch1 = fgetc (f1); if (ch1 == EOF) goto Fail3; if (ch1 != '.') goto Fail; L1 = ftell (f1); if (L1 != 2) goto Fail; ch1 = fgetc (f1); if (ch1 == EOF) goto Fail3; if (ch1 != 'b') goto Fail; ch1 = fgetc (f1); if (ch1 == EOF) goto Fail3; if (ch1 != '.') goto Fail; ch1 = fgetc (f1); if (ch1 == EOF) goto Fail3; if (ch1 != 'c') goto Fail; j = fseek (f1, L1, SEEK_SET); /* verify that ftell-position works */ if (j) goto Fail; ch1 = fgetc (f1); if (ch1 == EOF) goto Fail3; if (ch1 != 'b') goto Fail; /* Close the file and quit. */ j = fclose (f1); if (j == EOF) goto Fail4; printf ("Passed Conformance Test 17.5.0.2\n"); return; Fail: printf ("Failed Conformance Test 17.5.0.2\n"); return; Fail1: printf ("Could not open tmp file for Conformance Test 17.5.0.2\n"); return; Fail2: printf ("Could not write to file for Conformance Test 17.5.0.2\n"); return; Fail3: printf ("Error while reading file for Conformance Test 17.5.0.2\n"); return; Fail4: printf ("Could not close file for Conformance Test 17.5.0.2\n"); return; } \ No newline at end of file +/* Conformance Test 17.5.0.2: Verification of fseek, rewind, and ftell */ +/* functions for text files */ + +#include + +main () + { + FILE *f1; /* file pointer */ + int i, j, m; + long L1; + char s [254], ch1; + char ch [254] = "a.b.c.d.e.f.g.h.i.j.k.l.m.n.o.p.q.r.s.t.u.v.w.x.y.z." + "a.b.c.d.e.f.g.h.i.j.k.l.m.n.o.p.q.r.s.t.u.v.w.x.y.z." + "a.b.c.d.e.f.g.h.i.j.k.l.m.n.o.p.q.r.s.t.u.v.w.x.y.z." + "a.b.c.d.e.f.g.h.i.j.k.l.m.n.o.p.q.r.s.t.u.v.w.x.y.z." + "A.B.C.D.E.F.G.H.I.J.K.L.M.N.O.P.Q.R.S.T.U.V."; + + + f1 = fopen ("14:tmp", "w+"); /* create temporary file to work on */ + if (f1 == NULL) + goto Fail1; + for (i = 0; i < 100; i++) /* write 100 lines to the file */ + { + j = fprintf (f1, "%s\n", ch); + if (j == EOF) + goto Fail2; + } + + /* Test seek from beginning of file. */ + + j = fseek (f1, 0L, SEEK_SET); + if (j) + goto Fail; + for (i = 0; i < 100; i++) { + j = fscanf (f1, "%s", s); + if (j == EOF) + goto Fail3; + if (strcmp (s, ch)) + goto Fail; + } + + /* Test seek from end of file. */ + + j = fseek (f1, 0L, SEEK_END); + if (j) + goto Fail; + j = fscanf (f1, "%c", &m); + if (j != EOF) + goto Fail3; + + /* Test ftell function. */ + + L1 = ftell (f1); + if (L1 != 25300) + goto Fail; + rewind (f1); + L1 = ftell (f1); + if (L1 != 0) + goto Fail; + + ch1 = fgetc (f1); + if (ch1 == EOF) + goto Fail3; + if (ch1 != 'a') + goto Fail; + + ch1 = fgetc (f1); + if (ch1 == EOF) + goto Fail3; + if (ch1 != '.') + goto Fail; + + L1 = ftell (f1); + if (L1 != 2) + goto Fail; + + ch1 = fgetc (f1); + if (ch1 == EOF) + goto Fail3; + if (ch1 != 'b') + goto Fail; + + ch1 = fgetc (f1); + if (ch1 == EOF) + goto Fail3; + if (ch1 != '.') + goto Fail; + + ch1 = fgetc (f1); + if (ch1 == EOF) + goto Fail3; + if (ch1 != 'c') + goto Fail; + + j = fseek (f1, L1, SEEK_SET); /* verify that ftell-position works */ + if (j) + goto Fail; + ch1 = fgetc (f1); + if (ch1 == EOF) + goto Fail3; + if (ch1 != 'b') + goto Fail; + + /* Close the file and quit. */ + + j = fclose (f1); + if (j == EOF) + goto Fail4; + + printf ("Passed Conformance Test 17.5.0.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.5.0.2\n"); + return; + +Fail1: + printf ("Could not open tmp file for Conformance Test 17.5.0.2\n"); + return; + +Fail2: + printf ("Could not write to file for Conformance Test 17.5.0.2\n"); + return; + +Fail3: + printf ("Error while reading file for Conformance Test 17.5.0.2\n"); + return; + +Fail4: + printf ("Could not close file for Conformance Test 17.5.0.2\n"); + return; + } diff --git a/Tests/Conformance/C17.6.0.1.CC b/Tests/Conformance/C17.6.0.1.CC old mode 100755 new mode 100644 index d3cd835..3733845 --- a/Tests/Conformance/C17.6.0.1.CC +++ b/Tests/Conformance/C17.6.0.1.CC @@ -1 +1,108 @@ -/* Conformance Test 17.6.0.1: Verification of fgetc, getc, and ungetc with */ /* a text stream */ #include main () { FILE *f1; int i, j; char ch; f1 = fopen ("3/tmp", "w+"); /* create text file to work on */ if (f1 == NULL) goto Fail1; for (ch = 'a', i = 0; i < 26; i++) { j = fputc (ch, f1); if ((char) j != ch) goto Fail2; ch++; } j = fputc ('\r', f1); /* text files end with return */ if (j != '\r') goto Fail2; rewind (f1); /* check file contents with fgetc */ for (ch = 'a', i = 0; i < 26; i++) { j = fgetc (f1); if ( (char) j != ch++ ) goto Fail; } i = ungetc ('F', f1); /* test ungetc */ if (i != 'F') goto Fail; i = fgetc (f1); if (i != 'F') goto Fail; i = fgetc (f1); if (i != '\n') goto Fail; i = fgetc (f1); if (! (feof (f1)) ) /* ensure end-of-file reached */ goto Fail; j = ungetc (i, f1); /* not an error to try to push */ if (j != EOF) /* back EOF */ goto Fail; j = fseek (f1, 0L, SEEK_SET); /* test getc with temp file */ if (j) goto Fail3; j = ungetc (i, f1); /* ungetc should return an error */ if (j != EOF) /* after seeking on the file */ goto Fail; /* before reading */ for (ch = 'a', i = 0; i < 26; i++) { j = getc (f1); if ( (char) j != ch++ ) goto Fail; } i = ungetc ('L', f1); /* test ungetc */ if (i != 'L') goto Fail; i = fgetc (f1); if (i != 'L') goto Fail; i = getc (f1); if (i != '\n') goto Fail; i = getc (f1); if (! (feof (f1)) ) /* ensure end-of-file reached */ goto Fail; j = ungetc (i, f1); /* not an error to try to push */ if (j != EOF) /* back EOF */ goto Fail; i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail4; printf ("Passed Conformance Test 17.6.0.1\n"); return; Fail: printf ("Failed Conformance Test 17.6.0.1\n"); return; Fail1: printf ("Unable to open temp file for Conformance Test 17.6.0.1\n"); return; Fail2: printf ("Unable to write to temp file for Conformance Test 17.6.0.1\n"); return; Fail3: printf ("Unable to seek to temp file for Conformance Test 17.6.0.1\n"); return; Fail4: printf ("Unable to close temp file for Conformance Test 17.6.0.1\n"); return; } \ No newline at end of file +/* Conformance Test 17.6.0.1: Verification of fgetc, getc, and ungetc with */ +/* a text stream */ + +#include + +main () + { + FILE *f1; + int i, j; + char ch; + + + f1 = fopen ("3/tmp", "w+"); /* create text file to work on */ + if (f1 == NULL) + goto Fail1; + for (ch = 'a', i = 0; i < 26; i++) + { + j = fputc (ch, f1); + if ((char) j != ch) + goto Fail2; + ch++; + } + j = fputc ('\r', f1); /* text files end with return */ + if (j != '\r') + goto Fail2; + + rewind (f1); /* check file contents with fgetc */ + for (ch = 'a', i = 0; i < 26; i++) + { + j = fgetc (f1); + if ( (char) j != ch++ ) + goto Fail; + } + + i = ungetc ('F', f1); /* test ungetc */ + if (i != 'F') + goto Fail; + i = fgetc (f1); + if (i != 'F') + goto Fail; + + i = fgetc (f1); + if (i != '\n') + goto Fail; + i = fgetc (f1); + if (! (feof (f1)) ) /* ensure end-of-file reached */ + goto Fail; + j = ungetc (i, f1); /* not an error to try to push */ + if (j != EOF) /* back EOF */ + goto Fail; + + j = fseek (f1, 0L, SEEK_SET); /* test getc with temp file */ + if (j) + goto Fail3; + j = ungetc (i, f1); /* ungetc should return an error */ + if (j != EOF) /* after seeking on the file */ + goto Fail; /* before reading */ + for (ch = 'a', i = 0; i < 26; i++) + { + j = getc (f1); + if ( (char) j != ch++ ) + goto Fail; + } + + i = ungetc ('L', f1); /* test ungetc */ + if (i != 'L') + goto Fail; + i = fgetc (f1); + if (i != 'L') + goto Fail; + + i = getc (f1); + if (i != '\n') + goto Fail; + i = getc (f1); + if (! (feof (f1)) ) /* ensure end-of-file reached */ + goto Fail; + j = ungetc (i, f1); /* not an error to try to push */ + if (j != EOF) /* back EOF */ + goto Fail; + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail4; + + printf ("Passed Conformance Test 17.6.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.6.0.1\n"); + return; + +Fail1: + printf ("Unable to open temp file for Conformance Test 17.6.0.1\n"); + return; + +Fail2: + printf ("Unable to write to temp file for Conformance Test 17.6.0.1\n"); + return; + +Fail3: + printf ("Unable to seek to temp file for Conformance Test 17.6.0.1\n"); + return; + +Fail4: + printf ("Unable to close temp file for Conformance Test 17.6.0.1\n"); + return; + } diff --git a/Tests/Conformance/C17.6.0.2.CC b/Tests/Conformance/C17.6.0.2.CC old mode 100755 new mode 100644 index 998c07b..e96dac3 --- a/Tests/Conformance/C17.6.0.2.CC +++ b/Tests/Conformance/C17.6.0.2.CC @@ -1 +1,77 @@ -/* Conformance Test 17.6.0.2: Verification of fgetc, getc, and ungetc with */ /* a binary stream */ #include main () { FILE *f1; int i, j; char ch; f1 = fopen ("3/tmp", "w+b"); /* create binary file to work on */ if (f1 == NULL) goto Fail1; for (ch = 'a', i = 0; i < 26; i++) { j = fputc (ch, f1); if ((char) j != ch) goto Fail2; ch++; } rewind (f1); /* check file contents with fgetc */ ch = 'a'; while ((i = fgetc (f1)) != EOF) if ( (char) i != ch++ ) goto Fail; if (! (feof (f1)) ) /* ensure end-of-file reached */ goto Fail; j = ungetc (i, f1); /* not an error to try to push */ if (j != EOF) /* back EOF */ goto Fail; j = fseek (f1, 0L, SEEK_SET); /* test getc with temp file */ if (j) goto Fail3; j = ungetc (i, f1); /* ungetc should return an error */ if (j != EOF) /* after seeking on the file */ goto Fail; /* before reading */ ch = 'a'; while ((i = getc (f1)) != EOF) if ( (char) i != ch++ ) goto Fail; if (! (feof (f1)) ) /* ensure end-of-file reached */ goto Fail; j = ungetc (i, f1); /* not an error to try to push */ if (j != EOF) /* back EOF */ goto Fail; i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail4; printf ("Passed Conformance Test 17.6.0.2\n"); return; Fail: printf ("Failed Conformance Test 17.6.0.2\n"); return; Fail1: printf ("Unable to open temp file for Conformance Test 17.6.0.2\n"); return; Fail2: printf ("Unable to write to temp file for Conformance Test 17.6.0.2\n"); return; Fail3: printf ("Unable to seek to temp file for Conformance Test 17.6.0.2\n"); return; Fail4: printf ("Unable to close temp file for Conformance Test 17.6.0.2\n"); return; } \ No newline at end of file +/* Conformance Test 17.6.0.2: Verification of fgetc, getc, and ungetc with */ +/* a binary stream */ + +#include + +main () + { + FILE *f1; + int i, j; + char ch; + + + f1 = fopen ("3/tmp", "w+b"); /* create binary file to work on */ + if (f1 == NULL) + goto Fail1; + for (ch = 'a', i = 0; i < 26; i++) + { + j = fputc (ch, f1); + if ((char) j != ch) + goto Fail2; + ch++; + } + + rewind (f1); /* check file contents with fgetc */ + ch = 'a'; + while ((i = fgetc (f1)) != EOF) + if ( (char) i != ch++ ) + goto Fail; + if (! (feof (f1)) ) /* ensure end-of-file reached */ + goto Fail; + j = ungetc (i, f1); /* not an error to try to push */ + if (j != EOF) /* back EOF */ + goto Fail; + + j = fseek (f1, 0L, SEEK_SET); /* test getc with temp file */ + if (j) + goto Fail3; + j = ungetc (i, f1); /* ungetc should return an error */ + if (j != EOF) /* after seeking on the file */ + goto Fail; /* before reading */ + ch = 'a'; + while ((i = getc (f1)) != EOF) + if ( (char) i != ch++ ) + goto Fail; + if (! (feof (f1)) ) /* ensure end-of-file reached */ + goto Fail; + j = ungetc (i, f1); /* not an error to try to push */ + if (j != EOF) /* back EOF */ + goto Fail; + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail4; + + printf ("Passed Conformance Test 17.6.0.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.6.0.2\n"); + return; + +Fail1: + printf ("Unable to open temp file for Conformance Test 17.6.0.2\n"); + return; + +Fail2: + printf ("Unable to write to temp file for Conformance Test 17.6.0.2\n"); + return; + +Fail3: + printf ("Unable to seek to temp file for Conformance Test 17.6.0.2\n"); + return; + +Fail4: + printf ("Unable to close temp file for Conformance Test 17.6.0.2\n"); + return; + } diff --git a/Tests/Conformance/C17.7.0.1.CC b/Tests/Conformance/C17.7.0.1.CC old mode 100755 new mode 100644 index 441016f..22040dd --- a/Tests/Conformance/C17.7.0.1.CC +++ b/Tests/Conformance/C17.7.0.1.CC @@ -1 +1,80 @@ -/* Conformance Test 17.7.0.1: Verification of fgets function, text stream */ #include main () { FILE *f1; int i; char string [80] = ""; /* initialize input string to null string */ char *strPtr; f1 = fopen ("3/tmp", "w+"); /* create text file to work on */ if (f1 == NULL) goto Fail1; i = fputs ("Every good boy deserves favor\n", f1); if (i) goto Fail2; rewind (f1); /* test reading until '\n' seen */ strPtr = fgets (string, 100, f1); if (strPtr == NULL) goto Fail; if (strcmp ("Every good boy deserves favor\n", string)) goto Fail; fgetc(f1); /* force an EOF condition */ strPtr = fgets (string, 100, f1); /* test reading with EOF seen before */ if (strPtr != NULL) /* any other characters */ goto Fail; if (! (feof (f1)) ) goto Fail; if (strcmp ("Every good boy deserves favor\n", string)) goto Fail; rewind (f1); /* test reading until n-1 chars seen */ strPtr = fgets (string, 15, f1); if (strPtr == NULL) goto Fail; if (strcmp ("Every good boy", string)) goto Fail; strPtr = fgets (string, 17, f1); /* ensure fgets moves internal file */ if (strPtr == NULL) /* pointer */ goto Fail; if (strcmp (" deserves favor\n", string)) goto Fail; fgetc(f1); /* force an EOF condition */ strPtr = fgets (string, 100, f1); /* test reading with EOF seen before */ if (strPtr != NULL) /* any other characters */ goto Fail; if (! (feof (f1)) ) goto Fail; if (strcmp (" deserves favor\n", string)) goto Fail; i = fclose (f1); /* close file and quit */ if (i) goto Fail3; printf ("Passed Conformance Test 17.7.0.1\n"); return; Fail: printf ("Failed Conformance Test 17.7.0.1\n"); return; Fail1: printf ("Unable to open temp file for Conformance Test 17.7.0.1\n"); return; Fail2: printf ("Unable to write to temp file for Conformance Test 17.7.0.1\n"); return; Fail3: printf ("Unable to close temp file for Conformance Test 17.7.0.1\n"); return; } \ No newline at end of file +/* Conformance Test 17.7.0.1: Verification of fgets function, text stream */ + +#include + +main () + { + FILE *f1; + int i; + char string [80] = ""; /* initialize input string to null string */ + char *strPtr; + + + f1 = fopen ("3/tmp", "w+"); /* create text file to work on */ + if (f1 == NULL) + goto Fail1; + i = fputs ("Every good boy deserves favor\n", f1); + if (i) + goto Fail2; + + rewind (f1); /* test reading until '\n' seen */ + strPtr = fgets (string, 100, f1); + if (strPtr == NULL) + goto Fail; + if (strcmp ("Every good boy deserves favor\n", string)) + goto Fail; + + fgetc(f1); /* force an EOF condition */ + strPtr = fgets (string, 100, f1); /* test reading with EOF seen before */ + if (strPtr != NULL) /* any other characters */ + goto Fail; + if (! (feof (f1)) ) + goto Fail; + if (strcmp ("Every good boy deserves favor\n", string)) + goto Fail; + + rewind (f1); /* test reading until n-1 chars seen */ + strPtr = fgets (string, 15, f1); + if (strPtr == NULL) + goto Fail; + if (strcmp ("Every good boy", string)) + goto Fail; + + strPtr = fgets (string, 17, f1); /* ensure fgets moves internal file */ + if (strPtr == NULL) /* pointer */ + goto Fail; + if (strcmp (" deserves favor\n", string)) + goto Fail; + + fgetc(f1); /* force an EOF condition */ + strPtr = fgets (string, 100, f1); /* test reading with EOF seen before */ + if (strPtr != NULL) /* any other characters */ + goto Fail; + if (! (feof (f1)) ) + goto Fail; + if (strcmp (" deserves favor\n", string)) + goto Fail; + + i = fclose (f1); /* close file and quit */ + if (i) + goto Fail3; + + printf ("Passed Conformance Test 17.7.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.7.0.1\n"); + return; + +Fail1: + printf ("Unable to open temp file for Conformance Test 17.7.0.1\n"); + return; + +Fail2: + printf ("Unable to write to temp file for Conformance Test 17.7.0.1\n"); + return; + +Fail3: + printf ("Unable to close temp file for Conformance Test 17.7.0.1\n"); + return; + } diff --git a/Tests/Conformance/C17.7.0.2.CC b/Tests/Conformance/C17.7.0.2.CC old mode 100755 new mode 100644 index e7280e6..5045c75 --- a/Tests/Conformance/C17.7.0.2.CC +++ b/Tests/Conformance/C17.7.0.2.CC @@ -1 +1,80 @@ -/* Conformance Test 17.7.0.2: Verification of fgets function, binary stream */ #include main () { FILE *f1; int i; char string [80] = ""; /* initialize input string to null string */ char *strPtr; f1 = fopen ("3/tmp", "w+b"); /* create binary file to work on */ if (f1 == NULL) goto Fail1; i = fputs ("Every good boy deserves favor\n", f1); if (i) goto Fail2; rewind (f1); /* test reading until '\n' seen */ strPtr = fgets (string, 100, f1); if (strPtr == NULL) goto Fail; if (strcmp ("Every good boy deserves favor\n", string)) goto Fail; fgetc(f1); /* force an EOF condition */ strPtr = fgets (string, 100, f1); /* test reading with EOF seen before */ if (strPtr != NULL) /* any other characters */ goto Fail; if (! (feof (f1)) ) goto Fail; if (strcmp ("Every good boy deserves favor\n", string)) goto Fail; rewind (f1); /* test reading until n-1 chars seen */ strPtr = fgets (string, 15, f1); if (strPtr == NULL) goto Fail; if (strcmp ("Every good boy", string)) goto Fail; strPtr = fgets (string, 17, f1); /* ensure fgets moves internal file */ if (strPtr == NULL) /* pointer */ goto Fail; if (strcmp (" deserves favor\n", string)) goto Fail; fgetc(f1); /* force an EOF condition */ strPtr = fgets (string, 100, f1); /* test reading with EOF seen before */ if (strPtr != NULL) /* any other characters */ goto Fail; if (! (feof (f1)) ) goto Fail; if (strcmp (" deserves favor\n", string)) goto Fail; i = fclose (f1); /* close file and quit */ if (i) goto Fail3; printf ("Passed Conformance Test 17.7.0.2\n"); return; Fail: printf ("Failed Conformance Test 17.7.0.2\n"); return; Fail1: printf ("Unable to open temp file for Conformance Test 17.7.0.2\n"); return; Fail2: printf ("Unable to write to temp file for Conformance Test 17.7.0.2\n"); return; Fail3: printf ("Unable to close temp file for Conformance Test 17.7.0.2\n"); return; } \ No newline at end of file +/* Conformance Test 17.7.0.2: Verification of fgets function, binary stream */ + +#include + +main () + { + FILE *f1; + int i; + char string [80] = ""; /* initialize input string to null string */ + char *strPtr; + + + f1 = fopen ("3/tmp", "w+b"); /* create binary file to work on */ + if (f1 == NULL) + goto Fail1; + i = fputs ("Every good boy deserves favor\n", f1); + if (i) + goto Fail2; + + rewind (f1); /* test reading until '\n' seen */ + strPtr = fgets (string, 100, f1); + if (strPtr == NULL) + goto Fail; + if (strcmp ("Every good boy deserves favor\n", string)) + goto Fail; + + fgetc(f1); /* force an EOF condition */ + strPtr = fgets (string, 100, f1); /* test reading with EOF seen before */ + if (strPtr != NULL) /* any other characters */ + goto Fail; + if (! (feof (f1)) ) + goto Fail; + if (strcmp ("Every good boy deserves favor\n", string)) + goto Fail; + + rewind (f1); /* test reading until n-1 chars seen */ + strPtr = fgets (string, 15, f1); + if (strPtr == NULL) + goto Fail; + if (strcmp ("Every good boy", string)) + goto Fail; + + strPtr = fgets (string, 17, f1); /* ensure fgets moves internal file */ + if (strPtr == NULL) /* pointer */ + goto Fail; + if (strcmp (" deserves favor\n", string)) + goto Fail; + + fgetc(f1); /* force an EOF condition */ + strPtr = fgets (string, 100, f1); /* test reading with EOF seen before */ + if (strPtr != NULL) /* any other characters */ + goto Fail; + if (! (feof (f1)) ) + goto Fail; + if (strcmp (" deserves favor\n", string)) + goto Fail; + + i = fclose (f1); /* close file and quit */ + if (i) + goto Fail3; + + printf ("Passed Conformance Test 17.7.0.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.7.0.2\n"); + return; + +Fail1: + printf ("Unable to open temp file for Conformance Test 17.7.0.2\n"); + return; + +Fail2: + printf ("Unable to write to temp file for Conformance Test 17.7.0.2\n"); + return; + +Fail3: + printf ("Unable to close temp file for Conformance Test 17.7.0.2\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.1.CC b/Tests/Conformance/C17.8.0.1.CC old mode 100755 new mode 100644 index 835d6a0..8a626b5 --- a/Tests/Conformance/C17.8.0.1.CC +++ b/Tests/Conformance/C17.8.0.1.CC @@ -1 +1,90 @@ -/* Conformance Test 17.8.0.1: Verification of fscanf, d format code */ #include main () { FILE *f1; short i1; int i; int i2, i3; long L1; char ch; f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ if (f1 == NULL) goto Fail1; fprintf(f1, " +327678 - -002147483647A 327677-22 123*\r"); rewind(f1); i1 = 0; /* test format string of no */ i = fscanf (f1, "%*05hd8"); /* assignment, max. field */ if (i != 0) /* width of 5, h ignored, */ goto Fail; /* character 8 must appear*/ if (i1 != 0) /* after 5 digits read */ goto Fail; i2 = 15; /* test "plain vanilla" fmt */ i = fscanf (f1, "%d", &i2); /* string; data contains */ if (i != 1) /* a single minus sign */ goto Fail; if (i2 != 0) goto Fail; L1 = 0; /* test format string of */ i = fscanf (f1, "%12ldA", &L1); /* max. field width of 12,*/ if (i != 1) /* long variable expected,*/ goto Fail; /* character A must appear*/ if (L1 != -2147483647) /* after digits read */ goto Fail; L1 = 0; /* test format string of */ i = fscanf (f1, "%6ld%d", &L1, &i2); /* max. field width of 6, */ if (i != 2) /* long variable expected,*/ goto Fail; /* followed by simple fmt */ if ((L1 != 327677) || (i2 != -22)) /* for integer */ goto Fail; i3 = 4; /* test format string of */ i = fscanf (f1, "%4hd", &i3); /* max. field width of 4, */ if (i != 1) /* short variable expectd.*/ goto Fail; /* * appears in input as */ if (i3 != 123) /* 4th char. */ goto Fail; i = fscanf (f1, "%c", &ch); /* Ensure offending * has */ if (i != 1) /* been left in input. */ goto Fail; if (ch != '*') goto Fail; i = fscanf (f1, "%c", &ch); /* Ensure fscanf returns EOF*/ if (i != 1) /* when EOF encountered. */ goto Fail; if (ch != '\r') goto Fail; fgetc(f1); i = fscanf (f1, "%c", &ch); if (i != EOF) goto Fail; i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.8.0.1\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.1\n"); return; Fail1: printf ("Unable to open input file for Conformance Test 17.8.0.1\n"); return; Fail2: printf ("Unable to close input file for Conformance Test 17.8.0.1\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.1: Verification of fscanf, d format code */ + +#include + +main () + { + FILE *f1; + short i1; + int i; + int i2, i3; + long L1; + char ch; + + + f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ + if (f1 == NULL) + goto Fail1; + fprintf(f1, " +327678 - -002147483647A 327677-22 123*\r"); + rewind(f1); + + i1 = 0; /* test format string of no */ + i = fscanf (f1, "%*05hd8"); /* assignment, max. field */ + if (i != 0) /* width of 5, h ignored, */ + goto Fail; /* character 8 must appear*/ + if (i1 != 0) /* after 5 digits read */ + goto Fail; + + i2 = 15; /* test "plain vanilla" fmt */ + i = fscanf (f1, "%d", &i2); /* string; data contains */ + if (i != 1) /* a single minus sign */ + goto Fail; + if (i2 != 0) + goto Fail; + + L1 = 0; /* test format string of */ + i = fscanf (f1, "%12ldA", &L1); /* max. field width of 12,*/ + if (i != 1) /* long variable expected,*/ + goto Fail; /* character A must appear*/ + if (L1 != -2147483647) /* after digits read */ + goto Fail; + + L1 = 0; /* test format string of */ + i = fscanf (f1, "%6ld%d", &L1, &i2); /* max. field width of 6, */ + if (i != 2) /* long variable expected,*/ + goto Fail; /* followed by simple fmt */ + if ((L1 != 327677) || (i2 != -22)) /* for integer */ + goto Fail; + + i3 = 4; /* test format string of */ + i = fscanf (f1, "%4hd", &i3); /* max. field width of 4, */ + if (i != 1) /* short variable expectd.*/ + goto Fail; /* * appears in input as */ + if (i3 != 123) /* 4th char. */ + goto Fail; + + i = fscanf (f1, "%c", &ch); /* Ensure offending * has */ + if (i != 1) /* been left in input. */ + goto Fail; + if (ch != '*') + goto Fail; + + i = fscanf (f1, "%c", &ch); /* Ensure fscanf returns EOF*/ + if (i != 1) /* when EOF encountered. */ + goto Fail; + if (ch != '\r') + goto Fail; + fgetc(f1); + i = fscanf (f1, "%c", &ch); + if (i != EOF) + goto Fail; + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.8.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.1\n"); + return; + +Fail1: + printf ("Unable to open input file for Conformance Test 17.8.0.1\n"); + return; + +Fail2: + printf ("Unable to close input file for Conformance Test 17.8.0.1\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.10.CC b/Tests/Conformance/C17.8.0.10.CC old mode 100755 new mode 100644 index 6b7756c..76a2d76 --- a/Tests/Conformance/C17.8.0.10.CC +++ b/Tests/Conformance/C17.8.0.10.CC @@ -1 +1,45 @@ -/* Conformance Test 17.8.0.10: Verification of sscanf, u format code */ #include main () { char string [] = " 327678 D 4294967295m 32767722 "; int i; unsigned short us1; unsigned int ui1; unsigned long ul1; ui1 = 2; /* test format string of no */ i = sscanf (string, "%*05hu8"); /* assignment, max. field */ if (i != 0) /* width of 5, h ignored, */ goto Fail; /* character 8 must appear*/ if (ui1 != 2) /* after 5 digits read */ goto Fail; i = sscanf (&string [8], "%u", &ui1); /* test "plain vanilla" fmt */ if (i != 0) /* string; data contains */ goto Fail; /* the character 'D' */ ul1 = 0; /* test fmt string of max */ i = sscanf (&string [11], " D %12ldm", &ul1); /* field width of 12, */ if (i != 1) /* long variable expected,*/ goto Fail; /* character m must appear*/ if (ul1 != 4294967295u) /* after digits read */ goto Fail; ul1 = 0; /* test fmt string of max */ i = sscanf (&string [27], "%6lu%u", &ul1, &ui1); /* field width of 6, */ if (i != 2) /* long variable expected,*/ goto Fail; /* followed by simple fmt */ if ((ul1 != 327677) || (ui1 != 22)) /* for integer */ goto Fail; printf ("Passed Conformance Test 17.8.0.10\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.10\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.10: Verification of sscanf, u format code */ + +#include + +main () + { + char string [] = " 327678 D 4294967295m 32767722 "; + int i; + unsigned short us1; + unsigned int ui1; + unsigned long ul1; + + + ui1 = 2; /* test format string of no */ + i = sscanf (string, "%*05hu8"); /* assignment, max. field */ + if (i != 0) /* width of 5, h ignored, */ + goto Fail; /* character 8 must appear*/ + if (ui1 != 2) /* after 5 digits read */ + goto Fail; + + i = sscanf (&string [8], "%u", &ui1); /* test "plain vanilla" fmt */ + if (i != 0) /* string; data contains */ + goto Fail; /* the character 'D' */ + + ul1 = 0; /* test fmt string of max */ + i = sscanf (&string [11], " D %12ldm", &ul1); /* field width of 12, */ + if (i != 1) /* long variable expected,*/ + goto Fail; /* character m must appear*/ + if (ul1 != 4294967295u) /* after digits read */ + goto Fail; + + ul1 = 0; /* test fmt string of max */ + i = sscanf (&string [27], "%6lu%u", &ul1, &ui1); /* field width of 6, */ + if (i != 2) /* long variable expected,*/ + goto Fail; /* followed by simple fmt */ + if ((ul1 != 327677) || (ui1 != 22)) /* for integer */ + goto Fail; + + printf ("Passed Conformance Test 17.8.0.10\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.10\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.11.CC b/Tests/Conformance/C17.8.0.11.CC old mode 100755 new mode 100644 index 777a62b..f393e3b --- a/Tests/Conformance/C17.8.0.11.CC +++ b/Tests/Conformance/C17.8.0.11.CC @@ -1 +1,45 @@ -/* Conformance Test 17.8.0.11: Verification of sscanf, o format code */ #include main () { char string [] = " 777778 D 37777777777m 117777526 "; int i; unsigned short us1; unsigned int ui1; unsigned long ul1; us1 = 2; /* test format string of no */ i = sscanf (string, "%*05ho8"); /* assignment, max. field */ if (i != 0) /* width of 5, h ignored, */ goto Fail; /* character 8 must appear*/ if (us1 != 2) /* after 5 digits read */ goto Fail; i = sscanf (&string [9], "%o", &ui1); /* test "plain vanilla" fmt */ if (i != 0) /* string; data contains */ goto Fail; /* the character 'D' */ ul1 = 0; /* test fmt string of max */ i = sscanf (&string [11], "D %12lom", &ul1); /* field width of 12, */ if (i != 1) /* long variable expected,*/ goto Fail; /* character m must appear*/ if (ul1 != 4294967295u) /* after digits read */ goto Fail; ul1 = 0; /* test fmt string of max */ i = sscanf (&string [31], "%7lo%o", &ul1, &ui1); /* field width of 6, */ if (i != 2) /* long variable expected,*/ goto Fail; /* followed by simple fmt */ if ((ul1 != 327677) || (ui1 != 22)) /* for integer */ goto Fail; printf ("Passed Conformance Test 17.8.0.11\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.11\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.11: Verification of sscanf, o format code */ + +#include + +main () + { + char string [] = " 777778 D 37777777777m 117777526 "; + int i; + unsigned short us1; + unsigned int ui1; + unsigned long ul1; + + + us1 = 2; /* test format string of no */ + i = sscanf (string, "%*05ho8"); /* assignment, max. field */ + if (i != 0) /* width of 5, h ignored, */ + goto Fail; /* character 8 must appear*/ + if (us1 != 2) /* after 5 digits read */ + goto Fail; + + i = sscanf (&string [9], "%o", &ui1); /* test "plain vanilla" fmt */ + if (i != 0) /* string; data contains */ + goto Fail; /* the character 'D' */ + + ul1 = 0; /* test fmt string of max */ + i = sscanf (&string [11], "D %12lom", &ul1); /* field width of 12, */ + if (i != 1) /* long variable expected,*/ + goto Fail; /* character m must appear*/ + if (ul1 != 4294967295u) /* after digits read */ + goto Fail; + + ul1 = 0; /* test fmt string of max */ + i = sscanf (&string [31], "%7lo%o", &ul1, &ui1); /* field width of 6, */ + if (i != 2) /* long variable expected,*/ + goto Fail; /* followed by simple fmt */ + if ((ul1 != 327677) || (ui1 != 22)) /* for integer */ + goto Fail; + + printf ("Passed Conformance Test 17.8.0.11\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.11\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.12.CC b/Tests/Conformance/C17.8.0.12.CC old mode 100755 new mode 100644 index 368d325..6f54481 --- a/Tests/Conformance/C17.8.0.12.CC +++ b/Tests/Conformance/C17.8.0.12.CC @@ -1 +1,47 @@ -/* Conformance Test 17.8.0.12: Verification of sscanf, x,X format codes */ #include main () { char string [] = " 327678 0x D 0xFFFFFFFFm 0x7fEd0X10 "; int i; unsigned short us1; unsigned int ui1; unsigned long ul1; us1 = 2; /* test format string of no */ i = sscanf (string, "%*05hx8"); /* assignment, max. field */ if (i != 0) /* width of 5, h ignored, */ goto Fail; /* character 8 must appear*/ if (us1 != 2) /* after 5 digits read */ goto Fail; i = sscanf (&string [8], "%X", &ui1); /* test "plain vanilla" fmt */ if (i != 1) /* string; data contains */ goto Fail; /* the characters 0x */ if (ui1 != 0) goto Fail; ul1 = 0; /* test fmt string of max */ i = sscanf (&string [12], " D %12lxm", &ul1); /* field width of 12,*/ if (i != 1) /* long variable expected,*/ goto Fail; /* character m must appear*/ if (ul1 != 4294967295u) /* after digits read */ goto Fail; ul1 = 0; /* test fmt string of max */ i = sscanf (&string [30], "%6lx%x", &ul1, &ui1); /* field width of 6, */ if (i != 2) /* long variable expected,*/ goto Fail; /* followed by simple fmt */ if ((ul1 != 0x7FED) || (ui1 != 16)) /* for integer */ goto Fail; printf ("Passed Conformance Test 17.8.0.12\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.12\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.12: Verification of sscanf, x,X format codes */ + +#include + +main () + { + char string [] = " 327678 0x D 0xFFFFFFFFm 0x7fEd0X10 "; + int i; + unsigned short us1; + unsigned int ui1; + unsigned long ul1; + + + us1 = 2; /* test format string of no */ + i = sscanf (string, "%*05hx8"); /* assignment, max. field */ + if (i != 0) /* width of 5, h ignored, */ + goto Fail; /* character 8 must appear*/ + if (us1 != 2) /* after 5 digits read */ + goto Fail; + + i = sscanf (&string [8], "%X", &ui1); /* test "plain vanilla" fmt */ + if (i != 1) /* string; data contains */ + goto Fail; /* the characters 0x */ + if (ui1 != 0) + goto Fail; + + ul1 = 0; /* test fmt string of max */ + i = sscanf (&string [12], " D %12lxm", &ul1); /* field width of 12,*/ + if (i != 1) /* long variable expected,*/ + goto Fail; /* character m must appear*/ + if (ul1 != 4294967295u) /* after digits read */ + goto Fail; + + ul1 = 0; /* test fmt string of max */ + i = sscanf (&string [30], "%6lx%x", &ul1, &ui1); /* field width of 6, */ + if (i != 2) /* long variable expected,*/ + goto Fail; /* followed by simple fmt */ + if ((ul1 != 0x7FED) || (ui1 != 16)) /* for integer */ + goto Fail; + + printf ("Passed Conformance Test 17.8.0.12\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.12\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.13.CC b/Tests/Conformance/C17.8.0.13.CC old mode 100755 new mode 100644 index 8d7a027..ac08d54 --- a/Tests/Conformance/C17.8.0.13.CC +++ b/Tests/Conformance/C17.8.0.13.CC @@ -1 +1,32 @@ -/* Conformance Test 17.8.0.13: Verification of sscanf, c format code */ #include #include main () { char sstr [] = "bten chars!andMore"; int i; char ch, string [50]; ch = 'a'; /* no assignment should be made */ i = sscanf (sstr, "%*hc"); /* h ignored */ if (i != 0) goto Fail; if (ch != 'a') goto Fail; i = sscanf (&sstr [1], "%10lc", string); /* test assignment to string*/ if (i != 1) /* l ignored */ goto Fail; if (strncmp (string, "ten chars!", 10)) goto Fail; printf ("Passed Conformance Test 17.8.0.13\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.13\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.13: Verification of sscanf, c format code */ + +#include +#include + +main () + { + char sstr [] = "bten chars!andMore"; + int i; + char ch, string [50]; + + + ch = 'a'; /* no assignment should be made */ + i = sscanf (sstr, "%*hc"); /* h ignored */ + if (i != 0) + goto Fail; + if (ch != 'a') + goto Fail; + + i = sscanf (&sstr [1], "%10lc", string); /* test assignment to string*/ + if (i != 1) /* l ignored */ + goto Fail; + if (strncmp (string, "ten chars!", 10)) + goto Fail; + + printf ("Passed Conformance Test 17.8.0.13\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.13\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.14.CC b/Tests/Conformance/C17.8.0.14.CC old mode 100755 new mode 100644 index 19c68ef..3b65a8c --- a/Tests/Conformance/C17.8.0.14.CC +++ b/Tests/Conformance/C17.8.0.14.CC @@ -1 +1,30 @@ -/* Conformance Test 17.8.0.14: Verification of sscanf, s format code */ #include main () { char sstr [] = " oneLongWord ten-chars!andMore"; int i, j; char string [50] = "hey, hey!"; i = sscanf (&sstr[0], "%*hs"); /* no assignment made; h ignored */ if (i != 0) goto Fail; if (strcmp (string, "hey, hey!")) goto Fail; i = sscanf (&sstr [14], "%10ls", string); /* test assignment to string*/ if (i != 1) /* l ignored */ goto Fail; if (strcmp (string, "ten-chars!")) goto Fail; printf ("Passed Conformance Test 17.8.0.14\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.14\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.14: Verification of sscanf, s format code */ + +#include + +main () + { + char sstr [] = " oneLongWord ten-chars!andMore"; + int i, j; + char string [50] = "hey, hey!"; + + + i = sscanf (&sstr[0], "%*hs"); /* no assignment made; h ignored */ + if (i != 0) + goto Fail; + if (strcmp (string, "hey, hey!")) + goto Fail; + + i = sscanf (&sstr [14], "%10ls", string); /* test assignment to string*/ + if (i != 1) /* l ignored */ + goto Fail; + if (strcmp (string, "ten-chars!")) + goto Fail; + + printf ("Passed Conformance Test 17.8.0.14\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.14\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.15.CC b/Tests/Conformance/C17.8.0.15.CC old mode 100755 new mode 100644 index 691c369..ed8abf2 --- a/Tests/Conformance/C17.8.0.15.CC +++ b/Tests/Conformance/C17.8.0.15.CC @@ -1 +1,35 @@ -/* Conformance Test 17.8.0.15: Verification of fscanf, f e E g G format codes */ #include #include main () { char sstr [] = " 23 -3.8E20 - e- +25e- 00002.00008e000049.9 "; float f1, f2, f3, f4; double d1, d2, d3; int i; f1 = f2 = f3 = f4 = 1.0; d1 = d2 = d3 = 1.0; i = sscanf (&sstr[0], "%*07f %e %E %lg %30lG %17lf%e", &f2, &f3, &d1, &d2, &d3, &f4); if (i != 6) goto Fail; if ((fabs(f1 - 1.0) > 0.00001) || (fabs(f2 - (-3.8E20)) > 1e15) || (fabs(f3) > 0.00001) || (fabs(f4 - 9.9) > 0.00001) || (fabs(d1) > 0.00001) || (fabs(d2 - 25.0) > 0.00001) || (fabs(d3 - 2.00008e4) > 0.00001)) goto Fail; printf ("Passed Conformance Test 17.8.0.15\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.15\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.15: Verification of fscanf, f e E g G format codes */ + +#include +#include + +main () + { + char sstr [] = " 23 -3.8E20 - e- +25e- 00002.00008e000049.9 "; + float f1, f2, f3, f4; + double d1, d2, d3; + int i; + + + f1 = f2 = f3 = f4 = 1.0; + d1 = d2 = d3 = 1.0; + i = sscanf (&sstr[0], "%*07f %e %E %lg %30lG %17lf%e", &f2, &f3, &d1, &d2, + &d3, &f4); + if (i != 6) + goto Fail; + if ((fabs(f1 - 1.0) > 0.00001) || + (fabs(f2 - (-3.8E20)) > 1e15) || + (fabs(f3) > 0.00001) || + (fabs(f4 - 9.9) > 0.00001) || + (fabs(d1) > 0.00001) || + (fabs(d2 - 25.0) > 0.00001) || + (fabs(d3 - 2.00008e4) > 0.00001)) + goto Fail; + + printf ("Passed Conformance Test 17.8.0.15\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.15\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.16.CC b/Tests/Conformance/C17.8.0.16.CC old mode 100755 new mode 100644 index 2140385..92da4c8 --- a/Tests/Conformance/C17.8.0.16.CC +++ b/Tests/Conformance/C17.8.0.16.CC @@ -1 +1,43 @@ -/* Conformance Test 17.8.0.16: Verification of sscanf, % and [ format codes */ #include main () { char sstr [] = "% these are the ^only[ characters" "*aaabbb a fine mess, you see! ddddfffffffff"; int i; char string [2] [50] = { {"hey, hey!"}, {"you, you"} }; i = sscanf (&sstr[0], "%*50h%"); /* no assignment made; * 50 h ignored */ if (i != 0) goto Fail; /* Create set of characters which can appear in the output string. */ i = sscanf (&sstr [1], "%45[thes aronlyc^[] %*[*ab]", &string [0]); if (i != 1) goto Fail; if (strcmp (&string [0], " these are the ^only[ characters")) goto Fail; /* Create set of characters which cannot appear in the output string. */ i = sscanf (&sstr [42], "%[^d] %10[df]", &string [0], &string [1]); if (i != 2) goto Fail; if (strcmp (&string [0], " a fine mess, you see! ")) goto Fail; if (strcmp (&string [1], "ddddffffff")) goto Fail; printf ("Passed Conformance Test 17.8.0.16\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.16\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.16: Verification of sscanf, % and [ format codes */ + +#include + +main () + { + char sstr [] = "% these are the ^only[ characters" + "*aaabbb a fine mess, you see! ddddfffffffff"; + int i; + char string [2] [50] = { {"hey, hey!"}, {"you, you"} }; + + + i = sscanf (&sstr[0], "%*50h%"); /* no assignment made; * 50 h ignored */ + if (i != 0) + goto Fail; + + + /* Create set of characters which can appear in the output string. */ + + i = sscanf (&sstr [1], "%45[thes aronlyc^[] %*[*ab]", &string [0]); + if (i != 1) + goto Fail; + if (strcmp (&string [0], " these are the ^only[ characters")) + goto Fail; + + + /* Create set of characters which cannot appear in the output string. */ + + i = sscanf (&sstr [42], "%[^d] %10[df]", &string [0], &string [1]); + if (i != 2) + goto Fail; + if (strcmp (&string [0], " a fine mess, you see! ")) + goto Fail; + if (strcmp (&string [1], "ddddffffff")) + goto Fail; + + printf ("Passed Conformance Test 17.8.0.16\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.16\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.17.CC b/Tests/Conformance/C17.8.0.17.CC old mode 100755 new mode 100644 index 3e7f327..0a90840 --- a/Tests/Conformance/C17.8.0.17.CC +++ b/Tests/Conformance/C17.8.0.17.CC @@ -1 +1,91 @@ -/* Conformance Test 17.8.0.17: Verification of scanf, d format code */ #include main () { short i1; int i; int i2, i3; long L1; char ch; FILE *f1; /* Redirect standard input to a data file. */ f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ if (f1 == NULL) goto Fail1; fprintf(f1, " +327678 - -002147483647A 327677-22 123*\r"); fclose(f1); stdin = freopen ("3/tmp", "r", stdin); if (stdin == NULL) goto Fail1; i1 = 0; /* test format string of no */ i = scanf ("%*05hd8"); /* assignment, max. field */ if (i != 0) /* width of 5, h ignored, */ goto Fail; /* character 8 must appear*/ if (i1 != 0) /* after 5 digits read */ goto Fail; i2 = 15; /* test "plain vanilla" fmt */ i = scanf ("%d", &i2); /* string; data contains */ if (i != 1) /* a single minus sign */ goto Fail; if (i2 != 0) goto Fail; L1 = 0; /* test format string of */ i = scanf ("%12ldA", &L1); /* max. field width of 12,*/ if (i != 1) /* long variable expected,*/ goto Fail; /* character A must appear*/ if (L1 != -2147483647) /* after digits read */ goto Fail; L1 = 0; /* test format string of */ i = scanf ("%6ld%d", &L1, &i2); /* max. field width of 6, */ if (i != 2) /* long variable expected,*/ goto Fail; /* followed by simple fmt */ if ((L1 != 327677) || (i2 != -22)) /* for integer */ goto Fail; i3 = 4; /* test format string of */ i = scanf ("%4hd", &i3); /* max. field width of 4, */ if (i != 1) /* short variable expectd,*/ goto Fail; /* character * must appear*/ if (i3 != 123) /* after digits read. In */ goto Fail; /* the input, the number */ /* of digits is only 3. */ i = scanf ("%c", &ch); /* Ensure offending * has */ if (i != 1) /* been left in input. */ goto Fail; if (ch != '*') goto Fail; i = scanf ("%c", &ch); /* Ensure scanf returns EOF */ if (i != 1) /* when EOF encountered. */ goto Fail; if (ch != '\n') goto Fail; i = scanf ("%c", &ch); if (i != EOF) goto Fail; stdin = freopen (".CONSOLE", "r", stdin); /* reset stdin and quit */ if (stdin == NULL) goto Fail1; printf ("Passed Conformance Test 17.8.0.17\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.17\n"); return; Fail1: printf ("Unable to redirect stdin for Conformance Test 17.8.0.17\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.17: Verification of scanf, d format code */ + +#include + +main () + { + short i1; + int i; + int i2, i3; + long L1; + char ch; + FILE *f1; + + + /* Redirect standard input to a data file. */ + + f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ + if (f1 == NULL) + goto Fail1; + fprintf(f1, " +327678 - -002147483647A 327677-22 123*\r"); + fclose(f1); + + stdin = freopen ("3/tmp", "r", stdin); + if (stdin == NULL) + goto Fail1; + + i1 = 0; /* test format string of no */ + i = scanf ("%*05hd8"); /* assignment, max. field */ + if (i != 0) /* width of 5, h ignored, */ + goto Fail; /* character 8 must appear*/ + if (i1 != 0) /* after 5 digits read */ + goto Fail; + + i2 = 15; /* test "plain vanilla" fmt */ + i = scanf ("%d", &i2); /* string; data contains */ + if (i != 1) /* a single minus sign */ + goto Fail; + if (i2 != 0) + goto Fail; + + L1 = 0; /* test format string of */ + i = scanf ("%12ldA", &L1); /* max. field width of 12,*/ + if (i != 1) /* long variable expected,*/ + goto Fail; /* character A must appear*/ + if (L1 != -2147483647) /* after digits read */ + goto Fail; + + L1 = 0; /* test format string of */ + i = scanf ("%6ld%d", &L1, &i2); /* max. field width of 6, */ + if (i != 2) /* long variable expected,*/ + goto Fail; /* followed by simple fmt */ + if ((L1 != 327677) || (i2 != -22)) /* for integer */ + goto Fail; + + i3 = 4; /* test format string of */ + i = scanf ("%4hd", &i3); /* max. field width of 4, */ + if (i != 1) /* short variable expectd,*/ + goto Fail; /* character * must appear*/ + if (i3 != 123) /* after digits read. In */ + goto Fail; /* the input, the number */ + /* of digits is only 3. */ + i = scanf ("%c", &ch); /* Ensure offending * has */ + if (i != 1) /* been left in input. */ + goto Fail; + if (ch != '*') + goto Fail; + + i = scanf ("%c", &ch); /* Ensure scanf returns EOF */ + if (i != 1) /* when EOF encountered. */ + goto Fail; + if (ch != '\n') + goto Fail; + i = scanf ("%c", &ch); + if (i != EOF) + goto Fail; + + stdin = freopen (".CONSOLE", "r", stdin); /* reset stdin and quit */ + if (stdin == NULL) + goto Fail1; + + printf ("Passed Conformance Test 17.8.0.17\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.17\n"); + return; + +Fail1: + printf ("Unable to redirect stdin for Conformance Test 17.8.0.17\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.18.CC b/Tests/Conformance/C17.8.0.18.CC old mode 100755 new mode 100644 index 0a7d7cc..e70d6e2 --- a/Tests/Conformance/C17.8.0.18.CC +++ b/Tests/Conformance/C17.8.0.18.CC @@ -1 +1,65 @@ -/* Conformance Test 17.8.0.18: Verification of scanf, u format code */ #include main () { int i; unsigned short us1; unsigned int ui1; unsigned long ul1; FILE *f1; /* Redirect standard input from a file. */ f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ if (f1 == NULL) goto Fail1; fprintf(f1, " 327678 D 4294967295m 32767722\r"); fclose(f1); stdin = freopen ("3/tmp", "r", stdin); if (stdin == NULL) goto Fail1; ui1 = 2; /* test format string of no */ i = scanf ("%*05hu8"); /* assignment, max. field */ if (i != 0) /* width of 5, h ignored, */ goto Fail; /* character 8 must appear*/ if (ui1 != 2) /* after 5 digits read */ goto Fail; i = scanf ("%u", &ui1); /* test "plain vanilla" fmt */ if (i != 0) /* string; data contains */ goto Fail; /* the character 'D' */ ul1 = 0; /* test format string of */ i = scanf ("D %12ldm", &ul1); /* max. field width of 12,*/ if (i != 1) /* long variable expected,*/ goto Fail; /* character m must appear*/ if (ul1 != 4294967295u) /* after digits read */ goto Fail; ul1 = 0; /* test format string of */ i = scanf ("%6lu%u", &ul1, &ui1); /* max. field width of 6, */ if (i != 2) /* long variable expected,*/ goto Fail; /* followed by simple fmt */ if ((ul1 != 327677) || (ui1 != 22)) /* for integer */ goto Fail; stdin = freopen (".CONSOLE", "r", stdin); /* reset stdin and quit */ if (stdin == NULL) goto Fail1; printf ("Passed Conformance Test 17.8.0.18\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.18\n"); return; Fail1: printf ("Unable to redirect stdin for Conformance Test 17.8.0.18\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.18: Verification of scanf, u format code */ + +#include + +main () + { + int i; + unsigned short us1; + unsigned int ui1; + unsigned long ul1; + FILE *f1; + + + /* Redirect standard input from a file. */ + + f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ + if (f1 == NULL) + goto Fail1; + fprintf(f1, " 327678 D 4294967295m 32767722\r"); + fclose(f1); + + stdin = freopen ("3/tmp", "r", stdin); + if (stdin == NULL) + goto Fail1; + + ui1 = 2; /* test format string of no */ + i = scanf ("%*05hu8"); /* assignment, max. field */ + if (i != 0) /* width of 5, h ignored, */ + goto Fail; /* character 8 must appear*/ + if (ui1 != 2) /* after 5 digits read */ + goto Fail; + + i = scanf ("%u", &ui1); /* test "plain vanilla" fmt */ + if (i != 0) /* string; data contains */ + goto Fail; /* the character 'D' */ + + ul1 = 0; /* test format string of */ + i = scanf ("D %12ldm", &ul1); /* max. field width of 12,*/ + if (i != 1) /* long variable expected,*/ + goto Fail; /* character m must appear*/ + if (ul1 != 4294967295u) /* after digits read */ + goto Fail; + + ul1 = 0; /* test format string of */ + i = scanf ("%6lu%u", &ul1, &ui1); /* max. field width of 6, */ + if (i != 2) /* long variable expected,*/ + goto Fail; /* followed by simple fmt */ + if ((ul1 != 327677) || (ui1 != 22)) /* for integer */ + goto Fail; + + stdin = freopen (".CONSOLE", "r", stdin); /* reset stdin and quit */ + if (stdin == NULL) + goto Fail1; + + printf ("Passed Conformance Test 17.8.0.18\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.18\n"); + return; + +Fail1: + printf ("Unable to redirect stdin for Conformance Test 17.8.0.18\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.19.CC b/Tests/Conformance/C17.8.0.19.CC old mode 100755 new mode 100644 index 5ce4007..933fecc --- a/Tests/Conformance/C17.8.0.19.CC +++ b/Tests/Conformance/C17.8.0.19.CC @@ -1 +1,65 @@ -/* Conformance Test 17.8.0.19: Verification of scanf, o format code */ #include main () { int i; unsigned short us1; unsigned int ui1; unsigned long ul1; FILE *f1; /* Redirect standard input from a file. */ f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ if (f1 == NULL) goto Fail1; fprintf(f1, " 77777 D 37777777777m 117777526"); fclose(f1); stdin = freopen ("3/tmp", "r", stdin); if (stdin == NULL) goto Fail1; us1 = 2; /* test format string of no */ i = scanf ("%*05ho8"); /* assignment, max. field */ if (i != 0) /* width of 5, h ignored, */ goto Fail; /* character 8 must appear*/ if (us1 != 2) /* after 5 digits read */ goto Fail; i = scanf ("%o", &ui1); /* test "plain vanilla" fmt */ if (i != 0) /* string; data contains */ goto Fail; /* the character 'D' */ ul1 = 0; /* test format string of */ i = scanf ("D %12lom", &ul1); /* max. field width of 12,*/ if (i != 1) /* long variable expected,*/ goto Fail; /* character m must appear*/ if (ul1 != 4294967295u) /* after digits read */ goto Fail; ul1 = 0; /* test format string of */ i = scanf ("%7lo%o", &ul1, &ui1); /* max. field width of 6, */ if (i != 2) /* long variable expected,*/ goto Fail; /* followed by simple fmt */ if ((ul1 != 327677) || (ui1 != 22)) /* for integer */ goto Fail; stdin = freopen (".CONSOLE", "r", stdin); /* reset stdin and quit */ if (stdin == NULL) goto Fail1; printf ("Passed Conformance Test 17.8.0.19\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.19\n"); return; Fail1: printf ("Unable to redirect stdin for Conformance Test 17.8.0.19\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.19: Verification of scanf, o format code */ + +#include + +main () + { + int i; + unsigned short us1; + unsigned int ui1; + unsigned long ul1; + FILE *f1; + + + /* Redirect standard input from a file. */ + + f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ + if (f1 == NULL) + goto Fail1; + fprintf(f1, " 77777 D 37777777777m 117777526"); + fclose(f1); + + stdin = freopen ("3/tmp", "r", stdin); + if (stdin == NULL) + goto Fail1; + + us1 = 2; /* test format string of no */ + i = scanf ("%*05ho8"); /* assignment, max. field */ + if (i != 0) /* width of 5, h ignored, */ + goto Fail; /* character 8 must appear*/ + if (us1 != 2) /* after 5 digits read */ + goto Fail; + + i = scanf ("%o", &ui1); /* test "plain vanilla" fmt */ + if (i != 0) /* string; data contains */ + goto Fail; /* the character 'D' */ + + ul1 = 0; /* test format string of */ + i = scanf ("D %12lom", &ul1); /* max. field width of 12,*/ + if (i != 1) /* long variable expected,*/ + goto Fail; /* character m must appear*/ + if (ul1 != 4294967295u) /* after digits read */ + goto Fail; + + ul1 = 0; /* test format string of */ + i = scanf ("%7lo%o", &ul1, &ui1); /* max. field width of 6, */ + if (i != 2) /* long variable expected,*/ + goto Fail; /* followed by simple fmt */ + if ((ul1 != 327677) || (ui1 != 22)) /* for integer */ + goto Fail; + + stdin = freopen (".CONSOLE", "r", stdin); /* reset stdin and quit */ + if (stdin == NULL) + goto Fail1; + + printf ("Passed Conformance Test 17.8.0.19\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.19\n"); + return; + +Fail1: + printf ("Unable to redirect stdin for Conformance Test 17.8.0.19\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.2.CC b/Tests/Conformance/C17.8.0.2.CC old mode 100755 new mode 100644 index 06a2833..e2d74d0 --- a/Tests/Conformance/C17.8.0.2.CC +++ b/Tests/Conformance/C17.8.0.2.CC @@ -1 +1,63 @@ -/* Conformance Test 17.8.0.2: Verification of fscanf, u format code */ #include main () { FILE *f1; int i; unsigned short us1; unsigned int ui1; unsigned long ul1; f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ if (f1 == NULL) goto Fail1; fprintf(f1, " 327678 D 4294967295m 32767722\r"); rewind(f1); ui1 = 2; /* test format string of no */ i = fscanf (f1, "%*05hu8"); /* assignment, max. field */ if (i != 0) /* width of 5, h ignored, */ goto Fail; /* character 8 must appear*/ if (ui1 != 2) /* after 5 digits read */ goto Fail; i = fscanf (f1, "%u", &ui1); /* test "plain vanilla" fmt */ if (i != 0) /* string; data contains */ goto Fail; /* the character 'D' */ ul1 = 0; /* test format string of */ i = fscanf (f1, "D %12ldm", &ul1); /* max. field width of 12,*/ if (i != 1) /* long variable expected,*/ goto Fail; /* character m must appear*/ if (ul1 != 4294967295u) /* after digits read */ goto Fail; ul1 = 0; /* test format string of */ i = fscanf (f1, "%6lu%u", &ul1, &ui1); /* max. field width of 6, */ if (i != 2) /* long variable expected,*/ goto Fail; /* followed by simple fmt */ if ((ul1 != 327677) || (ui1 != 22)) /* for integer */ goto Fail; i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.8.0.2\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.2\n"); return; Fail1: printf ("Unable to open input file for Conformance Test 17.8.0.2\n"); return; Fail2: printf ("Unable to close input file for Conformance Test 17.8.0.2\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.2: Verification of fscanf, u format code */ + +#include + +main () + { + FILE *f1; + int i; + unsigned short us1; + unsigned int ui1; + unsigned long ul1; + + + f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ + if (f1 == NULL) + goto Fail1; + fprintf(f1, " 327678 D 4294967295m 32767722\r"); + rewind(f1); + + ui1 = 2; /* test format string of no */ + i = fscanf (f1, "%*05hu8"); /* assignment, max. field */ + if (i != 0) /* width of 5, h ignored, */ + goto Fail; /* character 8 must appear*/ + if (ui1 != 2) /* after 5 digits read */ + goto Fail; + + i = fscanf (f1, "%u", &ui1); /* test "plain vanilla" fmt */ + if (i != 0) /* string; data contains */ + goto Fail; /* the character 'D' */ + + ul1 = 0; /* test format string of */ + i = fscanf (f1, "D %12ldm", &ul1); /* max. field width of 12,*/ + if (i != 1) /* long variable expected,*/ + goto Fail; /* character m must appear*/ + if (ul1 != 4294967295u) /* after digits read */ + goto Fail; + + ul1 = 0; /* test format string of */ + i = fscanf (f1, "%6lu%u", &ul1, &ui1); /* max. field width of 6, */ + if (i != 2) /* long variable expected,*/ + goto Fail; /* followed by simple fmt */ + if ((ul1 != 327677) || (ui1 != 22)) /* for integer */ + goto Fail; + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.8.0.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.2\n"); + return; + +Fail1: + printf ("Unable to open input file for Conformance Test 17.8.0.2\n"); + return; + +Fail2: + printf ("Unable to close input file for Conformance Test 17.8.0.2\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.20.CC b/Tests/Conformance/C17.8.0.20.CC old mode 100755 new mode 100644 index 8225dee..cf51b8c --- a/Tests/Conformance/C17.8.0.20.CC +++ b/Tests/Conformance/C17.8.0.20.CC @@ -1 +1,67 @@ -/* Conformance Test 17.8.0.20: Verification of scanf, x,X format codes */ #include main () { int i; unsigned short us1; unsigned int ui1; unsigned long ul1; FILE *f1; /* Redirect standard input from a file */ f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ if (f1 == NULL) goto Fail1; fprintf(f1, " 327678 0x D 0xFFFFFFFFm 0x7fEd0X10"); fclose(f1); stdin = freopen ("3/tmp", "r", stdin); if (stdin == NULL) goto Fail1; us1 = 2; /* test format string of no */ i = scanf ("%*05hx8"); /* assignment, max. field */ if (i != 0) /* width of 5, h ignored, */ goto Fail; /* character 8 must appear*/ if (us1 != 2) /* after 5 digits read */ goto Fail; i = scanf ("%X", &ui1); /* test "plain vanilla" fmt */ if (i != 1) /* string; data contains */ goto Fail; /* the characters 0x */ if (ui1 != 0) goto Fail; ul1 = 0; /* test format string of */ i = scanf (" D %12lxm", &ul1); /* max. field width of 12,*/ if (i != 1) /* long variable expected,*/ goto Fail; /* character m must appear*/ if (ul1 != 4294967295u) /* after digits read */ goto Fail; ul1 = 0; /* test format string of */ i = scanf ("%6lx%x", &ul1, &ui1); /* max. field width of 6, */ if (i != 2) /* long variable expected,*/ goto Fail; /* followed by simple fmt */ if ((ul1 != 0x7FED) || (ui1 != 16)) /* for integer */ goto Fail; stdin = freopen (".CONSOLE", "r", stdin); /* reset stdin and quit */ if (stdin == NULL) goto Fail1; printf ("Passed Conformance Test 17.8.0.20\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.20\n"); return; Fail1: printf ("Unable to redirect stdin for Conformance Test 17.8.0.20\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.20: Verification of scanf, x,X format codes */ + +#include + +main () + { + int i; + unsigned short us1; + unsigned int ui1; + unsigned long ul1; + FILE *f1; + + + /* Redirect standard input from a file */ + + f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ + if (f1 == NULL) + goto Fail1; + fprintf(f1, " 327678 0x D 0xFFFFFFFFm 0x7fEd0X10"); + fclose(f1); + + stdin = freopen ("3/tmp", "r", stdin); + if (stdin == NULL) + goto Fail1; + + us1 = 2; /* test format string of no */ + i = scanf ("%*05hx8"); /* assignment, max. field */ + if (i != 0) /* width of 5, h ignored, */ + goto Fail; /* character 8 must appear*/ + if (us1 != 2) /* after 5 digits read */ + goto Fail; + + i = scanf ("%X", &ui1); /* test "plain vanilla" fmt */ + if (i != 1) /* string; data contains */ + goto Fail; /* the characters 0x */ + if (ui1 != 0) + goto Fail; + + ul1 = 0; /* test format string of */ + i = scanf (" D %12lxm", &ul1); /* max. field width of 12,*/ + if (i != 1) /* long variable expected,*/ + goto Fail; /* character m must appear*/ + if (ul1 != 4294967295u) /* after digits read */ + goto Fail; + + ul1 = 0; /* test format string of */ + i = scanf ("%6lx%x", &ul1, &ui1); /* max. field width of 6, */ + if (i != 2) /* long variable expected,*/ + goto Fail; /* followed by simple fmt */ + if ((ul1 != 0x7FED) || (ui1 != 16)) /* for integer */ + goto Fail; + + stdin = freopen (".CONSOLE", "r", stdin); /* reset stdin and quit */ + if (stdin == NULL) + goto Fail1; + + printf ("Passed Conformance Test 17.8.0.20\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.20\n"); + return; + +Fail1: + printf ("Unable to redirect stdin for Conformance Test 17.8.0.20\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.21.CC b/Tests/Conformance/C17.8.0.21.CC old mode 100755 new mode 100644 index ed8601a..c00954a --- a/Tests/Conformance/C17.8.0.21.CC +++ b/Tests/Conformance/C17.8.0.21.CC @@ -1 +1,52 @@ -/* Conformance Test 17.8.0.21: Verification of scanf, c format code */ #include #include main () { FILE *f1; int i; char ch, string [50]; /* Redirect standard input from a file */ f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ if (f1 == NULL) goto Fail1; fprintf(f1, "bten chars!andMore"); fclose(f1); stdin = freopen ("3/tmp", "r", stdin); if (stdin == NULL) goto Fail1; ch = 'a'; /* no assignment should be made */ i = scanf ("%*hc"); /* h ignored */ if (i != 0) goto Fail; if (ch != 'a') goto Fail; i = scanf ("%10lc", string); /* test assignment to string*/ if (i != 1) /* l ignored */ goto Fail; if (strncmp (string, "ten chars!", 10)) goto Fail; stdin = freopen (".CONSOLE", "r", stdin); /* reset stdin and quit */ if (stdin == NULL) goto Fail1; printf ("Passed Conformance Test 17.8.0.21\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.21\n"); return; Fail1: printf ("Unable to redirect stdin for Conformance Test 17.8.0.21\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.21: Verification of scanf, c format code */ + +#include +#include + +main () + { + FILE *f1; + int i; + char ch, string [50]; + + + /* Redirect standard input from a file */ + + f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ + if (f1 == NULL) + goto Fail1; + fprintf(f1, "bten chars!andMore"); + fclose(f1); + + stdin = freopen ("3/tmp", "r", stdin); + if (stdin == NULL) + goto Fail1; + + ch = 'a'; /* no assignment should be made */ + i = scanf ("%*hc"); /* h ignored */ + if (i != 0) + goto Fail; + if (ch != 'a') + goto Fail; + + i = scanf ("%10lc", string); /* test assignment to string*/ + if (i != 1) /* l ignored */ + goto Fail; + if (strncmp (string, "ten chars!", 10)) + goto Fail; + + stdin = freopen (".CONSOLE", "r", stdin); /* reset stdin and quit */ + if (stdin == NULL) + goto Fail1; + + printf ("Passed Conformance Test 17.8.0.21\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.21\n"); + return; + +Fail1: + printf ("Unable to redirect stdin for Conformance Test 17.8.0.21\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.22.CC b/Tests/Conformance/C17.8.0.22.CC old mode 100755 new mode 100644 index 4a10734..eb4bbd3 --- a/Tests/Conformance/C17.8.0.22.CC +++ b/Tests/Conformance/C17.8.0.22.CC @@ -1 +1,50 @@ -/* Conformance Test 17.8.0.22: Verification of scanf, s format code */ #include main () { int i, j; char string [50] = "hey, hey!"; FILE *f1; /* Redirect standard input from a file */ f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ if (f1 == NULL) goto Fail1; fprintf(f1, " oneLongWord ten_chars!andMore"); fclose(f1); stdin = freopen ("3/tmp", "r", stdin); if (stdin == NULL) goto Fail1; i = scanf ("%*hs"); /* no assignment made; h ignored */ if (i != 0) goto Fail; if (strcmp (string, "hey, hey!")) goto Fail; i = scanf ("%10ls", string); /* test assignment to string*/ if (i != 1) /* l ignored */ goto Fail; if (strcmp (string, "ten_chars!")) goto Fail; stdin = freopen (".CONSOLE", "r", stdin); /* reset stdin and quit */ if (stdin == NULL) goto Fail1; printf ("Passed Conformance Test 17.8.0.22\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.22\n"); return; Fail1: printf ("Unable to redirect stdin for Conformance Test 17.8.0.22\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.22: Verification of scanf, s format code */ + +#include + +main () + { + int i, j; + char string [50] = "hey, hey!"; + FILE *f1; + + + /* Redirect standard input from a file */ + + f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ + if (f1 == NULL) + goto Fail1; + fprintf(f1, " oneLongWord ten_chars!andMore"); + fclose(f1); + + stdin = freopen ("3/tmp", "r", stdin); + if (stdin == NULL) + goto Fail1; + + i = scanf ("%*hs"); /* no assignment made; h ignored */ + if (i != 0) + goto Fail; + if (strcmp (string, "hey, hey!")) + goto Fail; + + i = scanf ("%10ls", string); /* test assignment to string*/ + if (i != 1) /* l ignored */ + goto Fail; + if (strcmp (string, "ten_chars!")) + goto Fail; + + stdin = freopen (".CONSOLE", "r", stdin); /* reset stdin and quit */ + if (stdin == NULL) + goto Fail1; + + printf ("Passed Conformance Test 17.8.0.22\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.22\n"); + return; + +Fail1: + printf ("Unable to redirect stdin for Conformance Test 17.8.0.22\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.23.CC b/Tests/Conformance/C17.8.0.23.CC old mode 100755 new mode 100644 index 38e6048..d98ea65 --- a/Tests/Conformance/C17.8.0.23.CC +++ b/Tests/Conformance/C17.8.0.23.CC @@ -1 +1,55 @@ -/* Conformance Test 17.8.0.23: Verification of scanf, f e E g G format codes */ #include #include main () { float f1, f2, f3, f4; double d1, d2, d3; int i; FILE *f; /* Redirect standard input from a file */ f = fopen ("3/tmp", "wb+"); /* open input file for test */ if (f == NULL) goto Fail1; fprintf(f, "23 -3.8E20 - e- +25e- 00002.00008e000049.9"); fclose(f); stdin = freopen ("3/tmp", "r", stdin); if (stdin == NULL) goto Fail1; f1 = f2 = f3 = f4 = 1.0; d1 = d2 = d3 = 1.0; i = scanf ("%*07f %e %E %lg %30lG %17lf%e", &f2, &f3, &d1, &d2, &d3, &f4); if (i != 6) goto Fail; if ((fabs(f1 - 1.0) > 0.00001) || (fabs(f2 - (-3.8E20)) > 1e15) || (fabs(f3) > 0.00001) || (fabs(f4 - 9.9) > 0.00001) || (fabs(d1) > 0.00001) || (fabs(d2 - 25.0) > 0.00001) || (fabs(d3 - 2.00008e4) > 0.00001)) goto Fail; stdin = freopen (".CONSOLE", "r", stdin); /* reset stdin and quit */ if (stdin == NULL) goto Fail1; printf ("Passed Conformance Test 17.8.0.23\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.23\n"); return; Fail1: printf ("Unable to redirect stdin for Conformance Test 17.8.0.23\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.23: Verification of scanf, f e E g G format codes */ + +#include +#include + +main () + { + float f1, f2, f3, f4; + double d1, d2, d3; + int i; + FILE *f; + + + /* Redirect standard input from a file */ + + f = fopen ("3/tmp", "wb+"); /* open input file for test */ + if (f == NULL) + goto Fail1; + fprintf(f, "23 -3.8E20 - e- +25e- 00002.00008e000049.9"); + fclose(f); + + stdin = freopen ("3/tmp", "r", stdin); + if (stdin == NULL) + goto Fail1; + + f1 = f2 = f3 = f4 = 1.0; + d1 = d2 = d3 = 1.0; + i = scanf ("%*07f %e %E %lg %30lG %17lf%e", &f2, &f3, &d1, &d2, + &d3, &f4); + if (i != 6) + goto Fail; + if ((fabs(f1 - 1.0) > 0.00001) || + (fabs(f2 - (-3.8E20)) > 1e15) || + (fabs(f3) > 0.00001) || + (fabs(f4 - 9.9) > 0.00001) || + (fabs(d1) > 0.00001) || + (fabs(d2 - 25.0) > 0.00001) || + (fabs(d3 - 2.00008e4) > 0.00001)) + goto Fail; + + stdin = freopen (".CONSOLE", "r", stdin); /* reset stdin and quit */ + if (stdin == NULL) + goto Fail1; + + printf ("Passed Conformance Test 17.8.0.23\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.23\n"); + return; + +Fail1: + printf ("Unable to redirect stdin for Conformance Test 17.8.0.23\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.24.CC b/Tests/Conformance/C17.8.0.24.CC old mode 100755 new mode 100644 index de8173c..9f2397b --- a/Tests/Conformance/C17.8.0.24.CC +++ b/Tests/Conformance/C17.8.0.24.CC @@ -1 +1,61 @@ -/* Conformance Test 17.8.0.24: Verification of scanf, % and [ format codes */ #include main () { int i; char string [2] [50] = { {"hey, hey!"}, {"you, you"} }; FILE *f1; /* Redirect standard input from a file */ f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ if (f1 == NULL) goto Fail1; fprintf(f1, "%% these are the ^only[ characters*aaabbb a fine mess, " "you see! ddddfffffffff"); fclose(f1); stdin = freopen ("3/tmp", "r", stdin); if (stdin == NULL) goto Fail1; i = scanf ("%*50h%"); /* no assignment made; * 50 h ignored */ if (i != 0) goto Fail; /* Create set of characters which can appear in the output string. */ i = scanf ("%45[thes arohnlyc^[] %*[*ab]", &string [0]); if (i != 1) goto Fail; if (strcmp (&string [0], " these are the ^only[ characters")) goto Fail; /* Create set of characters which cannot appear in the output string. */ i = scanf ("%[^d] %10[df]", &string [0], &string [1]); if (i != 2) goto Fail; if (strcmp (&string [0], " a fine mess, you see! ")) goto Fail; if (strcmp (&string [1], "ddddffffff")) goto Fail; stdin = freopen (".CONSOLE", "r", stdin); /* reset stdin and quit */ if (stdin == NULL) goto Fail1; printf ("Passed Conformance Test 17.8.0.24\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.24\n"); return; Fail1: printf ("Unable to open input file for Conformance Test 17.8.0.24\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.24: Verification of scanf, % and [ format codes */ + +#include + +main () + { + int i; + char string [2] [50] = { {"hey, hey!"}, {"you, you"} }; + FILE *f1; + + + /* Redirect standard input from a file */ + + f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ + if (f1 == NULL) + goto Fail1; + fprintf(f1, "%% these are the ^only[ characters*aaabbb a fine mess, " + "you see! ddddfffffffff"); + fclose(f1); + + stdin = freopen ("3/tmp", "r", stdin); + if (stdin == NULL) + goto Fail1; + + i = scanf ("%*50h%"); /* no assignment made; * 50 h ignored */ + if (i != 0) + goto Fail; + + /* Create set of characters which can appear in the output string. */ + + i = scanf ("%45[thes arohnlyc^[] %*[*ab]", &string [0]); + if (i != 1) + goto Fail; + if (strcmp (&string [0], " these are the ^only[ characters")) + goto Fail; + + /* Create set of characters which cannot appear in the output string. */ + + i = scanf ("%[^d] %10[df]", &string [0], &string [1]); + if (i != 2) + goto Fail; + if (strcmp (&string [0], " a fine mess, you see! ")) + goto Fail; + if (strcmp (&string [1], "ddddffffff")) + goto Fail; + + stdin = freopen (".CONSOLE", "r", stdin); /* reset stdin and quit */ + if (stdin == NULL) + goto Fail1; + + printf ("Passed Conformance Test 17.8.0.24\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.24\n"); + return; + +Fail1: + printf ("Unable to open input file for Conformance Test 17.8.0.24\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.3.CC b/Tests/Conformance/C17.8.0.3.CC old mode 100755 new mode 100644 index 9ded319..80d31bf --- a/Tests/Conformance/C17.8.0.3.CC +++ b/Tests/Conformance/C17.8.0.3.CC @@ -1 +1,63 @@ -/* Conformance Test 17.8.0.3: Verification of fscanf, o format code */ #include main () { FILE *f1; int i; unsigned short us1; unsigned int ui1; unsigned long ul1; f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ if (f1 == NULL) goto Fail1; fprintf(f1, " 77777 D 37777777777m 117777526"); rewind(f1); us1 = 2; /* test format string of no */ i = fscanf (f1, "%*05ho8"); /* assignment, max. field */ if (i != 0) /* width of 5, h ignored, */ goto Fail; /* character 8 must appear*/ if (us1 != 2) /* after 5 digits read */ goto Fail; i = fscanf (f1, "%o", &ui1); /* test "plain vanilla" fmt */ if (i != 0) /* string; data contains */ goto Fail; /* the character 'D' */ ul1 = 0; /* test format string of */ i = fscanf (f1, "D %13lom", &ul1); /* max. field width of 13,*/ if (i != 1) /* long variable expected,*/ goto Fail; /* character m must appear*/ if (ul1 != 4294967295u) /* after digits read */ goto Fail; ul1 = 0; /* test format string of */ i = fscanf (f1, "%7lo%o", &ul1, &ui1); /* max. field width of 7, */ if (i != 2) /* long variable expected,*/ goto Fail; /* followed by simple fmt */ if ((ul1 != 327677) || (ui1 != 22)) /* for integer */ goto Fail; i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.8.0.3\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.3\n"); return; Fail1: printf ("Unable to open input file for Conformance Test 17.8.0.3\n"); return; Fail2: printf ("Unable to close input file for Conformance Test 17.8.0.3\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.3: Verification of fscanf, o format code */ + +#include + +main () + { + FILE *f1; + int i; + unsigned short us1; + unsigned int ui1; + unsigned long ul1; + + + f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ + if (f1 == NULL) + goto Fail1; + fprintf(f1, " 77777 D 37777777777m 117777526"); + rewind(f1); + + us1 = 2; /* test format string of no */ + i = fscanf (f1, "%*05ho8"); /* assignment, max. field */ + if (i != 0) /* width of 5, h ignored, */ + goto Fail; /* character 8 must appear*/ + if (us1 != 2) /* after 5 digits read */ + goto Fail; + + i = fscanf (f1, "%o", &ui1); /* test "plain vanilla" fmt */ + if (i != 0) /* string; data contains */ + goto Fail; /* the character 'D' */ + + ul1 = 0; /* test format string of */ + i = fscanf (f1, "D %13lom", &ul1); /* max. field width of 13,*/ + if (i != 1) /* long variable expected,*/ + goto Fail; /* character m must appear*/ + if (ul1 != 4294967295u) /* after digits read */ + goto Fail; + + ul1 = 0; /* test format string of */ + i = fscanf (f1, "%7lo%o", &ul1, &ui1); /* max. field width of 7, */ + if (i != 2) /* long variable expected,*/ + goto Fail; /* followed by simple fmt */ + if ((ul1 != 327677) || (ui1 != 22)) /* for integer */ + goto Fail; + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.8.0.3\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.3\n"); + return; + +Fail1: + printf ("Unable to open input file for Conformance Test 17.8.0.3\n"); + return; + +Fail2: + printf ("Unable to close input file for Conformance Test 17.8.0.3\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.4.CC b/Tests/Conformance/C17.8.0.4.CC old mode 100755 new mode 100644 index 44a7a7b..8fc056c --- a/Tests/Conformance/C17.8.0.4.CC +++ b/Tests/Conformance/C17.8.0.4.CC @@ -1 +1,65 @@ -/* Conformance Test 17.8.0.4: Verification of fscanf, x,X format codes */ #include main () { FILE *f1; int i; unsigned short us1; unsigned int ui1; unsigned long ul1; f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ if (f1 == NULL) goto Fail1; fprintf(f1, " 327678 0x D 0xFFFFFFFFm 0x7fEd0X10"); rewind(f1); us1 = 2; /* test format string of no */ i = fscanf (f1, "%*05hx8"); /* assignment, max. field */ if (i != 0) /* width of 5, h ignored, */ goto Fail; /* character 8 must appear*/ if (us1 != 2) /* after 5 digits read */ goto Fail; i = fscanf (f1, "%X", &ui1); /* test "plain vanilla" fmt */ if (i != 1) /* string; data contains */ goto Fail; /* the characters 0x */ if (ui1 != 0) goto Fail; ul1 = 0; /* test format string of */ i = fscanf (f1, " D %12lxm", &ul1); /* max. field width of 12,*/ if (i != 1) /* long variable expected,*/ goto Fail; /* character m must appear*/ if (ul1 != 4294967295u) /* after digits read */ goto Fail; ul1 = 0; /* test format string of */ i = fscanf (f1, "%6lx%x", &ul1, &ui1); /* max. field width of 6, */ if (i != 2) /* long variable expected,*/ goto Fail; /* followed by simple fmt */ if ((ul1 != 0x7FED) || (ui1 != 16)) /* for integer */ goto Fail; i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.8.0.4\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.4\n"); return; Fail1: printf ("Unable to open input file for Conformance Test 17.8.0.4\n"); return; Fail2: printf ("Unable to close input file for Conformance Test 17.8.0.4\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.4: Verification of fscanf, x,X format codes */ + +#include + +main () + { + FILE *f1; + int i; + unsigned short us1; + unsigned int ui1; + unsigned long ul1; + + + f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ + if (f1 == NULL) + goto Fail1; + fprintf(f1, " 327678 0x D 0xFFFFFFFFm 0x7fEd0X10"); + rewind(f1); + + us1 = 2; /* test format string of no */ + i = fscanf (f1, "%*05hx8"); /* assignment, max. field */ + if (i != 0) /* width of 5, h ignored, */ + goto Fail; /* character 8 must appear*/ + if (us1 != 2) /* after 5 digits read */ + goto Fail; + + i = fscanf (f1, "%X", &ui1); /* test "plain vanilla" fmt */ + if (i != 1) /* string; data contains */ + goto Fail; /* the characters 0x */ + if (ui1 != 0) + goto Fail; + + ul1 = 0; /* test format string of */ + i = fscanf (f1, " D %12lxm", &ul1); /* max. field width of 12,*/ + if (i != 1) /* long variable expected,*/ + goto Fail; /* character m must appear*/ + if (ul1 != 4294967295u) /* after digits read */ + goto Fail; + + ul1 = 0; /* test format string of */ + i = fscanf (f1, "%6lx%x", &ul1, &ui1); /* max. field width of 6, */ + if (i != 2) /* long variable expected,*/ + goto Fail; /* followed by simple fmt */ + if ((ul1 != 0x7FED) || (ui1 != 16)) /* for integer */ + goto Fail; + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.8.0.4\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.4\n"); + return; + +Fail1: + printf ("Unable to open input file for Conformance Test 17.8.0.4\n"); + return; + +Fail2: + printf ("Unable to close input file for Conformance Test 17.8.0.4\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.5.CC b/Tests/Conformance/C17.8.0.5.CC old mode 100755 new mode 100644 index 2803bfd..f8fee21 --- a/Tests/Conformance/C17.8.0.5.CC +++ b/Tests/Conformance/C17.8.0.5.CC @@ -1 +1,50 @@ -/* Conformance Test 17.8.0.5: Verification of fscanf, c format code */ #include #include main () { FILE *f1; int i; char ch, string [50]; f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ if (f1 == NULL) goto Fail1; fprintf(f1, "bten chars!andMore"); rewind(f1); ch = 'a'; /* no assignment should be made */ i = fscanf (f1, "%*hc"); /* h ignored */ if (i != 0) goto Fail; if (ch != 'a') goto Fail; i = fscanf (f1, "%10lc", string); /* test assignment to string*/ if (i != 1) /* l ignored */ goto Fail; if (strncmp (string, "ten chars!", 10)) goto Fail; i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.8.0.5\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.5\n"); return; Fail1: printf ("Unable to open input file for Conformance Test 17.8.0.5\n"); return; Fail2: printf ("Unable to close input file for Conformance Test 17.8.0.5\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.5: Verification of fscanf, c format code */ + +#include +#include + +main () + { + FILE *f1; + int i; + char ch, string [50]; + + + f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ + if (f1 == NULL) + goto Fail1; + fprintf(f1, "bten chars!andMore"); + rewind(f1); + + ch = 'a'; /* no assignment should be made */ + i = fscanf (f1, "%*hc"); /* h ignored */ + if (i != 0) + goto Fail; + if (ch != 'a') + goto Fail; + + i = fscanf (f1, "%10lc", string); /* test assignment to string*/ + if (i != 1) /* l ignored */ + goto Fail; + if (strncmp (string, "ten chars!", 10)) + goto Fail; + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.8.0.5\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.5\n"); + return; + +Fail1: + printf ("Unable to open input file for Conformance Test 17.8.0.5\n"); + return; + +Fail2: + printf ("Unable to close input file for Conformance Test 17.8.0.5\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.6.CC b/Tests/Conformance/C17.8.0.6.CC old mode 100755 new mode 100644 index ed02fcd..9b3b08c --- a/Tests/Conformance/C17.8.0.6.CC +++ b/Tests/Conformance/C17.8.0.6.CC @@ -1 +1,48 @@ -/* Conformance Test 17.8.0.6: Verification of fscanf, s format code */ #include main () { FILE *f1; int i, j; char string [50] = "hey, hey!"; f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ if (f1 == NULL) goto Fail1; fprintf(f1, " oneLongWord ten_chars!andMore"); rewind(f1); i = fscanf (f1, "%*hs"); /* no assignment made; h ignored */ if (i != 0) goto Fail; if (strcmp (string, "hey, hey!")) goto Fail; i = fscanf (f1, "%10ls", string); /* test assignment to string*/ if (i != 1) /* l ignored */ goto Fail; if (strcmp (string, "ten_chars!")) goto Fail; i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.8.0.6\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.6\n"); return; Fail1: printf ("Unable to open input file for Conformance Test 17.8.0.6\n"); return; Fail2: printf ("Unable to close input file for Conformance Test 17.8.0.6\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.6: Verification of fscanf, s format code */ + +#include + +main () + { + FILE *f1; + int i, j; + char string [50] = "hey, hey!"; + + + f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ + if (f1 == NULL) + goto Fail1; + fprintf(f1, " oneLongWord ten_chars!andMore"); + rewind(f1); + + i = fscanf (f1, "%*hs"); /* no assignment made; h ignored */ + if (i != 0) + goto Fail; + if (strcmp (string, "hey, hey!")) + goto Fail; + + i = fscanf (f1, "%10ls", string); /* test assignment to string*/ + if (i != 1) /* l ignored */ + goto Fail; + if (strcmp (string, "ten_chars!")) + goto Fail; + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.8.0.6\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.6\n"); + return; + +Fail1: + printf ("Unable to open input file for Conformance Test 17.8.0.6\n"); + return; + +Fail2: + printf ("Unable to close input file for Conformance Test 17.8.0.6\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.7.CC b/Tests/Conformance/C17.8.0.7.CC old mode 100755 new mode 100644 index 560602a..21f9b6a --- a/Tests/Conformance/C17.8.0.7.CC +++ b/Tests/Conformance/C17.8.0.7.CC @@ -1 +1,53 @@ -/* Conformance Test 17.8.0.7: Verification of fscanf, e format codes */ #include #include main () { FILE *f; float f1, f2, f3, f4; double d1, d2, d3; int i; f = fopen ("3/tmp", "wb+"); /* open input file for test */ if (f == NULL) goto Fail1; fprintf(f, "23 -3.8E20 - e- +25e- 00002.00008e000049.9"); rewind(f); f1 = f2 = f3 = f4 = 1.0; d1 = d2 = d3 = 1.0; i = fscanf (f, "%*07f %e %E %lg %30lG %17lf%e", &f2, &f3, &d1, &d2, &d3, &f4); if (i != 6) goto Fail; if ((fabs(f1 - 1.0) > 0.00001) || (fabs(f2 - (-3.8E20)) > 1e15) || (fabs(f3) > 0.00001) || (fabs(f4 - 9.9) > 0.00001) || (fabs(d1) > 0.00001) || (fabs(d2 - 25.0) > 0.00001) || (fabs(d3 - 2.00008e4) > 0.0000001)) goto Fail; i = fclose (f); /* close the file and quit */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.8.0.7\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.7\n"); return; Fail1: printf ("Unable to open input file for Conformance Test 17.8.0.7\n"); return; Fail2: printf ("Unable to close input file for Conformance Test 17.8.0.7\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.7: Verification of fscanf, e format codes */ + +#include +#include + +main () + { + FILE *f; + float f1, f2, f3, f4; + double d1, d2, d3; + int i; + + + f = fopen ("3/tmp", "wb+"); /* open input file for test */ + if (f == NULL) + goto Fail1; + fprintf(f, "23 -3.8E20 - e- +25e- 00002.00008e000049.9"); + rewind(f); + + f1 = f2 = f3 = f4 = 1.0; + d1 = d2 = d3 = 1.0; + i = fscanf (f, "%*07f %e %E %lg %30lG %17lf%e", &f2, &f3, &d1, &d2, + &d3, &f4); + if (i != 6) + goto Fail; + if ((fabs(f1 - 1.0) > 0.00001) || + (fabs(f2 - (-3.8E20)) > 1e15) || + (fabs(f3) > 0.00001) || + (fabs(f4 - 9.9) > 0.00001) || + (fabs(d1) > 0.00001) || + (fabs(d2 - 25.0) > 0.00001) || + (fabs(d3 - 2.00008e4) > 0.0000001)) + goto Fail; + + i = fclose (f); /* close the file and quit */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.8.0.7\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.7\n"); + return; + +Fail1: + printf ("Unable to open input file for Conformance Test 17.8.0.7\n"); + return; + +Fail2: + printf ("Unable to close input file for Conformance Test 17.8.0.7\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.8.CC b/Tests/Conformance/C17.8.0.8.CC old mode 100755 new mode 100644 index 77d9d89..7c70a67 --- a/Tests/Conformance/C17.8.0.8.CC +++ b/Tests/Conformance/C17.8.0.8.CC @@ -1 +1,59 @@ -/* Conformance Test 17.8.0.8: Verification of fscanf, % and [ format codes */ #include main () { FILE *f1; int i; char string [2] [50] = { {"hey, hey!"}, {"you, you"} }; f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ if (f1 == NULL) goto Fail1; fprintf(f1, "%% these are the ^only[ characters*aaabbb a fine mess, " "you see! ddddfffffffff"); rewind(f1); i = fscanf (f1, "%*50h%"); /* no assignment made; * 50 h ignored */ if (i != 0) goto Fail; /* Create set of characters which can appear in the output string. */ i = fscanf (f1, "%45[thes aronlyc^[h] %*[*ab]", &string [0]); if (i != 1) goto Fail; if (strcmp (&string [0], " these are the ^only[ characters")) goto Fail; /* Create set of characters which cannot appear in the output string. */ i = fscanf (f1, "%[^d] %10[df]", &string [0], &string [1]); if (i != 2) goto Fail; if (strcmp (&string [0], " a fine mess, you see! ")) goto Fail; if (strcmp (&string [1], "ddddffffff")) goto Fail; i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.8.0.8\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.8\n"); return; Fail1: printf ("Unable to open input file for Conformance Test 17.8.0.8\n"); return; Fail2: printf ("Unable to close input file for Conformance Test 17.8.0.8\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.8: Verification of fscanf, % and [ format codes */ + +#include + +main () + { + FILE *f1; + int i; + char string [2] [50] = { {"hey, hey!"}, {"you, you"} }; + + + f1 = fopen ("3/tmp", "wb+"); /* open input file for test */ + if (f1 == NULL) + goto Fail1; + fprintf(f1, "%% these are the ^only[ characters*aaabbb a fine mess, " + "you see! ddddfffffffff"); + rewind(f1); + + i = fscanf (f1, "%*50h%"); /* no assignment made; * 50 h ignored */ + if (i != 0) + goto Fail; + + /* Create set of characters which can appear in the output string. */ + + i = fscanf (f1, "%45[thes aronlyc^[h] %*[*ab]", &string [0]); + if (i != 1) + goto Fail; + if (strcmp (&string [0], " these are the ^only[ characters")) + goto Fail; + + /* Create set of characters which cannot appear in the output string. */ + + i = fscanf (f1, "%[^d] %10[df]", &string [0], &string [1]); + if (i != 2) + goto Fail; + if (strcmp (&string [0], " a fine mess, you see! ")) + goto Fail; + if (strcmp (&string [1], "ddddffffff")) + goto Fail; + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.8.0.8\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.8\n"); + return; + +Fail1: + printf ("Unable to open input file for Conformance Test 17.8.0.8\n"); + return; + +Fail2: + printf ("Unable to close input file for Conformance Test 17.8.0.8\n"); + return; + } diff --git a/Tests/Conformance/C17.8.0.9.CC b/Tests/Conformance/C17.8.0.9.CC old mode 100755 new mode 100644 index 9400d49..5a75f7f --- a/Tests/Conformance/C17.8.0.9.CC +++ b/Tests/Conformance/C17.8.0.9.CC @@ -1 +1,66 @@ -/* Conformance Test 17.8.0.9: Verification of scanf, d format code */ #include main () { char string [] = " +327678 - -002147483647A 327677-22 123*"; short i1; int i; int i2, i3; long L1; char ch; i1 = 0; /* test format string of no */ i = sscanf (string, "%*05hd8"); /* assignment, max. field */ if (i != 0) /* width of 5, h ignored, */ goto Fail; /* character 8 must appear*/ if (i1 != 0) /* after 5 digits read */ goto Fail; i2 = 15; /* test "plain vanilla" fmt */ i = sscanf (&string [9], "%d", &i2); /* string; data contains */ if (i != 1) /* a single minus sign */ goto Fail; if (i2 != 0) goto Fail; L1 = 0; /* test format string of */ i = sscanf (&string [15], "%12ldA", &L1); /* max. field width of 12,*/ if (i != 1) /* long variable expected,*/ goto Fail; /* character A must appear*/ if (L1 != -2147483647) /* after digits read */ goto Fail; L1 = 0; /* test fmt string of max */ i = sscanf (&string [31], "%6ld%d", &L1, &i2); /* field width of 6, */ if (i != 2) /* long variable expected,*/ goto Fail; /* followed by simple fmt */ if ((L1 != 327677) || (i2 != -22)) /* for integer */ goto Fail; i3 = 4; /* test format string of */ i = sscanf (&string [43], "%4hd*", &i3); /* max. field width of 4, */ if (i != 1) /* short variable expectd,*/ goto Fail; /* character * must appear*/ if (i3 != 123) /* after digits read. In */ goto Fail; /* the input, the number */ /* of digits is only 3. */ i = sscanf (&string [47], "%c", &ch); /* Ensure offending * has */ if (i != 1) /* been left in input. */ goto Fail; if (ch != '*') goto Fail; i = sscanf (&string [48], "%c", &ch); /* Ensure sscanf returns EOF*/ if (i != EOF) /* when EOF encountered. */ goto Fail; printf ("Passed Conformance Test 17.8.0.9\n"); return; Fail: printf ("Failed Conformance Test 17.8.0.9\n"); return; } \ No newline at end of file +/* Conformance Test 17.8.0.9: Verification of scanf, d format code */ + +#include + +main () + { + char string [] = " +327678 - -002147483647A 327677-22 123*"; + short i1; + int i; + int i2, i3; + long L1; + char ch; + + + i1 = 0; /* test format string of no */ + i = sscanf (string, "%*05hd8"); /* assignment, max. field */ + if (i != 0) /* width of 5, h ignored, */ + goto Fail; /* character 8 must appear*/ + if (i1 != 0) /* after 5 digits read */ + goto Fail; + + i2 = 15; /* test "plain vanilla" fmt */ + i = sscanf (&string [9], "%d", &i2); /* string; data contains */ + if (i != 1) /* a single minus sign */ + goto Fail; + if (i2 != 0) + goto Fail; + + L1 = 0; /* test format string of */ + i = sscanf (&string [15], "%12ldA", &L1); /* max. field width of 12,*/ + if (i != 1) /* long variable expected,*/ + goto Fail; /* character A must appear*/ + if (L1 != -2147483647) /* after digits read */ + goto Fail; + + L1 = 0; /* test fmt string of max */ + i = sscanf (&string [31], "%6ld%d", &L1, &i2); /* field width of 6, */ + if (i != 2) /* long variable expected,*/ + goto Fail; /* followed by simple fmt */ + if ((L1 != 327677) || (i2 != -22)) /* for integer */ + goto Fail; + + i3 = 4; /* test format string of */ + i = sscanf (&string [43], "%4hd*", &i3); /* max. field width of 4, */ + if (i != 1) /* short variable expectd,*/ + goto Fail; /* character * must appear*/ + if (i3 != 123) /* after digits read. In */ + goto Fail; /* the input, the number */ + /* of digits is only 3. */ + i = sscanf (&string [47], "%c", &ch); /* Ensure offending * has */ + if (i != 1) /* been left in input. */ + goto Fail; + if (ch != '*') + goto Fail; + + i = sscanf (&string [48], "%c", &ch); /* Ensure sscanf returns EOF*/ + if (i != EOF) /* when EOF encountered. */ + goto Fail; + + printf ("Passed Conformance Test 17.8.0.9\n"); + return; + +Fail: + printf ("Failed Conformance Test 17.8.0.9\n"); + return; + } diff --git a/Tests/Conformance/C17.9.0.1.CC b/Tests/Conformance/C17.9.0.1.CC old mode 100755 new mode 100644 index de49156..4ef71ab --- a/Tests/Conformance/C17.9.0.1.CC +++ b/Tests/Conformance/C17.9.0.1.CC @@ -1 +1,82 @@ -/* Conformance Test 17.9.0.1: Verification of fputc, putc, and putchar */ #include main () { FILE *f1; int i, j; char ch; f1 = fopen ("3/tmp", "w+"); /* open output file for test */ if (f1 == NULL) goto Fail1; /* Redirect standard output to a file */ stdout = freopen ("3/tmp2", "w+", stdout); if (stdout == NULL) goto Fail3; for (ch = 'A', i = 0; i < 26; i++) /* write uppercase alphabet to */ { /* output file */ j = fputc (ch, f1); /* test fputc */ if ((j == EOF) || ( ((char) j) != ch )) goto Fail; j = putc (ch, f1); /* test putc */ if ((j == EOF) || ( ((char) j) != ch )) goto Fail; j = putchar (ch); /* test putchar */ if ((j == EOF) || ( ((char) j) != ch )) goto Fail; ch++; } /* Check files' contents. */ rewind (f1); rewind (stdout); for (ch = 'A', i = 0; i < 26; i++) { if ( (j = fgetc (f1)) == EOF ) goto Fail; if ( ((char) (j)) != ch ) goto Fail; if ( (j = getc (f1)) == EOF ) goto Fail; if ( ((char) (j)) != ch ) goto Fail; if ( (j = fgetc (stdout)) == EOF ) goto Fail; if ( ((char) (j)) != ch ) goto Fail; ch++; } fclose(stdout); /* reset standard out */ i = fclose (f1); /* close the update file */ if (i == EOF) goto Fail2; printf ("Passed Conformance Test 17.9.0.1\n"); return; Fail: fprintf (stderr, "Failed Conformance Test 17.9.0.1\n"); return; Fail1: fprintf (stderr, "Unable to open input file for Conformance Test 17.9.0.1\n"); return; Fail2: fprintf (stderr, "Unable to close input file for Conformance Test 17.9.0.1\n"); return; Fail3: fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.9.0.1\n"); return; } \ No newline at end of file +/* Conformance Test 17.9.0.1: Verification of fputc, putc, and putchar */ + +#include + +main () + { + FILE *f1; + int i, j; + char ch; + + + f1 = fopen ("3/tmp", "w+"); /* open output file for test */ + if (f1 == NULL) + goto Fail1; + + /* Redirect standard output to a file */ + + stdout = freopen ("3/tmp2", "w+", stdout); + if (stdout == NULL) + goto Fail3; + + for (ch = 'A', i = 0; i < 26; i++) /* write uppercase alphabet to */ + { /* output file */ + j = fputc (ch, f1); /* test fputc */ + if ((j == EOF) || ( ((char) j) != ch )) + goto Fail; + j = putc (ch, f1); /* test putc */ + if ((j == EOF) || ( ((char) j) != ch )) + goto Fail; + j = putchar (ch); /* test putchar */ + if ((j == EOF) || ( ((char) j) != ch )) + goto Fail; + ch++; + } + + + /* Check files' contents. */ + + rewind (f1); + rewind (stdout); + for (ch = 'A', i = 0; i < 26; i++) + { + if ( (j = fgetc (f1)) == EOF ) + goto Fail; + if ( ((char) (j)) != ch ) + goto Fail; + if ( (j = getc (f1)) == EOF ) + goto Fail; + if ( ((char) (j)) != ch ) + goto Fail; + if ( (j = fgetc (stdout)) == EOF ) + goto Fail; + if ( ((char) (j)) != ch ) + goto Fail; + ch++; + } + + fclose(stdout); /* reset standard out */ + + i = fclose (f1); /* close the update file */ + if (i == EOF) + goto Fail2; + + printf ("Passed Conformance Test 17.9.0.1\n"); + return; + +Fail: + fprintf (stderr, "Failed Conformance Test 17.9.0.1\n"); + return; + +Fail1: + fprintf (stderr, "Unable to open input file for Conformance Test 17.9.0.1\n"); + return; + +Fail2: + fprintf (stderr, "Unable to close input file for Conformance Test 17.9.0.1\n"); + return; + +Fail3: + fprintf (stderr, "Unable to redirect stdout for Conformance Test 17.9.0.1\n"); + return; + } diff --git a/Tests/Conformance/C18.1.0.1.CC b/Tests/Conformance/C18.1.0.1.CC old mode 100755 new mode 100644 index f8f46e4..14eb804 --- a/Tests/Conformance/C18.1.0.1.CC +++ b/Tests/Conformance/C18.1.0.1.CC @@ -1 +1,37 @@ -/* Conformance Test 18.1.0.1: Verification of calloc library function */ #include #include struct S { int i; extended e; char ch [40]; }; main () { char *rgn; int i; rgn = (char *) calloc (50, sizeof (struct S)); if (rgn == NULL) goto Fail1; for (i = 0; i < 2600; i++) { if (*rgn != 0) goto Fail; rgn += 1; } free (rgn); printf ("Passed Conformance Test 18.1.0.1\n"); return; Fail: printf("%u\n", i); printf ("Failed Conformance Test 18.1.0.1\n"); return; Fail1: printf ("Unable to allocate memory for Conformance Test 18.1.0.1\n"); return; } \ No newline at end of file +/* Conformance Test 18.1.0.1: Verification of calloc library function */ + +#include +#include + +struct S { int i; extended e; char ch [40]; }; + +main () + { + char *rgn; + int i; + + rgn = (char *) calloc (50, sizeof (struct S)); + if (rgn == NULL) + goto Fail1; + + for (i = 0; i < 2600; i++) + { + if (*rgn != 0) + goto Fail; + rgn += 1; + } + + free (rgn); + + printf ("Passed Conformance Test 18.1.0.1\n"); + return; + +Fail: +printf("%u\n", i); + printf ("Failed Conformance Test 18.1.0.1\n"); + return; + +Fail1: + printf ("Unable to allocate memory for Conformance Test 18.1.0.1\n"); + return; + } diff --git a/Tests/Conformance/C18.3.0.1.CC b/Tests/Conformance/C18.3.0.1.CC old mode 100755 new mode 100644 index 23fd8fd..f6e4e0f --- a/Tests/Conformance/C18.3.0.1.CC +++ b/Tests/Conformance/C18.3.0.1.CC @@ -1 +1,69 @@ -/* Conformance Test 18.3.0.1: Verification of realloc library function */ #include #include #include struct S { int i; extended e; char ch [40]; }; main () { struct S *rgn, *ptr1; struct S s [3] = { {1, 1.0, "hey"}, {2, 2.0, "you"}, {3, 3.0, "person!"} }; /* Pass realloc a NULL pointer to initialally allocate some memory. */ rgn = (struct S *) realloc (NULL, 3 * (sizeof (struct S)) ); if (rgn == NULL) goto Fail1; /* Copy the structure array s into the allocated area. */ memcpy (rgn, s, sizeof (s)); /* Reallocate a larger area -- ensure initial contents are preserved. */ rgn = (struct S *) realloc (rgn, 5 * (sizeof (struct S)) ); if (rgn == NULL) goto Fail1; ptr1 = rgn; if ((ptr1->i != 1) || (fabs(ptr1->e - 1.0) > 0.00001)) goto Fail; if (strcmp (ptr1->ch, "hey")) goto Fail; ptr1 += 1; if ((ptr1->i != 2) || (fabs(ptr1->e - 2.0) > 0.00001)) goto Fail; if (strcmp (ptr1->ch, "you")) goto Fail; ptr1 += 1; if ((ptr1->i != 3) || (fabs(ptr1->e - 3.0) > 0.00001)) goto Fail; if (strcmp (ptr1->ch, "person!")) goto Fail; /* Ensure passing a size of 0 deallocates the memory. */ rgn = (struct S *) realloc (rgn, 0); if (rgn != NULL) goto Fail1; printf ("Passed Conformance Test 18.3.0.1\n"); return; Fail: printf ("Failed Conformance Test 18.3.0.1\n"); return; Fail1: printf ("Unable to allocate memory for Conformance Test 18.3.0.1\n"); return; } \ No newline at end of file +/* Conformance Test 18.3.0.1: Verification of realloc library function */ + +#include +#include +#include + +struct S { int i; extended e; char ch [40]; }; + +main () + { + struct S *rgn, *ptr1; + struct S s [3] = { {1, 1.0, "hey"}, {2, 2.0, "you"}, {3, 3.0, "person!"} }; + + + /* Pass realloc a NULL pointer to initialally allocate some memory. */ + + rgn = (struct S *) realloc (NULL, 3 * (sizeof (struct S)) ); + if (rgn == NULL) + goto Fail1; + + + /* Copy the structure array s into the allocated area. */ + + memcpy (rgn, s, sizeof (s)); + + + /* Reallocate a larger area -- ensure initial contents are preserved. */ + + rgn = (struct S *) realloc (rgn, 5 * (sizeof (struct S)) ); + if (rgn == NULL) + goto Fail1; + + ptr1 = rgn; + if ((ptr1->i != 1) || (fabs(ptr1->e - 1.0) > 0.00001)) + goto Fail; + if (strcmp (ptr1->ch, "hey")) + goto Fail; + ptr1 += 1; + + if ((ptr1->i != 2) || (fabs(ptr1->e - 2.0) > 0.00001)) + goto Fail; + if (strcmp (ptr1->ch, "you")) + goto Fail; + ptr1 += 1; + + if ((ptr1->i != 3) || (fabs(ptr1->e - 3.0) > 0.00001)) + goto Fail; + if (strcmp (ptr1->ch, "person!")) + goto Fail; + + + /* Ensure passing a size of 0 deallocates the memory. */ + + rgn = (struct S *) realloc (rgn, 0); + if (rgn != NULL) + goto Fail1; + + + printf ("Passed Conformance Test 18.3.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 18.3.0.1\n"); + return; + +Fail1: + printf ("Unable to allocate memory for Conformance Test 18.3.0.1\n"); + return; + } diff --git a/Tests/Conformance/C19.1.0.1.CC b/Tests/Conformance/C19.1.0.1.CC old mode 100755 new mode 100644 index 54dd8a9..9216963 --- a/Tests/Conformance/C19.1.0.1.CC +++ b/Tests/Conformance/C19.1.0.1.CC @@ -1 +1,30 @@ -/* Conformance Test 19.1.0.1: Verification of abs, fabs, labs functions */ #include #include main () { double d1 = -9.0; int i = -8; long L = -32767; d1 = fabs (1.0 + d1); if (fabs(d1 - 8.0) > 0.00001) goto Fail; i = abs (2 + i); if (i != 6) goto Fail; L = labs (5 + L); if (L != 32762) goto Fail; printf ("Passed Conformance Test 19.1.0.1\n"); return; Fail: printf ("Failed Conformance Test 19.1.0.1\n"); } \ No newline at end of file +/* Conformance Test 19.1.0.1: Verification of abs, fabs, labs functions */ + +#include +#include + +main () + { + double d1 = -9.0; + int i = -8; + long L = -32767; + + + d1 = fabs (1.0 + d1); + if (fabs(d1 - 8.0) > 0.00001) + goto Fail; + + i = abs (2 + i); + if (i != 6) + goto Fail; + + L = labs (5 + L); + if (L != 32762) + goto Fail; + + printf ("Passed Conformance Test 19.1.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 19.1.0.1\n"); + } diff --git a/Tests/Conformance/C19.10.0.1.CC b/Tests/Conformance/C19.10.0.1.CC old mode 100755 new mode 100644 index cb70d0b..b6dadd3 --- a/Tests/Conformance/C19.10.0.1.CC +++ b/Tests/Conformance/C19.10.0.1.CC @@ -1 +1,27 @@ -/* Conformance Test 19.10.0.1: Verification of cosh, sinh, tanh library */ /* functions */ #include main () { double d1; d1 = sinh (0.0); if (d1 != 0.0) goto Fail; d1 = cosh (0.0); if (d1 != 1.0) goto Fail; d1 = tanh (0.0); if (d1 != 0.0) goto Fail; printf ("Passed Conformance Test 19.10.0.1\n"); return; Fail: printf ("Failed Conformance Test 19.10.0.1\n"); } \ No newline at end of file +/* Conformance Test 19.10.0.1: Verification of cosh, sinh, tanh library */ +/* functions */ + +#include + +main () + { + double d1; + + d1 = sinh (0.0); + if (d1 != 0.0) + goto Fail; + + d1 = cosh (0.0); + if (d1 != 1.0) + goto Fail; + + d1 = tanh (0.0); + if (d1 != 0.0) + goto Fail; + + printf ("Passed Conformance Test 19.10.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 19.10.0.1\n"); + } diff --git a/Tests/Conformance/C19.2.0.1.CC b/Tests/Conformance/C19.2.0.1.CC old mode 100755 new mode 100644 index 7afd935..96e57fd --- a/Tests/Conformance/C19.2.0.1.CC +++ b/Tests/Conformance/C19.2.0.1.CC @@ -1 +1,24 @@ -/* Conformance Test 19.2.0.1: Verification of div, ldiv library functions */ #include main () { div_t d1; ldiv_t ld1; d1 = div (-9, 3); if ((d1.quot != -3) || (d1.rem != 0)) goto Fail; ld1 = ldiv (-80, 7); if ((ld1.quot != -11) || (ld1.rem != -3)) goto Fail; printf ("Passed Conformance Test 19.2.0.1\n"); return; Fail: printf ("Failed Conformance Test 19.2.0.1\n"); } \ No newline at end of file +/* Conformance Test 19.2.0.1: Verification of div, ldiv library functions */ + +#include + +main () + { + div_t d1; + ldiv_t ld1; + + d1 = div (-9, 3); + if ((d1.quot != -3) || (d1.rem != 0)) + goto Fail; + + ld1 = ldiv (-80, 7); + if ((ld1.quot != -11) || (ld1.rem != -3)) + goto Fail; + + + printf ("Passed Conformance Test 19.2.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 19.2.0.1\n"); + } diff --git a/Tests/Conformance/C19.3.0.1.CC b/Tests/Conformance/C19.3.0.1.CC old mode 100755 new mode 100644 index df95aff..b83f2bb --- a/Tests/Conformance/C19.3.0.1.CC +++ b/Tests/Conformance/C19.3.0.1.CC @@ -1 +1,31 @@ -/* Conformance Test 19.3.0.1: Verification of ceil, floor, fmod functions */ #include main () { double d1; d1 = ceil (-3.26); if (fabs(d1 - (-3.0)) > 0.00001) goto Fail; d1 = floor (-3.26); if (fabs(d1 - (-4.0)) > 0.00001) goto Fail; d1 = fmod (-4.4, 2.0); if (fabs(d1 - (-0.4)) > 0.00001) goto Fail; d1 = fmod (-4.4, 0.0); if (fabs(d1 - (-4.4)) > 0.00001) goto Fail; printf ("Passed Conformance Test 19.3.0.1\n"); return; Fail: printf ("Failed Conformance Test 19.3.0.1\n"); } \ No newline at end of file +/* Conformance Test 19.3.0.1: Verification of ceil, floor, fmod functions */ + +#include + +main () + { + double d1; + + d1 = ceil (-3.26); + if (fabs(d1 - (-3.0)) > 0.00001) + goto Fail; + + d1 = floor (-3.26); + if (fabs(d1 - (-4.0)) > 0.00001) + goto Fail; + + d1 = fmod (-4.4, 2.0); + if (fabs(d1 - (-0.4)) > 0.00001) + goto Fail; + + d1 = fmod (-4.4, 0.0); + if (fabs(d1 - (-4.4)) > 0.00001) + goto Fail; + + + printf ("Passed Conformance Test 19.3.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 19.3.0.1\n"); + } diff --git a/Tests/Conformance/C19.4.0.1.CC b/Tests/Conformance/C19.4.0.1.CC old mode 100755 new mode 100644 index b2aa237..2cc11b6 --- a/Tests/Conformance/C19.4.0.1.CC +++ b/Tests/Conformance/C19.4.0.1.CC @@ -1 +1,27 @@ -/* Conformance Test 19.4.0.1: Verification of exp, log, log10 functions */ #include main () { double d1; d1 = exp (0); if (fabs(d1 - 1.0) > 0.00001) goto Fail; d1 = log (1.0); if (fabs(d1) > 0.00001) goto Fail; d1 = log10 (100.00); if (fabs(d1 - 2.0) > 0.00001) goto Fail; printf ("Passed Conformance Test 19.4.0.1\n"); return; Fail: printf ("Failed Conformance Test 19.4.0.1\n"); } \ No newline at end of file +/* Conformance Test 19.4.0.1: Verification of exp, log, log10 functions */ + +#include + +main () + { + double d1; + + d1 = exp (0); + if (fabs(d1 - 1.0) > 0.00001) + goto Fail; + + d1 = log (1.0); + if (fabs(d1) > 0.00001) + goto Fail; + + d1 = log10 (100.00); + if (fabs(d1 - 2.0) > 0.00001) + goto Fail; + + + printf ("Passed Conformance Test 19.4.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 19.4.0.1\n"); + } diff --git a/Tests/Conformance/C19.6.0.1.CC b/Tests/Conformance/C19.6.0.1.CC old mode 100755 new mode 100644 index 616cc0b..bca508d --- a/Tests/Conformance/C19.6.0.1.CC +++ b/Tests/Conformance/C19.6.0.1.CC @@ -1 +1,31 @@ -/* Conformance Test 19.6.0.1: Verification of pow, sqrt library functions */ #include main () { double d1; d1 = pow (-3.0, 3.0); if (d1 != -27.0) goto Fail; d1 = pow (555.33e+10, 0.0); if (d1 != 1.0) goto Fail; d1 = pow (0.0, 234.77); if (d1 != 0.0) goto Fail; d1 = sqrt (81.0); if (d1 != 9.0) goto Fail; printf ("Passed Conformance Test 19.6.0.1\n"); return; Fail: printf ("Failed Conformance Test 19.6.0.1\n"); } \ No newline at end of file +/* Conformance Test 19.6.0.1: Verification of pow, sqrt library functions */ + +#include + +main () + { + double d1; + + d1 = pow (-3.0, 3.0); + if (d1 != -27.0) + goto Fail; + + d1 = pow (555.33e+10, 0.0); + if (d1 != 1.0) + goto Fail; + + d1 = pow (0.0, 234.77); + if (d1 != 0.0) + goto Fail; + + d1 = sqrt (81.0); + if (d1 != 9.0) + goto Fail; + + + printf ("Passed Conformance Test 19.6.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 19.6.0.1\n"); + } diff --git a/Tests/Conformance/C19.7.0.1.CC b/Tests/Conformance/C19.7.0.1.CC old mode 100755 new mode 100644 index 6350578..bdcf4e9 --- a/Tests/Conformance/C19.7.0.1.CC +++ b/Tests/Conformance/C19.7.0.1.CC @@ -1 +1,48 @@ -/* Conformance Test 19.7.0.1: Verification of rand, srand library functions */ #include main () { int i, j, array1 [20], array30 [20]; for (i = 0; i < 20; i++) { j = rand (); if ((j < 0 ) || (j > 32767)) goto Fail; array1 [i] = j; } srand (30); for (i = 0; i < 20; i++) { j = rand (); if ((j < 0 ) || (j > 32767)) goto Fail; array30 [i] = j; } srand (1); for (i = 0; i < 20; i++) { j = rand (); if (j != array1 [i]) goto Fail; } srand (30); for (i = 0; i < 20; i++) { j = rand (); if (j != array30 [i]) goto Fail; } printf ("Passed Conformance Test 19.7.0.1\n"); return; Fail: printf ("Failed Conformance Test 19.7.0.1\n"); } \ No newline at end of file +/* Conformance Test 19.7.0.1: Verification of rand, srand library functions */ + +#include + +main () + { + int i, j, array1 [20], array30 [20]; + + for (i = 0; i < 20; i++) + { + j = rand (); + if ((j < 0 ) || (j > 32767)) + goto Fail; + array1 [i] = j; + } + + srand (30); + for (i = 0; i < 20; i++) + { + j = rand (); + if ((j < 0 ) || (j > 32767)) + goto Fail; + array30 [i] = j; + } + + srand (1); + for (i = 0; i < 20; i++) + { + j = rand (); + if (j != array1 [i]) + goto Fail; + } + + srand (30); + for (i = 0; i < 20; i++) + { + j = rand (); + if (j != array30 [i]) + goto Fail; + } + + + printf ("Passed Conformance Test 19.7.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 19.7.0.1\n"); + } diff --git a/Tests/Conformance/C19.8.0.1.CC b/Tests/Conformance/C19.8.0.1.CC old mode 100755 new mode 100644 index a51591e..f8e3260 --- a/Tests/Conformance/C19.8.0.1.CC +++ b/Tests/Conformance/C19.8.0.1.CC @@ -1 +1,27 @@ -/* Conformance Test 19.8.0.1: Verification of cos, sin, tan library functions */ #include main () { double d1; d1 = cos (1.0); if (fabs(d1 - 0.540302305) > 0.00001) goto Fail; d1 = sin (1.0); if (fabs(d1 - 0.841470984) > 0.00001) goto Fail; d1 = tan (1.0); if (fabs(d1 - 1.557407725) > 0.00001) goto Fail; printf ("Passed Conformance Test 19.8.0.1\n"); return; Fail: printf ("Failed Conformance Test 19.8.0.1\n"); } \ No newline at end of file +/* Conformance Test 19.8.0.1: Verification of cos, sin, tan library functions */ + +#include + +main () + { + double d1; + + d1 = cos (1.0); + if (fabs(d1 - 0.540302305) > 0.00001) + goto Fail; + + d1 = sin (1.0); + if (fabs(d1 - 0.841470984) > 0.00001) + goto Fail; + + d1 = tan (1.0); + if (fabs(d1 - 1.557407725) > 0.00001) + goto Fail; + + + printf ("Passed Conformance Test 19.8.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 19.8.0.1\n"); + } diff --git a/Tests/Conformance/C19.9.0.1.CC b/Tests/Conformance/C19.9.0.1.CC old mode 100755 new mode 100644 index 0612c5d..9ed0bb6 --- a/Tests/Conformance/C19.9.0.1.CC +++ b/Tests/Conformance/C19.9.0.1.CC @@ -1 +1,32 @@ -/* Conformance Test 19.9.0.1: Verification of acos, asin, atan, atan2 library */ /* functions */ #include main () { double d1; d1 = acos (0.5); if (fabs(d1 - 1.047197551) > 0.00001) goto Fail; d1 = asin (0.5); if (fabs(d1 - 0.523598775) > 0.00001) goto Fail; d1 = atan (0.5); if (fabs(d1 - 0.463647609) > 0.00001) goto Fail; d1 = atan2 (2.0, 1.0); if (fabs(d1 - 1.107148718) > 0.00001) goto Fail; printf ("Passed Conformance Test 19.9.0.1\n"); return; Fail: printf ("Failed Conformance Test 19.9.0.1\n"); } \ No newline at end of file +/* Conformance Test 19.9.0.1: Verification of acos, asin, atan, atan2 library */ +/* functions */ + +#include + +main () + { + double d1; + + d1 = acos (0.5); + if (fabs(d1 - 1.047197551) > 0.00001) + goto Fail; + + d1 = asin (0.5); + if (fabs(d1 - 0.523598775) > 0.00001) + goto Fail; + + d1 = atan (0.5); + if (fabs(d1 - 0.463647609) > 0.00001) + goto Fail; + + d1 = atan2 (2.0, 1.0); + if (fabs(d1 - 1.107148718) > 0.00001) + goto Fail; + + + printf ("Passed Conformance Test 19.9.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 19.9.0.1\n"); + } diff --git a/Tests/Conformance/C2.1.0.1.CC b/Tests/Conformance/C2.1.0.1.CC old mode 100755 new mode 100644 index cdd1312..6ed33c6 --- a/Tests/Conformance/C2.1.0.1.CC +++ b/Tests/Conformance/C2.1.0.1.CC @@ -1 +1,64 @@ -/* Conformance Test 2.1.0.1: Verification of character set */ main () { char string1 [] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; char string2 [] = "abcdefghijklmnopqrstuvwxyz"; char string3 [] = "0123456789"; char string4 [] = " !\"#$%&\'()*+,-./"; char string5 [] = ":;<=>?@"; char string6 [] = "[\\]^_"; char string7 [] = "{|}~"; char string8 [] = "\b\t\v\f\r\a\?"; int encode, i; /* Create a string variable from the required characters and check */ /* its contents against the ASCII encodings for the characters. */ for (i = 0, encode = 0x41; i < 26; i++, encode++) if (string1 [i] != encode) goto Fail; for (i = 0, encode = 0x61; i < 26; i++, encode++) if (string2 [i] != encode) goto Fail; for (i = 0, encode = 0x30; i < 10; i++, encode++) if (string3 [i] != encode) goto Fail; for (i = 0, encode = 0x20; i < 15; i++, encode++) if (string4 [i] != encode) goto Fail; for (i = 0, encode = 0x3A; i < 7; i++, encode++) if (string5 [i] != encode) goto Fail; for (i = 0, encode = 0x5B; i < 5; i++, encode++) if (string6 [i] != encode) goto Fail; for (i = 0, encode = 0x7B; i < 4; i++, encode++) if (string7 [i] != encode) goto Fail; if (string8 [0] != 0x08) goto Fail; if (string8 [1] != 0x09) goto Fail; if (string8 [2] != 0x0B) goto Fail; if (string8 [3] != 0x0C) goto Fail; if (string8 [4] != 0x0D) goto Fail; if (string8 [5] != 0x07) goto Fail; if (string8 [6] != 0x3F) goto Fail; printf ("Passed Conformance Test 2.1.0.1\n"); return; Fail: printf ("Failed Conformance Test 2.1.0.1\n"); } \ No newline at end of file +/* Conformance Test 2.1.0.1: Verification of character set */ +main () + { + char string1 [] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; + char string2 [] = "abcdefghijklmnopqrstuvwxyz"; + char string3 [] = "0123456789"; + char string4 [] = " !\"#$%&\'()*+,-./"; + char string5 [] = ":;<=>?@"; + char string6 [] = "[\\]^_"; + char string7 [] = "{|}~"; + char string8 [] = "\b\t\v\f\r\a\?"; + int encode, i; + + /* Create a string variable from the required characters and check */ + /* its contents against the ASCII encodings for the characters. */ + for (i = 0, encode = 0x41; i < 26; i++, encode++) + if (string1 [i] != encode) + goto Fail; + + for (i = 0, encode = 0x61; i < 26; i++, encode++) + if (string2 [i] != encode) + goto Fail; + + for (i = 0, encode = 0x30; i < 10; i++, encode++) + if (string3 [i] != encode) + goto Fail; + + for (i = 0, encode = 0x20; i < 15; i++, encode++) + if (string4 [i] != encode) + goto Fail; + + for (i = 0, encode = 0x3A; i < 7; i++, encode++) + if (string5 [i] != encode) + goto Fail; + + for (i = 0, encode = 0x5B; i < 5; i++, encode++) + if (string6 [i] != encode) + goto Fail; + + for (i = 0, encode = 0x7B; i < 4; i++, encode++) + if (string7 [i] != encode) + goto Fail; + + if (string8 [0] != 0x08) + goto Fail; + if (string8 [1] != 0x09) + goto Fail; + if (string8 [2] != 0x0B) + goto Fail; + if (string8 [3] != 0x0C) + goto Fail; + if (string8 [4] != 0x0D) + goto Fail; + if (string8 [5] != 0x07) + goto Fail; + if (string8 [6] != 0x3F) + goto Fail; + + printf ("Passed Conformance Test 2.1.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.1.0.1\n"); + } diff --git a/Tests/Conformance/C2.1.0.2.CC b/Tests/Conformance/C2.1.0.2.CC old mode 100755 new mode 100644 index 208560c..c292be3 --- a/Tests/Conformance/C2.1.0.2.CC +++ b/Tests/Conformance/C2.1.0.2.CC @@ -1 +1,41 @@ -/* Conformance Test 2.1.0.2: Verification of ANSI C trigraphs */ ??=define ten 10 /* ??= is '#' */ main () ??< /* ??< is '{' */ int i; char a, b??(10??) = "abc"; /* ??( is '[' */ /* ??) is ']' */ if (ten != 10) goto Fail; if ((strcmp (b, "abc")) != 0) goto Fail; a = '??/n'; /* ??/ is '\' */ if (a != 0x0A) goto Fail; i = 5 ??/ * 8; i = 0x7F ??' 0x03; /* ??' is '^', XOR */ if (i != 0x7C) goto Fail; i = 0x45 ??! 0x03; /* ??! is '|', OR */ if (i != 0x47) goto Fail; i = ??-i; /* ??- is '~', bitwise negation */ if (i != 0xFFB8) goto Fail; printf ("Passed Conformance Test 2.1.0.2\n"); return; Fail: printf ("Failed Conformance Test 2.1.0.2\n"); ??> /* ??> is '}' */ \ No newline at end of file +/* Conformance Test 2.1.0.2: Verification of ANSI C trigraphs */ + +??=define ten 10 /* ??= is '#' */ + +main () + ??< /* ??< is '{' */ + int i; + char a, b??(10??) = "abc"; /* ??( is '[' */ + /* ??) is ']' */ + + if (ten != 10) + goto Fail; + + if ((strcmp (b, "abc")) != 0) + goto Fail; + + a = '??/n'; /* ??/ is '\' */ + if (a != 0x0A) + goto Fail; + + i = 5 ??/ + * 8; + + i = 0x7F ??' 0x03; /* ??' is '^', XOR */ + if (i != 0x7C) + goto Fail; + + i = 0x45 ??! 0x03; /* ??! is '|', OR */ + if (i != 0x47) + goto Fail; + + i = ??-i; /* ??- is '~', bitwise negation */ + if (i != 0xFFB8) + goto Fail; + + printf ("Passed Conformance Test 2.1.0.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.1.0.2\n"); + ??> /* ??> is '}' */ diff --git a/Tests/Conformance/C2.1.0.3.CC b/Tests/Conformance/C2.1.0.3.CC old mode 100755 new mode 100644 index bfcbe59..466d81c --- a/Tests/Conformance/C2.1.0.3.CC +++ b/Tests/Conformance/C2.1.0.3.CC @@ -1 +1,49 @@ -/* Conformance Test 2.1.0.3: Verification of ANSI C trigraphs in */ /* character constants */ main () { char a; a = '??='; /* ??= is '#' */ if (a != '#') goto Fail; a = '??/??/'; /* ??/ is '\' */ if (a != 0x5C) goto Fail; a = '??''; /* ??' is '^' */ if (a != '^') goto Fail; a = '??!'; /* ??! is '|' */ if (a != '|') goto Fail; a = '??-'; /* ??- is '~' */ if (a != '~') goto Fail; a = '??('; /* ??( is '[' */ if (a != '[') goto Fail; a = '??<'; /* ??< is '{' */ if (a != '{') goto Fail; a = '??)'; /* ??) is ']' */ if (a != ']') goto Fail; a = '??>'; /* ??> is '}' */ if (a != '}') goto Fail; printf ("Passed Conformance Test 2.1.0.3\n"); return; Fail: printf ("Failed Conformance Test 2.1.0.3\n"); } \ No newline at end of file +/* Conformance Test 2.1.0.3: Verification of ANSI C trigraphs in */ +/* character constants */ + +main () + { + char a; + + a = '??='; /* ??= is '#' */ + if (a != '#') + goto Fail; + + a = '??/??/'; /* ??/ is '\' */ + if (a != 0x5C) + goto Fail; + + a = '??''; /* ??' is '^' */ + if (a != '^') + goto Fail; + + a = '??!'; /* ??! is '|' */ + if (a != '|') + goto Fail; + + a = '??-'; /* ??- is '~' */ + if (a != '~') + goto Fail; + + a = '??('; /* ??( is '[' */ + if (a != '[') + goto Fail; + + a = '??<'; /* ??< is '{' */ + if (a != '{') + goto Fail; + + a = '??)'; /* ??) is ']' */ + if (a != ']') + goto Fail; + + a = '??>'; /* ??> is '}' */ + if (a != '}') + goto Fail; + + printf ("Passed Conformance Test 2.1.0.3\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.1.0.3\n"); + } diff --git a/Tests/Conformance/C2.1.0.4.CC b/Tests/Conformance/C2.1.0.4.CC old mode 100755 new mode 100644 index f52762c..afea8bc --- a/Tests/Conformance/C2.1.0.4.CC +++ b/Tests/Conformance/C2.1.0.4.CC @@ -1 +1,16 @@ -/* Conformance Test 2.1.0.4: Verification of ANSI C trigraphs in */ /* character string constants */ main () { char a [] = "??=??/boh??'??!??-??(??boy"; if ((strcmp (a, "#\boh^|~[{]}boy")) != 0) goto Fail; printf ("Passed Conformance Test 2.1.0.4\n"); return; Fail: printf ("Failed Conformance Test 2.1.0.4\n"); } \ No newline at end of file +/* Conformance Test 2.1.0.4: Verification of ANSI C trigraphs in */ +/* character string constants */ + +main () + { + char a [] = "??=??/boh??'??!??-??(??boy"; + + if ((strcmp (a, "#\boh^|~[{]}boy")) != 0) + goto Fail; + + printf ("Passed Conformance Test 2.1.0.4\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.1.0.4\n"); + } diff --git a/Tests/Conformance/C2.1.1.1.CC b/Tests/Conformance/C2.1.1.1.CC old mode 100755 new mode 100644 index 655d8f3..6a5bb3b --- a/Tests/Conformance/C2.1.1.1.CC +++ b/Tests/Conformance/C2.1.1.1.CC @@ -1 +1,21 @@ -/* Conformance Test 2.1.1.1: Verification of encoding for null */ #include main () { char string [4]; strcpy (string, ""); if (string [0] != 0) goto Fail; strcpy (string, "abc"); if (string [3] != 0) goto Fail; printf ("Passed Conformance Test 2.1.1.1\n"); return; Fail: printf ("Failed Conformance Test 2.1.1.1\n"); } \ No newline at end of file +/* Conformance Test 2.1.1.1: Verification of encoding for null */ +#include + +main () + { + char string [4]; + + strcpy (string, ""); + if (string [0] != 0) + goto Fail; + + strcpy (string, "abc"); + if (string [3] != 0) + goto Fail; + + printf ("Passed Conformance Test 2.1.1.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.1.1.1\n"); + } diff --git a/Tests/Conformance/C2.1.1.2.CC b/Tests/Conformance/C2.1.1.2.CC old mode 100755 new mode 100644 index 87decb5..7194f32 --- a/Tests/Conformance/C2.1.1.2.CC +++ b/Tests/Conformance/C2.1.1.2.CC @@ -1 +1,23 @@ -/* Conformance Test 2.1.1.2: Verification of newline character */ main () { char string [10]; strcpy (string, "\n"); if (string [0] != 0x0A) goto Fail; strcpy (string, "abc\nf\ngh\n"); if (string [3] != 0x0A) goto Fail; if (string [5] != 0x0A) goto Fail; if (string [8] != 0x0A) goto Fail; printf ("Passed Conformance Test 2.1.1.2\n"); return; Fail: printf ("Failed Conformance Test 2.1.1.2\n"); } \ No newline at end of file +/* Conformance Test 2.1.1.2: Verification of newline character */ +main () + { + char string [10]; + + strcpy (string, "\n"); + if (string [0] != 0x0A) + goto Fail; + + strcpy (string, "abc\nf\ngh\n"); + if (string [3] != 0x0A) + goto Fail; + if (string [5] != 0x0A) + goto Fail; + if (string [8] != 0x0A) + goto Fail; + + printf ("Passed Conformance Test 2.1.1.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.1.1.2\n"); + } diff --git a/Tests/Conformance/C2.1.2.2.CC b/Tests/Conformance/C2.1.2.2.CC old mode 100755 new mode 100644 index 60aa54b..45eff4c --- a/Tests/Conformance/C2.1.2.2.CC +++ b/Tests/Conformance/C2.1.2.2.CC @@ -1 +1,35 @@ -/* Conformance Test 2.1.2.2: Ensure '\' can be used to continue source lines */ main () { int i; i = 5 * \ 6; if \ (i != 30) goto Fail; i = 200 \ - 7; if (\ i != 193) goto Fail; i = \ 7 + 7; if (i\ != 14) goto Fail; i \ += 1; if (i !=\ 15) goto Fail; printf ("Passed Conformance Test 2.1.2.2\n"); return; Fail: printf ("Failed Conformance Test 2.1.2.2\n"); } \ No newline at end of file +/* Conformance Test 2.1.2.2: Ensure '\' can be used to continue source lines */ +main () + { + int i; + + i = 5 * \ + 6; + if \ + (i != 30) + goto Fail; + + i = 200 \ + - 7; + if (\ + i != 193) + goto Fail; + + i = \ + 7 + 7; + if (i\ + != 14) + goto Fail; + + i \ + += 1; + if (i !=\ + 15) + goto Fail; + + printf ("Passed Conformance Test 2.1.2.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.1.2.2\n"); + } diff --git a/Tests/Conformance/C2.1.2.3.CC b/Tests/Conformance/C2.1.2.3.CC old mode 100755 new mode 100644 index 8adc705..0558edd --- a/Tests/Conformance/C2.1.2.3.CC +++ b/Tests/Conformance/C2.1.2.3.CC @@ -1 +1,13 @@ -/* Conformance Test 2.1.2.3: Ensure '\' can be used to continue preprocessor */ /* lines */ #include \ #define CONSTANT \ 5 main () { if (CONSTANT != 5) printf ("Failed Conformance Test 2.1.2.3\n"); else printf ("Passed Conformance Test 2.1.2.3\n"); } \ No newline at end of file +/* Conformance Test 2.1.2.3: Ensure '\' can be used to continue preprocessor */ +/* lines */ +#include \ + +#define CONSTANT \ + 5 +main () + { + if (CONSTANT != 5) + printf ("Failed Conformance Test 2.1.2.3\n"); + else + printf ("Passed Conformance Test 2.1.2.3\n"); + } diff --git a/Tests/Conformance/C2.2.0.1.CC b/Tests/Conformance/C2.2.0.1.CC old mode 100755 new mode 100644 index 47c2247..0d878f6 --- a/Tests/Conformance/C2.2.0.1.CC +++ b/Tests/Conformance/C2.2.0.1.CC @@ -1 +1,6 @@ -/* Test 2.2.0.1: in-line comments */ main (/* This should be ignored */) /*{ brackets should not be seen }*/ { printf ("Passed Conformance Test 2.2.0.1\n"); /**//*****/} \ No newline at end of file +/* Test 2.2.0.1: in-line comments */ +main (/* This should be ignored */) + /*{ brackets should not be seen }*/ + { + printf ("Passed Conformance Test 2.2.0.1\n"); + /**//*****/} diff --git a/Tests/Conformance/C2.2.0.2.CC b/Tests/Conformance/C2.2.0.2.CC old mode 100755 new mode 100644 index c537e29..9ca1347 --- a/Tests/Conformance/C2.2.0.2.CC +++ b/Tests/Conformance/C2.2.0.2.CC @@ -1 +1,14 @@ -/* Conformance Test 2.2.0.2: Comments crossing multiple lines */ main () { /* Should ignore this comment line as well as this comment line and this and this and this and this and this */ printf ("Passed Conformance Test 2.2.0.2\n"); } \ No newline at end of file +/* Conformance Test 2.2.0.2: Comments crossing multiple lines */ +main () + { + /* Should ignore this + comment line + as well as this comment line + and this + and this + and this + and this + and this + */ + printf ("Passed Conformance Test 2.2.0.2\n"); + } diff --git a/Tests/Conformance/C2.2.0.3.CC b/Tests/Conformance/C2.2.0.3.CC old mode 100755 new mode 100644 index 48c5eb2..27d5ee1 --- a/Tests/Conformance/C2.2.0.3.CC +++ b/Tests/Conformance/C2.2.0.3.CC @@ -1 +1,16 @@ -/* Conformance test 2.2.0.3: Comments in preprocessor lines */ #define ten /* ten: one greater than nine */ (2 * 5) main () { if (ten == 10) { printf ("Passed Conformance Test 2.2.0.3\n"); } else { printf ("Failed Conformance Test 2.2.0.3\n"); } } \ No newline at end of file +/* Conformance test 2.2.0.3: Comments in preprocessor lines */ +#define ten /* ten: + one greater + than nine + */ (2 * 5) +main () + { + if (ten == 10) + { + printf ("Passed Conformance Test 2.2.0.3\n"); + } + else + { + printf ("Failed Conformance Test 2.2.0.3\n"); + } + } diff --git a/Tests/Conformance/C2.2.0.4.CC b/Tests/Conformance/C2.2.0.4.CC old mode 100755 new mode 100644 index 50f3f1a..84c5e40 --- a/Tests/Conformance/C2.2.0.4.CC +++ b/Tests/Conformance/C2.2.0.4.CC @@ -1 +1,9 @@ -/* Conformance test 2.2.0.4: Comment characters in strings */ main () { if (strlen("/*") == 2) printf ("Passed Conformance Test 2.2.0.4\n"); else printf ("Failed Conformance Test 2.2.0.4\n"); } \ No newline at end of file +/* Conformance test 2.2.0.4: Comment characters in strings */ + +main () + { + if (strlen("/*") == 2) + printf ("Passed Conformance Test 2.2.0.4\n"); + else + printf ("Failed Conformance Test 2.2.0.4\n"); + } diff --git a/Tests/Conformance/C2.4.0.1.CC b/Tests/Conformance/C2.4.0.1.CC old mode 100755 new mode 100644 index f59333d..18f9aa9 --- a/Tests/Conformance/C2.4.0.1.CC +++ b/Tests/Conformance/C2.4.0.1.CC @@ -1 +1,12 @@ -/* Conformance Test 2.4.0.1: Ensure =+ is assigment followed by unary plus */ main () { int a; a = 3; a =+ 2; if (a == 2) printf ("Passed Conformance Test 2.4.0.1\n"); else printf ("Failed Conformance Test 2.4.0.1\n"); } \ No newline at end of file +/* Conformance Test 2.4.0.1: Ensure =+ is assigment followed by unary plus */ +main () + { + int a; + + a = 3; + a =+ 2; + if (a == 2) + printf ("Passed Conformance Test 2.4.0.1\n"); + else + printf ("Failed Conformance Test 2.4.0.1\n"); + } diff --git a/Tests/Conformance/C2.4.0.2.CC b/Tests/Conformance/C2.4.0.2.CC old mode 100755 new mode 100644 index 34ae122..e8789e8 --- a/Tests/Conformance/C2.4.0.2.CC +++ b/Tests/Conformance/C2.4.0.2.CC @@ -1 +1,12 @@ -/* Conformance Test 2.4.0.2: Ensure =- is assigment followed by unary minus */ main () { int a; a = 3; a =- 2; if (a == -2) printf ("Passed Conformance Test 2.4.0.2\n"); else printf ("Failed Conformance Test 2.4.0.2\n"); } \ No newline at end of file +/* Conformance Test 2.4.0.2: Ensure =- is assigment followed by unary minus */ +main () + { + int a; + + a = 3; + a =- 2; + if (a == -2) + printf ("Passed Conformance Test 2.4.0.2\n"); + else + printf ("Failed Conformance Test 2.4.0.2\n"); + } diff --git a/Tests/Conformance/C2.5.0.1.CC b/Tests/Conformance/C2.5.0.1.CC old mode 100755 new mode 100644 index d7c522d..908fed1 --- a/Tests/Conformance/C2.5.0.1.CC +++ b/Tests/Conformance/C2.5.0.1.CC @@ -1 +1,65 @@ -/* Conformance Test 2.5.0.1: Test characters comprising identifiers for */ /* variables */ main () { int a_______________000000000000000000000000000000; short _____________________________________________9; long \ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210; long \ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321; char abc; char aBc; ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 = 8; ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 = 3; if (\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 != 8) goto Fail; if (\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 != 3) goto Fail; abc = 'a'; aBc = 'b'; if ((abc == 'b') || (aBc == 'a')) goto Fail; a_______________000000000000000000000000000000 = 32767; if (a_______________000000000000000000000000000000 != 0x7FFF) goto Fail; _____________________________________________9 = -4009; if (_____________________________________________9 != -4009) goto Fail; printf ("Passed Conformance Test 2.5.0.1\n"); return; Fail: printf ("Failed Conformance Test 2.5.0.1\n"); } \ No newline at end of file +/* Conformance Test 2.5.0.1: Test characters comprising identifiers for */ +/* variables */ +main () + { + int a_______________000000000000000000000000000000; + short _____________________________________________9; + + long \ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210; + + long \ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321; + + char abc; + char aBc; + +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 = 8; + +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 = 3; + + if (\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 != 8) + goto Fail; + + if (\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 != 3) + goto Fail; + + abc = 'a'; + aBc = 'b'; + if ((abc == 'b') || (aBc == 'a')) + goto Fail; + + a_______________000000000000000000000000000000 = 32767; + if (a_______________000000000000000000000000000000 != 0x7FFF) + goto Fail; + + _____________________________________________9 = -4009; + if (_____________________________________________9 != -4009) + goto Fail; + + printf ("Passed Conformance Test 2.5.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.5.0.1\n"); + } diff --git a/Tests/Conformance/C2.5.0.2.CC b/Tests/Conformance/C2.5.0.2.CC old mode 100755 new mode 100644 index ad74e57..c209efe --- a/Tests/Conformance/C2.5.0.2.CC +++ b/Tests/Conformance/C2.5.0.2.CC @@ -1 +1,75 @@ -/* Conformance Test 2.5.0.2: Test characters comprising function identifiers */ main () { extern double i_______________000000000000000000000000000000__________ (); extern float \ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210____________01234567899876543210 (); extern long \ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210____________0123456789987654321 (); double k; float t, realNum; long m; k = i_______________000000000000000000000000000000__________ (); if (k != 1.0e0) goto Fail; t = \ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210____________01234567899876543210 (); realNum = 2.5e1; if (realNum != 2.5e1) goto Fail; m = \ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210____________0123456789987654321 (4, 5); if (m != 20L) goto Fail; printf ("Passed Conformance Test 2.5.0.2\n"); return; Fail: printf ("Failed Conformance Test 2.5.0.2\n"); } /************************************************************************/ double i_______________000000000000000000000000000000__________ () { return (1.); } /************************************************************************/ float \ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210____________01234567899876543210 () { return (25.0); } /************************************************************************/ long \ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210____________0123456789987654321 ( _a_very_long_long_long_long_long_000000088888888888_parameter, ____________________________________another_long_parameter ) int _a_very_long_long_long_long_long_000000088888888888_parameter, ____________________________________another_long_parameter; { return ( \ _a_very_long_long_long_long_long_000000088888888888_parameter * \ ____________________________________another_long_parameter ); } \ No newline at end of file +/* Conformance Test 2.5.0.2: Test characters comprising function identifiers */ +main () + { + extern double i_______________000000000000000000000000000000__________ (); + + extern float \ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210____________01234567899876543210 (); + + extern long \ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210____________0123456789987654321 (); + + double k; + float t, realNum; + long m; + + k = i_______________000000000000000000000000000000__________ (); + if (k != 1.0e0) + goto Fail; + + t = \ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210____________01234567899876543210 (); + realNum = 2.5e1; + if (realNum != 2.5e1) + goto Fail; + + m = \ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210____________0123456789987654321 (4, 5); + if (m != 20L) + goto Fail; + + printf ("Passed Conformance Test 2.5.0.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.5.0.2\n"); + } + +/************************************************************************/ + +double i_______________000000000000000000000000000000__________ () + { + return (1.); + } + + +/************************************************************************/ + +float \ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210____________01234567899876543210 () + { + return (25.0); + } + +/************************************************************************/ + +long \ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210____________0123456789987654321 + + ( _a_very_long_long_long_long_long_000000088888888888_parameter, + ____________________________________another_long_parameter ) + + int _a_very_long_long_long_long_long_000000088888888888_parameter, + ____________________________________another_long_parameter; + + { + return ( \ + _a_very_long_long_long_long_long_000000088888888888_parameter * \ + ____________________________________another_long_parameter ); + } diff --git a/Tests/Conformance/C2.5.0.3.CC b/Tests/Conformance/C2.5.0.3.CC old mode 100755 new mode 100644 index 5e2169b..4a401f9 --- a/Tests/Conformance/C2.5.0.3.CC +++ b/Tests/Conformance/C2.5.0.3.CC @@ -1 +1,48 @@ -/* Conformance Test 2.5.0.3: Test characters comprising identifiers for */ /* user-defined types */ main () { typedef short _____________________________________________9; typedef long \ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210; typedef float \ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321; ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 x; ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 y; _____________________________________________9 s; s = 0x7FFF; if (s != 32767) goto Fail; x = 0x7FFFFFFF; if (x != 2147483647) goto Fail; y = 97.5; if (y != .975e+2) goto Fail; printf ("Passed Conformance Test 2.5.0.3\n"); return; Fail: printf ("Failed Conformance Test 2.5.0.3\n"); } \ No newline at end of file +/* Conformance Test 2.5.0.3: Test characters comprising identifiers for */ +/* user-defined types */ +main () + { + typedef short _____________________________________________9; + + typedef long \ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210; + + typedef float \ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321; + +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 x; + +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 y; + + _____________________________________________9 s; + + s = 0x7FFF; + if (s != 32767) + goto Fail; + + x = 0x7FFFFFFF; + if (x != 2147483647) + goto Fail; + + y = 97.5; + if (y != .975e+2) + goto Fail; + + printf ("Passed Conformance Test 2.5.0.3\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.5.0.3\n"); + } diff --git a/Tests/Conformance/C2.5.0.4.CC b/Tests/Conformance/C2.5.0.4.CC old mode 100755 new mode 100644 index 670960b..dde587f --- a/Tests/Conformance/C2.5.0.4.CC +++ b/Tests/Conformance/C2.5.0.4.CC @@ -1 +1,111 @@ -/* Conformance Test 2.5.0.4: Test characters comprising identifiers for */ /* structures */ main () { struct _____________________________________________9 { int ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\ _____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz_____________01234567899876543210\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210; long ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\ _____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz_____________01234567899876543210\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 0123456789987654321; } abcDEF, ABCdef; struct _____________________________________________9 s; abcDEF.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 = 26; abcDEF.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 = 2147483647; ABCdef.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 = 25; ABCdef.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 = 2147483646; s.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 = -5; s.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 = -2147483647; if (abcDEF.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 == \ ABCdef.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210) goto Fail; if (abcDEF.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 == \ s.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210) goto Fail; if (abcDEF.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 == \ ABCdef.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321) goto Fail; if (abcDEF.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 == \ s.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321) goto Fail; printf ("Passed Conformance Test 2.5.0.4\n"); return; Fail: printf ("Failed Conformance Test 2.5.0.4\n"); } \ No newline at end of file +/* Conformance Test 2.5.0.4: Test characters comprising identifiers for */ +/* structures */ +main () + { + struct _____________________________________________9 { + + int ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\ +_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz_____________01234567899876543210\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210; + + long ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\ +_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz_____________01234567899876543210\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +0123456789987654321; } abcDEF, ABCdef; + + struct _____________________________________________9 s; + + abcDEF.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 = 26; + + abcDEF.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 = 2147483647; + + ABCdef.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 = 25; + + ABCdef.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 = 2147483646; + + s.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 = -5; + + s.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 = -2147483647; + + if (abcDEF.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 == \ + ABCdef.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210) + goto Fail; + + if (abcDEF.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 == \ + s.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210) + goto Fail; + + if (abcDEF.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 == \ + ABCdef.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321) + goto Fail; + + if (abcDEF.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 == \ + s.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321) + goto Fail; + + + printf ("Passed Conformance Test 2.5.0.4\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.5.0.4\n"); + } diff --git a/Tests/Conformance/C2.5.0.5.CC b/Tests/Conformance/C2.5.0.5.CC old mode 100755 new mode 100644 index 7935def..9dd6988 --- a/Tests/Conformance/C2.5.0.5.CC +++ b/Tests/Conformance/C2.5.0.5.CC @@ -1 +1,112 @@ -/* Conformance Test 2.5.0.5: Test characters comprising identifiers for */ /* unions */ main () { union _____________________________________________9 { int ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\ _____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz_____________01234567899876543210\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210; long ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\ _____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz_____________01234567899876543210\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 0123456789987654321; } abcDEF, ABCdef; union _____________________________________________9 s; /* Assign and check 1st union field for each variable. */ abcDEF.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 = 26; ABCdef.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 = 25; s.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 = -5; if (abcDEF.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 == \ ABCdef.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210) goto Fail; if (abcDEF.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 == \ s.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210) goto Fail; /* Assign and check 2nd union field for each variable. */ abcDEF.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 = 2147483647; ABCdef.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 = 2147483646; s.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 = -2147483647; if (abcDEF.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 == \ ABCdef.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321) goto Fail; if (abcDEF.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 == \ s.\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321) goto Fail; printf ("Passed Conformance Test 2.5.0.5\n"); return; Fail: printf ("Failed Conformance Test 2.5.0.5\n"); } \ No newline at end of file +/* Conformance Test 2.5.0.5: Test characters comprising identifiers for */ +/* unions */ +main () + { + union _____________________________________________9 { + + int ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\ +_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz_____________01234567899876543210\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210; + + long ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\ +_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz_____________01234567899876543210\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +0123456789987654321; } abcDEF, ABCdef; + + union _____________________________________________9 s; + + /* Assign and check 1st union field for each variable. */ + abcDEF.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 = 26; + + ABCdef.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 = 25; + + s.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 = -5; + + if (abcDEF.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 == \ + ABCdef.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210) + goto Fail; + + if (abcDEF.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 == \ + s.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210) + goto Fail; + + /* Assign and check 2nd union field for each variable. */ + abcDEF.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 = 2147483647; + + ABCdef.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 = 2147483646; + + s.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 = -2147483647; + + if (abcDEF.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 == \ + ABCdef.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321) + goto Fail; + + if (abcDEF.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 == \ + s.\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321) + goto Fail; + + printf ("Passed Conformance Test 2.5.0.5\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.5.0.5\n"); + } diff --git a/Tests/Conformance/C2.5.0.6.CC b/Tests/Conformance/C2.5.0.6.CC old mode 100755 new mode 100644 index 6602d02..bbcf9c6 --- a/Tests/Conformance/C2.5.0.6.CC +++ b/Tests/Conformance/C2.5.0.6.CC @@ -1 +1,70 @@ -/* Conformance Test 2.5.0.6: Test characters comprising identifiers for */ /* enumerations */ main () { enum _____________________________________________9 { ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\ _____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz_____________01234567899876543210\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210, ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\ _____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz_____________01234567899876543210\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 0123456789987654321 } abcDEF, ABCdef; enum _____________________________________________9 s; /* Assign and check 1st enum field for each variable. */ abcDEF = \ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210; ABCdef = \ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210; s = \ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210; if ((abcDEF != ABCdef) || (abcDEF != s) || (ABCdef != 0)) goto Fail; /* Assign and check 2nd union field for each variable. */ abcDEF = \ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321; ABCdef = \ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321; s = \ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321; if ((abcDEF != ABCdef) || (s != abcDEF) || (s != 1)) goto Fail; printf ("Passed Conformance Test 2.5.0.6\n"); return; Fail: printf ("Failed Conformance Test 2.5.0.6\n"); } \ No newline at end of file +/* Conformance Test 2.5.0.6: Test characters comprising identifiers for */ +/* enumerations */ +main () + { + enum _____________________________________________9 { + + ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\ +_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz_____________01234567899876543210\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210, + + ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\ +_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz_____________01234567899876543210\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +0123456789987654321 } abcDEF, ABCdef; + + enum _____________________________________________9 s; + + /* Assign and check 1st enum field for each variable. */ + abcDEF = \ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210; + + ABCdef = \ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210; + + s = \ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210; + + if ((abcDEF != ABCdef) || (abcDEF != s) || (ABCdef != 0)) + goto Fail; + + /* Assign and check 2nd union field for each variable. */ + abcDEF = \ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321; + + ABCdef = \ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321; + + s = \ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321; + + if ((abcDEF != ABCdef) || (s != abcDEF) || (s != 1)) + goto Fail; + + printf ("Passed Conformance Test 2.5.0.6\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.5.0.6\n"); + } diff --git a/Tests/Conformance/C2.5.0.7.CC b/Tests/Conformance/C2.5.0.7.CC old mode 100755 new mode 100644 index 46aa74d..28d56bc --- a/Tests/Conformance/C2.5.0.7.CC +++ b/Tests/Conformance/C2.5.0.7.CC @@ -1 +1,39 @@ -/* Conformance Test 2.5.0.7: Test characters comprising identifiers for */ /* preprocessor macros */ #define _____________________________________________9 10 #define ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\ _____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz_____________01234567899876543210\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210 20 #define ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\ _____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz_____________01234567899876543210\ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 0123456789987654321 30 main () { if (_____________________________________________9 != 10) goto Fail; if (ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 != 20) goto Fail; if (ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 != 30) goto Fail; printf ("Passed Conformance Test 2.5.0.7\n"); return; Fail: printf ("Failed Conformance Test 2.5.0.7\n"); } \ No newline at end of file +/* Conformance Test 2.5.0.7: Test characters comprising identifiers for */ +/* preprocessor macros */ +#define _____________________________________________9 10 + +#define ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\ +_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz_____________01234567899876543210\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210 20 + +#define ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\ +_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz_____________01234567899876543210\ +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +0123456789987654321 30 + +main () + { + if (_____________________________________________9 != 10) + goto Fail; + + if (ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210 != 20) + goto Fail; + + if (ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321 != 30) + goto Fail; + + printf ("Passed Conformance Test 2.5.0.7\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.5.0.7\n"); + } diff --git a/Tests/Conformance/C2.5.0.8.CC b/Tests/Conformance/C2.5.0.8.CC old mode 100755 new mode 100644 index c636698..439909c --- a/Tests/Conformance/C2.5.0.8.CC +++ b/Tests/Conformance/C2.5.0.8.CC @@ -1 +1,34 @@ -/* Conformance Test 2.5.0.8: Test characters comprising identifiers for */ /* labels */ main () { goto _____________________________________________9; Fail: printf ("Failed Conformance Test 2.5.0.8\n"); _____________________________________________9: goto ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210; goto Fail; ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210: goto ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321; goto Fail; ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ 01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321: printf ("Passed Conformance Test 2.5.0.8\n"); return; } \ No newline at end of file +/* Conformance Test 2.5.0.8: Test characters comprising identifiers for */ +/* labels */ +main () + { + goto _____________________________________________9; + +Fail: + printf ("Failed Conformance Test 2.5.0.8\n"); + +_____________________________________________9: + goto ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210; + goto Fail; + +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________01234567899876543210: + goto ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321; + goto Fail; + +ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_____________\ +01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs\ +tuvwxyz_____________01234567899876543210ABCDEFGHIJKLMNOPQRSTUVWXY\ +Zabcdefghijklmnopqrstuvwxyz_____________0123456789987654321: + + printf ("Passed Conformance Test 2.5.0.8\n"); + return; + } diff --git a/Tests/Conformance/C2.6.0.1.CC b/Tests/Conformance/C2.6.0.1.CC old mode 100755 new mode 100644 index f0d57b3..6bc7b71 --- a/Tests/Conformance/C2.6.0.1.CC +++ b/Tests/Conformance/C2.6.0.1.CC @@ -1 +1,120 @@ -/* Conformance Test 2.6.0.1: Check if reserved words can be used as */ /* preprocessor macro names. All reserved */ /* words except GOTO, IF, and RETURN are */ /* checked. (They're used in the program) */ #define asm 1 #define auto 2 #define break 3 #define case 4 #define char 5 #define comp 6 #define const 7 #define continue 8 #define default 9 #define do 10 #define double 11 #define else 12 #define enum 13 #define extended 14 #define extern 15 #define float 16 #define for 17 #define inline 18 #define int 19 #define long 20 #define pascal 21 #define register 22 #define segment 23 #define short 24 #define signed 25 #define sizeof 26 #define static 27 #define struct 28 #define switch 29 #define typedef 30 #define union 31 #define unsigned 32 #define void 33 #define volatile 34 #define while 35 main () { if (asm != 1) goto Fail; if (auto != 2) goto Fail; if (break != 3) goto Fail; if (case != 4) goto Fail; if (char != 5) goto Fail; if (comp != 6) goto Fail; if (const != 7) goto Fail; if (continue != 8) goto Fail; if (default != 9) goto Fail; if (do != 10) goto Fail; if (double != 11) goto Fail; if (else != 12) goto Fail; if (enum != 13) goto Fail; if (extended != 14) goto Fail; if (extern != 15) goto Fail; if (float != 16) goto Fail; if (for != 17) goto Fail; if (inline != 18) goto Fail; if (int != 19) goto Fail; if (long != 20) goto Fail; if (pascal != 21) goto Fail; if (register != 22) goto Fail; if (segment != 23) goto Fail; if (short != 24) goto Fail; if (signed != 25) goto Fail; if (sizeof != 26) goto Fail; if (static != 27) goto Fail; if (struct != 28) goto Fail; if (switch != 29) goto Fail; if (typedef != 30) goto Fail; if (union != 31) goto Fail; if (unsigned != 32) goto Fail; if (void != 33) goto Fail; if (volatile != 34) goto Fail; if (while != 35) goto Fail; printf ("Passed Conformance Test 2.6.0.1\n"); return; Fail: printf ("Failed Conformance Test 2.6.0.1\n"); } \ No newline at end of file +/* Conformance Test 2.6.0.1: Check if reserved words can be used as */ +/* preprocessor macro names. All reserved */ +/* words except GOTO, IF, and RETURN are */ +/* checked. (They're used in the program) */ + +#define asm 1 +#define auto 2 +#define break 3 +#define case 4 +#define char 5 +#define comp 6 +#define const 7 +#define continue 8 +#define default 9 +#define do 10 +#define double 11 +#define else 12 +#define enum 13 +#define extended 14 +#define extern 15 +#define float 16 +#define for 17 +#define inline 18 +#define int 19 +#define long 20 +#define pascal 21 +#define register 22 +#define segment 23 +#define short 24 +#define signed 25 +#define sizeof 26 +#define static 27 +#define struct 28 +#define switch 29 +#define typedef 30 +#define union 31 +#define unsigned 32 +#define void 33 +#define volatile 34 +#define while 35 + +main () + { + if (asm != 1) + goto Fail; + if (auto != 2) + goto Fail; + if (break != 3) + goto Fail; + if (case != 4) + goto Fail; + if (char != 5) + goto Fail; + if (comp != 6) + goto Fail; + if (const != 7) + goto Fail; + if (continue != 8) + goto Fail; + if (default != 9) + goto Fail; + if (do != 10) + goto Fail; + if (double != 11) + goto Fail; + if (else != 12) + goto Fail; + if (enum != 13) + goto Fail; + if (extended != 14) + goto Fail; + if (extern != 15) + goto Fail; + if (float != 16) + goto Fail; + if (for != 17) + goto Fail; + if (inline != 18) + goto Fail; + if (int != 19) + goto Fail; + if (long != 20) + goto Fail; + if (pascal != 21) + goto Fail; + if (register != 22) + goto Fail; + if (segment != 23) + goto Fail; + if (short != 24) + goto Fail; + if (signed != 25) + goto Fail; + if (sizeof != 26) + goto Fail; + if (static != 27) + goto Fail; + if (struct != 28) + goto Fail; + if (switch != 29) + goto Fail; + if (typedef != 30) + goto Fail; + if (union != 31) + goto Fail; + if (unsigned != 32) + goto Fail; + if (void != 33) + goto Fail; + if (volatile != 34) + goto Fail; + if (while != 35) + goto Fail; + + printf ("Passed Conformance Test 2.6.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.6.0.1\n"); + } diff --git a/Tests/Conformance/C2.6.0.2.CC b/Tests/Conformance/C2.6.0.2.CC old mode 100755 new mode 100644 index 50939c2..82f17fb --- a/Tests/Conformance/C2.6.0.2.CC +++ b/Tests/Conformance/C2.6.0.2.CC @@ -1 +1,30 @@ -/* Conformance Test 2.6.0.2: Check if reserved words can be used as */ /* preprocessor macro names */ #define goto 1 #define if 2 #define return 3 main () { while (goto != 1) { printf ("Failed Conformance Test 2.6.0.2\n"); exit (1); } while (if != 2) { printf ("Failed Conformance Test 2.6.0.2\n"); exit (1); } while (return != 3) { printf ("Failed Conformance Test 2.6.0.2\n"); exit (1); } printf ("Passed Conformance Test 2.6.0.2\n"); } \ No newline at end of file +/* Conformance Test 2.6.0.2: Check if reserved words can be used as */ +/* preprocessor macro names */ + +#define goto 1 +#define if 2 +#define return 3 + +main () + { + + while (goto != 1) + { + printf ("Failed Conformance Test 2.6.0.2\n"); + exit (1); + } + + while (if != 2) + { + printf ("Failed Conformance Test 2.6.0.2\n"); + exit (1); + } + + while (return != 3) + { + printf ("Failed Conformance Test 2.6.0.2\n"); + exit (1); + } + + printf ("Passed Conformance Test 2.6.0.2\n"); + } diff --git a/Tests/Conformance/C2.6.0.3.CC b/Tests/Conformance/C2.6.0.3.CC old mode 100755 new mode 100644 index 71dba33..28e5a1a --- a/Tests/Conformance/C2.6.0.3.CC +++ b/Tests/Conformance/C2.6.0.3.CC @@ -1 +1,12 @@ -/* Conformance Test 2.6.0.3: Ensure reserved words within identifiers are */ /* ignored */ main () { int asmm, auto_1, tbreak, casechar, continue_default, dodoubleelse; short _comp, extended_, inlinee, pascal0, segment_; long enum_external, floatforgoto, ifi, inty, longy, registerreturn; float short2, sizeofF, staticstruct, switch_, typedef0, union_; double unsignedNum, voidT, while_, aconst, isigned, _volatile; printf ("Passed Conformance Test 2.6.0.3\n"); } \ No newline at end of file +/* Conformance Test 2.6.0.3: Ensure reserved words within identifiers are */ +/* ignored */ +main () + { + int asmm, auto_1, tbreak, casechar, continue_default, dodoubleelse; + short _comp, extended_, inlinee, pascal0, segment_; + long enum_external, floatforgoto, ifi, inty, longy, registerreturn; + float short2, sizeofF, staticstruct, switch_, typedef0, union_; + double unsignedNum, voidT, while_, aconst, isigned, _volatile; + + printf ("Passed Conformance Test 2.6.0.3\n"); + } diff --git a/Tests/Conformance/C2.6.0.4.CC b/Tests/Conformance/C2.6.0.4.CC old mode 100755 new mode 100644 index ae12578..41e8ab0 --- a/Tests/Conformance/C2.6.0.4.CC +++ b/Tests/Conformance/C2.6.0.4.CC @@ -1 +1,44 @@ -/* Conformance Test 2.6.0.4: Ensure reserved words within strings are ignored */ main () { char s0 [] = "asm"; char s1 [] = "auto"; char s2 [] = "break"; char s3 [] = "case"; char s4 [] = "char"; char s5 [] = "continue"; char s6 [] = "default"; char s7 [] = "do"; char s8 [] = "double"; char s9 [] = "else"; char s10[] = "enum"; char s11[] = "extern"; char s12[] = "float"; char s13[] = "for"; char s14[] = "goto"; char s15[] = "if"; char s16[] = "int"; char s17[] = "long"; char s18[] = "register"; char s19[] = "return"; char s20[] = "short"; char s21[] = "sizeof"; char s22[] = "static"; char s23[] = "struct"; char s24[] = "switch"; char s25[] = "typedef"; char s26[] = "union"; char s27[] = "unsigned"; char s28[] = "void"; char s29[] = "while"; char s30[] = "const"; char s31[] = "signed"; char s32[] = "volatile"; char s33[] = "comp"; char s34[] = "extended"; char s35[] = "inline"; char s36[] = "pascal"; char s37[] = "segment"; printf ("Passed Conformance Test 2.6.0.4\n"); } \ No newline at end of file +/* Conformance Test 2.6.0.4: Ensure reserved words within strings are ignored */ +main () + { + char s0 [] = "asm"; + char s1 [] = "auto"; + char s2 [] = "break"; + char s3 [] = "case"; + char s4 [] = "char"; + char s5 [] = "continue"; + char s6 [] = "default"; + char s7 [] = "do"; + char s8 [] = "double"; + char s9 [] = "else"; + char s10[] = "enum"; + char s11[] = "extern"; + char s12[] = "float"; + char s13[] = "for"; + char s14[] = "goto"; + char s15[] = "if"; + char s16[] = "int"; + char s17[] = "long"; + char s18[] = "register"; + char s19[] = "return"; + char s20[] = "short"; + char s21[] = "sizeof"; + char s22[] = "static"; + char s23[] = "struct"; + char s24[] = "switch"; + char s25[] = "typedef"; + char s26[] = "union"; + char s27[] = "unsigned"; + char s28[] = "void"; + char s29[] = "while"; + char s30[] = "const"; + char s31[] = "signed"; + char s32[] = "volatile"; + char s33[] = "comp"; + char s34[] = "extended"; + char s35[] = "inline"; + char s36[] = "pascal"; + char s37[] = "segment"; + + printf ("Passed Conformance Test 2.6.0.4\n"); + } diff --git a/Tests/Conformance/C2.6.0.5.CC b/Tests/Conformance/C2.6.0.5.CC old mode 100755 new mode 100644 index 2f4efbc..87eb8db --- a/Tests/Conformance/C2.6.0.5.CC +++ b/Tests/Conformance/C2.6.0.5.CC @@ -1 +1,12 @@ -/* Conformance Test 2.6.0.5: Ensure reserved words within comments are */ /* ignored */ main () { /* int auto, break, case, char, continue, default, do, double; */ /* long else, enum, extern, float, for, goto, if, int, long; */ /* float register, return, short, sizeof, static, struct, switch; */ /* double typedef, union, unsigned, void, while, const, signed; */ /* short volatile, asm, comp, extended, inline, pascal, segment; */ printf ("Passed Conformance Test 2.6.0.5\n"); } \ No newline at end of file +/* Conformance Test 2.6.0.5: Ensure reserved words within comments are */ +/* ignored */ +main () + { + /* int auto, break, case, char, continue, default, do, double; */ + /* long else, enum, extern, float, for, goto, if, int, long; */ + /* float register, return, short, sizeof, static, struct, switch; */ + /* double typedef, union, unsigned, void, while, const, signed; */ + /* short volatile, asm, comp, extended, inline, pascal, segment; */ + + printf ("Passed Conformance Test 2.6.0.5\n"); + } diff --git a/Tests/Conformance/C2.7.1.1.CC b/Tests/Conformance/C2.7.1.1.CC old mode 100755 new mode 100644 index 41c8ed9..ee1b3a9 --- a/Tests/Conformance/C2.7.1.1.CC +++ b/Tests/Conformance/C2.7.1.1.CC @@ -1 +1,42 @@ -/* Conformance Test 2.7.1.1: Test decimal integer constants */ main () { int a; short b; /* Test maxint for Apple IIGS */ a = 32767; b = a; if ((a != 32767) || (b != 32767)) goto Fail; /* Test minint for Apple IIGS */ a = -32768; b = -32768; if ((a != -32768) || (b != -32768)) goto Fail; /* Test zero */ a = 0; b = 0; if ((a != 0) || (b != 0)) goto Fail; /* Test positive intermediate values */ a = 32766; b = a; if ((a != 32766) || (b != 32766)) goto Fail; /* Test negative intermediate values */ b = -32767; a = b; if ((a != -32767) || (b != -32767)) goto Fail; printf ("Passed Conformance Test 2.7.1.1\n"); return; Fail: printf ("Failed Conformance Test 2.7.1.1\n"); } \ No newline at end of file +/* Conformance Test 2.7.1.1: Test decimal integer constants */ +main () + { + int a; + short b; + + /* Test maxint for Apple IIGS */ + a = 32767; + b = a; + if ((a != 32767) || (b != 32767)) + goto Fail; + + /* Test minint for Apple IIGS */ + a = -32768; + b = -32768; + if ((a != -32768) || (b != -32768)) + goto Fail; + + /* Test zero */ + a = 0; + b = 0; + if ((a != 0) || (b != 0)) + goto Fail; + + /* Test positive intermediate values */ + a = 32766; + b = a; + if ((a != 32766) || (b != 32766)) + goto Fail; + + /* Test negative intermediate values */ + b = -32767; + a = b; + if ((a != -32767) || (b != -32767)) + goto Fail; + + printf ("Passed Conformance Test 2.7.1.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.7.1.1\n"); + } diff --git a/Tests/Conformance/C2.7.1.2.CC b/Tests/Conformance/C2.7.1.2.CC old mode 100755 new mode 100644 index 18dcf44..446a7dc --- a/Tests/Conformance/C2.7.1.2.CC +++ b/Tests/Conformance/C2.7.1.2.CC @@ -1 +1,49 @@ -/* Conformance Test 2.7.1.2: Test octal integer constants */ main () { int a; short b; /* Test maxint for Apple IIGS */ a = 077777; b = a; if ((a != 32767) || (b != 32767)) goto Fail; /* Test minint for Apple IIGS */ a = -0100000; b = a; if ((a != -32768) || (b != -32768)) goto Fail; /* Test zero */ a = 0; b = a; if ((a != 0) || (b != 0)) goto Fail; /* Test positive intermediate values */ a = 077776; b = a; if ((a != 32766) || (b != 32766)) goto Fail; /* Test negative intermediate values */ b = -077777; a = b; if ((a != -32767) || (b != -32767)) goto Fail; /* Test octal digit string with 255 characters */ a = \ 000000000000000000000000000000000000000000000000000000000000000000000000000\ 000000000000000000000000000000000000000000000000000000000000000000000000000\ 000000000000000000000000000000000000000000000000000000000000000000000000000\ 000000000000000000000000000007; printf ("Passed Conformance Test 2.7.1.2\n"); return; Fail: printf ("Failed Conformance Test 2.7.1.2\n"); } \ No newline at end of file +/* Conformance Test 2.7.1.2: Test octal integer constants */ +main () + { + int a; + short b; + + /* Test maxint for Apple IIGS */ + a = 077777; + b = a; + if ((a != 32767) || (b != 32767)) + goto Fail; + + /* Test minint for Apple IIGS */ + a = -0100000; + b = a; + if ((a != -32768) || (b != -32768)) + goto Fail; + + /* Test zero */ + a = 0; + b = a; + if ((a != 0) || (b != 0)) + goto Fail; + + /* Test positive intermediate values */ + a = 077776; + b = a; + if ((a != 32766) || (b != 32766)) + goto Fail; + + /* Test negative intermediate values */ + b = -077777; + a = b; + if ((a != -32767) || (b != -32767)) + goto Fail; + + /* Test octal digit string with 255 characters */ + a = \ +000000000000000000000000000000000000000000000000000000000000000000000000000\ +000000000000000000000000000000000000000000000000000000000000000000000000000\ +000000000000000000000000000000000000000000000000000000000000000000000000000\ +000000000000000000000000000007; + + printf ("Passed Conformance Test 2.7.1.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.7.1.2\n"); + } diff --git a/Tests/Conformance/C2.7.1.3.CC b/Tests/Conformance/C2.7.1.3.CC old mode 100755 new mode 100644 index 16c9fb7..2c1a10f --- a/Tests/Conformance/C2.7.1.3.CC +++ b/Tests/Conformance/C2.7.1.3.CC @@ -1 +1,51 @@ -/* Conformance Test 2.7.1.3: Test hexadecimal integer constants */ main () { int a; short b; /* Test maxint for Apple IIGS */ a = 0x7FFF; b = 0X7fff; if ((a != 32767) || (b != 32767)) goto Fail; /* Test minint for Apple IIGS */ a = -0X8000; b = -0x8000; if ((a != -32768) || (b != -32768)) goto Fail; /* Test zero */ a = 0x0; b = 0X00; if ((a != 0) || (b != 0)) goto Fail; /* Test positive intermediate values */ a = 0x7fFe; b = 0X7FfE; if ((a != 32766) || (b != 32766)) goto Fail; /* Test negative intermediate values */ b = -0x7fFF; a = -0X7FfF; if ((a != -32767) || (b != -32767)) goto Fail; /* Test hexadecimal digit string with 255 characters */ a = \ 0x0000000000000000000000000000000000000000000000000000000000000000000000000\ 000000000000000000000000000000000000000000000000000000000000000000000000000\ 000000000000000000000000000000000000000000000000000000000000000000000000000\ 00000000000000000000000007FF; if (a != 0x7FF) goto Fail; printf ("Passed Conformance Test 2.7.1.3\n"); return; Fail: printf ("Failed Conformance Test 2.7.1.3\n"); } \ No newline at end of file +/* Conformance Test 2.7.1.3: Test hexadecimal integer constants */ +main () + { + int a; + short b; + + /* Test maxint for Apple IIGS */ + a = 0x7FFF; + b = 0X7fff; + if ((a != 32767) || (b != 32767)) + goto Fail; + + /* Test minint for Apple IIGS */ + a = -0X8000; + b = -0x8000; + if ((a != -32768) || (b != -32768)) + goto Fail; + + /* Test zero */ + a = 0x0; + b = 0X00; + if ((a != 0) || (b != 0)) + goto Fail; + + /* Test positive intermediate values */ + a = 0x7fFe; + b = 0X7FfE; + if ((a != 32766) || (b != 32766)) + goto Fail; + + /* Test negative intermediate values */ + b = -0x7fFF; + a = -0X7FfF; + if ((a != -32767) || (b != -32767)) + goto Fail; + + /* Test hexadecimal digit string with 255 characters */ + a = \ +0x0000000000000000000000000000000000000000000000000000000000000000000000000\ +000000000000000000000000000000000000000000000000000000000000000000000000000\ +000000000000000000000000000000000000000000000000000000000000000000000000000\ +00000000000000000000000007FF; + if (a != 0x7FF) + goto Fail; + + printf ("Passed Conformance Test 2.7.1.3\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.7.1.3\n"); + } diff --git a/Tests/Conformance/C2.7.1.4.CC b/Tests/Conformance/C2.7.1.4.CC old mode 100755 new mode 100644 index 3ba0e27..0801b5c --- a/Tests/Conformance/C2.7.1.4.CC +++ b/Tests/Conformance/C2.7.1.4.CC @@ -1 +1,35 @@ -/* Conformance Test 2.7.1.4: Test decimal long integer constants */ main () { long a; long int b; /* Test maxlong for Apple IIGS */ a = 2147483647; b = a; if ((a != 2147483647) || (b != 2147483647)) goto Fail; /* Test zero */ a = 0L; b = 0l; if ((a != 0) || (b != 0)) goto Fail; /* Test positive intermediate values */ a = 2147483646; b = a; if ((a != 2147483646) || (b != 2147483646)) goto Fail; a = 32767L; b = a; if ((a != 32767) || (b != 0x7FFF)) goto Fail; printf ("Passed Conformance Test 2.7.1.4\n"); return; Fail: printf ("Failed Conformance Test 2.7.1.4\n"); } \ No newline at end of file +/* Conformance Test 2.7.1.4: Test decimal long integer constants */ +main () + { + long a; + long int b; + + /* Test maxlong for Apple IIGS */ + a = 2147483647; + b = a; + if ((a != 2147483647) || (b != 2147483647)) + goto Fail; + + /* Test zero */ + a = 0L; + b = 0l; + if ((a != 0) || (b != 0)) + goto Fail; + + /* Test positive intermediate values */ + a = 2147483646; + b = a; + if ((a != 2147483646) || (b != 2147483646)) + goto Fail; + + a = 32767L; + b = a; + if ((a != 32767) || (b != 0x7FFF)) + goto Fail; + + printf ("Passed Conformance Test 2.7.1.4\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.7.1.4\n"); + } diff --git a/Tests/Conformance/C2.7.1.5.CC b/Tests/Conformance/C2.7.1.5.CC old mode 100755 new mode 100644 index 7d71aec..8583753 --- a/Tests/Conformance/C2.7.1.5.CC +++ b/Tests/Conformance/C2.7.1.5.CC @@ -1 +1,48 @@ -/* Conformance Test 2.7.1.5: Test octal long integer constants */ main () { long a; long int b; /* Test maxlong for Apple IIGS */ a = 017777777777; b = a; if ((a != 2147483647) || (b != 2147483647)) goto Fail; /* Test maximum 32-bit octal value */ a = 037777777777; b = a; if ((a != 0xfFfFfFfF) || (b != 0XFFFFFFFF)) goto Fail; /* Test zero */ a = 000000000000L; b = 0l; if ((a != 0) || (b != 0)) goto Fail; /* Test positive intermediate values */ a = 017777777776; b = a; if ((a != 2147483646) || (b != 2147483646)) goto Fail; a = 077777; b = a; if ((a != 32767) || (b != 0x7FFF)) goto Fail; /* Test octal digit string with 255 characters */ a = \ 000000000000000000000000000000000000000000000000000000000000000000000000000\ 000000000000000000000000000000000000000000000000000000000000000000000000000\ 000000000000000000000000000000000000000000000000000000000000000000000000000\ 000000000000000000000000000007; printf ("Passed Conformance Test 2.7.1.5\n"); return; Fail: printf ("Failed Conformance Test 2.7.1.5\n"); } \ No newline at end of file +/* Conformance Test 2.7.1.5: Test octal long integer constants */ +main () + { + long a; + long int b; + + /* Test maxlong for Apple IIGS */ + a = 017777777777; + b = a; + if ((a != 2147483647) || (b != 2147483647)) + goto Fail; + + /* Test maximum 32-bit octal value */ + a = 037777777777; + b = a; + if ((a != 0xfFfFfFfF) || (b != 0XFFFFFFFF)) + goto Fail; + + /* Test zero */ + a = 000000000000L; + b = 0l; + if ((a != 0) || (b != 0)) + goto Fail; + + /* Test positive intermediate values */ + a = 017777777776; + b = a; + if ((a != 2147483646) || (b != 2147483646)) + goto Fail; + + a = 077777; + b = a; + if ((a != 32767) || (b != 0x7FFF)) + goto Fail; + + /* Test octal digit string with 255 characters */ + a = \ +000000000000000000000000000000000000000000000000000000000000000000000000000\ +000000000000000000000000000000000000000000000000000000000000000000000000000\ +000000000000000000000000000000000000000000000000000000000000000000000000000\ +000000000000000000000000000007; + + printf ("Passed Conformance Test 2.7.1.5\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.7.1.5\n"); + } diff --git a/Tests/Conformance/C2.7.1.6.CC b/Tests/Conformance/C2.7.1.6.CC old mode 100755 new mode 100644 index 0ba13a6..1e519c8 --- a/Tests/Conformance/C2.7.1.6.CC +++ b/Tests/Conformance/C2.7.1.6.CC @@ -1 +1,50 @@ -/* Conformance Test 2.7.1.6: Test hexadecimal long integer constants */ main () { long a; long int b; /* Test maxlong for Apple IIGS */ a = 0x7FFFFFFF; b = 0X7fffFFff; if ((a != 2147483647) || (b != 2147483647)) goto Fail; /* Test minlong for Apple IIGS */ a = 0X80000000; b = 0x80000000; if ((a != -(2147483647 + 1)) || (b != -(2147483647 + 1))) goto Fail; /* Test zero */ a = 0x0; b = 0X00000000; if ((a != 0) || (b != 0)) goto Fail; /* Test positive intermediate values */ a = 0x7ffFfFfE; b = 0X7FFFFFfE; if ((a != 2147483646) || (b != 2147483646)) goto Fail; a = 0x7ffFl; b = 0X7FFFL; if ((a != 32767) || (b != 32767)) goto Fail; /* Test hexadecimal digit string with 255 characters */ a = \ 0X0000000000000000000000000000000000000000000000000000000000000000000000000\ 000000000000000000000000000000000000000000000000000000000000000000000000000\ 000000000000000000000000000000000000000000000000000000000000000000000000000\ 000000000000000000000000078A; if (a != 0x78A) goto Fail; printf ("Passed Conformance Test 2.7.1.6\n"); return; Fail: printf ("Failed Conformance Test 2.7.1.6\n"); } \ No newline at end of file +/* Conformance Test 2.7.1.6: Test hexadecimal long integer constants */ +main () + { + long a; + long int b; + + /* Test maxlong for Apple IIGS */ + a = 0x7FFFFFFF; + b = 0X7fffFFff; + if ((a != 2147483647) || (b != 2147483647)) + goto Fail; + + /* Test minlong for Apple IIGS */ + a = 0X80000000; + b = 0x80000000; + if ((a != -(2147483647 + 1)) || (b != -(2147483647 + 1))) + goto Fail; + + /* Test zero */ + a = 0x0; + b = 0X00000000; + if ((a != 0) || (b != 0)) + goto Fail; + + /* Test positive intermediate values */ + a = 0x7ffFfFfE; + b = 0X7FFFFFfE; + if ((a != 2147483646) || (b != 2147483646)) + goto Fail; + + a = 0x7ffFl; + b = 0X7FFFL; + if ((a != 32767) || (b != 32767)) + goto Fail; + + /* Test hexadecimal digit string with 255 characters */ + a = \ +0X0000000000000000000000000000000000000000000000000000000000000000000000000\ +000000000000000000000000000000000000000000000000000000000000000000000000000\ +000000000000000000000000000000000000000000000000000000000000000000000000000\ +000000000000000000000000078A; + if (a != 0x78A) + goto Fail; + + printf ("Passed Conformance Test 2.7.1.6\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.7.1.6\n"); + } diff --git a/Tests/Conformance/C2.7.1.7.CC b/Tests/Conformance/C2.7.1.7.CC old mode 100755 new mode 100644 index 51954cb..e2e2c31 --- a/Tests/Conformance/C2.7.1.7.CC +++ b/Tests/Conformance/C2.7.1.7.CC @@ -1 +1,58 @@ -/* Conformance Test 2.7.1.7: Test unsigned integer constants */ main () { unsigned a; unsigned int b; unsigned short c; unsigned short int d; /* Test unsigned maxint for Apple IIGS */ a = b = 0xFFFF; c = 0177777; d = 65535u; if ((a != c) || (b != d)) goto Fail; /* Test zero */ a = 0; b = 0000; c = 0x0000; d = a; if ((a != 0) || (b != 0) || (c != 0) || (d != 0)) goto Fail; /* Test intermediate values */ a = 0x9AbC; b = 39612; c = d = 0115274; if ((a != b) || (b != d)) goto Fail; a = 32767; b = c = 077777; d = 0X7fFfU; if ((a != b) || (c != d)) goto Fail; /* Test octal digit string with 255 characters */ a = \ 000000000000000000000000000000000000000000000000000000000000000000000000000\ 000000000000000000000000000000000000000000000000000000000000000000000000000\ 000000000000000000000000000000000000000000000000000000000000000000000000000\ 000000000000000000000000000007; /* Test hexadecimal digit string with 255 characters */ a = \ 0x0000000000000000000000000000000000000000000000000000000000000000000000000\ 000000000000000000000000000000000000000000000000000000000000000000000000000\ 000000000000000000000000000000000000000000000000000000000000000000000000000\ 0000000000000000000000000324; if (a != 0x324) goto Fail; printf ("Passed Conformance Test 2.7.1.7\n"); return; Fail: printf ("Failed Conformance Test 2.7.1.7\n"); } \ No newline at end of file +/* Conformance Test 2.7.1.7: Test unsigned integer constants */ +main () + { + unsigned a; + unsigned int b; + unsigned short c; + unsigned short int d; + + /* Test unsigned maxint for Apple IIGS */ + a = b = 0xFFFF; + c = 0177777; + d = 65535u; + if ((a != c) || (b != d)) + goto Fail; + + /* Test zero */ + a = 0; + b = 0000; + c = 0x0000; + d = a; + if ((a != 0) || (b != 0) || (c != 0) || (d != 0)) + goto Fail; + + /* Test intermediate values */ + a = 0x9AbC; + b = 39612; + c = d = 0115274; + if ((a != b) || (b != d)) + goto Fail; + + a = 32767; + b = c = 077777; + d = 0X7fFfU; + if ((a != b) || (c != d)) + goto Fail; + + /* Test octal digit string with 255 characters */ + a = \ +000000000000000000000000000000000000000000000000000000000000000000000000000\ +000000000000000000000000000000000000000000000000000000000000000000000000000\ +000000000000000000000000000000000000000000000000000000000000000000000000000\ +000000000000000000000000000007; + + /* Test hexadecimal digit string with 255 characters */ + a = \ +0x0000000000000000000000000000000000000000000000000000000000000000000000000\ +000000000000000000000000000000000000000000000000000000000000000000000000000\ +000000000000000000000000000000000000000000000000000000000000000000000000000\ +0000000000000000000000000324; + if (a != 0x324) + goto Fail; + + printf ("Passed Conformance Test 2.7.1.7\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.7.1.7\n"); + } diff --git a/Tests/Conformance/C2.7.1.8.CC b/Tests/Conformance/C2.7.1.8.CC old mode 100755 new mode 100644 index c6c4172..10a1705 --- a/Tests/Conformance/C2.7.1.8.CC +++ b/Tests/Conformance/C2.7.1.8.CC @@ -1 +1,53 @@ -/* Conformance Test 2.7.1.8: Test unsigned long integer constants */ main () { unsigned long a; unsigned long int b; /* Test unsigned maxlong for Apple IIGS */ a = 0xFFFFffff; b = 037777777777; if ((a != (4294967295ul)) || (b != (4294967295UL))) goto Fail; /* Test zero */ a = 0; b = 0000; if ((a != 0) || (b != 0)) goto Fail; /* Test intermediate values */ a = 0x81347500; b = 020115072400; if ((a != 2167698688ul) || (b != 2167698688UL)) goto Fail; a = 2147545424uL; b = 2147545424Ul; if ((a != 0x8000f150) || (b != 020000170520)) goto Fail; /* Test octal digit string with 255 characters */ a = \ 000000000000000000000000000000000000000000000000000000000000000000000000000\ 000000000000000000000000000000000000000000000000000000000000000000000000000\ 000000000000000000000000000000000000000000000000000000000000000000000000000\ 000000000000000000000000000007uL; if (a != 7) goto Fail; /* Test hexadecimal digit string with 255 characters */ a = \ 0x0000000000000000000000000000000000000000000000000000000000000000000000000\ 000000000000000000000000000000000000000000000000000000000000000000000000000\ 000000000000000000000000000000000000000000000000000000000000000000000000000\ 0000000000000000000000000271L; if (a != 0x271) goto Fail; printf ("Passed Conformance Test 2.7.1.8\n"); return; Fail: printf ("Failed Conformance Test 2.7.1.8\n"); } \ No newline at end of file +/* Conformance Test 2.7.1.8: Test unsigned long integer constants */ +main () + { + unsigned long a; + unsigned long int b; + + /* Test unsigned maxlong for Apple IIGS */ + a = 0xFFFFffff; + b = 037777777777; + if ((a != (4294967295ul)) || (b != (4294967295UL))) + goto Fail; + + /* Test zero */ + a = 0; + b = 0000; + if ((a != 0) || (b != 0)) + goto Fail; + + /* Test intermediate values */ + a = 0x81347500; + b = 020115072400; + if ((a != 2167698688ul) || (b != 2167698688UL)) + goto Fail; + + a = 2147545424uL; + b = 2147545424Ul; + if ((a != 0x8000f150) || (b != 020000170520)) + goto Fail; + + /* Test octal digit string with 255 characters */ + a = \ +000000000000000000000000000000000000000000000000000000000000000000000000000\ +000000000000000000000000000000000000000000000000000000000000000000000000000\ +000000000000000000000000000000000000000000000000000000000000000000000000000\ +000000000000000000000000000007uL; + if (a != 7) + goto Fail; + + /* Test hexadecimal digit string with 255 characters */ + a = \ +0x0000000000000000000000000000000000000000000000000000000000000000000000000\ +000000000000000000000000000000000000000000000000000000000000000000000000000\ +000000000000000000000000000000000000000000000000000000000000000000000000000\ +0000000000000000000000000271L; + if (a != 0x271) + goto Fail; + + printf ("Passed Conformance Test 2.7.1.8\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.7.1.8\n"); + } diff --git a/Tests/Conformance/C2.7.2.1.CC b/Tests/Conformance/C2.7.2.1.CC old mode 100755 new mode 100644 index 59cf4f4..d31a1d6 --- a/Tests/Conformance/C2.7.2.1.CC +++ b/Tests/Conformance/C2.7.2.1.CC @@ -1 +1,71 @@ -/* Conformance Test 2.7.2.1: Test single-precision floating-point constants */ #include main () { float a; /* Test maximum and minimum single-precision floating-point values, using */ /* all valid syntactic constructs. */ a = 1e+38; if (fabs(a - 1.E38) > 1e32) goto Fail; a = .1e-37; if (fabs(a - 0.1e-37) > 1e-42) goto Fail; /* Test other miscellaneous values. */ a = 32767.F; if (fabs(a - 32767.000E+00000) > 0.01) goto Fail; a = 123.4567; if (fabs(a - 1.234567E+02) > 0.001) goto Fail; a = 00000000; if (a != 0) goto Fail; a = .456789; if (fabs(a - 456789E-6) > 0.00001) goto Fail; /* Test negative values. */ a = -1e+38; if (fabs(a - (-1.E38)) > 1e33) goto Fail; a = -.1e-37; if (fabs(a - (-1.0e-38)) > 1e-42) goto Fail; /* Test other miscellaneous values. */ a = -32768.f; if (fabs(a - (-32768.000E+00000)) > 0.01) goto Fail; a = -123.4567; if (fabs(a - (-1.234567E+02)) > 0.001) goto Fail; a = -.456789; if (fabs(a - (-456789E-6)) > 0.00001) goto Fail; /* Test floating-point constant with many characters in a digit string */ a = \ 000000000000000000000000000000000000000000000000000000000000000000000000000007.0 ; if (fabs(a - 7.0) > 0.00001) goto Fail; printf ("Passed Conformance Test 2.7.2.1\n"); return; Fail: printf("Failed Conformance Test 2.7.2.1\n"); } \ No newline at end of file +/* Conformance Test 2.7.2.1: Test single-precision floating-point constants */ + +#include + +main () + { + float a; + + /* Test maximum and minimum single-precision floating-point values, using */ + /* all valid syntactic constructs. */ + a = 1e+38; + if (fabs(a - 1.E38) > 1e32) + goto Fail; + + a = .1e-37; + if (fabs(a - 0.1e-37) > 1e-42) + goto Fail; + + /* Test other miscellaneous values. */ + a = 32767.F; + if (fabs(a - 32767.000E+00000) > 0.01) + goto Fail; + + a = 123.4567; + if (fabs(a - 1.234567E+02) > 0.001) + goto Fail; + + a = 00000000; + if (a != 0) + goto Fail; + + a = .456789; + if (fabs(a - 456789E-6) > 0.00001) + goto Fail; + + /* Test negative values. */ + a = -1e+38; + if (fabs(a - (-1.E38)) > 1e33) + goto Fail; + + a = -.1e-37; + if (fabs(a - (-1.0e-38)) > 1e-42) + goto Fail; + + /* Test other miscellaneous values. */ + a = -32768.f; + if (fabs(a - (-32768.000E+00000)) > 0.01) + goto Fail; + + a = -123.4567; + if (fabs(a - (-1.234567E+02)) > 0.001) + goto Fail; + + a = -.456789; + if (fabs(a - (-456789E-6)) > 0.00001) + goto Fail; + + /* Test floating-point constant with many characters in a digit string */ + a = \ +000000000000000000000000000000000000000000000000000000000000000000000000000007.0 +; + + if (fabs(a - 7.0) > 0.00001) + goto Fail; + + printf ("Passed Conformance Test 2.7.2.1\n"); + return; + +Fail: + printf("Failed Conformance Test 2.7.2.1\n"); + } diff --git a/Tests/Conformance/C2.7.2.2.CC b/Tests/Conformance/C2.7.2.2.CC old mode 100755 new mode 100644 index 76ce3e3..3dfce46 --- a/Tests/Conformance/C2.7.2.2.CC +++ b/Tests/Conformance/C2.7.2.2.CC @@ -1 +1,63 @@ -/* Conformance Test 2.7.2.2: Test double-precision floating-point constants */ #include main () { double a; /* Test maximum and minimum double-precision floating-point values, using */ /* all valid syntactic constructs. */ a = 1e+308; if (fabs(a - 1.E308) > 1e302) goto Fail; a = .1e-307; if (fabs(a - 1.0e-308) > 1e-302) goto Fail; /* Test other miscellaneous values. */ a = 32767.f; if (fabs(a - 32767.000E+00000) > 0.1) goto Fail; a = 1234567.89012345; if (fabs(a - 1.23456789012345E+06) > 1.0) goto Fail; a = 000000000000000; if (fabs(a - 0) > 0.00001) goto Fail; a = .456789; if (fabs(a - 456789E-6) > 0.00001) goto Fail; /* Test negative values. */ a = -1e+308; if (fabs(a - (-1.E308)) > 1e-302) goto Fail; a = -.1e-307; if (fabs(a - (-1.0e-308)) > 1e-302) goto Fail; /* Test other miscellaneous values. */ a = -32768.F; if (fabs(a - (-32768.000E+00000)) > 0.1) goto Fail; a = -123.4567890123; if (fabs(a - (-1.234567E+02)) > 0.001) goto Fail; a = -.456789; if (fabs(a - (-456789E-6)) > 0.00001) goto Fail; printf ("Passed Conformance Test 2.7.2.2\n"); return; Fail: printf ("Failed Conformance Test 2.7.2.2\n"); } \ No newline at end of file +/* Conformance Test 2.7.2.2: Test double-precision floating-point constants */ + +#include + +main () + { + double a; + + /* Test maximum and minimum double-precision floating-point values, using */ + /* all valid syntactic constructs. */ + a = 1e+308; + if (fabs(a - 1.E308) > 1e302) + goto Fail; + + a = .1e-307; + if (fabs(a - 1.0e-308) > 1e-302) + goto Fail; + + /* Test other miscellaneous values. */ + a = 32767.f; + if (fabs(a - 32767.000E+00000) > 0.1) + goto Fail; + + a = 1234567.89012345; + if (fabs(a - 1.23456789012345E+06) > 1.0) + goto Fail; + + a = 000000000000000; + if (fabs(a - 0) > 0.00001) + goto Fail; + + a = .456789; + if (fabs(a - 456789E-6) > 0.00001) + goto Fail; + + /* Test negative values. */ + a = -1e+308; + if (fabs(a - (-1.E308)) > 1e-302) + goto Fail; + + a = -.1e-307; + if (fabs(a - (-1.0e-308)) > 1e-302) + goto Fail; + + /* Test other miscellaneous values. */ + a = -32768.F; + if (fabs(a - (-32768.000E+00000)) > 0.1) + goto Fail; + + a = -123.4567890123; + if (fabs(a - (-1.234567E+02)) > 0.001) + goto Fail; + + a = -.456789; + if (fabs(a - (-456789E-6)) > 0.00001) + goto Fail; + + printf ("Passed Conformance Test 2.7.2.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.7.2.2\n"); + } diff --git a/Tests/Conformance/C2.7.2.3.CC b/Tests/Conformance/C2.7.2.3.CC old mode 100755 new mode 100644 index 2c1bace..e81d440 --- a/Tests/Conformance/C2.7.2.3.CC +++ b/Tests/Conformance/C2.7.2.3.CC @@ -1 +1,63 @@ -/* Conformance Test 2.7.2.3: Test extended-precision floating-pt constants */ #include main () { long double a; /* Test maximum and minimum extended-precision floating-point values, */ /* using all valid syntactic constructs. */ a = 1e+4932; if (fabs(a - 1.E4932) > 1e4927) goto Fail; a = .1e-4931; if (fabs(a - 1.0e-4932) > 1e-4928) goto Fail; /* Test other miscellaneous values. */ a = 32767l; if (fabs(a - 32767.000E+00000) > 0.1) goto Fail; a = 1234567890.123456789; if (fabs(a - 1.234567890123456789E+09) > 1000.0) goto Fail; a = 0000000000000000000; if (fabs(a) > 0.0000000001) goto Fail; a = .456789; if (fabs(a - 456789E-6) > 0.0000000001) goto Fail; /* Test negative values. */ a = -1e+4932; if (fabs(a - (-1.E4932)) > 1e4920) goto Fail; a = -.1e-4943; if (fabs(a - (-1.0e-4932)) > 1e-4935) goto Fail; /* Test other miscellaneous values. */ a = -32768L; if (fabs(a - (-32768.000E+00000)) > 0.0000000001) goto Fail; a = -123.4567890123; if (fabs(a - (-1.234567890123E+02)) > 0.000000001) goto Fail; a = -.456789; if (fabs(a - (-456789E-6)) > 0.0000000001) goto Fail; printf ("Passed Conformance Test 2.7.2.3\n"); return; Fail: printf ("Failed Conformance Test 2.7.2.3\n"); } \ No newline at end of file +/* Conformance Test 2.7.2.3: Test extended-precision floating-pt constants */ + +#include + +main () + { + long double a; + + /* Test maximum and minimum extended-precision floating-point values, */ + /* using all valid syntactic constructs. */ + a = 1e+4932; + if (fabs(a - 1.E4932) > 1e4927) + goto Fail; + + a = .1e-4931; + if (fabs(a - 1.0e-4932) > 1e-4928) + goto Fail; + + /* Test other miscellaneous values. */ + a = 32767l; + if (fabs(a - 32767.000E+00000) > 0.1) + goto Fail; + + a = 1234567890.123456789; + if (fabs(a - 1.234567890123456789E+09) > 1000.0) + goto Fail; + + a = 0000000000000000000; + if (fabs(a) > 0.0000000001) + goto Fail; + + a = .456789; + if (fabs(a - 456789E-6) > 0.0000000001) + goto Fail; + + /* Test negative values. */ + a = -1e+4932; + if (fabs(a - (-1.E4932)) > 1e4920) + goto Fail; + + a = -.1e-4943; + if (fabs(a - (-1.0e-4932)) > 1e-4935) + goto Fail; + + /* Test other miscellaneous values. */ + a = -32768L; + if (fabs(a - (-32768.000E+00000)) > 0.0000000001) + goto Fail; + + a = -123.4567890123; + if (fabs(a - (-1.234567890123E+02)) > 0.000000001) + goto Fail; + + a = -.456789; + if (fabs(a - (-456789E-6)) > 0.0000000001) + goto Fail; + + printf ("Passed Conformance Test 2.7.2.3\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.7.2.3\n"); + } diff --git a/Tests/Conformance/C2.7.3.1.CC b/Tests/Conformance/C2.7.3.1.CC old mode 100755 new mode 100644 index bfac450..268f6a5 --- a/Tests/Conformance/C2.7.3.1.CC +++ b/Tests/Conformance/C2.7.3.1.CC @@ -1 +1,426 @@ -/* Conformance Test 2.7.3.1: Check ASCII encodings for all character */ /* constants */ main () { char a; /* Check all printing characters. */ a = ' '; if (a != 0x20) goto Fail; a = '!'; if (a != 0x21) goto Fail; a = '"'; if (a != 0x22) goto Fail; a = '#'; if (a != 0x23) goto Fail; a = '$'; if (a != 0x24) goto Fail; a = '%'; if (a != 0x25) goto Fail; a = '&'; if (a != 0x26) goto Fail; a = '('; if (a != 0x28) goto Fail; a = ')'; if (a != 0x29) goto Fail; a = '*'; if (a != 0x2A) goto Fail; a = '+'; if (a != 0x2B) goto Fail; a = ','; if (a != 0x2C) goto Fail; a = '-'; if (a != 0x2D) goto Fail; a = '.'; if (a != 0x2E) goto Fail; a = '/'; if (a != 0x2F) goto Fail; a = '0'; if (a != 0x30) goto Fail; a = '1'; if (a != 0x31) goto Fail; a = '2'; if (a != 0x32) goto Fail; a = '3'; if (a != 0x33) goto Fail; a = '4'; if (a != 0x34) goto Fail; a = '5'; if (a != 0x35) goto Fail; a = '6'; if (a != 0x36) goto Fail; a = '7'; if (a != 0x37) goto Fail; a = '8'; if (a != 0x38) goto Fail; a = '9'; if (a != 0x39) goto Fail; a = ':'; if (a != 0x3A) goto Fail; a = ';'; if (a != 0x3B) goto Fail; a = '<'; if (a != 0x3C) goto Fail; a = '='; if (a != 0x3D) goto Fail; a = '>'; if (a != 0x3E) goto Fail; a = '?'; if (a != 0x3F) goto Fail; a = '@'; if (a != 0x40) goto Fail; a = 'A'; if (a != 0x41) goto Fail; a = 'B'; if (a != 0x42) goto Fail; a = 'C'; if (a != 0x43) goto Fail; a = 'D'; if (a != 0x44) goto Fail; a = 'E'; if (a != 0x45) goto Fail; a = 'F'; if (a != 0x46) goto Fail; a = 'G'; if (a != 0x47) goto Fail; a = 'H'; if (a != 0x48) goto Fail; a = 'I'; if (a != 0x49) goto Fail; a = 'J'; if (a != 0x4A) goto Fail; a = 'K'; if (a != 0x4B) goto Fail; a = 'L'; if (a != 0x4C) goto Fail; a = 'M'; if (a != 0x4D) goto Fail; a = 'N'; if (a != 0x4E) goto Fail; a = 'O'; if (a != 0x4F) goto Fail; a = 'P'; if (a != 0x50) goto Fail; a = 'Q'; if (a != 0x51) goto Fail; a = 'R'; if (a != 0x52) goto Fail; a = 'S'; if (a != 0x53) goto Fail; a = 'T'; if (a != 0x54) goto Fail; a = 'U'; if (a != 0x55) goto Fail; a = 'V'; if (a != 0x56) goto Fail; a = 'W'; if (a != 0x57) goto Fail; a = 'X'; if (a != 0x58) goto Fail; a = 'Y'; if (a != 0x59) goto Fail; a = 'Z'; if (a != 0x5A) goto Fail; a = '['; if (a != 0x5B) goto Fail; a = ']'; if (a != 0x5D) goto Fail; a = '^'; if (a != 0x5E) goto Fail; a = '_'; if (a != 0x5F) goto Fail; a = 'a'; if (a != 0x61) goto Fail; a = 'b'; if (a != 0x62) goto Fail; a = 'c'; if (a != 0x63) goto Fail; a = 'd'; if (a != 0x64) goto Fail; a = 'e'; if (a != 0x65) goto Fail; a = 'f'; if (a != 0x66) goto Fail; a = 'g'; if (a != 0x67) goto Fail; a = 'h'; if (a != 0x68) goto Fail; a = 'i'; if (a != 0x69) goto Fail; a = 'j'; if (a != 0x6A) goto Fail; a = 'k'; if (a != 0x6B) goto Fail; a = 'l'; if (a != 0x6C) goto Fail; a = 'm'; if (a != 0x6D) goto Fail; a = 'n'; if (a != 0x6E) goto Fail; a = 'o'; if (a != 0x6F) goto Fail; a = 'p'; if (a != 0x70) goto Fail; a = 'q'; if (a != 0x71) goto Fail; a = 'r'; if (a != 0x72) goto Fail; a = 's'; if (a != 0x73) goto Fail; a = 't'; if (a != 0x74) goto Fail; a = 'u'; if (a != 0x75) goto Fail; a = 'v'; if (a != 0x76) goto Fail; a = 'w'; if (a != 0x77) goto Fail; a = 'x'; if (a != 0x78) goto Fail; a = 'y'; if (a != 0x79) goto Fail; a = 'z'; if (a != 0x7A) goto Fail; a = '{'; if (a != 0x7B) goto Fail; a = '|'; if (a != 0x7C) goto Fail; a = '}'; if (a != 0x7D) goto Fail; a = '~'; if (a != 0x7E) goto Fail; /* Check all escape characters. */ a = '\n'; /* newline */ if (a != 0x0A) goto Fail; a = '\t'; /* horizontal tab */ if (a != 0x09) goto Fail; a = '\b'; /* back space */ if (a != 0x08) goto Fail; a = '\r'; /* carriage return */ if (a != 0x0D) goto Fail; a = '\f'; /* form feed */ if (a != 0x0C) goto Fail; a = '\v'; /* vertical tab */ if (a != 0x0B) goto Fail; a = '\''; /* apostrophe */ if (a != 0x27) goto Fail; a = '\"'; /* double quotes */ if (a != 0x22) goto Fail; a = '\\'; /* back slash */ if (a != 0x5C) goto Fail; a = '\a'; /* alert */ if (a != 0x07) goto Fail; a = '\?'; /* question mark */ if (a != 0x3F) goto Fail; printf ("Passed Conformance Test 2.7.3.1\n"); return; Fail: printf ("Failed Conformance Test 2.7.3.1\n"); } \ No newline at end of file +/* Conformance Test 2.7.3.1: Check ASCII encodings for all character */ +/* constants */ +main () + { + char a; + + /* Check all printing characters. */ + a = ' '; + if (a != 0x20) + goto Fail; + + a = '!'; + if (a != 0x21) + goto Fail; + + a = '"'; + if (a != 0x22) + goto Fail; + + a = '#'; + if (a != 0x23) + goto Fail; + + a = '$'; + if (a != 0x24) + goto Fail; + + a = '%'; + if (a != 0x25) + goto Fail; + + a = '&'; + if (a != 0x26) + goto Fail; + + a = '('; + if (a != 0x28) + goto Fail; + + a = ')'; + if (a != 0x29) + goto Fail; + + a = '*'; + if (a != 0x2A) + goto Fail; + + a = '+'; + if (a != 0x2B) + goto Fail; + + a = ','; + if (a != 0x2C) + goto Fail; + + a = '-'; + if (a != 0x2D) + goto Fail; + + a = '.'; + if (a != 0x2E) + goto Fail; + + a = '/'; + if (a != 0x2F) + goto Fail; + + a = '0'; + if (a != 0x30) + goto Fail; + + a = '1'; + if (a != 0x31) + goto Fail; + + a = '2'; + if (a != 0x32) + goto Fail; + + a = '3'; + if (a != 0x33) + goto Fail; + + a = '4'; + if (a != 0x34) + goto Fail; + + a = '5'; + if (a != 0x35) + goto Fail; + + a = '6'; + if (a != 0x36) + goto Fail; + + a = '7'; + if (a != 0x37) + goto Fail; + + a = '8'; + if (a != 0x38) + goto Fail; + + a = '9'; + if (a != 0x39) + goto Fail; + + a = ':'; + if (a != 0x3A) + goto Fail; + + a = ';'; + if (a != 0x3B) + goto Fail; + + a = '<'; + if (a != 0x3C) + goto Fail; + + a = '='; + if (a != 0x3D) + goto Fail; + + a = '>'; + if (a != 0x3E) + goto Fail; + + a = '?'; + if (a != 0x3F) + goto Fail; + + a = '@'; + if (a != 0x40) + goto Fail; + + a = 'A'; + if (a != 0x41) + goto Fail; + + a = 'B'; + if (a != 0x42) + goto Fail; + + a = 'C'; + if (a != 0x43) + goto Fail; + + a = 'D'; + if (a != 0x44) + goto Fail; + + a = 'E'; + if (a != 0x45) + goto Fail; + + a = 'F'; + if (a != 0x46) + goto Fail; + + a = 'G'; + if (a != 0x47) + goto Fail; + + a = 'H'; + if (a != 0x48) + goto Fail; + + a = 'I'; + if (a != 0x49) + goto Fail; + + a = 'J'; + if (a != 0x4A) + goto Fail; + + a = 'K'; + if (a != 0x4B) + goto Fail; + + a = 'L'; + if (a != 0x4C) + goto Fail; + + a = 'M'; + if (a != 0x4D) + goto Fail; + + a = 'N'; + if (a != 0x4E) + goto Fail; + + a = 'O'; + if (a != 0x4F) + goto Fail; + + a = 'P'; + if (a != 0x50) + goto Fail; + + a = 'Q'; + if (a != 0x51) + goto Fail; + + a = 'R'; + if (a != 0x52) + goto Fail; + + a = 'S'; + if (a != 0x53) + goto Fail; + + a = 'T'; + if (a != 0x54) + goto Fail; + + a = 'U'; + if (a != 0x55) + goto Fail; + + a = 'V'; + if (a != 0x56) + goto Fail; + + a = 'W'; + if (a != 0x57) + goto Fail; + + a = 'X'; + if (a != 0x58) + goto Fail; + + a = 'Y'; + if (a != 0x59) + goto Fail; + + a = 'Z'; + if (a != 0x5A) + goto Fail; + + a = '['; + if (a != 0x5B) + goto Fail; + + a = ']'; + if (a != 0x5D) + goto Fail; + + a = '^'; + if (a != 0x5E) + goto Fail; + + a = '_'; + if (a != 0x5F) + goto Fail; + + a = 'a'; + if (a != 0x61) + goto Fail; + + a = 'b'; + if (a != 0x62) + goto Fail; + + a = 'c'; + if (a != 0x63) + goto Fail; + + a = 'd'; + if (a != 0x64) + goto Fail; + + a = 'e'; + if (a != 0x65) + goto Fail; + + a = 'f'; + if (a != 0x66) + goto Fail; + + a = 'g'; + if (a != 0x67) + goto Fail; + + a = 'h'; + if (a != 0x68) + goto Fail; + + a = 'i'; + if (a != 0x69) + goto Fail; + + a = 'j'; + if (a != 0x6A) + goto Fail; + + a = 'k'; + if (a != 0x6B) + goto Fail; + + a = 'l'; + if (a != 0x6C) + goto Fail; + + a = 'm'; + if (a != 0x6D) + goto Fail; + + a = 'n'; + if (a != 0x6E) + goto Fail; + + a = 'o'; + if (a != 0x6F) + goto Fail; + + a = 'p'; + if (a != 0x70) + goto Fail; + + a = 'q'; + if (a != 0x71) + goto Fail; + + a = 'r'; + if (a != 0x72) + goto Fail; + + a = 's'; + if (a != 0x73) + goto Fail; + + a = 't'; + if (a != 0x74) + goto Fail; + + a = 'u'; + if (a != 0x75) + goto Fail; + + a = 'v'; + if (a != 0x76) + goto Fail; + + a = 'w'; + if (a != 0x77) + goto Fail; + + a = 'x'; + if (a != 0x78) + goto Fail; + + a = 'y'; + if (a != 0x79) + goto Fail; + + a = 'z'; + if (a != 0x7A) + goto Fail; + + a = '{'; + if (a != 0x7B) + goto Fail; + + a = '|'; + if (a != 0x7C) + goto Fail; + + a = '}'; + if (a != 0x7D) + goto Fail; + + a = '~'; + if (a != 0x7E) + goto Fail; + + /* Check all escape characters. */ + a = '\n'; /* newline */ + if (a != 0x0A) + goto Fail; + + a = '\t'; /* horizontal tab */ + if (a != 0x09) + goto Fail; + + a = '\b'; /* back space */ + if (a != 0x08) + goto Fail; + + a = '\r'; /* carriage return */ + if (a != 0x0D) + goto Fail; + + a = '\f'; /* form feed */ + if (a != 0x0C) + goto Fail; + + a = '\v'; /* vertical tab */ + if (a != 0x0B) + goto Fail; + + a = '\''; /* apostrophe */ + if (a != 0x27) + goto Fail; + + a = '\"'; /* double quotes */ + if (a != 0x22) + goto Fail; + + a = '\\'; /* back slash */ + if (a != 0x5C) + goto Fail; + + a = '\a'; /* alert */ + if (a != 0x07) + goto Fail; + + a = '\?'; /* question mark */ + if (a != 0x3F) + goto Fail; + + printf ("Passed Conformance Test 2.7.3.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.7.3.1\n"); + } diff --git a/Tests/Conformance/C2.7.3.2.CC b/Tests/Conformance/C2.7.3.2.CC old mode 100755 new mode 100644 index ef530dc..aa2bf66 --- a/Tests/Conformance/C2.7.3.2.CC +++ b/Tests/Conformance/C2.7.3.2.CC @@ -1 +1,20 @@ -/* Conformance Test 2.7.3.2: Ensure char variables are implemented as */ /* unsigned 8-bit integers */ main () { char a; int i; for (i = 0; i < 256; i++) { a = i; if (a != i) goto Fail; } printf ("Passed Conformance Test 2.7.3.2\n"); return; Fail: printf ("Failed Conformance Test 2.7.3.2\n"); } \ No newline at end of file +/* Conformance Test 2.7.3.2: Ensure char variables are implemented as */ +/* unsigned 8-bit integers */ +main () + { + char a; + int i; + + for (i = 0; i < 256; i++) + { + a = i; + if (a != i) + goto Fail; + } + + printf ("Passed Conformance Test 2.7.3.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.7.3.2\n"); + } diff --git a/Tests/Conformance/C2.7.4.1.CC b/Tests/Conformance/C2.7.4.1.CC old mode 100755 new mode 100644 index e812c91..b9448ef --- a/Tests/Conformance/C2.7.4.1.CC +++ b/Tests/Conformance/C2.7.4.1.CC @@ -1 +1,23 @@ -/* Conformance Test 2.7.4.1: Test implementation of ORCA/C p-strings */ main () { char a [300]; strcpy (a, "\pabc"); /* "abc" should be a p-string */ if (a[0] != 3) goto Fail; strcpy (a, "\pThis is a longer string than the last one..."); if (a[0] != 44) goto Fail; strcpy (a, "not a \p-string"); if ((strcmp (a, "not a p-string")) != 0) goto Fail; printf ("Passed Conformance Test 2.7.4.1\n"); return; Fail: printf ("Failed Conformance Test 2.7.4.1\n"); } \ No newline at end of file +/* Conformance Test 2.7.4.1: Test implementation of ORCA/C p-strings */ +main () + { + char a [300]; + + strcpy (a, "\pabc"); /* "abc" should be a p-string */ + if (a[0] != 3) + goto Fail; + + strcpy (a, "\pThis is a longer string than the last one..."); + if (a[0] != 44) + goto Fail; + + strcpy (a, "not a \p-string"); + if ((strcmp (a, "not a p-string")) != 0) + goto Fail; + + printf ("Passed Conformance Test 2.7.4.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.7.4.1\n"); + } diff --git a/Tests/Conformance/C2.7.4.2.CC b/Tests/Conformance/C2.7.4.2.CC old mode 100755 new mode 100644 index 2974115..a89f3da --- a/Tests/Conformance/C2.7.4.2.CC +++ b/Tests/Conformance/C2.7.4.2.CC @@ -1 +1,21 @@ -/* Conformance Test 2.7.4.2: Ensure ability to define string constants */ /* across source lines */ main () { char s[300] = "The string begins here...\ and ends here!"; if (strcmp (s, "The string begins here... and ends here!")) goto Fail; strcpy (s, "another spl\ it string!"); if (strcmp (s, "another spl it string!")) goto Fail; printf ("Passed Conformance Test 2.7.4.2\n"); return; Fail: printf ("Failed Conformance Test 2.7.4.2\n"); } \ No newline at end of file +/* Conformance Test 2.7.4.2: Ensure ability to define string constants */ +/* across source lines */ +main () + { + char s[300] = "The string begins here...\ + and ends here!"; + + if (strcmp (s, "The string begins here... and ends here!")) + goto Fail; + + strcpy (s, "another spl\ + it string!"); + if (strcmp (s, "another spl it string!")) + goto Fail; + + printf ("Passed Conformance Test 2.7.4.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.7.4.2\n"); + } diff --git a/Tests/Conformance/C2.7.4.3.CC b/Tests/Conformance/C2.7.4.3.CC old mode 100755 new mode 100644 index 3b09510..48ee4a5 --- a/Tests/Conformance/C2.7.4.3.CC +++ b/Tests/Conformance/C2.7.4.3.CC @@ -1 +1,217 @@ -/* Conformance Test 2.7.4.3: Test strings of critical length in scanner */ #include #include main () { int i; char *strPtr; char s1 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789"; /* 99 bytes */ char s2 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789A"; /* 100 bytes */ char s3 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789AB"; /* 101 bytes */ char s4 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789AB" /* 100 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnop"; /* 17 bytes */ char s5 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789AB" /* 100 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopq"; /* 18 bytes */ char s8 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789AB" /* 100 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqr" /* 18 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ 0123456"; /* Test first set of critical lengths: 99, 100, 101 */ if (strcmp (s1, "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789")) goto Fail; if (strcmp (s2, "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789A")) goto Fail; if (strcmp (s3, "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789AB")) goto Fail; /* Second set of critical lengths: 999, 1000, 1001 */ if (strncmp (s4, "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789AB", 100)) goto Fail; strPtr = &s4 [100]; for (i = 1; i < 10; i++) { if (strncmp (strPtr, s1, 98)) goto Fail; strPtr += 98; } if (strcmp (strPtr, "abcdefghijklmnop")) goto Fail; if (strncmp (s5, "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789AB", 100)) goto Fail; strPtr = &s5 [100]; for (i = 1; i < 10; i++) { if (strncmp (strPtr, s1, 98)) goto Fail; strPtr += 98; } if (strcmp (strPtr, "abcdefghijklmnopq")) goto Fail; /* Third set of critical lengths: 3999, 4000, 4001 */ if (strncmp (s8, "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789AB", 100)) goto Fail; strPtr = &s8 [100]; for (i = 1; i < 10; i++) { if (strncmp (strPtr, s1, 98)) goto Fail; strPtr += 98; } if (strncmp (strPtr, "abcdefghijklmnopqr", 18)) goto Fail; strPtr += 18; for (i = 0; i < 30; i++) { if (strncmp (strPtr, s1, 98)) goto Fail; strPtr += 98; } if (strcmp (strPtr, "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ 0123456")) goto Fail; printf ("Passed Conformance Test 2.7.4.3\n"); return; Fail: printf ("Failed Conformance Test 2.7.4.3\n"); } \ No newline at end of file +/* Conformance Test 2.7.4.3: Test strings of critical length in scanner */ + +#include +#include + +main () + { + int i; + char *strPtr; + char s1 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789"; /* 99 bytes */ + + char s2 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789A"; /* 100 bytes */ + + char s3 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789AB"; /* 101 bytes */ + + char s4 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789AB" /* 100 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnop"; /* 17 bytes */ + + char s5 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789AB" /* 100 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopq"; /* 18 bytes */ + + char s8 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789AB" /* 100 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqr" /* 18 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789" /* 98 bytes */ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +0123456"; + + + /* Test first set of critical lengths: 99, 100, 101 */ + if (strcmp (s1, "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789")) + goto Fail; + + if (strcmp (s2, "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789A")) + goto Fail; + + if (strcmp (s3, "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789AB")) + goto Fail; + + /* Second set of critical lengths: 999, 1000, 1001 */ + if (strncmp (s4, "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789AB", 100)) + goto Fail; + strPtr = &s4 [100]; + for (i = 1; i < 10; i++) + { + if (strncmp (strPtr, s1, 98)) + goto Fail; + strPtr += 98; + } + if (strcmp (strPtr, "abcdefghijklmnop")) + goto Fail; + + if (strncmp (s5, "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789AB", 100)) + goto Fail; + strPtr = &s5 [100]; + for (i = 1; i < 10; i++) + { + if (strncmp (strPtr, s1, 98)) + goto Fail; + strPtr += 98; + } + if (strcmp (strPtr, "abcdefghijklmnopq")) + goto Fail; + + /* Third set of critical lengths: 3999, 4000, 4001 */ + if (strncmp (s8, "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789AB", 100)) + goto Fail; + strPtr = &s8 [100]; + for (i = 1; i < 10; i++) + { + if (strncmp (strPtr, s1, 98)) + goto Fail; + strPtr += 98; + } + if (strncmp (strPtr, "abcdefghijklmnopqr", 18)) + goto Fail; + strPtr += 18; + for (i = 0; i < 30; i++) + { + if (strncmp (strPtr, s1, 98)) + goto Fail; + strPtr += 98; + } + if (strcmp (strPtr, "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +0123456")) + goto Fail; + + printf ("Passed Conformance Test 2.7.4.3\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.7.4.3\n"); + } diff --git a/Tests/Conformance/C2.7.4.4.CC b/Tests/Conformance/C2.7.4.4.CC old mode 100755 new mode 100644 index b1c95d9..204df00 --- a/Tests/Conformance/C2.7.4.4.CC +++ b/Tests/Conformance/C2.7.4.4.CC @@ -1 +1,6 @@ -main ( ) { char a [300] = \ "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"; printf("Passed Conformance Test 2.7.4.4\n"); } \ No newline at end of file +main ( ) +{ +char a [300] = \ +"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"; +printf("Passed Conformance Test 2.7.4.4\n"); +} diff --git a/Tests/Conformance/C2.7.7.1.CC b/Tests/Conformance/C2.7.7.1.CC old mode 100755 new mode 100644 index 5a3450c..6c71450 --- a/Tests/Conformance/C2.7.7.1.CC +++ b/Tests/Conformance/C2.7.7.1.CC @@ -1 +1,248 @@ -/* Conformance Test 2.7.7.1: Verification of numeric escape codes in */ /* character constants */ main () { char a; a = '\000'; if (a != '\x0') goto Fail; a = '\001'; if (a != '\x1') goto Fail; a = '\002'; if (a != '\x2') goto Fail; a = '\007'; /* alert character = bell */ if ((a != '\x7') || (a != '\a')) goto Fail; a = '\010'; /* back space */ if ((a != '\x8') || (a != '\b')) goto Fail; a = '\011'; /* horizontal tab */ if ((a != '\x9') || (a != '\t')) goto Fail; a = '\012'; /* line feed = newline */ if ((a != '\xA') || (a != '\n')) goto Fail; a = '\013'; /* vertical tab */ if ((a != '\xB') || (a != '\v')) goto Fail; a = '\014'; /* form feed */ if ((a != '\xC') || (a != '\f')) goto Fail; a = '\015'; /* carriage return */ if ((a != '\xD') || (a != '\r')) goto Fail; a = '\016'; if (a != '\xE') goto Fail; a = '\017'; if (a != '\xF') goto Fail; a = '\020'; if (a != '\x10') goto Fail; a = '\021'; if (a != '\x11') goto Fail; a = '\036'; if (a != '\x1E') goto Fail; a = '\037'; if (a != '\x1F') goto Fail; a = '\040'; /* blank */ if ((a != '\x20') || (a != ' ')) goto Fail; a = '\041'; /* exclamation point */ if ((a != '\x21') || (a != '!')) goto Fail; a = '\042'; /* double quote mark */ if ((a != '\x22') || (a != '"')) goto Fail; a = '\043'; /* pound sign */ if ((a != '\x23') || (a != '#')) goto Fail; a = '\044'; /* dollar sign */ if ((a != '\x24') || (a != '$')) goto Fail; a = '\045'; /* percent sign */ if ((a != '\x25') || (a != '%')) goto Fail; a = '\046'; /* ampersand */ if ((a != '\x26') || (a != '&')) goto Fail; a = '\047'; /* apostrophe */ if ((a != '\x27') || (a != '\'')) goto Fail; a = '\062'; /* character two */ if ((a != '\x32') || (a != '2')) goto Fail; a = '\063'; /* character three */ if ((a != '\x33') || (a != '3')) goto Fail; a = '\064'; /* character four */ if ((a != '\x34') || (a != '4')) goto Fail; a = '\065'; /* character five */ if ((a != '\x35') || (a != '5')) goto Fail; a = '\066'; /* character six */ if ((a != '\x36') || (a != '6')) goto Fail; a = '\077'; /* question mark */ if ((a != '\x3F') || (a != '?')) goto Fail; a = '\100'; /* at sign */ if ((a != '\x40') || (a != '@')) goto Fail; a = '\101'; if ((a != '\x41') || (a != 'A')) goto Fail; a = '\120'; if ((a != '\x50') || (a != 'P')) goto Fail; a = '\121'; if ((a != '\x51') || (a != 'Q')) goto Fail; a = '\122'; if ((a != '\x52') || (a != 'R')) goto Fail; a = '\123'; if ((a != '\x53') || (a != 'S')) goto Fail; a = '\124'; if ((a != '\x54') || (a != 'T')) goto Fail; a = '\125'; if ((a != '\x55') || (a != 'U')) goto Fail; a = '\126'; if ((a != '\x56') || (a != 'V')) goto Fail; a = '\127'; if ((a != '\x57') || (a != 'W')) goto Fail; a = '\130'; if ((a != '\x58') || (a != 'X')) goto Fail; a = '\131'; if ((a != '\x59') || (a != 'Y')) goto Fail; a = '\132'; if ((a != '\x5A') || (a != 'Z')) goto Fail; a = '\133'; /* left square bracket */ if ((a != '\x5B') || (a != '[')) goto Fail; a = '\134'; /* back slash */ if ((a != '\x5C') || (a != '\\')) goto Fail; a = '\135'; /* right square bracket */ if ((a != '\x5D') || (a != ']')) goto Fail; a = '\136'; /* caret mark */ if ((a != '\x5E') || (a != '^')) goto Fail; a = '\137'; /* underscore */ if ((a != '\x5F') || (a != '_')) goto Fail; a = '\140'; /* accent grave */ if ((a != '\x60') || (a != '`')) goto Fail; a = '\141'; if ((a != '\x61') || (a != 'a')) goto Fail; a = '\142'; if ((a != '\x62') || (a != 'b')) goto Fail; a = '\143'; if ((a != '\x63') || (a != 'c')) goto Fail; a = '\144'; if ((a != '\x64') || (a != 'd')) goto Fail; a = '\172'; if ((a != '\x7A') || (a != 'z')) goto Fail; a = '\173'; /* left curly bracket */ if ((a != '\x7B') || (a != '{')) goto Fail; a = '\174'; /* vertical bar */ if ((a != '\x7C') || (a != '|')) goto Fail; a = '\175'; /* right curly bracket */ if ((a != '\x7D') || (a != '}')) goto Fail; a = '\176'; /* tilde */ if ((a != '\x7E') || (a != '~')) goto Fail; a = '\177'; /* rubout */ if (a != '\x7F') goto Fail; printf ("Passed Conformance Test 2.7.7.1\n"); return; Fail: printf ("Failed Conformance Test 2.7.7.1\n"); } \ No newline at end of file +/* Conformance Test 2.7.7.1: Verification of numeric escape codes in */ +/* character constants */ +main () + { + char a; + + a = '\000'; + if (a != '\x0') + goto Fail; + + a = '\001'; + if (a != '\x1') + goto Fail; + + a = '\002'; + if (a != '\x2') + goto Fail; + + a = '\007'; /* alert character = bell */ + if ((a != '\x7') || (a != '\a')) + goto Fail; + + a = '\010'; /* back space */ + if ((a != '\x8') || (a != '\b')) + goto Fail; + + a = '\011'; /* horizontal tab */ + if ((a != '\x9') || (a != '\t')) + goto Fail; + + a = '\012'; /* line feed = newline */ + if ((a != '\xA') || (a != '\n')) + goto Fail; + + a = '\013'; /* vertical tab */ + if ((a != '\xB') || (a != '\v')) + goto Fail; + + a = '\014'; /* form feed */ + if ((a != '\xC') || (a != '\f')) + goto Fail; + + a = '\015'; /* carriage return */ + if ((a != '\xD') || (a != '\r')) + goto Fail; + + a = '\016'; + if (a != '\xE') + goto Fail; + + a = '\017'; + if (a != '\xF') + goto Fail; + + a = '\020'; + if (a != '\x10') + goto Fail; + + a = '\021'; + if (a != '\x11') + goto Fail; + + a = '\036'; + if (a != '\x1E') + goto Fail; + + a = '\037'; + if (a != '\x1F') + goto Fail; + + a = '\040'; /* blank */ + if ((a != '\x20') || (a != ' ')) + goto Fail; + + a = '\041'; /* exclamation point */ + if ((a != '\x21') || (a != '!')) + goto Fail; + + a = '\042'; /* double quote mark */ + if ((a != '\x22') || (a != '"')) + goto Fail; + + a = '\043'; /* pound sign */ + if ((a != '\x23') || (a != '#')) + goto Fail; + + a = '\044'; /* dollar sign */ + if ((a != '\x24') || (a != '$')) + goto Fail; + + a = '\045'; /* percent sign */ + if ((a != '\x25') || (a != '%')) + goto Fail; + + a = '\046'; /* ampersand */ + if ((a != '\x26') || (a != '&')) + goto Fail; + + a = '\047'; /* apostrophe */ + if ((a != '\x27') || (a != '\'')) + goto Fail; + + a = '\062'; /* character two */ + if ((a != '\x32') || (a != '2')) + goto Fail; + + a = '\063'; /* character three */ + if ((a != '\x33') || (a != '3')) + goto Fail; + + a = '\064'; /* character four */ + if ((a != '\x34') || (a != '4')) + goto Fail; + + a = '\065'; /* character five */ + if ((a != '\x35') || (a != '5')) + goto Fail; + + a = '\066'; /* character six */ + if ((a != '\x36') || (a != '6')) + goto Fail; + + a = '\077'; /* question mark */ + if ((a != '\x3F') || (a != '?')) + goto Fail; + + a = '\100'; /* at sign */ + if ((a != '\x40') || (a != '@')) + goto Fail; + + a = '\101'; + if ((a != '\x41') || (a != 'A')) + goto Fail; + + a = '\120'; + if ((a != '\x50') || (a != 'P')) + goto Fail; + + a = '\121'; + if ((a != '\x51') || (a != 'Q')) + goto Fail; + + a = '\122'; + if ((a != '\x52') || (a != 'R')) + goto Fail; + + a = '\123'; + if ((a != '\x53') || (a != 'S')) + goto Fail; + + a = '\124'; + if ((a != '\x54') || (a != 'T')) + goto Fail; + + a = '\125'; + if ((a != '\x55') || (a != 'U')) + goto Fail; + + a = '\126'; + if ((a != '\x56') || (a != 'V')) + goto Fail; + + a = '\127'; + if ((a != '\x57') || (a != 'W')) + goto Fail; + + a = '\130'; + if ((a != '\x58') || (a != 'X')) + goto Fail; + + a = '\131'; + if ((a != '\x59') || (a != 'Y')) + goto Fail; + + a = '\132'; + if ((a != '\x5A') || (a != 'Z')) + goto Fail; + + a = '\133'; /* left square bracket */ + if ((a != '\x5B') || (a != '[')) + goto Fail; + + a = '\134'; /* back slash */ + if ((a != '\x5C') || (a != '\\')) + goto Fail; + + a = '\135'; /* right square bracket */ + if ((a != '\x5D') || (a != ']')) + goto Fail; + + a = '\136'; /* caret mark */ + if ((a != '\x5E') || (a != '^')) + goto Fail; + + a = '\137'; /* underscore */ + if ((a != '\x5F') || (a != '_')) + goto Fail; + + a = '\140'; /* accent grave */ + if ((a != '\x60') || (a != '`')) + goto Fail; + + a = '\141'; + if ((a != '\x61') || (a != 'a')) + goto Fail; + + a = '\142'; + if ((a != '\x62') || (a != 'b')) + goto Fail; + + a = '\143'; + if ((a != '\x63') || (a != 'c')) + goto Fail; + + a = '\144'; + if ((a != '\x64') || (a != 'd')) + goto Fail; + + a = '\172'; + if ((a != '\x7A') || (a != 'z')) + goto Fail; + + a = '\173'; /* left curly bracket */ + if ((a != '\x7B') || (a != '{')) + goto Fail; + + a = '\174'; /* vertical bar */ + if ((a != '\x7C') || (a != '|')) + goto Fail; + + a = '\175'; /* right curly bracket */ + if ((a != '\x7D') || (a != '}')) + goto Fail; + + a = '\176'; /* tilde */ + if ((a != '\x7E') || (a != '~')) + goto Fail; + + a = '\177'; /* rubout */ + if (a != '\x7F') + goto Fail; + + printf ("Passed Conformance Test 2.7.7.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.7.7.1\n"); + } diff --git a/Tests/Conformance/C2.7.7.2.CC b/Tests/Conformance/C2.7.7.2.CC old mode 100755 new mode 100644 index eefadd8..62c74b1 --- a/Tests/Conformance/C2.7.7.2.CC +++ b/Tests/Conformance/C2.7.7.2.CC @@ -1 +1,64 @@ -/* Conformance Test 2.7.7.2: Verification of numeric escape codes */ /* within character strings */ main () { char a [300]; strcpy (a, "\07a\010b\011c\012d\013e\014f\015g\016h\017i\020j"); if ((strcmp (a, "\aa\bb\tc\nd\ve\ff\rg\xeh\xfi\x10j")) != 0) goto Fail; strcpy (a, "\021k\022l\023m\024n\025o\026p\027q\030r\031s\032t"); if ((strcmp (a, "\x11k\x12l\x13m\x14n\x15o\x16p\x17q\x18r\x19s\x1At")) != 0) goto Fail; strcpy (a, "\033u\034v\035w\036x\037y\040z\041a\042b\043c\044d"); if ((strcmp (a, "\x1bu\x1cv\x1dw\x1ex\x1fy z!a\"b#c$d")) != 0) goto Fail; strcpy (a, "\045e\046f\047g\050h\051i\052j\053k\054l\055m\056n\057o"); if ((strcmp (a, "%e&f'g(h)i*j+k,l-m.n/o")) != 0) goto Fail; strcpy (a, "\060p\061q\062r\063s\064t\065u\066v\067w\070x\071y\072z"); if ((strcmp (a, "0p1q2r3s4t5u6v7w8x9y:z")) != 0) goto Fail; strcpy (a, "\073A\074B\075C\076D\077E\100F\101G\102H\103I\104J"); if ((strcmp (a, ";AD?E@FAGBHCIDJ")) != 0) goto Fail; strcpy (a, "\105k\106l\107m\110n\111o\112p\113q\114r\115s"); if ((strcmp (a, "EkFlGmHnIoJpKqLrMs")) != 0) goto Fail; strcpy (a, "\116t\117u\120v\121w\122x\123y\124z\125A\126B"); if ((strcmp (a, "NtOuPvQwRxSyTzUAVB")) != 0) goto Fail; strcpy (a, "\127C\130D\131E\132F\133G\134H\135I\136J\137K"); if ((strcmp (a, "WCXDYEZF[G\x5cH]I^J_K")) != 0) goto Fail; strcpy (a, "\140L\141M\142N\143O\144P\145Q\146R\147S\150T"); if ((strcmp (a, "`LaMbNcOdPeQfRgShT")) != 0) goto Fail; strcpy (a, "\151U\152V\153W\154X\155Y\156Z\157A\160B\161C"); if ((strcmp (a, "iUjVkWlXmYnZoApBqC")) != 0) goto Fail; strcpy (a, "\162D\163E\164F\165G\166H\167I\170J\171K\172L"); if ((strcmp (a, "rDsEtFuGvHwIxJyKzL")) != 0) goto Fail; strcpy (a, "\173M\174N\175O\176P\177Q"); if ((strcmp (a, "{M|N}O~P\x7fQ")) != 0) goto Fail; printf ("Passed Conformance Test 2.7.7.2\n"); return; Fail: printf ("Failed Conformance Test 2.7.7.2\n"); } \ No newline at end of file +/* Conformance Test 2.7.7.2: Verification of numeric escape codes */ +/* within character strings */ +main () + { + char a [300]; + + strcpy (a, "\07a\010b\011c\012d\013e\014f\015g\016h\017i\020j"); + if ((strcmp (a, "\aa\bb\tc\nd\ve\ff\rg\xeh\xfi\x10j")) != 0) + goto Fail; + + strcpy (a, "\021k\022l\023m\024n\025o\026p\027q\030r\031s\032t"); + if ((strcmp (a, "\x11k\x12l\x13m\x14n\x15o\x16p\x17q\x18r\x19s\x1At")) != 0) + goto Fail; + + strcpy (a, "\033u\034v\035w\036x\037y\040z\041a\042b\043c\044d"); + if ((strcmp (a, "\x1bu\x1cv\x1dw\x1ex\x1fy z!a\"b#c$d")) != 0) + goto Fail; + + strcpy (a, "\045e\046f\047g\050h\051i\052j\053k\054l\055m\056n\057o"); + if ((strcmp (a, "%e&f'g(h)i*j+k,l-m.n/o")) != 0) + goto Fail; + + strcpy (a, "\060p\061q\062r\063s\064t\065u\066v\067w\070x\071y\072z"); + if ((strcmp (a, "0p1q2r3s4t5u6v7w8x9y:z")) != 0) + goto Fail; + + strcpy (a, "\073A\074B\075C\076D\077E\100F\101G\102H\103I\104J"); + if ((strcmp (a, ";AD?E@FAGBHCIDJ")) != 0) + goto Fail; + + strcpy (a, "\105k\106l\107m\110n\111o\112p\113q\114r\115s"); + if ((strcmp (a, "EkFlGmHnIoJpKqLrMs")) != 0) + goto Fail; + + strcpy (a, "\116t\117u\120v\121w\122x\123y\124z\125A\126B"); + if ((strcmp (a, "NtOuPvQwRxSyTzUAVB")) != 0) + goto Fail; + + strcpy (a, "\127C\130D\131E\132F\133G\134H\135I\136J\137K"); + if ((strcmp (a, "WCXDYEZF[G\x5cH]I^J_K")) != 0) + goto Fail; + + strcpy (a, "\140L\141M\142N\143O\144P\145Q\146R\147S\150T"); + if ((strcmp (a, "`LaMbNcOdPeQfRgShT")) != 0) + goto Fail; + + strcpy (a, "\151U\152V\153W\154X\155Y\156Z\157A\160B\161C"); + if ((strcmp (a, "iUjVkWlXmYnZoApBqC")) != 0) + goto Fail; + + strcpy (a, "\162D\163E\164F\165G\166H\167I\170J\171K\172L"); + if ((strcmp (a, "rDsEtFuGvHwIxJyKzL")) != 0) + goto Fail; + + strcpy (a, "\173M\174N\175O\176P\177Q"); + if ((strcmp (a, "{M|N}O~P\x7fQ")) != 0) + goto Fail; + + printf ("Passed Conformance Test 2.7.7.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 2.7.7.2\n"); + } diff --git a/Tests/Conformance/C20.1.0.1.CC b/Tests/Conformance/C20.1.0.1.CC old mode 100755 new mode 100644 index 7182bd1..5661045 --- a/Tests/Conformance/C20.1.0.1.CC +++ b/Tests/Conformance/C20.1.0.1.CC @@ -1 +1,101 @@ -/* Conformance Test 20.1.0.1: Verification of clock library function */ #include #include #include #include #include #include #include #include #include main () { clock_t clicks; char **dpHandle, *dPageAddr; int myID; struct TSInfo { int toolSet; /* Tool Locator table to */ int minVersion; }; /* load RAM-based tools */ struct ToolTable { int count; struct TSInfo tsInfo [2]; } toolTbl; /* In order to use the clock function, must ensure that Event Manager */ /* has been started. The Event Manager requires the Miscellaneous Toolset */ /* QuickDraw II, the Desk Manager, and the ADB Toolset. First allocate */ /* 4 pages of direct page workspace for the Event Manager and QD II. */ myID = userid (); dpHandle = NewHandle (1024L, myID, 0xC015, 0x00000000L); if ( toolerror () ) goto Fail1; if (dpHandle == NULL) goto Fail1; dPageAddr = *dpHandle; if (! (MTStatus ()) ) /* start the Miscellaneous Toolset */ MTStartUp (); if (! (QDStatus ()) ) /* start QuickDraw II */ { QDStartUp ((int) dPageAddr, 0, 0, myID); if ( toolerror () ) goto Fail2; } if (! (EMStatus ()) ) /* start Event Manager */ { EMStartUp (((int) dPageAddr) + 768, 0, 0, 640, 0, 200, myID); if ( toolerror () ) goto Fail3; } toolTbl.count = 2; /* load Desk Mgr & ADB tools */ toolTbl.tsInfo [0].toolSet = 5; toolTbl.tsInfo [1].toolSet = 9; toolTbl.tsInfo [0].minVersion = toolTbl.tsInfo [1].minVersion = 1; LoadTools ((void *) (&toolTbl)); if ( toolerror () ) goto Fail4; if (! (DeskStatus ()) ) /* start the Desk Manager */ DeskStartUp (); if (! (ADBStatus ()) ) /* start the Apple Desktop Bus */ ADBStartUp (); /* Finally, can call clock. */ clicks = clock (); /* Shut down the tools in the reverse order of start up. */ ADBShutDown (); DeskShutDown (); EMShutDown (); QDShutDown (); MTShutDown (); printf ("Passed Conformance Test 20.1.0.1\n"); return; Fail: printf ("Failed Conformance Test 20.1.0.1\n"); Fail1: printf ("Unable to allocate direct page for Conformance Test 20.1.0.1\n"); Fail2: printf ("Unable to start QuickDraw II for Conformance Test 20.1.0.1\n"); Fail3: printf ("Unable to start Event Manager for Conformance Test 20.1.0.1\n"); Fail4: printf ("Unable to load RAM tools for Conformance Test 20.1.0.1\n"); } \ No newline at end of file +/* Conformance Test 20.1.0.1: Verification of clock library function */ + +#include +#include +#include +#include +#include +#include +#include +#include +#include + +main () + { + clock_t clicks; + char **dpHandle, *dPageAddr; + int myID; + + struct TSInfo { int toolSet; /* Tool Locator table to */ + int minVersion; }; /* load RAM-based tools */ + struct ToolTable { int count; + struct TSInfo tsInfo [2]; } toolTbl; + + + /* In order to use the clock function, must ensure that Event Manager */ + /* has been started. The Event Manager requires the Miscellaneous Toolset */ + /* QuickDraw II, the Desk Manager, and the ADB Toolset. First allocate */ + /* 4 pages of direct page workspace for the Event Manager and QD II. */ + + myID = userid (); + dpHandle = NewHandle (1024L, myID, 0xC015, 0x00000000L); + if ( toolerror () ) + goto Fail1; + if (dpHandle == NULL) + goto Fail1; + dPageAddr = *dpHandle; + + if (! (MTStatus ()) ) /* start the Miscellaneous Toolset */ + MTStartUp (); + + if (! (QDStatus ()) ) /* start QuickDraw II */ + { + QDStartUp ((int) dPageAddr, 0, 0, myID); + if ( toolerror () ) + goto Fail2; + } + + if (! (EMStatus ()) ) /* start Event Manager */ + { + EMStartUp (((int) dPageAddr) + 768, 0, 0, 640, 0, 200, myID); + if ( toolerror () ) + goto Fail3; + } + + toolTbl.count = 2; /* load Desk Mgr & ADB tools */ + toolTbl.tsInfo [0].toolSet = 5; + toolTbl.tsInfo [1].toolSet = 9; + toolTbl.tsInfo [0].minVersion = toolTbl.tsInfo [1].minVersion = 1; + + LoadTools ((void *) (&toolTbl)); + if ( toolerror () ) + goto Fail4; + + if (! (DeskStatus ()) ) /* start the Desk Manager */ + DeskStartUp (); + + if (! (ADBStatus ()) ) /* start the Apple Desktop Bus */ + ADBStartUp (); + + + /* Finally, can call clock. */ + + clicks = clock (); + + + /* Shut down the tools in the reverse order of start up. */ + + ADBShutDown (); + DeskShutDown (); + EMShutDown (); + QDShutDown (); + MTShutDown (); + + printf ("Passed Conformance Test 20.1.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 20.1.0.1\n"); + +Fail1: + printf ("Unable to allocate direct page for Conformance Test 20.1.0.1\n"); + +Fail2: + printf ("Unable to start QuickDraw II for Conformance Test 20.1.0.1\n"); + +Fail3: + printf ("Unable to start Event Manager for Conformance Test 20.1.0.1\n"); + +Fail4: + printf ("Unable to load RAM tools for Conformance Test 20.1.0.1\n"); + } diff --git a/Tests/Conformance/C20.5.0.1.CC b/Tests/Conformance/C20.5.0.1.CC old mode 100755 new mode 100644 index d2df21d..3c26374 --- a/Tests/Conformance/C20.5.0.1.CC +++ b/Tests/Conformance/C20.5.0.1.CC @@ -1 +1,26 @@ -/* Conformance Test 20.5.0.1: Verification of difftime function */ #include #include main () { double d1; time_t t1, t0; long L; t0 = time (NULL); for (L = 0; L < 50000; L++) ; t1 = time (NULL); d1 = difftime (t1, t0); if (d1 < 0) goto Fail; printf ("Passed Conformance Test 20.5.0.1\n"); return; Fail: printf ("Failed Conformance Test 20.5.0.1\n"); } \ No newline at end of file +/* Conformance Test 20.5.0.1: Verification of difftime function */ + +#include +#include + +main () + { + double d1; + time_t t1, t0; + long L; + + + t0 = time (NULL); + for (L = 0; L < 50000; L++) + ; + t1 = time (NULL); + d1 = difftime (t1, t0); + if (d1 < 0) + goto Fail; + + printf ("Passed Conformance Test 20.5.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 20.5.0.1\n"); + } diff --git a/Tests/Conformance/C21.1.0.2.CC b/Tests/Conformance/C21.1.0.2.CC old mode 100755 new mode 100644 index fc8fd46..4fa5ce3 --- a/Tests/Conformance/C21.1.0.2.CC +++ b/Tests/Conformance/C21.1.0.2.CC @@ -1 +1,11 @@ -/* Conformance Test 21.1.0.2: Verification of assert, ndebug macros */ #include #define NDEBUG 1 main () { int i = 7; assert (i == 7); printf ("Passed Conformance Test 21.1.0.2\n"); } \ No newline at end of file +/* Conformance Test 21.1.0.2: Verification of assert, ndebug macros */ + +#include +#define NDEBUG 1 + +main () + { + int i = 7; + assert (i == 7); + printf ("Passed Conformance Test 21.1.0.2\n"); + } diff --git a/Tests/Conformance/C21.4.0.1.CC b/Tests/Conformance/C21.4.0.1.CC old mode 100755 new mode 100644 index 3f38763..a304ab3 --- a/Tests/Conformance/C21.4.0.1.CC +++ b/Tests/Conformance/C21.4.0.1.CC @@ -1 +1,37 @@ -/* Conformance Test 21.4.0.1: Verification of setjmp, longjmp functions */ #include jmp_buf env; /* setjmp, longjmp environment array */ /*****************************************************************************/ void F1 (char ch) { if (ch == 'a') longjmp (env, 0); /* not allowed to do this -- should */ else /* cause setjmp to return a 1 */ longjmp (env, 2); } /*****************************************************************************/ main () { int i; i = setjmp (env); /* initialize env to main's environment */ if (i == 0) F1 ('a'); else if (i == 1) /* check second return from setjmp */ { printf ("Passed Conformance Test 21.4.0.1\n"); return; } else printf ("Failed Conformance Test 21.4.0.1\n"); } \ No newline at end of file +/* Conformance Test 21.4.0.1: Verification of setjmp, longjmp functions */ + +#include + +jmp_buf env; /* setjmp, longjmp environment array */ + + +/*****************************************************************************/ + +void F1 (char ch) + { + if (ch == 'a') + longjmp (env, 0); /* not allowed to do this -- should */ + else /* cause setjmp to return a 1 */ + longjmp (env, 2); + } + +/*****************************************************************************/ + +main () + { + int i; + + + i = setjmp (env); /* initialize env to main's environment */ + if (i == 0) + F1 ('a'); + + else if (i == 1) /* check second return from setjmp */ + { + printf ("Passed Conformance Test 21.4.0.1\n"); + return; + } + + else + printf ("Failed Conformance Test 21.4.0.1\n"); + } diff --git a/Tests/Conformance/C22.5.0.1.CC b/Tests/Conformance/C22.5.0.1.CC old mode 100755 new mode 100644 index 4d5c534..48eb4de --- a/Tests/Conformance/C22.5.0.1.CC +++ b/Tests/Conformance/C22.5.0.1.CC @@ -1 +1,65 @@ -/* Conformance Test 22.5.0.1: Verification of bsearch, qsort functions */ #include #include /******************************************************************************/ int Compare (int *i1, int *i2) { if (*i1 < *i2) return (-1); else if (*i1 > *i2) return (1); else return 0; } /******************************************************************************/ main () { int i [10] = { 3, 4, 6, 8, 0, 2, 1, 5, 3, 7 }; int j, *iptr; /* First sort the array with the qsort routine, then check results. */ qsort ( (int *) (i), 10, sizeof (int), Compare ); for (j = 0; j < 4; j++) if (i [j] != j) goto Fail; for (j = 3; j < 9; j++) if (i [j+1] != j) goto Fail; /* Now call bsearch to find some values in the array. */ j = 7; iptr = (int *) bsearch ( &j, i, 10, sizeof (int), Compare ); if (iptr != &i [8]) goto Fail; j = 0; iptr = (int *) bsearch ( &j, i, 10, sizeof (int), Compare ); if (iptr != i) goto Fail; j = -3; iptr = (int *) bsearch ( &j, i, 10, sizeof (int), Compare ); if (iptr != NULL) goto Fail; printf ("Passed Conformance Test 22.5.0.1\n"); return; Fail: printf ("Failed Conformance Test 22.5.0.1\n"); } \ No newline at end of file +/* Conformance Test 22.5.0.1: Verification of bsearch, qsort functions */ + +#include +#include + + +/******************************************************************************/ + +int Compare (int *i1, int *i2) + { + if (*i1 < *i2) + return (-1); + + else if (*i1 > *i2) + return (1); + + else + return 0; + } + + +/******************************************************************************/ + +main () + { + int i [10] = { 3, 4, 6, 8, 0, 2, 1, 5, 3, 7 }; + int j, *iptr; + + + /* First sort the array with the qsort routine, then check results. */ + + qsort ( (int *) (i), 10, sizeof (int), Compare ); + + for (j = 0; j < 4; j++) + if (i [j] != j) + goto Fail; + + for (j = 3; j < 9; j++) + if (i [j+1] != j) + goto Fail; + + + /* Now call bsearch to find some values in the array. */ + + j = 7; + iptr = (int *) bsearch ( &j, i, 10, sizeof (int), Compare ); + if (iptr != &i [8]) + goto Fail; + + j = 0; + iptr = (int *) bsearch ( &j, i, 10, sizeof (int), Compare ); + if (iptr != i) + goto Fail; + + j = -3; + iptr = (int *) bsearch ( &j, i, 10, sizeof (int), Compare ); + if (iptr != NULL) + goto Fail; + + printf ("Passed Conformance Test 22.5.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 22.5.0.1\n"); + } diff --git a/Tests/Conformance/C23.1.0.1.CC b/Tests/Conformance/C23.1.0.1.CC old mode 100755 new mode 100644 index 18bc40f..c23839e --- a/Tests/Conformance/C23.1.0.1.CC +++ b/Tests/Conformance/C23.1.0.1.CC @@ -1 +1,34 @@ -/* Conformance Test 23.1.0.1: Verification of c2pstr, p2cstr functions */ #include main () { char *ptr; char pstring [] = "\pThis is a so-called Pascal string"; char cstring [] = "This string is 289 characters long: a b c d e f g h i j " "a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M " "a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M " "a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M"; ptr = c2pstr (cstring); if ( ptr[0] != 255 ) goto Fail; if (! (strcmp (ptr, "\pThis string is 289 characters long: a b c d e f g h i \ j a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L \ M a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L \ M a b c d e f g h i j k l m n o p q r s t u v")) ) goto Fail; ptr = p2cstr (pstring); if ( (strlen (ptr)) != 33 ) goto Fail; if (strcmp (ptr, "This is a so-called Pascal string")) goto Fail; printf ("Passed Conformance Test 23.1.0.1\n"); return; Fail: printf ("Failed Conformance Test 23.1.0.1\n"); } \ No newline at end of file +/* Conformance Test 23.1.0.1: Verification of c2pstr, p2cstr functions */ + +#include + +main () + { + char *ptr; + char pstring [] = "\pThis is a so-called Pascal string"; + char cstring [] = "This string is 289 characters long: a b c d e f g h i j " +"a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M " +"a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M " +"a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M"; + + ptr = c2pstr (cstring); + if ( ptr[0] != 255 ) + goto Fail; + if (! (strcmp (ptr, "\pThis string is 289 characters long: a b c d e f g h i \ +j a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L \ +M a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L \ +M a b c d e f g h i j k l m n o p q r s t u v")) ) + goto Fail; + + ptr = p2cstr (pstring); + if ( (strlen (ptr)) != 33 ) + goto Fail; + if (strcmp (ptr, "This is a so-called Pascal string")) + goto Fail; + + printf ("Passed Conformance Test 23.1.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 23.1.0.1\n"); + } diff --git a/Tests/Conformance/C23.2.0.1.CC b/Tests/Conformance/C23.2.0.1.CC old mode 100755 new mode 100644 index 98aabdf..bef8119 --- a/Tests/Conformance/C23.2.0.1.CC +++ b/Tests/Conformance/C23.2.0.1.CC @@ -1 +1,13 @@ -/* Conformance Test 23.2.0.1: Make sure the rtl pragma works */ #pragma rtl #include int main (void) { SYSIOSTARTUP(); printf ("Passed Conformance Test 23.2.0.1\n"); SYSIOSHUTDOWN(); return; } \ No newline at end of file +/* Conformance Test 23.2.0.1: Make sure the rtl pragma works */ + +#pragma rtl + +#include + +int main (void) + { + SYSIOSTARTUP(); + printf ("Passed Conformance Test 23.2.0.1\n"); + SYSIOSHUTDOWN(); + return; + } diff --git a/Tests/Conformance/C23.3.0.1.CC b/Tests/Conformance/C23.3.0.1.CC old mode 100755 new mode 100644 index 60138f8..5c91a03 --- a/Tests/Conformance/C23.3.0.1.CC +++ b/Tests/Conformance/C23.3.0.1.CC @@ -1 +1,18 @@ -/* Conformance Test 23.3.0.1: Verification of shellid function */ #include main () { char *id; id = shellid (); if (strcmp (id, "BYTEWRKS")) goto Fail; printf ("Passed Conformance Test 23.3.0.1\n"); return; Fail: printf ("Failed Conformance Test 23.3.0.1\n"); } \ No newline at end of file +/* Conformance Test 23.3.0.1: Verification of shellid function */ + +#include + +main () + { + char *id; + + id = shellid (); + if (strcmp (id, "BYTEWRKS")) + goto Fail; + + printf ("Passed Conformance Test 23.3.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 23.3.0.1\n"); + } diff --git a/Tests/Conformance/C23.4.0.1.CC b/Tests/Conformance/C23.4.0.1.CC old mode 100755 new mode 100644 index 5e15b58..0840890 --- a/Tests/Conformance/C23.4.0.1.CC +++ b/Tests/Conformance/C23.4.0.1.CC @@ -1 +1,19 @@ -/* Conformance Test 23.4.0.1: Verification of startdesk, enddesk functions */ #include main () { startdesk (640); if ( toolerror () ) goto Fail; enddesk (); if ( toolerror () ) goto Fail; printf ("Passed Conformance Test 23.4.0.1\n"); return; Fail: printf ("Failed Conformance Test 23.4.0.1\n"); } \ No newline at end of file +/* Conformance Test 23.4.0.1: Verification of startdesk, enddesk functions */ + +#include + +main () + { + startdesk (640); + if ( toolerror () ) + goto Fail; + enddesk (); + if ( toolerror () ) + goto Fail; + + printf ("Passed Conformance Test 23.4.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 23.4.0.1\n"); + } diff --git a/Tests/Conformance/C23.5.0.1.CC b/Tests/Conformance/C23.5.0.1.CC old mode 100755 new mode 100644 index 9176e02..1d82e8c --- a/Tests/Conformance/C23.5.0.1.CC +++ b/Tests/Conformance/C23.5.0.1.CC @@ -1 +1,19 @@ -/* Conformance Test 23.5.0.1: Verification of startgraph, endgraph functions */ #include main () { startgraph (640); if ( toolerror () ) goto Fail; endgraph (); if ( toolerror () ) goto Fail; printf ("Passed Conformance Test 23.5.0.1\n"); return; Fail: printf ("Failed Conformance Test 23.5.0.1\n"); } \ No newline at end of file +/* Conformance Test 23.5.0.1: Verification of startgraph, endgraph functions */ + +#include + +main () + { + startgraph (640); + if ( toolerror () ) + goto Fail; + endgraph (); + if ( toolerror () ) + goto Fail; + + printf ("Passed Conformance Test 23.5.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 23.5.0.1\n"); + } diff --git a/Tests/Conformance/C23.6.0.1.CC b/Tests/Conformance/C23.6.0.1.CC old mode 100755 new mode 100644 index 32a40eb..44e1fb9 --- a/Tests/Conformance/C23.6.0.1.CC +++ b/Tests/Conformance/C23.6.0.1.CC @@ -1 +1,11 @@ -/* Conformance Test 23.6.0.1: Make sure the lint pragma is alive */ #pragma lint -1 #include int main (void) { printf ("Passed Conformance Test 23.6.0.1\n"); } \ No newline at end of file +/* Conformance Test 23.6.0.1: Make sure the lint pragma is alive */ + +#pragma lint -1 + +#include + +int main (void) + +{ +printf ("Passed Conformance Test 23.6.0.1\n"); +} diff --git a/Tests/Conformance/C24.0.1.CC b/Tests/Conformance/C24.0.1.CC old mode 100755 new mode 100644 index 3727e9e..ffabf7e --- a/Tests/Conformance/C24.0.1.CC +++ b/Tests/Conformance/C24.0.1.CC @@ -1 +1,106 @@ -/* Conformance Test 24.0.1: Verification of floating-point expressions for */ /* 68881 card */ #define SLOT 3 #define __FPE__ SLOT #pragma float 1 SLOT #include #include float f = 3.5; double d = 87.65; extended e = 92.33; int i, j, k, m; int sub1(void) { f++; d++; e++; /* test postincrement */ if ((fabs(f - 4.5) > 0.00001) || (fabs(d - 88.65) > 0.00001) || (fabs(e - 93.33) > 0.00001)) goto Fail; f--; d--; e--; /* test postdecrement */ if ((fabs(f - 3.5) > 0.00001) || (fabs(d - 87.65) > 0.00001) || (fabs(e - 92.33) > 0.00001)) goto Fail; f = f * 2.4; d = d * (-7.2); e = e * 9.22; /* multiplication */ if ((fabs(f - 8.4) > 0.00001) || (fabs(d - (-631.08)) > 0.00001) || (fabs(e - 851.2826) > 0.00001)) goto Fail; f = f / 2.0; d = d / -3.0; e = e / 0.2; /* division */ if ((fabs(f - 4.2) > 0.00001) || (fabs(d - 210.36) > 0.00001) || (fabs(e - 4256.413) > 0.00001)) goto Fail; i = f < d; j = d <= e; k = e > f; m = e >= e; /* relational operators */ if ((i != 1) || (j != 1) || (k != 1) || (m != 1)) goto Fail; return 0; Fail: return 1; } int sub2(void) { i = 0 && e--; j = f && 0; k = d++ && --f; /* logical AND operator */ if ((i != 0) || (j != 0) || (k != 1) || (fabs(e - 4256.413) > 0.00001) || (fabs(d - 211.36) > 0.00001) || (fabs(f - 3.2) > 0.00001)) goto Fail; i = 0 || e--; j = f || 0; k = d++ || --f; /* logical OR operator */ if ((i != 1) || (j != 1) || (k != 1) || (fabs(e - 4255.413) > 0.00001) || (fabs(d - 212.36) > 0.00001) || (fabs(f - 3.2) > 0.00001)) goto Fail; f = e ? 8 >> 1: d--; /* conditional expression */ if ((fabs(f - 4.0) > 0.00001) || (fabs(d - 212.36) > 0.00001)) goto Fail; return 0; Fail: return 1; } int sub3(void) { d += 5; e -= 8.9; f *= 3.0; /* compound assignment */ if ((fabs(f - 12.0) > 0.00001) || (fabs(d - 217.36) > 0.00001) || (fabs(e - 4246.513) > 0.00001)) goto Fail; f /= -0.4; if (fabs(f - (-30.0)) > 0.00001) goto Fail; f = (e = ((extended) (long) (e * 2.0)), d--, d--); /* comma operator */ if ((fabs(f - 216.36) > 0.00001) || (fabs(d - 215.36) > 0.00001) || (fabs(e - 8493.0) > 0.00001)) goto Fail; return 0; Fail: return 1; } main () { if (sub1()) goto Fail; if (sub2()) goto Fail; if (sub3()) goto Fail; printf ("Passed Conformance Test 24.0.1\n"); return; Fail: printf ("Failed Conformance Test 24.0.1\n"); } \ No newline at end of file +/* Conformance Test 24.0.1: Verification of floating-point expressions for */ +/* 68881 card */ + +#define SLOT 3 +#define __FPE__ SLOT +#pragma float 1 SLOT + +#include +#include + +float f = 3.5; +double d = 87.65; +extended e = 92.33; + +int i, j, k, m; + +int sub1(void) + +{ + f++; d++; e++; /* test postincrement */ + if ((fabs(f - 4.5) > 0.00001) || (fabs(d - 88.65) > 0.00001) || + (fabs(e - 93.33) > 0.00001)) + goto Fail; + + f--; d--; e--; /* test postdecrement */ + if ((fabs(f - 3.5) > 0.00001) || (fabs(d - 87.65) > 0.00001) || + (fabs(e - 92.33) > 0.00001)) + goto Fail; + + f = f * 2.4; d = d * (-7.2); e = e * 9.22; /* multiplication */ + if ((fabs(f - 8.4) > 0.00001) || (fabs(d - (-631.08)) > 0.00001) || + (fabs(e - 851.2826) > 0.00001)) + goto Fail; + + f = f / 2.0; d = d / -3.0; e = e / 0.2; /* division */ + if ((fabs(f - 4.2) > 0.00001) || (fabs(d - 210.36) > 0.00001) || + (fabs(e - 4256.413) > 0.00001)) + goto Fail; + + i = f < d; j = d <= e; k = e > f; m = e >= e; /* relational operators */ + if ((i != 1) || (j != 1) || (k != 1) || (m != 1)) + goto Fail; + + return 0; + +Fail: + return 1; +} + +int sub2(void) + +{ + i = 0 && e--; j = f && 0; k = d++ && --f; /* logical AND operator */ + if ((i != 0) || (j != 0) || (k != 1) || (fabs(e - 4256.413) > 0.00001) || + (fabs(d - 211.36) > 0.00001) || (fabs(f - 3.2) > 0.00001)) + goto Fail; + + i = 0 || e--; j = f || 0; k = d++ || --f; /* logical OR operator */ + if ((i != 1) || (j != 1) || (k != 1) || (fabs(e - 4255.413) > 0.00001) || + (fabs(d - 212.36) > 0.00001) || (fabs(f - 3.2) > 0.00001)) + goto Fail; + + f = e ? 8 >> 1: d--; /* conditional expression */ + if ((fabs(f - 4.0) > 0.00001) || (fabs(d - 212.36) > 0.00001)) + goto Fail; + + return 0; + +Fail: + return 1; +} + +int sub3(void) + +{ + d += 5; e -= 8.9; f *= 3.0; /* compound assignment */ + if ((fabs(f - 12.0) > 0.00001) || (fabs(d - 217.36) > 0.00001) || + (fabs(e - 4246.513) > 0.00001)) + goto Fail; + f /= -0.4; + if (fabs(f - (-30.0)) > 0.00001) + goto Fail; + + f = (e = ((extended) (long) (e * 2.0)), d--, d--); /* comma operator */ + if ((fabs(f - 216.36) > 0.00001) || (fabs(d - 215.36) > 0.00001) || + (fabs(e - 8493.0) > 0.00001)) + goto Fail; + + return 0; + +Fail: + return 1; +} + +main () + { + if (sub1()) goto Fail; + if (sub2()) goto Fail; + if (sub3()) goto Fail; + + printf ("Passed Conformance Test 24.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 24.0.1\n"); + } diff --git a/Tests/Conformance/C24.0.2.CC b/Tests/Conformance/C24.0.2.CC old mode 100755 new mode 100644 index c78449a..282fac5 --- a/Tests/Conformance/C24.0.2.CC +++ b/Tests/Conformance/C24.0.2.CC @@ -1 +1,51 @@ -/* Conformance Test 24.0.2: Test // comments and the ability to ignore */ /* them */ #pragma keep "t" #pragma lint -1 #include typedef enum {false, true} boolean; boolean pass; /* by default, // comments are allowed */ void Test1 (void) { int a; a = 8 //* this is a test */ 2 ; if (a == 4) pass = false; } #pragma ignore 0 /* now // comments are not allowed */ void Test2 (void) { int a; a = 8 //* this is a test */ 2 ; if (a == 8) pass = false; } int main (void) { pass = true; Test1(); Test2(); if (pass) printf("Passed Conformance Test 24.0.2\n"); else printf("Failed Conformance Test 24.0.2\n"); } \ No newline at end of file +/* Conformance Test 24.0.2: Test // comments and the ability to ignore */ +/* them */ + +#pragma keep "t" +#pragma lint -1 + +#include + +typedef enum {false, true} boolean; + +boolean pass; + +/* by default, // comments are allowed */ + +void Test1 (void) + +{ +int a; + +a = 8 //* this is a test */ 2 +; +if (a == 4) + pass = false; +} + +#pragma ignore 0 + +/* now // comments are not allowed */ + +void Test2 (void) + +{ +int a; + +a = 8 //* this is a test */ 2 +; +if (a == 8) + pass = false; +} + +int main (void) + +{ +pass = true; +Test1(); +Test2(); +if (pass) + printf("Passed Conformance Test 24.0.2\n"); +else + printf("Failed Conformance Test 24.0.2\n"); +} diff --git a/Tests/Conformance/C25.0.1.CC b/Tests/Conformance/C25.0.1.CC old mode 100755 new mode 100644 index 2a2886d..bb7a28d --- a/Tests/Conformance/C25.0.1.CC +++ b/Tests/Conformance/C25.0.1.CC @@ -1 +1,95 @@ -/* Conformance Test 25.0.1: Verification of code generation for ADC instruct */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #define LONG 0x123456 #include main () { int i; int count = 0; asm { brl Test Code: ADC #0xF ADC DP ADC DP,X ADC ABS ADC ABS,X ADC ABS,Y ADC (DP),Y ADC (DP,X) ADC (DP) ADC DP,S ADC (DP,S),Y ADC LONG ADC LONG,X ADC [DP] ADC [DP],Y End: Data: dcb 0x69 dcb 0x0F dcb 0x00 dcb 0x65 dcb 0x02 dcb 0x75 dcb 0x02 dcb 0x6D dcb 0x00 dcb 0x08 dcb 0x7D dcb 0x00 dcb 0x08 dcb 0x79 dcb 0x00 dcb 0x08 dcb 0x71 dcb 0x02 dcb 0x61 dcb 0x02 dcb 0x72 dcb 0x02 dcb 0x63 dcb 0x02 dcb 0x73 dcb 0x02 dcb 0x6F dcb 0x56 dcb 0x34 dcb 0x12 dcb 0x7F dcb 0x56 dcb 0x34 dcb 0x12 dcb 0x67 dcb 0x02 dcb 0x77 dcb 0x02 Test: ldx #36 Lbl1: lda Code,X cmp Data,X bne Err1 inc count dex dex bpl Lbl1 stz i bra Out Err1: lda #1 sta i Out: } /* printf (" i = %d count = %d\n", i, count); */ if (i) goto Fail; printf ("Passed Conformance Test 25.0.1\n"); return; Fail: printf ("Failed Conformance Test 25.0.1\n"); } \ No newline at end of file +/* Conformance Test 25.0.1: Verification of code generation for ADC instruct */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 +#define LONG 0x123456 + +#include + +main () + { + int i; + int count = 0; + + asm + { + brl Test + Code: ADC #0xF + ADC DP + ADC DP,X + ADC ABS + ADC ABS,X + ADC ABS,Y + ADC (DP),Y + ADC (DP,X) + ADC (DP) + ADC DP,S + ADC (DP,S),Y + ADC LONG + ADC LONG,X + ADC [DP] + ADC [DP],Y + End: + Data: dcb 0x69 + dcb 0x0F + dcb 0x00 + dcb 0x65 + dcb 0x02 + dcb 0x75 + dcb 0x02 + dcb 0x6D + dcb 0x00 + dcb 0x08 + dcb 0x7D + dcb 0x00 + dcb 0x08 + dcb 0x79 + dcb 0x00 + dcb 0x08 + dcb 0x71 + dcb 0x02 + dcb 0x61 + dcb 0x02 + dcb 0x72 + dcb 0x02 + dcb 0x63 + dcb 0x02 + dcb 0x73 + dcb 0x02 + dcb 0x6F + dcb 0x56 + dcb 0x34 + dcb 0x12 + dcb 0x7F + dcb 0x56 + dcb 0x34 + dcb 0x12 + dcb 0x67 + dcb 0x02 + dcb 0x77 + dcb 0x02 + Test: ldx #36 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + inc count + dex + dex + bpl Lbl1 + stz i + bra Out + Err1: lda #1 + sta i + Out: + } + +/* printf (" i = %d count = %d\n", i, count); */ + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.1\n"); + } diff --git a/Tests/Conformance/C25.0.10.CC b/Tests/Conformance/C25.0.10.CC old mode 100755 new mode 100644 index cb11ee0..ee1543c --- a/Tests/Conformance/C25.0.10.CC +++ b/Tests/Conformance/C25.0.10.CC @@ -1 +1,57 @@ -/* Conformance Test 25.0.10: Verification of code generation for CPX, CPY */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #define LONG 0x123456 #include main () { int i = 0; asm { brl Test Code: CPX #0x1234 CPX DP CPX ABS CPY #0x1234 CPY DP CPY ABS Data: dcb 0xE0 dcb 0x34 dcb 0x12 dcb 0xE4 dcb 0x02 dcb 0xEC dcb 0x00 dcb 0x08 dcb 0xC0 dcb 0x34 dcb 0x12 dcb 0xC4 dcb 0x02 dcb 0xCC dcb 0x00 dcb 0x08 Test: ldx #14 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.10\n"); return; Fail: printf ("Failed Conformance Test 25.0.10\n"); } \ No newline at end of file +/* Conformance Test 25.0.10: Verification of code generation for CPX, CPY */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 +#define LONG 0x123456 + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: CPX #0x1234 + CPX DP + CPX ABS + CPY #0x1234 + CPY DP + CPY ABS + Data: dcb 0xE0 + dcb 0x34 + dcb 0x12 + dcb 0xE4 + dcb 0x02 + dcb 0xEC + dcb 0x00 + dcb 0x08 + dcb 0xC0 + dcb 0x34 + dcb 0x12 + dcb 0xC4 + dcb 0x02 + dcb 0xCC + dcb 0x00 + dcb 0x08 + Test: ldx #14 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.10\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.10\n"); + } diff --git a/Tests/Conformance/C25.0.11.CC b/Tests/Conformance/C25.0.11.CC old mode 100755 new mode 100644 index 320e4e1..b8cfba2 --- a/Tests/Conformance/C25.0.11.CC +++ b/Tests/Conformance/C25.0.11.CC @@ -1 +1,53 @@ -/* Conformance Test 25.0.11: Verification of code generation for DEC instruct */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #define LONG 0x123456 #include main () { int i = 0; asm { brl Test Code: DEC A DEC DP DEC DP,X DEC ABS DEC ABS,X dcb 0 Data: dcb 0x3A dcb 0xC6 dcb 0x02 dcb 0xD6 dcb 0x02 dcb 0xCE dcb 0x00 dcb 0x08 dcb 0xDE dcb 0x00 dcb 0x08 dcb 0x00 Test: ldx #10 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.11\n"); return; Fail: printf ("Failed Conformance Test 25.0.11\n"); } \ No newline at end of file +/* Conformance Test 25.0.11: Verification of code generation for DEC instruct */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 +#define LONG 0x123456 + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: DEC A + DEC DP + DEC DP,X + DEC ABS + DEC ABS,X + dcb 0 + Data: dcb 0x3A + dcb 0xC6 + dcb 0x02 + dcb 0xD6 + dcb 0x02 + dcb 0xCE + dcb 0x00 + dcb 0x08 + dcb 0xDE + dcb 0x00 + dcb 0x08 + dcb 0x00 + Test: ldx #10 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.11\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.11\n"); + } diff --git a/Tests/Conformance/C25.0.12.CC b/Tests/Conformance/C25.0.12.CC old mode 100755 new mode 100644 index 2f8ab57..df03e8b --- a/Tests/Conformance/C25.0.12.CC +++ b/Tests/Conformance/C25.0.12.CC @@ -1 +1,53 @@ -/* Conformance Test 25.0.12: Verification of code generation for INC instr */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #define LONG 0x123456 #include main () { int i = 0; asm { brl Test Code: INC A INC DP INC DP,X INC ABS INC ABS,X dcb 0 Data: dcb 0x1A dcb 0xE6 dcb 0x02 dcb 0xF6 dcb 0x02 dcb 0xEE dcb 0x00 dcb 0x08 dcb 0xFE dcb 0x00 dcb 0x08 dcb 0x00 Test: ldx #10 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.12\n"); return; Fail: printf ("Failed Conformance Test 25.0.12\n"); } \ No newline at end of file +/* Conformance Test 25.0.12: Verification of code generation for INC instr */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 +#define LONG 0x123456 + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: INC A + INC DP + INC DP,X + INC ABS + INC ABS,X + dcb 0 + Data: dcb 0x1A + dcb 0xE6 + dcb 0x02 + dcb 0xF6 + dcb 0x02 + dcb 0xEE + dcb 0x00 + dcb 0x08 + dcb 0xFE + dcb 0x00 + dcb 0x08 + dcb 0x00 + Test: ldx #10 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.12\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.12\n"); + } diff --git a/Tests/Conformance/C25.0.13.CC b/Tests/Conformance/C25.0.13.CC old mode 100755 new mode 100644 index 17999d8..aa4d8f6 --- a/Tests/Conformance/C25.0.13.CC +++ b/Tests/Conformance/C25.0.13.CC @@ -1 +1,54 @@ -/* Conformance Test 25.0.13: Verification of code generation for LDX instr */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #include main () { int i = 0; asm { brl Test Code: LDX #0x1234 LDX DP LDX DP,Y LDX ABS LDX ABS,Y dcb 0 Data: dcb 0xA2 dcb 0x34 dcb 0x12 dcb 0xA6 dcb 0x02 dcb 0xB6 dcb 0x02 dcb 0xAE dcb 0x00 dcb 0x08 dcb 0xBE dcb 0x00 dcb 0x08 dcb 0x00 Test: ldx #12 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.13\n"); return; Fail: printf ("Failed Conformance Test 25.0.13\n"); } \ No newline at end of file +/* Conformance Test 25.0.13: Verification of code generation for LDX instr */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: LDX #0x1234 + LDX DP + LDX DP,Y + LDX ABS + LDX ABS,Y + dcb 0 + Data: dcb 0xA2 + dcb 0x34 + dcb 0x12 + dcb 0xA6 + dcb 0x02 + dcb 0xB6 + dcb 0x02 + dcb 0xAE + dcb 0x00 + dcb 0x08 + dcb 0xBE + dcb 0x00 + dcb 0x08 + dcb 0x00 + Test: ldx #12 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.13\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.13\n"); + } diff --git a/Tests/Conformance/C25.0.14.CC b/Tests/Conformance/C25.0.14.CC old mode 100755 new mode 100644 index 25f06e2..f7ba199 --- a/Tests/Conformance/C25.0.14.CC +++ b/Tests/Conformance/C25.0.14.CC @@ -1 +1,54 @@ -/* Conformance Test 25.0.14: Verification of code generation for LDY instr */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #include main () { int i = 0; asm { brl Test Code: LDY #0x1234 LDY DP LDY DP,X LDY ABS LDY ABS,X dcb 0 Data: dcb 0xA0 dcb 0x34 dcb 0x12 dcb 0xA4 dcb 0x02 dcb 0xB4 dcb 0x02 dcb 0xAC dcb 0x00 dcb 0x08 dcb 0xBC dcb 0x00 dcb 0x08 dcb 0x00 Test: ldx #12 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.14\n"); return; Fail: printf ("Failed Conformance Test 25.0.14\n"); } \ No newline at end of file +/* Conformance Test 25.0.14: Verification of code generation for LDY instr */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: LDY #0x1234 + LDY DP + LDY DP,X + LDY ABS + LDY ABS,X + dcb 0 + Data: dcb 0xA0 + dcb 0x34 + dcb 0x12 + dcb 0xA4 + dcb 0x02 + dcb 0xB4 + dcb 0x02 + dcb 0xAC + dcb 0x00 + dcb 0x08 + dcb 0xBC + dcb 0x00 + dcb 0x08 + dcb 0x00 + Test: ldx #12 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.14\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.14\n"); + } diff --git a/Tests/Conformance/C25.0.15.CC b/Tests/Conformance/C25.0.15.CC old mode 100755 new mode 100644 index bc15535..fb144af --- a/Tests/Conformance/C25.0.15.CC +++ b/Tests/Conformance/C25.0.15.CC @@ -1 +1,52 @@ -/* Conformance Test 25.0.15: Verification of code generation for LSR instr */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #include main () { int i = 0; asm { brl Test Code: LSR A LSR DP LSR DP,X LSR ABS LSR ABS,X dcb 0 Data: dcb 0x4A dcb 0x46 dcb 0x02 dcb 0x56 dcb 0x02 dcb 0x4E dcb 0x00 dcb 0x08 dcb 0x5E dcb 0x00 dcb 0x08 dcb 0x00 Test: ldx #10 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.15\n"); return; Fail: printf ("Failed Conformance Test 25.0.15\n"); } \ No newline at end of file +/* Conformance Test 25.0.15: Verification of code generation for LSR instr */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: LSR A + LSR DP + LSR DP,X + LSR ABS + LSR ABS,X + dcb 0 + Data: dcb 0x4A + dcb 0x46 + dcb 0x02 + dcb 0x56 + dcb 0x02 + dcb 0x4E + dcb 0x00 + dcb 0x08 + dcb 0x5E + dcb 0x00 + dcb 0x08 + dcb 0x00 + Test: ldx #10 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.15\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.15\n"); + } diff --git a/Tests/Conformance/C25.0.16.CC b/Tests/Conformance/C25.0.16.CC old mode 100755 new mode 100644 index 5bbe30d..bc6f381 --- a/Tests/Conformance/C25.0.16.CC +++ b/Tests/Conformance/C25.0.16.CC @@ -1 +1,52 @@ -/* Conformance Test 25.0.16: Verification of code generation for ROL instr */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #include main () { int i = 0; asm { brl Test Code: ROL A ROL DP ROL DP,X ROL ABS ROL ABS,X dcb 0 Data: dcb 0x2A dcb 0x26 dcb 0x02 dcb 0x36 dcb 0x02 dcb 0x2E dcb 0x00 dcb 0x08 dcb 0x3E dcb 0x00 dcb 0x08 dcb 0x00 Test: ldx #10 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.16\n"); return; Fail: printf ("Failed Conformance Test 25.0.16\n"); } \ No newline at end of file +/* Conformance Test 25.0.16: Verification of code generation for ROL instr */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: ROL A + ROL DP + ROL DP,X + ROL ABS + ROL ABS,X + dcb 0 + Data: dcb 0x2A + dcb 0x26 + dcb 0x02 + dcb 0x36 + dcb 0x02 + dcb 0x2E + dcb 0x00 + dcb 0x08 + dcb 0x3E + dcb 0x00 + dcb 0x08 + dcb 0x00 + Test: ldx #10 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.16\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.16\n"); + } diff --git a/Tests/Conformance/C25.0.17.CC b/Tests/Conformance/C25.0.17.CC old mode 100755 new mode 100644 index a841509..1c94738 --- a/Tests/Conformance/C25.0.17.CC +++ b/Tests/Conformance/C25.0.17.CC @@ -1 +1,53 @@ -/* Conformance Test 25.0.17: Verification of code generation for ROR instr */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #define LONG 0x123456 #include main () { int i = 0; asm { brl Test Code: ROR A ROR DP ROR DP,X ROR ABS ROR ABS,X dcb 0 Data: dcb 0x6A dcb 0x66 dcb 0x02 dcb 0x76 dcb 0x02 dcb 0x6E dcb 0x00 dcb 0x08 dcb 0x7E dcb 0x00 dcb 0x08 dcb 0x00 Test: ldx #10 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.17\n"); return; Fail: printf ("Failed Conformance Test 25.0.17\n"); } \ No newline at end of file +/* Conformance Test 25.0.17: Verification of code generation for ROR instr */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 +#define LONG 0x123456 + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: ROR A + ROR DP + ROR DP,X + ROR ABS + ROR ABS,X + dcb 0 + Data: dcb 0x6A + dcb 0x66 + dcb 0x02 + dcb 0x76 + dcb 0x02 + dcb 0x6E + dcb 0x00 + dcb 0x08 + dcb 0x7E + dcb 0x00 + dcb 0x08 + dcb 0x00 + Test: ldx #10 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.17\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.17\n"); + } diff --git a/Tests/Conformance/C25.0.18.CC b/Tests/Conformance/C25.0.18.CC old mode 100755 new mode 100644 index ac7f356..80d3fe3 --- a/Tests/Conformance/C25.0.18.CC +++ b/Tests/Conformance/C25.0.18.CC @@ -1 +1,55 @@ -/* Conformance Test 25.0.18: Verification of code generation for BIT instr */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #define LONG 0x123456 #include main () { int i = 0; asm { brl Test Code: BIT #0x1234 BIT DP BIT DP,X BIT ABS BIT ABS,X dcb 0 Data: dcb 0x89 dcb 0x34 dcb 0x12 dcb 0x24 dcb 0x02 dcb 0x34 dcb 0x02 dcb 0x2C dcb 0x00 dcb 0x08 dcb 0x3C dcb 0x00 dcb 0x08 dcb 0x00 Test: ldx #12 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.18\n"); return; Fail: printf ("Failed Conformance Test 25.0.18\n"); } \ No newline at end of file +/* Conformance Test 25.0.18: Verification of code generation for BIT instr */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 +#define LONG 0x123456 + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: BIT #0x1234 + BIT DP + BIT DP,X + BIT ABS + BIT ABS,X + dcb 0 + Data: dcb 0x89 + dcb 0x34 + dcb 0x12 + dcb 0x24 + dcb 0x02 + dcb 0x34 + dcb 0x02 + dcb 0x2C + dcb 0x00 + dcb 0x08 + dcb 0x3C + dcb 0x00 + dcb 0x08 + dcb 0x00 + Test: ldx #12 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.18\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.18\n"); + } diff --git a/Tests/Conformance/C25.0.19.CC b/Tests/Conformance/C25.0.19.CC old mode 100755 new mode 100644 index 6797236..9abd13a --- a/Tests/Conformance/C25.0.19.CC +++ b/Tests/Conformance/C25.0.19.CC @@ -1 +1,72 @@ -/* Conformance Test 25.0.19: Verification of code generation for branch */ /* instructions */ #include main () { int i = 0; asm { brl Test Code: D1: BCC D1 D2: BCC D2 D3: BCS D3 D4: BCS D4 D5: BEQ D5 D6: BMI D6 D7: BNE D7 D8: BPL D8 D9: BVC D9 D10: BVS D10 D11: BRA D11 D12: BRL D12 dcb 0 Data: dcb 0x90 dcb 0xFE dcb 0x90 dcb 0xFE dcb 0xB0 dcb 0xFE dcb 0xB0 dcb 0xFE dcb 0xF0 dcb 0xFE dcb 0x30 dcb 0xFE dcb 0xD0 dcb 0xFE dcb 0x10 dcb 0xFE dcb 0x50 dcb 0xFE dcb 0x70 dcb 0xFE dcb 0x80 dcb 0xFE dcb 0x82 dcb 0xFD dcb 0xFF dcb 0x00 Test: ldx #24 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: } if (i) goto Fail; printf ("Passed Conformance Test 25.0.19\n"); return; Fail: printf ("Failed Conformance Test 25.0.19\n"); } \ No newline at end of file +/* Conformance Test 25.0.19: Verification of code generation for branch */ +/* instructions */ + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: + D1: BCC D1 + D2: BCC D2 + D3: BCS D3 + D4: BCS D4 + D5: BEQ D5 + D6: BMI D6 + D7: BNE D7 + D8: BPL D8 + D9: BVC D9 + D10: BVS D10 + D11: BRA D11 + D12: BRL D12 + dcb 0 + Data: dcb 0x90 + dcb 0xFE + dcb 0x90 + dcb 0xFE + dcb 0xB0 + dcb 0xFE + dcb 0xB0 + dcb 0xFE + dcb 0xF0 + dcb 0xFE + dcb 0x30 + dcb 0xFE + dcb 0xD0 + dcb 0xFE + dcb 0x10 + dcb 0xFE + dcb 0x50 + dcb 0xFE + dcb 0x70 + dcb 0xFE + dcb 0x80 + dcb 0xFE + dcb 0x82 + dcb 0xFD + dcb 0xFF + dcb 0x00 + Test: ldx #24 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.19\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.19\n"); + } diff --git a/Tests/Conformance/C25.0.2.CC b/Tests/Conformance/C25.0.2.CC old mode 100755 new mode 100644 index 2905951..3548bb6 --- a/Tests/Conformance/C25.0.2.CC +++ b/Tests/Conformance/C25.0.2.CC @@ -1 +1,88 @@ -/* Conformance Test 25.0.2: Verification of code generation for AND instruct */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #define LONG 0x123456 #include main () { int i = 0; asm { brl Test Code: AND #0xF AND DP AND DP,X AND ABS AND ABS,X AND ABS,Y AND (DP),Y AND (DP,X) AND (DP) AND DP,S AND (DP,S),Y AND LONG AND LONG,X AND [DP] AND [DP],Y Data: dcb 0x29 dcb 0x0F dcb 0x00 dcb 0x25 dcb 0x02 dcb 0x35 dcb 0x02 dcb 0x2D dcb 0x00 dcb 0x08 dcb 0x3D dcb 0x00 dcb 0x08 dcb 0x39 dcb 0x00 dcb 0x08 dcb 0x31 dcb 0x02 dcb 0x21 dcb 0x02 dcb 0x32 dcb 0x02 dcb 0x23 dcb 0x02 dcb 0x33 dcb 0x02 dcb 0x2F dcb 0x56 dcb 0x34 dcb 0x12 dcb 0x3F dcb 0x56 dcb 0x34 dcb 0x12 dcb 0x27 dcb 0x02 dcb 0x37 dcb 0x02 Test: ldx #36 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.2\n"); return; Fail: printf ("Failed Conformance Test 25.0.2\n"); } \ No newline at end of file +/* Conformance Test 25.0.2: Verification of code generation for AND instruct */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 +#define LONG 0x123456 + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: AND #0xF + AND DP + AND DP,X + AND ABS + AND ABS,X + AND ABS,Y + AND (DP),Y + AND (DP,X) + AND (DP) + AND DP,S + AND (DP,S),Y + AND LONG + AND LONG,X + AND [DP] + AND [DP],Y + Data: dcb 0x29 + dcb 0x0F + dcb 0x00 + dcb 0x25 + dcb 0x02 + dcb 0x35 + dcb 0x02 + dcb 0x2D + dcb 0x00 + dcb 0x08 + dcb 0x3D + dcb 0x00 + dcb 0x08 + dcb 0x39 + dcb 0x00 + dcb 0x08 + dcb 0x31 + dcb 0x02 + dcb 0x21 + dcb 0x02 + dcb 0x32 + dcb 0x02 + dcb 0x23 + dcb 0x02 + dcb 0x33 + dcb 0x02 + dcb 0x2F + dcb 0x56 + dcb 0x34 + dcb 0x12 + dcb 0x3F + dcb 0x56 + dcb 0x34 + dcb 0x12 + dcb 0x27 + dcb 0x02 + dcb 0x37 + dcb 0x02 + Test: ldx #36 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.2\n"); + } diff --git a/Tests/Conformance/C25.0.20.CC b/Tests/Conformance/C25.0.20.CC old mode 100755 new mode 100644 index 292f8f3..2b13e1a --- a/Tests/Conformance/C25.0.20.CC +++ b/Tests/Conformance/C25.0.20.CC @@ -1 +1,120 @@ -/* Conformance Test 25.0.20: Verification of code generation for instructions */ /* whose only addressing mode is implied */ #include main () { int i = 0; asm { brl Test Code: CLC CLD CLI CLV DEX DEY INX INY NOP PHA PHP PLA PLP RTI RTS SEC SED SEI TAX TAY TSX TXA TXS TYA PHX PHY PLX PLY PHB PHD PHK PLB PLD RTL STP TCD TCS TDC TSC TXY TYX WAI XCE XBA Data: dcb 0x18 dcb 0xD8 dcb 0x58 dcb 0xB8 dcb 0xCA dcb 0x88 dcb 0xE8 dcb 0xC8 dcb 0xEA dcb 0x48 dcb 0x08 dcb 0x68 dcb 0x28 dcb 0x40 dcb 0x60 dcb 0x38 dcb 0xF8 dcb 0x78 dcb 0xAA dcb 0xA8 dcb 0xBA dcb 0x8A dcb 0x9A dcb 0x98 dcb 0xDA dcb 0x5A dcb 0xFA dcb 0x7A dcb 0x8B dcb 0x0B dcb 0x4B dcb 0xAB dcb 0x2B dcb 0x6B dcb 0xDB dcb 0x5B dcb 0x1B dcb 0x7B dcb 0x3B dcb 0x9B dcb 0xBB dcb 0xCB dcb 0xFB dcb 0xEB Test: ldx #42 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.20\n"); return; Fail: printf ("Failed Conformance Test 25.0.20\n"); } \ No newline at end of file +/* Conformance Test 25.0.20: Verification of code generation for instructions */ +/* whose only addressing mode is implied */ + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: CLC + CLD + CLI + CLV + DEX + DEY + INX + INY + NOP + PHA + PHP + PLA + PLP + RTI + RTS + SEC + SED + SEI + TAX + TAY + TSX + TXA + TXS + TYA + PHX + PHY + PLX + PLY + PHB + PHD + PHK + PLB + PLD + RTL + STP + TCD + TCS + TDC + TSC + TXY + TYX + WAI + XCE + XBA + Data: dcb 0x18 + dcb 0xD8 + dcb 0x58 + dcb 0xB8 + dcb 0xCA + dcb 0x88 + dcb 0xE8 + dcb 0xC8 + dcb 0xEA + dcb 0x48 + dcb 0x08 + dcb 0x68 + dcb 0x28 + dcb 0x40 + dcb 0x60 + dcb 0x38 + dcb 0xF8 + dcb 0x78 + dcb 0xAA + dcb 0xA8 + dcb 0xBA + dcb 0x8A + dcb 0x9A + dcb 0x98 + dcb 0xDA + dcb 0x5A + dcb 0xFA + dcb 0x7A + dcb 0x8B + dcb 0x0B + dcb 0x4B + dcb 0xAB + dcb 0x2B + dcb 0x6B + dcb 0xDB + dcb 0x5B + dcb 0x1B + dcb 0x7B + dcb 0x3B + dcb 0x9B + dcb 0xBB + dcb 0xCB + dcb 0xFB + dcb 0xEB + Test: ldx #42 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.20\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.20\n"); + } diff --git a/Tests/Conformance/C25.0.21.CC b/Tests/Conformance/C25.0.21.CC old mode 100755 new mode 100644 index 1270775..ec1b558 --- a/Tests/Conformance/C25.0.21.CC +++ b/Tests/Conformance/C25.0.21.CC @@ -1 +1,54 @@ -/* Conformance Test 25.0.21: Verification of code generation for STX, STY */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #include main () { int i = 0; asm { brl Test Code: STX DP STX DP,Y STX ABS STY DP STY DP,X STY ABS Data: dcb 0x86 dcb 0x02 dcb 0x96 dcb 0x02 dcb 0x8E dcb 0x00 dcb 0x08 dcb 0x84 dcb 0x02 dcb 0x94 dcb 0x02 dcb 0x8C dcb 0x00 dcb 0x08 Test: ldx #12 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.21\n"); return; Fail: printf ("Failed Conformance Test 25.0.21\n"); } \ No newline at end of file +/* Conformance Test 25.0.21: Verification of code generation for STX, STY */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: STX DP + STX DP,Y + STX ABS + STY DP + STY DP,X + STY ABS + Data: dcb 0x86 + dcb 0x02 + dcb 0x96 + dcb 0x02 + dcb 0x8E + dcb 0x00 + dcb 0x08 + dcb 0x84 + dcb 0x02 + dcb 0x94 + dcb 0x02 + dcb 0x8C + dcb 0x00 + dcb 0x08 + Test: ldx #12 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.21\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.21\n"); + } diff --git a/Tests/Conformance/C25.0.22.CC b/Tests/Conformance/C25.0.22.CC old mode 100755 new mode 100644 index 4c19ef1..9559457 --- a/Tests/Conformance/C25.0.22.CC +++ b/Tests/Conformance/C25.0.22.CC @@ -1 +1,84 @@ -/* Conformance Test 25.0.22: Verification of code generation for BRK, COP, */ /* MVN, MVP, PEA, PEI, PER, REP, SEP, TRB, and */ /* TSB instructions. */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #include main () { int i = 0; asm { brl Test Code: BRK 0 BRK DP COP DP MVN DP,DP MVP DP,DP PEA ABS PEI DP PER Data REP #0xF SEP #0xF TRB DP TRB ABS TSB DP TSB ABS Data: dcb 0x00 dcb 0x00 dcb 0x00 dcb 0x02 dcb 0x02 dcb 0x02 dcb 0x54 dcb 0x00 dcb 0x00 dcb 0x44 dcb 0x00 dcb 0x00 dcb 0xF4 dcb 0x00 dcb 0x08 dcb 0xD4 dcb 0x02 dcb 0x62 dcb 0x0E dcb 0x00 dcb 0xC2 dcb 0x0F dcb 0xE2 dcb 0x0F dcb 0x14 dcb 0x02 dcb 0x1C dcb 0x00 dcb 0x08 dcb 0x04 dcb 0x02 dcb 0x0C dcb 0x00 dcb 0x08 Test: ldx #32 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.22\n"); return; Fail: printf ("Failed Conformance Test 25.0.22\n"); } \ No newline at end of file +/* Conformance Test 25.0.22: Verification of code generation for BRK, COP, */ +/* MVN, MVP, PEA, PEI, PER, REP, SEP, TRB, and */ +/* TSB instructions. */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: BRK 0 + BRK DP + COP DP + MVN DP,DP + MVP DP,DP + PEA ABS + PEI DP + PER Data + REP #0xF + SEP #0xF + TRB DP + TRB ABS + TSB DP + TSB ABS + Data: dcb 0x00 + dcb 0x00 + dcb 0x00 + dcb 0x02 + dcb 0x02 + dcb 0x02 + dcb 0x54 + dcb 0x00 + dcb 0x00 + dcb 0x44 + dcb 0x00 + dcb 0x00 + dcb 0xF4 + dcb 0x00 + dcb 0x08 + dcb 0xD4 + dcb 0x02 + dcb 0x62 + dcb 0x0E + dcb 0x00 + dcb 0xC2 + dcb 0x0F + dcb 0xE2 + dcb 0x0F + dcb 0x14 + dcb 0x02 + dcb 0x1C + dcb 0x00 + dcb 0x08 + dcb 0x04 + dcb 0x02 + dcb 0x0C + dcb 0x00 + dcb 0x08 + Test: ldx #32 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.22\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.22\n"); + } diff --git a/Tests/Conformance/C25.0.23.CC b/Tests/Conformance/C25.0.23.CC old mode 100755 new mode 100644 index 8be8a2a..94baaf1 --- a/Tests/Conformance/C25.0.23.CC +++ b/Tests/Conformance/C25.0.23.CC @@ -1 +1,48 @@ -/* Conformance Test 25.0.23: Verification of code generation for STZ instruct */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #include main () { int i = 0; asm { bra Test Code: STZ DP STZ DP,X STZ ABS STZ ABS,X Data: dcb 0x64 dcb 0x02 dcb 0x74 dcb 0x02 dcb 0x9C dcb 0x00 dcb 0x08 dcb 0x9E dcb 0x00 dcb 0x08 Test: ldx #8 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.23\n"); return; Fail: printf ("Failed Conformance Test 25.0.23\n"); } \ No newline at end of file +/* Conformance Test 25.0.23: Verification of code generation for STZ instruct */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 + +#include + +main () + { + int i = 0; + + asm + { + bra Test + Code: STZ DP + STZ DP,X + STZ ABS + STZ ABS,X + Data: dcb 0x64 + dcb 0x02 + dcb 0x74 + dcb 0x02 + dcb 0x9C + dcb 0x00 + dcb 0x08 + dcb 0x9E + dcb 0x00 + dcb 0x08 + Test: ldx #8 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.23\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.23\n"); + } diff --git a/Tests/Conformance/C25.0.24.CC b/Tests/Conformance/C25.0.24.CC old mode 100755 new mode 100644 index 5c717ec..306b240 --- a/Tests/Conformance/C25.0.24.CC +++ b/Tests/Conformance/C25.0.24.CC @@ -1 +1,70 @@ -/* Conformance Test 25.0.24: Verification of code generation for jump */ /* instructions */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #define LONG 0x123456 #include main () { int i = 0; asm { brl Test Code: JMP ABS JMP (ABS) JMP (ABS,X) JMP LONG JMP [ABS] JSR ABS JSR (ABS,X) JSL LONG Data: dcb 0x4C dcb 0x00 dcb 0x08 dcb 0x6C dcb 0x00 dcb 0x08 dcb 0x7C dcb 0x00 dcb 0x08 dcb 0x5C dcb 0x56 dcb 0x34 dcb 0x12 dcb 0xDC dcb 0x00 dcb 0x08 dcb 0x20 dcb 0x00 dcb 0x08 dcb 0xFC dcb 0x00 dcb 0x08 dcb 0x22 dcb 0x56 dcb 0x34 dcb 0x12 Test: ldx #24 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.24\n"); return; Fail: printf ("Failed Conformance Test 25.0.24\n"); } \ No newline at end of file +/* Conformance Test 25.0.24: Verification of code generation for jump */ +/* instructions */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 +#define LONG 0x123456 + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: JMP ABS + JMP (ABS) + JMP (ABS,X) + JMP LONG + JMP [ABS] + JSR ABS + JSR (ABS,X) + JSL LONG + Data: dcb 0x4C + dcb 0x00 + dcb 0x08 + dcb 0x6C + dcb 0x00 + dcb 0x08 + dcb 0x7C + dcb 0x00 + dcb 0x08 + dcb 0x5C + dcb 0x56 + dcb 0x34 + dcb 0x12 + dcb 0xDC + dcb 0x00 + dcb 0x08 + dcb 0x20 + dcb 0x00 + dcb 0x08 + dcb 0xFC + dcb 0x00 + dcb 0x08 + dcb 0x22 + dcb 0x56 + dcb 0x34 + dcb 0x12 + Test: ldx #24 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.24\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.24\n"); + } diff --git a/Tests/Conformance/C25.0.25.CC b/Tests/Conformance/C25.0.25.CC old mode 100755 new mode 100644 index d82491a..2e9cb0a --- a/Tests/Conformance/C25.0.25.CC +++ b/Tests/Conformance/C25.0.25.CC @@ -1 +1,178 @@ -/* Conformance Test 25.0.25: Verification of code generation for upper and */ /* lower limits of all addressing modes */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #define LONG 0x123456 #include main () { int i = 0; asm { brl Test Code: ADC 0x0 ADC 0xFF LDA 0x0,X LDA 0xFF,X LDX 0x0,Y LDX 0xFF,Y ROR |0x0000 ROR 0xFFFF ROL |0x0000,X ROL 0xFFFF,X STA |0x0000,Y STA 0xFFFF,Y JMP (|0x0000) JMP (0xFFFF) ORA (0x0),Y ORA (0xFF),Y CMP (0x0,X) CMP (0xFF,X) BEQ LBL4 LBL4: BEQ LBL4 AND (0x0) AND (0xFF) JMP (|0x0000,X) JMP (0xFFFF,X) SBC 0x0,S SBC 0xFF,S ADC (0x0,S),Y ADC (0xFF,S),Y AND >0x000000 AND 0xFFFFFF CMP >0x000000,X CMP 0xFFFFFF,X EOR [0x0] EOR [0xFF] LDA [0x0],Y LDA [0xFF],Y JMP [|0x0] JMP [0xFFFF] BRL LBL5 LBL5: BRL LBL5 Data: dcb 0x65 dcb 0x00 dcb 0x65 dcb 0xFF dcb 0xB5 dcb 0x00 dcb 0xB5 dcb 0xFF dcb 0xB6 dcb 0x00 dcb 0xB6 dcb 0xFF dcb 0x6E dcb 0x00 dcb 0x00 dcb 0x6E dcb 0xFF dcb 0xFF dcb 0x3E dcb 0x00 dcb 0x00 dcb 0x3E dcb 0xFF dcb 0xFF dcb 0x99 dcb 0x00 dcb 0x00 dcb 0x99 dcb 0xFF dcb 0xFF dcb 0x6C dcb 0x00 dcb 0x00 dcb 0x6C dcb 0xFF dcb 0xFF dcb 0x11 dcb 0x00 dcb 0x11 dcb 0xFF dcb 0xC1 dcb 0x00 dcb 0xC1 dcb 0xFF dcb 0xF0 dcb 0x00 dcb 0xF0 dcb 0xFE dcb 0x32 dcb 0x00 dcb 0x32 dcb 0xFF dcb 0x7C dcb 0x00 dcb 0x00 dcb 0x7C dcb 0xFF dcb 0xFF dcb 0xE3 dcb 0x00 dcb 0xE3 dcb 0xFF dcb 0x73 dcb 0x00 dcb 0x73 dcb 0xFF dcb 0x2F dcb 0x00 dcb 0x00 dcb 0x00 dcb 0x2F dcb 0xFF dcb 0xFF dcb 0xFF dcb 0xDF dcb 0x00 dcb 0x00 dcb 0x00 dcb 0xDF dcb 0xFF dcb 0xFF dcb 0xFF dcb 0x47 dcb 0x00 dcb 0x47 dcb 0xFF dcb 0xB7 dcb 0x00 dcb 0xB7 dcb 0xFF dcb 0xDC dcb 0x00 dcb 0x00 dcb 0xDC dcb 0xFF dcb 0xFF dcb 0x82 dcb 0x00 dcb 0x00 dcb 0x82 dcb 0xFD dcb 0xFF Test: ldx #100 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.25\n"); return; Fail: printf ("Failed Conformance Test 25.0.25\n"); } \ No newline at end of file +/* Conformance Test 25.0.25: Verification of code generation for upper and */ +/* lower limits of all addressing modes */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 +#define LONG 0x123456 + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: ADC 0x0 + ADC 0xFF + LDA 0x0,X + LDA 0xFF,X + LDX 0x0,Y + LDX 0xFF,Y + ROR |0x0000 + ROR 0xFFFF + ROL |0x0000,X + ROL 0xFFFF,X + STA |0x0000,Y + STA 0xFFFF,Y + JMP (|0x0000) + JMP (0xFFFF) + ORA (0x0),Y + ORA (0xFF),Y + CMP (0x0,X) + CMP (0xFF,X) + BEQ LBL4 + LBL4: BEQ LBL4 + AND (0x0) + AND (0xFF) + JMP (|0x0000,X) + JMP (0xFFFF,X) + SBC 0x0,S + SBC 0xFF,S + ADC (0x0,S),Y + ADC (0xFF,S),Y + AND >0x000000 + AND 0xFFFFFF + CMP >0x000000,X + CMP 0xFFFFFF,X + EOR [0x0] + EOR [0xFF] + LDA [0x0],Y + LDA [0xFF],Y + JMP [|0x0] + JMP [0xFFFF] + BRL LBL5 + LBL5: BRL LBL5 + Data: dcb 0x65 + dcb 0x00 + dcb 0x65 + dcb 0xFF + dcb 0xB5 + dcb 0x00 + dcb 0xB5 + dcb 0xFF + dcb 0xB6 + dcb 0x00 + dcb 0xB6 + dcb 0xFF + dcb 0x6E + dcb 0x00 + dcb 0x00 + dcb 0x6E + dcb 0xFF + dcb 0xFF + dcb 0x3E + dcb 0x00 + dcb 0x00 + dcb 0x3E + dcb 0xFF + dcb 0xFF + dcb 0x99 + dcb 0x00 + dcb 0x00 + dcb 0x99 + dcb 0xFF + dcb 0xFF + dcb 0x6C + dcb 0x00 + dcb 0x00 + dcb 0x6C + dcb 0xFF + dcb 0xFF + dcb 0x11 + dcb 0x00 + dcb 0x11 + dcb 0xFF + dcb 0xC1 + dcb 0x00 + dcb 0xC1 + dcb 0xFF + dcb 0xF0 + dcb 0x00 + dcb 0xF0 + dcb 0xFE + dcb 0x32 + dcb 0x00 + dcb 0x32 + dcb 0xFF + dcb 0x7C + dcb 0x00 + dcb 0x00 + dcb 0x7C + dcb 0xFF + dcb 0xFF + dcb 0xE3 + dcb 0x00 + dcb 0xE3 + dcb 0xFF + dcb 0x73 + dcb 0x00 + dcb 0x73 + dcb 0xFF + dcb 0x2F + dcb 0x00 + dcb 0x00 + dcb 0x00 + dcb 0x2F + dcb 0xFF + dcb 0xFF + dcb 0xFF + dcb 0xDF + dcb 0x00 + dcb 0x00 + dcb 0x00 + dcb 0xDF + dcb 0xFF + dcb 0xFF + dcb 0xFF + dcb 0x47 + dcb 0x00 + dcb 0x47 + dcb 0xFF + dcb 0xB7 + dcb 0x00 + dcb 0xB7 + dcb 0xFF + dcb 0xDC + dcb 0x00 + dcb 0x00 + dcb 0xDC + dcb 0xFF + dcb 0xFF + dcb 0x82 + dcb 0x00 + dcb 0x00 + dcb 0x82 + dcb 0xFD + dcb 0xFF + Test: ldx #100 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.25\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.25\n"); + } diff --git a/Tests/Conformance/C25.0.26.CC b/Tests/Conformance/C25.0.26.CC old mode 100755 new mode 100644 index 2814602..7be9f55 --- a/Tests/Conformance/C25.0.26.CC +++ b/Tests/Conformance/C25.0.26.CC @@ -1 +1,17 @@ -/* Conformance Test 25.0.26: Make sure static variabes can be used */ #include static int j; void main(void) { static int i; asm { lda i sta j } printf ("Passed Conformance Test 25.0.26\n"); } \ No newline at end of file +/* Conformance Test 25.0.26: Make sure static variabes can be used */ + +#include + +static int j; + +void main(void) + +{ +static int i; + +asm { + lda i + sta j + } +printf ("Passed Conformance Test 25.0.26\n"); +} diff --git a/Tests/Conformance/C25.0.3.CC b/Tests/Conformance/C25.0.3.CC old mode 100755 new mode 100644 index 9458272..53888f0 --- a/Tests/Conformance/C25.0.3.CC +++ b/Tests/Conformance/C25.0.3.CC @@ -1 +1,88 @@ -/* Conformance Test 25.0.3: Verification of code generation for CMP instruct */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #define LONG 0x123456 #include main () { int i = 0; asm { brl Test Code: CMP #0xF CMP DP CMP DP,X CMP ABS CMP ABS,X CMP ABS,Y CMP (DP),Y CMP (DP,X) CMP (DP) CMP DP,S CMP (DP,S),Y CMP LONG CMP LONG,X CMP [DP] CMP [DP],Y Data: dcb 0xC9 dcb 0x0F dcb 0x00 dcb 0xC5 dcb 0x02 dcb 0xD5 dcb 0x02 dcb 0xCD dcb 0x00 dcb 0x08 dcb 0xDD dcb 0x00 dcb 0x08 dcb 0xD9 dcb 0x00 dcb 0x08 dcb 0xD1 dcb 0x02 dcb 0xC1 dcb 0x02 dcb 0xD2 dcb 0x02 dcb 0xC3 dcb 0x02 dcb 0xD3 dcb 0x02 dcb 0xCF dcb 0x56 dcb 0x34 dcb 0x12 dcb 0xDF dcb 0x56 dcb 0x34 dcb 0x12 dcb 0xC7 dcb 0x02 dcb 0xD7 dcb 0x02 Test: ldx #36 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.3\n"); return; Fail: printf ("Failed Conformance Test 25.0.3\n"); } \ No newline at end of file +/* Conformance Test 25.0.3: Verification of code generation for CMP instruct */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 +#define LONG 0x123456 + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: CMP #0xF + CMP DP + CMP DP,X + CMP ABS + CMP ABS,X + CMP ABS,Y + CMP (DP),Y + CMP (DP,X) + CMP (DP) + CMP DP,S + CMP (DP,S),Y + CMP LONG + CMP LONG,X + CMP [DP] + CMP [DP],Y + Data: dcb 0xC9 + dcb 0x0F + dcb 0x00 + dcb 0xC5 + dcb 0x02 + dcb 0xD5 + dcb 0x02 + dcb 0xCD + dcb 0x00 + dcb 0x08 + dcb 0xDD + dcb 0x00 + dcb 0x08 + dcb 0xD9 + dcb 0x00 + dcb 0x08 + dcb 0xD1 + dcb 0x02 + dcb 0xC1 + dcb 0x02 + dcb 0xD2 + dcb 0x02 + dcb 0xC3 + dcb 0x02 + dcb 0xD3 + dcb 0x02 + dcb 0xCF + dcb 0x56 + dcb 0x34 + dcb 0x12 + dcb 0xDF + dcb 0x56 + dcb 0x34 + dcb 0x12 + dcb 0xC7 + dcb 0x02 + dcb 0xD7 + dcb 0x02 + Test: ldx #36 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.3\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.3\n"); + } diff --git a/Tests/Conformance/C25.0.4.CC b/Tests/Conformance/C25.0.4.CC old mode 100755 new mode 100644 index 0f40bb7..54d7536 --- a/Tests/Conformance/C25.0.4.CC +++ b/Tests/Conformance/C25.0.4.CC @@ -1 +1,88 @@ -/* Conformance Test 25.0.4: Verification of code generation for EOR instruct */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #define LONG 0x123456 #include main () { int i = 0; asm { brl Test Code: EOR #0xF EOR DP EOR DP,X EOR ABS EOR ABS,X EOR ABS,Y EOR (DP),Y EOR (DP,X) EOR (DP) EOR DP,S EOR (DP,S),Y EOR LONG EOR LONG,X EOR [DP] EOR [DP],Y Data: dcb 0x49 dcb 0x0F dcb 0x00 dcb 0x45 dcb 0x02 dcb 0x55 dcb 0x02 dcb 0x4D dcb 0x00 dcb 0x08 dcb 0x5D dcb 0x00 dcb 0x08 dcb 0x59 dcb 0x00 dcb 0x08 dcb 0x51 dcb 0x02 dcb 0x41 dcb 0x02 dcb 0x52 dcb 0x02 dcb 0x43 dcb 0x02 dcb 0x53 dcb 0x02 dcb 0x4F dcb 0x56 dcb 0x34 dcb 0x12 dcb 0x5F dcb 0x56 dcb 0x34 dcb 0x12 dcb 0x47 dcb 0x02 dcb 0x57 dcb 0x02 Test: ldx #36 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.4\n"); return; Fail: printf ("Failed Conformance Test 25.0.4\n"); } \ No newline at end of file +/* Conformance Test 25.0.4: Verification of code generation for EOR instruct */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 +#define LONG 0x123456 + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: EOR #0xF + EOR DP + EOR DP,X + EOR ABS + EOR ABS,X + EOR ABS,Y + EOR (DP),Y + EOR (DP,X) + EOR (DP) + EOR DP,S + EOR (DP,S),Y + EOR LONG + EOR LONG,X + EOR [DP] + EOR [DP],Y + Data: dcb 0x49 + dcb 0x0F + dcb 0x00 + dcb 0x45 + dcb 0x02 + dcb 0x55 + dcb 0x02 + dcb 0x4D + dcb 0x00 + dcb 0x08 + dcb 0x5D + dcb 0x00 + dcb 0x08 + dcb 0x59 + dcb 0x00 + dcb 0x08 + dcb 0x51 + dcb 0x02 + dcb 0x41 + dcb 0x02 + dcb 0x52 + dcb 0x02 + dcb 0x43 + dcb 0x02 + dcb 0x53 + dcb 0x02 + dcb 0x4F + dcb 0x56 + dcb 0x34 + dcb 0x12 + dcb 0x5F + dcb 0x56 + dcb 0x34 + dcb 0x12 + dcb 0x47 + dcb 0x02 + dcb 0x57 + dcb 0x02 + Test: ldx #36 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.4\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.4\n"); + } diff --git a/Tests/Conformance/C25.0.5.CC b/Tests/Conformance/C25.0.5.CC old mode 100755 new mode 100644 index e638aac..1475595 --- a/Tests/Conformance/C25.0.5.CC +++ b/Tests/Conformance/C25.0.5.CC @@ -1 +1,88 @@ -/* Conformance Test 25.0.5: Verification of code generation for LDA instruct */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #define LONG 0x123456 #include main () { int i = 0; asm { brl Test Code: LDA #0xF LDA DP LDA DP,X LDA ABS LDA ABS,X LDA ABS,Y LDA (DP),Y LDA (DP,X) LDA (DP) LDA DP,S LDA (DP,S),Y LDA LONG LDA LONG,X LDA [DP] LDA [DP],Y Data: dcb 0xA9 dcb 0x0F dcb 0x00 dcb 0xA5 dcb 0x02 dcb 0xB5 dcb 0x02 dcb 0xAD dcb 0x00 dcb 0x08 dcb 0xBD dcb 0x00 dcb 0x08 dcb 0xB9 dcb 0x00 dcb 0x08 dcb 0xB1 dcb 0x02 dcb 0xA1 dcb 0x02 dcb 0xB2 dcb 0x02 dcb 0xA3 dcb 0x02 dcb 0xB3 dcb 0x02 dcb 0xAF dcb 0x56 dcb 0x34 dcb 0x12 dcb 0xBF dcb 0x56 dcb 0x34 dcb 0x12 dcb 0xA7 dcb 0x02 dcb 0xB7 dcb 0x02 Test: ldx #36 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.5\n"); return; Fail: printf ("Failed Conformance Test 25.0.5\n"); } \ No newline at end of file +/* Conformance Test 25.0.5: Verification of code generation for LDA instruct */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 +#define LONG 0x123456 + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: LDA #0xF + LDA DP + LDA DP,X + LDA ABS + LDA ABS,X + LDA ABS,Y + LDA (DP),Y + LDA (DP,X) + LDA (DP) + LDA DP,S + LDA (DP,S),Y + LDA LONG + LDA LONG,X + LDA [DP] + LDA [DP],Y + Data: dcb 0xA9 + dcb 0x0F + dcb 0x00 + dcb 0xA5 + dcb 0x02 + dcb 0xB5 + dcb 0x02 + dcb 0xAD + dcb 0x00 + dcb 0x08 + dcb 0xBD + dcb 0x00 + dcb 0x08 + dcb 0xB9 + dcb 0x00 + dcb 0x08 + dcb 0xB1 + dcb 0x02 + dcb 0xA1 + dcb 0x02 + dcb 0xB2 + dcb 0x02 + dcb 0xA3 + dcb 0x02 + dcb 0xB3 + dcb 0x02 + dcb 0xAF + dcb 0x56 + dcb 0x34 + dcb 0x12 + dcb 0xBF + dcb 0x56 + dcb 0x34 + dcb 0x12 + dcb 0xA7 + dcb 0x02 + dcb 0xB7 + dcb 0x02 + Test: ldx #36 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.5\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.5\n"); + } diff --git a/Tests/Conformance/C25.0.6.CC b/Tests/Conformance/C25.0.6.CC old mode 100755 new mode 100644 index 1240c24..09b6a16 --- a/Tests/Conformance/C25.0.6.CC +++ b/Tests/Conformance/C25.0.6.CC @@ -1 +1,88 @@ -/* Conformance Test 25.0.6: Verification of code generation for SBC instruct */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #define LONG 0x123456 #include main () { int i = 0; asm { brl Test Code: SBC #0xF SBC DP SBC DP,X SBC ABS SBC ABS,X SBC ABS,Y SBC (DP),Y SBC (DP,X) SBC (DP) SBC DP,S SBC (DP,S),Y SBC LONG SBC LONG,X SBC [DP] SBC [DP],Y Data: dcb 0xE9 dcb 0x0F dcb 0x00 dcb 0xE5 dcb 0x02 dcb 0xF5 dcb 0x02 dcb 0xED dcb 0x00 dcb 0x08 dcb 0xFD dcb 0x00 dcb 0x08 dcb 0xF9 dcb 0x00 dcb 0x08 dcb 0xF1 dcb 0x02 dcb 0xE1 dcb 0x02 dcb 0xF2 dcb 0x02 dcb 0xE3 dcb 0x02 dcb 0xF3 dcb 0x02 dcb 0xEF dcb 0x56 dcb 0x34 dcb 0x12 dcb 0xFF dcb 0x56 dcb 0x34 dcb 0x12 dcb 0xE7 dcb 0x02 dcb 0xF7 dcb 0x02 Test: ldx #36 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.6\n"); return; Fail: printf ("Failed Conformance Test 25.0.6\n"); } \ No newline at end of file +/* Conformance Test 25.0.6: Verification of code generation for SBC instruct */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 +#define LONG 0x123456 + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: SBC #0xF + SBC DP + SBC DP,X + SBC ABS + SBC ABS,X + SBC ABS,Y + SBC (DP),Y + SBC (DP,X) + SBC (DP) + SBC DP,S + SBC (DP,S),Y + SBC LONG + SBC LONG,X + SBC [DP] + SBC [DP],Y + Data: dcb 0xE9 + dcb 0x0F + dcb 0x00 + dcb 0xE5 + dcb 0x02 + dcb 0xF5 + dcb 0x02 + dcb 0xED + dcb 0x00 + dcb 0x08 + dcb 0xFD + dcb 0x00 + dcb 0x08 + dcb 0xF9 + dcb 0x00 + dcb 0x08 + dcb 0xF1 + dcb 0x02 + dcb 0xE1 + dcb 0x02 + dcb 0xF2 + dcb 0x02 + dcb 0xE3 + dcb 0x02 + dcb 0xF3 + dcb 0x02 + dcb 0xEF + dcb 0x56 + dcb 0x34 + dcb 0x12 + dcb 0xFF + dcb 0x56 + dcb 0x34 + dcb 0x12 + dcb 0xE7 + dcb 0x02 + dcb 0xF7 + dcb 0x02 + Test: ldx #36 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.6\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.6\n"); + } diff --git a/Tests/Conformance/C25.0.7.CC b/Tests/Conformance/C25.0.7.CC old mode 100755 new mode 100644 index 7a0c0e6..970743e --- a/Tests/Conformance/C25.0.7.CC +++ b/Tests/Conformance/C25.0.7.CC @@ -1 +1,86 @@ -/* Conformance Test 25.0.7: Verification of code generation for STA instruct */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #define LONG 0x123456 #include main () { int i = 0; asm { brl Test Code: STA DP STA DP,X STA ABS STA ABS,X STA ABS,Y STA (DP),Y STA (DP,X) STA (DP) STA DP,S STA (DP,S),Y STA LONG STA LONG,X STA [DP] STA [DP],Y dcb 0 Data: dcb 0x85 dcb 0x02 dcb 0x95 dcb 0x02 dcb 0x8D dcb 0x00 dcb 0x08 dcb 0x9D dcb 0x00 dcb 0x08 dcb 0x99 dcb 0x00 dcb 0x08 dcb 0x91 dcb 0x02 dcb 0x81 dcb 0x02 dcb 0x92 dcb 0x02 dcb 0x83 dcb 0x02 dcb 0x93 dcb 0x02 dcb 0x8F dcb 0x56 dcb 0x34 dcb 0x12 dcb 0x9F dcb 0x56 dcb 0x34 dcb 0x12 dcb 0x87 dcb 0x02 dcb 0x97 dcb 0x02 dcb 0 Test: ldx #34 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.7\n"); return; Fail: printf ("Failed Conformance Test 25.0.7\n"); } \ No newline at end of file +/* Conformance Test 25.0.7: Verification of code generation for STA instruct */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 +#define LONG 0x123456 + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: STA DP + STA DP,X + STA ABS + STA ABS,X + STA ABS,Y + STA (DP),Y + STA (DP,X) + STA (DP) + STA DP,S + STA (DP,S),Y + STA LONG + STA LONG,X + STA [DP] + STA [DP],Y + dcb 0 + Data: dcb 0x85 + dcb 0x02 + dcb 0x95 + dcb 0x02 + dcb 0x8D + dcb 0x00 + dcb 0x08 + dcb 0x9D + dcb 0x00 + dcb 0x08 + dcb 0x99 + dcb 0x00 + dcb 0x08 + dcb 0x91 + dcb 0x02 + dcb 0x81 + dcb 0x02 + dcb 0x92 + dcb 0x02 + dcb 0x83 + dcb 0x02 + dcb 0x93 + dcb 0x02 + dcb 0x8F + dcb 0x56 + dcb 0x34 + dcb 0x12 + dcb 0x9F + dcb 0x56 + dcb 0x34 + dcb 0x12 + dcb 0x87 + dcb 0x02 + dcb 0x97 + dcb 0x02 + dcb 0 + Test: ldx #34 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.7\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.7\n"); + } diff --git a/Tests/Conformance/C25.0.8.CC b/Tests/Conformance/C25.0.8.CC old mode 100755 new mode 100644 index 5128b72..19fe43b --- a/Tests/Conformance/C25.0.8.CC +++ b/Tests/Conformance/C25.0.8.CC @@ -1 +1,53 @@ -/* Conformance Test 25.0.8: Verification of code generation for ASL instruct */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #define LONG 0x123456 #include main () { int i = 0; asm { brl Test Code: ASL A ASL DP ASL DP,X ASL ABS ASL ABS,X dcb 0 Data: dcb 0x0A dcb 0x06 dcb 0x02 dcb 0x16 dcb 0x02 dcb 0x0E dcb 0x00 dcb 0x08 dcb 0x1E dcb 0x00 dcb 0x08 dcb 0x00 Test: ldx #10 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.8\n"); return; Fail: printf ("Failed Conformance Test 25.0.8\n"); } \ No newline at end of file +/* Conformance Test 25.0.8: Verification of code generation for ASL instruct */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 +#define LONG 0x123456 + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: ASL A + ASL DP + ASL DP,X + ASL ABS + ASL ABS,X + dcb 0 + Data: dcb 0x0A + dcb 0x06 + dcb 0x02 + dcb 0x16 + dcb 0x02 + dcb 0x0E + dcb 0x00 + dcb 0x08 + dcb 0x1E + dcb 0x00 + dcb 0x08 + dcb 0x00 + Test: ldx #10 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.8\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.8\n"); + } diff --git a/Tests/Conformance/C25.0.9.CC b/Tests/Conformance/C25.0.9.CC old mode 100755 new mode 100644 index 5e0bcb2..e714bf9 --- a/Tests/Conformance/C25.0.9.CC +++ b/Tests/Conformance/C25.0.9.CC @@ -1 +1,88 @@ -/* Conformance Test 25.0.9: Verification of code generation for ORA instruct */ #define DP 0x02 /* define 1, 2, & 3 byte addresses */ #define ABS 0x800 #define LONG 0x123456 #include main () { int i = 0; asm { brl Test Code: ORA #0x1234 ORA DP ORA DP,X ORA ABS ORA ABS,X ORA ABS,Y ORA (DP),Y ORA (DP,X) ORA (DP) ORA DP,S ORA (DP,S),Y ORA [DP] ORA [DP],Y ORA LONG ORA LONG,X Data: dcb 0x09 dcb 0x34 dcb 0x12 dcb 0x05 dcb 0x02 dcb 0x15 dcb 0x02 dcb 0x0D dcb 0x00 dcb 0x08 dcb 0x1D dcb 0x00 dcb 0x08 dcb 0x19 dcb 0x00 dcb 0x08 dcb 0x11 dcb 0x02 dcb 0x01 dcb 0x02 dcb 0x12 dcb 0x02 dcb 0x03 dcb 0x02 dcb 0x13 dcb 0x02 dcb 0x07 dcb 0x02 dcb 0x17 dcb 0x02 dcb 0x0F dcb 0x56 dcb 0x34 dcb 0x12 dcb 0x1F dcb 0x56 dcb 0x34 dcb 0x12 Test: ldx #36 Lbl1: lda Code,X cmp Data,X bne Err1 dex dex bpl Lbl1 bra Out Err1: inc i Out: nop } if (i) goto Fail; printf ("Passed Conformance Test 25.0.9\n"); return; Fail: printf ("Failed Conformance Test 25.0.9\n"); } \ No newline at end of file +/* Conformance Test 25.0.9: Verification of code generation for ORA instruct */ + +#define DP 0x02 /* define 1, 2, & 3 byte addresses */ +#define ABS 0x800 +#define LONG 0x123456 + +#include + +main () + { + int i = 0; + + asm + { + brl Test + Code: ORA #0x1234 + ORA DP + ORA DP,X + ORA ABS + ORA ABS,X + ORA ABS,Y + ORA (DP),Y + ORA (DP,X) + ORA (DP) + ORA DP,S + ORA (DP,S),Y + ORA [DP] + ORA [DP],Y + ORA LONG + ORA LONG,X + Data: dcb 0x09 + dcb 0x34 + dcb 0x12 + dcb 0x05 + dcb 0x02 + dcb 0x15 + dcb 0x02 + dcb 0x0D + dcb 0x00 + dcb 0x08 + dcb 0x1D + dcb 0x00 + dcb 0x08 + dcb 0x19 + dcb 0x00 + dcb 0x08 + dcb 0x11 + dcb 0x02 + dcb 0x01 + dcb 0x02 + dcb 0x12 + dcb 0x02 + dcb 0x03 + dcb 0x02 + dcb 0x13 + dcb 0x02 + dcb 0x07 + dcb 0x02 + dcb 0x17 + dcb 0x02 + dcb 0x0F + dcb 0x56 + dcb 0x34 + dcb 0x12 + dcb 0x1F + dcb 0x56 + dcb 0x34 + dcb 0x12 + Test: ldx #36 + Lbl1: lda Code,X + cmp Data,X + bne Err1 + dex + dex + bpl Lbl1 + bra Out + Err1: inc i + Out: nop + } + + if (i) + goto Fail; + printf ("Passed Conformance Test 25.0.9\n"); + return; + +Fail: + printf ("Failed Conformance Test 25.0.9\n"); + } diff --git a/Tests/Conformance/C3.3.0.1.CC b/Tests/Conformance/C3.3.0.1.CC old mode 100755 new mode 100644 index 064abc6..4f306f2 --- a/Tests/Conformance/C3.3.0.1.CC +++ b/Tests/Conformance/C3.3.0.1.CC @@ -1 +1,28 @@ -/* Conformance Test 3.3.0.1: Ensure macro names are ignored in comments */ /* and string constants */ #define sum(x,y) x+y #define mult(x,y) x*y main () { char a[25]; int x, y; x = /* sum(4,7) */ 10; /* This should be ignored */ y = /* mult(3,5) */ 2 * 9; /* This should also be ignored */ if ((x != 10) || (y != 18)) goto Fail; strcpy (a, "sum(x,y) mult(a,b)"); /* should also be ignored */ if ((strcmp (a, "sum(x,y) mult(a,b)")) != 0) goto Fail; printf ("Passed Conformance Test 3.3.0.1\n"); return; Fail: printf ("Failed Conformance Test 3.3.0.1\n"); } \ No newline at end of file +/* Conformance Test 3.3.0.1: Ensure macro names are ignored in comments */ +/* and string constants */ +#define sum(x,y) x+y +#define mult(x,y) x*y + +main () + { + char a[25]; + int x, y; + + x = /* sum(4,7) */ 10; /* This should be ignored */ + y = /* mult(3,5) */ 2 * 9; /* This should also be ignored */ + + if ((x != 10) || (y != 18)) + goto Fail; + + strcpy (a, "sum(x,y) mult(a,b)"); /* should also be ignored */ + if ((strcmp (a, "sum(x,y) mult(a,b)")) != 0) + goto Fail; + + printf ("Passed Conformance Test 3.3.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 3.3.0.1\n"); + } + + diff --git a/Tests/Conformance/C3.3.1.1.CC b/Tests/Conformance/C3.3.1.1.CC old mode 100755 new mode 100644 index a4d51d5..1d46a9c --- a/Tests/Conformance/C3.3.1.1.CC +++ b/Tests/Conformance/C3.3.1.1.CC @@ -1 +1,39 @@ -/* Conformance Test 3.3.1.1: Verification of simple macro definitions */ #define A_LONG_MACRO_NAME 7 * 3999 / 18 + count - digits; #define SUBSTITUTION a_variable #define EXPRESSION (3 + 21 / 6) #define STRING"This string was made for testing, and that's just what\ it does" #define LABEL Fail #define begin { #define end } #define pass_msg ("Passed Conformance Test 3.3.1.1\n"); #define letsSplit return main () begin long SUBSTITUTION; char string [] = STRING; int i, count, digits; if ((strcmp (string,"This string was made for testing, and that's \ just what it does")) != 0) goto Fail; a_variable = (long) (EXPRESSION); if (a_variable != 6) goto LABEL; count = 5; digits = 20; i = A_LONG_MACRO_NAME if (i != 1540) goto LABEL; printf pass_msg letsSplit; Fail: printf ("Failed Conformance Test 3.3.1.1\n"); end \ No newline at end of file +/* Conformance Test 3.3.1.1: Verification of simple macro definitions */ + +#define A_LONG_MACRO_NAME 7 * 3999 / 18 + count - digits; +#define SUBSTITUTION a_variable +#define EXPRESSION (3 + 21 / 6) +#define STRING"This string was made for testing, and that's just what\ + it does" +#define LABEL Fail +#define begin { +#define end } +#define pass_msg ("Passed Conformance Test 3.3.1.1\n"); +#define letsSplit return + +main () + begin + long SUBSTITUTION; + char string [] = STRING; + int i, count, digits; + + if ((strcmp (string,"This string was made for testing, and that's \ +just what it does")) != 0) + goto Fail; + + a_variable = (long) (EXPRESSION); + if (a_variable != 6) + goto LABEL; + + count = 5; + digits = 20; + i = A_LONG_MACRO_NAME + if (i != 1540) + goto LABEL; + + printf pass_msg + letsSplit; + +Fail: + printf ("Failed Conformance Test 3.3.1.1\n"); + end diff --git a/Tests/Conformance/C3.3.2.1.CC b/Tests/Conformance/C3.3.2.1.CC old mode 100755 new mode 100644 index 3a4b19b..572c771 --- a/Tests/Conformance/C3.3.2.1.CC +++ b/Tests/Conformance/C3.3.2.1.CC @@ -1 +1,51 @@ -/* Conformance Test 3.3.2.1: Verification of macros with parameters */ #define subtract(x,y) x - y #define noParmsPass() printf ("Passed Conformance Test 3.3.2.1\n"); #define noParmsFail() printf ("Failed Conformance Test 3.3.2.1\n"); #define many_parms(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z) \ a+b+c+d+e+f+g+h+i+j+k+l+m+n+o+p+q+r+s+t+u+v+w+x+y+z #define real float main () { double f1(), g1(); int i; long j; real x, y; i = subtract (3, 5); if (i != -2) goto Fail; x = 3.5e4; y = 2.8e0; j = subtract (((long) f1(x)), ((int) g1(y))); if (j != 69995) goto Fail; i = many_parms (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26); if (i != 351) goto Fail; noParmsPass () return; Fail: noParmsFail () } /**************************************************************************/ double f1 ( y ) real y; { return (y * 2.0); } /**************************************************************************/ double g1 ( x ) real x; { return (x / 0.5e+0); } \ No newline at end of file +/* Conformance Test 3.3.2.1: Verification of macros with parameters */ + +#define subtract(x,y) x - y +#define noParmsPass() printf ("Passed Conformance Test 3.3.2.1\n"); +#define noParmsFail() printf ("Failed Conformance Test 3.3.2.1\n"); +#define many_parms(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z) \ +a+b+c+d+e+f+g+h+i+j+k+l+m+n+o+p+q+r+s+t+u+v+w+x+y+z +#define real float + +main () + { + double f1(), g1(); + int i; + long j; + real x, y; + + i = subtract (3, 5); + if (i != -2) + goto Fail; + + x = 3.5e4; + y = 2.8e0; + j = subtract (((long) f1(x)), ((int) g1(y))); + if (j != 69995) + goto Fail; + + i = many_parms (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, + 17, 18, 19, 20, 21, 22, 23, 24, 25, 26); + if (i != 351) + goto Fail; + + noParmsPass () + return; + +Fail: + noParmsFail () + } + +/**************************************************************************/ +double f1 ( y ) + real y; + { + return (y * 2.0); + } + +/**************************************************************************/ +double g1 ( x ) + real x; + { + return (x / 0.5e+0); + } diff --git a/Tests/Conformance/C3.3.3.1.CC b/Tests/Conformance/C3.3.3.1.CC old mode 100755 new mode 100644 index b806a77..45aa225 --- a/Tests/Conformance/C3.3.3.1.CC +++ b/Tests/Conformance/C3.3.3.1.CC @@ -1 +1,33 @@ -/* Conformance Test 3.3.3.1: Ensure correct macro expansion for nested */ /* macros and nested macro calls */ #define addMult(a,b,c) mult ( (add((a),(c))), (b) ) #define mult(x,y) (y) * (x) #define add(i,j) (i) + (j) main () { long i, j, k, m; i = 2; j = 3; k = 5; m = addMult (i, j, k); if (m != 21) goto Fail; m = addMult ( (mult (j,k)), (add (m,i)), 4 ); if (m != 437) goto Fail; j = add ( (mult (k,i)), (addMult ((m), (mult ((i), (add (m,m))) ), (k)))); if (j != 772626) goto Fail; printf ("Passed Conformance Test 3.3.3.1\n"); return; Fail: printf ("Failed Conformance Test 3.3.3.1\n"); } \ No newline at end of file +/* Conformance Test 3.3.3.1: Ensure correct macro expansion for nested */ +/* macros and nested macro calls */ + +#define addMult(a,b,c) mult ( (add((a),(c))), (b) ) +#define mult(x,y) (y) * (x) +#define add(i,j) (i) + (j) + +main () + { + long i, j, k, m; + + i = 2; + j = 3; + k = 5; + + m = addMult (i, j, k); + if (m != 21) + goto Fail; + + m = addMult ( (mult (j,k)), (add (m,i)), 4 ); + if (m != 437) + goto Fail; + + j = add ( (mult (k,i)), (addMult ((m), (mult ((i), (add (m,m))) ), (k)))); + if (j != 772626) + goto Fail; + + printf ("Passed Conformance Test 3.3.3.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 3.3.3.1\n"); + } diff --git a/Tests/Conformance/C3.3.4.1.CC b/Tests/Conformance/C3.3.4.1.CC old mode 100755 new mode 100644 index f9f86e5..c8134c4 --- a/Tests/Conformance/C3.3.4.1.CC +++ b/Tests/Conformance/C3.3.4.1.CC @@ -1 +1,30 @@ -/* Conformance Test 3.3.4.1: Verification of ANSI C and ORCA/C predefined */ /* macros */ main () { int i, j; float x, y; char str[80], fname[20] = "C3.3.4.1.CC"; #line 10 if (__LINE__ != 11) goto Fail; strcpy(str, __FILE__); i = strlen(str)-strlen(fname); if ((strcmp (&str[i], fname)) != 0) goto Fail; if (__STDC__ == 0) goto Fail; if (__ORCAC__ != 1) goto Fail; printf ("Passed Conformance Test 3.3.4.1\n"); return; Fail: printf ("Failed Conformance Test 3.3.4.1\n"); } \ No newline at end of file +/* Conformance Test 3.3.4.1: Verification of ANSI C and ORCA/C predefined */ +/* macros */ + +main () + { + int i, j; + float x, y; + char str[80], fname[20] = "C3.3.4.1.CC"; + +#line 10 + if (__LINE__ != 11) + goto Fail; + + strcpy(str, __FILE__); + i = strlen(str)-strlen(fname); + if ((strcmp (&str[i], fname)) != 0) + goto Fail; + + if (__STDC__ == 0) + goto Fail; + + if (__ORCAC__ != 1) + goto Fail; + + printf ("Passed Conformance Test 3.3.4.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 3.3.4.1\n"); + } diff --git a/Tests/Conformance/C3.3.5.1.CC b/Tests/Conformance/C3.3.5.1.CC old mode 100755 new mode 100644 index cac3c39..5045269 --- a/Tests/Conformance/C3.3.5.1.CC +++ b/Tests/Conformance/C3.3.5.1.CC @@ -1 +1,26 @@ -/* Conformance Test 3.3.5.1: Verification of undefining/redefining macros */ #undef macroNotDefinedYet /* not an error to undefine an */ /* undefined macro */ #define macroNotDefinedYet 8 #define macroNotDefinedYet 8 /* allow only "benign" redefinition */ #undef macroNotDefinedYet /* without intervening #undef */ #define macroNotDefinedYet 23 /* allow infinite undefining and */ /* redefining */ #define A23__BD8 "These are the days" #undef A23__BD8 #define A23__BD8 27.3e5 #undef A23__BD8 #define A23__BD8 "Passed Conformance Test 3.3.5.1\n" main () { if (macroNotDefinedYet != 23) goto Fail; printf (A23__BD8); return; Fail: printf ("Failed Conformance Test 3.3.5.1\n"); } \ No newline at end of file +/* Conformance Test 3.3.5.1: Verification of undefining/redefining macros */ + +#undef macroNotDefinedYet /* not an error to undefine an */ + /* undefined macro */ +#define macroNotDefinedYet 8 +#define macroNotDefinedYet 8 /* allow only "benign" redefinition */ +#undef macroNotDefinedYet /* without intervening #undef */ +#define macroNotDefinedYet 23 /* allow infinite undefining and */ + /* redefining */ +#define A23__BD8 "These are the days" +#undef A23__BD8 +#define A23__BD8 27.3e5 +#undef A23__BD8 +#define A23__BD8 "Passed Conformance Test 3.3.5.1\n" + +main () + { + if (macroNotDefinedYet != 23) + goto Fail; + + printf (A23__BD8); + return; + +Fail: + printf ("Failed Conformance Test 3.3.5.1\n"); + } diff --git a/Tests/Conformance/C3.3.6.1.CC b/Tests/Conformance/C3.3.6.1.CC old mode 100755 new mode 100644 index 759bc5b..8658321 --- a/Tests/Conformance/C3.3.6.1.CC +++ b/Tests/Conformance/C3.3.6.1.CC @@ -1 +1,32 @@ -/* Conformance Test 3.3.6.1: Verify precedence setting with parentheses */ /* in macro expansions */ #define SQUARE1(x) x * x #define SQUARE2(x) (x) * (x) #define SQUARE3(x) ( (x) * (x) ) main () { float y; int i; y = 3.5; y = (int) SQUARE1 (y + 1); if (y != 7.5) goto Fail; y = (int) SQUARE2 (y + 1); if (y != 68.0) goto Fail; i = (int) SQUARE3 (y + 1); if (i != 4761) goto Fail; printf ("Passed Conformance Test 3.3.6.1\n"); return; Fail: printf ("Failed Conformance Test 3.3.6.1\n"); } \ No newline at end of file +/* Conformance Test 3.3.6.1: Verify precedence setting with parentheses */ +/* in macro expansions */ + +#define SQUARE1(x) x * x +#define SQUARE2(x) (x) * (x) +#define SQUARE3(x) ( (x) * (x) ) + +main () + { + float y; + int i; + + y = 3.5; + y = (int) SQUARE1 (y + 1); + if (y != 7.5) + goto Fail; + + y = (int) SQUARE2 (y + 1); + if (y != 68.0) + goto Fail; + + i = (int) SQUARE3 (y + 1); + if (i != 4761) + goto Fail; + + printf ("Passed Conformance Test 3.3.6.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 3.3.6.1\n"); + } + diff --git a/Tests/Conformance/C3.3.8.1.CC b/Tests/Conformance/C3.3.8.1.CC old mode 100755 new mode 100644 index bb3c771..a880cfa --- a/Tests/Conformance/C3.3.8.1.CC +++ b/Tests/Conformance/C3.3.8.1.CC @@ -1 +1,23 @@ -/* Conformance Test 3.3.8.1: Verification of converting tokens to strings */ /* within macros */ #define CnvToString1(a,b,c) "not a " #a " nor a c" #c " nor a m" #b\ " be me\n" #define CnvToString2(a,b,c) "a = " #a " b = " #b " c = "#c main () { char string1[] = CnvToString1 (5, 276.145, 0x7F); char string2[] = CnvToString2 (4, 3, 0); if ((strcmp (string1, "not a 5 nor a c0x7F nor a m276.145 be me\n")) != 0) goto Fail; if ((strcmp (string2, "a = 4 b = 3 c = 0")) != 0) goto Fail; printf ("Passed Conformance Test 3.3.8.1\n"); return; Fail: printf ("Failed Conformance Test 3.3.8.1\n"); } \ No newline at end of file +/* Conformance Test 3.3.8.1: Verification of converting tokens to strings */ +/* within macros */ + +#define CnvToString1(a,b,c) "not a " #a " nor a c" #c " nor a m" #b\ +" be me\n" +#define CnvToString2(a,b,c) "a = " #a " b = " #b " c = "#c + +main () + { + char string1[] = CnvToString1 (5, 276.145, 0x7F); + char string2[] = CnvToString2 (4, 3, 0); + + if ((strcmp (string1, "not a 5 nor a c0x7F nor a m276.145 be me\n")) != 0) + goto Fail; + if ((strcmp (string2, "a = 4 b = 3 c = 0")) != 0) + goto Fail; + + printf ("Passed Conformance Test 3.3.8.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 3.3.8.1\n"); + } diff --git a/Tests/Conformance/C3.3.9.1.CC b/Tests/Conformance/C3.3.9.1.CC old mode 100755 new mode 100644 index 85071be..2fc3d85 --- a/Tests/Conformance/C3.3.9.1.CC +++ b/Tests/Conformance/C3.3.9.1.CC @@ -1 +1,20 @@ -/* Conformance Test 3.3.9.1: Verification of token merging in macro */ /* expansions */ #define INCR(j,k) j##k main () { int x; x = 3; x = INCR (+, +) x; if (x != 4) goto Fail; printf ("Passed Conformance Test 3.3.9.1\n"); return; Fail: printf ("Failed Conformance Test 3.3.9.1\n"); } \ No newline at end of file +/* Conformance Test 3.3.9.1: Verification of token merging in macro */ +/* expansions */ + +#define INCR(j,k) j##k + +main () + { + int x; + + x = 3; + x = INCR (+, +) x; + if (x != 4) + goto Fail; + + printf ("Passed Conformance Test 3.3.9.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 3.3.9.1\n"); + } diff --git a/Tests/Conformance/C3.5.1.1.CC b/Tests/Conformance/C3.5.1.1.CC old mode 100755 new mode 100644 index d791ffb..77a9da1 --- a/Tests/Conformance/C3.5.1.1.CC +++ b/Tests/Conformance/C3.5.1.1.CC @@ -1 +1,83 @@ -/* Conformance Test 3.5.1.1: Verification of #if constant expressions */ #define FIVE 5 #define SIX 6 #if 2 * 8 #if 4 / 3 #if 209 - 8 #if 32760 + 7 #if (5 == 5) #if (2 != 0) #define NUM1 (2*8) | (4/3) ^ (209-208) & (32760+7) #else #define NUM1 5 #endif #else #define NUM1 4 #endif #else #define NUM1 3 #endif #else #define NUM1 2 #endif #else #define NUM1 1 #endif #else #define NUM1 0 #endif #if (6 < 32767) #if (20004 <= 20004) #if (59876 > 59875) #if (671234 >= 671234) #if ((2) && (3)) #if ((0) || (1)) #define NUM2 2147 % 3 << 3 >> 2 #else #define NUM2 5 #endif #else #define NUM2 4 #endif #else #define NUM2 3 #endif #else #define NUM2 2 #endif #else #define NUM2 1 #endif #else #define NUM2 0 #endif #if (-32768) #if ~0x7e #if !0 #define NUM3 NUM1 ? NUM2 : 187 #else #define NUM3 2 #endif #else #define NUM3 1 #endif #else #define NUM3 0 #endif #if (defined(FIVE)) && (defined(SIX)) && (NUM1 == 0x10) && (NUM2 == 4)\ && (NUM3 == NUM2) main () { printf ("Passed Conformance Test 3.5.1.1\n"); } #else main () { printf ("Failed Conformance Test 3.5.1.1\n"); } #endif \ No newline at end of file +/* Conformance Test 3.5.1.1: Verification of #if constant expressions */ + +#define FIVE 5 +#define SIX 6 + +#if 2 * 8 + #if 4 / 3 + #if 209 - 8 + #if 32760 + 7 + #if (5 == 5) + #if (2 != 0) + #define NUM1 (2*8) | (4/3) ^ (209-208) & (32760+7) + #else + #define NUM1 5 + #endif + #else + #define NUM1 4 + #endif + #else + #define NUM1 3 + #endif + #else + #define NUM1 2 + #endif + #else + #define NUM1 1 + #endif +#else + #define NUM1 0 +#endif + +#if (6 < 32767) + #if (20004 <= 20004) + #if (59876 > 59875) + #if (671234 >= 671234) + #if ((2) && (3)) + #if ((0) || (1)) + #define NUM2 2147 % 3 << 3 >> 2 + #else + #define NUM2 5 + #endif + #else + #define NUM2 4 + #endif + #else + #define NUM2 3 + #endif + #else + #define NUM2 2 + #endif + #else + #define NUM2 1 + #endif +#else + #define NUM2 0 +#endif + +#if (-32768) + #if ~0x7e + #if !0 + #define NUM3 NUM1 ? NUM2 : 187 + #else + #define NUM3 2 + #endif + #else + #define NUM3 1 + #endif +#else + #define NUM3 0 +#endif + +#if (defined(FIVE)) && (defined(SIX)) && (NUM1 == 0x10) && (NUM2 == 4)\ + && (NUM3 == NUM2) +main () + { + printf ("Passed Conformance Test 3.5.1.1\n"); + } +#else +main () + { + printf ("Failed Conformance Test 3.5.1.1\n"); + } +#endif diff --git a/Tests/Conformance/C3.5.1.2.CC b/Tests/Conformance/C3.5.1.2.CC old mode 100755 new mode 100644 index c76d416..4d74842 --- a/Tests/Conformance/C3.5.1.2.CC +++ b/Tests/Conformance/C3.5.1.2.CC @@ -1 +1,84 @@ -/* Conformance Test 3.5.1.2: Verification of #if character constant expressions */ #define FIVE '5' #define SIX '6' #if '2' * '8' #if '4' / '3' #if 'A' - 'b' #if '\r' + '\f' #if ('p' == '\x70') #if ('\001' != 0) #define NUM1 ('2'*'8') | ('4'/'3') ^ ('A'-'b')\ & ('\r'+'\f') #else #define NUM1 5 #endif #else #define NUM1 4 #endif #else #define NUM1 3 #endif #else #define NUM1 2 #endif #else #define NUM1 1 #endif #else #define NUM1 0 #endif #if ('6' < '7') #if ('2' <= '2') #if ('8' > '7') #if ('0' >= '0') #if (('\n') && ('\003')) #if ((0) || ('d')) #define NUM2 'z' % '0' << '\01' >> '\x2' #else #define NUM2 5 #endif #else #define NUM2 4 #endif #else #define NUM2 3 #endif #else #define NUM2 2 #endif #else #define NUM2 1 #endif #else #define NUM2 0 #endif #if -('\x7f') #if ~('\0') #if !0 #define NUM3 NUM1 ? NUM2 : 187 #else #define NUM3 2 #endif #else #define NUM3 1 #endif #else #define NUM3 0 #endif #if (defined(FIVE)) && (defined(SIX)) && (NUM1 == 0xAF8) && (NUM2 == 13)\ && (NUM3 == NUM2) main () { printf ("Passed Conformance Test 3.5.1.2\n"); } #else main () { printf ("Failed Conformance Test 3.5.1.2\n"); } #endif \ No newline at end of file +/* Conformance Test 3.5.1.2: Verification of #if character constant expressions */ + +#define FIVE '5' +#define SIX '6' + +#if '2' * '8' + #if '4' / '3' + #if 'A' - 'b' + #if '\r' + '\f' + #if ('p' == '\x70') + #if ('\001' != 0) + #define NUM1 ('2'*'8') | ('4'/'3') ^ ('A'-'b')\ + & ('\r'+'\f') + #else + #define NUM1 5 + #endif + #else + #define NUM1 4 + #endif + #else + #define NUM1 3 + #endif + #else + #define NUM1 2 + #endif + #else + #define NUM1 1 + #endif +#else + #define NUM1 0 +#endif + +#if ('6' < '7') + #if ('2' <= '2') + #if ('8' > '7') + #if ('0' >= '0') + #if (('\n') && ('\003')) + #if ((0) || ('d')) + #define NUM2 'z' % '0' << '\01' >> '\x2' + #else + #define NUM2 5 + #endif + #else + #define NUM2 4 + #endif + #else + #define NUM2 3 + #endif + #else + #define NUM2 2 + #endif + #else + #define NUM2 1 + #endif +#else + #define NUM2 0 +#endif + +#if -('\x7f') + #if ~('\0') + #if !0 + #define NUM3 NUM1 ? NUM2 : 187 + #else + #define NUM3 2 + #endif + #else + #define NUM3 1 + #endif +#else + #define NUM3 0 +#endif + +#if (defined(FIVE)) && (defined(SIX)) && (NUM1 == 0xAF8) && (NUM2 == 13)\ + && (NUM3 == NUM2) +main () + { + printf ("Passed Conformance Test 3.5.1.2\n"); + } +#else +main () + { + printf ("Failed Conformance Test 3.5.1.2\n"); + } +#endif diff --git a/Tests/Conformance/C3.5.1.3.CC b/Tests/Conformance/C3.5.1.3.CC old mode 100755 new mode 100644 index 07484f7..d8bd2ff --- a/Tests/Conformance/C3.5.1.3.CC +++ b/Tests/Conformance/C3.5.1.3.CC @@ -1 +1,16 @@ -/* Conformance Test 3.5.1.3: Verify macro expansion in #if commands */ #define VAL1 1 #undef VAL1 #if !VAL1 /* VAL1 should be undefined, and so evaluate as 0 */ main () { printf ("Passed Conformance Test 3.5.1.3\n"); } #else main () { printf ("Failed Conformance Test 3.5.1.3\n"); } #endif \ No newline at end of file +/* Conformance Test 3.5.1.3: Verify macro expansion in #if commands */ + +#define VAL1 1 +#undef VAL1 + +#if !VAL1 /* VAL1 should be undefined, and so evaluate as 0 */ +main () + { + printf ("Passed Conformance Test 3.5.1.3\n"); + } +#else +main () + { + printf ("Failed Conformance Test 3.5.1.3\n"); + } +#endif diff --git a/Tests/Conformance/C3.5.1.4.CC b/Tests/Conformance/C3.5.1.4.CC old mode 100755 new mode 100644 index 5f71873..3ea3d43 --- a/Tests/Conformance/C3.5.1.4.CC +++ b/Tests/Conformance/C3.5.1.4.CC @@ -1 +1,94 @@ -/* Conformance Test 3.5.1.4: Verification of macro expansions in #if */ /* commands */ #define ONE 1 #define TWO 2 #define THREE 3 #define FOUR 4 #define FIVE '5' #define SIX '6' #define SEVEN '7' #define EIGHT 8 #define NINE 9 #define ZERO 0 #if ONE * TWO #if SEVEN / ONE #if NINE - 8 #if '\r' + ZERO #if (FIVE == '\x35') #if ('\001' != ZERO) #define NUM1 (ONE*TWO) | (SEVEN/ONE) ^ (NINE-8)\ & ('\r'+ZERO) #else #define NUM1 5 #endif #else #define NUM1 4 #endif #else #define NUM1 3 #endif #else #define NUM1 2 #endif #else #define NUM1 1 #endif #else #define NUM1 0 #endif #if (THREE < '7') #if ('6' <= SIX) #if (EIGHT > 2) #if (FOUR >= 4) #if (('\n') && ('\003')) #if ((0) || ('d')) #define NUM2 NINE / ONE << THREE >> TWO #else #define NUM2 5 #endif #else #define NUM2 4 #endif #else #define NUM2 3 #endif #else #define NUM2 2 #endif #else #define NUM2 1 #endif #else #define NUM2 0 #endif #if -(3 * SEVEN) #if ~(SIX) #if !ZERO #define NUM3 NUM1 ? NUM2 : 187 #else #define NUM3 2 #endif #else #define NUM3 1 #endif #else #define NUM3 0 #endif #if (defined(FIVE)) && (defined(SIX)) && (NUM1 == 54) && (NUM2 == 18)\ && (NUM3 == NUM2) main () { printf ("Passed Conformance Test 3.5.1.4\n"); } #else main () { printf("%d %d %d\n", NUM1, NUM2, NUM3); printf ("Failed Conformance Test 3.5.1.4\n"); } #endif \ No newline at end of file +/* Conformance Test 3.5.1.4: Verification of macro expansions in #if */ +/* commands */ + +#define ONE 1 +#define TWO 2 +#define THREE 3 +#define FOUR 4 +#define FIVE '5' +#define SIX '6' +#define SEVEN '7' +#define EIGHT 8 +#define NINE 9 +#define ZERO 0 + +#if ONE * TWO + #if SEVEN / ONE + #if NINE - 8 + #if '\r' + ZERO + #if (FIVE == '\x35') + #if ('\001' != ZERO) + #define NUM1 (ONE*TWO) | (SEVEN/ONE) ^ (NINE-8)\ + & ('\r'+ZERO) + #else + #define NUM1 5 + #endif + #else + #define NUM1 4 + #endif + #else + #define NUM1 3 + #endif + #else + #define NUM1 2 + #endif + #else + #define NUM1 1 + #endif +#else + #define NUM1 0 +#endif + +#if (THREE < '7') + #if ('6' <= SIX) + #if (EIGHT > 2) + #if (FOUR >= 4) + #if (('\n') && ('\003')) + #if ((0) || ('d')) + #define NUM2 NINE / ONE << THREE >> TWO + #else + #define NUM2 5 + #endif + #else + #define NUM2 4 + #endif + #else + #define NUM2 3 + #endif + #else + #define NUM2 2 + #endif + #else + #define NUM2 1 + #endif +#else + #define NUM2 0 +#endif + +#if -(3 * SEVEN) + #if ~(SIX) + #if !ZERO + #define NUM3 NUM1 ? NUM2 : 187 + #else + #define NUM3 2 + #endif + #else + #define NUM3 1 + #endif +#else + #define NUM3 0 +#endif + +#if (defined(FIVE)) && (defined(SIX)) && (NUM1 == 54) && (NUM2 == 18)\ + && (NUM3 == NUM2) +main () + { + printf ("Passed Conformance Test 3.5.1.4\n"); + } +#else +main () + { +printf("%d %d %d\n", NUM1, NUM2, NUM3); + printf ("Failed Conformance Test 3.5.1.4\n"); + } +#endif diff --git a/Tests/Conformance/C3.5.1.5.CC b/Tests/Conformance/C3.5.1.5.CC old mode 100755 new mode 100644 index fd0c1bd..2154fde --- a/Tests/Conformance/C3.5.1.5.CC +++ b/Tests/Conformance/C3.5.1.5.CC @@ -1 +1,39 @@ -/* Conformance Test 3.5.1.5: Ensure #if, #else with no lines to compile */ /* are not errors */ #if 5 #else #endif #if !0 #define TRUE 1 #else #endif #if 32767 #else #define FALSE 0 #endif #if defined(FALSE) #define fail 1 #else #define fail 0 #endif main () { if (TRUE != 1) goto Fail; if (fail) goto Fail; printf ("Passed Conformance Test 3.5.1.5\n"); return; Fail: printf ("Failed Conformance Test 3.5.1.5\n"); } \ No newline at end of file +/* Conformance Test 3.5.1.5: Ensure #if, #else with no lines to compile */ +/* are not errors */ + +#if 5 +#else +#endif + +#if !0 + #define TRUE 1 +#else +#endif + +#if 32767 +#else + #define FALSE 0 +#endif + +#if defined(FALSE) + #define fail 1 +#else + #define fail 0 +#endif + +main () + { + if (TRUE != 1) + goto Fail; + + if (fail) + goto Fail; + + printf ("Passed Conformance Test 3.5.1.5\n"); + return; + +Fail: + printf ("Failed Conformance Test 3.5.1.5\n"); + } + + diff --git a/Tests/Conformance/C3.5.2.1.CC b/Tests/Conformance/C3.5.2.1.CC old mode 100755 new mode 100644 index 0de3790..cc3d9e3 --- a/Tests/Conformance/C3.5.2.1.CC +++ b/Tests/Conformance/C3.5.2.1.CC @@ -1 +1,37 @@ -/* Conformance Test 3.5.2.1: Verification of #elif command */ #if 0 # define MSG "Failed Conformance Test 3.5.2.1; location 1\n" #elif (5 - 5) # define MSG "Failed Conformance Test 3.5.2.1; location 2\n" #elif 1 # define MSG "Passed Conformance Test 3.5.2.1\n" #elif 2 # define MSG "Failed Conformance Test 3.5.2.1; location 3\n" #elif 3 # define MSG "Failed Conformance Test 3.5.2.1; location 4\n" #elif 4 # define MSG "Failed Conformance Test 3.5.2.1; location 5\n" #elif 5 # define MSG "Failed Conformance Test 3.5.2.1; location 6\n" #elif 6 # define MSG "Failed Conformance Test 3.5.2.1; location 7\n" #elif 7 # define MSG "Failed Conformance Test 3.5.2.1; location 8\n" #else # define MSG "Failed Conformance Test 3.5.2.1; location 9\n" #endif main () { printf (MSG); } \ No newline at end of file +/* Conformance Test 3.5.2.1: Verification of #elif command */ + +#if 0 + # define MSG "Failed Conformance Test 3.5.2.1; location 1\n" + +#elif (5 - 5) + # define MSG "Failed Conformance Test 3.5.2.1; location 2\n" + +#elif 1 + # define MSG "Passed Conformance Test 3.5.2.1\n" + +#elif 2 + # define MSG "Failed Conformance Test 3.5.2.1; location 3\n" + +#elif 3 + # define MSG "Failed Conformance Test 3.5.2.1; location 4\n" + +#elif 4 + # define MSG "Failed Conformance Test 3.5.2.1; location 5\n" + +#elif 5 + # define MSG "Failed Conformance Test 3.5.2.1; location 6\n" + +#elif 6 + # define MSG "Failed Conformance Test 3.5.2.1; location 7\n" + +#elif 7 + # define MSG "Failed Conformance Test 3.5.2.1; location 8\n" + +#else + # define MSG "Failed Conformance Test 3.5.2.1; location 9\n" +#endif + +main () + { + printf (MSG); + } diff --git a/Tests/Conformance/C3.5.2.2.CC b/Tests/Conformance/C3.5.2.2.CC old mode 100755 new mode 100644 index 32171d0..4a339ae --- a/Tests/Conformance/C3.5.2.2.CC +++ b/Tests/Conformance/C3.5.2.2.CC @@ -1 +1,60 @@ -/* Conformance Test 3.5.2.2: Verification of #elif command, using macro */ /* substitution */ #define MACRO1(x,y,z) ((x) + (y) * (z)) #define PASS "Passed Conformance Test 3.5.2.2\n" #define FAIL "Failed Conformance Test 3.5.2.2\n" #if MACRO1 (-6,2,3) # define MSG FAIL #elif MACRO1 (8,-4,2) # define MSG FAIL #elif MACRO1 (16,8,-2) # define MSG FAIL #elif MACRO1 (-10,-5,-2) # define MSG FAIL #elif MACRO1 (2,3,4) # define MSG PASS #elif MACRO1 (1,2,3) # define MSG FAIL #elif MACRO1 (2,3,4) # define MSG FAIL #elif MACRO1 (3,4,5) # define MSG FAIL #elif MACRO1 (4,5,6) # define MSG FAIL #elif MACRO1 (5,6,7) # define MSG FAIL #elif MACRO1 (6,7,8) # define MSG FAIL #elif MACRO1 (7,8,9) # define MSG FAIL #elif MACRO1 (4,2,-2) # define MSG FAIL #elif MACRO1 (0,0,0) # define MSG FAIL #elif MACRO1 (4,5,6) # define MSG FAIL #else # define MSG FAIL #endif main () { printf (MSG); } \ No newline at end of file +/* Conformance Test 3.5.2.2: Verification of #elif command, using macro */ +/* substitution */ + +#define MACRO1(x,y,z) ((x) + (y) * (z)) +#define PASS "Passed Conformance Test 3.5.2.2\n" +#define FAIL "Failed Conformance Test 3.5.2.2\n" + +#if MACRO1 (-6,2,3) + # define MSG FAIL + +#elif MACRO1 (8,-4,2) + # define MSG FAIL + +#elif MACRO1 (16,8,-2) + # define MSG FAIL + +#elif MACRO1 (-10,-5,-2) + # define MSG FAIL + +#elif MACRO1 (2,3,4) + # define MSG PASS + +#elif MACRO1 (1,2,3) + # define MSG FAIL + +#elif MACRO1 (2,3,4) + # define MSG FAIL + +#elif MACRO1 (3,4,5) + # define MSG FAIL + +#elif MACRO1 (4,5,6) + # define MSG FAIL + +#elif MACRO1 (5,6,7) + # define MSG FAIL + +#elif MACRO1 (6,7,8) + # define MSG FAIL + +#elif MACRO1 (7,8,9) + # define MSG FAIL + +#elif MACRO1 (4,2,-2) + # define MSG FAIL + +#elif MACRO1 (0,0,0) + # define MSG FAIL + +#elif MACRO1 (4,5,6) + # define MSG FAIL + +#else + # define MSG FAIL +#endif + +main () + { + printf (MSG); + } diff --git a/Tests/Conformance/C3.5.2.3.CC b/Tests/Conformance/C3.5.2.3.CC old mode 100755 new mode 100644 index d57aacd..a02e12d --- a/Tests/Conformance/C3.5.2.3.CC +++ b/Tests/Conformance/C3.5.2.3.CC @@ -1 +1,37 @@ -/* Conformance Test 3.5.2.3: Verification of nested #elif commands */ #define PASS "Passed Conformance Test 3.5.2.3\n" #define FAIL "Failed Conformance Test 3.5.2.3\n" main () { #if 1 #if 2 #if 0 printf (FAIL); #elif 0 printf (FAIL); #elif 32767 printf (PASS); #endif #elif 3 printf (FAIL); #elif 0 printf (FAIL); #else printf (FAIL); #endif #elif 5 printf (FAIL); #elif 6 printf (FAIL); #elif 7 printf (FAIL); #elif 8 printf (FAIL); #elif 0 printf (FAIL); #else printf (FAIL); #endif } \ No newline at end of file +/* Conformance Test 3.5.2.3: Verification of nested #elif commands */ + +#define PASS "Passed Conformance Test 3.5.2.3\n" +#define FAIL "Failed Conformance Test 3.5.2.3\n" + +main () + { + #if 1 + #if 2 + #if 0 + printf (FAIL); + #elif 0 + printf (FAIL); + #elif 32767 + printf (PASS); + #endif + #elif 3 + printf (FAIL); + #elif 0 + printf (FAIL); + #else + printf (FAIL); + #endif + #elif 5 + printf (FAIL); + #elif 6 + printf (FAIL); + #elif 7 + printf (FAIL); + #elif 8 + printf (FAIL); + #elif 0 + printf (FAIL); + #else + printf (FAIL); + #endif + } diff --git a/Tests/Conformance/C3.5.2.4.CC b/Tests/Conformance/C3.5.2.4.CC old mode 100755 new mode 100644 index 32a7e4e..5000426 --- a/Tests/Conformance/C3.5.2.4.CC +++ b/Tests/Conformance/C3.5.2.4.CC @@ -1 +1,41 @@ -/* Conformance Test 3.5.2.4: Verification of nested #elif commands, using */ /* macro substitution */ #define PASS "Passed Conformance Test 3.5.2.4\n" #define FAIL "Failed Conformance Test 3.5.2.4\n" #define CALL1(a,b,c) ((a) - (b) * (c)) #define CALL2(x,y) ((x) || (y)) main () { #if CALL1 (6,2,3) #if CALL1 (8,2,4) #if CALL2 (0,0) printf (FAIL); #elif 0 printf (FAIL); #elif 32767 printf (FAIL); #endif #elif CALL1 (10,3,4) printf (FAIL); #elif CALL2 (7,0) printf (FAIL); #else printf (FAIL); #endif #elif CALL1 (12,4,3) printf (FAIL); #elif CALL2 ((5-(4+1)), 0) printf (FAIL); #elif CALL1 (16,4,4) printf (FAIL); #elif 0 printf (FAIL); #elif CALL1 (20,-10,-2) printf (FAIL); #else printf (PASS); #endif } \ No newline at end of file +/* Conformance Test 3.5.2.4: Verification of nested #elif commands, using */ +/* macro substitution */ + +#define PASS "Passed Conformance Test 3.5.2.4\n" +#define FAIL "Failed Conformance Test 3.5.2.4\n" + +#define CALL1(a,b,c) ((a) - (b) * (c)) +#define CALL2(x,y) ((x) || (y)) + +main () + { + #if CALL1 (6,2,3) + #if CALL1 (8,2,4) + #if CALL2 (0,0) + printf (FAIL); + #elif 0 + printf (FAIL); + #elif 32767 + printf (FAIL); + #endif + #elif CALL1 (10,3,4) + printf (FAIL); + #elif CALL2 (7,0) + printf (FAIL); + #else + printf (FAIL); + #endif + #elif CALL1 (12,4,3) + printf (FAIL); + #elif CALL2 ((5-(4+1)), 0) + printf (FAIL); + #elif CALL1 (16,4,4) + printf (FAIL); + #elif 0 + printf (FAIL); + #elif CALL1 (20,-10,-2) + printf (FAIL); + #else + printf (PASS); + #endif + } diff --git a/Tests/Conformance/C3.5.3.1.CC b/Tests/Conformance/C3.5.3.1.CC old mode 100755 new mode 100644 index 8fcb34e..a0cb089 --- a/Tests/Conformance/C3.5.3.1.CC +++ b/Tests/Conformance/C3.5.3.1.CC @@ -1 +1,57 @@ -/* Conformance Test 3.5.3.1: Verification of #ifdef and #ifndef commands */ #define ONE 1 #define TWO 2 #define THREE 3 #define FOUR 4 #ifdef ONE #define COUNT1 1 #endif #ifdef TWO #define COUNT2 2 #endif #ifdef THREE #define COUNT3 3 #endif #ifdef FOUR #define COUNT4 4 #endif #undef ONE #undef TWO #undef THREE #undef FOUR #ifndef ONE #define COUNT5 5 #endif #ifndef TWO #define COUNT6 6 #endif #ifndef THREE #define COUNT7 7 #endif #ifndef FOUR #define COUNT8 8 #endif main () { int a; a = COUNT1 + COUNT2 + COUNT3 + COUNT4 + COUNT5 + COUNT6 + COUNT7 + COUNT8; if (a != 36) goto Fail; printf ("Passed Conformance Test 3.5.3.1\n"); return; Fail: printf ("Failed Conformance Test 3.5.3.1\n"); } \ No newline at end of file +/* Conformance Test 3.5.3.1: Verification of #ifdef and #ifndef commands */ + +#define ONE 1 +#define TWO 2 +#define THREE 3 +#define FOUR 4 + +#ifdef ONE + #define COUNT1 1 +#endif + +#ifdef TWO + #define COUNT2 2 +#endif + +#ifdef THREE + #define COUNT3 3 +#endif + +#ifdef FOUR + #define COUNT4 4 +#endif + +#undef ONE +#undef TWO +#undef THREE +#undef FOUR + +#ifndef ONE + #define COUNT5 5 +#endif + +#ifndef TWO + #define COUNT6 6 +#endif + +#ifndef THREE + #define COUNT7 7 +#endif + +#ifndef FOUR + #define COUNT8 8 +#endif + +main () + { + int a; + + a = COUNT1 + COUNT2 + COUNT3 + COUNT4 + COUNT5 + COUNT6 + COUNT7 + COUNT8; + if (a != 36) + goto Fail; + printf ("Passed Conformance Test 3.5.3.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 3.5.3.1\n"); + } diff --git a/Tests/Conformance/C3.5.4.1.CC b/Tests/Conformance/C3.5.4.1.CC old mode 100755 new mode 100644 index fe288b6..f996ba9 --- a/Tests/Conformance/C3.5.4.1.CC +++ b/Tests/Conformance/C3.5.4.1.CC @@ -1 +1,146 @@ -/* Conformance Test 3.5.4.1: Verification of #elif constant expressions */ #define FIVE 5 #define SIX 6 #if 0 #define NUM1 0 #elif 2 * 8 #define NUM1 2*8 #else #define NUM1 0 #endif #if 0 #define NUM2 0 #elif 4 / 3 #define NUM2 4/3 #endif #if 0 #define NUM3 0 #elif 209 - 8 #define NUM3 (209 - 8) #else #define NUM3 0 #endif #if 0 #define NUM4 0 #elif 32760 + 7 #define NUM4 ((32760) + (7)) #endif #if 0 #define NUM5 0 #elif (5 == 5) #define NUM5 5 == 5 #else #define NUM5 0 #endif #if 0 #define NUM6 0 #elif (2 != 0) #define NUM6 (2*8) | (4/3) ^ (209-208) & (32760+7) #else #define NUM6 0 #endif #if 0 #define NUM7 0 #elif (6 < 32767) #define NUM7 6 < 32767 #else #define NUM7 0 #endif #if 0 #define NUM8 0 #elif (20004 <= 20004) #define NUM8 (( 20004 <= 20004 )) #else #define NUM8 0 #endif #if 0 #define NUM9 0 #elif (59876 > 59875) #define NUM9 59876 > 59875 #endif #if 0 #define NUM10 0 #elif (671234 >= 671234) #define NUM10 671234 >= 671234 #else #define NUM10 0 #endif #if 0 #define NUM11 0 #elif ((2) && (3)) #define NUM11 2 && 3 #else #define NUM11 0 #endif #if 0 #define NUM12 0 #elif ((0) || (1)) #define NUM12 2147 % 3 << 3 >> 2 #else #define NUM12 0 #endif #if 0 #define NUM13 0 #elif (-32768) #define NUM13 (-(32768)) #else #define NUM13 0 #endif #if 0 #define NUM14 0 #elif ~0x7e #define NUM14 ~0x7E #else #define NUM14 0 #endif #if 0 #define NUM15 0 #elif !0 #define NUM15 NUM1 ? NUM2 : 187 #else #define NUM15 0 #endif main () { if ( ! ((FIVE == 5) && (1 == NUM10)) ) goto Fail; if (NUM1 != 16 ) goto Fail; if (NUM2 != 1 ) goto Fail; if (NUM3 != 201 ) goto Fail; if (NUM4 != 32767 ) goto Fail; if (NUM5 != 1 ) goto Fail; if (NUM6 != 0xB8 ) goto Fail; if (NUM7 != 1 ) goto Fail; if (NUM8 != 1 ) goto Fail; if (NUM9 != 1 ) goto Fail; if (NUM10 != 1 ) goto Fail; if (NUM11 != 1 ) goto Fail; if (NUM12 != 4 ) goto Fail; if (NUM13 != -32768) goto Fail; if (NUM14 != 0x81 ) goto Fail; if (NUM15 != 1 ) goto Fail; printf ("Passed Conformance Test 3.5.4.1\n"); return; Fail: printf ("Passed Conformance Test 3.5.4.1\n"); } \ No newline at end of file +/* Conformance Test 3.5.4.1: Verification of #elif constant expressions */ + +#define FIVE 5 +#define SIX 6 + +#if 0 + #define NUM1 0 +#elif 2 * 8 + #define NUM1 2*8 +#else + #define NUM1 0 +#endif + +#if 0 + #define NUM2 0 +#elif 4 / 3 + #define NUM2 4/3 +#endif + +#if 0 + #define NUM3 0 +#elif 209 - 8 + #define NUM3 (209 - 8) +#else + #define NUM3 0 +#endif + +#if 0 + #define NUM4 0 +#elif 32760 + 7 + #define NUM4 ((32760) + (7)) +#endif + +#if 0 + #define NUM5 0 +#elif (5 == 5) + #define NUM5 5 == 5 +#else + #define NUM5 0 +#endif + +#if 0 + #define NUM6 0 +#elif (2 != 0) + #define NUM6 (2*8) | (4/3) ^ (209-208) & (32760+7) +#else + #define NUM6 0 +#endif + +#if 0 + #define NUM7 0 +#elif (6 < 32767) + #define NUM7 6 < 32767 +#else + #define NUM7 0 +#endif + +#if 0 + #define NUM8 0 +#elif (20004 <= 20004) + #define NUM8 (( 20004 <= 20004 )) +#else + #define NUM8 0 +#endif + +#if 0 + #define NUM9 0 +#elif (59876 > 59875) + #define NUM9 59876 > 59875 +#endif + +#if 0 + #define NUM10 0 +#elif (671234 >= 671234) + #define NUM10 671234 >= 671234 +#else + #define NUM10 0 +#endif + +#if 0 + #define NUM11 0 +#elif ((2) && (3)) + #define NUM11 2 && 3 +#else + #define NUM11 0 +#endif + +#if 0 + #define NUM12 0 +#elif ((0) || (1)) + #define NUM12 2147 % 3 << 3 >> 2 +#else + #define NUM12 0 +#endif + +#if 0 + #define NUM13 0 +#elif (-32768) + #define NUM13 (-(32768)) +#else + #define NUM13 0 +#endif + +#if 0 + #define NUM14 0 +#elif ~0x7e + #define NUM14 ~0x7E +#else + #define NUM14 0 +#endif + +#if 0 + #define NUM15 0 +#elif !0 + #define NUM15 NUM1 ? NUM2 : 187 +#else + #define NUM15 0 +#endif + +main () + { + if ( ! ((FIVE == 5) && (1 == NUM10)) ) + goto Fail; + + if (NUM1 != 16 ) goto Fail; + if (NUM2 != 1 ) goto Fail; + if (NUM3 != 201 ) goto Fail; + if (NUM4 != 32767 ) goto Fail; + if (NUM5 != 1 ) goto Fail; + if (NUM6 != 0xB8 ) goto Fail; + if (NUM7 != 1 ) goto Fail; + if (NUM8 != 1 ) goto Fail; + if (NUM9 != 1 ) goto Fail; + if (NUM10 != 1 ) goto Fail; + if (NUM11 != 1 ) goto Fail; + if (NUM12 != 4 ) goto Fail; + if (NUM13 != -32768) goto Fail; + if (NUM14 != 0x81 ) goto Fail; + if (NUM15 != 1 ) goto Fail; + + printf ("Passed Conformance Test 3.5.4.1\n"); + return; + +Fail: + printf ("Passed Conformance Test 3.5.4.1\n"); + } diff --git a/Tests/Conformance/C3.5.4.2.CC b/Tests/Conformance/C3.5.4.2.CC old mode 100755 new mode 100644 index 8462c2b..db8bb87 --- a/Tests/Conformance/C3.5.4.2.CC +++ b/Tests/Conformance/C3.5.4.2.CC @@ -1 +1,161 @@ -/* Conformance Test 3.5.4.2: Verification of #elif character constant */ /* expressions */ #define FIVE '5' #define SIX '6' #if 0 #define NUM1 0 #elif '2' * '8' #define NUM1 '2' * '8' #else #define NUM1 0 #endif #if 0 #define NUM2 0 #elif '4' / '3' #define NUM2 '4' / '3' #else #define NUM2 0 #endif #if 0 #define NUM3 0 #elif 'b' - 'a' #define NUM3 'b' - 'a' #else #define NUM3 0 #endif #if 0 #define NUM4 0 #elif '\r' + '\f' #define NUM4 '\r' + '\f' #else #define NUM4 0 #endif #if 0 #define NUM5 0 #elif ('p' == '\x70') #define NUM5 (('\p') == '\x70') #else #define NUM5 0 #endif #if 0 #define NUM6 0 #elif ('\001' != 0) #define NUM6 ('2'*'8') | ('4'/'3') ^ ('A'-'b')\ & ('\r'+'\f') #else #define NUM6 0 #endif #if 0 #define NUM7 0 #elif ('6' < '7') #define NUM7 '6' < '7' #else #define NUM7 0 #endif #if 0 #define NUM8 0 #elif ('2' <= '2') #define NUM8 '2' <= '2' #else #define NUM8 0 #endif #if 0 #define NUM9 0 #elif ('8' > '7') #define NUM9 '8' > '7' #else #define NUM9 0 #endif #if 0 #define NUM10 0 #elif ('0' >= '0') #define NUM10 '0' >= '0' #else #define NUM10 0 #endif #if 0 #define NUM11 0 #elif (('\n') && ('\003')) #define NUM11 (('\n') && ('\003')) #else #define NUM11 0 #endif #if 0 #define NUM12 0 #elif ((0) || ('d')) #define NUM12 'z' % '0' << '\01' >> '\x2' #else #define NUM12 0 #endif #if 0 #define NUM13 0 #elif -('\x7f') #define NUM13 (-('\x7f')) #else #define NUM13 0 #endif #if 0 #define NUM14 0 #elif ~('\0') #define NUM14 ~'\0' #else #define NUM14 0 #endif #if 0 #define NUM15 0 #elif !0 #define NUM15 NUM1 ? NUM2 : 187 #else #define NUM15 0 #endif #if 0 #elif (defined(FIVE)) && (defined(SIX)) && (NUM1 == 0xAF0) && (NUM2 == 1)\ && (NUM3 == NUM2) main () { if (NUM1 != 2800 ) goto Fail; if (NUM2 != 1 ) goto Fail; if (NUM3 != 1 ) goto Fail; if (NUM4 != 25 ) goto Fail; if (NUM5 != 1 ) goto Fail; if ((NUM6) != 0xAF8 ) goto Fail; if (NUM7 != 1 ) goto Fail; if (NUM8 != 1 ) goto Fail; if (NUM9 != 1 ) goto Fail; if (NUM10 != 1 ) goto Fail; if (NUM11 != 1 ) goto Fail; if (NUM12 != 13 ) goto Fail; if (NUM13 != -127 ) goto Fail; if (NUM14 != -1 ) goto Fail; if ((NUM15) != 1 ) goto Fail; printf ("Passed Conformance Test 3.5.4.2\n"); return; Fail: printf ("Failed Conformance Test 3.5.4.2; location 1\n"); } #else main () { printf ("Failed Conformance Test 3.5.4.2; location 2\n"); } #endif \ No newline at end of file +/* Conformance Test 3.5.4.2: Verification of #elif character constant */ +/* expressions */ + +#define FIVE '5' +#define SIX '6' + +#if 0 + #define NUM1 0 +#elif '2' * '8' + #define NUM1 '2' * '8' +#else + #define NUM1 0 +#endif + +#if 0 + #define NUM2 0 +#elif '4' / '3' + #define NUM2 '4' / '3' +#else + #define NUM2 0 +#endif + +#if 0 + #define NUM3 0 +#elif 'b' - 'a' + #define NUM3 'b' - 'a' +#else + #define NUM3 0 +#endif + +#if 0 + #define NUM4 0 +#elif '\r' + '\f' + #define NUM4 '\r' + '\f' +#else + #define NUM4 0 +#endif + +#if 0 + #define NUM5 0 +#elif ('p' == '\x70') + #define NUM5 (('\p') == '\x70') +#else + #define NUM5 0 +#endif + +#if 0 + #define NUM6 0 +#elif ('\001' != 0) + #define NUM6 ('2'*'8') | ('4'/'3') ^ ('A'-'b')\ + & ('\r'+'\f') +#else + #define NUM6 0 +#endif + +#if 0 + #define NUM7 0 +#elif ('6' < '7') + #define NUM7 '6' < '7' +#else + #define NUM7 0 +#endif + +#if 0 + #define NUM8 0 +#elif ('2' <= '2') + #define NUM8 '2' <= '2' +#else + #define NUM8 0 +#endif + +#if 0 + #define NUM9 0 +#elif ('8' > '7') + #define NUM9 '8' > '7' +#else + #define NUM9 0 +#endif + +#if 0 + #define NUM10 0 +#elif ('0' >= '0') + #define NUM10 '0' >= '0' +#else + #define NUM10 0 +#endif + +#if 0 + #define NUM11 0 +#elif (('\n') && ('\003')) + #define NUM11 (('\n') && ('\003')) +#else + #define NUM11 0 +#endif + +#if 0 + #define NUM12 0 +#elif ((0) || ('d')) + #define NUM12 'z' % '0' << '\01' >> '\x2' +#else + #define NUM12 0 +#endif + +#if 0 + #define NUM13 0 +#elif -('\x7f') + #define NUM13 (-('\x7f')) +#else + #define NUM13 0 +#endif + +#if 0 + #define NUM14 0 +#elif ~('\0') + #define NUM14 ~'\0' +#else + #define NUM14 0 +#endif + +#if 0 + #define NUM15 0 +#elif !0 + #define NUM15 NUM1 ? NUM2 : 187 +#else + #define NUM15 0 +#endif + +#if 0 +#elif (defined(FIVE)) && (defined(SIX)) && (NUM1 == 0xAF0) && (NUM2 == 1)\ + && (NUM3 == NUM2) +main () + { + if (NUM1 != 2800 ) goto Fail; + if (NUM2 != 1 ) goto Fail; + if (NUM3 != 1 ) goto Fail; + if (NUM4 != 25 ) goto Fail; + if (NUM5 != 1 ) goto Fail; + if ((NUM6) != 0xAF8 ) goto Fail; + if (NUM7 != 1 ) goto Fail; + if (NUM8 != 1 ) goto Fail; + if (NUM9 != 1 ) goto Fail; + if (NUM10 != 1 ) goto Fail; + if (NUM11 != 1 ) goto Fail; + if (NUM12 != 13 ) goto Fail; + if (NUM13 != -127 ) goto Fail; + if (NUM14 != -1 ) goto Fail; + if ((NUM15) != 1 ) goto Fail; + + printf ("Passed Conformance Test 3.5.4.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 3.5.4.2; location 1\n"); + } + +#else +main () + { + printf ("Failed Conformance Test 3.5.4.2; location 2\n"); + } +#endif diff --git a/Tests/Conformance/C4.2.1.1.CC b/Tests/Conformance/C4.2.1.1.CC old mode 100755 new mode 100644 index 5f680c0..0b6aa95 --- a/Tests/Conformance/C4.2.1.1.CC +++ b/Tests/Conformance/C4.2.1.1.CC @@ -1 +1,120 @@ -/* Conformance Test 4.2.1.1: Test scoping of identifiers */ /* Global declarations of all different identifier types in C. */ /* Each identifier should be available through the end of the source file. */ #include #define MAC_NAME1 10 /* macro name */ typedef int *intPtr; /* user-defined type */ char F1 (int x, int y); /* function name */ int i; /* variable */ struct ComplexNum { float real; /* type tag name */ float imag; }; /* and struct fields */ union LongOrShort { long longNum; /* type tag name */ int shortNum; }; /* and union fields */ enum flowers { rose, iris, carnation }; /* type tag name */ /* and enum const */ main () { char ch; int m; intPtr k; struct ComplexNum c, d; union LongOrShort z; enum flowers f; m = 3; k = &m; if (*k != 3) goto Fail; c.real = 5.1; c.imag = 2.0; d = c; if ((fabs(d.real - 5.1) > 0.00001) || (fabs(d.imag - 2.0) > 0.00001)) goto Fail; z.longNum = 5; if (z.shortNum != 5) /* don't ever do this in real life! */ goto Fail; f = carnation; if (f != 2) goto Fail; i = MAC_NAME1; if (i != 10) goto Fail; ch = F1 (3, i); if (ch != '\r') goto Fail; printf ("Passed Conformance Test 4.2.1.1\n"); return; printf ("This code can never be reached !!!\n"); Fail: printf ("Failed Conformance Test 4.2.1.1\n"); return; printf ("Nor can this code ever be reached !!!\n"); } /****************************************************************************/ char F1 (int x, int y) { int m; intPtr k; struct ComplexNum c, *d; union LongOrShort z; enum flowers f; m = 5; k = &m; if (*k != 5) goto Err1; c.real = 18.7; c.imag = 23.5; d = &c; if ((fabs(d->real - 18.7) > 0.00001) || (fabs(d->imag - 23.5) > 0.00001)) goto Err2; z.longNum = 0x7FE5; if (z.shortNum != 0x7fe5) /* don't ever do this in real life! */ goto Err3; #define MAC_NAME2 11 f = iris; if (f != 1) goto Fail; i = MAC_NAME2; if (i != 11) goto Fail; return (x + y); Err1: return (1); Err2: return (2); Err3: return (3); Fail: return (4); } \ No newline at end of file +/* Conformance Test 4.2.1.1: Test scoping of identifiers */ + +/* Global declarations of all different identifier types in C. */ +/* Each identifier should be available through the end of the source file. */ + +#include + +#define MAC_NAME1 10 /* macro name */ + +typedef int *intPtr; /* user-defined type */ +char F1 (int x, int y); /* function name */ + + int i; /* variable */ + +struct ComplexNum { float real; /* type tag name */ + float imag; }; /* and struct fields */ + +union LongOrShort { long longNum; /* type tag name */ + int shortNum; }; /* and union fields */ + +enum flowers { rose, iris, carnation }; /* type tag name */ + /* and enum const */ + +main () + { + char ch; + int m; + intPtr k; + struct ComplexNum c, d; + union LongOrShort z; + enum flowers f; + + m = 3; + k = &m; + if (*k != 3) + goto Fail; + + c.real = 5.1; + c.imag = 2.0; + d = c; + if ((fabs(d.real - 5.1) > 0.00001) || (fabs(d.imag - 2.0) > 0.00001)) + goto Fail; + + z.longNum = 5; + if (z.shortNum != 5) /* don't ever do this in real life! */ + goto Fail; + + f = carnation; + if (f != 2) + goto Fail; + + i = MAC_NAME1; + if (i != 10) + goto Fail; + + ch = F1 (3, i); + if (ch != '\r') + goto Fail; + + printf ("Passed Conformance Test 4.2.1.1\n"); + return; + + printf ("This code can never be reached !!!\n"); + +Fail: + printf ("Failed Conformance Test 4.2.1.1\n"); + return; + + printf ("Nor can this code ever be reached !!!\n"); + } + +/****************************************************************************/ + +char F1 (int x, int y) + { + int m; + intPtr k; + struct ComplexNum c, *d; + union LongOrShort z; + enum flowers f; + + m = 5; + k = &m; + if (*k != 5) + goto Err1; + + c.real = 18.7; + c.imag = 23.5; + d = &c; + if ((fabs(d->real - 18.7) > 0.00001) || (fabs(d->imag - 23.5) > 0.00001)) + goto Err2; + + z.longNum = 0x7FE5; + if (z.shortNum != 0x7fe5) /* don't ever do this in real life! */ + goto Err3; + + #define MAC_NAME2 11 + + f = iris; + if (f != 1) + goto Fail; + + i = MAC_NAME2; + if (i != 11) + goto Fail; + + return (x + y); + +Err1: + return (1); + +Err2: + return (2); + +Err3: + return (3); + +Fail: + return (4); + } diff --git a/Tests/Conformance/C4.2.2.1.CC b/Tests/Conformance/C4.2.2.1.CC old mode 100755 new mode 100644 index ffb25d8..1ff2858 --- a/Tests/Conformance/C4.2.2.1.CC +++ b/Tests/Conformance/C4.2.2.1.CC @@ -1 +1,123 @@ -/* Conformance Test 4.2.2.1: Verify correct identifier "hiding" */ /* Global declarations of all different identifier types in C. */ #include typedef int *numPtr; /* user-defined type */ float f; /* variables */ double ch; struct aRecord { int value1; /* type tag name */ int value2; }; /* and struct fields */ union variantRec { long longNum; /* type tag name */ int shortNum; }; /* and union fields */ enum flowers { rose, iris, carnation }; /* type tag name */ /* and enum const */ int DoubleCheck (void); /* function names */ /******************************************************************************/ int i (char ch) { return ch; } /******************************************************************************/ main () { int i; typedef float *numPtr; /* redefine the global types */ numPtr f; struct variantRec { long longNum; int shortNum; }; enum aRecord { rec1, rec2, rec3 }; union flowers { int x; long y; }; struct variantRec r1, *r2; enum aRecord x, y; union flowers longNum, Rose; float fp; ch = 6.0; if (fabs(ch - 6.0) > 0.00001) goto Fail; fp = 3.1; f = &fp; if (fabs(*f - 3.1) > 0.00001) goto Fail; r1.longNum = 10; r1.shortNum = 12; r2 = &r1; if ((r2->longNum != 10) || (r2->shortNum != 12)) goto Fail; x = rec1; y = rec3; if ((x != 0) || (y != 2)) goto Fail; longNum.x = 89; longNum.y = 101; Rose = longNum; if (Rose.y != 101) goto Fail; i = DoubleCheck(); if (i != 0) goto Fail; printf ("Passed Conformance Test 4.2.2.1\n"); return; Fail: printf ("Failed Conformance Test 4.2.2.1\n"); } /******************************************************************************/ int DoubleCheck (void) { numPtr k; int f; struct aRecord R1, *R2; union variantRec value1, value2; enum flowers dahlia; f = i ('a'); if (f != 0x61) goto Fail; f = 45; k = &f; if (*k != 45) goto Fail; R2 = &R1; R2->value1 = 18; (*R2).value2 = 27; if ((R1.value1 != 18) || (R1.value2 != 27)) goto Fail; value1.shortNum = 111; value2 = value1; if (value2.shortNum != 111) goto Fail; dahlia = carnation; if (dahlia != 2) goto Fail; return 0; Fail: return 211; } \ No newline at end of file +/* Conformance Test 4.2.2.1: Verify correct identifier "hiding" */ + +/* Global declarations of all different identifier types in C. */ + +#include + +typedef int *numPtr; /* user-defined type */ + +float f; /* variables */ +double ch; + +struct aRecord { int value1; /* type tag name */ + int value2; }; /* and struct fields */ + +union variantRec { long longNum; /* type tag name */ + int shortNum; }; /* and union fields */ + +enum flowers { rose, iris, carnation }; /* type tag name */ + /* and enum const */ + +int DoubleCheck (void); /* function names */ + +/******************************************************************************/ + +int i (char ch) + { + return ch; + } + +/******************************************************************************/ + +main () + { + int i; + typedef float *numPtr; /* redefine the global types */ + numPtr f; + struct variantRec { long longNum; + int shortNum; }; + enum aRecord { rec1, rec2, rec3 }; + union flowers { int x; + long y; }; + struct variantRec r1, *r2; + enum aRecord x, y; + union flowers longNum, Rose; + float fp; + + ch = 6.0; + if (fabs(ch - 6.0) > 0.00001) + goto Fail; + + fp = 3.1; + f = &fp; + if (fabs(*f - 3.1) > 0.00001) + goto Fail; + + r1.longNum = 10; + r1.shortNum = 12; + r2 = &r1; + if ((r2->longNum != 10) || (r2->shortNum != 12)) + goto Fail; + + x = rec1; + y = rec3; + if ((x != 0) || (y != 2)) + goto Fail; + + longNum.x = 89; + longNum.y = 101; + Rose = longNum; + if (Rose.y != 101) + goto Fail; + + i = DoubleCheck(); + if (i != 0) + goto Fail; + + printf ("Passed Conformance Test 4.2.2.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 4.2.2.1\n"); + } + +/******************************************************************************/ + +int DoubleCheck (void) + { + numPtr k; + int f; + + struct aRecord R1, *R2; + union variantRec value1, value2; + enum flowers dahlia; + + f = i ('a'); + if (f != 0x61) + goto Fail; + + f = 45; + k = &f; + if (*k != 45) + goto Fail; + + R2 = &R1; + R2->value1 = 18; + (*R2).value2 = 27; + if ((R1.value1 != 18) || (R1.value2 != 27)) + goto Fail; + + value1.shortNum = 111; + value2 = value1; + if (value2.shortNum != 111) + goto Fail; + + dahlia = carnation; + if (dahlia != 2) + goto Fail; + + return 0; + +Fail: + return 211; + } diff --git a/Tests/Conformance/C4.2.4.1.CC b/Tests/Conformance/C4.2.4.1.CC old mode 100755 new mode 100644 index 8066103..39468cd --- a/Tests/Conformance/C4.2.4.1.CC +++ b/Tests/Conformance/C4.2.4.1.CC @@ -1 +1,123 @@ -/* Conformance Test 4.2.4.1: Ensure the same names in different overloading */ /* classes are allowed */ struct rect { int h1; /* struct, union, enum type tags */ int v1; /* struct/union components */ int h2; int v2; }; union longOrShort { int first; long second; }; enum repeats { h1, v1, h2, v2, first, second }; /* all others: variables, */ /* functions, typedefs, */ /* enumeration constants*/ main () { int rect; /* can give variables same */ double longOrShort; /* names as labels, tags,*/ float repeats; /* or components */ int label [10]; union longOrShort first; enum repeats r; enum colors { red, black, green }; struct person { char name [20]; char address [50]; }; union floatOrDouble { float red; double green; }; int Label2 (void); /* can give functions same */ char person (int i); /* names as labels, tags,*/ float name (void); /* or components */ typedef int Label3; /* can give typedefs same */ typedef struct person floatOrDouble; /* names as labels, tags,*/ typedef short colors; /* or components */ typedef float address; Label3 i; floatOrDouble x; colors j; address z; rect = 8; if (rect != 8) goto label; longOrShort = 3.5; if (longOrShort != 3.5) goto Label3; repeats = (float) 2; if (repeats != 2.0) goto label; for (i = 0; i < 10; i++) label [i] = i; for (i = 9; i >= 0; i--) if (label [i] != i) goto label; first.first = 10; if (first.first != (9+1)) goto Label2; r = second; if (r != 5) goto Label2; strcpy (x.name, "Barbara"); if ((strcmp (x.name, "Barbara")) != 0) goto label; j = (int) person (6); if (j != 0x36) goto Label2; j = Label2 (); if (j != 5) goto Label2; z = name (); if (z != 1.0) goto label; printf ("Passed Conformance Test 4.2.4.1\n"); return; label: ; Label2: ; Label3: printf ("Failed Conformance Test 4.2.4.1\n"); } /******************************************************************************/ int Label2 (void) { return 5; } /******************************************************************************/ char person (int i) { return (i + 0x30); } /******************************************************************************/ float name (void) { return 1.0; } \ No newline at end of file +/* Conformance Test 4.2.4.1: Ensure the same names in different overloading */ +/* classes are allowed */ + +struct rect { int h1; /* struct, union, enum type tags */ + int v1; /* struct/union components */ + int h2; + int v2; }; + +union longOrShort { int first; + long second; }; + +enum repeats { h1, v1, h2, v2, first, second }; /* all others: variables, */ + /* functions, typedefs, */ + /* enumeration constants*/ + +main () + { + int rect; /* can give variables same */ + double longOrShort; /* names as labels, tags,*/ + float repeats; /* or components */ + int label [10]; + union longOrShort first; + enum repeats r; + + enum colors { red, black, green }; + + struct person { char name [20]; + char address [50]; }; + + union floatOrDouble { float red; + double green; }; + + int Label2 (void); /* can give functions same */ + char person (int i); /* names as labels, tags,*/ + float name (void); /* or components */ + + typedef int Label3; /* can give typedefs same */ + typedef struct person floatOrDouble; /* names as labels, tags,*/ + typedef short colors; /* or components */ + typedef float address; + + Label3 i; + floatOrDouble x; + colors j; + address z; + + rect = 8; + if (rect != 8) + goto label; + + longOrShort = 3.5; + if (longOrShort != 3.5) + goto Label3; + + repeats = (float) 2; + if (repeats != 2.0) + goto label; + + for (i = 0; i < 10; i++) + label [i] = i; + + for (i = 9; i >= 0; i--) + if (label [i] != i) + goto label; + + first.first = 10; + if (first.first != (9+1)) + goto Label2; + + r = second; + if (r != 5) + goto Label2; + + strcpy (x.name, "Barbara"); + if ((strcmp (x.name, "Barbara")) != 0) + goto label; + + j = (int) person (6); + if (j != 0x36) + goto Label2; + + j = Label2 (); + if (j != 5) + goto Label2; + + z = name (); + if (z != 1.0) + goto label; + + printf ("Passed Conformance Test 4.2.4.1\n"); + return; + +label: ; +Label2: ; +Label3: + printf ("Failed Conformance Test 4.2.4.1\n"); + } + +/******************************************************************************/ + +int Label2 (void) + + { + return 5; + } + + +/******************************************************************************/ + +char person (int i) + + { + return (i + 0x30); + } + + +/******************************************************************************/ + +float name (void) + + { + return 1.0; + } diff --git a/Tests/Conformance/C4.2.5.1.CC b/Tests/Conformance/C4.2.5.1.CC old mode 100755 new mode 100644 index 6b9ca69..1ea5870 --- a/Tests/Conformance/C4.2.5.1.CC +++ b/Tests/Conformance/C4.2.5.1.CC @@ -1 +1,46 @@ -/* Conformance Test 4.2.5.1: Verification of duplicate extern references */ int a; extern float F1 (int x, int y); main () { extern int a; extern float F1 (int x, int y); float x; extern extended G1 (void); a = (int) F1 (2, 3); if (a != 5) goto Fail; x = (float) G1 (); if (x != 10.0) goto Fail; printf ("Passed Conformance Test 4.2.5.1\n"); return; Fail: printf ("Failed Conformance Test 4.2.5.1\n"); } /*****************************************************************************/ extended G1 (void) { extern float F1 (int x, int y); extern int a; return (F1 (a, 5)); } /*****************************************************************************/ float F1 (int x, int y) { extern extended G1 (void); extern int a; return (float) (x + y); } \ No newline at end of file +/* Conformance Test 4.2.5.1: Verification of duplicate extern references */ + +int a; +extern float F1 (int x, int y); + +main () + { + extern int a; + extern float F1 (int x, int y); + float x; + extern extended G1 (void); + + a = (int) F1 (2, 3); + if (a != 5) + goto Fail; + + x = (float) G1 (); + if (x != 10.0) + goto Fail; + + printf ("Passed Conformance Test 4.2.5.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 4.2.5.1\n"); + } + +/*****************************************************************************/ + +extended G1 (void) + { + extern float F1 (int x, int y); + extern int a; + + return (F1 (a, 5)); + } + +/*****************************************************************************/ + +float F1 (int x, int y) + { + extern extended G1 (void); + extern int a; + + return (float) (x + y); + } diff --git a/Tests/Conformance/C4.3.0.1.CC b/Tests/Conformance/C4.3.0.1.CC old mode 100755 new mode 100644 index cccae3b..a94fd36 --- a/Tests/Conformance/C4.3.0.1.CC +++ b/Tests/Conformance/C4.3.0.1.CC @@ -1 +1,96 @@ -/* Conformance Test 4.3.0.1: Verification of auto, register, and static */ /* storage classes */ static long L1 (register int a1, float x1); /* test forward referencing */ /* at top level */ static extended ext = 3.678; /* ensure static variables */ static int j = 2; /* initialized correctly */ static int i; /* should automatically be */ /* set to zero */ main () { static void V1 (void); /* test forward referencing within */ /* function */ long LL = 3; if (ext != 3.678) goto Fail; { auto i = 10; /* this i hides top-level i */ for (; i < 15; i++) { V1 (); switch (i) { case 10: if (j != 3) goto Fail; break; case 11: if (j != 4) goto Fail; break; case 12: if (j != 5) goto Fail; break; case 13: if (j != 6) goto Fail; break; case 14: if (j != 7) goto Fail; break; default: goto Fail; break; } /* end switch */ } /* end for */ } /* end inner block */ if (i != 5) /* top-level i */ goto Fail; for (i = 0; i < 7; i++) /* L0 should be init. to 10 with each */ { /* pass through the for loop; F0 */ auto int L0 = 10; /* should be initialized once */ static float F0 = 1.0; LL = L1 (L0, F0); if (LL) goto Fail; F0 += 1.0; if (F0 == 3.0) break; } if (i != 1) /* test that F0 was not reset */ goto Fail; printf ("Passed Conformance Test 4.3.0.1\n"); return; Fail: printf ("Failed Conformance Test 4.3.0.1\n"); } /******************************************************************************/ static long L1 (register int a1, float x1) /* ensure classification as */ { /* register doesn't affect */ /* value of parameter */ if (a1 != 10) /* a1 should be 10 each time called */ return 1; else return 0; } /******************************************************************************/ static void V1 (void) { ++i; j++; /* ensure i, j are visible */ } \ No newline at end of file +/* Conformance Test 4.3.0.1: Verification of auto, register, and static */ +/* storage classes */ + +static long L1 (register int a1, float x1); /* test forward referencing */ + /* at top level */ + +static extended ext = 3.678; /* ensure static variables */ +static int j = 2; /* initialized correctly */ +static int i; /* should automatically be */ + /* set to zero */ + +main () + { + static void V1 (void); /* test forward referencing within */ + /* function */ + long LL = 3; + + if (ext != 3.678) + goto Fail; + + { + auto i = 10; /* this i hides top-level i */ + for (; i < 15; i++) + { + V1 (); + switch (i) + { + case 10: if (j != 3) + goto Fail; + break; + + case 11: if (j != 4) + goto Fail; + break; + + case 12: if (j != 5) + goto Fail; + break; + + case 13: if (j != 6) + goto Fail; + break; + + case 14: if (j != 7) + goto Fail; + break; + + default: goto Fail; + break; + + } /* end switch */ + } /* end for */ + } /* end inner block */ + + if (i != 5) /* top-level i */ + goto Fail; + + for (i = 0; i < 7; i++) /* L0 should be init. to 10 with each */ + { /* pass through the for loop; F0 */ + auto int L0 = 10; /* should be initialized once */ + static float F0 = 1.0; + + LL = L1 (L0, F0); + if (LL) + goto Fail; + F0 += 1.0; + if (F0 == 3.0) + break; + } + if (i != 1) /* test that F0 was not reset */ + goto Fail; + + printf ("Passed Conformance Test 4.3.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 4.3.0.1\n"); + } + +/******************************************************************************/ + +static long L1 (register int a1, float x1) /* ensure classification as */ + { /* register doesn't affect */ + /* value of parameter */ + if (a1 != 10) /* a1 should be 10 each time called */ + return 1; + else + return 0; + } + +/******************************************************************************/ + +static void V1 (void) + { + ++i; j++; /* ensure i, j are visible */ + } diff --git a/Tests/Conformance/C4.3.0.2.CC b/Tests/Conformance/C4.3.0.2.CC old mode 100755 new mode 100644 index 6d40b52..9030f8b --- a/Tests/Conformance/C4.3.0.2.CC +++ b/Tests/Conformance/C4.3.0.2.CC @@ -1 +1,60 @@ -/* Conformance Test 4.3.0.2: Check uniqueness of static variables */ static int var; int sub1(void) { static int var; var = 2; { static int var; var = 3; if (var != 3) return 1; } if (var != 2) return 1; return 0; } int sub2(void) { static int var; var = 2; { static int var; var = 3; if (var != 3) return 1; } if (var != 2) return 1; return 0; } void main (void) { var = 1; if (sub1()) goto Fail; if (sub2()) goto Fail; if (var != 1) goto Fail; printf ("Passed Conformance Test 4.3.0.2\n"); return; Fail: printf ("Failed Conformance Test 4.3.0.2\n"); } \ No newline at end of file +/* Conformance Test 4.3.0.2: Check uniqueness of static variables */ + +static int var; + +int sub1(void) + +{ +static int var; + +var = 2; + + { + static int var; + + var = 3; + if (var != 3) + return 1; + } + +if (var != 2) + return 1; +return 0; +} + + +int sub2(void) + +{ +static int var; + +var = 2; + + { + static int var; + + var = 3; + if (var != 3) + return 1; + } + +if (var != 2) + return 1; +return 0; +} + + +void main (void) + +{ +var = 1; + +if (sub1()) goto Fail; +if (sub2()) goto Fail; +if (var != 1) goto Fail; + +printf ("Passed Conformance Test 4.3.0.2\n"); +return; + +Fail: printf ("Failed Conformance Test 4.3.0.2\n"); +} diff --git a/Tests/Conformance/C4.4.2.1.CC b/Tests/Conformance/C4.4.2.1.CC old mode 100755 new mode 100644 index ef8e30c..dcd4004 --- a/Tests/Conformance/C4.4.2.1.CC +++ b/Tests/Conformance/C4.4.2.1.CC @@ -1 +1,19 @@ -/* Conformance Test 4.4.2.1: Ensure compile accepts missing declarators */ struct {int a; /* can't use it, but it's legal */ float x;}; int ; /* nothing declared, but it's legal */ static enum E {a, b, c}; /* storage class ignored */ main () { struct {double d; short s;}; extended; extern union U {int i; long l;}; printf ("Passed Conformance Test 4.4.2.1\n"); } \ No newline at end of file +/* Conformance Test 4.4.2.1: Ensure compile accepts missing declarators */ + +struct {int a; /* can't use it, but it's legal */ + float x;}; + +int ; /* nothing declared, but it's legal */ + +static enum E {a, b, c}; /* storage class ignored */ + +main () + { + struct {double d; + short s;}; + extended; + extern union U {int i; + long l;}; + + printf ("Passed Conformance Test 4.4.2.1\n"); + } diff --git a/Tests/Conformance/C4.5.2.1.CC b/Tests/Conformance/C4.5.2.1.CC old mode 100755 new mode 100644 index 4b3b409..8c75e90 --- a/Tests/Conformance/C4.5.2.1.CC +++ b/Tests/Conformance/C4.5.2.1.CC @@ -1 +1,103 @@ -/* Conformance Test 4.5.2.1: Verification of pointer declarators for local */ /* data */ #include main () { int *intPtr, i; /* pointers to all the basic types */ long *longPtr, L; unsigned int *uintPtr, ui; unsigned long *ulongPtr, ulong; comp *compPtr, cmp; char *charPtr, ch; float *floatPtr, fl; double *doublePtr, dbl; extended *extPtr, ext; /* pointers to conglomerate types */ struct s { int a; long L; } *structPtr, s; enum colors { red, black, green } *colorPtr, color; union longOrShort { int first; long second; } *unionPtr, un; intPtr = &i; i = 3; if (*intPtr != 3) goto Fail; longPtr = &L; L = 32769; if (*longPtr != 32769) goto Fail; uintPtr = &ui; ui = 65535; if (*uintPtr != 65535) goto Fail; ulongPtr = &ulong; ulong = 4294967295ul; if (*ulongPtr != 4294967295ul) goto Fail; compPtr = &cmp; cmp = 4294967295ul; if (*compPtr != 4294967295ul) goto Fail; charPtr = &ch; ch = 'A'; if (*charPtr != 'A') goto Fail; floatPtr = &fl; fl = 123.456; if (fabs(*floatPtr - 123.456) > 0.00001) goto Fail; doublePtr = &dbl; dbl = 0.0; if (*doublePtr != 0.0) goto Fail; extPtr = &ext; ext = 12.3e20; if (*extPtr != 123.0E19) goto Fail; structPtr = &s; s.a = 32767; s.L = 2147483647; if ((structPtr->L != 2147483647) || (structPtr->a != 32767)) goto Fail; intPtr = &(s.a); if (*intPtr != 32767) goto Fail; longPtr = &(s.L); if (*longPtr != 2147483647) goto Fail; colorPtr = &color; color = black; if (*colorPtr != black) goto Fail; unionPtr = &un; un.first = 12; if (unionPtr->first != 12) goto Fail; un.second = 2147483646; if (unionPtr->second != 2147483646) goto Fail; printf ("Passed Conformance Test 4.5.2.1\n"); return; Fail: printf ("Failed Conformance Test 4.5.2.1\n"); } \ No newline at end of file +/* Conformance Test 4.5.2.1: Verification of pointer declarators for local */ +/* data */ + +#include + +main () + { + int *intPtr, i; /* pointers to all the basic types */ + long *longPtr, L; + unsigned int *uintPtr, ui; + unsigned long *ulongPtr, ulong; + comp *compPtr, cmp; + char *charPtr, ch; + float *floatPtr, fl; + double *doublePtr, dbl; + extended *extPtr, ext; + + /* pointers to conglomerate types */ + + struct s { int a; + long L; } *structPtr, s; + enum colors { red, black, green } *colorPtr, color; + union longOrShort { int first; + long second; } *unionPtr, un; + + intPtr = &i; + i = 3; + if (*intPtr != 3) + goto Fail; + + longPtr = &L; + L = 32769; + if (*longPtr != 32769) + goto Fail; + + uintPtr = &ui; + ui = 65535; + if (*uintPtr != 65535) + goto Fail; + + ulongPtr = &ulong; + ulong = 4294967295ul; + if (*ulongPtr != 4294967295ul) + goto Fail; + + compPtr = &cmp; + cmp = 4294967295ul; + if (*compPtr != 4294967295ul) + goto Fail; + + charPtr = &ch; + ch = 'A'; + if (*charPtr != 'A') + goto Fail; + + floatPtr = &fl; + fl = 123.456; + if (fabs(*floatPtr - 123.456) > 0.00001) + goto Fail; + + doublePtr = &dbl; + dbl = 0.0; + if (*doublePtr != 0.0) + goto Fail; + + extPtr = &ext; + ext = 12.3e20; + if (*extPtr != 123.0E19) + goto Fail; + + structPtr = &s; + s.a = 32767; + s.L = 2147483647; + if ((structPtr->L != 2147483647) || (structPtr->a != 32767)) + goto Fail; + + intPtr = &(s.a); + if (*intPtr != 32767) + goto Fail; + + longPtr = &(s.L); + if (*longPtr != 2147483647) + goto Fail; + + colorPtr = &color; + color = black; + if (*colorPtr != black) + goto Fail; + + unionPtr = &un; + un.first = 12; + if (unionPtr->first != 12) + goto Fail; + un.second = 2147483646; + if (unionPtr->second != 2147483646) + goto Fail; + + printf ("Passed Conformance Test 4.5.2.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 4.5.2.1\n"); + } diff --git a/Tests/Conformance/C4.5.2.2.CC b/Tests/Conformance/C4.5.2.2.CC old mode 100755 new mode 100644 index 26c7a41..011cfe5 --- a/Tests/Conformance/C4.5.2.2.CC +++ b/Tests/Conformance/C4.5.2.2.CC @@ -1 +1,141 @@ -/* Conformance Test 4.5.2.2: Verification of pointer declarators for local */ /* data using the typedef storage class */ #include main () { /* pointers to all the basic types */ typedef int *intPtr; intPtr iPtr; int i; typedef long *longPtr; longPtr lPtr; long L; typedef unsigned int *uintPtr; uintPtr uiPtr; unsigned int ui; typedef unsigned long *ulongPtr; ulongPtr ulPtr; unsigned long ulong; typedef comp *compPtr; compPtr cmpPtr; comp cmp; typedef char *charPtr; charPtr chPtr; char ch; typedef float *floatPtr; floatPtr flPtr; float fl; typedef double *doublePtr; doublePtr dblPtr; double dbl; typedef extended *extPtr; extPtr ePtr; extended ext; /* pointers to conglomerate types */ struct s { int a; long L; }; typedef struct s *structPtr; structPtr sPtr; struct s s; enum colors { red, black, green }; typedef enum colors *colorPtr; colorPtr colPtr; enum colors color; union longOrShort { int first; long second; }; typedef union longOrShort *unionPtr; unionPtr unPtr; union longOrShort un; iPtr = &i; i = 3; if (*iPtr != 3) goto Fail; lPtr = &L; L = 32769; if (*lPtr != 32769) goto Fail; uiPtr = &ui; ui = 65535; if (*uiPtr != 65535) goto Fail; ulPtr = &ulong; ulong = 4294967295ul; if (*ulPtr != 4294967295ul) goto Fail; cmpPtr = &cmp; cmp = 4294967295ul; if (*cmpPtr != 4294967295ul) goto Fail; chPtr = &ch; ch = 'A'; if (*chPtr != 'A') goto Fail; flPtr = &fl; fl = 123.456; if (fabs(*flPtr - 123.456) > 0.00001) goto Fail; dblPtr = &dbl; dbl = 0.0; if (*dblPtr != 0.0) goto Fail; ePtr = &ext; ext = 12.3e20; if (fabs(*ePtr - 123.0E19) >0.00001) goto Fail; sPtr = &s; s.a = 32767; s.L = 2147483647; if ((sPtr->L != 2147483647) || (sPtr->a != 32767)) goto Fail; iPtr = &(s.a); if (*iPtr != 32767) goto Fail; lPtr = &(s.L); if (*lPtr != 2147483647) goto Fail; colPtr = &color; color = black; if (*colPtr != black) goto Fail; unPtr = &un; un.first = 12; if (unPtr->first != 12) goto Fail; un.second = 2147483646; if (unPtr->second != 2147483646) goto Fail; printf ("Passed Conformance Test 4.5.2.2\n"); return; Fail: printf ("Failed Conformance Test 4.5.2.2\n"); } \ No newline at end of file +/* Conformance Test 4.5.2.2: Verification of pointer declarators for local */ +/* data using the typedef storage class */ + +#include + +main () + { + /* pointers to all the basic types */ + typedef int *intPtr; + intPtr iPtr; + int i; + + typedef long *longPtr; + longPtr lPtr; + long L; + + typedef unsigned int *uintPtr; + uintPtr uiPtr; + unsigned int ui; + + typedef unsigned long *ulongPtr; + ulongPtr ulPtr; + unsigned long ulong; + + typedef comp *compPtr; + compPtr cmpPtr; + comp cmp; + + typedef char *charPtr; + charPtr chPtr; + char ch; + + typedef float *floatPtr; + floatPtr flPtr; + float fl; + + typedef double *doublePtr; + doublePtr dblPtr; + double dbl; + + typedef extended *extPtr; + extPtr ePtr; + extended ext; + + /* pointers to conglomerate types */ + + struct s { int a; + long L; }; + typedef struct s *structPtr; + structPtr sPtr; + struct s s; + + enum colors { red, black, green }; + typedef enum colors *colorPtr; + colorPtr colPtr; + enum colors color; + + union longOrShort { int first; + long second; }; + typedef union longOrShort *unionPtr; + unionPtr unPtr; + union longOrShort un; + + iPtr = &i; + i = 3; + if (*iPtr != 3) + goto Fail; + + lPtr = &L; + L = 32769; + if (*lPtr != 32769) + goto Fail; + + uiPtr = &ui; + ui = 65535; + if (*uiPtr != 65535) + goto Fail; + + ulPtr = &ulong; + ulong = 4294967295ul; + if (*ulPtr != 4294967295ul) + goto Fail; + + cmpPtr = &cmp; + cmp = 4294967295ul; + if (*cmpPtr != 4294967295ul) + goto Fail; + + chPtr = &ch; + ch = 'A'; + if (*chPtr != 'A') + goto Fail; + + flPtr = &fl; + fl = 123.456; + if (fabs(*flPtr - 123.456) > 0.00001) + goto Fail; + + dblPtr = &dbl; + dbl = 0.0; + if (*dblPtr != 0.0) + goto Fail; + + ePtr = &ext; + ext = 12.3e20; + if (fabs(*ePtr - 123.0E19) >0.00001) + goto Fail; + + sPtr = &s; + s.a = 32767; + s.L = 2147483647; + if ((sPtr->L != 2147483647) || (sPtr->a != 32767)) + goto Fail; + + iPtr = &(s.a); + if (*iPtr != 32767) + goto Fail; + + lPtr = &(s.L); + if (*lPtr != 2147483647) + goto Fail; + + colPtr = &color; + color = black; + if (*colPtr != black) + goto Fail; + + unPtr = &un; + un.first = 12; + if (unPtr->first != 12) + goto Fail; + un.second = 2147483646; + if (unPtr->second != 2147483646) + goto Fail; + + printf ("Passed Conformance Test 4.5.2.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 4.5.2.2\n"); + } diff --git a/Tests/Conformance/C4.5.2.3.CC b/Tests/Conformance/C4.5.2.3.CC old mode 100755 new mode 100644 index ad02074..2935d3f --- a/Tests/Conformance/C4.5.2.3.CC +++ b/Tests/Conformance/C4.5.2.3.CC @@ -1 +1,113 @@ -/* Conformance Test 4.5.2.3: Verification of pointer declarators for static */ /* data */ #include /* pointers to all the basic types */ static int *intPtr, i; static long *longPtr, L; static unsigned int *uintPtr, ui; static unsigned long *ulongPtr, ulong; static comp *compPtr, cmp; static char *charPtr, ch; static float *floatPtr, fl; static double *doublePtr, dbl; static extended *extPtr, ext; /* pointers to conglomerate types */ static struct s { int a; long L; } *structPtr, s; static enum colors { red, black, green } *colorPtr, color; static union longOrShort { int first; long second; } *unionPtr, un; main () { void F1 (void); F1(); } /******************************************************************************/ void F1 (void) { intPtr = &i; i = 3; if (*intPtr != 3) goto Fail; longPtr = &L; L = 32769; if (*longPtr != 32769) goto Fail; uintPtr = &ui; ui = 65535; if (*uintPtr != 65535) goto Fail; ulongPtr = &ulong; ulong = 4294967295ul; if (*ulongPtr != 4294967295ul) goto Fail; compPtr = &cmp; cmp = 4294967295ul; if (*compPtr != 4294967295ul) goto Fail; charPtr = &ch; ch = 'A'; if (*charPtr != 'A') goto Fail; floatPtr = &fl; fl = 123.456; if (fabs(*floatPtr - 123.456) > 0.00001) goto Fail; doublePtr = &dbl; dbl = 0.0; if (fabs(*doublePtr - 0.0) > 0.00001) goto Fail; extPtr = &ext; ext = 12.3e20; if (fabs(*extPtr - 123.0E19) > 0.00001) goto Fail; structPtr = &s; s.a = 32767; s.L = 2147483647; if ((structPtr->L != 2147483647) || (structPtr->a != 32767)) goto Fail; intPtr = &(s.a); if (*intPtr != 32767) goto Fail; longPtr = &(s.L); if (*longPtr != 2147483647) goto Fail; colorPtr = &color; color = black; if (*colorPtr != black) goto Fail; unionPtr = &un; un.first = 12; if (unionPtr->first != 12) goto Fail; un.second = 2147483646; if (unionPtr->second != 2147483646) goto Fail; printf ("Passed Conformance Test 4.5.2.3\n"); return; Fail: printf ("Failed Conformance Test 4.5.2.3\n"); } \ No newline at end of file +/* Conformance Test 4.5.2.3: Verification of pointer declarators for static */ +/* data */ + +#include + + /* pointers to all the basic types */ +static int *intPtr, i; +static long *longPtr, L; +static unsigned int *uintPtr, ui; +static unsigned long *ulongPtr, ulong; +static comp *compPtr, cmp; +static char *charPtr, ch; +static float *floatPtr, fl; +static double *doublePtr, dbl; +static extended *extPtr, ext; + + /* pointers to conglomerate types */ + +static struct s { int a; + long L; } *structPtr, s; +static enum colors { red, black, green } *colorPtr, color; +static union longOrShort { int first; + long second; } *unionPtr, un; + +main () + { + void F1 (void); + F1(); + } + +/******************************************************************************/ + +void F1 (void) + { + + intPtr = &i; + i = 3; + if (*intPtr != 3) + goto Fail; + + longPtr = &L; + L = 32769; + if (*longPtr != 32769) + goto Fail; + + uintPtr = &ui; + ui = 65535; + if (*uintPtr != 65535) + goto Fail; + + ulongPtr = &ulong; + ulong = 4294967295ul; + if (*ulongPtr != 4294967295ul) + goto Fail; + + compPtr = &cmp; + cmp = 4294967295ul; + if (*compPtr != 4294967295ul) + goto Fail; + + charPtr = &ch; + ch = 'A'; + if (*charPtr != 'A') + goto Fail; + + floatPtr = &fl; + fl = 123.456; + if (fabs(*floatPtr - 123.456) > 0.00001) + goto Fail; + + doublePtr = &dbl; + dbl = 0.0; + if (fabs(*doublePtr - 0.0) > 0.00001) + goto Fail; + + extPtr = &ext; + ext = 12.3e20; + if (fabs(*extPtr - 123.0E19) > 0.00001) + goto Fail; + + structPtr = &s; + s.a = 32767; + s.L = 2147483647; + if ((structPtr->L != 2147483647) || (structPtr->a != 32767)) + goto Fail; + + intPtr = &(s.a); + if (*intPtr != 32767) + goto Fail; + + longPtr = &(s.L); + if (*longPtr != 2147483647) + goto Fail; + + colorPtr = &color; + color = black; + if (*colorPtr != black) + goto Fail; + + unionPtr = &un; + un.first = 12; + if (unionPtr->first != 12) + goto Fail; + un.second = 2147483646; + if (unionPtr->second != 2147483646) + goto Fail; + + printf ("Passed Conformance Test 4.5.2.3\n"); + return; + +Fail: + printf ("Failed Conformance Test 4.5.2.3\n"); + } diff --git a/Tests/Conformance/C4.5.3.1.CC b/Tests/Conformance/C4.5.3.1.CC old mode 100755 new mode 100644 index 10762bb..961a012 --- a/Tests/Conformance/C4.5.3.1.CC +++ b/Tests/Conformance/C4.5.3.1.CC @@ -1 +1,245 @@ -/* Conformance Test 4.5.3.1: Verfication of local array declarations */ #include main () { char ch; int i, j, k, n; /* loop indices */ long L; /* l-values */ unsigned int ui; unsigned long ul; float f; double d; extended e; int i1 [50], i3 [3] [5] [8]; /* all basic types */ long L1 [9], L2 [2] [6]; unsigned int ui3 [4] [5] [1], ui1 [7]; unsigned long ul2 [5] [3], ul1 [1]; comp c1 [3], c2 [2] [3]; char ch2 [6] [5], ch1 [10]; float f1 [3], f4 [2] [3] [1] [4]; double d2 [2] [4], d1 [8]; extended e1 [9], e2 [7] [3]; /* conglomerate types */ struct s { int a; float f; } s1 [10], s2 [5] [4]; enum colors { red, black, green } C3 [2] [1] [3], C1 [6]; union longOrShort { int first; long second; } u2 [3] [3], u1 [12]; for (ch = 'a', i = 0; i < 6; i++) /* assign & check multiply-dimensioned */ for (j = 0; j < 5; j++) /* character arrays */ ch2 [i] [j] = ch++; for (ch = '~', n = 5; n >= 0; n--) for (k = 4; k >= 0; k--) if (ch2 [n] [k] != ch--) goto Fail; for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ ch1 [i] = (char) (i + 0x41); /* character arrays */ for (ch = 'J', i = 9; i >= 0; i--) if (ch1 [i] != ch--) goto Fail; for (i = 0; i < 50; i++) /* assign & check singly-dimensioned */ i1 [i] = i; /* integer array */ for (i = 49; i >= 0; i--) if (i1 [i] != i) goto Fail; for (i = 0; i < 3; i++) /* assign & check multiply-dimensioned */ for (j = 0; j < 5; j++) /* integer array */ for (k = 0; k < 8; k++) i3 [i] [j] [k] = k; for (i = 2; i >= 0; i--) for (j = 4; j >= 0; j--) for (k = 7; k >= 0; k--) if (i3 [i] [j] [k] != k) goto Fail; for (i = 8; i >= 0; i--) /* assign & check singly-dimensioned */ L1 [i] = 2147483647; /* long integer array */ for (i = 0; i < 9; i++) if (L1 [i] != 2147483647) goto Fail; for (L = 2147483646, i = 0; i < 2; i++) /* assign & check multiply- */ for (j = 0; j < 6; j++) /* dimensioned long integer*/ L2 [i] [j] = L--; /* array */ for (L = 2147483635, i = 1; i >= 0; i--) for (j = 5; j >= 0; j--) if (L2 [i] [j] != L++) goto Fail; for (ui = 65534, i = 0; i < 7; i++) /* assign & check singly-dimensioned */ ui1 [i] = ui--; /* unsigned integer array */ for (ui = 65528, i = 6; i >= 0; i--) if (ui1 [i] != ui++) goto Fail; for (ui = 65534, i = 0; i < 4; i++) /* assign & check multiply-dimensioned */ for (j = 0; j < 5; j++) /* unsigned integer array */ for (k = 0; k < 1; k++) ui3 [i] [j] [k] = ui--; for (ui = 65515, i = 3, k = 0; i >= 0; i--) for (j = 4; j >= 0; j--) if (ui3 [i] [j] [k] != ui++) goto Fail; for (ul = 4294967279ul, i = 0; i < 5; i++) /* assign & check multiply- */ for (j = 0; j < 3; j++) /* dimensioned unsigned */ ul2 [i] [j] = ul++; /* long integer array */ for (ul = 4294967293ul, i = 4; i >= 0; i--) for (j = 2; j >= 0; j--) if (ul2 [i] [j] != ul--) goto Fail; ul1 [0] = ul; /* assign & check singly-dimensioned */ if (ul1 [0] != 4294967278ul) /* unsigned long integer array */ goto Fail; for (i = 0; i < 3; i++) /* assign & check singly-dimensioned */ c1 [i] = i; /* comp array */ for (j = 2; j >= 0; j--) if (c1 [j] != j) goto Fail; for (i = 0; i < 2; i++) /* assign & check multiply-dimensioned */ for (j = 0; j < 3; j++) /* comp array */ c2 [i] [j] = 0; for (k = 1; k >= 0; k--) for (i = 2; i >= 0; i--) if (c2 [k] [i] != 0) goto Fail; f1 [0] = f1 [1] = f1 [2] = 43.8; /* assign & check singly-dimensioned */ for (k = 0; k < 3; k++) /* float array */ if (fabs(f1 [k] - 43.8) > 0.00001) goto Fail; for (f = 1.0, i = 0; i < 2; i++) /* assign & check multiply-dimensioned */ for (j = 0; j < 3; j++) /* float array */ for (k = 0; k < 1; k++) for (n = 0; n < 4; n++) f4 [i] [j] [k] [n] = f++; for (f = 1.0, i = 0; i < 2; i++) for (j = 0; j < 3; j++) for (k = 0; k < 1; k++) for (n = 0; n < 4; n++) if (fabs(f4 [i] [j] [k] [n] - (f++)) > 0.00001) goto Fail; for (i = 0; i < 2; i++) /* assign & check multiply-dimensioned */ for (j = 0; j < 4; j++) /* double array */ d2 [i] [j] = 0.00; for (d = 0, k = 1; k >= 0; k--) for (i = 3; i >= 0; i--) if (d2 [k] [i] != d) goto Fail; for (d1 [0] = 5.6, i = 1; i < 8; i++) /* assign & check singly- */ d1 [i] = d1 [i-1] + 1.0; /* dimensioned double array */ for (d = 12.6, k = 7; k >= 0; k--) if (d1 [k] != d--) goto Fail; for (e = 96e-75, i = 0; i < 7; i++) /* assign & check multiply-dimensioned */ for (j = 0; j < 3; j++) /* extended array */ e2 [i] [j] = e; for (i = 0; i < 7; i++) for (j = 0; j < 3; j++) if (e2 [i] [j] != 96.0e-75) goto Fail; for (k = 8; k >= 0; k--) /* assign & check singly-dimensioned */ e1 [k] = 0; /* extended array */ for (e = 0.000, i = 0; i < 9; i++) if (e1 [i] != e) goto Fail; for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ { /* array of structures */ s1 [i].a = i; s1 [i].f = (float) i * 2.0; } for (i = 0; i < 10; i++) { if ((s1 [i].a != i) || (fabs(s1 [i].f - i * 2.0) > 0.00001)) goto Fail; } for (n = 32766, f = 29.8E10, i = 0; i < 5; i++) /* assign & check multipy- */ for (j = 0; j < 4; j++) /* dimensioned array of */ { /* structures */ s2 [i] [j].a = n--; s2 [i] [j].f = f; } for (n = 32766, f = 29.8e10, i = 0; i < 5; i++) for (j = 0; j < 4; j++) if ((s2 [i] [j].a != n--) || (fabs(s2 [i] [j].f - f) > 0.00001)) goto Fail; for (i = 1, j = 0, k = 0; k < 3; k++) /* assign & check multiply- */ C3 [i] [j] [k] = red; /* dimensioned array of */ for (i = 0, k = 0; k < 3; k++) /* enumerations */ C3 [i] [j] [k] = green; for (k = 0; k < 3; k++) if (C3 [0] [0] [k] != green) goto Fail; for (k = 0; k < 3; k++) if (C3 [1] [0] [k] != red) goto Fail; for (n = 5; n >= 0; n--) /* assign & check singly- */ C1 [n] = black; /* dimensioned array of */ for (k = 0; k < 6; k++) /* enumerations */ if (C1 [k] != 1) goto Fail; for (i = 0; i < 3; i++) /* assign & check multiply- */ for (j = 0; j < 3; j++) /* dimensioned array of */ u2 [i] [j].first = j; /* unions */ for (n = 2; n >= 0; n--) if (u2 [n] [0].first != 0) goto Fail; for (n = 2; n >= 0; n--) if (u2 [n] [1].first != 1) goto Fail; for (n = 2; n >= 0; n--) if (u2 [n] [2].first != 2) goto Fail; for (L = 2147483646, i = 0; i < 3; i++) for (j = 0; j < 3; j++) u2 [i] [j].second = L--; for (L = 2147483646, k = 0; k < 3; k++) for (n = 0; n < 3; n++) if (u2 [k] [n].second != L--) goto Fail; for (i = 0; i < 12; i++) /* assign & check singly-dimensioned */ u1 [i].first = i; /* array of unions */ for (k = 11; k >= 0; k--) if (u1 [k].first != k) goto Fail; for (L = 32767, j = 0; j < 12; j++) u1 [j].second = L++; for (L = 32778, n = 11; n >= 0; n--) if (u1 [n].second != L--) goto Fail; printf ("Passed Conformance Test 4.5.3.1\n"); return; Fail: printf ("Failed Conformance Test 4.5.3.1\n"); } \ No newline at end of file +/* Conformance Test 4.5.3.1: Verfication of local array declarations */ + +#include + +main () + { + char ch; + int i, j, k, n; /* loop indices */ + long L; /* l-values */ + unsigned int ui; + unsigned long ul; + float f; + double d; + extended e; + + int i1 [50], i3 [3] [5] [8]; /* all basic types */ + long L1 [9], L2 [2] [6]; + unsigned int ui3 [4] [5] [1], ui1 [7]; + unsigned long ul2 [5] [3], ul1 [1]; + comp c1 [3], c2 [2] [3]; + char ch2 [6] [5], ch1 [10]; + float f1 [3], f4 [2] [3] [1] [4]; + double d2 [2] [4], d1 [8]; + extended e1 [9], e2 [7] [3]; + + /* conglomerate types */ + + struct s { int a; + float f; } s1 [10], s2 [5] [4]; + enum colors { red, black, green } C3 [2] [1] [3], C1 [6]; + union longOrShort { int first; + long second; } u2 [3] [3], u1 [12]; + + + + for (ch = 'a', i = 0; i < 6; i++) /* assign & check multiply-dimensioned */ + for (j = 0; j < 5; j++) /* character arrays */ + ch2 [i] [j] = ch++; + for (ch = '~', n = 5; n >= 0; n--) + for (k = 4; k >= 0; k--) + if (ch2 [n] [k] != ch--) + goto Fail; + + for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ + ch1 [i] = (char) (i + 0x41); /* character arrays */ + for (ch = 'J', i = 9; i >= 0; i--) + if (ch1 [i] != ch--) + goto Fail; + + for (i = 0; i < 50; i++) /* assign & check singly-dimensioned */ + i1 [i] = i; /* integer array */ + for (i = 49; i >= 0; i--) + if (i1 [i] != i) + goto Fail; + + for (i = 0; i < 3; i++) /* assign & check multiply-dimensioned */ + for (j = 0; j < 5; j++) /* integer array */ + for (k = 0; k < 8; k++) + i3 [i] [j] [k] = k; + for (i = 2; i >= 0; i--) + for (j = 4; j >= 0; j--) + for (k = 7; k >= 0; k--) + if (i3 [i] [j] [k] != k) + goto Fail; + + for (i = 8; i >= 0; i--) /* assign & check singly-dimensioned */ + L1 [i] = 2147483647; /* long integer array */ + for (i = 0; i < 9; i++) + if (L1 [i] != 2147483647) + goto Fail; + + for (L = 2147483646, i = 0; i < 2; i++) /* assign & check multiply- */ + for (j = 0; j < 6; j++) /* dimensioned long integer*/ + L2 [i] [j] = L--; /* array */ + for (L = 2147483635, i = 1; i >= 0; i--) + for (j = 5; j >= 0; j--) + if (L2 [i] [j] != L++) + goto Fail; + + for (ui = 65534, i = 0; i < 7; i++) /* assign & check singly-dimensioned */ + ui1 [i] = ui--; /* unsigned integer array */ + for (ui = 65528, i = 6; i >= 0; i--) + if (ui1 [i] != ui++) + goto Fail; + + for (ui = 65534, i = 0; i < 4; i++) /* assign & check multiply-dimensioned */ + for (j = 0; j < 5; j++) /* unsigned integer array */ + for (k = 0; k < 1; k++) + ui3 [i] [j] [k] = ui--; + for (ui = 65515, i = 3, k = 0; i >= 0; i--) + for (j = 4; j >= 0; j--) + if (ui3 [i] [j] [k] != ui++) + goto Fail; + + for (ul = 4294967279ul, i = 0; i < 5; i++) /* assign & check multiply- */ + for (j = 0; j < 3; j++) /* dimensioned unsigned */ + ul2 [i] [j] = ul++; /* long integer array */ + for (ul = 4294967293ul, i = 4; i >= 0; i--) + for (j = 2; j >= 0; j--) + if (ul2 [i] [j] != ul--) + goto Fail; + + ul1 [0] = ul; /* assign & check singly-dimensioned */ + if (ul1 [0] != 4294967278ul) /* unsigned long integer array */ + goto Fail; + + for (i = 0; i < 3; i++) /* assign & check singly-dimensioned */ + c1 [i] = i; /* comp array */ + for (j = 2; j >= 0; j--) + if (c1 [j] != j) + goto Fail; + + for (i = 0; i < 2; i++) /* assign & check multiply-dimensioned */ + for (j = 0; j < 3; j++) /* comp array */ + c2 [i] [j] = 0; + for (k = 1; k >= 0; k--) + for (i = 2; i >= 0; i--) + if (c2 [k] [i] != 0) + goto Fail; + + f1 [0] = f1 [1] = f1 [2] = 43.8; /* assign & check singly-dimensioned */ + for (k = 0; k < 3; k++) /* float array */ + if (fabs(f1 [k] - 43.8) > 0.00001) + goto Fail; + + for (f = 1.0, i = 0; i < 2; i++) /* assign & check multiply-dimensioned */ + for (j = 0; j < 3; j++) /* float array */ + for (k = 0; k < 1; k++) + for (n = 0; n < 4; n++) + f4 [i] [j] [k] [n] = f++; + + for (f = 1.0, i = 0; i < 2; i++) + for (j = 0; j < 3; j++) + for (k = 0; k < 1; k++) + for (n = 0; n < 4; n++) + if (fabs(f4 [i] [j] [k] [n] - (f++)) > 0.00001) + goto Fail; + + for (i = 0; i < 2; i++) /* assign & check multiply-dimensioned */ + for (j = 0; j < 4; j++) /* double array */ + d2 [i] [j] = 0.00; + for (d = 0, k = 1; k >= 0; k--) + for (i = 3; i >= 0; i--) + if (d2 [k] [i] != d) + goto Fail; + + for (d1 [0] = 5.6, i = 1; i < 8; i++) /* assign & check singly- */ + d1 [i] = d1 [i-1] + 1.0; /* dimensioned double array */ + for (d = 12.6, k = 7; k >= 0; k--) + if (d1 [k] != d--) + goto Fail; + + for (e = 96e-75, i = 0; i < 7; i++) /* assign & check multiply-dimensioned */ + for (j = 0; j < 3; j++) /* extended array */ + e2 [i] [j] = e; + for (i = 0; i < 7; i++) + for (j = 0; j < 3; j++) + if (e2 [i] [j] != 96.0e-75) + goto Fail; + + for (k = 8; k >= 0; k--) /* assign & check singly-dimensioned */ + e1 [k] = 0; /* extended array */ + for (e = 0.000, i = 0; i < 9; i++) + if (e1 [i] != e) + goto Fail; + + for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ + { /* array of structures */ + s1 [i].a = i; + s1 [i].f = (float) i * 2.0; + } + for (i = 0; i < 10; i++) + { + if ((s1 [i].a != i) || (fabs(s1 [i].f - i * 2.0) > 0.00001)) + goto Fail; + } + + for (n = 32766, f = 29.8E10, i = 0; i < 5; i++) /* assign & check multipy- */ + for (j = 0; j < 4; j++) /* dimensioned array of */ + { /* structures */ + s2 [i] [j].a = n--; + s2 [i] [j].f = f; + } + + for (n = 32766, f = 29.8e10, i = 0; i < 5; i++) + for (j = 0; j < 4; j++) + if ((s2 [i] [j].a != n--) || (fabs(s2 [i] [j].f - f) > 0.00001)) + goto Fail; + + for (i = 1, j = 0, k = 0; k < 3; k++) /* assign & check multiply- */ + C3 [i] [j] [k] = red; /* dimensioned array of */ + for (i = 0, k = 0; k < 3; k++) /* enumerations */ + C3 [i] [j] [k] = green; + for (k = 0; k < 3; k++) + if (C3 [0] [0] [k] != green) + goto Fail; + for (k = 0; k < 3; k++) + if (C3 [1] [0] [k] != red) + goto Fail; + + for (n = 5; n >= 0; n--) /* assign & check singly- */ + C1 [n] = black; /* dimensioned array of */ + for (k = 0; k < 6; k++) /* enumerations */ + if (C1 [k] != 1) + goto Fail; + + for (i = 0; i < 3; i++) /* assign & check multiply- */ + for (j = 0; j < 3; j++) /* dimensioned array of */ + u2 [i] [j].first = j; /* unions */ + for (n = 2; n >= 0; n--) + if (u2 [n] [0].first != 0) + goto Fail; + for (n = 2; n >= 0; n--) + if (u2 [n] [1].first != 1) + goto Fail; + for (n = 2; n >= 0; n--) + if (u2 [n] [2].first != 2) + goto Fail; + + for (L = 2147483646, i = 0; i < 3; i++) + for (j = 0; j < 3; j++) + u2 [i] [j].second = L--; + for (L = 2147483646, k = 0; k < 3; k++) + for (n = 0; n < 3; n++) + if (u2 [k] [n].second != L--) + goto Fail; + + for (i = 0; i < 12; i++) /* assign & check singly-dimensioned */ + u1 [i].first = i; /* array of unions */ + for (k = 11; k >= 0; k--) + if (u1 [k].first != k) + goto Fail; + + for (L = 32767, j = 0; j < 12; j++) + u1 [j].second = L++; + for (L = 32778, n = 11; n >= 0; n--) + if (u1 [n].second != L--) + goto Fail; + + printf ("Passed Conformance Test 4.5.3.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 4.5.3.1\n"); + } diff --git a/Tests/Conformance/C4.5.3.2.CC b/Tests/Conformance/C4.5.3.2.CC old mode 100755 new mode 100644 index 3b582c0..a22eb6b --- a/Tests/Conformance/C4.5.3.2.CC +++ b/Tests/Conformance/C4.5.3.2.CC @@ -1 +1,258 @@ -/* Conformance Test 4.5.3.2: Verfication of static array declarations */ #include static int i1 [50], i3 [3] [5] [8]; /* all basic types */ static long L1 [9], L2 [2] [6]; static unsigned int ui3 [4] [5] [1], ui1 [7]; static unsigned long ul2 [5] [3], ul1 [1]; static comp c1 [3], c2 [2] [3]; static char ch2 [6] [5], ch1 [10]; static float f1 [3], f4 [2] [3] [1] [4]; static double d2 [2] [4], d1 [8]; static extended e1 [9], e2 [7] [3]; /* conglomerate types */ struct s { int a; float f; }; static struct s s1 [10], s2 [5] [4]; enum colors { red, black, green }; static enum colors C3 [2] [1] [3], C1 [6]; union longOrShort { int first; long second; }; static union longOrShort u2 [3] [3], u1 [12]; main () { static int TestArray (void); if ( TestArray() ) printf ("Passed Conformance Test 4.5.3.2\n"); else printf ("Failed Conformance Test 4.5.3.2\n"); } /****************************************************************************/ static int TestArray ( void ) { int i, j, k, n; /* loop indices */ long L; /* l-values */ char ch; float f; double d; extended e; unsigned int ui; unsigned long ul; for (i = 0; i < 50; i++) /* assign & check singly-dimensioned */ i1 [i] = i; /* integer array */ for (i = 49; i >= 0; i--) if (i1 [i] != i) goto Fail; for (i = 0; i < 3; i++) /* assign & check multiply-dimensioned */ for (j = 0; j < 5; j++) /* integer array */ for (k = 0; k < 8; k++) i3 [i] [j] [k] = k; for (i = 2; i >= 0; i--) for (j = 4; j >= 0; j--) for (k = 7; k >= 0; k--) if (i3 [i] [j] [k] != k) goto Fail; for (ch = 'a', i = 0; i < 6; i++) /* assign & check multiply-dimensioned */ for (j = 0; j < 5; j++) /* character arrays */ ch2 [i] [j] = ch++; for (ch = '~', n = 5; n >= 0; n--) for (k = 4; k >= 0; k--) if (ch2 [n] [k] != ch--) goto Fail; for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ ch1 [i] = (char) (i + 0x41); /* character arrays */ for (ch = 'J', i = 9; i >= 0; i--) if (ch1 [i] != ch--) goto Fail; for (i = 8; i >= 0; i--) /* assign & check singly-dimensioned */ L1 [i] = 2147483647; /* long integer array */ for (i = 0; i < 9; i++) if (L1 [i] != 2147483647) goto Fail; for (L = 2147483646, i = 0; i < 2; i++) /* assign & check multiply- */ for (j = 0; j < 6; j++) /* dimensioned long integer*/ L2 [i] [j] = L--; /* array */ for (L = 2147483635, i = 1; i >= 0; i--) for (j = 5; j >= 0; j--) if (L2 [i] [j] != L++) goto Fail; for (ui = 65534, i = 0; i < 7; i++) /* assign & check singly-dimensioned */ ui1 [i] = ui--; /* unsigned integer array */ for (ui = 65528, i = 6; i >= 0; i--) if (ui1 [i] != ui++) goto Fail; for (ui = 65534, i = 0; i < 4; i++) /* assign & check multiply-dimensioned */ for (j = 0; j < 5; j++) /* unsigned integer array */ for (k = 0; k < 1; k++) ui3 [i] [j] [k] = ui--; for (ui = 65515, i = 3, k = 0; i >= 0; i--) for (j = 4; j >= 0; j--) if (ui3 [i] [j] [k] != ui++) goto Fail; for (ul = 4294967279ul, i = 0; i < 5; i++) /* assign & check multiply- */ for (j = 0; j < 3; j++) /* dimensioned unsigned */ ul2 [i] [j] = ul++; /* long integer array */ for (ul = 4294967293ul, i = 4; i >= 0; i--) for (j = 2; j >= 0; j--) if (ul2 [i] [j] != ul--) goto Fail; ul1 [0] = ul; /* assign & check singly-dimensioned */ if (ul1 [0] != 4294967278ul) /* unsigned long integer array */ goto Fail; for (i = 0; i < 3; i++) /* assign & check singly-dimensioned */ c1 [i] = i; /* comp array */ for (j = 2; j >= 0; j--) if (c1 [j] != j) goto Fail; for (i = 0; i < 2; i++) /* assign & check multiply-dimensioned */ for (j = 0; j < 3; j++) /* comp array */ c2 [i] [j] = 0; for (k = 1; k >= 0; k--) for (i = 2; i >= 0; i--) if (c2 [i] [j] != 0) goto Fail; f1 [0] = f1 [1] = f1 [2] = 43.8; /* assign & check singly-dimensioned */ for (k = 0; k < 3; k++) /* float array */ if (fabs(f1 [k] - 43.8) > 0.00001) goto Fail; for (f = 1.0, i = 0; i < 2; i++) /* assign & check multiply-dimensioned */ for (j = 0; j < 3; j++) /* float array */ for (k = 0; k < 1; k++) for (n = 0; n < 4; n++) f4 [i] [j] [k] [n] = f++; for (f = 1.0, i = 0; i < 2; i++) for (j = 0; j < 3; j++) for (k = 0; k < 1; k++) for (n = 0; n < 4; n++) if (fabs(f4 [i] [j] [k] [n] - f++) > 0.00001) goto Fail; for (i = 0; i < 2; i++) /* assign & check multiply-dimensioned */ for (j = 0; j < 4; j++) /* double array */ d2 [i] [j] = 0.00; for (d = 0, k = 1; k >= 0; k--) for (i = 3; i >= 0; i--) if (d2 [k] [i] != d) goto Fail; for (d1 [0] = 5.6, i = 1; i < 8; i++) /* assign & check singly- */ d1 [i] = d1 [i-1] + 1.0; /* dimensioned double array */ for (d = 12.6, k = 7; k >= 0; k--) if (d1 [k] != d--) goto Fail; for (e = 96e-75, i = 0; i < 7; i++) /* assign & check multiply-dimensioned */ for (j = 0; j < 3; j++) /* extended array */ e2 [i] [j] = e; for (i = 0; i < 7; i++) for (j = 0; j < 3; j++) if (fabs(e2 [i] [j] - 96.0e-75) > 0.00001) goto Fail; for (k = 8; k >= 0; k--) /* assign & check singly-dimensioned */ e1 [k] = 0; /* extended array */ for (e = 0.000, i = 0; i < 9; i++) if (e1 [i] != e) goto Fail; for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ { /* array of structures */ s1 [i].a = i; s1 [i].f = (float) i * 2.0; } for (i = 0; i < 10; i++) if ((s1 [i].a != i) || (fabs(s1 [i].f - i * 2.0) > 0.00001)) goto Fail; for (n = 32766, f = 29.8E10, i = 0; i < 5; i++) /* assign & check multipy- */ for (j = 0; j < 4; j++) /* dimensioned array of */ { /* structures */ s2 [i] [j].a = n--; s2 [i] [j].f = f; } for (n = 32766, f = 29.8e10, i = 0; i < 5; i++) for (j = 0; j < 4; j++) if ((s2 [i] [j].a != n--) || (fabs(s2 [i] [j].f - f) > 0.00001)) goto Fail; for (i = 1, j = 0, k = 0; k < 3; k++) /* assign & check multiply- */ C3 [i] [j] [k] = red; /* dimensioned array of */ for (i = 0, k = 0; k < 3; k++) /* enumerations */ C3 [i] [j] [k] = green; for (k = 0; k < 3; k++) if (C3 [0] [0] [k] != green) goto Fail; for (k = 0; k < 3; k++) if (C3 [1] [0] [k] != red) goto Fail; for (n = 5; n >= 0; n--) /* assign & check singly- */ C1 [n] = black; /* dimensioned array of */ for (k = 0; k < 6; k++) /* enumerations */ if (C1 [k] != 1) goto Fail; for (i = 0; i < 3; i++) /* assign & check multiply- */ for (j = 0; j < 3; j++) /* dimensioned array of */ u2 [i] [j].first = j; /* unions */ for (n = 2; n >= 0; n--) if (u2 [n] [0].first != 0) goto Fail; for (n = 2; n >= 0; n--) if (u2 [n] [1].first != 1) goto Fail; for (n = 2; n >= 0; n--) if (u2 [n] [2].first != 2) goto Fail; for (L = 2147483646, i = 0; i < 3; i++) for (j = 0; j < 3; j++) u2 [i] [j].second = L--; for (L = 2147483646, i = 0; i < 3; i++) for (j = 0; j < 3; j++) if (u2 [i] [j].second != L--) goto Fail; for (i = 0; i < 12; i++) /* assign & check singly-dimensioned */ u1 [i].first = i; /* array of unions */ for (k = 11; k >= 0; k--) if (u1 [k].first != k) goto Fail; for (L = 32767, j = 0; j < 12; j++) u1 [j].second = L++; for (L = 32767, j = 0; j < 12; j++) if (u1[j].second != L++) goto Fail; return (1); Fail: return (0); } \ No newline at end of file +/* Conformance Test 4.5.3.2: Verfication of static array declarations */ + +#include + +static int i1 [50], i3 [3] [5] [8]; /* all basic types */ +static long L1 [9], L2 [2] [6]; + +static unsigned int ui3 [4] [5] [1], ui1 [7]; +static unsigned long ul2 [5] [3], ul1 [1]; + +static comp c1 [3], c2 [2] [3]; +static char ch2 [6] [5], ch1 [10]; +static float f1 [3], f4 [2] [3] [1] [4]; +static double d2 [2] [4], d1 [8]; +static extended e1 [9], e2 [7] [3]; + + /* conglomerate types */ +struct s { int a; + float f; }; +static struct s s1 [10], s2 [5] [4]; + +enum colors { red, black, green }; +static enum colors C3 [2] [1] [3], C1 [6]; + +union longOrShort { int first; + long second; }; +static union longOrShort u2 [3] [3], u1 [12]; + +main () + { + static int TestArray (void); + + if ( TestArray() ) + printf ("Passed Conformance Test 4.5.3.2\n"); + else + printf ("Failed Conformance Test 4.5.3.2\n"); + } + +/****************************************************************************/ + +static int TestArray ( void ) + { + int i, j, k, n; /* loop indices */ + long L; /* l-values */ + char ch; + float f; + double d; + extended e; + unsigned int ui; + unsigned long ul; + + for (i = 0; i < 50; i++) /* assign & check singly-dimensioned */ + i1 [i] = i; /* integer array */ + for (i = 49; i >= 0; i--) + if (i1 [i] != i) + goto Fail; + + for (i = 0; i < 3; i++) /* assign & check multiply-dimensioned */ + for (j = 0; j < 5; j++) /* integer array */ + for (k = 0; k < 8; k++) + i3 [i] [j] [k] = k; + for (i = 2; i >= 0; i--) + for (j = 4; j >= 0; j--) + for (k = 7; k >= 0; k--) + if (i3 [i] [j] [k] != k) + goto Fail; + + for (ch = 'a', i = 0; i < 6; i++) /* assign & check multiply-dimensioned */ + for (j = 0; j < 5; j++) /* character arrays */ + ch2 [i] [j] = ch++; + for (ch = '~', n = 5; n >= 0; n--) + for (k = 4; k >= 0; k--) + if (ch2 [n] [k] != ch--) + goto Fail; + + for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ + ch1 [i] = (char) (i + 0x41); /* character arrays */ + for (ch = 'J', i = 9; i >= 0; i--) + if (ch1 [i] != ch--) + goto Fail; + + for (i = 8; i >= 0; i--) /* assign & check singly-dimensioned */ + L1 [i] = 2147483647; /* long integer array */ + for (i = 0; i < 9; i++) + if (L1 [i] != 2147483647) + goto Fail; + + for (L = 2147483646, i = 0; i < 2; i++) /* assign & check multiply- */ + for (j = 0; j < 6; j++) /* dimensioned long integer*/ + L2 [i] [j] = L--; /* array */ + for (L = 2147483635, i = 1; i >= 0; i--) + for (j = 5; j >= 0; j--) + if (L2 [i] [j] != L++) + goto Fail; + + for (ui = 65534, i = 0; i < 7; i++) /* assign & check singly-dimensioned */ + ui1 [i] = ui--; /* unsigned integer array */ + for (ui = 65528, i = 6; i >= 0; i--) + if (ui1 [i] != ui++) + goto Fail; + + for (ui = 65534, i = 0; i < 4; i++) /* assign & check multiply-dimensioned */ + for (j = 0; j < 5; j++) /* unsigned integer array */ + for (k = 0; k < 1; k++) + ui3 [i] [j] [k] = ui--; + for (ui = 65515, i = 3, k = 0; i >= 0; i--) + for (j = 4; j >= 0; j--) + if (ui3 [i] [j] [k] != ui++) + goto Fail; + + for (ul = 4294967279ul, i = 0; i < 5; i++) /* assign & check multiply- */ + for (j = 0; j < 3; j++) /* dimensioned unsigned */ + ul2 [i] [j] = ul++; /* long integer array */ + for (ul = 4294967293ul, i = 4; i >= 0; i--) + for (j = 2; j >= 0; j--) + if (ul2 [i] [j] != ul--) + goto Fail; + + ul1 [0] = ul; /* assign & check singly-dimensioned */ + if (ul1 [0] != 4294967278ul) /* unsigned long integer array */ + goto Fail; + + for (i = 0; i < 3; i++) /* assign & check singly-dimensioned */ + c1 [i] = i; /* comp array */ + for (j = 2; j >= 0; j--) + if (c1 [j] != j) + goto Fail; + + for (i = 0; i < 2; i++) /* assign & check multiply-dimensioned */ + for (j = 0; j < 3; j++) /* comp array */ + c2 [i] [j] = 0; + for (k = 1; k >= 0; k--) + for (i = 2; i >= 0; i--) + if (c2 [i] [j] != 0) + goto Fail; + + f1 [0] = f1 [1] = f1 [2] = 43.8; /* assign & check singly-dimensioned */ + for (k = 0; k < 3; k++) /* float array */ + if (fabs(f1 [k] - 43.8) > 0.00001) + goto Fail; + + for (f = 1.0, i = 0; i < 2; i++) /* assign & check multiply-dimensioned */ + for (j = 0; j < 3; j++) /* float array */ + for (k = 0; k < 1; k++) + for (n = 0; n < 4; n++) + f4 [i] [j] [k] [n] = f++; + + for (f = 1.0, i = 0; i < 2; i++) + for (j = 0; j < 3; j++) + for (k = 0; k < 1; k++) + for (n = 0; n < 4; n++) + if (fabs(f4 [i] [j] [k] [n] - f++) > 0.00001) + goto Fail; + + for (i = 0; i < 2; i++) /* assign & check multiply-dimensioned */ + for (j = 0; j < 4; j++) /* double array */ + d2 [i] [j] = 0.00; + for (d = 0, k = 1; k >= 0; k--) + for (i = 3; i >= 0; i--) + if (d2 [k] [i] != d) + goto Fail; + + for (d1 [0] = 5.6, i = 1; i < 8; i++) /* assign & check singly- */ + d1 [i] = d1 [i-1] + 1.0; /* dimensioned double array */ + for (d = 12.6, k = 7; k >= 0; k--) + if (d1 [k] != d--) + goto Fail; + + for (e = 96e-75, i = 0; i < 7; i++) /* assign & check multiply-dimensioned */ + for (j = 0; j < 3; j++) /* extended array */ + e2 [i] [j] = e; + for (i = 0; i < 7; i++) + for (j = 0; j < 3; j++) + if (fabs(e2 [i] [j] - 96.0e-75) > 0.00001) + goto Fail; + + for (k = 8; k >= 0; k--) /* assign & check singly-dimensioned */ + e1 [k] = 0; /* extended array */ + for (e = 0.000, i = 0; i < 9; i++) + if (e1 [i] != e) + goto Fail; + + for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ + { /* array of structures */ + s1 [i].a = i; + s1 [i].f = (float) i * 2.0; + } + for (i = 0; i < 10; i++) + if ((s1 [i].a != i) || (fabs(s1 [i].f - i * 2.0) > 0.00001)) + goto Fail; + + for (n = 32766, f = 29.8E10, i = 0; i < 5; i++) /* assign & check multipy- */ + for (j = 0; j < 4; j++) /* dimensioned array of */ + { /* structures */ + s2 [i] [j].a = n--; + s2 [i] [j].f = f; + } + + for (n = 32766, f = 29.8e10, i = 0; i < 5; i++) + for (j = 0; j < 4; j++) + if ((s2 [i] [j].a != n--) || (fabs(s2 [i] [j].f - f) > 0.00001)) + goto Fail; + + for (i = 1, j = 0, k = 0; k < 3; k++) /* assign & check multiply- */ + C3 [i] [j] [k] = red; /* dimensioned array of */ + for (i = 0, k = 0; k < 3; k++) /* enumerations */ + C3 [i] [j] [k] = green; + for (k = 0; k < 3; k++) + if (C3 [0] [0] [k] != green) + goto Fail; + for (k = 0; k < 3; k++) + if (C3 [1] [0] [k] != red) + goto Fail; + + for (n = 5; n >= 0; n--) /* assign & check singly- */ + C1 [n] = black; /* dimensioned array of */ + for (k = 0; k < 6; k++) /* enumerations */ + if (C1 [k] != 1) + goto Fail; + + for (i = 0; i < 3; i++) /* assign & check multiply- */ + for (j = 0; j < 3; j++) /* dimensioned array of */ + u2 [i] [j].first = j; /* unions */ + for (n = 2; n >= 0; n--) + if (u2 [n] [0].first != 0) + goto Fail; + for (n = 2; n >= 0; n--) + if (u2 [n] [1].first != 1) + goto Fail; + for (n = 2; n >= 0; n--) + if (u2 [n] [2].first != 2) + goto Fail; + + for (L = 2147483646, i = 0; i < 3; i++) + for (j = 0; j < 3; j++) + u2 [i] [j].second = L--; + for (L = 2147483646, i = 0; i < 3; i++) + for (j = 0; j < 3; j++) + if (u2 [i] [j].second != L--) + goto Fail; + + for (i = 0; i < 12; i++) /* assign & check singly-dimensioned */ + u1 [i].first = i; /* array of unions */ + for (k = 11; k >= 0; k--) + if (u1 [k].first != k) + goto Fail; + + for (L = 32767, j = 0; j < 12; j++) + u1 [j].second = L++; + for (L = 32767, j = 0; j < 12; j++) + if (u1[j].second != L++) + goto Fail; + + return (1); + +Fail: + return (0); + } diff --git a/Tests/Conformance/C4.5.3.3.CC b/Tests/Conformance/C4.5.3.3.CC old mode 100755 new mode 100644 index 4e8a416..63ec297 --- a/Tests/Conformance/C4.5.3.3.CC +++ b/Tests/Conformance/C4.5.3.3.CC @@ -1 +1,129 @@ -/* Conformance Test 4.5.3.3: Verfication of local array declarations: arrays */ /* of pointers */ #include main () { int i, j, k, n; /* loop indices */ long L; /* l-values */ float f; double d; extended e; comp cmp; unsigned int ui; unsigned long ul; char ch; int *i1 [50]; /* all basic types */ long *L1 [9]; comp *c1 [3]; char *ch1 [10]; float *f1 [3]; double *d1 [8]; extended *e1 [9]; unsigned int ui3 [4] [5] [1], *ui1 [7]; unsigned long ul2 [5] [3], *ul1 [1]; /* conglomerate types */ struct s { int a; float f; } *s1 [10], S; enum colors { red, black, green } *en [6], C; union longOrShort { int first; long second; } *u1 [12], U; for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ ch1 [i] = &ch; /* array of pointers to character */ ch = 'z'; for (i = 9; i >= 0; i--) if (*(ch1 [i]) != 'z') goto Fail; for (i = 0; i < 50; i++) /* assign & check singly-dimensioned */ i1 [i] = &n; /* array of pointers to int */ n = 32767; for (i = 49; i >= 0; i--) if (*(i1 [i]) != 32767) goto Fail; for (i = 8; i >= 0; i--) /* assign & check singly-dimensioned */ L1 [i] = &L; /* array of pointers to long int */ L = 2147483647; for (i = 0; i < 9; i++) if (*(L1 [i]) != 2147483647) goto Fail; for (i = 0; i < 7; i++) /* assign & check singly-dimensioned */ ui1 [i] = &ui; /* array of ptrs to unsigned int */ ui = 65535; for (i = 6; i >= 0; i--) if (*(ui1 [i]) != 65535) goto Fail; ul1 [0] = &ul; /* assign & check singly-dimensioned */ ul = 4294967295ul; /* array of ptrs to long unsigned int*/ if (*(ul1 [0]) != 0xffffffff) goto Fail; for (i = 0; i < 3; i++) /* assign & check singly-dimensioned */ c1 [i] = &cmp; /* array of pointers to comp */ cmp = 4; for (j = 2; j >= 0; j--) if (*(c1 [j]) != 4) goto Fail; f1 [0] = f1 [1] = f1 [2] = &f; /* assign & check singly-dimensioned */ f = 32.8; /* array of pointers to float */ for (k = 0; k < 3; k++) if (fabs(*(f1 [k]) - 32.8) > 0.00001) goto Fail; for (i = 0; i < 8; i++) /* assign & check singly- */ d1 [i] = &d; /* dimensioned array of */ d = 123.0e50; /* pointers to double */ for (k = 7; k >= 0; k--) if (fabs(*(d1 [k]) - 0.123E53) > 0.00001) goto Fail; for (k = 8; k >= 0; k--) /* assign & check singly-dimensioned */ e1 [k] = &e; /* array of pointers to extended */ e = 0.0e-300; for (i = 0; i < 9; i++) if (*(e1 [i]) != 0) goto Fail; for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ s1 [i] = &S; /* array of pointers to structures */ S.a = 7; S.f = 6.4; for (i = 9; i >= 0; i--) if ((s1 [i]->a != 7) || (fabs(s1 [i]->f - 6.4) > 0.00001)) goto Fail; for (n = 5; n >= 0; n--) /* assign & check singly-dimensioned */ en [n] = &C; /* array of pointers to enumerations*/ C = black; for (k = 0; k < 6; k++) if (*(en [k]) != 1) goto Fail; for (i = 0; i < 12; i++) /* assign & check singly-dimensioned */ u1 [i] = &U; /* array of pointers to union */ U.first = -45; for (k = 11; k >= 0; k--) if (u1 [k]->first != -45) goto Fail; U.second = 32770; for (n = 11; n >= 0; n--) if (u1 [n]->second != 32770) goto Fail; printf ("Passed Conformance Test 4.5.3.3\n"); return; Fail: printf ("Failed Conformance Test 4.5.3.3\n"); } \ No newline at end of file +/* Conformance Test 4.5.3.3: Verfication of local array declarations: arrays */ +/* of pointers */ + +#include + +main () + { + int i, j, k, n; /* loop indices */ + long L; /* l-values */ + float f; + double d; + extended e; + comp cmp; + unsigned int ui; + unsigned long ul; + char ch; + + int *i1 [50]; /* all basic types */ + long *L1 [9]; + comp *c1 [3]; + char *ch1 [10]; + float *f1 [3]; + double *d1 [8]; + extended *e1 [9]; + + unsigned int ui3 [4] [5] [1], *ui1 [7]; + unsigned long ul2 [5] [3], *ul1 [1]; + + /* conglomerate types */ + struct s { int a; + float f; } *s1 [10], S; + enum colors { red, black, green } *en [6], C; + union longOrShort { int first; + long second; } *u1 [12], U; + + + for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ + ch1 [i] = &ch; /* array of pointers to character */ + ch = 'z'; + for (i = 9; i >= 0; i--) + if (*(ch1 [i]) != 'z') + goto Fail; + + for (i = 0; i < 50; i++) /* assign & check singly-dimensioned */ + i1 [i] = &n; /* array of pointers to int */ + n = 32767; + for (i = 49; i >= 0; i--) + if (*(i1 [i]) != 32767) + goto Fail; + + for (i = 8; i >= 0; i--) /* assign & check singly-dimensioned */ + L1 [i] = &L; /* array of pointers to long int */ + L = 2147483647; + for (i = 0; i < 9; i++) + if (*(L1 [i]) != 2147483647) + goto Fail; + + for (i = 0; i < 7; i++) /* assign & check singly-dimensioned */ + ui1 [i] = &ui; /* array of ptrs to unsigned int */ + ui = 65535; + for (i = 6; i >= 0; i--) + if (*(ui1 [i]) != 65535) + goto Fail; + + ul1 [0] = &ul; /* assign & check singly-dimensioned */ + ul = 4294967295ul; /* array of ptrs to long unsigned int*/ + if (*(ul1 [0]) != 0xffffffff) + goto Fail; + + for (i = 0; i < 3; i++) /* assign & check singly-dimensioned */ + c1 [i] = &cmp; /* array of pointers to comp */ + cmp = 4; + for (j = 2; j >= 0; j--) + if (*(c1 [j]) != 4) + goto Fail; + + f1 [0] = f1 [1] = f1 [2] = &f; /* assign & check singly-dimensioned */ + f = 32.8; /* array of pointers to float */ + for (k = 0; k < 3; k++) + if (fabs(*(f1 [k]) - 32.8) > 0.00001) + goto Fail; + + for (i = 0; i < 8; i++) /* assign & check singly- */ + d1 [i] = &d; /* dimensioned array of */ + d = 123.0e50; /* pointers to double */ + for (k = 7; k >= 0; k--) + if (fabs(*(d1 [k]) - 0.123E53) > 0.00001) + goto Fail; + + for (k = 8; k >= 0; k--) /* assign & check singly-dimensioned */ + e1 [k] = &e; /* array of pointers to extended */ + e = 0.0e-300; + for (i = 0; i < 9; i++) + if (*(e1 [i]) != 0) + goto Fail; + + for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ + s1 [i] = &S; /* array of pointers to structures */ + S.a = 7; + S.f = 6.4; + for (i = 9; i >= 0; i--) + if ((s1 [i]->a != 7) || (fabs(s1 [i]->f - 6.4) > 0.00001)) + goto Fail; + + for (n = 5; n >= 0; n--) /* assign & check singly-dimensioned */ + en [n] = &C; /* array of pointers to enumerations*/ + C = black; + for (k = 0; k < 6; k++) + if (*(en [k]) != 1) + goto Fail; + + for (i = 0; i < 12; i++) /* assign & check singly-dimensioned */ + u1 [i] = &U; /* array of pointers to union */ + U.first = -45; + for (k = 11; k >= 0; k--) + if (u1 [k]->first != -45) + goto Fail; + + U.second = 32770; + for (n = 11; n >= 0; n--) + if (u1 [n]->second != 32770) + goto Fail; + + printf ("Passed Conformance Test 4.5.3.3\n"); + return; + +Fail: + printf ("Failed Conformance Test 4.5.3.3\n"); + } diff --git a/Tests/Conformance/C4.5.3.4.CC b/Tests/Conformance/C4.5.3.4.CC old mode 100755 new mode 100644 index 363cc12..0ffc1ce --- a/Tests/Conformance/C4.5.3.4.CC +++ b/Tests/Conformance/C4.5.3.4.CC @@ -1 +1,147 @@ -/* Conformance Test 4.5.3.4: Verfication of static array declarations: arrays */ /* of pointers */ #include static int *i1 [50]; /* all basic types */ static long *L1 [9]; static comp *c1 [3]; static char *ch1 [10]; static float *f1 [3]; static double *d1 [8]; static extended *e1 [9]; static unsigned int ui3 [4] [5] [1], *ui1 [7]; static unsigned long ul2 [5] [3], *ul1 [1]; /* conglomerate types */ struct s { int a; float f; }; static struct s *s1 [10], S; enum colors { red, black, green }; static enum colors *en [6], C; union longOrShort { int first; long second; }; static union longOrShort *u1 [12], U; main () { static int TestEm (void); if (TestEm()) printf ("Passed Conformance Test 4.5.3.4\n"); else printf ("Failed Conformance Test 4.5.3.4\n"); } /****************************************************************************/ static int TestEm (void) { char ch; comp cmp; int i, j, k, n; /* loop indices */ long L; /* l-values */ float f; double d; extended e; unsigned int ui; unsigned long ul; for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ ch1 [i] = &ch; /* array of pointers to character */ ch = 'z'; for (i = 9; i >= 0; i--) if (*(ch1 [i]) != 'z') goto Fail; for (i = 0; i < 50; i++) /* assign & check singly-dimensioned */ i1 [i] = &n; /* array of pointers to int */ n = 32767; for (i = 49; i >= 0; i--) if (*(i1 [i]) != 32767) goto Fail; for (i = 8; i >= 0; i--) /* assign & check singly-dimensioned */ L1 [i] = &L; /* array of pointers to long int */ L = 2147483647; for (i = 0; i < 9; i++) if (*(L1 [i]) != 2147483647) goto Fail; for (i = 0; i < 7; i++) /* assign & check singly-dimensioned */ ui1 [i] = &ui; /* array of ptrs to unsigned int */ ui = 65535; for (i = 6; i >= 0; i--) if (*(ui1 [i]) != 65535) goto Fail; ul1 [0] = &ul; /* assign & check singly-dimensioned */ ul = 4294967295ul; /* array of ptrs to long unsigned int*/ if (*(ul1 [0]) != 0xffffffff) goto Fail; for (i = 0; i < 3; i++) /* assign & check singly-dimensioned */ c1 [i] = &cmp; /* array of pointers to comp */ cmp = 4; for (j = 2; j >= 0; j--) if (*(c1 [j]) != 4) goto Fail; f1 [0] = f1 [1] = f1 [2] = &f; /* assign & check singly-dimensioned */ f = 32.8; /* array of pointers to float */ for (k = 0; k < 3; k++) if (fabs(*(f1 [k]) - 32.8) > 0.00001) goto Fail; for (i = 0; i < 8; i++) /* assign & check singly- */ d1 [i] = &d; /* dimensioned array of */ d = 123.0e50; /* pointers to double */ for (k = 7; k >= 0; k--) if (fabs(*(d1 [k]) - 0.123E53) > 0.00001) goto Fail; for (k = 8; k >= 0; k--) /* assign & check singly-dimensioned */ e1 [k] = &e; /* array of pointers to extended */ e = 0.0e-300; for (i = 0; i < 9; i++) if (*(e1 [i]) != 0) goto Fail; for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ s1 [i] = &S; /* array of pointers to structures */ S.a = 7; S.f = 6.4; for (i = 9; i >= 0; i--) if ((s1 [i]->a != 7) || (fabs(s1 [i]->f - 6.4) > 0.00001)) goto Fail; for (n = 5; n >= 0; n--) /* assign & check singly-dimensioned */ en [n] = &C; /* array of pointers to enumerations*/ C = black; for (k = 0; k < 6; k++) if (*(en [k]) != 1) goto Fail; for (i = 0; i < 12; i++) /* assign & check singly-dimensioned */ u1 [i] = &U; /* array of pointers to union */ U.first = -45; for (k = 11; k >= 0; k--) if (u1 [k]->first != -45) goto Fail; U.second = 32770; for (n = 11; n >= 0; n--) if (u1 [n]->second != 32770) goto Fail; return 1; Fail: return 0; } \ No newline at end of file +/* Conformance Test 4.5.3.4: Verfication of static array declarations: arrays */ +/* of pointers */ + +#include + +static int *i1 [50]; /* all basic types */ +static long *L1 [9]; +static comp *c1 [3]; +static char *ch1 [10]; +static float *f1 [3]; +static double *d1 [8]; +static extended *e1 [9]; + +static unsigned int ui3 [4] [5] [1], *ui1 [7]; +static unsigned long ul2 [5] [3], *ul1 [1]; + + /* conglomerate types */ +struct s { int a; + float f; }; +static struct s *s1 [10], S; + +enum colors { red, black, green }; +static enum colors *en [6], C; + +union longOrShort { int first; + long second; }; +static union longOrShort *u1 [12], U; + + +main () + { + static int TestEm (void); + + if (TestEm()) + printf ("Passed Conformance Test 4.5.3.4\n"); + else + printf ("Failed Conformance Test 4.5.3.4\n"); + } + +/****************************************************************************/ + +static int TestEm (void) + { + + char ch; + comp cmp; + int i, j, k, n; /* loop indices */ + long L; /* l-values */ + float f; + double d; + extended e; + unsigned int ui; + unsigned long ul; + + + for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ + ch1 [i] = &ch; /* array of pointers to character */ + ch = 'z'; + for (i = 9; i >= 0; i--) + if (*(ch1 [i]) != 'z') + goto Fail; + + for (i = 0; i < 50; i++) /* assign & check singly-dimensioned */ + i1 [i] = &n; /* array of pointers to int */ + n = 32767; + for (i = 49; i >= 0; i--) + if (*(i1 [i]) != 32767) + goto Fail; + + for (i = 8; i >= 0; i--) /* assign & check singly-dimensioned */ + L1 [i] = &L; /* array of pointers to long int */ + L = 2147483647; + for (i = 0; i < 9; i++) + if (*(L1 [i]) != 2147483647) + goto Fail; + + for (i = 0; i < 7; i++) /* assign & check singly-dimensioned */ + ui1 [i] = &ui; /* array of ptrs to unsigned int */ + ui = 65535; + for (i = 6; i >= 0; i--) + if (*(ui1 [i]) != 65535) + goto Fail; + + ul1 [0] = &ul; /* assign & check singly-dimensioned */ + ul = 4294967295ul; /* array of ptrs to long unsigned int*/ + if (*(ul1 [0]) != 0xffffffff) + goto Fail; + + for (i = 0; i < 3; i++) /* assign & check singly-dimensioned */ + c1 [i] = &cmp; /* array of pointers to comp */ + cmp = 4; + for (j = 2; j >= 0; j--) + if (*(c1 [j]) != 4) + goto Fail; + + f1 [0] = f1 [1] = f1 [2] = &f; /* assign & check singly-dimensioned */ + f = 32.8; /* array of pointers to float */ + for (k = 0; k < 3; k++) + if (fabs(*(f1 [k]) - 32.8) > 0.00001) + goto Fail; + + for (i = 0; i < 8; i++) /* assign & check singly- */ + d1 [i] = &d; /* dimensioned array of */ + d = 123.0e50; /* pointers to double */ + for (k = 7; k >= 0; k--) + if (fabs(*(d1 [k]) - 0.123E53) > 0.00001) + goto Fail; + + for (k = 8; k >= 0; k--) /* assign & check singly-dimensioned */ + e1 [k] = &e; /* array of pointers to extended */ + e = 0.0e-300; + for (i = 0; i < 9; i++) + if (*(e1 [i]) != 0) + goto Fail; + + for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ + s1 [i] = &S; /* array of pointers to structures */ + S.a = 7; + S.f = 6.4; + for (i = 9; i >= 0; i--) + if ((s1 [i]->a != 7) || (fabs(s1 [i]->f - 6.4) > 0.00001)) + goto Fail; + + for (n = 5; n >= 0; n--) /* assign & check singly-dimensioned */ + en [n] = &C; /* array of pointers to enumerations*/ + C = black; + for (k = 0; k < 6; k++) + if (*(en [k]) != 1) + goto Fail; + + for (i = 0; i < 12; i++) /* assign & check singly-dimensioned */ + u1 [i] = &U; /* array of pointers to union */ + U.first = -45; + for (k = 11; k >= 0; k--) + if (u1 [k]->first != -45) + goto Fail; + + U.second = 32770; + for (n = 11; n >= 0; n--) + if (u1 [n]->second != 32770) + goto Fail; + + return 1; + +Fail: + return 0; + } diff --git a/Tests/Conformance/C4.5.4.1.CC b/Tests/Conformance/C4.5.4.1.CC old mode 100755 new mode 100644 index e3fd6ea..fe10554 --- a/Tests/Conformance/C4.5.4.1.CC +++ b/Tests/Conformance/C4.5.4.1.CC @@ -1 +1,103 @@ -/* Conformance Test 4.5.4.1: Verification of function declarators */ #include #include /***************************************************************************/ static int I1 (int (*func1) (char a), int (*func2) (float f)) { return ( ((*func1) ('a')) + (func2 (3.5)) ); } /***************************************************************************/ static int I2 (int (*func []) (char a)) { int j; j = (*func) ('@'); j += (func[1]) ('@'); return j; } /***************************************************************************/ main () { int i; int Char1 (char ch); /* define two different functions which */ int Char2 (char ch); /* take 1 char parm and return int */ int Float1 (float f); /* define two different functions which */ int Float2 (float f); /* take 1 float parm and return int */ int (*f1Ptr) (char); /* pointer to function returning int */ /* function has single char arg */ int (*f1Array [3]) (char); /* array of pointers to functions */ /* returning int & having single */ /* char parameter */ int (*f2Ptr) (float); /* pointer to function returning int */ /* function has single float arg */ f1Ptr = Char1; f2Ptr = Float2; i = I1 (f1Ptr, f2Ptr); if (i != 0xC3) goto Fail; f1Ptr = Char2; f2Ptr = Float1; i = I1 (f1Ptr, f2Ptr); if (i != 0xD4) goto Fail; i = I1 (Char1, Float1); if (i != 0xD3) goto Fail; f1Array [0] = Char1; f1Array [1] = Char2; f1Array [2] = NULL; i = I2 (f1Array); if (i != 0x143) goto Fail; printf ("Passed Conformance Test 4.5.4.1\n"); return; Fail: printf ("Failed Conformance Test 4.5.4.1\n"); } /***************************************************************************/ int Char1 (char ch) { return (ch + 'a'); } /***************************************************************************/ int Char2 (char ch) { return ((ch) + ('b')); } /***************************************************************************/ int Float1 (float f) { return (int) ((f) * 5.0); } /***************************************************************************/ int Float2 (float f) { return (int) (f / 2.0); } \ No newline at end of file +/* Conformance Test 4.5.4.1: Verification of function declarators */ + +#include +#include + +/***************************************************************************/ + +static int I1 (int (*func1) (char a), int (*func2) (float f)) + { + return ( ((*func1) ('a')) + (func2 (3.5)) ); + } + +/***************************************************************************/ + +static int I2 (int (*func []) (char a)) + { + int j; + + j = (*func) ('@'); + j += (func[1]) ('@'); + return j; + } + +/***************************************************************************/ + + +main () + { + int i; + + int Char1 (char ch); /* define two different functions which */ + int Char2 (char ch); /* take 1 char parm and return int */ + + int Float1 (float f); /* define two different functions which */ + int Float2 (float f); /* take 1 float parm and return int */ + + int (*f1Ptr) (char); /* pointer to function returning int */ + /* function has single char arg */ + int (*f1Array [3]) (char); /* array of pointers to functions */ + /* returning int & having single */ + /* char parameter */ + int (*f2Ptr) (float); /* pointer to function returning int */ + /* function has single float arg */ + + f1Ptr = Char1; + f2Ptr = Float2; + i = I1 (f1Ptr, f2Ptr); + if (i != 0xC3) + goto Fail; + + f1Ptr = Char2; + f2Ptr = Float1; + i = I1 (f1Ptr, f2Ptr); + if (i != 0xD4) + goto Fail; + + i = I1 (Char1, Float1); + if (i != 0xD3) + goto Fail; + + f1Array [0] = Char1; + f1Array [1] = Char2; + f1Array [2] = NULL; + i = I2 (f1Array); + if (i != 0x143) + goto Fail; + + + printf ("Passed Conformance Test 4.5.4.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 4.5.4.1\n"); + } + + +/***************************************************************************/ + +int Char1 (char ch) + { + return (ch + 'a'); + } + +/***************************************************************************/ + +int Char2 (char ch) + { + return ((ch) + ('b')); + } + +/***************************************************************************/ + +int Float1 (float f) + { + return (int) ((f) * 5.0); + } + +/***************************************************************************/ + +int Float2 (float f) + { + return (int) (f / 2.0); + } diff --git a/Tests/Conformance/C4.5.4.2.CC b/Tests/Conformance/C4.5.4.2.CC old mode 100755 new mode 100644 index 989a2aa..d7f961a --- a/Tests/Conformance/C4.5.4.2.CC +++ b/Tests/Conformance/C4.5.4.2.CC @@ -1 +1,105 @@ -/* Conformance Test 4.5.4.2: Verification of function declarators, using */ /* non-prototyped form */ #include #include /***************************************************************************/ static int I1 (func1, func2) int (*func1) (); int (*func2) (); { return ( ((*func1) ('a')) + ((*func2) (3.5)) ); } /***************************************************************************/ static int I2 (func) int (*func []) (); { int j; j = (*func) ('@'); j += (func[1]) ('@'); return j; } /***************************************************************************/ main () { int i; int Char1 (), Char2 (); /* define external functions */ int Float1 (), Float2(); int (*f1Ptr) (); /* pointer to function returning int */ int (*f2Ptr) (); int (*f1Array [3]) (); /* array of pointers to functions */ /* returning int */ f1Ptr = Char1; f2Ptr = Float2; i = I1 (f1Ptr, f2Ptr); if (i != 0xC3) goto Fail; f1Ptr = Char2; f2Ptr = Float1; i = I1 (f1Ptr, f2Ptr); if (i != 0xD4) goto Fail; i = I1 (Char1, Float1); if (i != 0xD3) goto Fail; f1Array [0] = Char1; f1Array [1] = Char2; f1Array [2] = NULL; i = I2 (f1Array); if (i != 0x143) goto Fail; printf ("Passed Conformance Test 4.5.4.2\n"); return; Fail: printf ("Failed Conformance Test 4.5.4.2\n"); } /***************************************************************************/ int Char1 (ch) char ch; { return (ch + 'a'); } /***************************************************************************/ int Char2 (ch) char ch; { return ((ch) + ('b')); } /***************************************************************************/ int Float1 (f) float f; { return (int) ((f) * 5.0); } /***************************************************************************/ int Float2 (f) float f; { return (int) (f / 2.0); } \ No newline at end of file +/* Conformance Test 4.5.4.2: Verification of function declarators, using */ +/* non-prototyped form */ + +#include +#include + +/***************************************************************************/ + +static int I1 (func1, func2) + int (*func1) (); + int (*func2) (); + { + return ( ((*func1) ('a')) + ((*func2) (3.5)) ); + } + +/***************************************************************************/ + +static int I2 (func) + int (*func []) (); + { + int j; + + j = (*func) ('@'); + j += (func[1]) ('@'); + return j; + } + +/***************************************************************************/ + + +main () + { + int i; + + int Char1 (), Char2 (); /* define external functions */ + int Float1 (), Float2(); + + int (*f1Ptr) (); /* pointer to function returning int */ + int (*f2Ptr) (); + int (*f1Array [3]) (); /* array of pointers to functions */ + /* returning int */ + + f1Ptr = Char1; + f2Ptr = Float2; + i = I1 (f1Ptr, f2Ptr); + if (i != 0xC3) + goto Fail; + + f1Ptr = Char2; + f2Ptr = Float1; + i = I1 (f1Ptr, f2Ptr); + if (i != 0xD4) + goto Fail; + + i = I1 (Char1, Float1); + if (i != 0xD3) + goto Fail; + + f1Array [0] = Char1; + f1Array [1] = Char2; + f1Array [2] = NULL; + i = I2 (f1Array); + if (i != 0x143) + goto Fail; + + + printf ("Passed Conformance Test 4.5.4.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 4.5.4.2\n"); + } + + +/***************************************************************************/ + +int Char1 (ch) + char ch; + { + return (ch + 'a'); + } + +/***************************************************************************/ + +int Char2 (ch) + char ch; + { + return ((ch) + ('b')); + } + +/***************************************************************************/ + +int Float1 (f) + float f; + { + return (int) ((f) * 5.0); + } + +/***************************************************************************/ + +int Float2 (f) + float f; + { + return (int) (f / 2.0); + } diff --git a/Tests/Conformance/C4.6.1.1.CC b/Tests/Conformance/C4.6.1.1.CC old mode 100755 new mode 100644 index 7cb2c74..2cb68ed --- a/Tests/Conformance/C4.6.1.1.CC +++ b/Tests/Conformance/C4.6.1.1.CC @@ -1 +1,47 @@ -/* Conformance Test 4.6.1.1: Initialization of integer variables */ #define ONE 1 #define TWO 2 /* static and extern variables can only be initialized with constant exprs */ static int i = 8 << 2 + 6 - 7 / 3 >> 1 * 5 % (sizeof (int)); long j = ONE <= 5; /* default storage class at top-level is extern */ char ch = ~'a' - 0x20; int gk = 0x7D; unsigned gu1 = 0x7D; main () { /* auto & register integers can be initialized with arbitrary expressions */ /* default storage class at head of block is auto */ int k = ch - j; unsigned u1 = gk | i & j; long m = (long) (gu1 ^ gk); unsigned long n = 4294967295ul >> gk; char chr = 'z' * (gk / 'b'); register int k1 = ch - j; register unsigned un1 = gk| i & j; register long m1 = (long) (gu1 ^ gk); register unsigned long n1 = 4294967295ul >> 8; register char chr1 = 'z' * (gk / 'b') + TWO; if ((i != 0x100) || (j != 1) || (ch != 0x7E) || (k != 0x7D) || (n1 != 0x00FFFFFF)) goto Fail; if ((m != 0) || (n != 0) || (chr != 0x7A) || (k1 != 0x7D) || (un1 != 0x7D)) goto Fail; if ((m1 != 0) || (chr1 != 0x7C)) goto Fail; printf ("Passed Conformance Test 4.6.1.1\n"); return; Fail: printf ("Failed Conformance Test 4.6.1.1\n"); } \ No newline at end of file +/* Conformance Test 4.6.1.1: Initialization of integer variables */ + +#define ONE 1 +#define TWO 2 + +/* static and extern variables can only be initialized with constant exprs */ + +static int i = 8 << 2 + 6 - 7 / 3 >> 1 * 5 % (sizeof (int)); + +long j = ONE <= 5; /* default storage class at top-level is extern */ +char ch = ~'a' - 0x20; +int gk = 0x7D; +unsigned gu1 = 0x7D; + +main () + { + /* auto & register integers can be initialized with arbitrary expressions */ + /* default storage class at head of block is auto */ + + int k = ch - j; + unsigned u1 = gk | i & j; + long m = (long) (gu1 ^ gk); + unsigned long n = 4294967295ul >> gk; + char chr = 'z' * (gk / 'b'); + + register int k1 = ch - j; + register unsigned un1 = gk| i & j; + register long m1 = (long) (gu1 ^ gk); + register unsigned long n1 = 4294967295ul >> 8; + register char chr1 = 'z' * (gk / 'b') + TWO; + + if ((i != 0x100) || (j != 1) || (ch != 0x7E) || (k != 0x7D) || + (n1 != 0x00FFFFFF)) + goto Fail; + + if ((m != 0) || (n != 0) || (chr != 0x7A) || (k1 != 0x7D) || (un1 != 0x7D)) + goto Fail; + + if ((m1 != 0) || (chr1 != 0x7C)) + goto Fail; + + printf ("Passed Conformance Test 4.6.1.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 4.6.1.1\n"); + } diff --git a/Tests/Conformance/C4.6.1.2.CC b/Tests/Conformance/C4.6.1.2.CC old mode 100755 new mode 100644 index 0e79eb9..638b0b7 --- a/Tests/Conformance/C4.6.1.2.CC +++ b/Tests/Conformance/C4.6.1.2.CC @@ -1 +1,52 @@ -/* Conformance Test 4.6.1.2: Initialization of integer variables, using */ /* curly-braced expressions. Verification of */ /* zeroing of non-initialized static variables */ /* is also checked. */ #define ONE 1 #define TWO 2 /* static and extern variables can only be initialized with constant exprs */ static int i; long j = { ONE <= 5 }; /* default storage class at top-level is extern */ char ch = {~'a' - 0x20}; main () { /* auto & register integers can be initialized with arbitrary expressions */ /* default storage class at head of block is auto */ static char chr8; static long longStatic; int k = { ch - j }; { unsigned u1 = {k | i & j}; { long m = {(long) (u1 ^ k)}; unsigned long n = { 4294967295ul >> k }; char chr = { 'z' * (k / 'b') }; register int k1 = {ch - j}; register unsigned un1 = {k | i & j}; { register long m1 = { (long) (u1 ^ k) }; register unsigned long n1 = { 4294967295ul >> 8 }; register char chr1 = { 'z' * (k / 'b') + TWO }; if ((i != 0) || (j != 1) || (ch != 0x7E) || (k != 0x7D) || (n1 != 0x00FFFFFF)) goto Fail; if ((m != 0) || (n != 0) || (chr != 0x7A) || (k1 != 0x7D) || (un1 != 0x7D)) goto Fail; if ((m1 != 0) || (n1 != 0x00FFFFFF) || (chr1 != 0x7C) || (chr8 != 0) || \ (longStatic != 0)) goto Fail; printf ("Passed Conformance Test 4.6.1.2\n"); return; Fail: printf ("Failed Conformance Test 4.6.1.2\n"); }}} } \ No newline at end of file +/* Conformance Test 4.6.1.2: Initialization of integer variables, using */ +/* curly-braced expressions. Verification of */ +/* zeroing of non-initialized static variables */ +/* is also checked. */ + +#define ONE 1 +#define TWO 2 + +/* static and extern variables can only be initialized with constant exprs */ + +static int i; + +long j = { ONE <= 5 }; /* default storage class at top-level is extern */ +char ch = {~'a' - 0x20}; + +main () + { + /* auto & register integers can be initialized with arbitrary expressions */ + /* default storage class at head of block is auto */ + + static char chr8; + static long longStatic; + + int k = { ch - j }; +{ unsigned u1 = {k | i & j}; +{ long m = {(long) (u1 ^ k)}; + unsigned long n = { 4294967295ul >> k }; + char chr = { 'z' * (k / 'b') }; + + register int k1 = {ch - j}; + register unsigned un1 = {k | i & j}; +{ register long m1 = { (long) (u1 ^ k) }; + register unsigned long n1 = { 4294967295ul >> 8 }; + register char chr1 = { 'z' * (k / 'b') + TWO }; + + if ((i != 0) || (j != 1) || (ch != 0x7E) || (k != 0x7D) || (n1 != 0x00FFFFFF)) + goto Fail; + + if ((m != 0) || (n != 0) || (chr != 0x7A) || (k1 != 0x7D) || (un1 != 0x7D)) + goto Fail; + + if ((m1 != 0) || (n1 != 0x00FFFFFF) || (chr1 != 0x7C) || (chr8 != 0) || \ + (longStatic != 0)) + goto Fail; + + printf ("Passed Conformance Test 4.6.1.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 4.6.1.2\n"); +}}} + } diff --git a/Tests/Conformance/C4.6.2.1.CC b/Tests/Conformance/C4.6.2.1.CC old mode 100755 new mode 100644 index 02bb2fe..f55e143 --- a/Tests/Conformance/C4.6.2.1.CC +++ b/Tests/Conformance/C4.6.2.1.CC @@ -1 +1,69 @@ -/* Conformance Test 4.6.2.1: Verification of floating-point initializers */ /* static and extern variables are restricted to constant expressions */ #include static float f1 = -1.0E2 + (float) 2 * 5.0 / 20.0 - (double) 6; static double d1 = 89.76E5 * 17.6 - (extended) 1 + (float) (-3) / 8.; static extended e1 = 9.9 * 7.1 + 0.03 - (extended) 2 / (float) (0 && 3.0 || 2); float f2 = 5.1 * 7 - 88 / 4 + (extended) (double) (float) 8; double d2 = 10.0e20 / 0.04E-6; extended e2 = 15.5 - .5 * 3 + 1; main () { /* auto and register variables can use any arithmetic expression */ float f3 = f1 * f2 / 1; double d3 = 8.1; { extended e3 = e1 && e2 || d3 - f3; { register float f4 = f3; register double d4 = f3 / 2.0; { register extended e4 = d4 + (extended) 8.88 - f1 / 5.0; if (fabs(f1 - (-105.5)) > 0.00001) goto Fail; if (fabs(f2 - 21.7) > 0.00001) goto Fail; if (fabs(f3 - (-2289.35)) > 0.001) goto Fail; if (fabs(f4 - (-2289.35)) > 0.001) goto Fail; if (fabs(d1 - 157977600.0) > 100.0) goto Fail; if (fabs(d2 - 2.5e28) > 1e21) goto Fail; if (fabs(d3 - 8.1) > 0.00001) goto Fail; if (fabs(d4 - (-1144.675)) > 0.01) goto Fail; if (fabs(e1 - 68.32) > 0.0001) goto Fail; if (fabs(e2 - 15.0) > 0.0001) goto Fail; if (fabs(e3 - 1.0) > 0.00001) goto Fail; if (fabs(e4 - (-1114.695)) > 0.001) goto Fail; printf ("Passed Conformance Test 4.6.2.1\n"); return; Fail: printf ("Failed Conformance Test 4.6.2.1\n"); }}} } \ No newline at end of file +/* Conformance Test 4.6.2.1: Verification of floating-point initializers */ + +/* static and extern variables are restricted to constant expressions */ + +#include + +static float f1 = -1.0E2 + (float) 2 * 5.0 / 20.0 - (double) 6; +static double d1 = 89.76E5 * 17.6 - (extended) 1 + (float) (-3) / 8.; +static extended e1 = 9.9 * 7.1 + 0.03 - (extended) 2 / (float) (0 && 3.0 || 2); + +float f2 = 5.1 * 7 - 88 / 4 + (extended) (double) (float) 8; +double d2 = 10.0e20 / 0.04E-6; +extended e2 = 15.5 - .5 * 3 + 1; + +main () + { + /* auto and register variables can use any arithmetic expression */ + + float f3 = f1 * f2 / 1; + double d3 = 8.1; +{ extended e3 = e1 && e2 || d3 - f3; + +{ register float f4 = f3; + register double d4 = f3 / 2.0; +{ register extended e4 = d4 + (extended) 8.88 - f1 / 5.0; + + if (fabs(f1 - (-105.5)) > 0.00001) + goto Fail; + + if (fabs(f2 - 21.7) > 0.00001) + goto Fail; + + if (fabs(f3 - (-2289.35)) > 0.001) + goto Fail; + + if (fabs(f4 - (-2289.35)) > 0.001) + goto Fail; + + if (fabs(d1 - 157977600.0) > 100.0) + goto Fail; + + if (fabs(d2 - 2.5e28) > 1e21) + goto Fail; + + if (fabs(d3 - 8.1) > 0.00001) + goto Fail; + + if (fabs(d4 - (-1144.675)) > 0.01) + goto Fail; + + if (fabs(e1 - 68.32) > 0.0001) + goto Fail; + + if (fabs(e2 - 15.0) > 0.0001) + goto Fail; + + if (fabs(e3 - 1.0) > 0.00001) + goto Fail; + + if (fabs(e4 - (-1114.695)) > 0.001) + goto Fail; + + printf ("Passed Conformance Test 4.6.2.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 4.6.2.1\n"); +}}} + } diff --git a/Tests/Conformance/C4.6.2.2.CC b/Tests/Conformance/C4.6.2.2.CC old mode 100755 new mode 100644 index 2527a1c..0470d66 --- a/Tests/Conformance/C4.6.2.2.CC +++ b/Tests/Conformance/C4.6.2.2.CC @@ -1 +1,81 @@ -/* Conformance Test 4.6.2.1: Verification of floating-point initializers */ /* Ensure non-initialized static variables are */ /* zeroed, and that curly braces can enclose */ /* initialization expression. */ /* static and extern variables are restricted to constant expressions */ #include static float f1 = { -1.0E2 + (float) 2 * 5.0 / 20.0 - (double) 6 }; static double d1 = { 89.76E5 * 17.6 - (extended) 1 + (float) (-3) / 8.0 }; static extended e1; static float f0; float f2 = 5.1 * 7 - 88 / 4 + (extended) (double) (float) 8; double d2 = { 10.0e20 / 0.04E-6 }; extended e2 = 15.5 - .5 * 3 + 1; main () { static double d0; /* auto and register variables can use any arithmetic expression */ float f3 = {f1 * f2 / 1}; double d3 = 8.1; { extended e3 = {e1 && e2 || d3 - f3}; register float f4 = {f3}; register double d4 = {f3 / 2.0}; { register extended e4 = d4 + (extended) 8.88 - f1 / 5.0; if (fabs(f1 - (-105.5)) > 0.0001) goto Fail; if (fabs(f2 - 21.7) > 0.0001) goto Fail; if (fabs(f3 - (-2289.35)) > 0.01) goto Fail; if (fabs(f4 - (-2289.35)) > 0.01) goto Fail; if (fabs(d1 - 157977598.625) > 1.0000) goto Fail; if (fabs(d2 - 2.5e28) > 1e23) goto Fail; if (fabs(d3 - 8.1) > 0.00001) goto Fail; if (fabs(d4 - (-1144.675)) > 0.01) goto Fail; if (fabs(e1) > 0.00001) goto Fail; if (fabs(e2 - 15.0) > 0.0001) goto Fail; if (fabs(e3 - 1.0) > 0.00001) goto Fail; if (fabs(e4 - (-1114.695)) > 0.001) goto Fail; if (fabs(f0) > 0.00001) goto Fail; if (fabs(d0) > 0.00001) goto Fail; printf ("Passed Conformance Test 4.6.2.2\n"); return; Fail: printf ("Failed Conformance Test 4.6.2.2\n"); }}} \ No newline at end of file +/* Conformance Test 4.6.2.1: Verification of floating-point initializers */ +/* Ensure non-initialized static variables are */ +/* zeroed, and that curly braces can enclose */ +/* initialization expression. */ + +/* static and extern variables are restricted to constant expressions */ + +#include + +static float f1 = { -1.0E2 + (float) 2 * 5.0 / 20.0 - (double) 6 }; +static double d1 = { 89.76E5 * 17.6 - (extended) 1 + (float) (-3) / 8.0 }; +static extended e1; +static float f0; + +float f2 = 5.1 * 7 - 88 / 4 + (extended) (double) (float) 8; +double d2 = { 10.0e20 / 0.04E-6 }; +extended e2 = 15.5 - .5 * 3 + 1; + +main () + { + static double d0; + + /* auto and register variables can use any arithmetic expression */ + + float f3 = {f1 * f2 / 1}; + double d3 = 8.1; +{ extended e3 = {e1 && e2 || d3 - f3}; + + register float f4 = {f3}; + register double d4 = {f3 / 2.0}; +{ register extended e4 = d4 + (extended) 8.88 - f1 / 5.0; + + if (fabs(f1 - (-105.5)) > 0.0001) + goto Fail; + + if (fabs(f2 - 21.7) > 0.0001) + goto Fail; + + if (fabs(f3 - (-2289.35)) > 0.01) + goto Fail; + + if (fabs(f4 - (-2289.35)) > 0.01) + goto Fail; + + if (fabs(d1 - 157977598.625) > 1.0000) + goto Fail; + + if (fabs(d2 - 2.5e28) > 1e23) + goto Fail; + + if (fabs(d3 - 8.1) > 0.00001) + goto Fail; + + if (fabs(d4 - (-1144.675)) > 0.01) + goto Fail; + + if (fabs(e1) > 0.00001) + goto Fail; + + if (fabs(e2 - 15.0) > 0.0001) + goto Fail; + + if (fabs(e3 - 1.0) > 0.00001) + goto Fail; + + if (fabs(e4 - (-1114.695)) > 0.001) + goto Fail; + + if (fabs(f0) > 0.00001) + goto Fail; + + if (fabs(d0) > 0.00001) + goto Fail; + + printf ("Passed Conformance Test 4.6.2.2\n"); + + return; + +Fail: + printf ("Failed Conformance Test 4.6.2.2\n"); +}}} diff --git a/Tests/Conformance/C4.6.3.1.CC b/Tests/Conformance/C4.6.3.1.CC old mode 100755 new mode 100644 index 78f0283..7a8b7e5 --- a/Tests/Conformance/C4.6.3.1.CC +++ b/Tests/Conformance/C4.6.3.1.CC @@ -1 +1,100 @@ -/* Conformance Test 4.6.3.1: Verification of pointer initializers */ /* static and extern pointer variables can use only constant expressions */ #include struct S { int a; float b; }; union U { int i; long L; }; enum E { a, b, c }; static int *i1Ptr = NULL; /* constant expression can contain NULL */ static char *ch1Ptr = NULL; static long *L1Ptr = NULL; static comp *c1Ptr = NULL; static float *f1Ptr = NULL; static double *d1Ptr = NULL; static extended *e1Ptr = NULL; static unsigned int *ui1Ptr = NULL; static unsigned long *uL1Ptr = NULL; static struct S *struct1Ptr = NULL; static union U *union1Ptr = NULL; static enum E *enum1Ptr = NULL; int *i2Ptr = NULL; char *ch2Ptr = NULL; long *L2Ptr = NULL; comp *c2Ptr = NULL; float *f2Ptr = NULL; double *d2Ptr = NULL; extended *e2Ptr = NULL; unsigned int *ui2Ptr = NULL; unsigned long *uL2Ptr = NULL; struct S *struct2Ptr = NULL; union U *union2Ptr = NULL; enum E *enum2Ptr = NULL; main () { /* local pointer variables can also be set to NULL */ int *i3Ptr = NULL; char *ch3Ptr = NULL; long *L3Ptr = NULL; comp *c3Ptr = NULL; float *f3Ptr = NULL; double *d3Ptr = NULL; extended *e3Ptr = NULL; unsigned int *ui3Ptr = NULL; unsigned long *uL3Ptr = NULL; struct S *struct3Ptr = NULL; union U *union3Ptr = NULL; enum E *enum3Ptr = NULL; if ((i1Ptr != 0) || (i2Ptr != 0) || (i3Ptr != 0)) goto Fail; if ((ch1Ptr != 0) || (ch2Ptr != 0) || (ch3Ptr != 0)) goto Fail; if ((L1Ptr != 0) || (L2Ptr != 0) || (L3Ptr != 0)) goto Fail; if ((c1Ptr != 0) || (c2Ptr != 0) || (c3Ptr != 0)) goto Fail; if ((f1Ptr != 0) || (f2Ptr != 0) || (f3Ptr != 0)) goto Fail; if ((d1Ptr != 0) || (d2Ptr != 0) || (d3Ptr != 0)) goto Fail; if ((e1Ptr != 0) || (e2Ptr != 0) || (e3Ptr != 0)) goto Fail; if ((ui1Ptr != 0) || (ui2Ptr != 0) || (ui3Ptr != 0)) goto Fail; if ((uL1Ptr != 0) || (uL2Ptr != 0) || (uL3Ptr != 0)) goto Fail; if ((struct1Ptr != 0) || (struct2Ptr != 0) || (struct3Ptr != 0)) goto Fail; if ((union1Ptr != 0) || (union2Ptr != 0) || (union3Ptr != 0)) goto Fail; printf ("Passed Conformance Test 4.6.3.1\n"); return; Fail: printf ("Failed Conformance Test 4.6.3.1\n"); } \ No newline at end of file +/* Conformance Test 4.6.3.1: Verification of pointer initializers */ + +/* static and extern pointer variables can use only constant expressions */ + +#include + +struct S { int a; + float b; }; +union U { int i; + long L; }; +enum E { a, b, c }; + +static int *i1Ptr = NULL; /* constant expression can contain NULL */ +static char *ch1Ptr = NULL; +static long *L1Ptr = NULL; +static comp *c1Ptr = NULL; +static float *f1Ptr = NULL; +static double *d1Ptr = NULL; +static extended *e1Ptr = NULL; + +static unsigned int *ui1Ptr = NULL; +static unsigned long *uL1Ptr = NULL; + +static struct S *struct1Ptr = NULL; +static union U *union1Ptr = NULL; +static enum E *enum1Ptr = NULL; + +int *i2Ptr = NULL; +char *ch2Ptr = NULL; +long *L2Ptr = NULL; +comp *c2Ptr = NULL; +float *f2Ptr = NULL; +double *d2Ptr = NULL; +extended *e2Ptr = NULL; + +unsigned int *ui2Ptr = NULL; +unsigned long *uL2Ptr = NULL; + +struct S *struct2Ptr = NULL; +union U *union2Ptr = NULL; +enum E *enum2Ptr = NULL; + +main () + { + /* local pointer variables can also be set to NULL */ + + int *i3Ptr = NULL; + char *ch3Ptr = NULL; + long *L3Ptr = NULL; + comp *c3Ptr = NULL; + float *f3Ptr = NULL; + double *d3Ptr = NULL; + extended *e3Ptr = NULL; + + unsigned int *ui3Ptr = NULL; + unsigned long *uL3Ptr = NULL; + + struct S *struct3Ptr = NULL; + union U *union3Ptr = NULL; + enum E *enum3Ptr = NULL; + + if ((i1Ptr != 0) || (i2Ptr != 0) || (i3Ptr != 0)) + goto Fail; + + if ((ch1Ptr != 0) || (ch2Ptr != 0) || (ch3Ptr != 0)) + goto Fail; + + if ((L1Ptr != 0) || (L2Ptr != 0) || (L3Ptr != 0)) + goto Fail; + + if ((c1Ptr != 0) || (c2Ptr != 0) || (c3Ptr != 0)) + goto Fail; + + if ((f1Ptr != 0) || (f2Ptr != 0) || (f3Ptr != 0)) + goto Fail; + + if ((d1Ptr != 0) || (d2Ptr != 0) || (d3Ptr != 0)) + goto Fail; + + if ((e1Ptr != 0) || (e2Ptr != 0) || (e3Ptr != 0)) + goto Fail; + + if ((ui1Ptr != 0) || (ui2Ptr != 0) || (ui3Ptr != 0)) + goto Fail; + + if ((uL1Ptr != 0) || (uL2Ptr != 0) || (uL3Ptr != 0)) + goto Fail; + + if ((struct1Ptr != 0) || (struct2Ptr != 0) || (struct3Ptr != 0)) + goto Fail; + + if ((union1Ptr != 0) || (union2Ptr != 0) || (union3Ptr != 0)) + goto Fail; + + printf ("Passed Conformance Test 4.6.3.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 4.6.3.1\n"); + } diff --git a/Tests/Conformance/C4.6.3.2.CC b/Tests/Conformance/C4.6.3.2.CC old mode 100755 new mode 100644 index ed6c72f..bcaf366 --- a/Tests/Conformance/C4.6.3.2.CC +++ b/Tests/Conformance/C4.6.3.2.CC @@ -1 +1,187 @@ -/* Conformance Test 4.6.3.2: Verification of local pointer initializers */ #include struct S { int a; float b; }; union U { int i; long L; }; enum E { a, b, c }; /******************************************************************************/ int I1 (void) { return 32760; } /******************************************************************************/ long Long1 (void) { return 2147483647; } /******************************************************************************/ char Ch1 (void) { return 'm'; } /******************************************************************************/ extended E1 (void) { return 189.0E50; } /******************************************************************************/ main () { static int IDisp (int (*func) (void)); /* declare dispatcher rtns */ static char ChDisp (char (*func) (void)); static long LDisp (long (*func) (void)); static extended EDisp (extended (*func) (void)); int i1 = 8 * 10; /* define local variables */ char ch1 = 'P'; long L1 = { 0x12345678 - 0x78 }; comp c1 = { 0x12345678 }; float f1 = 98.6e-00; double d1 = 15.7e10; extended e1 = 9.8E45; unsigned int ui1 = 65535; unsigned long ul1 = { 42959796 }; struct S struct1 = { 3, 3.3 }; union U union1 = 5; enum E enum1 = c; int i2 [2] = { 160, 140 }; /* define local arrays */ char ch2 [2] = { 'e', 'O' }; long L2 [2] = { 40, 0x12345600 }; comp c2 [2] = { 0x12345678, 0x12345678 }; float f2 [2] = { 1.0, 1.0 }; double d2 [2] = { 15.7e10, 1.0 }; extended e2 [2] = { 9.8E45, 8.9E-45 }; unsigned int ui2 [2] = { 0x3FFF }; unsigned long ul2 [2] = { 0x51f0768 }; int (*i3Ptr) (void) = I1; /* pointers to functions */ char (*ch3Ptr) (void) = Ch1; long (*L3Ptr) (void) = Long1; extended (*e3Ptr) (void) = E1; int *i4Ptr = i2; /* array names */ char *ch4Ptr = ch2 + 1; long *L4Ptr = L2 + 1; comp *c4Ptr = c2 + 2 - 1; float *f4Ptr = f2; double *d4Ptr = d2 - 0; extended *e4Ptr = e2 + 1; unsigned int *ui4Ptr = ui2; unsigned long *uL4Ptr = ul2 + 1; struct S *struct5Ptr = &struct1; /* addresses of local variables */ union U *union5Ptr = &union1; enum E *enum5Ptr = &enum1; int *i5 = &i1; char *ch5 = &ch1; long *L5 = &L1; comp *c5 = &c1; float *f5 = &f1; double *d5 = &d1; extended *e5 = &e1; unsigned int *ui5 = &ui1; unsigned long *ul5 = &ul1; /* First ensure correctness of pointers to scalars */ if ((*i5 != 80) || (*ch5 != 'P') || (*L5 != 0x12345600) || (*c5 != 0x12345678) || (fabs(*f5 - 98.6) > 0.00001) || (fabs(*d5 - 15.7e10) > 0.00001) || (fabs(*e5 - 9.8e45) > 0.00001) || (*ui5 != 65535) || (*ul5 != 42959796)) goto Fail; /* Verify pointers to local arrays */ if (*i4Ptr != 160) goto Fail; if (*ch4Ptr != 'O') goto Fail; if (*L4Ptr != 0x12345600) goto Fail; if (*c4Ptr != 0x12345678) goto Fail; if (fabs(*f4Ptr - 1.0) > 0.00001) goto Fail; if (fabs(*d4Ptr - 15.7E10) > 0.00001) goto Fail; if (fabs(*e4Ptr - 8.9E-45) > 1e-50) goto Fail; if (*ui4Ptr != 0x3FFF) goto Fail; if (*uL4Ptr != 0) goto Fail; if (struct5Ptr->a != 3) goto Fail; if (fabs(struct5Ptr->b - 3.3) > 0.00001) goto Fail; if (union5Ptr->i != 5) goto Fail; if (*enum5Ptr != c) goto Fail; /* Verify pointers to functions */ i1 = IDisp (i3Ptr); if (i1 != 32760) goto Fail; ch1 = ChDisp (ch3Ptr); if (ch1 != 'm') goto Fail; L1 = LDisp (L3Ptr); if (L1 != 2147483647) goto Fail; e1 = EDisp (e3Ptr); if (fabs(e1 - 189.0E50) > 0.00001) goto Fail; printf ("Passed Conformance Test 4.6.3.2\n"); return; Fail: printf ("Failed Conformance Test 4.6.3.2\n"); } /******************************************************************************/ static int IDisp (int (*func) (void)) { return func (); } /******************************************************************************/ static char ChDisp (char (*func) (void)) { return func (); } /******************************************************************************/ static long LDisp (long (*func) (void)) { return func (); } /******************************************************************************/ static extended EDisp (extended (*func) (void)) { return func (); } \ No newline at end of file +/* Conformance Test 4.6.3.2: Verification of local pointer initializers */ + +#include + +struct S { int a; + float b; }; +union U { int i; + long L; }; +enum E { a, b, c }; + + +/******************************************************************************/ + +int I1 (void) + { + return 32760; + } + +/******************************************************************************/ + +long Long1 (void) + { + return 2147483647; + } + +/******************************************************************************/ + +char Ch1 (void) + { + return 'm'; + } + +/******************************************************************************/ + +extended E1 (void) + { + return 189.0E50; + } + + +/******************************************************************************/ + +main () + { + + static int IDisp (int (*func) (void)); /* declare dispatcher rtns */ + static char ChDisp (char (*func) (void)); + static long LDisp (long (*func) (void)); + static extended EDisp (extended (*func) (void)); + + int i1 = 8 * 10; /* define local variables */ + char ch1 = 'P'; + long L1 = { 0x12345678 - 0x78 }; + comp c1 = { 0x12345678 }; + float f1 = 98.6e-00; + double d1 = 15.7e10; + extended e1 = 9.8E45; + + unsigned int ui1 = 65535; + unsigned long ul1 = { 42959796 }; + + struct S struct1 = { 3, 3.3 }; + union U union1 = 5; + enum E enum1 = c; + + int i2 [2] = { 160, 140 }; /* define local arrays */ + char ch2 [2] = { 'e', 'O' }; + long L2 [2] = { 40, 0x12345600 }; + comp c2 [2] = { 0x12345678, 0x12345678 }; + float f2 [2] = { 1.0, 1.0 }; + double d2 [2] = { 15.7e10, 1.0 }; + extended e2 [2] = { 9.8E45, 8.9E-45 }; + + unsigned int ui2 [2] = { 0x3FFF }; + unsigned long ul2 [2] = { 0x51f0768 }; + + + int (*i3Ptr) (void) = I1; /* pointers to functions */ + char (*ch3Ptr) (void) = Ch1; + long (*L3Ptr) (void) = Long1; + extended (*e3Ptr) (void) = E1; + + int *i4Ptr = i2; /* array names */ + char *ch4Ptr = ch2 + 1; + long *L4Ptr = L2 + 1; + comp *c4Ptr = c2 + 2 - 1; + float *f4Ptr = f2; + double *d4Ptr = d2 - 0; + extended *e4Ptr = e2 + 1; + + unsigned int *ui4Ptr = ui2; + unsigned long *uL4Ptr = ul2 + 1; + + struct S *struct5Ptr = &struct1; /* addresses of local variables */ + union U *union5Ptr = &union1; + enum E *enum5Ptr = &enum1; + + int *i5 = &i1; + char *ch5 = &ch1; + long *L5 = &L1; + comp *c5 = &c1; + float *f5 = &f1; + double *d5 = &d1; + extended *e5 = &e1; + + unsigned int *ui5 = &ui1; + unsigned long *ul5 = &ul1; + + + /* First ensure correctness of pointers to scalars */ + + if ((*i5 != 80) || (*ch5 != 'P') || (*L5 != 0x12345600) || + (*c5 != 0x12345678) || (fabs(*f5 - 98.6) > 0.00001) || + (fabs(*d5 - 15.7e10) > 0.00001) || + (fabs(*e5 - 9.8e45) > 0.00001) || (*ui5 != 65535) || (*ul5 != 42959796)) + goto Fail; + + /* Verify pointers to local arrays */ + + if (*i4Ptr != 160) goto Fail; + if (*ch4Ptr != 'O') goto Fail; + if (*L4Ptr != 0x12345600) goto Fail; + if (*c4Ptr != 0x12345678) goto Fail; + if (fabs(*f4Ptr - 1.0) > 0.00001) goto Fail; + if (fabs(*d4Ptr - 15.7E10) > 0.00001) goto Fail; + if (fabs(*e4Ptr - 8.9E-45) > 1e-50) goto Fail; + if (*ui4Ptr != 0x3FFF) goto Fail; + if (*uL4Ptr != 0) goto Fail; + if (struct5Ptr->a != 3) goto Fail; + if (fabs(struct5Ptr->b - 3.3) > 0.00001) goto Fail; + if (union5Ptr->i != 5) goto Fail; + if (*enum5Ptr != c) goto Fail; + + /* Verify pointers to functions */ + + i1 = IDisp (i3Ptr); + if (i1 != 32760) + goto Fail; + + ch1 = ChDisp (ch3Ptr); + if (ch1 != 'm') + goto Fail; + + L1 = LDisp (L3Ptr); + if (L1 != 2147483647) + goto Fail; + + e1 = EDisp (e3Ptr); + if (fabs(e1 - 189.0E50) > 0.00001) + goto Fail; + + + printf ("Passed Conformance Test 4.6.3.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 4.6.3.2\n"); + } + + +/******************************************************************************/ + +static int IDisp (int (*func) (void)) + { + return func (); + } + +/******************************************************************************/ + +static char ChDisp (char (*func) (void)) + { + return func (); + } + +/******************************************************************************/ + +static long LDisp (long (*func) (void)) + { + return func (); + } + +/******************************************************************************/ + +static extended EDisp (extended (*func) (void)) + { + return func (); + } diff --git a/Tests/Conformance/C4.6.4.1.CC b/Tests/Conformance/C4.6.4.1.CC old mode 100755 new mode 100644 index d1fe5ce..bf93c16 --- a/Tests/Conformance/C4.6.4.1.CC +++ b/Tests/Conformance/C4.6.4.1.CC @@ -1 +1,183 @@ -/* Conformance Test 4.6.4.1: Test initialization of static and extern arrays */ #include #include /* Check size supplied by compiler */ static int i1 [] = { 1, 2, 3 }; static int i2 [] [2] = { {4, 5}, {6, 7}, {8, 9} }; static extended e1 [] = { 1.0, 2.0, 3.0, 4.0 }; static extended e2 [] [3] = { {1.1, 1.2, 1.3}, {2.2, 2.3, 2.4} }; char ch1 [] = "Now is the time"; char ch2 [] [20] = { "for all good people", "to come to the aid " }; double d1 [] = { 5.4, 5.5, 5.6, 5.7 }; double d2 [] [2] [3] = { { {6.6, 6.7, 6.8}, {7.7, 7.8, 7.9} }, { {8.8, 8.9, 9.0}, {3.3, 3.4, 3.5} }, { {4.4, 4.5, 4.6}, {5.5, 5.6, 5.7} } }; /* Ensure that missing values are zeroed */ static long L1 [4] = { 2, 3 }; extended e3 [5] = { 1.1, 2.2, 3.3 }; static struct S1 { int x, y, z; float a, b, c; } s1 [3] = { { 1, 2, 3, 2.0, 3.0, 4.0 } }; struct S2 { char ch1, ch2; double d1, d2; } s2 [4] = { {'a', 'b', 3.3, 4.4}, {'l', 'm', 3.5, 4.6} }; main () { int i, j, k, m; /* local variables */ double d3; extended e4; /* Check sizes of arrays */ if ((sizeof (i1) != 6) || (sizeof (i2) != 12) || (sizeof (e1) != 40) || (sizeof (e2) != 60) || (sizeof (ch1) != 16) || (sizeof (ch2) != 40)) goto Fail; if ((sizeof (d1) != 32) || (sizeof (d2) != 144) || (sizeof (L1) != 16) || (sizeof (e3) != 50) || (sizeof (s1) != 54) || (sizeof (s2) != 72)) goto Fail; /* Check array contents */ for (i = 0; i < 3; i++) /* i1 */ if (i1 [i] != i + 1) goto Fail; for (i = 0, k = 4; i < 3; i++) /* i2 */ for (j = 0; j < 2; j++) { if (i2 [i] [j] != k) goto Fail; k += 1; } for (i = 0, e4 = 1.0; i < 4; i++) /* e1 */ { if (e1 [i] != e4) goto Fail; e4 += 1.0; } for (e4 = 1.1, i = 0; i < 3; i++) /* e2 */ { if (fabs(e2 [0] [i] - e4) > 0.00001) goto Fail; e4 += 0.1; } for (e4 = 2.2, i = 0; i < 3; i++) { if (fabs(e2 [1] [i] - e4) > 0.00001) goto Fail; e4 += 0.1; } if (strcmp (ch1, "Now is the time")) /* ch1 */ goto Fail; if ((strcmp (&ch2 [1], "to come to the aid ")) || /* ch2 */ (strcmp (&ch2 [0], "for all good people"))) goto Fail; for (d3 = 5.4, i = 0; i < 4; i++) /* d1 */ { if (fabs(d1 [i] - d3) > 0.00001) goto Fail; d3 += 0.1; } for (d3 = 6.6, i = 0; i < 3; i++) /* 0,0,0-2 of d2 */ /* d2 */ { if (fabs(d2 [0] [0] [i] - d3) > 0.00001) goto Fail; d3 += 0.1; } for (d3 = 7.7, i = 0; i < 3; i++) /* 0,1,0-2 of d2 */ { if (fabs(d2 [0] [1] [i] - d3) > 0.00001) goto Fail; d3 += 0.1; } for (d3 = 8.8, i = 0; i < 3; i++) /* 1,0,0-2 of d2 */ { if (fabs(d2 [1] [0] [i] - d3) > 0.00001) goto Fail; d3 += 0.1; } for (d3 = 3.3, i = 0; i < 3; i++) /* 1,1,0-2 of d2 */ { if (fabs(d2 [1] [1] [i] - d3) > 0.00001) goto Fail; d3 += 0.1; } for (d3 = 4.4, i = 0; i < 3; i++) /* 2,0,0-2 of d2 */ { if (fabs(d2 [2] [0] [i] - d3) > 0.00001) goto Fail; d3 += 0.1; } for (d3 = 5.5, i = 0; i < 3; i++) /* 2,1,0-2 of d2 */ { if (fabs(d2 [2] [1] [i] - d3) > 0.00001) goto Fail; d3 += 0.1; } /* L1 */ if ((L1 [0] != 2) || (L1 [1] != 3) || (L1 [2] != 0) || (L1 [3] != 0)) goto Fail; /* e3 */ if ((fabs(e3 [0] - 1.1) > 0.00001) || (fabs(e3 [1] - 2.2) > 0.00001) || (fabs(e3 [2] - 3.3) > 0.00001) || (fabs(e3 [3]) > 0.00001) || (fabs(e3 [4] ) > 0.00001)) goto Fail; /* s1 */ if ((s1 [0].x != 1) || (s1 [0].y != 2) || (s1 [0].z != 3) || (fabs(s1 [0].a - 2.0) > 0.00001) || (fabs(s1 [0].b - 3.0) > 0.00001) || (fabs(s1 [0].c - 4.0) > 0.00001)) goto Fail; for (i = 1; i < 3; i++) if ((s1 [i].x != 0) || (s1 [i].y != 0) || (s1 [i].z != 0) || (s1 [i].a != 0.0) || (s1 [i].b != 0.0) || (s1 [i].c != 0.0)) goto Fail; /* s2 */ if ((s2 [0].ch1 != 'a') || (s2 [0].ch2 != 'b') || (s2 [1].ch1 != 'l') || (s2 [1].ch2 != 'm')) goto Fail; if ((fabs(s2 [0].d1 - 3.3) > 0.00001) || (fabs(s2 [0].d2 - 4.4) > 0.00001) || (fabs(s2 [1].d1 - 3.5) > 0.00001) || (fabs(s2 [1].d2 - 4.6) > 0.00001)) goto Fail; for (i = 2; i < 4; i++) if ((s2 [i].ch1 != 0) || (s2 [i].ch2 != 0) || (s2 [i].d1 != 0.0) || (s2 [i].d2 != 0.0)) goto Fail; printf ("Passed Conformance Test 4.6.4.1\n"); return; Fail: printf ("Failed Conformance Test 4.6.4.1\n"); } \ No newline at end of file +/* Conformance Test 4.6.4.1: Test initialization of static and extern arrays */ + +#include +#include + +/* Check size supplied by compiler */ + +static int i1 [] = { 1, 2, 3 }; +static int i2 [] [2] = { {4, 5}, {6, 7}, {8, 9} }; + +static extended e1 [] = { 1.0, 2.0, 3.0, 4.0 }; +static extended e2 [] [3] = { {1.1, 1.2, 1.3}, {2.2, 2.3, 2.4} }; + +char ch1 [] = "Now is the time"; +char ch2 [] [20] = { "for all good people", "to come to the aid " }; + +double d1 [] = { 5.4, 5.5, 5.6, 5.7 }; +double d2 [] [2] [3] = { { {6.6, 6.7, 6.8}, {7.7, 7.8, 7.9} }, + { {8.8, 8.9, 9.0}, {3.3, 3.4, 3.5} }, + { {4.4, 4.5, 4.6}, {5.5, 5.6, 5.7} } }; + +/* Ensure that missing values are zeroed */ + +static long L1 [4] = { 2, 3 }; +extended e3 [5] = { 1.1, 2.2, 3.3 }; + +static struct S1 { int x, y, z; + float a, b, c; } s1 [3] = { { 1, 2, 3, 2.0, 3.0, 4.0 } }; +struct S2 { char ch1, ch2; + double d1, d2; } s2 [4] = { {'a', 'b', 3.3, 4.4}, + {'l', 'm', 3.5, 4.6} }; + +main () + { + int i, j, k, m; /* local variables */ + double d3; + extended e4; + + /* Check sizes of arrays */ + if ((sizeof (i1) != 6) || (sizeof (i2) != 12) || (sizeof (e1) != 40) || + (sizeof (e2) != 60) || (sizeof (ch1) != 16) || (sizeof (ch2) != 40)) + goto Fail; + + if ((sizeof (d1) != 32) || (sizeof (d2) != 144) || (sizeof (L1) != 16) || + (sizeof (e3) != 50) || (sizeof (s1) != 54) || (sizeof (s2) != 72)) + goto Fail; + + /* Check array contents */ + + for (i = 0; i < 3; i++) /* i1 */ + if (i1 [i] != i + 1) + goto Fail; + + for (i = 0, k = 4; i < 3; i++) /* i2 */ + for (j = 0; j < 2; j++) + { + if (i2 [i] [j] != k) + goto Fail; + k += 1; + } + + for (i = 0, e4 = 1.0; i < 4; i++) /* e1 */ + { + if (e1 [i] != e4) + goto Fail; + e4 += 1.0; + } + + for (e4 = 1.1, i = 0; i < 3; i++) /* e2 */ + { + if (fabs(e2 [0] [i] - e4) > 0.00001) + goto Fail; + e4 += 0.1; + } + + for (e4 = 2.2, i = 0; i < 3; i++) + { + if (fabs(e2 [1] [i] - e4) > 0.00001) + goto Fail; + e4 += 0.1; + } + + if (strcmp (ch1, "Now is the time")) /* ch1 */ + goto Fail; + + if ((strcmp (&ch2 [1], "to come to the aid ")) || /* ch2 */ + (strcmp (&ch2 [0], "for all good people"))) + goto Fail; + + for (d3 = 5.4, i = 0; i < 4; i++) /* d1 */ + { + if (fabs(d1 [i] - d3) > 0.00001) + goto Fail; + d3 += 0.1; + } + + for (d3 = 6.6, i = 0; i < 3; i++) /* 0,0,0-2 of d2 */ /* d2 */ + { + if (fabs(d2 [0] [0] [i] - d3) > 0.00001) + goto Fail; + d3 += 0.1; + } + + for (d3 = 7.7, i = 0; i < 3; i++) /* 0,1,0-2 of d2 */ + { + if (fabs(d2 [0] [1] [i] - d3) > 0.00001) + goto Fail; + d3 += 0.1; + } + + for (d3 = 8.8, i = 0; i < 3; i++) /* 1,0,0-2 of d2 */ + { + if (fabs(d2 [1] [0] [i] - d3) > 0.00001) + goto Fail; + d3 += 0.1; + } + + for (d3 = 3.3, i = 0; i < 3; i++) /* 1,1,0-2 of d2 */ + { + if (fabs(d2 [1] [1] [i] - d3) > 0.00001) + goto Fail; + d3 += 0.1; + } + + for (d3 = 4.4, i = 0; i < 3; i++) /* 2,0,0-2 of d2 */ + { + if (fabs(d2 [2] [0] [i] - d3) > 0.00001) + goto Fail; + d3 += 0.1; + } + + for (d3 = 5.5, i = 0; i < 3; i++) /* 2,1,0-2 of d2 */ + { + if (fabs(d2 [2] [1] [i] - d3) > 0.00001) + goto Fail; + d3 += 0.1; + } + + /* L1 */ + + if ((L1 [0] != 2) || (L1 [1] != 3) || (L1 [2] != 0) || (L1 [3] != 0)) + goto Fail; + + /* e3 */ + + if ((fabs(e3 [0] - 1.1) > 0.00001) || (fabs(e3 [1] - 2.2) > 0.00001) || + (fabs(e3 [2] - 3.3) > 0.00001) || (fabs(e3 [3]) > 0.00001) || + (fabs(e3 [4] ) > 0.00001)) + goto Fail; + + /* s1 */ + + if ((s1 [0].x != 1) || (s1 [0].y != 2) || (s1 [0].z != 3) || + (fabs(s1 [0].a - 2.0) > 0.00001) || (fabs(s1 [0].b - 3.0) > 0.00001) || + (fabs(s1 [0].c - 4.0) > 0.00001)) + goto Fail; + + for (i = 1; i < 3; i++) + if ((s1 [i].x != 0) || (s1 [i].y != 0) || (s1 [i].z != 0) || + (s1 [i].a != 0.0) || (s1 [i].b != 0.0) || (s1 [i].c != 0.0)) + goto Fail; + + /* s2 */ + + if ((s2 [0].ch1 != 'a') || (s2 [0].ch2 != 'b') || + (s2 [1].ch1 != 'l') || (s2 [1].ch2 != 'm')) + goto Fail; + + if ((fabs(s2 [0].d1 - 3.3) > 0.00001) || (fabs(s2 [0].d2 - 4.4) > 0.00001) || + (fabs(s2 [1].d1 - 3.5) > 0.00001) || (fabs(s2 [1].d2 - 4.6) > 0.00001)) + goto Fail; + + for (i = 2; i < 4; i++) + if ((s2 [i].ch1 != 0) || (s2 [i].ch2 != 0) || + (s2 [i].d1 != 0.0) || (s2 [i].d2 != 0.0)) + goto Fail; + + printf ("Passed Conformance Test 4.6.4.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 4.6.4.1\n"); + } diff --git a/Tests/Conformance/C4.6.4.2.CC b/Tests/Conformance/C4.6.4.2.CC old mode 100755 new mode 100644 index 705793f..58c2e38 --- a/Tests/Conformance/C4.6.4.2.CC +++ b/Tests/Conformance/C4.6.4.2.CC @@ -1 +1,183 @@ -/* Conformance Test 4.6.4.2: Test initialization of auto arrays */ #include #include main () { int i, j, k, m; /* local variables */ double d3; extended e4; int i1 [] = { 1, 2, 3 }; int i2 [] [2] = { {4, 5}, {6, 7}, {8, 9} }; extended e1 [] = { 1.0, 2.0, 3.0, 4.0 }; extended e2 [] [3] = { {1.1, 1.2, 1.3}, {2.2, 2.3, 2.4} }; char ch1 [] = "Now is the time"; char ch2 [] [20] = { "for all good people", "to come to the aid " }; double d1 [] = { 5.4, 5.5, 5.6, 5.7 }; double d2 [] [2] [3] = { { {6.6, 6.7, 6.8}, {7.7, 7.8, 7.9} }, { {8.8, 8.9, 9.0}, {3.3, 3.4, 3.5} }, { {4.4, 4.5, 4.6}, {5.5, 5.6, 5.7} } }; /* Ensure that missing values are zeroed */ long L1 [4] = { 2, 3 }; extended e3 [5] = { 1.1, 2.2, 3.3 }; struct S1 { int x, y, z; float a, b, c; } s1 [3] = { { 1, 2, 3, 2.0, 3.0, 4.0 } }; struct S2 { char ch1, ch2; double d1, d2; } s2 [4] = { {'a', 'b', 3.3, 4.4}, {'l', 'm', 3.5, 4.6} }; /* Check sizes of arrays */ if ((sizeof (i1) != 6) || (sizeof (i2) != 12) || (sizeof (e1) != 40) || (sizeof (e2) != 60) || (sizeof (ch1) != 16) || (sizeof (ch2) != 40)) goto Fail; if ((sizeof (d1) != 32) || (sizeof (d2) != 144) || (sizeof (L1) != 16) || (sizeof (e3) != 50) || (sizeof (s1) != 54) || (sizeof (s2) != 72)) goto Fail; /* Check array contents */ for (i = 0; i < 3; i++) /* i1 */ if (i1 [i] != i + 1) goto Fail; for (i = 0, k = 4; i < 3; i++) /* i2 */ for (j = 0; j < 2; j++) { if (i2 [i] [j] != k) goto Fail; k += 1; } for (i = 0, e4 = 1.0; i < 4; i++) /* e1 */ { if (fabs(e1 [i] - e4) > 0.00001) goto Fail; e4 += 1.0; } for (e4 = 1.1, i = 0; i < 3; i++) /* e2 */ { if (fabs(e2 [0] [i] - e4) > 0.00001) goto Fail; e4 += 0.1; } for (e4 = 2.2, i = 0; i < 3; i++) { if (fabs(e2 [1] [i] - e4) > 0.00001) goto Fail; e4 += 0.1; } if (strcmp (ch1, "Now is the time")) /* ch1 */ goto Fail; if ((strcmp (ch2 [1], "to come to the aid ")) || /* ch2 */ (strcmp (ch2 [0], "for all good people"))) goto Fail; for (d3 = 5.4, i = 0; i < 4; i++) /* d1 */ { if (fabs(d1 [i] - d3) > 0.00001) goto Fail; d3 += 0.1; } for (d3 = 6.6, i = 0; i < 3; i++) /* 0,0,0-2 of d2 */ /* d2 */ { if (fabs(d2 [0] [0] [i] - d3) > 0.00001) goto Fail; d3 += 0.1; } for (d3 = 7.7, i = 0; i < 3; i++) /* 0,1,0-2 of d2 */ { if (fabs(d2 [0] [1] [i] - d3) > 0.00001) goto Fail; d3 += 0.1; } for (d3 = 8.8, i = 0; i < 3; i++) /* 1,0,0-2 of d2 */ { if (fabs(d2 [1] [0] [i] - d3) > 0.00001) goto Fail; d3 += 0.1; } for (d3 = 3.3, i = 0; i < 3; i++) /* 1,1,0-2 of d2 */ { if (fabs(d2 [1] [1] [i] - d3) > 0.00001) goto Fail; d3 += 0.1; } for (d3 = 4.4, i = 0; i < 3; i++) /* 2,0,0-2 of d2 */ { if (fabs(d2 [2] [0] [i] - d3) > 0.00001) goto Fail; d3 += 0.1; } for (d3 = 5.5, i = 0; i < 3; i++) /* 2,1,0-2 of d2 */ { if (fabs(d2 [2] [1] [i] - d3) > 0.00001) goto Fail; d3 += 0.1; } /* L1 */ if ((L1 [0] != 2) || (L1 [1] != 3) || (L1 [2] != 0) || (L1 [3] != 0)) goto Fail; /* e3 */ if ((fabs(e3 [0] - 1.1) > 0.00001) || (fabs(e3 [1] - 2.2) > 0.00001) || (fabs(e3 [2] - 3.3) > 0.00001) || (fabs(e3 [3]) > 0.00001) || (fabs(e3 [4]) > 0.00001)) goto Fail; /* s1 */ if ((s1 [0].x != 1) || (s1 [0].y != 2) || (s1 [0].z != 3) || (fabs(s1 [0].a - 2.0) > 0.00001) || (fabs(s1 [0].b - 3.0) > 0.00001) || (fabs(s1 [0].c - 4.0) > 0.00001)) goto Fail; for (i = 1; i < 3; i++) if ((s1 [i].x != 0) || (s1 [i].y != 0) || (s1 [i].z != 0) || (fabs(s1 [i].a) > 0.00001) || (fabs(s1 [i].b) > 0.00001) || (fabs(s1 [i].c) > 0.00001)) goto Fail; /* s2 */ if ((s2 [0].ch1 != 'a') || (s2 [0].ch2 != 'b') || (s2 [1].ch1 != 'l') || (s2 [1].ch2 != 'm')) goto Fail; if ((fabs(s2 [0].d1 - 3.3) > 0.00001) || (fabs(s2 [0].d2 - 4.4) > 0.00001) || (fabs(s2 [1].d1 - 3.5) > 0.00001) || (fabs(s2 [1].d2 - 4.6) > 0.00001)) goto Fail; for (i = 2; i < 4; i++) if ((s2 [i].ch1 != 0) || (s2 [i].ch2 != 0) || (fabs(s2 [i].d1) > 0.00001) || (fabs(s2 [i].d2) > 0.00001)) goto Fail; printf ("Passed Conformance Test 4.6.4.2\n"); return; Fail: printf ("Failed Conformance Test 4.6.4.2\n"); } \ No newline at end of file +/* Conformance Test 4.6.4.2: Test initialization of auto arrays */ + +#include +#include + +main () + { + int i, j, k, m; /* local variables */ + double d3; + extended e4; + + int i1 [] = { 1, 2, 3 }; + int i2 [] [2] = { {4, 5}, {6, 7}, {8, 9} }; + + extended e1 [] = { 1.0, 2.0, 3.0, 4.0 }; + extended e2 [] [3] = { {1.1, 1.2, 1.3}, {2.2, 2.3, 2.4} }; + + char ch1 [] = "Now is the time"; + char ch2 [] [20] = { "for all good people", "to come to the aid " }; + + double d1 [] = { 5.4, 5.5, 5.6, 5.7 }; + double d2 [] [2] [3] = { { {6.6, 6.7, 6.8}, {7.7, 7.8, 7.9} }, + { {8.8, 8.9, 9.0}, {3.3, 3.4, 3.5} }, + { {4.4, 4.5, 4.6}, {5.5, 5.6, 5.7} } }; + + /* Ensure that missing values are zeroed */ + + long L1 [4] = { 2, 3 }; + extended e3 [5] = { 1.1, 2.2, 3.3 }; + + struct S1 { int x, y, z; + float a, b, c; } s1 [3] = { { 1, 2, 3, 2.0, 3.0, 4.0 } }; + struct S2 { char ch1, ch2; + double d1, d2; } s2 [4] = { {'a', 'b', 3.3, 4.4}, + {'l', 'm', 3.5, 4.6} }; + + /* Check sizes of arrays */ + + if ((sizeof (i1) != 6) || (sizeof (i2) != 12) || (sizeof (e1) != 40) || + (sizeof (e2) != 60) || (sizeof (ch1) != 16) || (sizeof (ch2) != 40)) + goto Fail; + + if ((sizeof (d1) != 32) || (sizeof (d2) != 144) || (sizeof (L1) != 16) || + (sizeof (e3) != 50) || (sizeof (s1) != 54) || (sizeof (s2) != 72)) + goto Fail; + + /* Check array contents */ + + for (i = 0; i < 3; i++) /* i1 */ + if (i1 [i] != i + 1) + goto Fail; + + for (i = 0, k = 4; i < 3; i++) /* i2 */ + for (j = 0; j < 2; j++) + { + if (i2 [i] [j] != k) + goto Fail; + k += 1; + } + + for (i = 0, e4 = 1.0; i < 4; i++) /* e1 */ + { + if (fabs(e1 [i] - e4) > 0.00001) + goto Fail; + e4 += 1.0; + } + + for (e4 = 1.1, i = 0; i < 3; i++) /* e2 */ + { + if (fabs(e2 [0] [i] - e4) > 0.00001) + goto Fail; + e4 += 0.1; + } + + for (e4 = 2.2, i = 0; i < 3; i++) + { + if (fabs(e2 [1] [i] - e4) > 0.00001) + goto Fail; + e4 += 0.1; + } + + if (strcmp (ch1, "Now is the time")) /* ch1 */ + goto Fail; + + if ((strcmp (ch2 [1], "to come to the aid ")) || /* ch2 */ + (strcmp (ch2 [0], "for all good people"))) + goto Fail; + + for (d3 = 5.4, i = 0; i < 4; i++) /* d1 */ + { + if (fabs(d1 [i] - d3) > 0.00001) + goto Fail; + d3 += 0.1; + } + + for (d3 = 6.6, i = 0; i < 3; i++) /* 0,0,0-2 of d2 */ /* d2 */ + { + if (fabs(d2 [0] [0] [i] - d3) > 0.00001) + goto Fail; + d3 += 0.1; + } + + for (d3 = 7.7, i = 0; i < 3; i++) /* 0,1,0-2 of d2 */ + { + if (fabs(d2 [0] [1] [i] - d3) > 0.00001) + goto Fail; + d3 += 0.1; + } + + for (d3 = 8.8, i = 0; i < 3; i++) /* 1,0,0-2 of d2 */ + { + if (fabs(d2 [1] [0] [i] - d3) > 0.00001) + goto Fail; + d3 += 0.1; + } + + for (d3 = 3.3, i = 0; i < 3; i++) /* 1,1,0-2 of d2 */ + { + if (fabs(d2 [1] [1] [i] - d3) > 0.00001) + goto Fail; + d3 += 0.1; + } + + for (d3 = 4.4, i = 0; i < 3; i++) /* 2,0,0-2 of d2 */ + { + if (fabs(d2 [2] [0] [i] - d3) > 0.00001) + goto Fail; + d3 += 0.1; + } + + for (d3 = 5.5, i = 0; i < 3; i++) /* 2,1,0-2 of d2 */ + { + if (fabs(d2 [2] [1] [i] - d3) > 0.00001) + goto Fail; + d3 += 0.1; + } + + /* L1 */ + + if ((L1 [0] != 2) || (L1 [1] != 3) || (L1 [2] != 0) || (L1 [3] != 0)) + goto Fail; + + /* e3 */ + + if ((fabs(e3 [0] - 1.1) > 0.00001) || (fabs(e3 [1] - 2.2) > 0.00001) || + (fabs(e3 [2] - 3.3) > 0.00001) || (fabs(e3 [3]) > 0.00001) || + (fabs(e3 [4]) > 0.00001)) + goto Fail; + + /* s1 */ + + if ((s1 [0].x != 1) || (s1 [0].y != 2) || (s1 [0].z != 3) || + (fabs(s1 [0].a - 2.0) > 0.00001) || (fabs(s1 [0].b - 3.0) > 0.00001) || + (fabs(s1 [0].c - 4.0) > 0.00001)) + goto Fail; + + for (i = 1; i < 3; i++) + if ((s1 [i].x != 0) || (s1 [i].y != 0) || (s1 [i].z != 0) || + (fabs(s1 [i].a) > 0.00001) || (fabs(s1 [i].b) > 0.00001) || + (fabs(s1 [i].c) > 0.00001)) + goto Fail; + + /* s2 */ + + if ((s2 [0].ch1 != 'a') || (s2 [0].ch2 != 'b') || + (s2 [1].ch1 != 'l') || (s2 [1].ch2 != 'm')) + goto Fail; + + if ((fabs(s2 [0].d1 - 3.3) > 0.00001) || (fabs(s2 [0].d2 - 4.4) > 0.00001) || + (fabs(s2 [1].d1 - 3.5) > 0.00001) || (fabs(s2 [1].d2 - 4.6) > 0.00001)) + goto Fail; + + for (i = 2; i < 4; i++) + if ((s2 [i].ch1 != 0) || (s2 [i].ch2 != 0) || + (fabs(s2 [i].d1) > 0.00001) || (fabs(s2 [i].d2) > 0.00001)) + goto Fail; + + printf ("Passed Conformance Test 4.6.4.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 4.6.4.2\n"); + } diff --git a/Tests/Conformance/C4.6.4.3.CC b/Tests/Conformance/C4.6.4.3.CC old mode 100755 new mode 100644 index 00ef722..ecc777a --- a/Tests/Conformance/C4.6.4.3.CC +++ b/Tests/Conformance/C4.6.4.3.CC @@ -1 +1,68 @@ -/* Conformance Test 4.6.4.2: Verify that subscripts work */ /* properly in initializers. */ #include #include char str1[] = "Hello, "; char str2[] = "*world."; char *str[] = {&str1[0], &str2[1]}; int tensor[3][3][3] = {0,1,2,3,4,5,6,7,8, 9,10,11,12,13,14,15,16,17, 18,19,20,21,22,23,24,25,26}; int *ip[27] = { &tensor[0][0][0], &tensor[0][0][1], &tensor[0][0][2], &tensor[0][1][0], &tensor[0][1][1], &tensor[0][1][2], &tensor[0][2][0], &tensor[0][2][1], &tensor[0][2][2], &tensor[1][0][0], &tensor[1][0][1], &tensor[1][0][2], &tensor[1][1][0], &tensor[1][1][1], &tensor[1][1][2], &tensor[1][2][0], &tensor[1][2][1], &tensor[1][2][2], &tensor[2][0][0], &tensor[2][0][1], &tensor[2][0][2], &tensor[2][1][0], &tensor[2][1][1], &tensor[2][1][2], &tensor[2][2][0], &tensor[2][2][1], &tensor[2][2][2] }; main() { int i; char st1[20],st2[20]; int fail = 0; strcpy(st1, str[0]); strcat(st1, str[1]); strcpy(st2, &str1[0]); strcat(st2, &str2[1]); if (strcmp(st1,st2) != 0) fail = 1; for (i = 0; i < 27; ++i) if (*ip[i] != i) fail = 1; if (fail) printf ("Failed Conformance Test 4.6.4.3\n"); else printf ("Passed Conformance Test 4.6.4.3\n"); } \ No newline at end of file +/* Conformance Test 4.6.4.2: Verify that subscripts work */ +/* properly in initializers. */ + +#include +#include + +char str1[] = "Hello, "; +char str2[] = "*world."; + +char *str[] = {&str1[0], &str2[1]}; + +int tensor[3][3][3] = {0,1,2,3,4,5,6,7,8, + 9,10,11,12,13,14,15,16,17, + 18,19,20,21,22,23,24,25,26}; + +int *ip[27] = { + &tensor[0][0][0], + &tensor[0][0][1], + &tensor[0][0][2], + &tensor[0][1][0], + &tensor[0][1][1], + &tensor[0][1][2], + &tensor[0][2][0], + &tensor[0][2][1], + &tensor[0][2][2], + &tensor[1][0][0], + &tensor[1][0][1], + &tensor[1][0][2], + &tensor[1][1][0], + &tensor[1][1][1], + &tensor[1][1][2], + &tensor[1][2][0], + &tensor[1][2][1], + &tensor[1][2][2], + &tensor[2][0][0], + &tensor[2][0][1], + &tensor[2][0][2], + &tensor[2][1][0], + &tensor[2][1][1], + &tensor[2][1][2], + &tensor[2][2][0], + &tensor[2][2][1], + &tensor[2][2][2] + }; + +main() + +{ +int i; +char st1[20],st2[20]; +int fail = 0; + +strcpy(st1, str[0]); +strcat(st1, str[1]); +strcpy(st2, &str1[0]); +strcat(st2, &str2[1]); +if (strcmp(st1,st2) != 0) + fail = 1; + +for (i = 0; i < 27; ++i) + if (*ip[i] != i) + fail = 1; + +if (fail) + printf ("Failed Conformance Test 4.6.4.3\n"); +else + printf ("Passed Conformance Test 4.6.4.3\n"); +} diff --git a/Tests/Conformance/C4.6.5.1.CC b/Tests/Conformance/C4.6.5.1.CC old mode 100755 new mode 100644 index 2131ab3..6208a00 --- a/Tests/Conformance/C4.6.5.1.CC +++ b/Tests/Conformance/C4.6.5.1.CC @@ -1 +1,26 @@ -/* Conformance Test 4.6.5.1: Verification of enumeration initializations */ static enum E1 { a, b, c } e1 = b; enum E2 { d, e } e2 = e; main () { enum E3 { f, g, h } e3 = f; { enum E3 e4 = e3; register enum E4 { i, j, k } e8 = j; enum E4 e5 = e8; enum E2 e6 = d; enum E1 e7 = e1; if ((e1 != b) || (e2 != e) || (e3 != f) || (e4 != f) || (e5 != j) || (e6 != d) || (e7 != b)) goto Fail; printf ("Passed Conformance Test 4.6.5.1\n"); return; Fail: printf ("Failed Conformance Test 4.6.5.1\n"); } } \ No newline at end of file +/* Conformance Test 4.6.5.1: Verification of enumeration initializations */ + +static enum E1 { a, b, c } e1 = b; +enum E2 { d, e } e2 = e; + +main () + { + enum E3 { f, g, h } e3 = f; +{ enum E3 e4 = e3; + + register enum E4 { i, j, k } e8 = j; + enum E4 e5 = e8; + enum E2 e6 = d; + enum E1 e7 = e1; + + if ((e1 != b) || (e2 != e) || (e3 != f) || (e4 != f) || (e5 != j) || + (e6 != d) || (e7 != b)) + goto Fail; + + printf ("Passed Conformance Test 4.6.5.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 4.6.5.1\n"); + } + } diff --git a/Tests/Conformance/C4.6.6.1.CC b/Tests/Conformance/C4.6.6.1.CC old mode 100755 new mode 100644 index c163b02..057c6d3 --- a/Tests/Conformance/C4.6.6.1.CC +++ b/Tests/Conformance/C4.6.6.1.CC @@ -1 +1,297 @@ -/* Conformance Test 4.6.6.1: Verification of static and extern structure */ /* initialization */ #include #include struct S1 { int i; char ch; long L; float f; double d; extended e; unsigned int bf1: 8; }; struct S2 { int i1 [5]; char ch1 [10]; long L1 [3]; float f1 [4]; double d1 [3]; extended e1 [3]; unsigned int ui [4]; unsigned long ul [2]; }; struct S3 { struct S1 s1; struct S2 s2; }; /* Initialization of static & extern structures allowed; each variable */ /* within the structure is subject to the rules for initializing static */ /* and extern variables of the corresponding type. */ struct S1 s4 = { 32767, 'z', 32788, 17.0, 18.0, 19.0, 5 }; struct S2 s5 = { { 10, 20, 30, 40, 50 }, "ORCA/C !!", { 4, 5, 6 }, { 45.0, 55.0, 65.0, 75.0 }, { 455.0, 555.0, 655.0 }, { 4555.0, 5555.0 } }; struct S3 s6 = { { 7654, 'x', 65535, 876.0, 877.0, 878.0, 033 }, { { 10, 9, 8, 7, 6 }, "it's back", { 2000, 2001, 2002 }, { 7.7, 8.8, 9.9, 11.00 }, { 6.0, 6.0, 6.0 }, { 1.0, 1.3 }, { 0x7f, 0x80, 0x81, 0x82 }, { 0x01 } } }; main () { int i, j; long k; float f; double d; extended e; unsigned int ui; int TestStatics1 (void); int TestStatics2 (void); extern struct S1 s4; extern struct S2 s5; extern struct S3 s6; if ((s4.i != 32767) || (s4.ch != 'z') || (s4.L != 32788) || (s4.f != 17.0) || (s4.d != 18.0) || (s4.e != 19.0) || (s4.bf1 != 5)) goto Fail; for (j = 10, i = 0; i < 5; i++) { if (s5.i1 [i] != j) goto Fail; j += 10; } if (strcmp (s5.ch1, "ORCA/C !!")) goto Fail; for (k = 4, i = 0; i < 3; i++) if (s5.L1 [i] != k++) goto Fail; for (f = 45.0, i = 0; i < 4; i++) { if (s5.f1 [i] != f) goto Fail; f += 10.0; } for (d = 455.0, i = 0; i < 3; i++) { if (s5.d1 [i] != d) goto Fail; d += 100.0; } for (e = 4555.0, i = 0; i < 2; i++) { if (s5.e1 [i] != e) goto Fail; e += 1000.0; } for (i = 0; i < 4; i++) if (s5.ui [i] != 0) goto Fail; for (i = 0; i < 2; i++) if (s5.ul [i] != 0) goto Fail; if ((s6.s1.i != 7654) || (s6.s1.ch != 'x') || (s6.s1.L != 65535) || (s6.s1.f != 876.0) || (s6.s1.d != 877.0) || (s6.s1.e != 878.0) || (s6.s1.bf1 != 27)) goto Fail; for (j = 10, i = 0; i < 5; i++) if (s6.s2.i1 [i] != j--) goto Fail; if (strcmp (s6.s2.ch1, "it's back")) goto Fail; for (k = 2000, i = 0; i < 3; i++) if (s6.s2.L1 [i] != k++) goto Fail; for (f = 7.7, i = 0; i < 4; i++) { if ((s6.s2.f1 [i] - f) > 0.00001) goto Fail; f += 1.1; } for (d = 6.0, i = 0; i < 3; i++) if (s6.s2.d1 [i] != d) goto Fail; if ((s6.s2.e1 [0] != 1.0) || (s6.s2.e1 [1] != 1.3)) goto Fail; for (ui = 0x7F, i = 0; i < 4; i++) if (s6.s2.ui [i] != ui++) goto Fail; if ((s6.s2.ul [0] != 1) || (s6.s2.ul [1] != 0)) goto Fail; if (TestStatics1()) goto Fail; if (TestStatics2()) goto Fail; printf ("Passed Conformance Test 4.6.6.1\n"); return; Fail: printf ("Failed Conformance Test 4.6.6.1\n"); } /******************************************************************************/ int TestStatics1 (void) { int i, j; long k; float f; double d; extended e; unsigned int ui; static struct S1 s1 = { 1, 'a', -2147483647, 4.3, 4.3e100, 4.3e300, 0xFF }; static struct S2 s2 = { { 1, 2, 3, 4, 5 }, "an array ", { 8, 9, 10 }, { 5.1, 5.2, 5.3, 5.4 }, { 5.1e50, 5.2e50, 5.3e50 }, { 5.1e200, 5.2e200, 5.3e200 }, { 0xFFFF, 0xFFFE, 0xFFFD } }; if ((s1.i != 1) || (s1.ch != 'a') || (s1.L != -2147483647) || (fabs(s1.f - 4.3) > 0.00001) || (fabs(s1.d - 4.3e100) > 1e95) || (s1.bf1 != 0xFF)) goto Fail; for (i = 0; i < 5; i++) if (s2.i1 [i] != i + 1) goto Fail; if (strcmp (s2.ch1, "an array ")) goto Fail; for (k = 8, i = 0; i < 3; i++) if (s2.L1 [i] != k++) goto Fail; for (f = 5.1, i = 0; i < 4; i++) { if (fabs(s2.f1 [i] - f) > 0.00001) goto Fail; f += 0.1; } for (d = 5.1e50, i = 0; i < 3; i++) { if (fabs(s2.d1 [i] - d) > 1e44) goto Fail; d += 0.1e50; } for (e = 5.1e200, i = 0; i < 2; i++) { if (fabs(s2.e1 [i] - e) > 1e195) goto Fail; e += 0.1e200; } for (ui = 0xFFFF, i = 0; i < 3; i++) if (s2.ui [i] != ui--) goto Fail; if ((s2.ui [3] != 0) || (s2.ul [0] != 0) || (s2.ul [1] != 0)) goto Fail; return 0; Fail: return 1; } /******************************************************************************/ int TestStatics2 (void) { int i, j; long k; float f; double d; extended e; unsigned int ui; static struct S3 s1 = { { 9, 'd', 80000, 88.9, 88.99, 888.999, 0x33 }, { { 9, 8, 7, 6, 5 }, "ten chars", { 32768, 32769, 32770 }, { 6.0, 7.0, 8.0, 9.0 }, { 66.0, 77.0, 88.0, }, { 666.0, 777.0 }, { 0x7FFF, } } }; if ((s1.s1.i != 9) || (s1.s1.ch != 'd') || (s1.s1.L != 80000) || (fabs(s1.s1.f - 88.9) > 0.0001) || (fabs(s1.s1.d - 88.99) > 0.0001) || (fabs(s1.s1.e - 888.999) > 0.001) || (s1.s1.bf1 != 0x33)) goto Fail; for (j = 9, i = 0; i < 5; i++) if (s1.s2.i1 [i] != j--) goto Fail; if (strcmp (s1.s2.ch1, "ten chars")) goto Fail; for (k = 32768, i = 0; i < 3; i++) if (s1.s2.L1 [i] != k++) goto Fail; for (f = 6.0, i = 0; i < 4; i++) { if (fabs(s1.s2.f1 [i] - f) > 0.00001) goto Fail; f += 1.0; } for (d = 66.0, i = 0; i < 3; i++) { if (fabs(s1.s2.d1 [i] - d) > 0.0001) goto Fail; d += 11.0; } for (e = 666.0, i = 0; i < 2; i++) { if (fabs(s1.s2.e1 [i] - e) > 0.001) goto Fail; e += 111.0; } if (s1.s2.ui [0] != 0x7FFF) goto Fail; for (i = 1; i < 4; i++) if (s1.s2.ui [i] != 0) goto Fail; for (i = 0; i < 2; i++) if (s1.s2.ul [i] != 0) goto Fail; return 0; Fail: return 1; } \ No newline at end of file +/* Conformance Test 4.6.6.1: Verification of static and extern structure */ +/* initialization */ + +#include +#include + +struct S1 { int i; + char ch; + long L; + float f; + double d; + extended e; + unsigned int bf1: 8; }; + +struct S2 { int i1 [5]; + char ch1 [10]; + long L1 [3]; + float f1 [4]; + double d1 [3]; + extended e1 [3]; + unsigned int ui [4]; + unsigned long ul [2]; }; + +struct S3 { struct S1 s1; + struct S2 s2; }; + +/* Initialization of static & extern structures allowed; each variable */ +/* within the structure is subject to the rules for initializing static */ +/* and extern variables of the corresponding type. */ + +struct S1 s4 = { 32767, 'z', 32788, 17.0, 18.0, 19.0, 5 }; + +struct S2 s5 = { { 10, 20, 30, 40, 50 }, "ORCA/C !!", { 4, 5, 6 }, + { 45.0, 55.0, 65.0, 75.0 }, { 455.0, 555.0, 655.0 }, + { 4555.0, 5555.0 } }; + +struct S3 s6 = { { 7654, 'x', 65535, 876.0, 877.0, 878.0, 033 }, + { { 10, 9, 8, 7, 6 }, "it's back", { 2000, 2001, 2002 }, + { 7.7, 8.8, 9.9, 11.00 }, { 6.0, 6.0, 6.0 }, + { 1.0, 1.3 }, { 0x7f, 0x80, 0x81, 0x82 }, + { 0x01 } } }; + + +main () + { + int i, j; + long k; + float f; + double d; + extended e; + unsigned int ui; + + int TestStatics1 (void); + int TestStatics2 (void); + + extern struct S1 s4; + extern struct S2 s5; + extern struct S3 s6; + + + if ((s4.i != 32767) || (s4.ch != 'z') || (s4.L != 32788) || (s4.f != 17.0) || + (s4.d != 18.0) || (s4.e != 19.0) || (s4.bf1 != 5)) + goto Fail; + + for (j = 10, i = 0; i < 5; i++) + { + if (s5.i1 [i] != j) + goto Fail; + j += 10; + } + + if (strcmp (s5.ch1, "ORCA/C !!")) + goto Fail; + + for (k = 4, i = 0; i < 3; i++) + if (s5.L1 [i] != k++) + goto Fail; + + for (f = 45.0, i = 0; i < 4; i++) + { + if (s5.f1 [i] != f) + goto Fail; + f += 10.0; + } + + for (d = 455.0, i = 0; i < 3; i++) + { + if (s5.d1 [i] != d) + goto Fail; + d += 100.0; + } + + for (e = 4555.0, i = 0; i < 2; i++) + { + if (s5.e1 [i] != e) + goto Fail; + e += 1000.0; + } + + for (i = 0; i < 4; i++) + if (s5.ui [i] != 0) + goto Fail; + + for (i = 0; i < 2; i++) + if (s5.ul [i] != 0) + goto Fail; + + if ((s6.s1.i != 7654) || (s6.s1.ch != 'x') || (s6.s1.L != 65535) || + (s6.s1.f != 876.0) || (s6.s1.d != 877.0) || (s6.s1.e != 878.0) || + (s6.s1.bf1 != 27)) + goto Fail; + + for (j = 10, i = 0; i < 5; i++) + if (s6.s2.i1 [i] != j--) + goto Fail; + + if (strcmp (s6.s2.ch1, "it's back")) + goto Fail; + + for (k = 2000, i = 0; i < 3; i++) + if (s6.s2.L1 [i] != k++) + goto Fail; + + for (f = 7.7, i = 0; i < 4; i++) + { + if ((s6.s2.f1 [i] - f) > 0.00001) + goto Fail; + f += 1.1; + } + + for (d = 6.0, i = 0; i < 3; i++) + if (s6.s2.d1 [i] != d) + goto Fail; + + if ((s6.s2.e1 [0] != 1.0) || (s6.s2.e1 [1] != 1.3)) + goto Fail; + + for (ui = 0x7F, i = 0; i < 4; i++) + if (s6.s2.ui [i] != ui++) + goto Fail; + + if ((s6.s2.ul [0] != 1) || (s6.s2.ul [1] != 0)) + goto Fail; + + if (TestStatics1()) + goto Fail; + + if (TestStatics2()) + goto Fail; + + printf ("Passed Conformance Test 4.6.6.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 4.6.6.1\n"); + } + +/******************************************************************************/ + +int TestStatics1 (void) + { + int i, j; + long k; + float f; + double d; + extended e; + unsigned int ui; + + static struct S1 s1 = { 1, 'a', -2147483647, 4.3, 4.3e100, 4.3e300, 0xFF }; + + static struct S2 s2 = { { 1, 2, 3, 4, 5 }, "an array ", { 8, 9, 10 }, + { 5.1, 5.2, 5.3, 5.4 }, { 5.1e50, 5.2e50, 5.3e50 }, + { 5.1e200, 5.2e200, 5.3e200 }, { 0xFFFF, 0xFFFE, + 0xFFFD } }; + + + if ((s1.i != 1) || (s1.ch != 'a') || (s1.L != -2147483647) || + (fabs(s1.f - 4.3) > 0.00001) || + (fabs(s1.d - 4.3e100) > 1e95) || (s1.bf1 != 0xFF)) + goto Fail; + + for (i = 0; i < 5; i++) + if (s2.i1 [i] != i + 1) + goto Fail; + + if (strcmp (s2.ch1, "an array ")) + goto Fail; + + for (k = 8, i = 0; i < 3; i++) + if (s2.L1 [i] != k++) + goto Fail; + + for (f = 5.1, i = 0; i < 4; i++) + { + if (fabs(s2.f1 [i] - f) > 0.00001) + goto Fail; + f += 0.1; + } + + for (d = 5.1e50, i = 0; i < 3; i++) + { + if (fabs(s2.d1 [i] - d) > 1e44) + goto Fail; + d += 0.1e50; + } + + for (e = 5.1e200, i = 0; i < 2; i++) + { + if (fabs(s2.e1 [i] - e) > 1e195) + goto Fail; + e += 0.1e200; + } + + for (ui = 0xFFFF, i = 0; i < 3; i++) + if (s2.ui [i] != ui--) + goto Fail; + + if ((s2.ui [3] != 0) || (s2.ul [0] != 0) || (s2.ul [1] != 0)) + goto Fail; + + return 0; + +Fail: + return 1; + } + +/******************************************************************************/ + +int TestStatics2 (void) + { + int i, j; + long k; + float f; + double d; + extended e; + unsigned int ui; + + static struct S3 s1 = { { 9, 'd', 80000, 88.9, 88.99, 888.999, 0x33 }, + { { 9, 8, 7, 6, 5 }, "ten chars", + { 32768, 32769, 32770 }, { 6.0, 7.0, 8.0, 9.0 }, + { 66.0, 77.0, 88.0, }, { 666.0, 777.0 }, + { 0x7FFF, } } }; + + + if ((s1.s1.i != 9) || (s1.s1.ch != 'd') || (s1.s1.L != 80000) || + (fabs(s1.s1.f - 88.9) > 0.0001) || (fabs(s1.s1.d - 88.99) > 0.0001) || + (fabs(s1.s1.e - 888.999) > 0.001) || (s1.s1.bf1 != 0x33)) + goto Fail; + + for (j = 9, i = 0; i < 5; i++) + if (s1.s2.i1 [i] != j--) + goto Fail; + + if (strcmp (s1.s2.ch1, "ten chars")) + goto Fail; + + for (k = 32768, i = 0; i < 3; i++) + if (s1.s2.L1 [i] != k++) + goto Fail; + + for (f = 6.0, i = 0; i < 4; i++) + { + if (fabs(s1.s2.f1 [i] - f) > 0.00001) + goto Fail; + f += 1.0; + } + + for (d = 66.0, i = 0; i < 3; i++) + { + if (fabs(s1.s2.d1 [i] - d) > 0.0001) + goto Fail; + d += 11.0; + } + + for (e = 666.0, i = 0; i < 2; i++) + { + if (fabs(s1.s2.e1 [i] - e) > 0.001) + goto Fail; + e += 111.0; + } + + if (s1.s2.ui [0] != 0x7FFF) + goto Fail; + + for (i = 1; i < 4; i++) + if (s1.s2.ui [i] != 0) + goto Fail; + + for (i = 0; i < 2; i++) + if (s1.s2.ul [i] != 0) + goto Fail; + + return 0; + +Fail: + return 1; + } diff --git a/Tests/Conformance/C4.6.6.2.CC b/Tests/Conformance/C4.6.6.2.CC old mode 100755 new mode 100644 index 25f800a..b0f60b5 --- a/Tests/Conformance/C4.6.6.2.CC +++ b/Tests/Conformance/C4.6.6.2.CC @@ -1 +1,269 @@ -/* Conformance Test 4.6.6.2: Verification of auto and register structure */ /* initialization */ #include #include struct S1 { int i; char ch; long L; float f; double d; extended e; unsigned int bf1: 8; }; struct S2 { int i1 [5]; char ch1 [10]; long L1 [3]; float f1 [4]; double d1 [3]; extended e1 [3]; unsigned int ui [4]; unsigned long ul [2]; }; struct S3 { struct S1 s1; struct S2 s2; }; main () { int i, j; long k; float f; double d; extended e; unsigned int ui; unsigned long ul; /* Initialization of auto and register structures allowed; each variable */ /* within the structure can only be set to a constant. */ register struct S1 s1 = { 1, 'a', -2147483647, 4.3, 4.3e100, 4.3e300, 0xFF }; register struct S2 s2 = { { 1, 2, 3, 4, 5 }, "an array ", { 8, 9, 10 }, { 5.1, 5.2, 5.3, 5.4 }, { 5.1e50, 5.2e50, 5.3e50 }, { 5.1e200, 5.2e200, 5.3e200 }, { 0xFFFF, 0xFFFE, 0xFFFD } }; register struct S3 s3 = { { 9, 'd', 80000, 88.9, 88.99, 888.999, 0x33 }, { { 9, 8, 7, 6, 5 }, "ten chars", { 32768, 32769, 32770 }, { 6.0, 7.0, 8.0, 9.0 }, { 66.0, 77.0, 88.0, }, { 666.0, 777.0 }, { 0x7FFF, } } }; struct S1 s4 = { 32767, 'z', 32788, 17.0, 18.0, 19.0, 5 }; struct S2 s5 = { { 10, 20, 30, 40, 50 }, "ORCA/C !!", { 4, 5, 6 }, { 45.0, 55.0, 65.0, 75.0 }, { 455.0, 555.0, 655.0 }, { 4555.0, 5555.0 } }; struct S3 s6 = { { 7654, 'x', 65535, 876.0, 877.0, 878.0, 033 }, { { 10, 9, 8, 7, 6 }, "it's back", { 2000, 2001, 2002 }, { 7.7, 8.8, 9.9, 11.0 }, { 6.0, 6.0, 6.0 }, { 1.0, 1.3 }, { 0x7f, 0x80, 0x81, 0x82 }, { 0x01 } } }; /* Check initialization of struct s1. */ if ((s1.i != 1) || (s1.ch != 'a') || (s1.L != -2147483647) || (fabs(s1.f - 4.3) > 0.00001) || (fabs(s1.d - 4.3e100) > 1e95) || (s1.bf1 != 0xFFu)) goto Fail; /* Check initialization of struct s2. */ for (i = 0; i < 5; i++) if (s2.i1 [i] != i + 1) goto Fail; if (strcmp (s2.ch1, "an array ")) goto Fail; for (k = 8, i = 0; i < 3; i++) if (s2.L1 [i] != k++) goto Fail; for (f = 5.1, i = 0; i < 4; i++) { if (fabs(s2.f1 [i] - f) > 0.00001) goto Fail; f += 0.1; } for (d = 5.1e50, i = 0; i < 3; i++) { if (fabs(s2.d1 [i] - d) > 1e45) goto Fail; d += 0.1e50; } for (e = 5.1e200, i = 0; i < 2; i++) { if (fabs(s2.e1 [i] - e) > 1e195) goto Fail; e += 0.1e200; } for (ui = 0xFFFF, i = 0; i < 3; i++) if (s2.ui [i] != ui--) goto Fail; if ((s2.ui [3] != 0) || (s2.ul [0] != 0) || (s2.ul [1] != 0)) goto Fail; /* Check initialization of struct s3. */ if ((s3.s1.i != 9) || (s3.s1.ch != 'd') || (s3.s1.L != 80000) || (fabs(s3.s1.f - 88.9) > 0.0001) || (fabs(s3.s1.d - 88.99) > 0.0001) || (fabs(s3.s1.e - 888.999) > 0.0001) || (s3.s1.bf1 != 0x33)) goto Fail; for (j = 9, i = 0; i < 5; i++) if (s3.s2.i1 [i] != j--) goto Fail; if (strcmp (s3.s2.ch1, "ten chars")) goto Fail; for (k = 32768, i = 0; i < 3; i++) if (s3.s2.L1 [i] != k++) goto Fail; for (f = 6.0, i = 0; i < 4; i++) { if (s3.s2.f1 [i] != f) goto Fail; f += 1.0; } for (d = 66.0, i = 0; i < 3; i++) { if (fabs(s3.s2.d1 [i] - d) > 0.0001) goto Fail; d += 11.0; } for (e = 666.0, i = 0; i < 2; i++) { if (fabs(s3.s2.e1 [i] - e) > 0.0001) goto Fail; e += 111.0; } if (s3.s2.ui [0] != 0x7FFF) goto Fail; for (i = 1; i < 4; i++) if (s3.s2.ui [i] != 0) goto Fail; for (i = 0; i < 2; i++) if (s3.s2.ul [i] != 0) goto Fail; /* Check initialization of struct s4. */ if ((s4.i != 32767) || (s4.ch != 'z') || (s4.L != 32788) || (fabs(s4.f - 17.0) > 0.00001) || (fabs(s4.d - 18.0) > 0.00001) || (fabs(s4.e - 19.0) > 0.00001) || (s4.bf1 != 5)) goto Fail; /* Check initialization of struct s5. */ for (j = 10, i = 0; i < 5; i++) { if (s5.i1 [i] != j) goto Fail; j += 10; } if (strcmp (s5.ch1, "ORCA/C !!")) goto Fail; for (k = 4, i = 0; i < 3; i++) if (s5.L1 [i] != k++) goto Fail; for (f = 45.0, i = 0; i < 4; i++) { if (fabs(s5.f1 [i] - f) > 0.0001) goto Fail; f += 10.0; } for (d = 455.0, i = 0; i < 3; i++) { if (fabs(s5.d1 [i] - d) > 0.0001) goto Fail; d += 100.0; } for (e = 4555.0, i = 0; i < 2; i++) { if (fabs(s5.e1 [i] - e) > 0.01) goto Fail; e += 1000.0; } for (i = 0; i < 4; i++) if (s5.ui [i] != 0) goto Fail; for (i = 0; i < 2; i++) if (s5.ul [i] != 0) goto Fail; /* Check initialization of struct s6. */ if ((s6.s1.i != 7654) || (s6.s1.ch != 'x') || (s6.s1.L != 65535) || (fabs(s6.s1.f - 876.0) > 0.001) || (fabs(s6.s1.d - 877.0) > 0.001) || (fabs(s6.s1.e - 878.0) > 0.001) || (s6.s1.bf1 != 27)) goto Fail; for (j = 10, i = 0; i < 5; i++) if (s6.s2.i1 [i] != j--) goto Fail; if (strcmp (s6.s2.ch1, "it's back")) goto Fail; for (k = 2000, i = 0; i < 3; i++) if (s6.s2.L1 [i] != k++) goto Fail; for (f = 7.7, i = 0; i < 4; i++) { if (fabs(s6.s2.f1 [i] - f) > 0.00001) goto Fail; f += 1.1; } for (d = 6.0, i = 0; i < 3; i++) if (s6.s2.d1 [i] != d) goto Fail; if ((fabs(s6.s2.e1 [0] - 1.0) > 0.00001) || (fabs(s6.s2.e1 [1] - 1.3) > 0.00001)) goto Fail; for (ui = 0x7F, i = 0; i < 4; i++) if (s6.s2.ui [i] != ui++) goto Fail; if ((s6.s2.ul [0] != 1) || (s6.s2.ul [1] != 0)) goto Fail; printf ("Passed Conformance Test 4.6.6.2\n"); return; Fail: printf ("Failed Conformance Test 4.6.6.2\n"); } \ No newline at end of file +/* Conformance Test 4.6.6.2: Verification of auto and register structure */ +/* initialization */ + +#include +#include + +struct S1 { int i; + char ch; + long L; + float f; + double d; + extended e; + unsigned int bf1: 8; }; + +struct S2 { int i1 [5]; + char ch1 [10]; + long L1 [3]; + float f1 [4]; + double d1 [3]; + extended e1 [3]; + unsigned int ui [4]; + unsigned long ul [2]; }; + +struct S3 { struct S1 s1; + struct S2 s2; }; + + +main () + { + int i, j; + long k; + float f; + double d; + extended e; + unsigned int ui; + unsigned long ul; + +/* Initialization of auto and register structures allowed; each variable */ +/* within the structure can only be set to a constant. */ + + register struct S1 s1 = { 1, 'a', -2147483647, 4.3, 4.3e100, 4.3e300, 0xFF }; + + register struct S2 s2 = { { 1, 2, 3, 4, 5 }, "an array ", { 8, 9, 10 }, + { 5.1, 5.2, 5.3, 5.4 }, { 5.1e50, 5.2e50, 5.3e50 }, + { 5.1e200, 5.2e200, 5.3e200 }, { 0xFFFF, 0xFFFE, + 0xFFFD } }; + + register struct S3 s3 = { { 9, 'd', 80000, 88.9, 88.99, 888.999, 0x33 }, + { { 9, 8, 7, 6, 5 }, "ten chars", + { 32768, 32769, 32770 }, { 6.0, 7.0, 8.0, 9.0 }, + { 66.0, 77.0, 88.0, }, { 666.0, 777.0 }, + { 0x7FFF, } } }; + + struct S1 s4 = { 32767, 'z', 32788, 17.0, 18.0, 19.0, 5 }; + + struct S2 s5 = { { 10, 20, 30, 40, 50 }, "ORCA/C !!", { 4, 5, 6 }, + { 45.0, 55.0, 65.0, 75.0 }, { 455.0, 555.0, 655.0 }, + { 4555.0, 5555.0 } }; + + struct S3 s6 = { { 7654, 'x', 65535, 876.0, 877.0, 878.0, 033 }, + { { 10, 9, 8, 7, 6 }, "it's back", { 2000, 2001, 2002 }, + { 7.7, 8.8, 9.9, 11.0 }, { 6.0, 6.0, 6.0 }, + { 1.0, 1.3 }, { 0x7f, 0x80, 0x81, 0x82 }, + { 0x01 } } }; + + + /* Check initialization of struct s1. */ + + if ((s1.i != 1) || (s1.ch != 'a') || (s1.L != -2147483647) + || (fabs(s1.f - 4.3) > 0.00001) + || (fabs(s1.d - 4.3e100) > 1e95) || (s1.bf1 != 0xFFu)) + goto Fail; + + + /* Check initialization of struct s2. */ + + for (i = 0; i < 5; i++) + if (s2.i1 [i] != i + 1) + goto Fail; + + if (strcmp (s2.ch1, "an array ")) + goto Fail; + + for (k = 8, i = 0; i < 3; i++) + if (s2.L1 [i] != k++) + goto Fail; + + for (f = 5.1, i = 0; i < 4; i++) + { + if (fabs(s2.f1 [i] - f) > 0.00001) + goto Fail; + f += 0.1; + } + + for (d = 5.1e50, i = 0; i < 3; i++) + { + if (fabs(s2.d1 [i] - d) > 1e45) + goto Fail; + d += 0.1e50; + } + + for (e = 5.1e200, i = 0; i < 2; i++) + { + if (fabs(s2.e1 [i] - e) > 1e195) + goto Fail; + e += 0.1e200; + } + + for (ui = 0xFFFF, i = 0; i < 3; i++) + if (s2.ui [i] != ui--) + goto Fail; + + if ((s2.ui [3] != 0) || (s2.ul [0] != 0) || (s2.ul [1] != 0)) + goto Fail; + + + /* Check initialization of struct s3. */ + + if ((s3.s1.i != 9) || (s3.s1.ch != 'd') || (s3.s1.L != 80000) || + (fabs(s3.s1.f - 88.9) > 0.0001) || (fabs(s3.s1.d - 88.99) > 0.0001) || + (fabs(s3.s1.e - 888.999) > 0.0001) || + (s3.s1.bf1 != 0x33)) + goto Fail; + + for (j = 9, i = 0; i < 5; i++) + if (s3.s2.i1 [i] != j--) + goto Fail; + + if (strcmp (s3.s2.ch1, "ten chars")) + goto Fail; + + for (k = 32768, i = 0; i < 3; i++) + if (s3.s2.L1 [i] != k++) + goto Fail; + + for (f = 6.0, i = 0; i < 4; i++) + { + if (s3.s2.f1 [i] != f) + goto Fail; + f += 1.0; + } + + for (d = 66.0, i = 0; i < 3; i++) + { + if (fabs(s3.s2.d1 [i] - d) > 0.0001) + goto Fail; + d += 11.0; + } + + for (e = 666.0, i = 0; i < 2; i++) + { + if (fabs(s3.s2.e1 [i] - e) > 0.0001) + goto Fail; + e += 111.0; + } + + if (s3.s2.ui [0] != 0x7FFF) + goto Fail; + + for (i = 1; i < 4; i++) + if (s3.s2.ui [i] != 0) + goto Fail; + + for (i = 0; i < 2; i++) + if (s3.s2.ul [i] != 0) + goto Fail; + + + /* Check initialization of struct s4. */ + + if ((s4.i != 32767) || (s4.ch != 'z') || (s4.L != 32788) || + (fabs(s4.f - 17.0) > 0.00001) || (fabs(s4.d - 18.0) > 0.00001) || + (fabs(s4.e - 19.0) > 0.00001) || (s4.bf1 != 5)) + goto Fail; + + + /* Check initialization of struct s5. */ + + for (j = 10, i = 0; i < 5; i++) + { + if (s5.i1 [i] != j) + goto Fail; + j += 10; + } + + if (strcmp (s5.ch1, "ORCA/C !!")) + goto Fail; + + for (k = 4, i = 0; i < 3; i++) + if (s5.L1 [i] != k++) + goto Fail; + + for (f = 45.0, i = 0; i < 4; i++) + { + if (fabs(s5.f1 [i] - f) > 0.0001) + goto Fail; + f += 10.0; + } + + for (d = 455.0, i = 0; i < 3; i++) + { + if (fabs(s5.d1 [i] - d) > 0.0001) + goto Fail; + d += 100.0; + } + + for (e = 4555.0, i = 0; i < 2; i++) + { + if (fabs(s5.e1 [i] - e) > 0.01) + goto Fail; + e += 1000.0; + } + + for (i = 0; i < 4; i++) + if (s5.ui [i] != 0) + goto Fail; + + for (i = 0; i < 2; i++) + if (s5.ul [i] != 0) + goto Fail; + + + /* Check initialization of struct s6. */ + + if ((s6.s1.i != 7654) || (s6.s1.ch != 'x') || (s6.s1.L != 65535) || + (fabs(s6.s1.f - 876.0) > 0.001) || (fabs(s6.s1.d - 877.0) > 0.001) || + (fabs(s6.s1.e - 878.0) > 0.001) || (s6.s1.bf1 != 27)) + goto Fail; + + for (j = 10, i = 0; i < 5; i++) + if (s6.s2.i1 [i] != j--) + goto Fail; + + if (strcmp (s6.s2.ch1, "it's back")) + goto Fail; + + for (k = 2000, i = 0; i < 3; i++) + if (s6.s2.L1 [i] != k++) + goto Fail; + + for (f = 7.7, i = 0; i < 4; i++) + { + if (fabs(s6.s2.f1 [i] - f) > 0.00001) + goto Fail; + f += 1.1; + } + + for (d = 6.0, i = 0; i < 3; i++) + if (s6.s2.d1 [i] != d) + goto Fail; + + if ((fabs(s6.s2.e1 [0] - 1.0) > 0.00001) + || (fabs(s6.s2.e1 [1] - 1.3) > 0.00001)) + goto Fail; + + for (ui = 0x7F, i = 0; i < 4; i++) + if (s6.s2.ui [i] != ui++) + goto Fail; + + if ((s6.s2.ul [0] != 1) || (s6.s2.ul [1] != 0)) + goto Fail; + + + printf ("Passed Conformance Test 4.6.6.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 4.6.6.2\n"); + } diff --git a/Tests/Conformance/C4.6.7.1.CC b/Tests/Conformance/C4.6.7.1.CC old mode 100755 new mode 100644 index 42014f8..ec46a16 --- a/Tests/Conformance/C4.6.7.1.CC +++ b/Tests/Conformance/C4.6.7.1.CC @@ -1 +1,28 @@ -/* Conformance Test 4.6.7.1: Verification of union initialization */ union U1 { int i; long L; float f; }; union U1 u1 = { 3 }; static union U1 u2 = 5; main () { auto union U1 u3 = { 32767 }; if (u1.i != 3) goto Fail; if (u2.i != 5) goto Fail; if (u3.i != 32767) goto Fail; printf ("Passed Conformance Test 4.6.7.1\n"); return; Fail: printf ("Failed Conformance Test 4.6.7.1\n"); } \ No newline at end of file +/* Conformance Test 4.6.7.1: Verification of union initialization */ + +union U1 { int i; + long L; + float f; }; + +union U1 u1 = { 3 }; +static union U1 u2 = 5; + +main () + { + auto union U1 u3 = { 32767 }; + + if (u1.i != 3) + goto Fail; + + if (u2.i != 5) + goto Fail; + + if (u3.i != 32767) + goto Fail; + + printf ("Passed Conformance Test 4.6.7.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 4.6.7.1\n"); + } diff --git a/Tests/Conformance/C5.6.0.1.CC b/Tests/Conformance/C5.6.0.1.CC old mode 100755 new mode 100644 index b631fab..14ddc8c --- a/Tests/Conformance/C5.6.0.1.CC +++ b/Tests/Conformance/C5.6.0.1.CC @@ -1 +1,35 @@ -/* Conformance Test 5.6.0.1: Make sure structs can be forward */ /* declared. */ #include int fail = 0; struct foo bar; struct foo {int i,j;}; void f(void) { struct foo {char j,k;} bar; bar.j = 'a'; bar.k = 'b'; if ((bar.j != 'a') || (bar.k != 'b')) fail = 1; } int main(void) { bar.i = -1; bar.j = 3; if ((bar.i != -1) || (bar.j != 3)) fail = 1; f(); if (fail) printf ("Failed Conformance Test 5.6.0.1\n"); else printf ("Passed Conformance Test 5.6.0.1\n"); } \ No newline at end of file +/* Conformance Test 5.6.0.1: Make sure structs can be forward */ +/* declared. */ + +#include + +int fail = 0; + +struct foo bar; +struct foo {int i,j;}; + +void f(void) + +{ +struct foo {char j,k;} bar; + +bar.j = 'a'; +bar.k = 'b'; +if ((bar.j != 'a') || (bar.k != 'b')) + fail = 1; +} + +int main(void) + +{ +bar.i = -1; +bar.j = 3; +if ((bar.i != -1) || (bar.j != 3)) + fail = 1; +f(); + +if (fail) + printf ("Failed Conformance Test 5.6.0.1\n"); +else + printf ("Passed Conformance Test 5.6.0.1\n"); +} diff --git a/Tests/Conformance/C6.2.3.1.CC b/Tests/Conformance/C6.2.3.1.CC old mode 100755 new mode 100644 index fbb0dd4..a88f94a --- a/Tests/Conformance/C6.2.3.1.CC +++ b/Tests/Conformance/C6.2.3.1.CC @@ -1 +1,108 @@ -/* Conformance Test 5.11.0.1: Verification of type equivalence: int types */ #include main () { char ch = 'Z'; int i = 80, k; short sh = 5; enum E { a, b, c } e = b; unsigned char uch = 'm'; unsigned int ui = 0xff; unsigned short ush = 0x80; static void TestCnv (unsigned int ch, unsigned int i, int ui); static int TestInt (int ch, int i, int e, int sh, int ui, int ush, int uch); static unsigned int TestUnsigned (unsigned int ush, unsigned int ui, unsigned int uch, unsigned int e, unsigned int sh, unsigned int i, unsigned int ch); k = TestInt (ch, i, e, sh, ui, ush, uch); if (k != 0x703) goto Fail; k = TestUnsigned (ush, ui, uch, e, sh, i, ch); if (k != 0x3739) goto Fail; ch = 131; i = -32767; ui = 0xa123; TestCnv (ch, i, ui); printf ("Passed Conformance Test 6.2.3.1\n"); return; Fail: printf ("Failed Conformance Test 6.2.3.1\n"); } /*****************************************************************************/ static int TestInt (int ch, int i, int e, int sh, int ui, int ush, int uch) { int j; /* Ensure parameters have not been changed during usual conversions. */ if ((ch != 90) || (i != 80) || (e != 1) || (sh != 5) || (ui != 255) || (ush != 128) || (uch != 109)) goto Fail; /* Compute integral expression and check expected result. */ j = (ch + i * e - ui / sh << 4 | ush >> 1) - (uch); if (j != 1795) goto Fail; return j; Fail: printf ("Failure in TestInt function in Conformance Test 5.11.0.1\n"); exit (-1); } /*****************************************************************************/ static unsigned int TestUnsigned (unsigned int ush, unsigned int ui, unsigned int uch, unsigned int e, unsigned int sh, unsigned int i, unsigned int ch) { unsigned int j; /* Ensure parameters have not been changed during usual conversions. */ if ((ush != 128) || (ui != 255) || (sh != 5) || (e != 1) || (i != 80) || (ch != 90) || (uch != 109)) goto Fail; /* Compute integral expression and check expected result. */ j = ((ush ^ e) * uch) - (ch / sh >> 2) + (i & ui); if (j != 14137) goto Fail; return j; Fail: printf ("Failure in TestUnsigned function in Conformance Test 6.2.3.1\n"); exit (-1); } /*****************************************************************************/ static void TestCnv (unsigned int ch, unsigned int i, int ui) { if ((ch != 0x0083) || (i != 0x8001) || (ui != -24285)) goto Fail; return; Fail: printf ("Failure in TestCnv function in Conformance Test 6.2.3.1\n"); exit (-1); } \ No newline at end of file +/* Conformance Test 5.11.0.1: Verification of type equivalence: int types */ + +#include + +main () + { + char ch = 'Z'; + int i = 80, k; + short sh = 5; + enum E { a, b, c } e = b; + unsigned char uch = 'm'; + unsigned int ui = 0xff; + unsigned short ush = 0x80; + + static void TestCnv (unsigned int ch, unsigned int i, int ui); + static int TestInt (int ch, int i, int e, int sh, int ui, int ush, int uch); + static unsigned int TestUnsigned (unsigned int ush, unsigned int ui, + unsigned int uch, unsigned int e, + unsigned int sh, unsigned int i, + unsigned int ch); + + + k = TestInt (ch, i, e, sh, ui, ush, uch); + if (k != 0x703) + goto Fail; + + k = TestUnsigned (ush, ui, uch, e, sh, i, ch); + if (k != 0x3739) + goto Fail; + + ch = 131; + i = -32767; + ui = 0xa123; + TestCnv (ch, i, ui); + + + printf ("Passed Conformance Test 6.2.3.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 6.2.3.1\n"); + } + + +/*****************************************************************************/ + +static int TestInt (int ch, int i, int e, int sh, int ui, int ush, int uch) + { + int j; + + /* Ensure parameters have not been changed during usual conversions. */ + + if ((ch != 90) || (i != 80) || (e != 1) || (sh != 5) || (ui != 255) || + (ush != 128) || (uch != 109)) + goto Fail; + + /* Compute integral expression and check expected result. */ + + j = (ch + i * e - ui / sh << 4 | ush >> 1) - (uch); + if (j != 1795) + goto Fail; + return j; + +Fail: + printf ("Failure in TestInt function in Conformance Test 5.11.0.1\n"); + exit (-1); + } + + +/*****************************************************************************/ + +static unsigned int TestUnsigned (unsigned int ush, unsigned int ui, + unsigned int uch, unsigned int e, + unsigned int sh, unsigned int i, + unsigned int ch) + { + unsigned int j; + + /* Ensure parameters have not been changed during usual conversions. */ + + if ((ush != 128) || (ui != 255) || (sh != 5) || (e != 1) || (i != 80) || + (ch != 90) || (uch != 109)) + goto Fail; + + /* Compute integral expression and check expected result. */ + + j = ((ush ^ e) * uch) - (ch / sh >> 2) + (i & ui); + if (j != 14137) + goto Fail; + return j; + +Fail: + printf ("Failure in TestUnsigned function in Conformance Test 6.2.3.1\n"); + exit (-1); + } + + +/*****************************************************************************/ + +static void TestCnv (unsigned int ch, unsigned int i, int ui) + { + if ((ch != 0x0083) || (i != 0x8001) || (ui != -24285)) + goto Fail; + return; +Fail: + printf ("Failure in TestCnv function in Conformance Test 6.2.3.1\n"); + exit (-1); + } diff --git a/Tests/Conformance/C6.2.3.2.CC b/Tests/Conformance/C6.2.3.2.CC old mode 100755 new mode 100644 index e44f1bf..d311032 --- a/Tests/Conformance/C6.2.3.2.CC +++ b/Tests/Conformance/C6.2.3.2.CC @@ -1 +1,82 @@ -/* Conformance Test 6.2.3.2: Verification of type equivalence: long types */ #include main () { signed char ch; int i; short sh; long L = 2147483647; unsigned char uch; unsigned int ui; unsigned short ush; unsigned long uL; static long TestLong (unsigned long uL, unsigned short ush, unsigned int ui, unsigned char uch, long L, short sh, int i, signed char ch); static void TestCnv (unsigned long uL, unsigned short ush, unsigned int ui, unsigned char uch, long L, short sh, int i, signed char ch); L = TestLong (L, L, L, L, L, L, L, L); if (L != -2139095296) goto Fail; TestCnv (L, L, L, L, L, L, L, L); printf ("Passed Conformance Test 6.2.3.2\n"); return; Fail: printf ("Failed Conformance Test 6.2.3.2\n"); } /*****************************************************************************/ static long TestLong (unsigned long uL, unsigned short ush, unsigned int ui, unsigned char uch, long L, short sh, int i, signed char ch) { long LL; /* Ensure parameters have not been changed during usual conversions. */ if ((uL != 0x7fFFffFF) || (ush != 0xffff) || (ui != 0xFFFF) || (uch != 0xff) || (L != 2147483647) || (sh != -1) || (i != -1) || (ch != -1)) goto Fail; /* Compute integral expression and check expected result. */ LL = (uL >> 8 ^ ush >> 8) - (L + ch * sh); if (LL != -2139095296) goto Fail; return LL; Fail: printf ("Failure in TestLong function in Conformance Test 6.2.3.2\n"); exit (-1); } /*****************************************************************************/ static void TestCnv (unsigned long uL, unsigned short ush, unsigned int ui, unsigned char uch, long L, short sh, int i, signed char ch) { if ((uL != 0x807FFF00) || (ush != 0xFF00) || (ui != 0xFF00) || (uch != 0) || (L != -2139095296) || (sh != -256) || (i != -256) || (ch != 0)) goto Fail; return; Fail: printf ("Failure in TestCnv function in Conformance Test 6.2.3.2\n"); exit (-1); } \ No newline at end of file +/* Conformance Test 6.2.3.2: Verification of type equivalence: long types */ + +#include + +main () + { + signed char ch; + int i; + short sh; + long L = 2147483647; + + unsigned char uch; + unsigned int ui; + unsigned short ush; + unsigned long uL; + + static long TestLong (unsigned long uL, unsigned short ush, unsigned int ui, + unsigned char uch, long L, short sh, int i, + signed char ch); + + static void TestCnv (unsigned long uL, unsigned short ush, unsigned int ui, + unsigned char uch, long L, short sh, int i, + signed char ch); + + + L = TestLong (L, L, L, L, L, L, L, L); + if (L != -2139095296) + goto Fail; + + TestCnv (L, L, L, L, L, L, L, L); + + printf ("Passed Conformance Test 6.2.3.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 6.2.3.2\n"); + } + + +/*****************************************************************************/ + +static long TestLong (unsigned long uL, unsigned short ush, unsigned int ui, + unsigned char uch, long L, short sh, int i, + signed char ch) + { + long LL; + + /* Ensure parameters have not been changed during usual conversions. */ + + if ((uL != 0x7fFFffFF) || (ush != 0xffff) || (ui != 0xFFFF) || + (uch != 0xff) || (L != 2147483647) || (sh != -1) || (i != -1) || + (ch != -1)) + goto Fail; + + /* Compute integral expression and check expected result. */ + + LL = (uL >> 8 ^ ush >> 8) - (L + ch * sh); + if (LL != -2139095296) + goto Fail; + return LL; + +Fail: + printf ("Failure in TestLong function in Conformance Test 6.2.3.2\n"); + exit (-1); + } + + +/*****************************************************************************/ + +static void TestCnv (unsigned long uL, unsigned short ush, unsigned int ui, + unsigned char uch, long L, short sh, int i, + signed char ch) + { + if ((uL != 0x807FFF00) || (ush != 0xFF00) || (ui != 0xFF00) || (uch != 0) || + (L != -2139095296) || (sh != -256) || (i != -256) || (ch != 0)) + goto Fail; + return; + +Fail: + printf ("Failure in TestCnv function in Conformance Test 6.2.3.2\n"); + exit (-1); + } diff --git a/Tests/Conformance/C6.2.3.3.CC b/Tests/Conformance/C6.2.3.3.CC old mode 100755 new mode 100644 index 324844c..3071618 --- a/Tests/Conformance/C6.2.3.3.CC +++ b/Tests/Conformance/C6.2.3.3.CC @@ -1 +1,83 @@ -/* Conformance Test 6.2.3.3: Verification of type equivalence: long types */ #include main () { signed char ch; int i; short sh; long L; unsigned char uch; unsigned int ui; unsigned short ush; unsigned long uL = 65535; static long TestULong (unsigned long uL, unsigned short ush, unsigned int ui, unsigned char uch, long L, short sh, int i, signed char ch); static void TestCnv (unsigned long uL, unsigned short ush, unsigned int ui, unsigned char uch, long L, short sh, int i, signed char ch); uL = TestULong (uL, uL, uL, uL, uL, uL, uL, uL); if (uL != 0xffFf0000) goto Fail; TestCnv (uL, uL, uL, uL, uL, uL, uL, uL); printf ("Passed Conformance Test 6.2.3.3\n"); return; Fail: printf ("Failed Conformance Test 6.2.3.3\n"); } /*****************************************************************************/ static long TestULong (unsigned long uL, unsigned short ush, unsigned int ui, unsigned char uch, long L, short sh, int i, signed char ch) { unsigned long UL; /* Ensure parameters have not been changed during usual conversions. */ if ((uL != 0x0000ffFF) || (ush != 0xffff) || (ui != 0xFFFF) || (uch != 0xff) || (L != 65535) || (sh != -1) || (i != -1) || (ch != -1)) goto Fail; /* Compute integral expression and check expected result. */ UL = ((uL >> 8 ^ ush >> 8) - (L + ch * sh)) | 0x80000000; if (UL != 0xFFFF0000) goto Fail; return UL; Fail: printf ("Failure in TestULong function in Conformance Test 6.2.3.3\n"); exit (-1); } /*****************************************************************************/ static void TestCnv (unsigned long uL, unsigned short ush, unsigned int ui, unsigned char uch, long L, short sh, int i, signed char ch) { if ((uL != 0xFFFF0000) || (ush != 0) || (ui != 0) || (uch != 0) || (L != -65536) || (sh != 0) || (i != 0) || (ch != 0)) goto Fail; return; Fail: printf ("Failure in TestCnv function in Conformance Test 6.2.3.3\n"); exit (-1); } \ No newline at end of file +/* Conformance Test 6.2.3.3: Verification of type equivalence: long types */ + +#include + +main () + { + signed char ch; + int i; + short sh; + long L; + + unsigned char uch; + unsigned int ui; + unsigned short ush; + unsigned long uL = 65535; + + static long TestULong (unsigned long uL, unsigned short ush, unsigned int ui, + unsigned char uch, long L, short sh, int i, + signed char ch); + + static void TestCnv (unsigned long uL, unsigned short ush, unsigned int ui, + unsigned char uch, long L, short sh, int i, + signed char ch); + + + uL = TestULong (uL, uL, uL, uL, uL, uL, uL, uL); + if (uL != 0xffFf0000) + goto Fail; + + TestCnv (uL, uL, uL, uL, uL, uL, uL, uL); + + printf ("Passed Conformance Test 6.2.3.3\n"); + return; + +Fail: + printf ("Failed Conformance Test 6.2.3.3\n"); + } + + +/*****************************************************************************/ + +static long TestULong (unsigned long uL, unsigned short ush, unsigned int ui, + unsigned char uch, long L, short sh, int i, + signed char ch) + { + unsigned long UL; + + /* Ensure parameters have not been changed during usual conversions. */ + + if ((uL != 0x0000ffFF) || (ush != 0xffff) || (ui != 0xFFFF) || + (uch != 0xff) || (L != 65535) || (sh != -1) || (i != -1) || + (ch != -1)) + goto Fail; + + /* Compute integral expression and check expected result. */ + + UL = ((uL >> 8 ^ ush >> 8) - (L + ch * sh)) | 0x80000000; + if (UL != 0xFFFF0000) + goto Fail; + return UL; + +Fail: + printf ("Failure in TestULong function in Conformance Test 6.2.3.3\n"); + exit (-1); + } + + +/*****************************************************************************/ + +static void TestCnv (unsigned long uL, unsigned short ush, unsigned int ui, + unsigned char uch, long L, short sh, int i, + signed char ch) + { + if ((uL != 0xFFFF0000) || (ush != 0) || (ui != 0) || + (uch != 0) || (L != -65536) || (sh != 0) || (i != 0) || + (ch != 0)) + goto Fail; + return; + +Fail: + printf ("Failure in TestCnv function in Conformance Test 6.2.3.3\n"); + exit (-1); + } diff --git a/Tests/Conformance/C6.2.3.4.CC b/Tests/Conformance/C6.2.3.4.CC old mode 100755 new mode 100644 index 7e22482..627d500 --- a/Tests/Conformance/C6.2.3.4.CC +++ b/Tests/Conformance/C6.2.3.4.CC @@ -1 +1,90 @@ -/* Conformance Test 6.2.3.4: Verification of type equivalence: long types */ #include main () { signed char ch = 0x87; int i = -32767; short sh = -12345; long L; unsigned char uch = 0x95; unsigned int ui = 0xabcd; unsigned short ush = 0x8765; unsigned long uL; static long TestLong (long ush, long ui, long uch, long sh, long i, long ch); static unsigned long TestULong (unsigned long ush, unsigned long ui, unsigned long uch, unsigned long sh, unsigned long i, unsigned long ch); L = TestLong (ush, ui, uch, sh, i, ch); if (L != 3952611) goto Fail; uL = TestULong (ush, ui, uch, sh, i, ch); if (uL != 0xFFFE7BFA) goto Fail; printf ("Passed Conformance Test 6.2.3.4\n"); return; Fail: printf ("Failed Conformance Test 6.2.3.4\n"); } /*****************************************************************************/ static long TestLong (long ush, long ui, long uch, long sh, long i, long ch) { long L; /* Ensure parameters have not been changed during usual conversions. */ if ((ush != 0x8765) || (ui != 0xaBcD) || (uch != 149) || (sh != -12345) || (i != -32767) || (ch != -121)) goto Fail; /* Compute integral expression and check expected result. */ L = i * ch - ush / ui + uch + sh; if (L != 3952611) goto Fail; return L; Fail: printf ("Failure in TestLong function in Conformance Test 6.2.3.4\n"); exit (-1); } /*****************************************************************************/ static unsigned long TestULong (unsigned long ush, unsigned long ui, unsigned long uch, unsigned long sh, unsigned long i, unsigned long ch) { unsigned long ul; /* Check converted values passed to function. */ if ((ush != 0x8765) || (ui != 0xaBcD) || (uch != 0x95) || (sh != 0xFFFFcfc7) || (i != 0xffff8001) || (ch != 0xffffff87)) goto Fail; /* Use values to compute expression, and then check expected result. */ ul = ch - sh - ui - ush + i - uch; if (ul != 0xFFFE7BFA) goto Fail; return ul; Fail: printf ("Failure in TestULong function in Conformance Test 6.2.3.4\n"); exit (-1); } \ No newline at end of file +/* Conformance Test 6.2.3.4: Verification of type equivalence: long types */ + +#include + +main () + { + signed char ch = 0x87; + int i = -32767; + short sh = -12345; + long L; + + unsigned char uch = 0x95; + unsigned int ui = 0xabcd; + unsigned short ush = 0x8765; + unsigned long uL; + + static long TestLong (long ush, long ui, long uch, long sh, long i, long ch); + + static unsigned long TestULong (unsigned long ush, unsigned long ui, + unsigned long uch, unsigned long sh, + unsigned long i, unsigned long ch); + + + L = TestLong (ush, ui, uch, sh, i, ch); + if (L != 3952611) + goto Fail; + + uL = TestULong (ush, ui, uch, sh, i, ch); + if (uL != 0xFFFE7BFA) + goto Fail; + + + printf ("Passed Conformance Test 6.2.3.4\n"); + return; + +Fail: + printf ("Failed Conformance Test 6.2.3.4\n"); + } + + +/*****************************************************************************/ + +static long TestLong (long ush, long ui, long uch, long sh, long i, long ch) + { + long L; + + /* Ensure parameters have not been changed during usual conversions. */ + + if ((ush != 0x8765) || (ui != 0xaBcD) || (uch != 149) || (sh != -12345) || + (i != -32767) || (ch != -121)) + goto Fail; + + /* Compute integral expression and check expected result. */ + + L = i * ch - ush / ui + uch + sh; + if (L != 3952611) + goto Fail; + return L; + +Fail: + printf ("Failure in TestLong function in Conformance Test 6.2.3.4\n"); + exit (-1); + } + + +/*****************************************************************************/ + +static unsigned long TestULong (unsigned long ush, unsigned long ui, + unsigned long uch, unsigned long sh, + unsigned long i, unsigned long ch) + { + unsigned long ul; + + /* Check converted values passed to function. */ + + if ((ush != 0x8765) || (ui != 0xaBcD) || (uch != 0x95) || + (sh != 0xFFFFcfc7) || (i != 0xffff8001) || (ch != 0xffffff87)) + goto Fail; + + /* Use values to compute expression, and then check expected result. */ + + ul = ch - sh - ui - ush + i - uch; + if (ul != 0xFFFE7BFA) + goto Fail; + return ul; + +Fail: + printf ("Failure in TestULong function in Conformance Test 6.2.3.4\n"); + exit (-1); + } diff --git a/Tests/Conformance/C7.10.0.1.CC b/Tests/Conformance/C7.10.0.1.CC old mode 100755 new mode 100644 index 6803e31..8484baf --- a/Tests/Conformance/C7.10.0.1.CC +++ b/Tests/Conformance/C7.10.0.1.CC @@ -1 +1,44 @@ -/* Conformance Test 7.10.0.1: Verification of comma operator */ #include #include main () { int i = 5; long L = 32777; char ch = '!'; unsigned int ui = 653; unsigned long ul = 895; unsigned char uch = 0x8; comp c = 4294; float f = 3.5; double d = 87.65; extended e = 92.33; i = (i++ * 2, i -= 2, 88); L = (ch *= 2, ch--, 3000); ch = ('a' || 'b', ch++); c = -9, 888, f * 3.3; f = 1.1 + f, f -= 57, f+=1.0; d = (L, uch, -f); e = 8 + e, e -= 0.33, e / 2; ui = ui * 3, ui--, ui; ul = ul >>= 5, ul & 0x0, ul++; uch = (2 + uch, 'Y'); if ((i != 88) || (L != 3000) || (ch != 'A') || (ui != 1958) || (ul != 28) || (uch != 'Y') || (fabs(c -(- 9.0)) > 0.00001) || (fabs(f - (-51.4)) > 0.00001) || (fabs(d - 51.40) > 0.00001) || (fabs(e - 100.000) > 0.00001)) goto Fail; printf ("Passed Conformance Test 7.10.0.1\n"); return; Fail: printf ("Failed Conformance Test 7.10.0.1\n"); } \ No newline at end of file +/* Conformance Test 7.10.0.1: Verification of comma operator */ + +#include +#include + +main () + { + int i = 5; + long L = 32777; + char ch = '!'; + + unsigned int ui = 653; + unsigned long ul = 895; + unsigned char uch = 0x8; + + comp c = 4294; + float f = 3.5; + double d = 87.65; + extended e = 92.33; + + i = (i++ * 2, i -= 2, 88); + L = (ch *= 2, ch--, 3000); + ch = ('a' || 'b', ch++); + c = -9, 888, f * 3.3; + f = 1.1 + f, f -= 57, f+=1.0; + d = (L, uch, -f); + e = 8 + e, e -= 0.33, e / 2; + ui = ui * 3, ui--, ui; + ul = ul >>= 5, ul & 0x0, ul++; + uch = (2 + uch, 'Y'); + + if ((i != 88) || (L != 3000) || (ch != 'A') || (ui != 1958) || + (ul != 28) || (uch != 'Y') || (fabs(c -(- 9.0)) > 0.00001) || + (fabs(f - (-51.4)) > 0.00001) || (fabs(d - 51.40) > 0.00001) || + (fabs(e - 100.000) > 0.00001)) + goto Fail; + + + printf ("Passed Conformance Test 7.10.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.10.0.1\n"); + } diff --git a/Tests/Conformance/C7.4.1.1.CC b/Tests/Conformance/C7.4.1.1.CC old mode 100755 new mode 100644 index 1a4cad7..45c3ee5 --- a/Tests/Conformance/C7.4.1.1.CC +++ b/Tests/Conformance/C7.4.1.1.CC @@ -1 +1,43 @@ -/* Conformance Test 7.4.1.1: Verification of subscripted expressions */ #include #include main () { int i [5] = { 1, 2, 3, 4, 5 }, *iptr = i; struct S { float f; char ch; } s = { 2.2, 'k' }, *sptr = &s; static double D (extended e), (*fptr) () = D, d; if ((iptr++ [2]) != 3) goto Fail; if (iptr != &i [1]) goto Fail; if (i [4] != 5) goto Fail; d = (*fptr) (5.5); if (fabs(d - 11.0) > 0.00001) goto Fail; d = fptr (4.5); if (fabs(d - 9.0) > 0.00001) goto Fail; printf ("Passed Conformance Test 7.4.1.1\n"); return; Fail: printf ("Failed Conformance Test 7.4.1.1\n"); } /*****************************************************************************/ static double D (extended e) { return (e * 2.0); } \ No newline at end of file +/* Conformance Test 7.4.1.1: Verification of subscripted expressions */ + +#include +#include + +main () + { + int i [5] = { 1, 2, 3, 4, 5 }, *iptr = i; + struct S { float f; char ch; } s = { 2.2, 'k' }, *sptr = &s; + static double D (extended e), (*fptr) () = D, d; + + if ((iptr++ [2]) != 3) + goto Fail; + + if (iptr != &i [1]) + goto Fail; + + if (i [4] != 5) + goto Fail; + + d = (*fptr) (5.5); + if (fabs(d - 11.0) > 0.00001) + goto Fail; + + d = fptr (4.5); + if (fabs(d - 9.0) > 0.00001) + goto Fail; + + + printf ("Passed Conformance Test 7.4.1.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.4.1.1\n"); + } + + +/*****************************************************************************/ + +static double D (extended e) + { + return (e * 2.0); + } diff --git a/Tests/Conformance/C7.4.4.1.CC b/Tests/Conformance/C7.4.4.1.CC old mode 100755 new mode 100644 index 72ae3c8..ee446f9 --- a/Tests/Conformance/C7.4.4.1.CC +++ b/Tests/Conformance/C7.4.4.1.CC @@ -1 +1,50 @@ -/* Conformance Test 7.4.4.1: Verification of postincrement operator */ #include #include main () { int i = 5, j; long L = 32777; char ch = 'y'; unsigned int ui = 65534; unsigned long ul = 0x7FFFFFFF; unsigned char uch = 0x80; comp c = 2147483646; float f = 3.5; double d = 87.65; extended e = 92.33; struct st {int i,j;} s[2]; i++; L++; ch++; ui++; ul++; uch++; c++; f++; d++; e++; if ((i != 6) || (L != 32778) || (ch != 'z') || (ui != 65535) || (ul != 0x80000000) || (uch != 0x81) || (c != 2147483647) || (fabs(f - 4.5) > 0.00001) || (fabs(d - 88.65) > 0.00001) || (fabs(e - 93.33) > 0.00001)) goto Fail; i = 1; s[1].j = 3; j = s[i].j++; if ((j != 3) || (s[i].j != 4)) goto Fail; printf ("Passed Conformance Test 7.4.4.1\n"); return; Fail: printf ("Failed Conformance Test 7.4.4.1\n"); } \ No newline at end of file +/* Conformance Test 7.4.4.1: Verification of postincrement operator */ + +#include +#include + +main () + { + int i = 5, j; + long L = 32777; + char ch = 'y'; + + unsigned int ui = 65534; + unsigned long ul = 0x7FFFFFFF; + unsigned char uch = 0x80; + + comp c = 2147483646; + float f = 3.5; + double d = 87.65; + extended e = 92.33; + + struct st {int i,j;} s[2]; + + i++; + L++; + ch++; + ui++; + ul++; + uch++; + c++; + f++; + d++; + e++; + if ((i != 6) || (L != 32778) || (ch != 'z') || (ui != 65535) || + (ul != 0x80000000) || (uch != 0x81) || (c != 2147483647) || + (fabs(f - 4.5) > 0.00001) || (fabs(d - 88.65) > 0.00001) || + (fabs(e - 93.33) > 0.00001)) + goto Fail; + + i = 1; + s[1].j = 3; + j = s[i].j++; + if ((j != 3) || (s[i].j != 4)) + goto Fail; + + printf ("Passed Conformance Test 7.4.4.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.4.4.1\n"); + } diff --git a/Tests/Conformance/C7.4.5.1.CC b/Tests/Conformance/C7.4.5.1.CC old mode 100755 new mode 100644 index 8aa3f49..24a8f4a --- a/Tests/Conformance/C7.4.5.1.CC +++ b/Tests/Conformance/C7.4.5.1.CC @@ -1 +1,32 @@ -/* Conformance Test 7.4.5.1: Verification of postdecrement operator */ #include main () { int i = 5; long L = 32777; char ch = 'y'; unsigned int ui = 65534; unsigned long ul = 0x7FFFFFFF; unsigned char uch = 0x80; comp c = 4294967295ul; float f = 3.5; double d = 87.65; extended e = 92.33; i--; L--; ch--; ui--; ul--; uch--; c--; f--; d--; e--; if ((i != 4) || (L != 32776) || (ch != 'x') || (ui != 65533) || (ul != 0x7fFFffFE) || (uch != 0x7f) || (c != 4294967294ul) || (f != 2.5) || (d != 86.65) || (e != 91.33)) goto Fail; printf ("Passed Conformance Test 7.4.5.1\n"); return; Fail: printf ("Failed Conformance Test 7.4.5.1\n"); } \ No newline at end of file +/* Conformance Test 7.4.5.1: Verification of postdecrement operator */ + +#include + +main () + { + int i = 5; + long L = 32777; + char ch = 'y'; + + unsigned int ui = 65534; + unsigned long ul = 0x7FFFFFFF; + unsigned char uch = 0x80; + + comp c = 4294967295ul; + float f = 3.5; + double d = 87.65; + extended e = 92.33; + + i--; L--; ch--; ui--; ul--; uch--; c--; f--; d--; e--; + if ((i != 4) || (L != 32776) || (ch != 'x') || (ui != 65533) || + (ul != 0x7fFFffFE) || (uch != 0x7f) || (c != 4294967294ul) || + (f != 2.5) || (d != 86.65) || (e != 91.33)) + goto Fail; + + + printf ("Passed Conformance Test 7.4.5.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.4.5.1\n"); + } diff --git a/Tests/Conformance/C7.5.1.1.CC b/Tests/Conformance/C7.5.1.1.CC old mode 100755 new mode 100644 index 4670034..9204834 --- a/Tests/Conformance/C7.5.1.1.CC +++ b/Tests/Conformance/C7.5.1.1.CC @@ -1 +1,59 @@ -/* Conformance Test 7.5.1.1: Verification of type casting: int, char types */ #include main () { signed char ch = 'Z'; int i = 80, j, k [7]; short sh = 5; enum E { a, b, c } e = b; unsigned char uch = 'm'; unsigned int ui = 0xff, n [7]; unsigned short ush = 0x80; /* Conversion from integer to integer. */ k [0] = (int) ch; k [1] = (int) i; k [2] = (int) sh; k [3] = (int) ui; k [4] = (int) ush; k [5] = (int) uch; k [6] = (int) e; if ((k [0] != 90) || (k [1] != 80) || (k [2] != 5) || (k [3] != 255) || (k [4] != 128) || (k [5] != 109) || (k [6] != 1)) goto Fail; /* Conversion from integer to unsigned integer. */ n [0] = (unsigned int) ch; n [1] = (unsigned int) i; n [2] = (unsigned int) sh; n [3] = (unsigned int) ui; n [4] = (unsigned int) ush; n [5] = (unsigned int) uch; n [6] = (unsigned int) e; if ((n [4] != 128) || (n [3] != 255) || (n [2] != 5) || (n [6] != 1) || (n [1] != 80) || (n [0] != 90) || (n [5] != 109)) goto Fail; /* Test conversion from negative integer to unsigned integer. */ ch = -125; i = -32767; ui = 0xa123; n [0] = (unsigned int) ch; n [1] = (unsigned int) i; j = (int) ui; if ((n [0] != 0xFF83) || (n [1] != 0x8001) || (j != -24285)) goto Fail; printf ("Passed Conformance Test 7.5.1.1\n"); return; Fail: printf ("Failed Conformance Test 7.5.1.1\n"); } \ No newline at end of file +/* Conformance Test 7.5.1.1: Verification of type casting: int, char types */ + +#include + +main () + { + signed char ch = 'Z'; + int i = 80, j, k [7]; + short sh = 5; + enum E { a, b, c } e = b; + unsigned char uch = 'm'; + unsigned int ui = 0xff, n [7]; + unsigned short ush = 0x80; + + /* Conversion from integer to integer. */ + + k [0] = (int) ch; + k [1] = (int) i; + k [2] = (int) sh; + k [3] = (int) ui; + k [4] = (int) ush; + k [5] = (int) uch; + k [6] = (int) e; + + if ((k [0] != 90) || (k [1] != 80) || (k [2] != 5) || (k [3] != 255) || + (k [4] != 128) || (k [5] != 109) || (k [6] != 1)) + goto Fail; + + + /* Conversion from integer to unsigned integer. */ + + n [0] = (unsigned int) ch; + n [1] = (unsigned int) i; + n [2] = (unsigned int) sh; + n [3] = (unsigned int) ui; + n [4] = (unsigned int) ush; + n [5] = (unsigned int) uch; + n [6] = (unsigned int) e; + + if ((n [4] != 128) || (n [3] != 255) || (n [2] != 5) || (n [6] != 1) || + (n [1] != 80) || (n [0] != 90) || (n [5] != 109)) + goto Fail; + + + /* Test conversion from negative integer to unsigned integer. */ + + ch = -125; + i = -32767; + ui = 0xa123; + n [0] = (unsigned int) ch; n [1] = (unsigned int) i; j = (int) ui; + if ((n [0] != 0xFF83) || (n [1] != 0x8001) || (j != -24285)) + goto Fail; + + printf ("Passed Conformance Test 7.5.1.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.5.1.1\n"); + } diff --git a/Tests/Conformance/C7.5.1.2.CC b/Tests/Conformance/C7.5.1.2.CC old mode 100755 new mode 100644 index c5cc9a6..8e23920 --- a/Tests/Conformance/C7.5.1.2.CC +++ b/Tests/Conformance/C7.5.1.2.CC @@ -1 +1,59 @@ -/* Conformance Test 7.5.1.2: Verification of type casting: long types */ #include main () { signed char ch; int i; short sh; long L = 2147483647, LL; unsigned char uch; unsigned int ui; unsigned short ush; unsigned long uL; extern void TestCnv (unsigned long uL, unsigned short ush, unsigned int ui, unsigned char uch, long L, short sh, int i, signed char ch); /* Test conversion from long to other integral types. */ uL = (unsigned long) L; ush = (unsigned short) L; ui = (unsigned int) L; uch = (unsigned char) L; LL = (long) L; sh = (short) L; i = (int) L; ch = (signed char) L; if ((uL != 0x7fFFffFF) || (ush != 0xffff) || (ui != 0xFFFF) || (uch != 0xff) || (LL != 2147483647) || (sh != -1) || (i != -1) || (ch != -1)) goto Fail; L = -2139095040; uL = (unsigned long) L; ush = (unsigned short) L; ui = (unsigned int) L; uch = (unsigned char) L; LL = (long) L; sh = (short) L; i = (int) L; ch = (signed char) L; if ((uL != 0x80800000) || (ush != 0) || (ui != 0) || (uch != 0) || (LL != -2139095040) || (sh != 0) || (i != 0) || (ch != 0)) goto Fail; printf ("Passed Conformance Test 7.5.1.2\n"); return; Fail: printf ("Failed Conformance Test 7.5.1.2\n"); } \ No newline at end of file +/* Conformance Test 7.5.1.2: Verification of type casting: long types */ + +#include + +main () + { + signed char ch; + int i; + short sh; + long L = 2147483647, LL; + + unsigned char uch; + unsigned int ui; + unsigned short ush; + unsigned long uL; + + extern void TestCnv (unsigned long uL, unsigned short ush, unsigned int ui, + unsigned char uch, long L, short sh, int i, + signed char ch); + + /* Test conversion from long to other integral types. */ + + uL = (unsigned long) L; + ush = (unsigned short) L; + ui = (unsigned int) L; + uch = (unsigned char) L; + LL = (long) L; + sh = (short) L; + i = (int) L; + ch = (signed char) L; + + if ((uL != 0x7fFFffFF) || (ush != 0xffff) || (ui != 0xFFFF) || + (uch != 0xff) || (LL != 2147483647) || (sh != -1) || (i != -1) || + (ch != -1)) + goto Fail; + + + L = -2139095040; + + uL = (unsigned long) L; + ush = (unsigned short) L; + ui = (unsigned int) L; + uch = (unsigned char) L; + LL = (long) L; + sh = (short) L; + i = (int) L; + ch = (signed char) L; + + if ((uL != 0x80800000) || (ush != 0) || (ui != 0) || (uch != 0) || + (LL != -2139095040) || (sh != 0) || (i != 0) || (ch != 0)) + goto Fail; + + + printf ("Passed Conformance Test 7.5.1.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.5.1.2\n"); + } diff --git a/Tests/Conformance/C7.5.1.3.CC b/Tests/Conformance/C7.5.1.3.CC old mode 100755 new mode 100644 index bc5e295..8bfe273 --- a/Tests/Conformance/C7.5.1.3.CC +++ b/Tests/Conformance/C7.5.1.3.CC @@ -1 +1,55 @@ -/* Conformance Test 7.5.1.3: Verification of type equivalence: long types */ #include main () { signed char ch; int i; short sh; long L; unsigned char uch; unsigned int ui; unsigned short ush; unsigned long ul = 65535, uLL; /* Test conversion from unsigned long to other integral types. */ uLL = (unsigned long) ul; ush = (unsigned short) ul; ui = (unsigned int) ul; uch = (unsigned char) ul; L = (long) ul; sh = (short) ul; i = (int) ul; ch = (signed char) ul; if ((uLL != 0x0000ffFF) || (ush != 0xffff) || (ui != 0xFFFF) || (uch != 0xff) || (L != 65535) || (sh != -1) || (i != -1) || (ch != -1)) goto Fail; ul = 0xffF20000; uLL = (unsigned long) ul; ush = (unsigned short) ul; ui = (unsigned int) ul; uch = (unsigned char) ul; L = (long) ul; sh = (short) ul; i = (int) ul; ch = (signed char) ul; if ((uLL != 0xFFF20000) || (ush != 0) || (ui != 0) || (uch != 0) || (L != -917504) || (sh != 0) || (i != 0) || (ch != 0)) goto Fail; printf ("Passed Conformance Test 7.5.1.3\n"); return; Fail: printf ("Failed Conformance Test 7.5.1.3\n"); } \ No newline at end of file +/* Conformance Test 7.5.1.3: Verification of type equivalence: long types */ + +#include + +main () + { + signed char ch; + int i; + short sh; + long L; + + unsigned char uch; + unsigned int ui; + unsigned short ush; + unsigned long ul = 65535, uLL; + + + /* Test conversion from unsigned long to other integral types. */ + + uLL = (unsigned long) ul; + ush = (unsigned short) ul; + ui = (unsigned int) ul; + uch = (unsigned char) ul; + L = (long) ul; + sh = (short) ul; + i = (int) ul; + ch = (signed char) ul; + + if ((uLL != 0x0000ffFF) || (ush != 0xffff) || (ui != 0xFFFF) || + (uch != 0xff) || (L != 65535) || (sh != -1) || (i != -1) || + (ch != -1)) + goto Fail; + + + ul = 0xffF20000; + + uLL = (unsigned long) ul; + ush = (unsigned short) ul; + ui = (unsigned int) ul; + uch = (unsigned char) ul; + L = (long) ul; + sh = (short) ul; + i = (int) ul; + ch = (signed char) ul; + + if ((uLL != 0xFFF20000) || (ush != 0) || (ui != 0) || (uch != 0) || + (L != -917504) || (sh != 0) || (i != 0) || (ch != 0)) + goto Fail; + + printf ("Passed Conformance Test 7.5.1.3\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.5.1.3\n"); + } diff --git a/Tests/Conformance/C7.5.1.4.CC b/Tests/Conformance/C7.5.1.4.CC old mode 100755 new mode 100644 index fd7792c..baf6b38 --- a/Tests/Conformance/C7.5.1.4.CC +++ b/Tests/Conformance/C7.5.1.4.CC @@ -1 +1,52 @@ -/* Conformance Test 7.5.1.4: Verification of type casting: int to long */ #include main () { signed char ch = 0x87; int i = -32767; short sh = -12345; long L [6]; unsigned char uch = 0x95; unsigned int ui = 0xabcd; unsigned short ush = 0x8765; unsigned long uL [6]; /* Test conversion from shorter integer to long. */ L [0] = (long) ush; L [1] = (long) ui; L [2] = (long) uch; L [3] = (long) sh; L [4] = (long) i; L [5] = (long) ch; if ((L [0] != 0x8765) || (L [1] != 0xaBcD) || (L [2] != 149) || (L [3] != -12345) || (L [4] != -32767) || (L [5] != -121)) goto Fail; /* Test conversion from shorter integer to unsigned long. */ uL [0] = (unsigned long) ush; uL [1] = (unsigned long) ui; uL [2] = (unsigned long) uch; uL [3] = (unsigned long) sh; uL [4] = (unsigned long) i; uL [5] = (unsigned long) ch; if ((uL [0] != 0x8765) || (uL [1] != 0xaBcD) || (uL [2] != 0x95) || (uL [3] != 0xFFFFcfc7) || (uL [4] != 0xffff8001) || (uL [5] != 0xffffff87)) goto Fail; printf ("Passed Conformance Test 7.5.1.4\n"); return; Fail: printf ("Failed Conformance Test 7.5.1.4\n"); } \ No newline at end of file +/* Conformance Test 7.5.1.4: Verification of type casting: int to long */ + +#include + +main () + { + signed char ch = 0x87; + int i = -32767; + short sh = -12345; + long L [6]; + + unsigned char uch = 0x95; + unsigned int ui = 0xabcd; + unsigned short ush = 0x8765; + unsigned long uL [6]; + + + /* Test conversion from shorter integer to long. */ + + L [0] = (long) ush; + L [1] = (long) ui; + L [2] = (long) uch; + L [3] = (long) sh; + L [4] = (long) i; + L [5] = (long) ch; + + if ((L [0] != 0x8765) || (L [1] != 0xaBcD) || (L [2] != 149) || + (L [3] != -12345) || (L [4] != -32767) || (L [5] != -121)) + goto Fail; + + + /* Test conversion from shorter integer to unsigned long. */ + + uL [0] = (unsigned long) ush; + uL [1] = (unsigned long) ui; + uL [2] = (unsigned long) uch; + uL [3] = (unsigned long) sh; + uL [4] = (unsigned long) i; + uL [5] = (unsigned long) ch; + + if ((uL [0] != 0x8765) || (uL [1] != 0xaBcD) || (uL [2] != 0x95) || + (uL [3] != 0xFFFFcfc7) || (uL [4] != 0xffff8001) || + (uL [5] != 0xffffff87)) + goto Fail; + + + printf ("Passed Conformance Test 7.5.1.4\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.5.1.4\n"); + } diff --git a/Tests/Conformance/C7.5.1.5.CC b/Tests/Conformance/C7.5.1.5.CC old mode 100755 new mode 100644 index a65ec65..dcebaa8 --- a/Tests/Conformance/C7.5.1.5.CC +++ b/Tests/Conformance/C7.5.1.5.CC @@ -1 +1,87 @@ -/* Conformance Test 7.5.1.5: Verification of conversion from floating-point */ /* to integer types using type casting */ #include main () { char ch; short sh; int i; long L; unsigned char uch; unsigned int ui; unsigned long ul; float f [10] = { 123.456, -876.443, 456.789, -127.54, 321.456, -456.77, -844.0, 4.0, 6.0, 4.2e2 }, ff; double d [10] = { -1234.56, 4567.89977, 55555.66666, 4.5, -89.0, -4565.00, 333.88, 42.567, 76.564, 987.98765 }, dd; extended e [10] = { 8.456e20, 3478.6e-100, 9876.43E+300, 0.00e-30, 00.00, -0.0, 0.577, 00.33, 0.43212, 0.9876}, ee; /* Check conversion from float to other arithmetic types. */ ff = (float) f [0]; dd = (double) f [1]; ee = (extended) f [2]; ch = (char) f [3]; sh = (short) f [4]; i = (int) f [5]; L = (long) f [6]; uch = (unsigned char) f [7]; ui = (unsigned int) f [8]; ul = (unsigned long) f [9]; if ((ff != 123.456) || (dd != -876.443) || (ee != 456.789) || (ch != -127) || (sh != 321) || (i != -456) || (L != -844) || (uch != 4) || (ui != 6) || (ul != 420)) goto Fail; /* Check conversion from double to other arithmetic types. */ ff = (float) d [0]; dd = (double) d [1]; ee = (extended) d [2]; ch = (char) d [3]; sh = (short) d [4]; i = (int) d [5]; L = (long) d [6]; uch = (unsigned char) d [7]; ui = (unsigned int) d [8]; ul = (unsigned long) d [9]; if ((ff != -1234.56) || (dd != 4567.89977) || (ee != 55555.66666) || (ch != 4) || (sh != -89) || (i != -4565) || (L != 333) || (uch != 42) || (ui != 76) || (ul != 987)) goto Fail; /* Check conversion from extended to other arithmetic types. */ ff = (float) e [0]; dd = (double) e [1]; ee = (extended) e [2]; ch = (char) e [3]; sh = (short) e [4]; i = (int) e [5]; L = (long) e [6]; uch = (unsigned char) e [7]; ui = (unsigned int) e [8]; ul = (unsigned long) e [9]; if ((ff != 8.456e20) || (dd != 3478.6e-100) || (ee != 9876.43e+300) || (ch != 0) || (sh != 0) || (i != 0) || (L != 0) || (uch != 0) || (ui != 0) || (ul != 0)) goto Fail; printf ("Passed Conformance Test 7.5.1.5\n"); return; Fail: printf ("Passed Conformance Test 7.5.1.5\n"); } \ No newline at end of file +/* Conformance Test 7.5.1.5: Verification of conversion from floating-point */ +/* to integer types using type casting */ + +#include + +main () + { + char ch; + short sh; + int i; + long L; + + unsigned char uch; + unsigned int ui; + unsigned long ul; + + float f [10] = { 123.456, -876.443, 456.789, -127.54, 321.456, + -456.77, -844.0, 4.0, 6.0, 4.2e2 }, ff; + double d [10] = { -1234.56, 4567.89977, 55555.66666, 4.5, -89.0, -4565.00, + 333.88, 42.567, 76.564, 987.98765 }, dd; + extended e [10] = { 8.456e20, 3478.6e-100, 9876.43E+300, 0.00e-30, 00.00, + -0.0, 0.577, 00.33, 0.43212, 0.9876}, ee; + + + /* Check conversion from float to other arithmetic types. */ + + ff = (float) f [0]; + dd = (double) f [1]; + ee = (extended) f [2]; + ch = (char) f [3]; + sh = (short) f [4]; + i = (int) f [5]; + L = (long) f [6]; + uch = (unsigned char) f [7]; + ui = (unsigned int) f [8]; + ul = (unsigned long) f [9]; + + if ((ff != 123.456) || (dd != -876.443) || (ee != 456.789) || (ch != -127) || + (sh != 321) || (i != -456) || (L != -844) || (uch != 4) || + (ui != 6) || (ul != 420)) + goto Fail; + + + /* Check conversion from double to other arithmetic types. */ + + ff = (float) d [0]; + dd = (double) d [1]; + ee = (extended) d [2]; + ch = (char) d [3]; + sh = (short) d [4]; + i = (int) d [5]; + L = (long) d [6]; + uch = (unsigned char) d [7]; + ui = (unsigned int) d [8]; + ul = (unsigned long) d [9]; + + if ((ff != -1234.56) || (dd != 4567.89977) || (ee != 55555.66666) || + (ch != 4) || (sh != -89) || (i != -4565) || (L != 333) || + (uch != 42) || (ui != 76) || (ul != 987)) + goto Fail; + + + /* Check conversion from extended to other arithmetic types. */ + + ff = (float) e [0]; + dd = (double) e [1]; + ee = (extended) e [2]; + ch = (char) e [3]; + sh = (short) e [4]; + i = (int) e [5]; + L = (long) e [6]; + uch = (unsigned char) e [7]; + ui = (unsigned int) e [8]; + ul = (unsigned long) e [9]; + + if ((ff != 8.456e20) || (dd != 3478.6e-100) || (ee != 9876.43e+300) || + (ch != 0) || (sh != 0) || (i != 0) || (L != 0) || (uch != 0) || + (ui != 0) || (ul != 0)) + goto Fail; + + + printf ("Passed Conformance Test 7.5.1.5\n"); + return; + +Fail: + printf ("Passed Conformance Test 7.5.1.5\n"); + } diff --git a/Tests/Conformance/C7.5.1.6.CC b/Tests/Conformance/C7.5.1.6.CC old mode 100755 new mode 100644 index dda9c6f..0428177 --- a/Tests/Conformance/C7.5.1.6.CC +++ b/Tests/Conformance/C7.5.1.6.CC @@ -1 +1,79 @@ -/* Conformance Test 7.5.1.6: Verification of conversion from integer to */ /* floating-point types using type casting */ #include main () { char ch = 'D'; short sh = -32767; int i = 4456; long L = sh * 4; comp c = -(ch * i); unsigned char uch = 0x80; unsigned int ui = 65535; unsigned long ul = ui << 2; float f [8]; double d [8]; extended e [8]; /* Check conversion from integer to float. */ f [0] = (float) ch; f [1] = (float) sh; f [2] = (float) i; f [3] = (float) L; f [4] = (float) uch; f [5] = (float) ui; f [6] = (float) ul; f [7] = (float) c; if ((f [0] != 68.0) || (f [1] != -32767.0) || (f [2] != 4456.0) || (f [3] != -131068.0) || (f [4] != 128.0) || (f [5] != 65535.0) || (f [6] != 262140.0) || (f [7] != -303008.0)) goto Fail; /* Check conversion from double to other arithmetic types. */ d [0] = (double) ch; d [1] = (double) sh; d [2] = (double) i; d [3] = (double) L; d [4] = (double) uch; d [5] = (double) ui; d [6] = (double) ul; d [7] = (double) c; if ((d [0] != 68.0) || (d [1] != -32767.0) || (d [2] != 4456.0) || (d [3] != -131068.0) || (d [4] != 128.0) || (d [5] != 65535.0) || (d [6] != 262140.0) || (d [7] != -303008.0)) goto Fail; /* Check conversion from extended to other arithmetic types. */ e [0] = (extended) ch; e [1] = (extended) sh; e [2] = (extended) i; e [3] = (extended) L; e [4] = (extended) uch; e [5] = (extended) ui; e [6] = (extended) ul; e [7] = (extended) c; if ((e [0] != 68.0) || (e [1] != -32767.0) || (e [2] != 4456.0) || (e [3] != -131068.0) || (e [4] != 128.0) || (e [5] != 65535.0) || (e [6] != 262140.0) || (e [7] != -303008.0)) goto Fail; printf ("Passed Conformance Test 7.5.1.6\n"); return; Fail: printf ("Passed Conformance Test 7.5.1.6\n"); } \ No newline at end of file +/* Conformance Test 7.5.1.6: Verification of conversion from integer to */ +/* floating-point types using type casting */ + +#include + +main () + { + char ch = 'D'; + short sh = -32767; + int i = 4456; + long L = sh * 4; + comp c = -(ch * i); + + unsigned char uch = 0x80; + unsigned int ui = 65535; + unsigned long ul = ui << 2; + + float f [8]; + double d [8]; + extended e [8]; + + + /* Check conversion from integer to float. */ + + f [0] = (float) ch; + f [1] = (float) sh; + f [2] = (float) i; + f [3] = (float) L; + f [4] = (float) uch; + f [5] = (float) ui; + f [6] = (float) ul; + f [7] = (float) c; + + if ((f [0] != 68.0) || (f [1] != -32767.0) || (f [2] != 4456.0) || + (f [3] != -131068.0) || (f [4] != 128.0) || (f [5] != 65535.0) || + (f [6] != 262140.0) || (f [7] != -303008.0)) + goto Fail; + + + /* Check conversion from double to other arithmetic types. */ + + d [0] = (double) ch; + d [1] = (double) sh; + d [2] = (double) i; + d [3] = (double) L; + d [4] = (double) uch; + d [5] = (double) ui; + d [6] = (double) ul; + d [7] = (double) c; + + if ((d [0] != 68.0) || (d [1] != -32767.0) || (d [2] != 4456.0) || + (d [3] != -131068.0) || (d [4] != 128.0) || (d [5] != 65535.0) || + (d [6] != 262140.0) || (d [7] != -303008.0)) + goto Fail; + + + /* Check conversion from extended to other arithmetic types. */ + + e [0] = (extended) ch; + e [1] = (extended) sh; + e [2] = (extended) i; + e [3] = (extended) L; + e [4] = (extended) uch; + e [5] = (extended) ui; + e [6] = (extended) ul; + e [7] = (extended) c; + + if ((e [0] != 68.0) || (e [1] != -32767.0) || (e [2] != 4456.0) || + (e [3] != -131068.0) || (e [4] != 128.0) || (e [5] != 65535.0) || + (e [6] != 262140.0) || (e [7] != -303008.0)) + goto Fail; + + + printf ("Passed Conformance Test 7.5.1.6\n"); + return; + +Fail: + printf ("Passed Conformance Test 7.5.1.6\n"); + } diff --git a/Tests/Conformance/C7.5.5.1.CC b/Tests/Conformance/C7.5.5.1.CC old mode 100755 new mode 100644 index 3d7fc3c..66c0c04 --- a/Tests/Conformance/C7.5.5.1.CC +++ b/Tests/Conformance/C7.5.5.1.CC @@ -1 +1,40 @@ -/* Conformance Test 7.5.5.1: Verification of bitwise negation operator */ #include main () { char ch = 0x87; int i = -32767; short sh = -12345; long L = 2147483647; unsigned char uch = 0x95; unsigned int ui = 0xabcd; unsigned short ush = 0x8765; unsigned long uL = 0xffFFffaa; /* Invert each integer and check expected result. */ ch = ~ch; i = ~i; sh = ~sh; L = ~L; uch = ~uch; ui = ~ui; ush = ~ush; uL = ~uL; if ((ch != 'x') || (i != 32766) || (sh != 12344) || (L != 0x80000000) || (uch != 106) || (ui != 21554) || (ush != 0x789a) || (uL != 85)) goto Fail; printf ("Passed Conformance Test 7.5.5.1\n"); return; Fail: printf ("Failed Conformance Test 7.5.5.1\n"); } \ No newline at end of file +/* Conformance Test 7.5.5.1: Verification of bitwise negation operator */ + +#include + +main () + { + char ch = 0x87; + int i = -32767; + short sh = -12345; + long L = 2147483647; + + unsigned char uch = 0x95; + unsigned int ui = 0xabcd; + unsigned short ush = 0x8765; + unsigned long uL = 0xffFFffaa; + + + /* Invert each integer and check expected result. */ + + ch = ~ch; + i = ~i; + sh = ~sh; + L = ~L; + uch = ~uch; + ui = ~ui; + ush = ~ush; + uL = ~uL; + + if ((ch != 'x') || (i != 32766) || (sh != 12344) || (L != 0x80000000) || + (uch != 106) || (ui != 21554) || + (ush != 0x789a) || (uL != 85)) + goto Fail; + + + printf ("Passed Conformance Test 7.5.5.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.5.5.1\n"); + } diff --git a/Tests/Conformance/C7.5.8.1.CC b/Tests/Conformance/C7.5.8.1.CC old mode 100755 new mode 100644 index c253415..7624a25 --- a/Tests/Conformance/C7.5.8.1.CC +++ b/Tests/Conformance/C7.5.8.1.CC @@ -1 +1,33 @@ -/* Conformance Test 7.5.8.1: Verification of preincrement operator */ #include #include main () { int i = 5; long L = 32777; char ch = 'y'; unsigned int ui = 65534; unsigned long ul = 0x7FFFFFFF; unsigned char uch = 0x80; float f = 3.5; double d = 87.65; extended e = 92.33; ++i; ++L; ++ch; ++ui; ++ul; ++uch; ++f; ++d; ++e; if ((i != 6) || (L != 32778) || (ch != 'z') || (ui != 65535) || (ul != 0x80000000) || (uch != 0x81) || (fabs(f - 4.5) > 0.00001) || (fabs(d - 88.65) > 0.00001) || (fabs(e - 93.33) > 0.00001)) goto Fail; printf ("Passed Conformance Test 7.5.8.1\n"); return; Fail: printf ("Failed Conformance Test 7.5.8.1\n"); } \ No newline at end of file +/* Conformance Test 7.5.8.1: Verification of preincrement operator */ + +#include +#include + +main () + { + int i = 5; + long L = 32777; + char ch = 'y'; + + unsigned int ui = 65534; + unsigned long ul = 0x7FFFFFFF; + unsigned char uch = 0x80; + + float f = 3.5; + double d = 87.65; + extended e = 92.33; + + ++i; ++L; ++ch; ++ui; ++ul; ++uch; ++f; ++d; ++e; + if ((i != 6) || (L != 32778) || (ch != 'z') || (ui != 65535) || + (ul != 0x80000000) || (uch != 0x81) || + (fabs(f - 4.5) > 0.00001) || (fabs(d - 88.65) > 0.00001) || + (fabs(e - 93.33) > 0.00001)) + goto Fail; + + + printf ("Passed Conformance Test 7.5.8.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.5.8.1\n"); + } diff --git a/Tests/Conformance/C7.5.9.1.CC b/Tests/Conformance/C7.5.9.1.CC old mode 100755 new mode 100644 index e172b01..99e6b08 --- a/Tests/Conformance/C7.5.9.1.CC +++ b/Tests/Conformance/C7.5.9.1.CC @@ -1 +1,34 @@ -/* Conformance Test 7.5.9.1: Verification of predecrement operator */ #include #include main () { int i = 5; long L = 32777; char ch = 'y'; unsigned int ui = 65534; unsigned long ul = 0x7FFFFFFF; unsigned char uch = 0x80; comp c = 4294967295ul; float f = 3.5; double d = 87.65; extended e = 92.33; --i; --L; --ch; --ui; --ul; --uch; --c; --f; --d; --e; if ((i != 4) || (L != 32776) || (ch != 'x') || (ui != 65533) || (ul != 0x7fFFffFE) || (uch != 0x7f) || (c != 4294967294ul) || (fabs(f - 2.5) > 0.00001) || (fabs(d - 86.65) > 0.00001) || (fabs(e - 91.33) > 0.00001)) goto Fail; printf ("Passed Conformance Test 7.5.9.1\n"); return; Fail: printf ("Failed Conformance Test 7.5.9.1\n"); } \ No newline at end of file +/* Conformance Test 7.5.9.1: Verification of predecrement operator */ + +#include +#include + +main () + { + int i = 5; + long L = 32777; + char ch = 'y'; + + unsigned int ui = 65534; + unsigned long ul = 0x7FFFFFFF; + unsigned char uch = 0x80; + + comp c = 4294967295ul; + float f = 3.5; + double d = 87.65; + extended e = 92.33; + + --i; --L; --ch; --ui; --ul; --uch; --c; --f; --d; --e; + if ((i != 4) || (L != 32776) || (ch != 'x') || (ui != 65533) || + (ul != 0x7fFFffFE) || (uch != 0x7f) || (c != 4294967294ul) || + (fabs(f - 2.5) > 0.00001) || (fabs(d - 86.65) > 0.00001) || + (fabs(e - 91.33) > 0.00001)) + goto Fail; + + + printf ("Passed Conformance Test 7.5.9.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.5.9.1\n"); + } diff --git a/Tests/Conformance/C7.6.1.1.CC b/Tests/Conformance/C7.6.1.1.CC old mode 100755 new mode 100644 index 53a9b46..af7d9cd --- a/Tests/Conformance/C7.6.1.1.CC +++ b/Tests/Conformance/C7.6.1.1.CC @@ -1 +1,44 @@ -/* Conformance Test 7.6.1.1: Verification of multiplication operator */ #include #include main () { int i = 5; long L = 32777; char ch = '!'; unsigned int ui = 653; unsigned long ul = 895; unsigned char uch = 0x8; comp c = 4294; float f = 3.5; double d = 87.65; extended e = 92.33; i = i * -8; L = 3 * L; ch = 2 * ch; c = -9 * c; f = 1.1 * f; d = d * 5; e = 8 * e; ui = ui * 3; ul = 7 * ul; uch = 2 * uch; if ((i != -40) || (L != 98331) || (ch != 'B') || (ui != 1959) || (ul != 6265) || (uch != 16) || (c != -38646) || (fabs(f - 3.85) > 0.00001) || (fabs(d - 438.25) > 0.00001) || (fabs(e - 738.64) > 0.00001)) goto Fail; printf ("Passed Conformance Test 7.6.1.1\n"); return; Fail: printf ("Failed Conformance Test 7.6.1.1\n"); } \ No newline at end of file +/* Conformance Test 7.6.1.1: Verification of multiplication operator */ + +#include +#include + +main () + { + int i = 5; + long L = 32777; + char ch = '!'; + + unsigned int ui = 653; + unsigned long ul = 895; + unsigned char uch = 0x8; + + comp c = 4294; + float f = 3.5; + double d = 87.65; + extended e = 92.33; + + i = i * -8; + L = 3 * L; + ch = 2 * ch; + c = -9 * c; + f = 1.1 * f; + d = d * 5; + e = 8 * e; + ui = ui * 3; + ul = 7 * ul; + uch = 2 * uch; + + if ((i != -40) || (L != 98331) || (ch != 'B') || (ui != 1959) || + (ul != 6265) || (uch != 16) || (c != -38646) || + (fabs(f - 3.85) > 0.00001) || (fabs(d - 438.25) > 0.00001) || + (fabs(e - 738.64) > 0.00001)) + goto Fail; + + + printf ("Passed Conformance Test 7.6.1.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.6.1.1\n"); + } diff --git a/Tests/Conformance/C7.6.1.2.CC b/Tests/Conformance/C7.6.1.2.CC old mode 100755 new mode 100644 index 10c0e13..c7db11e --- a/Tests/Conformance/C7.6.1.2.CC +++ b/Tests/Conformance/C7.6.1.2.CC @@ -1 +1,42 @@ -/* Conformance Test 7.6.1.2: Verification of division operator */ #include main () { int i = 5; long L = 32777; char ch = '!'; unsigned int ui = 653; unsigned long ul = 895; unsigned char uch = 0x8; comp c = 4294; float f = 3.5; double d = 87.65; extended e = 92.33; i = i / -1; L = L / L; ch = ch / 3; c = c / -9; f = f / f; d = d / 5; e = e / 1.0; ui = ui / 3; ul = ul / 5; uch = 2 / uch; if ((i != -5) || (L != 1) || (ch != '\v') || (ui != 217) || (ul != 179) || (uch != 0) || (c != -477) || (f != 1.0) || (d != 17.53) || (e != 92.33)) goto Fail; printf ("Passed Conformance Test 7.6.1.2\n"); return; Fail: printf ("Failed Conformance Test 7.6.1.2\n"); } \ No newline at end of file +/* Conformance Test 7.6.1.2: Verification of division operator */ + +#include + +main () + { + int i = 5; + long L = 32777; + char ch = '!'; + + unsigned int ui = 653; + unsigned long ul = 895; + unsigned char uch = 0x8; + + comp c = 4294; + float f = 3.5; + double d = 87.65; + extended e = 92.33; + + i = i / -1; + L = L / L; + ch = ch / 3; + c = c / -9; + f = f / f; + d = d / 5; + e = e / 1.0; + ui = ui / 3; + ul = ul / 5; + uch = 2 / uch; + + if ((i != -5) || (L != 1) || (ch != '\v') || (ui != 217) || + (ul != 179) || (uch != 0) || (c != -477) || + (f != 1.0) || (d != 17.53) || (e != 92.33)) + goto Fail; + + + printf ("Passed Conformance Test 7.6.1.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.6.1.2\n"); + } diff --git a/Tests/Conformance/C7.6.1.3.CC b/Tests/Conformance/C7.6.1.3.CC old mode 100755 new mode 100644 index b2a347c..aa69286 --- a/Tests/Conformance/C7.6.1.3.CC +++ b/Tests/Conformance/C7.6.1.3.CC @@ -1 +1,39 @@ -/* Conformance Test 7.6.1.3: Verification of remainder operator */ #include main () { char ch = 87; int i = 32767; short sh = 12345; long L = 98765; unsigned char uch = 130; unsigned int ui = 3579; unsigned short ush = 15234; unsigned long uL = 863112; /* Apply remainder operation to each integer and check expected result. */ ch = ch % 2; i = i % 3; sh = sh % 4; L = L % 5; uch = uch % 7; ui = ui % 8; ush = ush % 9; uL = uL % 10; if ((ch != 1) || (i != 1) || (sh != 1) || (L != 0) || (uch != 4) || (ui != 3) || (ush != 6) || (uL != 2)) goto Fail; printf ("Passed Conformance Test 7.6.1.3\n"); return; Fail: printf ("Failed Conformance Test 7.6.1.3\n"); } \ No newline at end of file +/* Conformance Test 7.6.1.3: Verification of remainder operator */ + +#include + +main () + { + char ch = 87; + int i = 32767; + short sh = 12345; + long L = 98765; + + unsigned char uch = 130; + unsigned int ui = 3579; + unsigned short ush = 15234; + unsigned long uL = 863112; + + + /* Apply remainder operation to each integer and check expected result. */ + + ch = ch % 2; + i = i % 3; + sh = sh % 4; + L = L % 5; + uch = uch % 7; + ui = ui % 8; + ush = ush % 9; + uL = uL % 10; + + if ((ch != 1) || (i != 1) || (sh != 1) || (L != 0) || + (uch != 4) || (ui != 3) || (ush != 6) || (uL != 2)) + goto Fail; + + + printf ("Passed Conformance Test 7.6.1.3\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.6.1.3\n"); + } diff --git a/Tests/Conformance/C7.6.2.1.CC b/Tests/Conformance/C7.6.2.1.CC old mode 100755 new mode 100644 index 29d5c30..a1bdcff --- a/Tests/Conformance/C7.6.2.1.CC +++ b/Tests/Conformance/C7.6.2.1.CC @@ -1 +1,62 @@ -/* Conformance Test 7.6.2.1: Verification of additive operators */ #include #include main () { int i = 5; long L = 32777; signed char ch = '!'; unsigned int ui = 653; unsigned long ul = 895; unsigned char uch = 0x8; comp c = 4294; float f = 3.5; double d = 87.65; extended e = 92.33; i = i + -8; L = 3 + L; ch = 2 + ch; c = -9 + c; f = 1.1 + f; d = d + 5; e = 8 + e; ui = ui + 3; ul = 7 + ul; uch = 2 + uch; if ((i != -3) || (L != 32780) || (ch != '#') || (ui != 656) || (ul != 902) || (uch != 10) || (c != 4285) || (fabs(f - 4.6) > 0.00001) || (fabs(d - 92.65) > 0.00001) || (fabs(e - 100.33) > 0.00001)) goto Fail; i = i - (-2000); L = 33 - L; ch = -90 - ch; c = 0 - c; f = 6.8 - f; d = d - 72.1; e = 3.2 - e; ui = ui - 8; ul = 999 - ul; uch = uch - uch; if ((i != 1997) || (L != -32747) || (ch != -125) || (ui != 648) || (ul != 97) || (uch != 0) || (c != -4285) || (fabs(f - 2.2) > 0.00001) || (fabs(d - 20.55) > 0.00001) || (fabs(e + 97.13) > 0.00001)) goto Fail; printf ("Passed Conformance Test 7.6.2.1\n"); return; Fail: printf ("Failed Conformance Test 7.6.2.1\n"); } \ No newline at end of file +/* Conformance Test 7.6.2.1: Verification of additive operators */ + +#include +#include + +main () + { + int i = 5; + long L = 32777; + signed char ch = '!'; + + unsigned int ui = 653; + unsigned long ul = 895; + unsigned char uch = 0x8; + + comp c = 4294; + float f = 3.5; + double d = 87.65; + extended e = 92.33; + + i = i + -8; + L = 3 + L; + ch = 2 + ch; + c = -9 + c; + f = 1.1 + f; + d = d + 5; + e = 8 + e; + ui = ui + 3; + ul = 7 + ul; + uch = 2 + uch; + + if ((i != -3) || (L != 32780) || (ch != '#') || (ui != 656) || + (ul != 902) || (uch != 10) || (c != 4285) || + (fabs(f - 4.6) > 0.00001) || (fabs(d - 92.65) > 0.00001) || + (fabs(e - 100.33) > 0.00001)) + goto Fail; + + + i = i - (-2000); + L = 33 - L; + ch = -90 - ch; + c = 0 - c; + f = 6.8 - f; + d = d - 72.1; + e = 3.2 - e; + ui = ui - 8; + ul = 999 - ul; + uch = uch - uch; + + if ((i != 1997) || (L != -32747) || (ch != -125) || (ui != 648) || + (ul != 97) || (uch != 0) || (c != -4285) || + (fabs(f - 2.2) > 0.00001) || (fabs(d - 20.55) > 0.00001) || + (fabs(e + 97.13) > 0.00001)) + goto Fail; + + + printf ("Passed Conformance Test 7.6.2.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.6.2.1\n"); + } diff --git a/Tests/Conformance/C7.6.3.1.CC b/Tests/Conformance/C7.6.3.1.CC old mode 100755 new mode 100644 index 9781265..a8ecee1 --- a/Tests/Conformance/C7.6.3.1.CC +++ b/Tests/Conformance/C7.6.3.1.CC @@ -1 +1,56 @@ -/* Conformance Test 7.6.3.1: Verification of shift operators */ #include main () { signed char ch = 0X57; int i = 0xabcd; short sh = 0x3214; long L = 0xfedcab65; unsigned char uch = 0x83; unsigned int ui = 0xcbcb; unsigned short ush = 0x1234; unsigned long uL = 0x98765432; /* Shift each integer left and check expected result. */ ch = ch << 1; i = i << 2; sh = sh << 3; L = L << 4; uch = uch << 6; ui = ui << 7; ush = ush << 8; uL = uL << 9; if ((ch != -82) || (i != -20684) || (sh != -28512) || (L != 0xedCAb650) || (uch != 0xc0) || (ui != 0xe580) || (ush != 0x3400) || (uL != 0xeca86400)) goto Fail; /* Shift each integer right and check expected result. */ ch = ch >> 2; i = i >> 3; sh = sh >> 4; L = L >> 5; uch = uch >> 7; ui = ui >> 8; ush = ush >> 9; uL = uL >> 10; if ((ch != 0xFFEB) || (i != 0xF5e6) || (sh != 0xF90a) || (L != 0xff6e55b2) || (uch != 1) || (ui != 0xe5) || (ush != 0x1A) || (uL != 0x3B2A19)) goto Fail; printf ("Passed Conformance Test 7.6.3.1\n"); return; Fail: printf ("Failed Conformance Test 7.6.3.1\n"); } \ No newline at end of file +/* Conformance Test 7.6.3.1: Verification of shift operators */ + +#include + +main () + { + signed char ch = 0X57; + int i = 0xabcd; + short sh = 0x3214; + long L = 0xfedcab65; + + unsigned char uch = 0x83; + unsigned int ui = 0xcbcb; + unsigned short ush = 0x1234; + unsigned long uL = 0x98765432; + + + /* Shift each integer left and check expected result. */ + + ch = ch << 1; + i = i << 2; + sh = sh << 3; + L = L << 4; + uch = uch << 6; + ui = ui << 7; + ush = ush << 8; + uL = uL << 9; + + if ((ch != -82) || (i != -20684) || (sh != -28512) || (L != 0xedCAb650) || + (uch != 0xc0) || (ui != 0xe580) || (ush != 0x3400) + || (uL != 0xeca86400)) + goto Fail; + + + /* Shift each integer right and check expected result. */ + + ch = ch >> 2; + i = i >> 3; + sh = sh >> 4; + L = L >> 5; + uch = uch >> 7; + ui = ui >> 8; + ush = ush >> 9; + uL = uL >> 10; + + if ((ch != 0xFFEB) || (i != 0xF5e6) || (sh != 0xF90a) || (L != 0xff6e55b2) || + (uch != 1) || (ui != 0xe5) || (ush != 0x1A) + || (uL != 0x3B2A19)) + goto Fail; + + printf ("Passed Conformance Test 7.6.3.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.6.3.1\n"); + } diff --git a/Tests/Conformance/C7.6.4.1.CC b/Tests/Conformance/C7.6.4.1.CC old mode 100755 new mode 100644 index cceafa4..6cba7dc --- a/Tests/Conformance/C7.6.4.1.CC +++ b/Tests/Conformance/C7.6.4.1.CC @@ -1 +1,49 @@ -/* Conformance Test 7.6.4.1: Verification of relational operators */ #include main () { int i [3] = { 5, 6, 7 }, *i1ptr = i, *i2ptr = &i [2]; int j, k, m, n; long L = 32777; char ch = '!'; unsigned int ui = 653; unsigned long ul = 895; unsigned char uch = 0x8; comp c = 4294; float f = 3.5; double d = 87.65; extended e = 92.33; /* Compare integers and test expected results. */ j = i [0] < i [2]; k = L <= c; m = uch >= ul; n = ch > ch; if ((j != 1) || (k != 0) || (m != 0) || (n != 0)) goto Fail; /* Compare floating point values and test expected results. */ j = f < d; k = e <= e; m = d > e; n = e >= f; if ((j != 1) || (k != 1) || (m != 0) || (n != 1)) goto Fail; /* Compare pointers and test expected results. */ j = i1ptr > i2ptr; k = i2ptr <= i1ptr; m = i2ptr > i1ptr; n = i1ptr >= i2ptr; if ((j != 0) || (k != 0) || (m != 1) || (n != 0)) goto Fail; printf ("Passed Conformance Test 7.6.4.1\n"); return; Fail: printf ("Failed Conformance Test 7.6.4.1\n"); } \ No newline at end of file +/* Conformance Test 7.6.4.1: Verification of relational operators */ + +#include + +main () + { + int i [3] = { 5, 6, 7 }, *i1ptr = i, *i2ptr = &i [2]; + int j, k, m, n; + long L = 32777; + char ch = '!'; + + unsigned int ui = 653; + unsigned long ul = 895; + unsigned char uch = 0x8; + + comp c = 4294; + float f = 3.5; + double d = 87.65; + extended e = 92.33; + + + /* Compare integers and test expected results. */ + + j = i [0] < i [2]; k = L <= c; m = uch >= ul; n = ch > ch; + if ((j != 1) || (k != 0) || (m != 0) || (n != 0)) + goto Fail; + + + /* Compare floating point values and test expected results. */ + + j = f < d; k = e <= e; m = d > e; n = e >= f; + if ((j != 1) || (k != 1) || (m != 0) || (n != 1)) + goto Fail; + + + /* Compare pointers and test expected results. */ + + j = i1ptr > i2ptr; k = i2ptr <= i1ptr; + m = i2ptr > i1ptr; n = i1ptr >= i2ptr; + if ((j != 0) || (k != 0) || (m != 1) || (n != 0)) + goto Fail; + + + printf ("Passed Conformance Test 7.6.4.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.6.4.1\n"); + } diff --git a/Tests/Conformance/C7.6.6.1.CC b/Tests/Conformance/C7.6.6.1.CC old mode 100755 new mode 100644 index 6552dcb..0097dba --- a/Tests/Conformance/C7.6.6.1.CC +++ b/Tests/Conformance/C7.6.6.1.CC @@ -1 +1,40 @@ -/* Conformance Test 7.6.6.1: Verification of bitwise AND operator */ #include main () { char ch = 0X57; int i = 0xabcd; short sh = 0x3214; long L = 0xfedcab65; unsigned char uch = 0x83; unsigned int ui = 0xcbcb; unsigned short ush = 0x1234; unsigned long uL = 0x98765432; /* Invert each integer and check expected result. */ ch = ch & 0x42; i = i & 0x1234; sh = sh & 0x4321; L = L & 0xa1b2c3d4; uch = uch & 0x77; ui = ui & 0x7373; ush = ush & 0xabcd; uL = uL & 0x12345678; if ((ch != 0x42) || (i != 0x204) || (sh != 0x200) || (L != 0xA0908344) || (uch != 3) || (ui != 0x4343) || (ush != 0x204) || (uL != 0x10345430)) goto Fail; printf ("Passed Conformance Test 7.6.6.1\n"); return; Fail: printf ("Failed Conformance Test 7.6.6.1\n"); } \ No newline at end of file +/* Conformance Test 7.6.6.1: Verification of bitwise AND operator */ + +#include + +main () + { + char ch = 0X57; + int i = 0xabcd; + short sh = 0x3214; + long L = 0xfedcab65; + + unsigned char uch = 0x83; + unsigned int ui = 0xcbcb; + unsigned short ush = 0x1234; + unsigned long uL = 0x98765432; + + + /* Invert each integer and check expected result. */ + + ch = ch & 0x42; + i = i & 0x1234; + sh = sh & 0x4321; + L = L & 0xa1b2c3d4; + uch = uch & 0x77; + ui = ui & 0x7373; + ush = ush & 0xabcd; + uL = uL & 0x12345678; + + if ((ch != 0x42) || (i != 0x204) || (sh != 0x200) || (L != 0xA0908344) || + (uch != 3) || (ui != 0x4343) || (ush != 0x204) || + (uL != 0x10345430)) + goto Fail; + + + printf ("Passed Conformance Test 7.6.6.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.6.6.1\n"); + } diff --git a/Tests/Conformance/C7.6.7.1.CC b/Tests/Conformance/C7.6.7.1.CC old mode 100755 new mode 100644 index af93a38..8dcbc70 --- a/Tests/Conformance/C7.6.7.1.CC +++ b/Tests/Conformance/C7.6.7.1.CC @@ -1 +1,40 @@ -/* Conformance Test 7.6.7.1: Verification of bitwise XOR operator */ #include main () { char ch = 0X57; int i = 0xabcd; short sh = 0x3214; long L = 0xfedcab65; unsigned char uch = 0x83; unsigned int ui = 0xcbcb; unsigned short ush = 0x1234; unsigned long uL = 0x98765432; /* Perform exclusive OR operation on each integer; check expected result. */ ch = ch ^ 0x42; i = i ^ 0x1234; sh = sh ^ 0x4321; L = L ^ 0xa1b2c3d4; uch = uch ^ 0x77; ui = ui ^ 0x7373; ush = ush ^ 0xabcd; uL = uL ^ 0x12345678; if ((ch != 0x15) || (i != 0xB9F9) || (sh != 0x7135) || (L != 0x5f6e68b1) || (uch != 0xf4) || (ui != 0xb8b8) || (ush != 0xB9F9) || (uL != 0x8a42024a)) goto Fail; printf ("Passed Conformance Test 7.6.7.1\n"); return; Fail: printf ("Failed Conformance Test 7.6.7.1\n"); } \ No newline at end of file +/* Conformance Test 7.6.7.1: Verification of bitwise XOR operator */ + +#include + +main () + { + char ch = 0X57; + int i = 0xabcd; + short sh = 0x3214; + long L = 0xfedcab65; + + unsigned char uch = 0x83; + unsigned int ui = 0xcbcb; + unsigned short ush = 0x1234; + unsigned long uL = 0x98765432; + + + /* Perform exclusive OR operation on each integer; check expected result. */ + + ch = ch ^ 0x42; + i = i ^ 0x1234; + sh = sh ^ 0x4321; + L = L ^ 0xa1b2c3d4; + uch = uch ^ 0x77; + ui = ui ^ 0x7373; + ush = ush ^ 0xabcd; + uL = uL ^ 0x12345678; + + if ((ch != 0x15) || (i != 0xB9F9) || (sh != 0x7135) || (L != 0x5f6e68b1) || + (uch != 0xf4) || (ui != 0xb8b8) || (ush != 0xB9F9) + || (uL != 0x8a42024a)) + goto Fail; + + + printf ("Passed Conformance Test 7.6.7.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.6.7.1\n"); + } diff --git a/Tests/Conformance/C7.6.8.1.CC b/Tests/Conformance/C7.6.8.1.CC old mode 100755 new mode 100644 index 3177677..bdbcb76 --- a/Tests/Conformance/C7.6.8.1.CC +++ b/Tests/Conformance/C7.6.8.1.CC @@ -1 +1,40 @@ -/* Conformance Test 7.6.8.1: Verification of bitwise OR operator */ #include main () { char ch = 0X57; int i = 0xabcd; short sh = 0x3214; long L = 0xfedcab65; unsigned char uch = 0x83; unsigned int ui = 0xcbcb; unsigned short ush = 0x1234; unsigned long uL = 0x98765432; /* Perform bitwise OR operation on each integer; check expected result. */ ch = ch | 0x42; i = i | 0x1234; sh = sh | 0x4321; L = L | 0xa1b2c3d4; uch = uch | 0x77; ui = ui | 0x7373; ush = ush | 0xabcd; uL = uL | 0x12345678; if ((ch != 0x57) || (i != 0xbbfd) || (sh != 0x7335) || (L != 0xfffeebf5) || (uch != 0xf7) || (ui != 0xFBFB) || (ush != 0xBBFD) || (uL != 0x9A76567A)) goto Fail; printf ("Passed Conformance Test 7.6.8.1\n"); return; Fail: printf ("Failed Conformance Test 7.6.8.1\n"); } \ No newline at end of file +/* Conformance Test 7.6.8.1: Verification of bitwise OR operator */ + +#include + +main () + { + char ch = 0X57; + int i = 0xabcd; + short sh = 0x3214; + long L = 0xfedcab65; + + unsigned char uch = 0x83; + unsigned int ui = 0xcbcb; + unsigned short ush = 0x1234; + unsigned long uL = 0x98765432; + + + /* Perform bitwise OR operation on each integer; check expected result. */ + + ch = ch | 0x42; + i = i | 0x1234; + sh = sh | 0x4321; + L = L | 0xa1b2c3d4; + uch = uch | 0x77; + ui = ui | 0x7373; + ush = ush | 0xabcd; + uL = uL | 0x12345678; + + if ((ch != 0x57) || (i != 0xbbfd) || (sh != 0x7335) || (L != 0xfffeebf5) || + (uch != 0xf7) || (ui != 0xFBFB) || (ush != 0xBBFD) + || (uL != 0x9A76567A)) + goto Fail; + + + printf ("Passed Conformance Test 7.6.8.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.6.8.1\n"); + } diff --git a/Tests/Conformance/C7.7.1.1.CC b/Tests/Conformance/C7.7.1.1.CC old mode 100755 new mode 100644 index 458c3ce..03e6f6b --- a/Tests/Conformance/C7.7.1.1.CC +++ b/Tests/Conformance/C7.7.1.1.CC @@ -1 +1,50 @@ -/* Conformance Test 7.7.1.1: Verification of logical AND operator */ #include #include main () { int i [3] = { 5, 6, 7 }, *i1ptr = i, *i2ptr = &i [2]; int j, k, m, n; long L = 32777; char ch = '!'; enum E { a, b, c }; unsigned int ui = 653; unsigned long ul = 895; unsigned char uch = 0x8; float f = 3.5; double d = 87.65; extended e = 92.33; /* Perform logical ANDs; test expected results. Left-to-right evaluation */ /* guaranteed. */ j = i [0] && i [2]; k = L && c; m = 0 && uch++; n = a && ch--; if ((j != 1) || (k != 1) || (m != 0) || (n != 0) || (uch != 8) || (ch != '!')) goto Fail; j = f && (!d); k = --e && ++L; m = d && f; n = 0 && f--; if ((j != 0) || (k != 1) || (m != 1) || (n != 0) || (fabs(e - 91.33) > 0.00001) || (L != 32778) || (fabs(f - 3.5) > 0.00001)) goto Fail; j = i1ptr && i2ptr; k = 0 && (--i2ptr); m = i2ptr && i1ptr++; n = i2ptr-- && 0; if ((j != 1) || (k != 0) || (m != 1) || (n != 0) || (*i1ptr != 6) || (*i2ptr != 6)) goto Fail; printf ("Passed Conformance Test 7.7.1.1\n"); return; Fail: printf ("Failed Conformance Test 7.7.1.1\n"); } \ No newline at end of file +/* Conformance Test 7.7.1.1: Verification of logical AND operator */ + +#include +#include + +main () + { + int i [3] = { 5, 6, 7 }, *i1ptr = i, *i2ptr = &i [2]; + int j, k, m, n; + long L = 32777; + char ch = '!'; + enum E { a, b, c }; + + unsigned int ui = 653; + unsigned long ul = 895; + unsigned char uch = 0x8; + + float f = 3.5; + double d = 87.65; + extended e = 92.33; + + + /* Perform logical ANDs; test expected results. Left-to-right evaluation */ + /* guaranteed. */ + + j = i [0] && i [2]; k = L && c; m = 0 && uch++; n = a && ch--; + if ((j != 1) || (k != 1) || (m != 0) || (n != 0) || (uch != 8) || + (ch != '!')) + goto Fail; + + + j = f && (!d); k = --e && ++L; m = d && f; n = 0 && f--; + if ((j != 0) || (k != 1) || (m != 1) || (n != 0) || + (fabs(e - 91.33) > 0.00001) || (L != 32778) || (fabs(f - 3.5) > 0.00001)) + goto Fail; + + + j = i1ptr && i2ptr; k = 0 && (--i2ptr); + m = i2ptr && i1ptr++; n = i2ptr-- && 0; + if ((j != 1) || (k != 0) || (m != 1) || (n != 0) || (*i1ptr != 6) || + (*i2ptr != 6)) + goto Fail; + + + printf ("Passed Conformance Test 7.7.1.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.7.1.1\n"); + } diff --git a/Tests/Conformance/C7.7.2.1.CC b/Tests/Conformance/C7.7.2.1.CC old mode 100755 new mode 100644 index a429640..afaaf9f --- a/Tests/Conformance/C7.7.2.1.CC +++ b/Tests/Conformance/C7.7.2.1.CC @@ -1 +1,50 @@ -/* Conformance Test 7.7.2.1: Verification of logical OR operator */ #include #include main () { int i [3] = { 5, 6, 7 }, *i1ptr = i, *i2ptr = &i [2]; int j, k, m, n; long L = 32777; char ch = '!'; enum E { a, b, c }; unsigned int ui = 653; unsigned long ul = 895; unsigned char uch = 0x8; float f = 3.5; double d = 87.65; extended e = 92.33; /* Perform logical ORs; test expected results. Left-to-right evaluation */ /* guaranteed. */ j = i [0] || i [2]; k = L || c; m = 0 || uch++; n = a || ch--; if ((j != 1) || (k != 1) || (m != 1) || (n != 1) || (uch != 9) || (ch != ' ')) goto Fail; j = (!f) || (!d); k = --e || ++L; m = d || f; n = 0 || a; if ((j != 0) || (k != 1) || (m != 1) || (n != 0) || (fabs(e - 91.33) > 0.00001) || (L != 32777)) goto Fail; j = i1ptr || f; k = 0 || (--i2ptr); m = d || i1ptr++; n = i2ptr-- || 0; if ((j != 1) || (k != 1) || (m != 1) || (n != 1) || (*i1ptr != 5) || (*i2ptr != 5)) goto Fail; printf ("Passed Conformance Test 7.7.2.1\n"); return; Fail: printf ("Failed Conformance Test 7.7.2.1\n"); } \ No newline at end of file +/* Conformance Test 7.7.2.1: Verification of logical OR operator */ + +#include +#include + +main () + { + int i [3] = { 5, 6, 7 }, *i1ptr = i, *i2ptr = &i [2]; + int j, k, m, n; + long L = 32777; + char ch = '!'; + enum E { a, b, c }; + + unsigned int ui = 653; + unsigned long ul = 895; + unsigned char uch = 0x8; + + float f = 3.5; + double d = 87.65; + extended e = 92.33; + + + /* Perform logical ORs; test expected results. Left-to-right evaluation */ + /* guaranteed. */ + + j = i [0] || i [2]; k = L || c; m = 0 || uch++; n = a || ch--; + if ((j != 1) || (k != 1) || (m != 1) || (n != 1) || (uch != 9) || + (ch != ' ')) + goto Fail; + + + j = (!f) || (!d); k = --e || ++L; m = d || f; n = 0 || a; + if ((j != 0) || (k != 1) || (m != 1) || (n != 0) || + (fabs(e - 91.33) > 0.00001) || (L != 32777)) + goto Fail; + + + j = i1ptr || f; k = 0 || (--i2ptr); + m = d || i1ptr++; n = i2ptr-- || 0; + if ((j != 1) || (k != 1) || (m != 1) || (n != 1) || (*i1ptr != 5) || + (*i2ptr != 5)) + goto Fail; + + + printf ("Passed Conformance Test 7.7.2.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.7.2.1\n"); + } diff --git a/Tests/Conformance/C7.8.0.1.CC b/Tests/Conformance/C7.8.0.1.CC old mode 100755 new mode 100644 index 9110afe..f65b99c --- a/Tests/Conformance/C7.8.0.1.CC +++ b/Tests/Conformance/C7.8.0.1.CC @@ -1 +1,48 @@ -/* Conformance Test 7.8.0.1: Verification of conditional expressions */ #include #include main () { int i [3] = { 5, 6, 7 }, *i1ptr = i, *i2ptr = &i [2], *i3ptr; long L = 32777; char ch = '!'; enum E { a, b, c }; struct S { int i; float f ;} s1 = { 1, 1.0 }, s2 = { 2, 2.2 }, s3; unsigned int ui = 653; unsigned long ul = 895; float f = 3.5; double d = 87.65; extended e = 92.33; /* Evaluate conditional expressions; check expected results. Ensure */ /* operation is right associative. */ e = f ? L * 2: ch ? d: ul ? s1.f + s2.i: ui; if (fabs(e - 65554.0) > 0.00001) goto Fail; i [1] = a ? *i1ptr * 2: (*i2ptr / 7); if ((i [0] != 5) || (i [1] != 1) || (i [2] != 7)) goto Fail; s3 = i1ptr ? s1 : s2; if ((s3.i != 1) || (s3.f != 1.0)) goto Fail; i3ptr = (L / 8) ? (i1ptr += 2): NULL; if ((*i3ptr != 7) || (i1ptr != &i [2])) goto Fail; printf ("Passed Conformance Test 7.8.0.1\n"); return; Fail: printf ("Failed Conformance Test 7.8.0.1\n"); } \ No newline at end of file +/* Conformance Test 7.8.0.1: Verification of conditional expressions */ + +#include +#include + +main () + { + int i [3] = { 5, 6, 7 }, *i1ptr = i, *i2ptr = &i [2], *i3ptr; + long L = 32777; + char ch = '!'; + + enum E { a, b, c }; + struct S { int i; float f ;} s1 = { 1, 1.0 }, s2 = { 2, 2.2 }, s3; + + unsigned int ui = 653; + unsigned long ul = 895; + + float f = 3.5; + double d = 87.65; + extended e = 92.33; + + + /* Evaluate conditional expressions; check expected results. Ensure */ + /* operation is right associative. */ + + e = f ? L * 2: ch ? d: ul ? s1.f + s2.i: ui; + if (fabs(e - 65554.0) > 0.00001) + goto Fail; + + i [1] = a ? *i1ptr * 2: (*i2ptr / 7); + if ((i [0] != 5) || (i [1] != 1) || (i [2] != 7)) + goto Fail; + + s3 = i1ptr ? s1 : s2; + if ((s3.i != 1) || (s3.f != 1.0)) + goto Fail; + + i3ptr = (L / 8) ? (i1ptr += 2): NULL; + if ((*i3ptr != 7) || (i1ptr != &i [2])) + goto Fail; + + + printf ("Passed Conformance Test 7.8.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.8.0.1\n"); + } diff --git a/Tests/Conformance/C7.9.2.1.CC b/Tests/Conformance/C7.9.2.1.CC old mode 100755 new mode 100644 index 58983bc..4cdd4ee --- a/Tests/Conformance/C7.9.2.1.CC +++ b/Tests/Conformance/C7.9.2.1.CC @@ -1 +1,44 @@ -/* Conformance Test 7.9.2.1: Verification of multiplication assign operator */ #include #include main () { int i = 5; long L = 32777; char ch = '!'; unsigned int ui = 653; unsigned long ul = 895; unsigned char uch = 0x8; comp c = 4294; float f = 3.5; double d = 87.65; extended e = 92.33; i *= -8; L *= 3; ch *= 2; c *= -9; f *= 1.1; d *= 5; e *= 8; ui *= 3; ul *= 7; uch *= 2; if ((i != -40) || (L != 98331) || (ch != 'B') || (ui != 1959) || (ul != 6265) || (uch != 16) || (c != -38646) || (fabs(f - 3.85) > 0.00001) || (fabs(d - 438.25) > 0.00001) || (fabs(e - 738.64) > 0.00001)) goto Fail; printf ("Passed Conformance Test 7.9.2.1\n"); return; Fail: printf ("Failed Conformance Test 7.9.2.1\n"); } \ No newline at end of file +/* Conformance Test 7.9.2.1: Verification of multiplication assign operator */ + +#include +#include + +main () + { + int i = 5; + long L = 32777; + char ch = '!'; + + unsigned int ui = 653; + unsigned long ul = 895; + unsigned char uch = 0x8; + + comp c = 4294; + float f = 3.5; + double d = 87.65; + extended e = 92.33; + + i *= -8; + L *= 3; + ch *= 2; + c *= -9; + f *= 1.1; + d *= 5; + e *= 8; + ui *= 3; + ul *= 7; + uch *= 2; + + if ((i != -40) || (L != 98331) || (ch != 'B') || (ui != 1959) || + (ul != 6265) || (uch != 16) || (c != -38646) || + (fabs(f - 3.85) > 0.00001) || (fabs(d - 438.25) > 0.00001) || + (fabs(e - 738.64) > 0.00001)) + goto Fail; + + + printf ("Passed Conformance Test 7.9.2.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.9.2.1\n"); + } diff --git a/Tests/Conformance/C7.9.2.2.CC b/Tests/Conformance/C7.9.2.2.CC old mode 100755 new mode 100644 index a5de7b5..eb023bc --- a/Tests/Conformance/C7.9.2.2.CC +++ b/Tests/Conformance/C7.9.2.2.CC @@ -1 +1,44 @@ -/* Conformance Test 7.9.2.2: Verification of division assign operator */ #include #include main () { int i = 5; long L = 32777; char ch = '!'; unsigned int ui = 653; unsigned long ul = 895; unsigned char uch = 0x8; comp c = 4294; float f = 3.5; double d = 87.65; extended e = 92.33; i /= -1; L /= L; ch /= 3; c /= -9; f /= f; d /= 5; e /= 1.0; ui /= 3; ul /= 5; uch /= 2; if ((i != -5) || (L != 1) || (ch != '\v') || (ui != 217) || (ul != 179) || (uch != 4) || (c != -477) || (fabs(f - 1.0) > 0.00001) || (fabs(d - 17.53) > 0.00001) || (fabs(e - 92.33) > 0.00001)) goto Fail; printf ("Passed Conformance Test 7.9.2.2\n"); return; Fail: printf ("Failed Conformance Test 7.9.2.2\n"); } \ No newline at end of file +/* Conformance Test 7.9.2.2: Verification of division assign operator */ + +#include +#include + +main () + { + int i = 5; + long L = 32777; + char ch = '!'; + + unsigned int ui = 653; + unsigned long ul = 895; + unsigned char uch = 0x8; + + comp c = 4294; + float f = 3.5; + double d = 87.65; + extended e = 92.33; + + i /= -1; + L /= L; + ch /= 3; + c /= -9; + f /= f; + d /= 5; + e /= 1.0; + ui /= 3; + ul /= 5; + uch /= 2; + + if ((i != -5) || (L != 1) || (ch != '\v') || (ui != 217) || + (ul != 179) || (uch != 4) || (c != -477) || + (fabs(f - 1.0) > 0.00001) || (fabs(d - 17.53) > 0.00001) || + (fabs(e - 92.33) > 0.00001)) + goto Fail; + + + printf ("Passed Conformance Test 7.9.2.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.9.2.2\n"); + } diff --git a/Tests/Conformance/C7.9.2.3.CC b/Tests/Conformance/C7.9.2.3.CC old mode 100755 new mode 100644 index b3274e4..970cfbe --- a/Tests/Conformance/C7.9.2.3.CC +++ b/Tests/Conformance/C7.9.2.3.CC @@ -1 +1,39 @@ -/* Conformance Test 7.9.2.3: Verification of remainder assign operator */ #include main () { char ch = 87; int i = 32767; short sh = 12345; long L = 98765; unsigned char uch = 130; unsigned int ui = 3579; unsigned short ush = 15234; unsigned long uL = 863112; /* Apply remainder operation to each integer and check expected result. */ ch %= 2; i %= 3; sh %= 4; L %= 5; uch %= 7; ui %= 8; ush %= 9; uL %= 10; if ((ch != 1) || (i != 1) || (sh != 1) || (L != 0) || (uch != 4) || (ui != 3) || (ush != 6) || (uL != 2)) goto Fail; printf ("Passed Conformance Test 7.9.2.3\n"); return; Fail: printf ("Failed Conformance Test 7.9.2.3\n"); } \ No newline at end of file +/* Conformance Test 7.9.2.3: Verification of remainder assign operator */ + +#include + +main () + { + char ch = 87; + int i = 32767; + short sh = 12345; + long L = 98765; + + unsigned char uch = 130; + unsigned int ui = 3579; + unsigned short ush = 15234; + unsigned long uL = 863112; + + + /* Apply remainder operation to each integer and check expected result. */ + + ch %= 2; + i %= 3; + sh %= 4; + L %= 5; + uch %= 7; + ui %= 8; + ush %= 9; + uL %= 10; + + if ((ch != 1) || (i != 1) || (sh != 1) || (L != 0) || + (uch != 4) || (ui != 3) || (ush != 6) || (uL != 2)) + goto Fail; + + + printf ("Passed Conformance Test 7.9.2.3\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.9.2.3\n"); + } diff --git a/Tests/Conformance/C7.9.2.4.CC b/Tests/Conformance/C7.9.2.4.CC old mode 100755 new mode 100644 index 190dd6f..b23ad48 --- a/Tests/Conformance/C7.9.2.4.CC +++ b/Tests/Conformance/C7.9.2.4.CC @@ -1 +1,63 @@ -/* Conformance Test 7.9.2.4: Verification of additive assign operators */ #include #include main () { int i = 5; long L = 32777; char ch = '!'; unsigned int ui = 653; unsigned long ul = 895; unsigned char uch = 0x8; comp c = 4294; float f = 3.5; double d = 87.65; extended e = 92.33; i += -8; L += 3; ch += 2; c += -9; f += 1.1; d += 5; e += 8; ui += 3; ul += 7; uch += 2; if ((i != -3) || (L != 32780) || (ch != '#') || (ui != 656) || (ul != 902) || (uch != 10) || (c != 4285) || (fabs(f - 4.6) > 0.00001) || (fabs(d - 92.65) > 0.00001) || (fabs(e - 100.33) > 0.00001)) goto Fail; i -= (-2000); L -= 33; ch -= -90; c -= 0; f -= 6.8; d -= 72.1; e -= 3.2; ui -= 8; ul -= 900; uch -= uch; if ((i != 1997) || (L != 32747) || (ch != 125) || (ui != 648) || (ul != 2) || (uch != 0) || (c != 4285) || (fabs(f - (-2.2)) > 0.00001) || (fabs(d - 20.55) > 0.00001) || (fabs(e - 97.13) > 0.00001)) goto Fail; printf ("Passed Conformance Test 7.9.2.4\n"); return; Fail: printf ("Failed Conformance Test 7.9.2.4\n"); } \ No newline at end of file +/* Conformance Test 7.9.2.4: Verification of additive assign operators */ + +#include +#include + +main () + { + int i = 5; + long L = 32777; + char ch = '!'; + + unsigned int ui = 653; + unsigned long ul = 895; + unsigned char uch = 0x8; + + comp c = 4294; + float f = 3.5; + double d = 87.65; + extended e = 92.33; + + + i += -8; + L += 3; + ch += 2; + c += -9; + f += 1.1; + d += 5; + e += 8; + ui += 3; + ul += 7; + uch += 2; + + if ((i != -3) || (L != 32780) || (ch != '#') || (ui != 656) || + (ul != 902) || (uch != 10) || (c != 4285) || + (fabs(f - 4.6) > 0.00001) || (fabs(d - 92.65) > 0.00001) || + (fabs(e - 100.33) > 0.00001)) + goto Fail; + + + i -= (-2000); + L -= 33; + ch -= -90; + c -= 0; + f -= 6.8; + d -= 72.1; + e -= 3.2; + ui -= 8; + ul -= 900; + uch -= uch; + + if ((i != 1997) || (L != 32747) || (ch != 125) || (ui != 648) || + (ul != 2) || (uch != 0) || (c != 4285) || + (fabs(f - (-2.2)) > 0.00001) || (fabs(d - 20.55) > 0.00001) || + (fabs(e - 97.13) > 0.00001)) + goto Fail; + + + printf ("Passed Conformance Test 7.9.2.4\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.9.2.4\n"); + } diff --git a/Tests/Conformance/C7.9.2.5.CC b/Tests/Conformance/C7.9.2.5.CC old mode 100755 new mode 100644 index 4c2a3d6..aed4047 --- a/Tests/Conformance/C7.9.2.5.CC +++ b/Tests/Conformance/C7.9.2.5.CC @@ -1 +1,57 @@ -/* Conformance Test 7.9.2.5: Verification of shift assign operators */ #include main () { signed char ch = 0X57; int i = 0xabcd; short sh = 0x3214; long L = 0xfedcab65; unsigned char uch = 0x83; unsigned int ui = 0xcbcb; unsigned short ush = 0x1234; unsigned long uL = 0x98765432; /* Shift each integer left and check expected result. */ ch <<= 1; i <<= 2; sh <<= 3; L <<= 4; uch <<= 6; ui <<= 7; ush <<= 8; uL <<= 9; if ((ch != -82) || (i != -20684) || (sh != -28512) || (L != 0xedCAb650) || (uch != 0xc0) || (ui != 0xe580) || (ush != 0x3400) || (uL != 0xeca86400)) goto Fail; /* Shift each integer right and check expected result. */ ch >>= 2; i >>= 3; sh >>= 4; L >>= 5; uch >>= 7; ui >>= 8; ush >>= 9; uL >>= 10; if ((ch != 0xFFEB) || (i != 0xF5e6) || (sh != 0xF90a) || (L != 0xff6e55b2) || (uch != 1) || (ui != 0xe5) || (ush != 0x1A) || (uL != 0x3B2A19)) goto Fail; printf ("Passed Conformance Test 7.9.2.5\n"); return; Fail: printf ("Failed Conformance Test 7.9.2.5\n"); } \ No newline at end of file +/* Conformance Test 7.9.2.5: Verification of shift assign operators */ + +#include + +main () + { + signed char ch = 0X57; + int i = 0xabcd; + short sh = 0x3214; + long L = 0xfedcab65; + + unsigned char uch = 0x83; + unsigned int ui = 0xcbcb; + unsigned short ush = 0x1234; + unsigned long uL = 0x98765432; + + + /* Shift each integer left and check expected result. */ + + ch <<= 1; + i <<= 2; + sh <<= 3; + L <<= 4; + uch <<= 6; + ui <<= 7; + ush <<= 8; + uL <<= 9; + + if ((ch != -82) || (i != -20684) || (sh != -28512) || (L != 0xedCAb650) || + (uch != 0xc0) || (ui != 0xe580) || (ush != 0x3400) + || (uL != 0xeca86400)) + goto Fail; + + + /* Shift each integer right and check expected result. */ + + ch >>= 2; + i >>= 3; + sh >>= 4; + L >>= 5; + uch >>= 7; + ui >>= 8; + ush >>= 9; + uL >>= 10; + + if ((ch != 0xFFEB) || (i != 0xF5e6) || (sh != 0xF90a) || (L != 0xff6e55b2) || + (uch != 1) || (ui != 0xe5) || (ush != 0x1A) + || (uL != 0x3B2A19)) + goto Fail; + + + printf ("Passed Conformance Test 7.9.2.5\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.9.2.5\n"); + } diff --git a/Tests/Conformance/C7.9.2.6.CC b/Tests/Conformance/C7.9.2.6.CC old mode 100755 new mode 100644 index 36de4c8..b6c0690 --- a/Tests/Conformance/C7.9.2.6.CC +++ b/Tests/Conformance/C7.9.2.6.CC @@ -1 +1,40 @@ -/* Conformance Test 7.9.2.6: Verification of bitwise AND assign operator */ #include main () { char ch = 0X57; int i = 0xabcd; short sh = 0x3214; long L = 0xfedcab65; unsigned char uch = 0x83; unsigned int ui = 0xcbcb; unsigned short ush = 0x1234; unsigned long uL = 0x98765432; /* Invert each integer and check expected result. */ ch &= 0x42; i &= 0x1234; sh &= 0x4321; L &= 0xa1b2c3d4; uch &= 0x77; ui &= 0x7373; ush &= 0xabcd; uL &= 0x12345678; if ((ch != 0x42) || (i != 0x204) || (sh != 0x200) || (L != 0xA0908344) || (uch != 3) || (ui != 0x4343) || (ush != 0x204) || (uL != 0x10345430)) goto Fail; printf ("Passed Conformance Test 7.9.2.6\n"); return; Fail: printf ("Failed Conformance Test 7.9.2.6\n"); } \ No newline at end of file +/* Conformance Test 7.9.2.6: Verification of bitwise AND assign operator */ + +#include + +main () + { + char ch = 0X57; + int i = 0xabcd; + short sh = 0x3214; + long L = 0xfedcab65; + + unsigned char uch = 0x83; + unsigned int ui = 0xcbcb; + unsigned short ush = 0x1234; + unsigned long uL = 0x98765432; + + + /* Invert each integer and check expected result. */ + + ch &= 0x42; + i &= 0x1234; + sh &= 0x4321; + L &= 0xa1b2c3d4; + uch &= 0x77; + ui &= 0x7373; + ush &= 0xabcd; + uL &= 0x12345678; + + if ((ch != 0x42) || (i != 0x204) || (sh != 0x200) || (L != 0xA0908344) || + (uch != 3) || (ui != 0x4343) || (ush != 0x204) || + (uL != 0x10345430)) + goto Fail; + + + printf ("Passed Conformance Test 7.9.2.6\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.9.2.6\n"); + } diff --git a/Tests/Conformance/C7.9.2.7.CC b/Tests/Conformance/C7.9.2.7.CC old mode 100755 new mode 100644 index 50708b2..c7740e3 --- a/Tests/Conformance/C7.9.2.7.CC +++ b/Tests/Conformance/C7.9.2.7.CC @@ -1 +1,40 @@ -/* Conformance Test 7.9.2.7: Verification of bitwise XOR assign operator */ #include main () { char ch = 0X57; int i = 0xabcd; short sh = 0x3214; long L = 0xfedcab65; unsigned char uch = 0x83; unsigned int ui = 0xcbcb; unsigned short ush = 0x1234; unsigned long uL = 0x98765432; /* Perform exclusive OR operation on each integer; check expected result. */ ch ^= 0x42; i ^= 0x1234; sh ^= 0x4321; L ^= 0xa1b2c3d4; uch ^= 0x77; ui ^= 0x7373; ush ^= 0xabcd; uL ^= 0x12345678; if ((ch != 0x15) || (i != 0xB9F9) || (sh != 0x7135) || (L != 0x5f6e68B1) || (uch != 0xf4) || (ui != 0xb8b8) || (ush != 0xB9F9) || (uL != 0x8a42024a)) goto Fail; printf ("Passed Conformance Test 7.9.2.7\n"); return; Fail: printf ("Failed Conformance Test 7.9.2.7\n"); } \ No newline at end of file +/* Conformance Test 7.9.2.7: Verification of bitwise XOR assign operator */ + +#include + +main () + { + char ch = 0X57; + int i = 0xabcd; + short sh = 0x3214; + long L = 0xfedcab65; + + unsigned char uch = 0x83; + unsigned int ui = 0xcbcb; + unsigned short ush = 0x1234; + unsigned long uL = 0x98765432; + + + /* Perform exclusive OR operation on each integer; check expected result. */ + + ch ^= 0x42; + i ^= 0x1234; + sh ^= 0x4321; + L ^= 0xa1b2c3d4; + uch ^= 0x77; + ui ^= 0x7373; + ush ^= 0xabcd; + uL ^= 0x12345678; + + if ((ch != 0x15) || (i != 0xB9F9) || (sh != 0x7135) || (L != 0x5f6e68B1) || + (uch != 0xf4) || (ui != 0xb8b8) || (ush != 0xB9F9) + || (uL != 0x8a42024a)) + goto Fail; + + + printf ("Passed Conformance Test 7.9.2.7\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.9.2.7\n"); + } diff --git a/Tests/Conformance/C7.9.2.8.CC b/Tests/Conformance/C7.9.2.8.CC old mode 100755 new mode 100644 index 581d095..6677228 --- a/Tests/Conformance/C7.9.2.8.CC +++ b/Tests/Conformance/C7.9.2.8.CC @@ -1 +1,40 @@ -/* Conformance Test 7.9.2.8: Verification of bitwise OR assign operator */ #include main () { char ch = 0X57; int i = 0xabcd; short sh = 0x3214; long L = 0xfedcab65; unsigned char uch = 0x83; unsigned int ui = 0xcbcb; unsigned short ush = 0x1234; unsigned long uL = 0x98765432; /* Perform bitwise OR operation on each integer; check expected result. */ ch |= 0x42; i |= 0x1234; sh |= 0x4321; L |= 0xa1b2c3d4; uch |= 0x77; ui |= 0x7373; ush |= 0xabcd; uL |= 0x12345678; if ((ch != 0x57) || (i != 0xbbfd) || (sh != 0x7335) || (L != 0xfffeebf5) || (uch != 0xf7) || (ui != 0xFBFB) || (ush != 0xBBFD) || (uL != 0x9A76567A)) goto Fail; printf ("Passed Conformance Test 7.9.2.8\n"); return; Fail: printf ("Failed Conformance Test 7.9.2.8\n"); } \ No newline at end of file +/* Conformance Test 7.9.2.8: Verification of bitwise OR assign operator */ + +#include + +main () + { + char ch = 0X57; + int i = 0xabcd; + short sh = 0x3214; + long L = 0xfedcab65; + + unsigned char uch = 0x83; + unsigned int ui = 0xcbcb; + unsigned short ush = 0x1234; + unsigned long uL = 0x98765432; + + + /* Perform bitwise OR operation on each integer; check expected result. */ + + ch |= 0x42; + i |= 0x1234; + sh |= 0x4321; + L |= 0xa1b2c3d4; + uch |= 0x77; + ui |= 0x7373; + ush |= 0xabcd; + uL |= 0x12345678; + + if ((ch != 0x57) || (i != 0xbbfd) || (sh != 0x7335) || (L != 0xfffeebf5) || + (uch != 0xf7) || (ui != 0xFBFB) || (ush != 0xBBFD) + || (uL != 0x9A76567A)) + goto Fail; + + + printf ("Passed Conformance Test 7.9.2.8\n"); + return; + +Fail: + printf ("Failed Conformance Test 7.9.2.8\n"); + } diff --git a/Tests/Conformance/C7.9.2.9.CC b/Tests/Conformance/C7.9.2.9.CC old mode 100755 new mode 100644 index ef97aea..4c59eaf --- a/Tests/Conformance/C7.9.2.9.CC +++ b/Tests/Conformance/C7.9.2.9.CC @@ -1 +1,21 @@ -/* Conformance Test 7.9.2.9: Make sure types can be mixed across the */ /* compound assignment operators. */ #include #include main () { int i,j; char str[] = "How, now, brown cow."; i = strlen(str); j = 0; j += strlen(str); if (i == j) printf ("Passed Conformance Test 7.9.2.9\n"); else printf ("Failed Conformance Test 7.9.2.9\n"); } \ No newline at end of file +/* Conformance Test 7.9.2.9: Make sure types can be mixed across the */ +/* compound assignment operators. */ + +#include +#include + +main () + +{ +int i,j; +char str[] = "How, now, brown cow."; + +i = strlen(str); +j = 0; +j += strlen(str); + +if (i == j) + printf ("Passed Conformance Test 7.9.2.9\n"); +else + printf ("Failed Conformance Test 7.9.2.9\n"); +} diff --git a/Tests/Conformance/C8.7.0.1.CC b/Tests/Conformance/C8.7.0.1.CC old mode 100755 new mode 100644 index 10f1819..70be07c --- a/Tests/Conformance/C8.7.0.1.CC +++ b/Tests/Conformance/C8.7.0.1.CC @@ -1 +1,152 @@ -/* Conformance Test 8.7.0.1: Verification of switch statement */ #include /****************************************************************************/ int F1 (int i) { switch (i) { case 1: return 9; case 2: return 99; case 3: return 999; default: return 9999; } } /****************************************************************************/ main () { char ch = 'd'; int i = 3; short s = 5; long L = 0; unsigned int ui = 0x7F; enum Colors { red, black, gold, green } color = gold; switch (i * s) /* test "fall through" of case labels */ { case 15: ++L; case 1: ++L; case 2: ++L; default: ++L; } if (L != 4) goto Fail; switch (ch >> i) /* test break out with goto statement */ { case 1: L = 1; case 2: L = 2; case 12: L = 12; goto Out; default: L = 0; } Out: if (L != 12) goto Fail; switch (s) /* test break out with break statement */ { case 1: L = 1; case 2: L = 2; case 3: L = 3; case 4: L = 4; case 5: L = 5; break; default: L = 0; } if (L != 5) goto Fail; switch (F1 (i)) /* test break out with return statement */ { case 999: L = 999; break; default: L = 0; } if (L != 999) goto Fail; switch (2) /* test no case labels equal switch */ { /* expr and no default given */ case 0: L = 0; case 1: L = 1; } if (L != 999) goto Fail; switch (ui) /* multiple case labels + default on */ { /* same statement */ case 0x7c: L = 0x7c; break; case 0x7e: case 0x7F: case 0x80: default: L = 0x80; break; case 0x7D: L = 0x7d; break; } if (L != 128) goto Fail; { enum Colors { red, black, gold, green } color = gold; switch (color) /* test nested switch statements */ { case red: switch (ui && i) { case 1: L = 1; break; case 0: L = 0; break; } break; case black: switch (--i) { case 2: L = 2; break; } break; case gold: switch (color) { case gold: L = (long) (color); } break; } if (L != 2) goto Fail; } printf ("Passed Conformance Test 8.7.0.1\n"); return; Fail: printf ("Failed Conformance Test 8.7.0.1\n"); } \ No newline at end of file +/* Conformance Test 8.7.0.1: Verification of switch statement */ + +#include + + +/****************************************************************************/ + +int F1 (int i) + { + switch (i) + { + case 1: return 9; + case 2: return 99; + case 3: return 999; + default: return 9999; + } + } + + +/****************************************************************************/ + +main () + { + char ch = 'd'; + int i = 3; + short s = 5; + long L = 0; + unsigned int ui = 0x7F; + enum Colors { red, black, gold, green } color = gold; + + + switch (i * s) /* test "fall through" of case labels */ + { + case 15: ++L; + + case 1: ++L; + + case 2: ++L; + + default: ++L; + } + if (L != 4) + goto Fail; + + + switch (ch >> i) /* test break out with goto statement */ + { + case 1: L = 1; + + case 2: L = 2; + + case 12: L = 12; + goto Out; + + default: L = 0; + } +Out: + if (L != 12) + goto Fail; + + + switch (s) /* test break out with break statement */ + { + case 1: L = 1; + + case 2: L = 2; + + case 3: L = 3; + + case 4: L = 4; + + case 5: L = 5; + break; + + default: L = 0; + } + if (L != 5) + goto Fail; + + + switch (F1 (i)) /* test break out with return statement */ + { + case 999: L = 999; + break; + default: L = 0; + } + if (L != 999) + goto Fail; + + + switch (2) /* test no case labels equal switch */ + { /* expr and no default given */ + case 0: L = 0; + case 1: L = 1; + } + if (L != 999) + goto Fail; + + + switch (ui) /* multiple case labels + default on */ + { /* same statement */ + case 0x7c: L = 0x7c; + break; + + case 0x7e: case 0x7F: case 0x80: default: + L = 0x80; + break; + + case 0x7D: L = 0x7d; + break; + } + if (L != 128) + goto Fail; + +{ + enum Colors { red, black, gold, green } color = gold; + switch (color) /* test nested switch statements */ + { + case red: switch (ui && i) + { + case 1: L = 1; + break; + + case 0: L = 0; + break; + } + break; + + case black: switch (--i) + { + case 2: L = 2; + break; + } + break; + + case gold: switch (color) + { + case gold: L = (long) (color); + } + break; + } + if (L != 2) + goto Fail; + +} + + printf ("Passed Conformance Test 8.7.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 8.7.0.1\n"); + } diff --git a/Tests/Conformance/C8.7.0.2.CC b/Tests/Conformance/C8.7.0.2.CC old mode 100755 new mode 100644 index d94262b..89e4a18 --- a/Tests/Conformance/C8.7.0.2.CC +++ b/Tests/Conformance/C8.7.0.2.CC @@ -1 +1,23 @@ -/* Conformance Test 8.7.0.2: Test compact integer switch statement */ #include void main(void) { int i, sum1 = 0, sum2 = 0; for (i = 1; i < 11; i++) switch (i) { case 1: case 3: case 5: case 7: case 9: sum1 += i; break; case 2: case 4: case 6: case 8: sum2 += i; } if ((sum1 == 25) && (sum2 == 20)) printf ("Passed Conformance Test 8.7.0.2\n"); else printf ("Failed Conformance Test 8.7.0.2\n"); } \ No newline at end of file +/* Conformance Test 8.7.0.2: Test compact integer switch statement */ + +#include + +void main(void) + +{ +int i, sum1 = 0, sum2 = 0; + +for (i = 1; i < 11; i++) + switch (i) { + case 1: case 3: case 5: case 7: case 9: + sum1 += i; + break; + case 2: case 4: case 6: case 8: + sum2 += i; + } + +if ((sum1 == 25) && (sum2 == 20)) + printf ("Passed Conformance Test 8.7.0.2\n"); +else + printf ("Failed Conformance Test 8.7.0.2\n"); +} diff --git a/Tests/Conformance/C8.7.0.3.CC b/Tests/Conformance/C8.7.0.3.CC old mode 100755 new mode 100644 index 7f6f350..c34ec38 --- a/Tests/Conformance/C8.7.0.3.CC +++ b/Tests/Conformance/C8.7.0.3.CC @@ -1 +1,24 @@ -/* Conformance Test 8.7.0.3: Make sure negative numbers are accepted */ /* in switch */ #include void main(void) { int i, sum1 = 0, sum2 = 0; for (i = -11; i < 0; i++) switch (i) { case -1: case -3: case -5: case -7: case -9: sum1 += i; break; case -2: case -4: case -6: case -8: sum2 += i; } if ((sum1 == -25) && (sum2 == -20)) printf ("Passed Conformance Test 8.7.0.3\n"); else printf ("Failed Conformance Test 8.7.0.3\n"); } \ No newline at end of file +/* Conformance Test 8.7.0.3: Make sure negative numbers are accepted */ +/* in switch */ + +#include + +void main(void) + +{ +int i, sum1 = 0, sum2 = 0; + +for (i = -11; i < 0; i++) + switch (i) { + case -1: case -3: case -5: case -7: case -9: + sum1 += i; + break; + case -2: case -4: case -6: case -8: + sum2 += i; + } + +if ((sum1 == -25) && (sum2 == -20)) + printf ("Passed Conformance Test 8.7.0.3\n"); +else + printf ("Failed Conformance Test 8.7.0.3\n"); +} diff --git a/Tests/Conformance/C8.7.0.4.CC b/Tests/Conformance/C8.7.0.4.CC old mode 100755 new mode 100644 index 5698aba..267ae95 --- a/Tests/Conformance/C8.7.0.4.CC +++ b/Tests/Conformance/C8.7.0.4.CC @@ -1 +1,21 @@ -/* Conformance Test 8.7.0.4: Make sure enums are accepted in switch */ #include void main(void) { enum color {red, orange, yellow, green, blue, violet} c; int primary = 0; for (c = red; c <= violet; c++) switch (c) { case red: case yellow: case blue: primary++; } if (primary == 3) printf ("Passed Conformance Test 8.7.0.4\n"); else printf ("Failed Conformance Test 8.7.0.4\n"); } \ No newline at end of file +/* Conformance Test 8.7.0.4: Make sure enums are accepted in switch */ + +#include + +void main(void) + +{ +enum color {red, orange, yellow, green, blue, violet} c; +int primary = 0; + +for (c = red; c <= violet; c++) + switch (c) { + case red: case yellow: case blue: + primary++; + } + +if (primary == 3) + printf ("Passed Conformance Test 8.7.0.4\n"); +else + printf ("Failed Conformance Test 8.7.0.4\n"); +} diff --git a/Tests/Conformance/C8.7.0.5.CC b/Tests/Conformance/C8.7.0.5.CC old mode 100755 new mode 100644 index e10ee08..6334cdf --- a/Tests/Conformance/C8.7.0.5.CC +++ b/Tests/Conformance/C8.7.0.5.CC @@ -1 +1,28 @@ -/* Conformance Test 8.7.0.5: Test sparse switch statements */ #include void main(void) { int i, hundreds = 0; for (i = 0; i < 1000; i += 10) switch (i) { case 100: case 200: case 300: case 400: case 500: case 600: case 700: case 800: case 900: hundreds++; } if (hundreds == 9) printf ("Passed Conformance Test 8.7.0.5\n"); else printf ("Failed Conformance Test 8.7.0.5\n"); } \ No newline at end of file +/* Conformance Test 8.7.0.5: Test sparse switch statements */ + +#include + +void main(void) + +{ +int i, hundreds = 0; + +for (i = 0; i < 1000; i += 10) + switch (i) { + case 100: + case 200: + case 300: + case 400: + case 500: + case 600: + case 700: + case 800: + case 900: + hundreds++; + } + +if (hundreds == 9) + printf ("Passed Conformance Test 8.7.0.5\n"); +else + printf ("Failed Conformance Test 8.7.0.5\n"); +} diff --git a/Tests/Conformance/C8.7.0.6.CC b/Tests/Conformance/C8.7.0.6.CC old mode 100755 new mode 100644 index e37cdc8..fe228da --- a/Tests/Conformance/C8.7.0.6.CC +++ b/Tests/Conformance/C8.7.0.6.CC @@ -1 +1,30 @@ -/* Conformance Test 8.7.0.6: Test swicth statements with long */ /* expressions */ #include void main(void) { long l; int hundreds = 0; for (l = 0; l < 1000000; l += 10000) switch (l) { case 100000: case 200000: case 300000: case 400000: case 500000: case 600000: case 700000: case 800000: case 900000: hundreds++; } if (hundreds == 9) printf ("Passed Conformance Test 8.7.0.6\n"); else printf ("Failed Conformance Test 8.7.0.6\n"); } \ No newline at end of file +/* Conformance Test 8.7.0.6: Test swicth statements with long */ +/* expressions */ + +#include + +void main(void) + +{ +long l; +int hundreds = 0; + +for (l = 0; l < 1000000; l += 10000) + switch (l) { + case 100000: + case 200000: + case 300000: + case 400000: + case 500000: + case 600000: + case 700000: + case 800000: + case 900000: + hundreds++; + } + +if (hundreds == 9) + printf ("Passed Conformance Test 8.7.0.6\n"); +else + printf ("Failed Conformance Test 8.7.0.6\n"); +} diff --git a/Tests/Conformance/C8.8.0.1.CC b/Tests/Conformance/C8.8.0.1.CC old mode 100755 new mode 100644 index 9a665b2..c93195e --- a/Tests/Conformance/C8.8.0.1.CC +++ b/Tests/Conformance/C8.8.0.1.CC @@ -1 +1,100 @@ -/* Conformance Test 8.8.0.1: Verification of break, continue statements */ #include #define youStillCan 1 main () { int F1 (int i, int j); int i = 65, j = 7, k; while (i > 0) /* test break, continue in while loop */ { j++; if (j == 15) break; if (((i - j) == 57) || ((i - j) == 55) || ((i - j) == 52)) continue; i--; } if ((i != 60) || (j != 15)) goto Fail; do /* test break, continue in do loop */ { i -= 2; if (((i / 2) == 29) || ((i / 2) == 27) || ((i / 2) == 25)) continue; j -= 3; if (j < 2) break; } while (youStillCan); if ((i != 44) || (j != 0)) goto Fail; for (k = 100; k > 0; k -= 5) /* test break, continue in for loop */ { if (k > 80) continue; if (k == 60) break; k -= 5; j += 2; } if ((j != 4) || (k != 60)) goto Fail; while ( (i = F1 (k, j)) > 57) /* test nested while, do, for, switch */ { do { for (; i > 60; i -= 4) { i /= 4; switch (i) { case 17: k -= 1; break; case 16: j -= 2; break; default: k -= 5; break; } if (k > 40) continue; } /* end for */ j -= 2; if (j == 0) break; } while (1); if (k == 45) continue; k -= 3; } if ((k != 57) || (j != 0) || (i != 57)) goto Fail; printf ("Passed Conformance Test 8.8.0.1\n"); return; Fail: printf ("Failed Conformance Test 8.8.0.1\n"); } /****************************************************************************/ int F1 (int i, int j) { return i + j; } \ No newline at end of file +/* Conformance Test 8.8.0.1: Verification of break, continue statements */ + +#include +#define youStillCan 1 + +main () + { + int F1 (int i, int j); + int i = 65, j = 7, k; + + while (i > 0) /* test break, continue in while loop */ + { + j++; + if (j == 15) + break; + if (((i - j) == 57) || ((i - j) == 55) || ((i - j) == 52)) + continue; + i--; + } + if ((i != 60) || (j != 15)) + goto Fail; + + + do /* test break, continue in do loop */ + { + i -= 2; + if (((i / 2) == 29) || ((i / 2) == 27) || ((i / 2) == 25)) + continue; + j -= 3; + if (j < 2) + break; + } + while (youStillCan); + if ((i != 44) || (j != 0)) + goto Fail; + + + for (k = 100; k > 0; k -= 5) /* test break, continue in for loop */ + { + if (k > 80) + continue; + if (k == 60) + break; + k -= 5; + j += 2; + } + if ((j != 4) || (k != 60)) + goto Fail; + + + while ( (i = F1 (k, j)) > 57) /* test nested while, do, for, switch */ + { + do + { + for (; i > 60; i -= 4) + { + i /= 4; + switch (i) + { + case 17: k -= 1; + break; + + case 16: j -= 2; + break; + + default: k -= 5; + break; + } + if (k > 40) + continue; + + } /* end for */ + + j -= 2; + if (j == 0) + break; + } while (1); + + if (k == 45) + continue; + k -= 3; + } + if ((k != 57) || (j != 0) || (i != 57)) + goto Fail; + + + printf ("Passed Conformance Test 8.8.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 8.8.0.1\n"); + } + + +/****************************************************************************/ + +int F1 (int i, int j) + { + return i + j; + } diff --git a/Tests/Conformance/C9.2.0.1.CC b/Tests/Conformance/C9.2.0.1.CC old mode 100755 new mode 100644 index 3e3ec3b..d901e5a --- a/Tests/Conformance/C9.2.0.1.CC +++ b/Tests/Conformance/C9.2.0.1.CC @@ -1 +1,27 @@ -/* Conformance Test 9.2.0.1: Make sure pascal functions can be called. */ #include pascal int pasFunc (int i, int j) { return i+j; } void main(void) { if (pasFunc(2,5) != 7) goto Fail; if (pasFunc(3,0) != 3) goto Fail; if (pasFunc(8,1) != 9) goto Fail; if (pasFunc(1,1) != 2) goto Fail; printf ("Passed Conformance Test 9.2.0.1\n"); return; Fail: printf ("Failed Conformance Test 9.2.0.1\n"); } \ No newline at end of file +/* Conformance Test 9.2.0.1: Make sure pascal functions can be called. */ + +#include + + +pascal int pasFunc (int i, int j) + +{ +return i+j; +} + + +void main(void) + +{ + +if (pasFunc(2,5) != 7) goto Fail; +if (pasFunc(3,0) != 3) goto Fail; +if (pasFunc(8,1) != 9) goto Fail; +if (pasFunc(1,1) != 2) goto Fail; + + printf ("Passed Conformance Test 9.2.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 9.2.0.1\n"); + } diff --git a/Tests/Conformance/C9.3.0.1.CC b/Tests/Conformance/C9.3.0.1.CC old mode 100755 new mode 100644 index 59982d2..b0a2a6a --- a/Tests/Conformance/C9.3.0.1.CC +++ b/Tests/Conformance/C9.3.0.1.CC @@ -1 +1,32 @@ -/* Conformance Test 9.3.0.1: Parameters, functions must be defined in time */ /* to call the function recursively. */ #include int iexp (int x, int y) { if (x == 0) return 1; if (y <= 1) return x; return iexp(x,y-1)*x; } void main(void) { if (iexp(2,5) != 32) goto Fail; if (iexp(3,3) != 27) goto Fail; if (iexp(1,50) != 1) goto Fail; if (iexp(7,3) != 343) goto Fail; printf ("Passed Conformance Test 9.3.0.1\n"); return; Fail: printf ("Failed Conformance Test 9.3.0.1\n"); } \ No newline at end of file +/* Conformance Test 9.3.0.1: Parameters, functions must be defined in time */ +/* to call the function recursively. */ + +#include + + +int iexp (int x, int y) + +{ +if (x == 0) + return 1; +if (y <= 1) + return x; +return iexp(x,y-1)*x; +} + + +void main(void) + +{ + +if (iexp(2,5) != 32) goto Fail; +if (iexp(3,3) != 27) goto Fail; +if (iexp(1,50) != 1) goto Fail; +if (iexp(7,3) != 343) goto Fail; + + printf ("Passed Conformance Test 9.3.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 9.3.0.1\n"); + } diff --git a/Tests/Conformance/C9.5.0.1.CC b/Tests/Conformance/C9.5.0.1.CC old mode 100755 new mode 100644 index 7a7fde2..9974b6a --- a/Tests/Conformance/C9.5.0.1.CC +++ b/Tests/Conformance/C9.5.0.1.CC @@ -1 +1,59 @@ -/* Conformance Test 9.5.0.1: Verification of parameter passing conventions */ #include #include struct S { int i; float f; comp c [5]; }; union U { int i; long L; }; /****************************************************************************/ void Func1 (int i, char ch [], float f, struct S s, union U u) { int j; for (j = 0; j < i; j++) /* alter array's contents */ ch [j] = (char) (j + 0x41); s.i = 22; /* this should not change struct's contents */ s.f = 8.0; s.c [0] = s.c [1] = s.c [2] = s.c [3] = s.c [4] = 32767; u.L = 2147483647l; /* this should not change unions's contents */ f = 9.9; /* this should not change float's contents */ } /****************************************************************************/ main () { char string [4] = "hey"; struct S s = { 1, 2.0, 1, 2, 3, 4, 5 }; union U u = { 9 }; float f = 0.5; Func1 (3, string, f, s, u); /* call function to change only array */ if (strcmp (string, "ABC")) goto Fail; if ((s.i != 1) || (fabs(s.f - 2.0) > 0.00001) || (s.c [0] != 1) || (s.c [1] != 2) || (s.c [2] != 3) || (s.c [3] != 4) || (s.c [4] != 5)) goto Fail; if ((u.i != 9) || (fabs(f - 0.5) > 0.00001)) goto Fail; printf ("Passed Conformance Test 9.5.0.1\n"); return; Fail: printf ("Failed Conformance Test 9.5.0.1\n"); } \ No newline at end of file +/* Conformance Test 9.5.0.1: Verification of parameter passing conventions */ + +#include +#include + +struct S { int i; + float f; + comp c [5]; }; + +union U { int i; + long L; }; + + +/****************************************************************************/ + +void Func1 (int i, char ch [], float f, struct S s, union U u) + { + int j; + + for (j = 0; j < i; j++) /* alter array's contents */ + ch [j] = (char) (j + 0x41); + + s.i = 22; /* this should not change struct's contents */ + s.f = 8.0; + s.c [0] = s.c [1] = s.c [2] = s.c [3] = s.c [4] = 32767; + + u.L = 2147483647l; /* this should not change unions's contents */ + + f = 9.9; /* this should not change float's contents */ + } + + +/****************************************************************************/ + +main () + { + char string [4] = "hey"; + struct S s = { 1, 2.0, 1, 2, 3, 4, 5 }; + union U u = { 9 }; + float f = 0.5; + + Func1 (3, string, f, s, u); /* call function to change only array */ + if (strcmp (string, "ABC")) + goto Fail; + + if ((s.i != 1) || (fabs(s.f - 2.0) > 0.00001) || (s.c [0] != 1) || + (s.c [1] != 2) || (s.c [2] != 3) || (s.c [3] != 4) || (s.c [4] != 5)) + goto Fail; + + if ((u.i != 9) || (fabs(f - 0.5) > 0.00001)) + goto Fail; + + + printf ("Passed Conformance Test 9.5.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 9.5.0.1\n"); + } diff --git a/Tests/Conformance/C9.5.0.2.CC b/Tests/Conformance/C9.5.0.2.CC old mode 100755 new mode 100644 index b559a71..1a6b6cd --- a/Tests/Conformance/C9.5.0.2.CC +++ b/Tests/Conformance/C9.5.0.2.CC @@ -1 +1,29 @@ -/* Conformance Test 9.5.0.2: Make sure assignments can be used as parms */ #include int func (int x) { return x*2; } void main(void) { int i,j; i = j = 0; i = func(j = 3); if (i != 6) goto Fail; if (j != 3) goto Fail; printf ("Passed Conformance Test 9.5.0.2\n"); return; Fail: printf ("Failed Conformance Test 9.5.0.2\n"); } \ No newline at end of file +/* Conformance Test 9.5.0.2: Make sure assignments can be used as parms */ + +#include + +int func (int x) + +{ +return x*2; +} + + +void main(void) + +{ + int i,j; + + i = j = 0; + + i = func(j = 3); + + if (i != 6) goto Fail; + if (j != 3) goto Fail; + + printf ("Passed Conformance Test 9.5.0.2\n"); + return; + +Fail: + printf ("Failed Conformance Test 9.5.0.2\n"); + } diff --git a/Tests/Conformance/C9.7.0.1.CC b/Tests/Conformance/C9.7.0.1.CC old mode 100755 new mode 100644 index bb1e68f..4a4922d --- a/Tests/Conformance/C9.7.0.1.CC +++ b/Tests/Conformance/C9.7.0.1.CC @@ -1 +1,217 @@ -/* Conformance Test 9.7.0.1: Verification of function return types: enum, */ /* pointer to array, pointer to function, struct, */ /* and union */ #include #include #include struct S { float f; extended e; }; union U { double d; extended e; }; enum E { a, b, c }; /**************************************************************************/ void V1 (void) { } /**************************************************************************/ main () { /* Func1 returns an enumeration E constant. */ static enum E Func1 (char ch, int i, double d, struct S s); /* Func2 returns a pointer to an array of integers. */ static int ( *Func2 (long L, extended e, enum E e0) ) []; /* Func3 returns a pointer to a function returning void. */ static void ( *Func3 (union U u, unsigned long ul1) ) (); /* Func4 returns a struct S. */ static struct S Func4 (extended e, unsigned short s, float f); /* Func5 returns a union U. */ static union U Func5 (struct S s, double d, char ch, comp c); extended e = 8.88e-2; double d = 47.81; float f = 32.32; comp c = 222222; long L = 33769; char ch = 'k'; int i = 897; enum E e0 = b; int (*j)[], (*m)[], k; unsigned short sh = 0177; unsigned long ul1 = 0x11001100; struct S s = { 5.5, 6.6 }; union U u = 4.5; void (*funcPtr) (void); e0 = Func1 (ch, i, d, s); /* call functions & test return values */ if (e0 != a) goto Fail; m = j = Func2 (L, e, e0); if (j == NULL) goto Fail; for (k = 0; k < 5; k++) if ((*j)[k] != k) goto Fail; free (m); funcPtr = Func3 (u, ul1); if (funcPtr != V1) goto Fail; s = Func4 (e, sh, f); if ((fabs(s.f - 2340.0) > 0.01) || (fabs(s.e - (-159.4088)) > 0.001)) goto Fail; u = Func5 (s, d, ch, c); if (fabs(u.e - 123.456e+300) > 1e295) goto Fail; printf ("Passed Conformance Test 9.7.0.1\n"); return; Fail: printf ("Failed Conformance Test 9.7.0.1\n"); } /**************************************************************************/ static enum E Func1 (char ch, int i, double d, struct S s) { d = s.f - 0.5; if (d != 5.0) goto Fail; i += ch; if (i != 1004) goto Fail; return a; Fail: printf ("Failure in Conformance Test 9.7.0.1, Func1\n"); exit (-1); } /**************************************************************************/ static int ( *Func2 (long L, extended e, enum E e0) ) [] { int (*i)[], *j, k; e += ((extended) (L) - (extended) (e0)); /* check passed parameters */ if (fabs(e - 33769.0888) > 0.00001) goto Fail; i = (int (*)[]) calloc (5, sizeof (int)); /* create array to return */ if (i == NULL) goto Fail; for (j = *i, k = 0; k < 5; k++, j++) *j = k; return (i); Fail: printf ("Failure in Conformance Test 9.7.0.1, Func2\n"); exit (-1); } /**************************************************************************/ static void ( *Func3 (union U u, unsigned long ul1) ) () { extended e; e = (extended) (u.d) + (extended) (ul1); if (e != 285217028.5) goto Fail; return V1; Fail: printf ("Failure in Conformance Test 9.7.0.1, Func3\n"); exit (-1); } /**************************************************************************/ static struct S Func4 (extended e, unsigned short s, float f) { double d; struct S *SS; d = - ((double) (e)) - ((double) (s)) - ((double) (f)); /* test parms */ if (fabs(d - (-159.4088)) > 0.00001) goto Fail; /* Create struct to return. */ SS = (struct S *) calloc (1, sizeof (struct S)); if (SS == NULL) goto Fail; SS->f = 23.4e+02; SS->e = d; return * SS; Fail: printf ("Failure in Conformance Test 9.7.0.1, Func4\n"); exit (-1); } /**************************************************************************/ static union U Func5 (struct S s, double d, char ch, comp c) { extended e; comp cp; union U *u; e = s.f - d; /* test parameters */ if (fabs(e - 2292.19) > 0.01) goto Fail; cp = (comp) ch + c; if (cp != 222329) goto Fail; u = (union U *) calloc (1, sizeof (union U)); /* create union to return */ if (u == NULL) goto Fail; u->e = 123.456E+300; return (*u); Fail: printf ("Failure in Conformance Test 9.7.0.1, Func5\n"); exit (-1); } \ No newline at end of file +/* Conformance Test 9.7.0.1: Verification of function return types: enum, */ +/* pointer to array, pointer to function, struct, */ +/* and union */ + +#include +#include +#include + +struct S { float f; + extended e; }; + +union U { double d; + extended e; }; + +enum E { a, b, c }; + + +/**************************************************************************/ + +void V1 (void) + { + } + + +/**************************************************************************/ + +main () + { + /* Func1 returns an enumeration E constant. */ + + static enum E Func1 (char ch, int i, double d, struct S s); + + + /* Func2 returns a pointer to an array of integers. */ + + static int ( *Func2 (long L, extended e, enum E e0) ) []; + + + /* Func3 returns a pointer to a function returning void. */ + + static void ( *Func3 (union U u, unsigned long ul1) ) (); + + + /* Func4 returns a struct S. */ + + static struct S Func4 (extended e, unsigned short s, float f); + + + /* Func5 returns a union U. */ + + static union U Func5 (struct S s, double d, char ch, comp c); + + + extended e = 8.88e-2; + double d = 47.81; + float f = 32.32; + comp c = 222222; + long L = 33769; + char ch = 'k'; + int i = 897; + enum E e0 = b; + + int (*j)[], (*m)[], k; + + unsigned short sh = 0177; + unsigned long ul1 = 0x11001100; + + struct S s = { 5.5, 6.6 }; + union U u = 4.5; + + void (*funcPtr) (void); + + + e0 = Func1 (ch, i, d, s); /* call functions & test return values */ + if (e0 != a) + goto Fail; + + m = j = Func2 (L, e, e0); + if (j == NULL) + goto Fail; + for (k = 0; k < 5; k++) + if ((*j)[k] != k) + goto Fail; + free (m); + + funcPtr = Func3 (u, ul1); + if (funcPtr != V1) + goto Fail; + + s = Func4 (e, sh, f); + if ((fabs(s.f - 2340.0) > 0.01) || (fabs(s.e - (-159.4088)) > 0.001)) + goto Fail; + + u = Func5 (s, d, ch, c); + if (fabs(u.e - 123.456e+300) > 1e295) + goto Fail; + + + printf ("Passed Conformance Test 9.7.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 9.7.0.1\n"); + } + + +/**************************************************************************/ + +static enum E Func1 (char ch, int i, double d, struct S s) + { + d = s.f - 0.5; + if (d != 5.0) + goto Fail; + i += ch; + if (i != 1004) + goto Fail; + return a; + +Fail: + printf ("Failure in Conformance Test 9.7.0.1, Func1\n"); + exit (-1); + } + + +/**************************************************************************/ + +static int ( *Func2 (long L, extended e, enum E e0) ) [] + { + int (*i)[], *j, k; + + + e += ((extended) (L) - (extended) (e0)); /* check passed parameters */ + if (fabs(e - 33769.0888) > 0.00001) + goto Fail; + + i = (int (*)[]) calloc (5, sizeof (int)); /* create array to return */ + if (i == NULL) + goto Fail; + for (j = *i, k = 0; k < 5; k++, j++) + *j = k; + return (i); + +Fail: + printf ("Failure in Conformance Test 9.7.0.1, Func2\n"); + exit (-1); + } + + +/**************************************************************************/ + +static void ( *Func3 (union U u, unsigned long ul1) ) () + { + extended e; + + e = (extended) (u.d) + (extended) (ul1); + if (e != 285217028.5) + goto Fail; + return V1; + +Fail: + printf ("Failure in Conformance Test 9.7.0.1, Func3\n"); + exit (-1); + } + + +/**************************************************************************/ + +static struct S Func4 (extended e, unsigned short s, float f) + { + double d; + struct S *SS; + + d = - ((double) (e)) - ((double) (s)) - ((double) (f)); /* test parms */ + if (fabs(d - (-159.4088)) > 0.00001) + goto Fail; + + /* Create struct to return. */ + + SS = (struct S *) calloc (1, sizeof (struct S)); + if (SS == NULL) + goto Fail; + SS->f = 23.4e+02; + SS->e = d; + return * SS; + +Fail: + printf ("Failure in Conformance Test 9.7.0.1, Func4\n"); + exit (-1); + } + + +/**************************************************************************/ + +static union U Func5 (struct S s, double d, char ch, comp c) + { + extended e; + comp cp; + union U *u; + + e = s.f - d; /* test parameters */ + if (fabs(e - 2292.19) > 0.01) + goto Fail; + + cp = (comp) ch + c; + if (cp != 222329) + goto Fail; + + u = (union U *) calloc (1, sizeof (union U)); /* create union to return */ + if (u == NULL) + goto Fail; + u->e = 123.456E+300; + return (*u); + +Fail: + printf ("Failure in Conformance Test 9.7.0.1, Func5\n"); + exit (-1); + } diff --git a/Tests/Conformance/TEST b/Tests/Conformance/TEST old mode 100755 new mode 100644 index f8a10dd..39b07eb --- a/Tests/Conformance/TEST +++ b/Tests/Conformance/TEST @@ -1 +1,8 @@ -unset exit echo {1} cmpl -i {1} keep=3/t >>3/temp if {status} == 0 3/t else echo Could not compile {1} end \ No newline at end of file +unset exit +echo {1} +cmpl -i {1} keep=3/t >>3/temp +if {status} == 0 + 3/t +else + echo Could not compile {1} +end diff --git a/Tests/Conformance/TEST2 b/Tests/Conformance/TEST2 old mode 100755 new mode 100644 index a665cd5..4a4734b --- a/Tests/Conformance/TEST2 +++ b/Tests/Conformance/TEST2 @@ -1 +1,19 @@ -echo {1} echo #pragma keep "3/t" >3/{1} echo #pragma memorymodel 1 >>3/{1} echo #pragma optimize -1 >>3/{1} echo >>3/{1} type {1} >>3/{1} change 3/{1} cc unset exit cmpl -i 3/{1} >>3/temp if {status} == 0 3/t else echo Could not compile {1} end if {#} == 1 delete 3/{1} end \ No newline at end of file +echo {1} + +echo #pragma keep "3/t" >3/{1} +echo #pragma memorymodel 1 >>3/{1} +echo #pragma optimize -1 >>3/{1} +echo >>3/{1} +type {1} >>3/{1} +change 3/{1} cc + +unset exit +cmpl -i 3/{1} >>3/temp +if {status} == 0 + 3/t +else + echo Could not compile {1} +end +if {#} == 1 + delete 3/{1} +end diff --git a/Tests/Conformance/c14.4.0.1.cc b/Tests/Conformance/c14.4.0.1.cc old mode 100755 new mode 100644 index 491dd21..293c7d7 --- a/Tests/Conformance/c14.4.0.1.cc +++ b/Tests/Conformance/c14.4.0.1.cc @@ -1 +1,78 @@ -/* Conformance Test 14.4.0.1: Verification of isgraph, isprint, ispunct */ #include main () { int i, j; char ch; unsigned char uc; /* isgraph: returns 0 if char is not in [ASCII 33 .. 126] */ /* isprint: returns 0 if char is not in [ASCII 32 .. 126] */ /* ispunct: returns 0 if char not in [ !"#$%&'()*+,-./:;<=>?@[\]^_`{|}~] */ j = isprint (' '); if (j == 0) goto Fail; for (ch = 33; ch < 127; ch++) { j = isgraph (ch); if (j == 0) goto Fail; j = isprint (ch); if (j == 0) goto Fail; } for (uc = '!'; uc < '0'; uc++) /* ! through / */ { j = ispunct (uc); if (j == 0) goto Fail; } for (uc = ':'; uc < 'A'; uc++) /* : thru @ */ { j = ispunct (uc); if (j == 0) goto Fail; } for (ch = '['; ch < 'a'; ch++) /* [ thru ` */ { j = ispunct (ch); if (j == 0) goto Fail; } for (uc = 0x7B; uc < 127; uc++) /* { thru ~ */ { j = ispunct (uc); if (j == 0) goto Fail; } for (i = 0; i < 32; i++) /* 0 for non-set characters */ { j = isgraph ((char) i); if (j != 0) goto Fail; j = isprint ((char) i); if (j != 0) goto Fail; j = ispunct ((char) i); if (j != 0) goto Fail; } if (ispunct(' ')) goto Fail; printf ("Passed Conformance Test 14.4.0.1\n"); return; Fail: printf ("Failed Conformance Test 14.4.0.1\n"); } \ No newline at end of file +/* Conformance Test 14.4.0.1: Verification of isgraph, isprint, ispunct */ + +#include + +main () + { + int i, j; + char ch; + unsigned char uc; + + + /* isgraph: returns 0 if char is not in [ASCII 33 .. 126] */ + /* isprint: returns 0 if char is not in [ASCII 32 .. 126] */ + /* ispunct: returns 0 if char not in [ !"#$%&'()*+,-./:;<=>?@[\]^_`{|}~] */ + + j = isprint (' '); + if (j == 0) + goto Fail; + + for (ch = 33; ch < 127; ch++) + { + j = isgraph (ch); + if (j == 0) + goto Fail; + j = isprint (ch); + if (j == 0) + goto Fail; + } + + for (uc = '!'; uc < '0'; uc++) /* ! through / */ + { + j = ispunct (uc); + if (j == 0) + goto Fail; + } + + for (uc = ':'; uc < 'A'; uc++) /* : thru @ */ + { + j = ispunct (uc); + if (j == 0) + goto Fail; + } + + for (ch = '['; ch < 'a'; ch++) /* [ thru ` */ + { + j = ispunct (ch); + if (j == 0) + goto Fail; + } + + for (uc = 0x7B; uc < 127; uc++) /* { thru ~ */ + { + j = ispunct (uc); + if (j == 0) + goto Fail; + } + + for (i = 0; i < 32; i++) /* 0 for non-set characters */ + { + j = isgraph ((char) i); + if (j != 0) + goto Fail; + j = isprint ((char) i); + if (j != 0) + goto Fail; + j = ispunct ((char) i); + if (j != 0) + goto Fail; + } + if (ispunct(' ')) + goto Fail; + + printf ("Passed Conformance Test 14.4.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 14.4.0.1\n"); + } diff --git a/Tests/Conformance/c19.5.0.1.cc b/Tests/Conformance/c19.5.0.1.cc old mode 100755 new mode 100644 index 976f84e..4f39eb8 --- a/Tests/Conformance/c19.5.0.1.cc +++ b/Tests/Conformance/c19.5.0.1.cc @@ -1 +1,33 @@ -/* Conformance Test 19.5.0.1: Verification of frexp, ldexp, modf functions */ #include main () { double d1, d2; int i; d1 = frexp (4.8, &i); if ((fabs(d1 - .60) > 0.00001) || (i != 3)) goto Fail; d1 = frexp (0, &i); if ((fabs(d1) > 0.00001) || (i != 0)) goto Fail; d1 = ldexp (3.2, 4); if (fabs(d1 - 51.2) > 0.00001) goto Fail; d1 = modf (-14.654, &d2); if ((fabs(d1 - (-0.654)) > 0.00001) || (d2 != -14.0)) goto Fail; printf ("Passed Conformance Test 19.5.0.1\n"); return; Fail: printf ("Failed Conformance Test 19.5.0.1\n"); } \ No newline at end of file +/* Conformance Test 19.5.0.1: Verification of frexp, ldexp, modf functions */ + +#include + +main () + { + double d1, d2; + int i; + + + d1 = frexp (4.8, &i); + if ((fabs(d1 - .60) > 0.00001) || (i != 3)) + goto Fail; + + d1 = frexp (0, &i); + if ((fabs(d1) > 0.00001) || (i != 0)) + goto Fail; + + d1 = ldexp (3.2, 4); + if (fabs(d1 - 51.2) > 0.00001) + goto Fail; + + d1 = modf (-14.654, &d2); + if ((fabs(d1 - (-0.654)) > 0.00001) || (d2 != -14.0)) + goto Fail; + + + printf ("Passed Conformance Test 19.5.0.1\n"); + return; + +Fail: + printf ("Failed Conformance Test 19.5.0.1\n"); + } diff --git a/Tests/Conformance/c24.0.3.cc b/Tests/Conformance/c24.0.3.cc old mode 100755 new mode 100644 index f390dd8..bd4e357 --- a/Tests/Conformance/c24.0.3.cc +++ b/Tests/Conformance/c24.0.3.cc @@ -1 +1,101 @@ -/* Conformance Test 24.0.3: Test the use of the extended character set */ #pragma lint -1 #include #include typedef enum {false, true} boolean; void main (void) { boolean fail; int a, b, c, i; char str[128]; int €‘‚’ƒ“„”´Ä…•µ†–¶Æ‡—§·ˆ˜¸Ø‰™¹Šš‹›»ËŒœ¼Ì½ÍŽž®¾ÎÞŸ¯¿Ïß; int €‘‚’ƒ“„”´Ä…•µ†„ÆƇ—§·Ë˜¸Ø‰™¹€…Ìͻ˜¼Ì‚½Íƒž®®ÎÞ†¯¯Îß; /* Make sure alpha-"looking" characters are allowed in identifiers, and that the lowercase versions are distinct from the uppercase versions. */ fail = false; €‘‚’ƒ“„”´Ä…•µ†–¶Æ‡—§·ˆ˜¸Ø‰™¹Šš‹›»ËŒœ¼Ì½ÍŽž®¾ÎÞŸ¯¿Ïß = 4; €‘‚’ƒ“„”´Ä…•µ†„ÆƇ—§·Ë˜¸Ø‰™¹€…Ìͻ˜¼Ì‚½Íƒž®®ÎÞ†¯¯Îß = 5; if (€‘‚’ƒ“„”´Ä…•µ†–¶Æ‡—§·ˆ˜¸Ø‰™¹Šš‹›»ËŒœ¼Ì½ÍŽž®¾ÎÞŸ¯¿Ïß != 4) fail = true; /* Make sure all special characters are allowed in strings */ strcpy(str, ""); for (i = 17; i <= 20; ++i) if (str[i - 17] != i) { fail = true; printf("Character %d was incorrect in str.\n", i); } strcpy(str, "€‚ƒ„…†‡ˆ‰Š‹ŒŽ‘’“”•–—˜™š›œžŸ ¡¢£¤¥¦§¨©ª«" "¬­®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×Ø"); for (i = 128; i <= 216; ++i) if (str[i - 128] != i) { fail = true; printf("Character %d was incorrect in str.\n", i); } if ('Þ' != 222) { fail = true; printf("Character 222 was incorrect in str.\n"); } if ('ß' != 223) { fail = true; printf("Character 223 was incorrect in str.\n"); } /* Make sure all special characters are allowed in comments */ /* The special character set is: 0 1 2 3 4 5 6 7 8 9 A B C D E F 0 0 @ P ` p €   ° À Ð 1  ! 1 A Q a q ‘ ¡ ± Á Ñ 2  " 2 B R b r ‚ ’ ¢ ² Â Ò 3  # 3 C S c s ƒ “ £ ³ Ã Ó 4  $ 4 D T d t „ ” ¤ ´ Ä Ô 5 % 5 E U e u … • ¥ µ Å Õ 6 & 6 F V f v † – ¦ ¶ Æ Ö 7 ' 7 G W g w ‡ — § · Ç × 8 ( 8 H X h x ˆ ˜ ¨ ¸ È Ø 9 ) 9 I Y i y ‰ ™ © ¹ É A * 0 J Z j z Š š ª º Ê B + : K [ k { ‹ › « » Ë C , ; L \ l | Œ œ ¬ ¼ Ì D _ < M ] m } ­ ½ Í E . = N ^ n ~ Ž ž ® ¾ Î Þ F / ? O _ o Ÿ ¯ ¿ Ï ß */ /* Make sure the special operators work */ /* Some lines also test the non-breaking space */ aÊ=Ê100; bÊ=Ê3; cÊ=ÊaÖb; ifÊ(aʲÊb) fail = true; if (! (a ² a)) fail = true; if (b ³ a) fail = true; if (! (b ³ b)) fail = true; if (c ­ 33) fail = true; c = a Ç 2; if (c ­ 400) fail = true; c = a È 2; if (c ­ 25) fail = true; if (!fail) printf("Passed Conformance Test 24.0.3\n"); else printf("Failed Conformance Test 24.0.3\n"); } \ No newline at end of file +/* Conformance Test 24.0.3: Test the use of the extended character set */ + +#pragma lint -1 + +#include +#include + +typedef enum {false, true} boolean; + +void main (void) + +{ +boolean fail; +int a, b, c, i; +char str[128]; + +int €‘‚’ƒ“„”´Ä…•µ†–¶Æ‡—§·ˆ˜¸Ø‰™¹Šš‹›»ËŒœ¼Ì½ÍŽž®¾ÎÞŸ¯¿Ïß; +int €‘‚’ƒ“„”´Ä…•µ†„ÆƇ—§·Ë˜¸Ø‰™¹€…Ìͻ˜¼Ì‚½Íƒž®®ÎÞ†¯¯Îß; + +/* Make sure alpha-"looking" characters are allowed in identifiers, + and that the lowercase versions are distinct from the uppercase + versions. */ +fail = false; + €‘‚’ƒ“„”´Ä…•µ†–¶Æ‡—§·ˆ˜¸Ø‰™¹Šš‹›»ËŒœ¼Ì½ÍŽž®¾ÎÞŸ¯¿Ïß = 4; + €‘‚’ƒ“„”´Ä…•µ†„ÆƇ—§·Ë˜¸Ø‰™¹€…Ìͻ˜¼Ì‚½Íƒž®®ÎÞ†¯¯Îß = 5; +if (€‘‚’ƒ“„”´Ä…•µ†–¶Æ‡—§·ˆ˜¸Ø‰™¹Šš‹›»ËŒœ¼Ì½ÍŽž®¾ÎÞŸ¯¿Ïß != 4) + fail = true; + +/* Make sure all special characters are allowed in strings */ +strcpy(str, ""); +for (i = 17; i <= 20; ++i) + if (str[i - 17] != i) { + fail = true; + printf("Character %d was incorrect in str.\n", i); + } +strcpy(str, "€‚ƒ„…†‡ˆ‰Š‹ŒŽ‘’“”•–—˜™š›œžŸ ¡¢£¤¥¦§¨©ª«" + "¬­®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×Ø"); +for (i = 128; i <= 216; ++i) + if (str[i - 128] != i) { + fail = true; + printf("Character %d was incorrect in str.\n", i); + } +if ('Þ' != 222) { + fail = true; + printf("Character 222 was incorrect in str.\n"); + } +if ('ß' != 223) { + fail = true; + printf("Character 223 was incorrect in str.\n"); + } + +/* Make sure all special characters are allowed in comments */ +/* The special character set is: + + 0 1 2 3 4 5 6 7 8 9 A B C D E F + +0 0 @ P ` p €   ° À Ð +1  ! 1 A Q a q ‘ ¡ ± Á Ñ +2  " 2 B R b r ‚ ’ ¢ ² Â Ò +3  # 3 C S c s ƒ “ £ ³ Ã Ó +4  $ 4 D T d t „ ” ¤ ´ Ä Ô +5 % 5 E U e u … • ¥ µ Å Õ +6 & 6 F V f v † – ¦ ¶ Æ Ö +7 ' 7 G W g w ‡ — § · Ç × +8 ( 8 H X h x ˆ ˜ ¨ ¸ È Ø +9 ) 9 I Y i y ‰ ™ © ¹ É +A * 0 J Z j z Š š ª º Ê +B + : K [ k { ‹ › « » Ë +C , ; L \ l | Œ œ ¬ ¼ Ì +D _ < M ] m } ­ ½ Í +E . = N ^ n ~ Ž ž ® ¾ Î Þ +F / ? O _ o Ÿ ¯ ¿ Ï ß +*/ + +/* Make sure the special operators work */ +/* Some lines also test the non-breaking space */ +aÊ=Ê100; +bÊ=Ê3; +cÊ=ÊaÖb; +ifÊ(aʲÊb) + fail = true; +if (! (a ² a)) + fail = true; +if (b ³ a) + fail = true; +if (! (b ³ b)) + fail = true; +if (c ­ 33) + fail = true; +c = a Ç 2; +if (c ­ 400) + fail = true; +c = a È 2; +if (c ­ 25) + fail = true; + +if (!fail) + printf("Passed Conformance Test 24.0.3\n"); +else + printf("Failed Conformance Test 24.0.3\n"); +} diff --git a/Tests/Conformance/c26.0.1.cc b/Tests/Conformance/c26.0.1.cc old mode 100755 new mode 100644 index 4f7e06d..24cd5ab --- a/Tests/Conformance/c26.0.1.cc +++ b/Tests/Conformance/c26.0.1.cc @@ -1 +1,59 @@ -/* Conformance Test 26.0.1: Ensure can include all library header files */ /* without conflicts */ #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include main () { printf ("Passed Conformance Test 26.0.1\n"); } \ No newline at end of file +/* Conformance Test 26.0.1: Ensure can include all library header files */ +/* without conflicts */ + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +main () + { + printf ("Passed Conformance Test 26.0.1\n"); + } diff --git a/Tests/Conformance/c6.2.3.5.cc b/Tests/Conformance/c6.2.3.5.cc old mode 100755 new mode 100644 index e52ed53..1950ff1 --- a/Tests/Conformance/c6.2.3.5.cc +++ b/Tests/Conformance/c6.2.3.5.cc @@ -1 +1,133 @@ -/* Conformance Test 6.2.3.5: Verification of conversion from floating-point */ /* to integer types */ #include #include main () { float f; double d; extended e; static float F (float f, double d, extended e, signed char ch, short sh, int i, long L, unsigned char uch, unsigned int ui, unsigned long ul); static double D (float f, double d, extended e, signed char ch, short sh, int i, long L, unsigned char uch, unsigned int ui, unsigned long ul); static extended E (float f, double d, extended e, signed char ch, short sh, int i, long L, unsigned char uch, unsigned int ui, unsigned long ul); #if 0 f = F (123.456, -876.443, 456.789, -127.54, 321.456, -456.77, -844.0, 4.0, 6.0, 4.2e2); if (fabs(f - 18.224) > 0.00001) goto Fail; #endif d = D (-1234.56, 4567.89977, 55555.66666, 4.5, -89.0, -4565.00, 333.88, 42.567, 76.564, 987.98765); if (fabs(d - 28121.32696) > 0.00001) goto Fail; e = E (8.456e20, 3478.6e-100, 9876.43E+300, 0.00e-30, 00.00, -0.0, 0.577, 00.33, 0.43212, 0.9876); if (fabs(e) > 0.00001) goto Fail; printf ("Passed Conformance Test 6.2.3.5\n"); return; Fail: printf ("Passed Conformance Test 6.2.3.5\n"); } /******************************************************************************/ static float F (float f, double d, extended e, signed char ch, short sh, int i, long L, unsigned char uch, unsigned int ui, unsigned long ul) { float f1; /* Check expected values of passed parameters. */ if ((fabs(f - 123.456) > 0.00001) || (fabs(d - (-876.443)) > 0.00001) || (fabs(e - 456.789) > 0.00001) || (ch != -127) || (sh != 321) || (i != -456) || (L != -844) || (uch != 4) || (ui != 6) || (ul != 420)) goto Fail; /* Calculate a float value to return, and check expected result. */ f1 = f + d - e + (sh / ch + i - L / uch * ui + ul); if (fabs(f1 - 18.224) > 0.0001) goto Fail; return f1; Fail: printf ("Failure in F function in Conformance Test 6.2.3.5\n"); exit (-1); } /******************************************************************************/ static double D (float f, double d, extended e, signed char ch, short sh, int i, long L, unsigned char uch, unsigned int ui, unsigned long ul) { double d1; /* Check expected values of passed parameters. */ if ((fabs(f - (-1234.56)) > 0.00001) || (fabs(d - 4567.89977) > 0.00001) || (fabs(e - 55555.66666) > 0.00001) || (ch != 4) || (sh != -89) || (i != -4565) || (L != 333) || (uch != 42) || (ui != 76) || (ul != 987)) goto Fail; /* Calculate a double value to return, and check expected result. */ d1 = e - d - f - (i / ch + ul / uch * sh - L * ui); if (fabs(d1 + 4294886577.673110) > 0.00001) goto Fail; return d1; Fail: printf ("Failure in D function in Conformance Test 6.2.3.5\n"); exit (-1); } /******************************************************************************/ static extended E (float f, double d, extended e, signed char ch, short sh, int i, long L, unsigned char uch, unsigned int ui, unsigned long ul) { extended e1; e1 = F (8.456e20, 3478.6e-100, 9876.43E+300, 0.00e-30, 00.00, -0.0, 0.577, 00.33, 0.43212, 0.9876); if ((fabs(f - 8.456e20) > 0.00001) || (fabs(d - 3478.6e-100) > 0.00001) || (fabs(e - 9876.43e+300) > 0.00001) || (ch != 0) || (sh != 0) || (i != 0) || (L != 0) || (uch != 0) || (ui != 0) || (ul != 0)) goto Fail; e1 = f / d * ch - ul; if (fabs(e1) > 0.00001) goto Fail; return (e1); Fail: printf ("Failure in E function in Conformance Test 6.2.3.5\n"); exit (-1); } \ No newline at end of file +/* Conformance Test 6.2.3.5: Verification of conversion from floating-point */ +/* to integer types */ + +#include +#include + +main () + { + float f; + double d; + extended e; + + static float F (float f, double d, extended e, signed char ch, short sh, + int i, long L, unsigned char uch, unsigned int ui, + unsigned long ul); + + static double D (float f, double d, extended e, signed char ch, short sh, + int i, long L, unsigned char uch, unsigned int ui, + unsigned long ul); + + static extended E (float f, double d, extended e, signed char ch, short sh, + int i, long L, unsigned char uch, unsigned int ui, + unsigned long ul); + +#if 0 + f = F (123.456, -876.443, 456.789, -127.54, 321.456, -456.77, -844.0, 4.0, + 6.0, 4.2e2); + if (fabs(f - 18.224) > 0.00001) + goto Fail; +#endif + + d = D (-1234.56, 4567.89977, 55555.66666, 4.5, -89.0, -4565.00, 333.88, + 42.567, 76.564, 987.98765); + if (fabs(d - 28121.32696) > 0.00001) + goto Fail; + + + e = E (8.456e20, 3478.6e-100, 9876.43E+300, 0.00e-30, 00.00, -0.0, 0.577, + 00.33, 0.43212, 0.9876); + if (fabs(e) > 0.00001) + goto Fail; + + printf ("Passed Conformance Test 6.2.3.5\n"); + return; + +Fail: + printf ("Passed Conformance Test 6.2.3.5\n"); + } + + +/******************************************************************************/ + +static float F (float f, double d, extended e, signed char ch, short sh, int i, + long L, unsigned char uch, unsigned int ui, unsigned long ul) + { + float f1; + + /* Check expected values of passed parameters. */ + + if ((fabs(f - 123.456) > 0.00001) || (fabs(d - (-876.443)) > 0.00001) || + (fabs(e - 456.789) > 0.00001) || (ch != -127) || + (sh != 321) || (i != -456) || (L != -844) || (uch != 4) || + (ui != 6) || (ul != 420)) + goto Fail; + + /* Calculate a float value to return, and check expected result. */ + + f1 = f + d - e + (sh / ch + i - L / uch * ui + ul); + if (fabs(f1 - 18.224) > 0.0001) + goto Fail; + return f1; + +Fail: + printf ("Failure in F function in Conformance Test 6.2.3.5\n"); + exit (-1); + } + + +/******************************************************************************/ + +static double D (float f, double d, extended e, signed char ch, short sh, int i, + long L, unsigned char uch, unsigned int ui, unsigned long ul) + { + double d1; + + /* Check expected values of passed parameters. */ + + if ((fabs(f - (-1234.56)) > 0.00001) || (fabs(d - 4567.89977) > 0.00001) || + (fabs(e - 55555.66666) > 0.00001) || + (ch != 4) || (sh != -89) || (i != -4565) || (L != 333) || + (uch != 42) || (ui != 76) || (ul != 987)) + goto Fail; + + /* Calculate a double value to return, and check expected result. */ + + d1 = e - d - f - (i / ch + ul / uch * sh - L * ui); + if (fabs(d1 + 4294886577.673110) > 0.00001) + goto Fail; + return d1; + +Fail: + printf ("Failure in D function in Conformance Test 6.2.3.5\n"); + exit (-1); + } + + +/******************************************************************************/ + +static extended E (float f, double d, extended e, signed char ch, short sh, + int i, long L, unsigned char uch, unsigned int ui, + unsigned long ul) + { + extended e1; + + e1 = F (8.456e20, 3478.6e-100, 9876.43E+300, 0.00e-30, 00.00, -0.0, 0.577, + 00.33, 0.43212, 0.9876); + + + if ((fabs(f - 8.456e20) > 0.00001) || (fabs(d - 3478.6e-100) > 0.00001) || + (fabs(e - 9876.43e+300) > 0.00001) || + (ch != 0) || (sh != 0) || (i != 0) || (L != 0) || (uch != 0) || + (ui != 0) || (ul != 0)) + goto Fail; + + e1 = f / d * ch - ul; + if (fabs(e1) > 0.00001) + goto Fail; + return (e1); + +Fail: + printf ("Failure in E function in Conformance Test 6.2.3.5\n"); + exit (-1); + } diff --git a/Tests/Conformance/doit b/Tests/Conformance/doit old mode 100755 new mode 100644 index 5428f68..76ebf8d --- a/Tests/Conformance/doit +++ b/Tests/Conformance/doit @@ -1 +1,269 @@ -{1} C2.1.0.1.CC {1} C2.1.0.2.CC {1} C2.1.0.3.CC {1} C2.1.0.4.CC {1} C2.1.1.1.CC {1} C2.1.1.2.CC {1} C2.1.2.1.CC {1} C2.1.2.2.CC {1} C2.1.2.3.CC {1} C2.2.0.1.CC {1} C2.2.0.2.CC {1} C2.2.0.3.CC {1} C2.2.0.4.CC {1} C2.4.0.1.CC {1} C2.4.0.2.CC {1} C2.5.0.1.CC {1} C2.5.0.2.CC {1} C2.5.0.3.CC {1} C2.5.0.4.CC {1} C2.5.0.5.CC {1} C2.5.0.6.CC {1} C2.5.0.7.CC {1} C2.5.0.8.CC {1} C2.6.0.1.CC {1} C2.6.0.2.CC {1} C2.6.0.3.CC {1} C2.6.0.4.CC {1} C2.6.0.5.CC {1} C2.7.1.1.CC {1} C2.7.1.2.CC {1} C2.7.1.3.CC {1} C2.7.1.4.CC {1} C2.7.1.5.CC {1} C2.7.1.6.CC {1} C2.7.1.7.CC {1} C2.7.1.8.CC {1} C2.7.2.1.CC {1} C2.7.2.2.CC {1} C2.7.2.3.CC {1} C2.7.3.1.CC {1} C2.7.3.2.CC {1} C2.7.4.1.CC {1} C2.7.4.2.CC {1} C2.7.4.3.CC {1} C2.7.4.4.CC {1} C2.7.7.1.CC {1} C2.7.7.2.CC {1} C3.3.0.1.CC {1} C3.3.1.1.CC {1} C3.3.2.1.CC {1} C3.3.3.1.CC {1} C3.3.4.1.CC {1} C3.3.5.1.CC {1} C3.3.6.1.CC {1} C3.3.8.1.CC {1} C3.3.9.1.CC {1} C3.5.1.1.CC {1} C3.5.1.2.CC {1} C3.5.1.3.CC {1} C3.5.1.4.CC {1} C3.5.1.5.CC {1} C3.5.2.1.CC {1} C3.5.2.2.CC {1} C3.5.2.3.CC {1} C3.5.2.4.CC {1} C3.5.3.1.CC {1} C3.5.4.1.CC {1} C3.5.4.2.CC {1} C4.2.1.1.CC {1} C4.2.2.1.CC {1} C4.2.4.1.CC {1} C4.2.5.1.CC {1} C4.3.0.1.CC {1} C4.3.0.2.CC {1} C4.4.2.1.CC {1} C4.5.2.1.CC {1} C4.5.2.2.CC {1} C4.5.2.3.CC {1} C4.5.3.1.CC {1} C4.5.3.2.CC {1} C4.5.3.3.CC {1} C4.5.3.4.CC {1} C4.5.4.1.CC {1} C4.5.4.2.CC {1} C4.6.1.1.CC {1} C4.6.1.2.CC {1} C4.6.2.1.CC {1} C4.6.2.2.CC {1} C4.6.3.1.CC {1} C4.6.3.2.CC {1} C4.6.4.1.CC {1} C4.6.4.2.CC {1} C4.6.5.1.CC {1} C4.6.6.1.CC {1} C4.6.6.2.CC {1} C4.6.7.1.CC {1} C5.6.0.1.CC {1} C6.2.3.1.CC {1} C6.2.3.2.CC {1} C6.2.3.3.CC {1} C6.2.3.4.CC {1} C6.2.3.5.CC {1} C7.4.1.1.CC {1} C7.4.4.1.CC {1} C7.4.5.1.CC {1} C7.5.1.1.CC {1} C7.5.1.2.CC {1} C7.5.1.3.CC {1} C7.5.1.4.CC {1} C7.5.1.5.CC {1} C7.5.1.6.CC {1} C7.5.5.1.CC {1} C7.5.8.1.CC {1} C7.5.9.1.CC {1} C7.6.1.1.CC {1} C7.6.1.2.CC {1} C7.6.1.3.CC {1} C7.6.2.1.CC {1} C7.6.3.1.CC {1} C7.6.4.1.CC {1} C7.6.6.1.CC {1} C7.6.7.1.CC {1} C7.6.8.1.CC {1} C7.7.1.1.CC {1} C7.7.2.1.CC {1} C7.8.0.1.CC {1} C7.9.2.1.CC {1} C7.9.2.2.CC {1} C7.9.2.3.CC {1} C7.9.2.4.CC {1} C7.9.2.5.CC {1} C7.9.2.6.CC {1} C7.9.2.7.CC {1} C7.9.2.8.CC {1} C7.10.0.1.CC {1} C8.7.0.1.CC {1} C8.7.0.2.CC {1} C8.7.0.3.CC {1} C8.7.0.4.CC {1} C8.7.0.5.CC {1} C8.7.0.6.CC {1} C8.8.0.1.CC {1} C9.2.0.1.CC {1} C9.3.0.1.CC {1} C9.5.0.1.CC {1} C9.5.0.2.CC {1} C9.7.0.1.CC {1} C13.1.0.1.CC {1} C14.1.0.1.CC {1} C14.2.0.1.CC {1} C14.3.0.1.CC {1} C14.4.0.1.CC {1} C14.5.0.1.CC {1} C14.6.0.1.CC {1} C14.7.0.1.CC {1} C14.8.0.1.CC {1} C14.9.0.1.CC {1} C15.1.0.1.CC {1} C15.2.0.1.CC {1} C15.3.0.1.CC {1} C15.5.0.1.CC {1} C15.6.0.1.CC {1} C15.7.0.1.CC {1} C15.7.0.2.CC {1} C15.8.0.1.CC {1} C15.8.0.2.CC {1} C15.9.0.1.CC {1} C16.1.0.1.CC {1} C16.4.0.1.CC {1} C17.5.0.1.CC {1} C17.5.0.2.CC {1} C17.6.0.1.CC {1} C17.6.0.2.CC {1} C17.7.0.1.CC {1} C17.7.0.2.CC {1} C17.8.0.1.CC {1} C17.8.0.2.CC {1} C17.8.0.3.CC {1} C17.8.0.4.CC {1} C17.8.0.5.CC {1} C17.8.0.6.CC {1} C17.8.0.7.CC {1} C17.8.0.8.CC {1} C17.8.0.9.CC {1} C17.8.0.10.CC {1} C17.8.0.11.CC {1} C17.8.0.12.CC {1} C17.8.0.13.CC {1} C17.8.0.14.CC {1} C17.8.0.15.CC {1} C17.8.0.16.CC {1} C17.8.0.17.CC {1} C17.8.0.18.CC {1} C17.8.0.19.CC {1} C17.8.0.20.CC {1} C17.8.0.21.CC {1} C17.8.0.22.CC {1} C17.8.0.23.CC {1} C17.8.0.24.CC {1} C17.9.0.1.CC {1} C17.10.0.1.CC {1} C17.11.0.1.CC {1} C17.11.0.2.CC {1} C17.11.0.3.CC {1} C17.11.0.4.CC {1} C17.11.0.5.CC {1} C17.11.0.6.CC {1} C17.11.0.7.CC {1} C17.11.0.8.CC {1} C17.11.0.9.CC {1} C17.11.0.10.CC {1} C17.11.0.11.CC {1} C17.13.0.1.CC {1} C17.14.0.1.CC {1} C17.15.0.1.CC {1} C17.16.0.1.CC {1} C18.1.0.1.CC {1} C18.3.0.1.CC {1} C19.1.0.1.CC {1} C19.2.0.1.CC {1} C19.3.0.1.CC {1} C19.4.0.1.CC {1} C19.5.0.1.CC {1} C19.6.0.1.CC {1} C19.7.0.1.CC {1} C19.8.0.1.CC {1} C19.9.0.1.CC {1} C19.10.0.1.CC {1} C20.1.0.1.CC {1} C20.5.0.1.CC {1} C21.1.0.2.CC {1} C21.4.0.1.CC {1} C22.5.0.1.CC {1} C23.1.0.1.CC {1} C23.2.0.1.CC {1} C23.3.0.1.CC {1} C23.4.0.1.CC {1} C23.5.0.1.CC {1} C23.6.0.1.CC {1} C24.0.1.CC {1} C24.0.2.CC {1} C24.0.3.CC {1} C25.0.1.CC {1} C25.0.2.CC {1} C25.0.3.CC {1} C25.0.4.CC {1} C25.0.5.CC {1} C25.0.6.CC {1} C25.0.7.CC {1} C25.0.8.CC {1} C25.0.9.CC {1} C25.0.10.CC {1} C25.0.11.CC {1} C25.0.12.CC {1} C25.0.13.CC {1} C25.0.14.CC {1} C25.0.15.CC {1} C25.0.16.CC {1} C25.0.17.CC {1} C25.0.18.CC {1} C25.0.19.CC {1} C25.0.20.CC {1} C25.0.21.CC {1} C25.0.22.CC {1} C25.0.23.CC {1} C25.0.24.CC {1} C25.0.25.CC {1} C25.0.26.CC {1} C26.0.1.CC \ No newline at end of file +{1} C2.1.0.1.CC +{1} C2.1.0.2.CC +{1} C2.1.0.3.CC +{1} C2.1.0.4.CC +{1} C2.1.1.1.CC +{1} C2.1.1.2.CC +{1} C2.1.2.1.CC +{1} C2.1.2.2.CC +{1} C2.1.2.3.CC +{1} C2.2.0.1.CC +{1} C2.2.0.2.CC +{1} C2.2.0.3.CC +{1} C2.2.0.4.CC +{1} C2.4.0.1.CC +{1} C2.4.0.2.CC +{1} C2.5.0.1.CC +{1} C2.5.0.2.CC +{1} C2.5.0.3.CC +{1} C2.5.0.4.CC +{1} C2.5.0.5.CC +{1} C2.5.0.6.CC +{1} C2.5.0.7.CC +{1} C2.5.0.8.CC +{1} C2.6.0.1.CC +{1} C2.6.0.2.CC +{1} C2.6.0.3.CC +{1} C2.6.0.4.CC +{1} C2.6.0.5.CC +{1} C2.7.1.1.CC +{1} C2.7.1.2.CC +{1} C2.7.1.3.CC +{1} C2.7.1.4.CC +{1} C2.7.1.5.CC +{1} C2.7.1.6.CC +{1} C2.7.1.7.CC +{1} C2.7.1.8.CC +{1} C2.7.2.1.CC +{1} C2.7.2.2.CC +{1} C2.7.2.3.CC +{1} C2.7.3.1.CC +{1} C2.7.3.2.CC +{1} C2.7.4.1.CC +{1} C2.7.4.2.CC +{1} C2.7.4.3.CC +{1} C2.7.4.4.CC +{1} C2.7.7.1.CC +{1} C2.7.7.2.CC +{1} C3.3.0.1.CC +{1} C3.3.1.1.CC +{1} C3.3.2.1.CC +{1} C3.3.3.1.CC +{1} C3.3.4.1.CC +{1} C3.3.5.1.CC +{1} C3.3.6.1.CC +{1} C3.3.8.1.CC +{1} C3.3.9.1.CC +{1} C3.5.1.1.CC +{1} C3.5.1.2.CC +{1} C3.5.1.3.CC +{1} C3.5.1.4.CC +{1} C3.5.1.5.CC +{1} C3.5.2.1.CC +{1} C3.5.2.2.CC +{1} C3.5.2.3.CC +{1} C3.5.2.4.CC +{1} C3.5.3.1.CC +{1} C3.5.4.1.CC +{1} C3.5.4.2.CC +{1} C4.2.1.1.CC +{1} C4.2.2.1.CC +{1} C4.2.4.1.CC +{1} C4.2.5.1.CC +{1} C4.3.0.1.CC +{1} C4.3.0.2.CC +{1} C4.4.2.1.CC +{1} C4.5.2.1.CC +{1} C4.5.2.2.CC +{1} C4.5.2.3.CC +{1} C4.5.3.1.CC +{1} C4.5.3.2.CC +{1} C4.5.3.3.CC +{1} C4.5.3.4.CC +{1} C4.5.4.1.CC +{1} C4.5.4.2.CC +{1} C4.6.1.1.CC +{1} C4.6.1.2.CC +{1} C4.6.2.1.CC +{1} C4.6.2.2.CC +{1} C4.6.3.1.CC +{1} C4.6.3.2.CC +{1} C4.6.4.1.CC +{1} C4.6.4.2.CC +{1} C4.6.5.1.CC +{1} C4.6.6.1.CC +{1} C4.6.6.2.CC +{1} C4.6.7.1.CC +{1} C5.6.0.1.CC +{1} C6.2.3.1.CC +{1} C6.2.3.2.CC +{1} C6.2.3.3.CC +{1} C6.2.3.4.CC +{1} C6.2.3.5.CC +{1} C7.4.1.1.CC +{1} C7.4.4.1.CC +{1} C7.4.5.1.CC +{1} C7.5.1.1.CC +{1} C7.5.1.2.CC +{1} C7.5.1.3.CC +{1} C7.5.1.4.CC +{1} C7.5.1.5.CC +{1} C7.5.1.6.CC +{1} C7.5.5.1.CC +{1} C7.5.8.1.CC +{1} C7.5.9.1.CC +{1} C7.6.1.1.CC +{1} C7.6.1.2.CC +{1} C7.6.1.3.CC +{1} C7.6.2.1.CC +{1} C7.6.3.1.CC +{1} C7.6.4.1.CC +{1} C7.6.6.1.CC +{1} C7.6.7.1.CC +{1} C7.6.8.1.CC +{1} C7.7.1.1.CC +{1} C7.7.2.1.CC +{1} C7.8.0.1.CC +{1} C7.9.2.1.CC +{1} C7.9.2.2.CC +{1} C7.9.2.3.CC +{1} C7.9.2.4.CC +{1} C7.9.2.5.CC +{1} C7.9.2.6.CC +{1} C7.9.2.7.CC +{1} C7.9.2.8.CC +{1} C7.10.0.1.CC +{1} C8.7.0.1.CC +{1} C8.7.0.2.CC +{1} C8.7.0.3.CC +{1} C8.7.0.4.CC +{1} C8.7.0.5.CC +{1} C8.7.0.6.CC +{1} C8.8.0.1.CC +{1} C9.2.0.1.CC +{1} C9.3.0.1.CC +{1} C9.5.0.1.CC +{1} C9.5.0.2.CC +{1} C9.7.0.1.CC +{1} C13.1.0.1.CC +{1} C14.1.0.1.CC +{1} C14.2.0.1.CC +{1} C14.3.0.1.CC +{1} C14.4.0.1.CC +{1} C14.5.0.1.CC +{1} C14.6.0.1.CC +{1} C14.7.0.1.CC +{1} C14.8.0.1.CC +{1} C14.9.0.1.CC +{1} C15.1.0.1.CC +{1} C15.2.0.1.CC +{1} C15.3.0.1.CC +{1} C15.5.0.1.CC +{1} C15.6.0.1.CC +{1} C15.7.0.1.CC +{1} C15.7.0.2.CC +{1} C15.8.0.1.CC +{1} C15.8.0.2.CC +{1} C15.9.0.1.CC +{1} C16.1.0.1.CC +{1} C16.4.0.1.CC +{1} C17.5.0.1.CC +{1} C17.5.0.2.CC +{1} C17.6.0.1.CC +{1} C17.6.0.2.CC +{1} C17.7.0.1.CC +{1} C17.7.0.2.CC +{1} C17.8.0.1.CC +{1} C17.8.0.2.CC +{1} C17.8.0.3.CC +{1} C17.8.0.4.CC +{1} C17.8.0.5.CC +{1} C17.8.0.6.CC +{1} C17.8.0.7.CC +{1} C17.8.0.8.CC +{1} C17.8.0.9.CC +{1} C17.8.0.10.CC +{1} C17.8.0.11.CC +{1} C17.8.0.12.CC +{1} C17.8.0.13.CC +{1} C17.8.0.14.CC +{1} C17.8.0.15.CC +{1} C17.8.0.16.CC +{1} C17.8.0.17.CC +{1} C17.8.0.18.CC +{1} C17.8.0.19.CC +{1} C17.8.0.20.CC +{1} C17.8.0.21.CC +{1} C17.8.0.22.CC +{1} C17.8.0.23.CC +{1} C17.8.0.24.CC +{1} C17.9.0.1.CC +{1} C17.10.0.1.CC +{1} C17.11.0.1.CC +{1} C17.11.0.2.CC +{1} C17.11.0.3.CC +{1} C17.11.0.4.CC +{1} C17.11.0.5.CC +{1} C17.11.0.6.CC +{1} C17.11.0.7.CC +{1} C17.11.0.8.CC +{1} C17.11.0.9.CC +{1} C17.11.0.10.CC +{1} C17.11.0.11.CC +{1} C17.13.0.1.CC +{1} C17.14.0.1.CC +{1} C17.15.0.1.CC +{1} C17.16.0.1.CC +{1} C18.1.0.1.CC +{1} C18.3.0.1.CC +{1} C19.1.0.1.CC +{1} C19.2.0.1.CC +{1} C19.3.0.1.CC +{1} C19.4.0.1.CC +{1} C19.5.0.1.CC +{1} C19.6.0.1.CC +{1} C19.7.0.1.CC +{1} C19.8.0.1.CC +{1} C19.9.0.1.CC +{1} C19.10.0.1.CC +{1} C20.1.0.1.CC +{1} C20.5.0.1.CC +{1} C21.1.0.2.CC +{1} C21.4.0.1.CC +{1} C22.5.0.1.CC +{1} C23.1.0.1.CC +{1} C23.2.0.1.CC +{1} C23.3.0.1.CC +{1} C23.4.0.1.CC +{1} C23.5.0.1.CC +{1} C23.6.0.1.CC +{1} C24.0.1.CC +{1} C24.0.2.CC +{1} C24.0.3.CC +{1} C25.0.1.CC +{1} C25.0.2.CC +{1} C25.0.3.CC +{1} C25.0.4.CC +{1} C25.0.5.CC +{1} C25.0.6.CC +{1} C25.0.7.CC +{1} C25.0.8.CC +{1} C25.0.9.CC +{1} C25.0.10.CC +{1} C25.0.11.CC +{1} C25.0.12.CC +{1} C25.0.13.CC +{1} C25.0.14.CC +{1} C25.0.15.CC +{1} C25.0.16.CC +{1} C25.0.17.CC +{1} C25.0.18.CC +{1} C25.0.19.CC +{1} C25.0.20.CC +{1} C25.0.21.CC +{1} C25.0.22.CC +{1} C25.0.23.CC +{1} C25.0.24.CC +{1} C25.0.25.CC +{1} C25.0.26.CC +{1} C26.0.1.CC diff --git a/Tests/Conformance/doit2 b/Tests/Conformance/doit2 old mode 100755 new mode 100644 index aa17288..b0904da --- a/Tests/Conformance/doit2 +++ b/Tests/Conformance/doit2 @@ -1 +1,56 @@ -{1} C17.14.0.1.CC {1} C17.15.0.1.CC {1} C17.16.0.1.CC {1} C18.1.0.1.CC {1} C18.3.0.1.CC {1} C19.1.0.1.CC {1} C19.2.0.1.CC {1} C19.3.0.1.CC {1} C19.4.0.1.CC {1} C19.5.0.1.CC {1} C19.6.0.1.CC {1} C19.7.0.1.CC {1} C19.8.0.1.CC {1} C19.9.0.1.CC {1} C19.10.0.1.CC {1} C20.1.0.1.CC {1} C20.5.0.1.CC {1} C21.1.0.2.CC {1} C21.4.0.1.CC {1} C22.5.0.1.CC {1} C23.1.0.1.CC {1} C23.2.0.1.CC {1} C23.3.0.1.CC {1} C23.4.0.1.CC {1} C23.5.0.1.CC {1} C23.6.0.1.CC {1} C24.0.1.CC {1} C24.0.2.CC {1} C24.0.3.CC {1} C25.0.1.CC {1} C25.0.2.CC {1} C25.0.3.CC {1} C25.0.4.CC {1} C25.0.5.CC {1} C25.0.6.CC {1} C25.0.7.CC {1} C25.0.8.CC {1} C25.0.9.CC {1} C25.0.10.CC {1} C25.0.11.CC {1} C25.0.12.CC {1} C25.0.13.CC {1} C25.0.14.CC {1} C25.0.15.CC {1} C25.0.16.CC {1} C25.0.17.CC {1} C25.0.18.CC {1} C25.0.19.CC {1} C25.0.20.CC {1} C25.0.21.CC {1} C25.0.22.CC {1} C25.0.23.CC {1} C25.0.24.CC {1} C25.0.25.CC {1} C25.0.26.CC {1} C26.0.1.CC \ No newline at end of file +{1} C17.14.0.1.CC +{1} C17.15.0.1.CC +{1} C17.16.0.1.CC +{1} C18.1.0.1.CC +{1} C18.3.0.1.CC +{1} C19.1.0.1.CC +{1} C19.2.0.1.CC +{1} C19.3.0.1.CC +{1} C19.4.0.1.CC +{1} C19.5.0.1.CC +{1} C19.6.0.1.CC +{1} C19.7.0.1.CC +{1} C19.8.0.1.CC +{1} C19.9.0.1.CC +{1} C19.10.0.1.CC +{1} C20.1.0.1.CC +{1} C20.5.0.1.CC +{1} C21.1.0.2.CC +{1} C21.4.0.1.CC +{1} C22.5.0.1.CC +{1} C23.1.0.1.CC +{1} C23.2.0.1.CC +{1} C23.3.0.1.CC +{1} C23.4.0.1.CC +{1} C23.5.0.1.CC +{1} C23.6.0.1.CC +{1} C24.0.1.CC +{1} C24.0.2.CC +{1} C24.0.3.CC +{1} C25.0.1.CC +{1} C25.0.2.CC +{1} C25.0.3.CC +{1} C25.0.4.CC +{1} C25.0.5.CC +{1} C25.0.6.CC +{1} C25.0.7.CC +{1} C25.0.8.CC +{1} C25.0.9.CC +{1} C25.0.10.CC +{1} C25.0.11.CC +{1} C25.0.12.CC +{1} C25.0.13.CC +{1} C25.0.14.CC +{1} C25.0.15.CC +{1} C25.0.16.CC +{1} C25.0.17.CC +{1} C25.0.18.CC +{1} C25.0.19.CC +{1} C25.0.20.CC +{1} C25.0.21.CC +{1} C25.0.22.CC +{1} C25.0.23.CC +{1} C25.0.24.CC +{1} C25.0.25.CC +{1} C25.0.26.CC +{1} C26.0.1.CC diff --git a/Tests/Deviance/D2.1.0.1.CC b/Tests/Deviance/D2.1.0.1.CC old mode 100755 new mode 100644 index 4b63636..beeb894 --- a/Tests/Deviance/D2.1.0.1.CC +++ b/Tests/Deviance/D2.1.0.1.CC @@ -1 +1,6 @@ -/* Deviance Test 2.1.0.1: Ensure graphic characters $, @, ` can only appear */ /* in comments and character and string constants. */ main () { int hey$, you@, look`; } \ No newline at end of file +/* Deviance Test 2.1.0.1: Ensure graphic characters $, @, ` can only appear */ +/* in comments and character and string constants. */ +main () + { + int hey$, you@, look`; + } diff --git a/Tests/Deviance/D2.2.0.2.CC b/Tests/Deviance/D2.2.0.2.CC old mode 100755 new mode 100644 index 2bc5d99..4624534 --- a/Tests/Deviance/D2.2.0.2.CC +++ b/Tests/Deviance/D2.2.0.2.CC @@ -1 +1,13 @@ -/* Deviance Test 2.2.0.2: Ensure comments without terminators are flagged */ /* as errors */ main () { /* don't terminate this one int a; */ and then try to comment here */ a = 3; printf ("Failed Deviance Test 2.2.0.2\n"); } \ No newline at end of file +/* Deviance Test 2.2.0.2: Ensure comments without terminators are flagged */ +/* as errors */ +main () + { + /* don't terminate this one + + int a; + + */ and then try to comment here */ + + a = 3; + printf ("Failed Deviance Test 2.2.0.2\n"); + } diff --git a/Tests/Deviance/D2.4.0.1.CC b/Tests/Deviance/D2.4.0.1.CC old mode 100755 new mode 100644 index 0ef56d7..e4c7b50 --- a/Tests/Deviance/D2.4.0.1.CC +++ b/Tests/Deviance/D2.4.0.1.CC @@ -1 +1,45 @@ -/* Deviance Test 2.4.0.1: Ensure compound operators are scanned as one token */ main () { struct a { int b; } structA, *sptr; int i, j; i = 1; j = 2; /* Test compound assignment operators. */ i + = j; i - = j; i * = j; i / = j; i % = j; i << = j; i >> = j; i & = j; i ^ = j; i | = j; /* Test other compound operators. */ sptr = &structA; sptr- >b = 5; i + +; j - -; i = i < < j; j = i > > j; if (i < = j) ; if ( (i <= j) | | (j >= i) ) ; if (j > = i) ; if ( (i <= j) || (j >= i) & & (i == 3) ) ; if (i = = 3) ; if (j ! = 5) ; printf ("Failed Deviance Test 2.4.0.1\n"); } \ No newline at end of file +/* Deviance Test 2.4.0.1: Ensure compound operators are scanned as one token */ +main () + { + struct a { + int b; + } structA, *sptr; + int i, j; + + i = 1; + j = 2; + + /* Test compound assignment operators. */ + i + = j; + i - = j; + i * = j; + i / = j; + i % = j; + i << = j; + i >> = j; + i & = j; + i ^ = j; + i | = j; + + /* Test other compound operators. */ + sptr = &structA; + sptr- >b = 5; + i + +; + j - -; + i = i < < j; + j = i > > j; + if (i < = j) + ; + if ( (i <= j) | | (j >= i) ) + ; + if (j > = i) + ; + if ( (i <= j) || (j >= i) & & (i == 3) ) + ; + if (i = = 3) + ; + if (j ! = 5) + ; + + printf ("Failed Deviance Test 2.4.0.1\n"); + } diff --git a/Tests/Deviance/D2.5.0.1.CC b/Tests/Deviance/D2.5.0.1.CC old mode 100755 new mode 100644 index 47fd52c..bbbc694 --- a/Tests/Deviance/D2.5.0.1.CC +++ b/Tests/Deviance/D2.5.0.1.CC @@ -1 +1,37 @@ -/* Deviance Test 2.5.0.1: Ensure error flagging for invalid identifiers */ main () { int 1n; char !v_9; char @wrk; char #et; long $hex; long %percent; long ^caret; long &ersand; short *asterisk8876_L6, mid(_00; short middle)paren; float -minus; float +plus; float eq=ual; double {curly; extended brack}et; extern int square[; extern comp qu"ote; static unsigned char ]bracket; static unsigned short t'ic; extern long lessthan; float quest?ion; double period.; extern float ti~lde; int gra`ve; long bar|; unsigned char back\slash; char sla/sh; printf ("Failed Deviance Test 2.5.0.1\n"); } \ No newline at end of file +/* Deviance Test 2.5.0.1: Ensure error flagging for invalid identifiers */ +main () + { + int 1n; + char !v_9; + char @wrk; + char #et; + long $hex; + long %percent; + long ^caret; + long &ersand; + short *asterisk8876_L6, mid(_00; + short middle)paren; + float -minus; + float +plus; + float eq=ual; + double {curly; + extended brack}et; + + extern int square[; + extern comp qu"ote; + + static unsigned char ]bracket; + static unsigned short t'ic; + + extern long lessthan; + float quest?ion; + double period.; + extern float ti~lde; + int gra`ve; + long bar|; + unsigned char back\slash; + char sla/sh; + + printf ("Failed Deviance Test 2.5.0.1\n"); + } diff --git a/Tests/Deviance/D2.5.0.2.CC b/Tests/Deviance/D2.5.0.2.CC old mode 100755 new mode 100644 index 6ba5560..7bde1de --- a/Tests/Deviance/D2.5.0.2.CC +++ b/Tests/Deviance/D2.5.0.2.CC @@ -1 +1,44 @@ -/* Deviance Test 2.5.0.2: Ensure reserved words cannot be used as identifiers */ main () { int auto; int break; int case; int char; int continue; int default; int do; int double; long else; long enum; long extern; long float; long for; long goto; long if; long int; float long; float register; float return; float short; float sizeof; float static; float struct; float switch; double typedef; double union; double unsigned; double void; double while; short const; short signed; short volatile; unsigned asm; unsigned comp; unsigned extended; unsigned inline; unsigned pascal; unsigned segment; printf ("Failed Deviance Test 2.5.0.2\n"); } \ No newline at end of file +/* Deviance Test 2.5.0.2: Ensure reserved words cannot be used as identifiers */ +main () + { + int auto; + int break; + int case; + int char; + int continue; + int default; + int do; + int double; + long else; + long enum; + long extern; + long float; + long for; + long goto; + long if; + long int; + float long; + float register; + float return; + float short; + float sizeof; + float static; + float struct; + float switch; + double typedef; + double union; + double unsigned; + double void; + double while; + short const; + short signed; + short volatile; + unsigned asm; + unsigned comp; + unsigned extended; + unsigned inline; + unsigned pascal; + unsigned segment; + + printf ("Failed Deviance Test 2.5.0.2\n"); + } diff --git a/Tests/Deviance/D2.7.1.1.CC b/Tests/Deviance/D2.7.1.1.CC old mode 100755 new mode 100644 index 9cb8e69..5addfe3 --- a/Tests/Deviance/D2.7.1.1.CC +++ b/Tests/Deviance/D2.7.1.1.CC @@ -1 +1,25 @@ -/* Deviance Test 2.7.1.1: Ensure misformed integers are flagged as errors */ main () { int a; a = 32t79; /* invalid character embedded in digit sequence */ a = 14f; /* floating-pt type marker only used with reals */ a = 28F; a = 12FA; /* decimal number with embedded hex digits */ a = 04FC; /* octal number with embedded hex digits */ /* octal number with more than 255 characters */ a = 000000000000000000000000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000000000000000000000000000000\ 00000000000000000000000000000000000000000000000000000000000003; /* hex number with more than 255 characters */ a = 0X0000000000000000000000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000000000000000000000000000000\ 00000000000000000000000000000000000000000000000000000000000003FFA; printf ("Failed Deviance Test 2.7.1.1\n"); } \ No newline at end of file +/* Deviance Test 2.7.1.1: Ensure misformed integers are flagged as errors */ +main () + { + int a; + + a = 32t79; /* invalid character embedded in digit sequence */ + a = 14f; /* floating-pt type marker only used with reals */ + a = 28F; + a = 12FA; /* decimal number with embedded hex digits */ + a = 04FC; /* octal number with embedded hex digits */ + + /* octal number with more than 255 characters */ + a = 000000000000000000000000000000000000000000000000000000000000\ +0000000000000000000000000000000000000000000000000000000000000000000\ +0000000000000000000000000000000000000000000000000000000000000000000\ +00000000000000000000000000000000000000000000000000000000000003; + + /* hex number with more than 255 characters */ + a = 0X0000000000000000000000000000000000000000000000000000000000\ +0000000000000000000000000000000000000000000000000000000000000000000\ +0000000000000000000000000000000000000000000000000000000000000000000\ +00000000000000000000000000000000000000000000000000000000000003FFA; + + printf ("Failed Deviance Test 2.7.1.1\n"); + } diff --git a/Tests/Deviance/D2.7.1.2.CC b/Tests/Deviance/D2.7.1.2.CC old mode 100755 new mode 100644 index cbd33a7..d33ba0b --- a/Tests/Deviance/D2.7.1.2.CC +++ b/Tests/Deviance/D2.7.1.2.CC @@ -1 +1,26 @@ -/* Deviance Test 2.7.1.2: Ensure long integer constant overflows are */ /* caught as errors */ main () { long a; a = 2147483648; a = -2147483648L; a = 0xFFFFFFFF2; a = 0x800000001; a = 047777777777L; /* octal number with more than 255 characters */ a = 000000000000000000000000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000000000000000000000000000000\ 00000000000000000000000000000000000000000000000000000000000003; /* hex number with more than 255 characters */ a = 0x0000000000000000000000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000000000000000000000000000000\ 00000000000000000000000000000000000000000000000000000000000003FF0110; printf ("Failed Deviance Test 2.7.1.2\n"); } \ No newline at end of file +/* Deviance Test 2.7.1.2: Ensure long integer constant overflows are */ +/* caught as errors */ +main () + { + long a; + + a = 2147483648; + a = -2147483648L; + a = 0xFFFFFFFF2; + a = 0x800000001; + a = 047777777777L; + + /* octal number with more than 255 characters */ + a = 000000000000000000000000000000000000000000000000000000000000\ +0000000000000000000000000000000000000000000000000000000000000000000\ +0000000000000000000000000000000000000000000000000000000000000000000\ +00000000000000000000000000000000000000000000000000000000000003; + + /* hex number with more than 255 characters */ + a = 0x0000000000000000000000000000000000000000000000000000000000\ +0000000000000000000000000000000000000000000000000000000000000000000\ +0000000000000000000000000000000000000000000000000000000000000000000\ +00000000000000000000000000000000000000000000000000000000000003FF0110; + + printf ("Failed Deviance Test 2.7.1.2\n"); + } diff --git a/Tests/Deviance/D2.7.2.1.CC b/Tests/Deviance/D2.7.2.1.CC old mode 100755 new mode 100644 index 2754f9b..cd96431 --- a/Tests/Deviance/D2.7.2.1.CC +++ b/Tests/Deviance/D2.7.2.1.CC @@ -1 +1,30 @@ -/* Deviance Test 2.7.2.1: Ensure misformed floating-point constants are */ /* flagged as errors */ main () { float a; double b; a = .e+5; /* no digits before exponent */ b = .e-100; a = 0x7FE80; /* hex constant instead of digits */ b = 0x33.71; a = 0777E5; /* octal constant instead of digits */ b = 0043.71; a = 87t4.; /* invalid character in digit string */ b = 2@e-9; a = 39e*7; /* invalid sign character in exponent */ d = 54E/6; a = 98.E 8; /* space embedded within token */ b = 75.4 e+43; a = ..45; /* multiple decimal points */ b = 123.6.89; printf ("Failed Deviance Test 2.7.2.1\n"); } \ No newline at end of file +/* Deviance Test 2.7.2.1: Ensure misformed floating-point constants are */ +/* flagged as errors */ +main () + { + float a; + double b; + + a = .e+5; /* no digits before exponent */ + b = .e-100; + + a = 0x7FE80; /* hex constant instead of digits */ + b = 0x33.71; + + a = 0777E5; /* octal constant instead of digits */ + b = 0043.71; + + a = 87t4.; /* invalid character in digit string */ + b = 2@e-9; + + a = 39e*7; /* invalid sign character in exponent */ + d = 54E/6; + + a = 98.E 8; /* space embedded within token */ + b = 75.4 e+43; + + a = ..45; /* multiple decimal points */ + b = 123.6.89; + + printf ("Failed Deviance Test 2.7.2.1\n"); + } diff --git a/Tests/Deviance/D2.7.3.1.CC b/Tests/Deviance/D2.7.3.1.CC old mode 100755 new mode 100644 index d70d419..95f8719 --- a/Tests/Deviance/D2.7.3.1.CC +++ b/Tests/Deviance/D2.7.3.1.CC @@ -1 +1,14 @@ -/* Deviance Test 2.7.3.1: Ensure unterminated character constants are */ /* flagged as errors */ main () { char a; int j; a = 'a; j = 5 * 76; a = '\t; a = '\006; printf ("Failed Deviance Test 2.7.3.1\n"); } \ No newline at end of file +/* Deviance Test 2.7.3.1: Ensure unterminated character constants are */ +/* flagged as errors */ +main () + { + char a; + int j; + + a = 'a; + j = 5 * 76; + a = '\t; + a = '\006; + + printf ("Failed Deviance Test 2.7.3.1\n"); + } diff --git a/Tests/Deviance/D2.7.3.2.CC b/Tests/Deviance/D2.7.3.2.CC old mode 100755 new mode 100644 index 33842c5..5052597 --- a/Tests/Deviance/D2.7.3.2.CC +++ b/Tests/Deviance/D2.7.3.2.CC @@ -1 +1,15 @@ -/* Deviance Test 2.7.3.2: Ensure character constants contain only 1 charactr */ /* PAGE 20: DRAFT ANSI C PERMITS MULTIPLE CHAR CONSTANTS -- VALUE IS */ /* IMPLEMENTATION DEFINED */ main () { char a; a = 'ab'; a = '\t\n'; a = '\006HELP'; printf ("Failed Deviance Test 2.7.3.2\n"); } \ No newline at end of file +/* Deviance Test 2.7.3.2: Ensure character constants contain only 1 charactr */ + +/* PAGE 20: DRAFT ANSI C PERMITS MULTIPLE CHAR CONSTANTS -- VALUE IS */ +/* IMPLEMENTATION DEFINED */ + +main () + { + char a; + + a = 'ab'; + a = '\t\n'; + a = '\006HELP'; + + printf ("Failed Deviance Test 2.7.3.2\n"); + } diff --git a/Tests/Deviance/D2.7.3.3.CC b/Tests/Deviance/D2.7.3.3.CC old mode 100755 new mode 100644 index 593587a..a911d96 --- a/Tests/Deviance/D2.7.3.3.CC +++ b/Tests/Deviance/D2.7.3.3.CC @@ -1 +1,11 @@ -/* Deviance Test 2.7.3.3: Ensure character constants containing no */ /* characters are flagged as errors */ main () { char a, b; a = ''; b = ''; printf ("Failed Deviance Test 2.7.3.3\n"); } \ No newline at end of file +/* Deviance Test 2.7.3.3: Ensure character constants containing no */ +/* characters are flagged as errors */ +main () + { + char a, b; + + a = ''; + b = ''; + + printf ("Failed Deviance Test 2.7.3.3\n"); + } diff --git a/Tests/Deviance/D2.7.4.1.CC b/Tests/Deviance/D2.7.4.1.CC old mode 100755 new mode 100644 index d706f88..552cc95 --- a/Tests/Deviance/D2.7.4.1.CC +++ b/Tests/Deviance/D2.7.4.1.CC @@ -1 +1,11 @@ -/* Deviance Test 2.7.4.1: Ensure string constants with no closing " are */ /* flagged as errors */ main () { char string [] = "badly formed string ; strcpy (string, "another bad string ); printf ("Failed Deviance Test 2.7.4.1\n"); } \ No newline at end of file +/* Deviance Test 2.7.4.1: Ensure string constants with no closing " are */ +/* flagged as errors */ + +main () + { + char string [] = "badly formed string ; + + strcpy (string, "another bad string ); + + printf ("Failed Deviance Test 2.7.4.1\n"); + } diff --git a/Tests/Deviance/D2.7.4.4.CC b/Tests/Deviance/D2.7.4.4.CC old mode 100755 new mode 100644 index 4c512aa..c8a6b17 --- a/Tests/Deviance/D2.7.4.4.CC +++ b/Tests/Deviance/D2.7.4.4.CC @@ -1 +1,277 @@ -/* Deviance Test 2.7.3.5: Ensure functions cannot contain character string */ /* constants whose total length exceeds 8000 bytes */ main () { char s1 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"; char s2 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"; char s3 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ 0123456789"; printf ("Failed Deviance Test 2.7.3.5\n"); } int Dummy () { char s1 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"; char s2 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"; char s3 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ 0123456789"; return; } \ No newline at end of file +/* Deviance Test 2.7.3.5: Ensure functions cannot contain character string */ +/* constants whose total length exceeds 8000 bytes */ +main () + { + char s1 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"; + + char s2 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"; + + char s3 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +0123456789"; + + printf ("Failed Deviance Test 2.7.3.5\n"); + } + +int Dummy () + { + char s1 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"; + + char s2 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +abcdefghijklmnopqrstuvwxyz01234567890123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"; + + char s3 [] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\ +0123456789"; + + return; + } diff --git a/Tests/Deviance/D25.0.1.CC b/Tests/Deviance/D25.0.1.CC old mode 100755 new mode 100644 index 248ffb4..bcc4cc0 --- a/Tests/Deviance/D25.0.1.CC +++ b/Tests/Deviance/D25.0.1.CC @@ -1 +1,20 @@ -/* Deviance Test 25.0.1: Ensure illegal use mini-assembler is detected */ #include main () { int i, j; asm { 9__A: nop ; invalid label clcNoSuchOpcode ; illegal op code lda i * j - (j || i) ; invalid expression dupLab: dcl 0x888 ; duplicate labels dupLab: dcb 9 + 2 } printf ("Failed Deviance Test 25.0.1\n"); } \ No newline at end of file +/* Deviance Test 25.0.1: Ensure illegal use mini-assembler is detected */ + +#include + +main () + { + int i, j; + + asm + { + 9__A: nop ; invalid label + clcNoSuchOpcode ; illegal op code + lda i * j - (j || i) ; invalid expression + + dupLab: dcl 0x888 ; duplicate labels + dupLab: dcb 9 + 2 + } + + printf ("Failed Deviance Test 25.0.1\n"); + } diff --git a/Tests/Deviance/D25.0.2.CC b/Tests/Deviance/D25.0.2.CC old mode 100755 new mode 100644 index 3710021..db41c41 --- a/Tests/Deviance/D25.0.2.CC +++ b/Tests/Deviance/D25.0.2.CC @@ -1 +1,14 @@ -/* Deviance Test 25.0.2: Ensure branching to label + expression is detected */ #include main () { asm { bra Lbl1 + 0x8 Lbl1: nop } printf ("Failed Deviance Test 25.0.2\n"); } \ No newline at end of file +/* Deviance Test 25.0.2: Ensure branching to label + expression is detected */ + +#include + +main () + { + asm + { + bra Lbl1 + 0x8 + Lbl1: nop + } + + printf ("Failed Deviance Test 25.0.2\n"); + } diff --git a/Tests/Deviance/D3.3.1.1.CC b/Tests/Deviance/D3.3.1.1.CC old mode 100755 new mode 100644 index 8062f01..967fdd2 --- a/Tests/Deviance/D3.3.1.1.CC +++ b/Tests/Deviance/D3.3.1.1.CC @@ -1 +1,12 @@ -/* Deviance Test 3.3.1.1: Ensure invalid simple macro definitions are */ /* flagged as errors */ #DEfine BadDef 10 #DEFINE anotherBaddef 20 #define 7*8 name goes first! #define /* oops -- no name A-tall!!! */ main () { printf ("Failed Deviance Test 3.3.1.1\n"); } \ No newline at end of file +/* Deviance Test 3.3.1.1: Ensure invalid simple macro definitions are */ +/* flagged as errors */ + +#DEfine BadDef 10 +#DEFINE anotherBaddef 20 +#define 7*8 name goes first! +#define /* oops -- no name A-tall!!! */ + +main () + { + printf ("Failed Deviance Test 3.3.1.1\n"); + } diff --git a/Tests/Deviance/D3.3.10.1.CC b/Tests/Deviance/D3.3.10.1.CC old mode 100755 new mode 100644 index 4322a2d..0127353 --- a/Tests/Deviance/D3.3.10.1.CC +++ b/Tests/Deviance/D3.3.10.1.CC @@ -1 +1,13 @@ -/* Deviance Test 3.3.10.1: Ensure macro bodies contain only complete tokens */ #define BadExp1 $ #define BadExp2 @~ #define BadChar1 'a #define BadChar2 z' #define BadString1 "not a complete string #define BadString2 nor is this" main () { printf ("Failed Deviance Test 3.3.10.1\n"); } \ No newline at end of file +/* Deviance Test 3.3.10.1: Ensure macro bodies contain only complete tokens */ + +#define BadExp1 $ +#define BadExp2 @~ +#define BadChar1 'a +#define BadChar2 z' +#define BadString1 "not a complete string +#define BadString2 nor is this" + +main () + { + printf ("Failed Deviance Test 3.3.10.1\n"); + } diff --git a/Tests/Deviance/D3.3.2.1.CC b/Tests/Deviance/D3.3.2.1.CC old mode 100755 new mode 100644 index ea059e2..dde82ca --- a/Tests/Deviance/D3.3.2.1.CC +++ b/Tests/Deviance/D3.3.2.1.CC @@ -1 +1,25 @@ -/* Deviance Test 3.3.2.1: Ensure invalid macro definitions/invocations */ /* are flagged as errors */ #define sameName1(name1,name1) name1 * name1 #define missingRParen(x,y x / y #define sameName1(a,b) a | b #define argsSeparatedWithSpaces(e f) e - f #define badArgs(&y,->t) &y & ->t #define sameName2 88 - 9 #define oneGoodOne(z1,z2) z1 * z2 #define sameName2 " same name 2 " main () { int a, b, c; /* Invoke macro with too few parameters. */ a = 3; c = oneGoodOne (a); /* Invoke macro with too many parameters. */ a = oneGoodOne (a, b, c); printf ("Failed Deviance Test 3.3.2.1\n"); } \ No newline at end of file +/* Deviance Test 3.3.2.1: Ensure invalid macro definitions/invocations */ +/* are flagged as errors */ + +#define sameName1(name1,name1) name1 * name1 +#define missingRParen(x,y x / y +#define sameName1(a,b) a | b +#define argsSeparatedWithSpaces(e f) e - f +#define badArgs(&y,->t) &y & ->t +#define sameName2 88 - 9 +#define oneGoodOne(z1,z2) z1 * z2 +#define sameName2 " same name 2 " + +main () + { + int a, b, c; + + /* Invoke macro with too few parameters. */ + a = 3; + c = oneGoodOne (a); + + /* Invoke macro with too many parameters. */ + a = oneGoodOne (a, b, c); + + printf ("Failed Deviance Test 3.3.2.1\n"); + } diff --git a/Tests/Deviance/D3.3.3.1.CC b/Tests/Deviance/D3.3.3.1.CC old mode 100755 new mode 100644 index 4239f6c..759eafa --- a/Tests/Deviance/D3.3.3.1.CC +++ b/Tests/Deviance/D3.3.3.1.CC @@ -1 +1,14 @@ -/* Deviance Test 3.3.3.1: Ensure macros which expand into preprocessor */ /* commands are not parsed as preprocessor cmds */ #define includeFile #include #define badValue #define reallyBadValue 5 main () { includeFile badValue printf ("Failed Deviance Test 3.3.3.1\n"); } \ No newline at end of file +/* Deviance Test 3.3.3.1: Ensure macros which expand into preprocessor */ +/* commands are not parsed as preprocessor cmds */ + +#define includeFile #include +#define badValue #define reallyBadValue 5 + +main () + { + includeFile + badValue + printf ("Failed Deviance Test 3.3.3.1\n"); + } + + diff --git a/Tests/Deviance/D3.3.4.1.CC b/Tests/Deviance/D3.3.4.1.CC old mode 100755 new mode 100644 index 65a72eb..c01bf41 --- a/Tests/Deviance/D3.3.4.1.CC +++ b/Tests/Deviance/D3.3.4.1.CC @@ -1 +1,19 @@ -/* Deviance Test 3.3.4.1: Ensure cannot redefine or undefine ORCA/C's */ /* predefined macros */ #define __LINE__ 5 #define __FILE__ "d3.3.4.1.cc" #define __DATE__ "Mar 01 1989" #define __TIME__ "10:10:10" #define __STDC__ illegal redefinition of __STDC__ #undef __LINE__ #undef __FILE__ #undef __DATE__ #undef __TIME__ #undef __STDC__ main () { printf ("Failed Deviance Test 3.3.4.1\n"); } \ No newline at end of file +/* Deviance Test 3.3.4.1: Ensure cannot redefine or undefine ORCA/C's */ +/* predefined macros */ + +#define __LINE__ 5 +#define __FILE__ "d3.3.4.1.cc" +#define __DATE__ "Mar 01 1989" +#define __TIME__ "10:10:10" +#define __STDC__ illegal redefinition of __STDC__ + +#undef __LINE__ +#undef __FILE__ +#undef __DATE__ +#undef __TIME__ +#undef __STDC__ + +main () + { + printf ("Failed Deviance Test 3.3.4.1\n"); + } diff --git a/Tests/Deviance/D3.3.5.1.CC b/Tests/Deviance/D3.3.5.1.CC old mode 100755 new mode 100644 index b5b641d..66a96d7 --- a/Tests/Deviance/D3.3.5.1.CC +++ b/Tests/Deviance/D3.3.5.1.CC @@ -1 +1,20 @@ -/* Deviance Test 3.3.5.1: Check error generation for #undef commands */ #undef Name #define Name "hey" /* macro replacement is NOT done */ /* for #undef commands */ #define A "5" #define A "you" #undef A /* check "stack model" of redefining*/ /* macros -- not ANSI C */ #define cantUseIt 10 #undef cantUseIt main () { char a[] = A; int i; i = cantUseIt; printf ("Failed Deviance Test 3.3.5.1\n"); } \ No newline at end of file +/* Deviance Test 3.3.5.1: Check error generation for #undef commands */ + +#undef Name #define Name "hey" /* macro replacement is NOT done */ + /* for #undef commands */ + +#define A "5" +#define A "you" +#undef A /* check "stack model" of redefining*/ + /* macros -- not ANSI C */ +#define cantUseIt 10 +#undef cantUseIt + +main () + { + char a[] = A; + int i; + + i = cantUseIt; + printf ("Failed Deviance Test 3.3.5.1\n"); + } diff --git a/Tests/Deviance/D3.4.0.1.CC b/Tests/Deviance/D3.4.0.1.CC old mode 100755 new mode 100644 index bf9d597..a7c4414 --- a/Tests/Deviance/D3.4.0.1.CC +++ b/Tests/Deviance/D3.4.0.1.CC @@ -1 +1,19 @@ -/* Deviance Test 3.4.0.1: Ensure errors flagged for invalid #include commands */ #define BadMacro(x) #include #include "nosuchfile" main () { printf ("Failed Deviance Test 3.4.0.1\n"); } \ No newline at end of file +/* Deviance Test 3.4.0.1: Ensure errors flagged for invalid #include commands */ + +#define BadMacro(x) +#include +#include "nosuchfile" + +main () + { + printf ("Failed Deviance Test 3.4.0.1\n"); + } diff --git a/Tests/Deviance/D3.5.1.1.CC b/Tests/Deviance/D3.5.1.1.CC old mode 100755 new mode 100644 index 5fec567..542d228 --- a/Tests/Deviance/D3.5.1.1.CC +++ b/Tests/Deviance/D3.5.1.1.CC @@ -1 +1,38 @@ -/* Deviance Test 3.5.1.1: Check invalid #if, #else commands */ #if /* #if with no operand */ #else #endif #if a * b #define bad "this doesn't evaluate to a constant value" #else #endif #define macro1 1 #if 4 /* ensure improper nesting is detected */ #ifdef macro1 /* in "discarded" lines */ #ifndef noName #define TEN 10 #elif 5 #if defined(SIX) #ifdef EIGHTYONE #endif /* ifndef noName */ #endif /* ifdef macro1 */ #endif /* if 4 */ #if 1 /* ...as well as in non-discarded lines */ #ifdef macro1 #define SIXTEEN 16 #endif /* missing endif */ main () { printf ("Failed Deviance Test 3.5.1.1\n"); } \ No newline at end of file +/* Deviance Test 3.5.1.1: Check invalid #if, #else commands */ + +#if /* #if with no operand */ +#else +#endif + +#if a * b + #define bad "this doesn't evaluate to a constant value" +#else +#endif + +#define macro1 1 + +#if 4 /* ensure improper nesting is detected */ + #ifdef macro1 /* in "discarded" lines */ + #ifndef noName + #define TEN 10 +#elif 5 + #if defined(SIX) + #ifdef EIGHTYONE + + #endif /* ifndef noName */ + #endif /* ifdef macro1 */ +#endif /* if 4 */ + +#if 1 /* ...as well as in non-discarded lines */ + #ifdef macro1 + #define SIXTEEN 16 + #endif +/* missing endif */ + +main () + { + printf ("Failed Deviance Test 3.5.1.1\n"); + } + + + diff --git a/Tests/Deviance/D3.5.2.1.CC b/Tests/Deviance/D3.5.2.1.CC old mode 100755 new mode 100644 index c0b8e89..896a5d8 --- a/Tests/Deviance/D3.5.2.1.CC +++ b/Tests/Deviance/D3.5.2.1.CC @@ -1 +1,33 @@ -/* Deviance Test 3.5.2.1: Ensure illegal #elif commands are flagged as errors */ #if 0 #define WHO_CARES 0 #elif 0 #if 1 #define WHO_REALLY_CARES 1 #elif 2 #define ARE_YOU_KIDDING 2 #elif 3 #define WHATS_FOR_LUNCH 3 #else #define LETS_LEAVE_OFF "endif" #elif 1 #define CATS_R_US 'c' #if CATS_R_US #define DOGS_R_US 'd' #endif #else #define LETS_NOT_LEAVE_OFF "endif" #endif #if 0 #elif /* no expression */ #endif main () { printf ("Failed Deviance Test 3.5.2.1\n"); } \ No newline at end of file +/* Deviance Test 3.5.2.1: Ensure illegal #elif commands are flagged as errors */ + +#if 0 + #define WHO_CARES 0 +#elif 0 + #if 1 + #define WHO_REALLY_CARES 1 + #elif 2 + #define ARE_YOU_KIDDING 2 + #elif 3 + #define WHATS_FOR_LUNCH 3 + #else + #define LETS_LEAVE_OFF "endif" + +#elif 1 + #define CATS_R_US 'c' + #if CATS_R_US + #define DOGS_R_US 'd' + #endif + +#else + #define LETS_NOT_LEAVE_OFF "endif" + +#endif + +#if 0 +#elif /* no expression */ +#endif + +main () + { + printf ("Failed Deviance Test 3.5.2.1\n"); + } diff --git a/Tests/Deviance/D3.5.3.1.CC b/Tests/Deviance/D3.5.3.1.CC old mode 100755 new mode 100644 index 3fe0831..e3411eb --- a/Tests/Deviance/D3.5.3.1.CC +++ b/Tests/Deviance/D3.5.3.1.CC @@ -1 +1,19 @@ -/* Deviance Test 3.5.3.1: Ensure only macro names can be checked with the */ /* #ifdef and #ifndef commands */ main () { #ifdef a * 2 #endif #ifndef intPtr << 8 #endif #ifdef 76.5 - 8 #endif #ifndef #endif printf ("Failed Deviance Test 3.5.3.1\n"); } \ No newline at end of file +/* Deviance Test 3.5.3.1: Ensure only macro names can be checked with the */ +/* #ifdef and #ifndef commands */ + +main () + { + #ifdef a * 2 + #endif + + #ifndef intPtr << 8 + #endif + + #ifdef 76.5 - 8 + #endif + + #ifndef + #endif + + printf ("Failed Deviance Test 3.5.3.1\n"); + } diff --git a/Tests/Deviance/D3.5.5.1.CC b/Tests/Deviance/D3.5.5.1.CC old mode 100755 new mode 100644 index 8df166e..f9b3dd2 --- a/Tests/Deviance/D3.5.5.1.CC +++ b/Tests/Deviance/D3.5.5.1.CC @@ -1 +1,27 @@ -/* Deviance Test 3.5.5.1: Ensure invalid defined expressions are caught */ #define NAME "hey, you!" main () { if (defined NAME) /* defined can only appear in #if or #elif */ ; while (! (defined (NONAME)) ) ; do while (defined (NAME)); for (;defined (NAME);;) ; switch (defined (NAME)) ; #if defined /* missing name operand */ #elif defined #endif printf ("Failed Deviance Test 3.5.5.1\n"); } \ No newline at end of file +/* Deviance Test 3.5.5.1: Ensure invalid defined expressions are caught */ + +#define NAME "hey, you!" + +main () + { + if (defined NAME) /* defined can only appear in #if or #elif */ + ; + + while (! (defined (NONAME)) ) + ; + + do + while (defined (NAME)); + + for (;defined (NAME);;) + ; + + switch (defined (NAME)) + ; + + #if defined /* missing name operand */ + #elif defined + #endif + + printf ("Failed Deviance Test 3.5.5.1\n"); + } diff --git a/Tests/Deviance/D3401.DATA b/Tests/Deviance/D3401.DATA old mode 100755 new mode 100644 index a2b0246..a6c46d2 --- a/Tests/Deviance/D3401.DATA +++ b/Tests/Deviance/D3401.DATA @@ -1 +1,4 @@ -#define one 1 #define two 2 #undef one #undef two \ No newline at end of file +#define one 1 +#define two 2 +#undef one +#undef two diff --git a/Tests/Deviance/D4.2.1.1.CC b/Tests/Deviance/D4.2.1.1.CC old mode 100755 new mode 100644 index 04a251a..c5eb127 --- a/Tests/Deviance/D4.2.1.1.CC +++ b/Tests/Deviance/D4.2.1.1.CC @@ -1 +1,55 @@ -/* Deviance Test 4.2.1.1: Ensure invalid scoping of identifiers is detected */ main () { int i; struct ComplexNum c; struct ComplexNum { float real; float imag; }; struct ComplexNum d; union LongOrShort z; union LongOrShort { long longNum; int shortNum; }; union LongOrShort ls; enum flowers f; enum flowers { rose, iris, canation }; enum flowers g; intPtr k; /* types not defined yet */ typedef int *intPtr; d.noSuchField = 0.0; z.real = 5; g = dahlia; ls.noNumber = 10; goto Hell; /* no offense... */ ch = F1 (g, i); G1(); printf ("Failed Conformance Test 4.2.1.1\n"); } /****************************************************************************/ char F1 (int x, int y); { intPtr k; struct ComplexNum c, *d; union LongOrShort z; enum flowers f; i = 5; G1(); return (3); } /******************************************************************************/ void G1 (void); { x += y; return; } \ No newline at end of file +/* Deviance Test 4.2.1.1: Ensure invalid scoping of identifiers is detected */ + +main () + { + int i; + + struct ComplexNum c; + struct ComplexNum { float real; + float imag; }; + struct ComplexNum d; + + union LongOrShort z; + union LongOrShort { long longNum; + int shortNum; }; + union LongOrShort ls; + + enum flowers f; + enum flowers { rose, iris, canation }; + enum flowers g; + + intPtr k; /* types not defined yet */ + typedef int *intPtr; + + d.noSuchField = 0.0; + z.real = 5; + g = dahlia; + ls.noNumber = 10; + goto Hell; /* no offense... */ + ch = F1 (g, i); + G1(); + + printf ("Failed Conformance Test 4.2.1.1\n"); + } + +/****************************************************************************/ + +char F1 (int x, int y); + { + intPtr k; + struct ComplexNum c, *d; + union LongOrShort z; + enum flowers f; + + i = 5; + G1(); + return (3); + } + +/******************************************************************************/ + +void G1 (void); + { + x += y; + return; + } diff --git a/Tests/Deviance/D4.2.2.1.CC b/Tests/Deviance/D4.2.2.1.CC old mode 100755 new mode 100644 index 95d71ef..3ba7b50 --- a/Tests/Deviance/D4.2.2.1.CC +++ b/Tests/Deviance/D4.2.2.1.CC @@ -1 +1,61 @@ -/* Deviance Test 4.2.2.1: Ensure "hiding" identifiers with same scope is */ /* detected */ #define MAC1 1 /* macro name */ #define MAC1 8 typedef int *intPtr; /* user-defined type */ typedef float *intPtr; int a; /* variables */ double a; struct aRecord { int a; }; /* type tag names */ union aRecord { long one; int two; }; enum aRecord { rec1, rec2, rec3 }; struct repeats { int r1; /* component names */ char ch; float r1; }; union moreRepeats { float x; int y; double y; }; enum stillOthers { red, black, green, green }; double D2 (int x, int z); /* function names */ int D2 (char k); main () { #define MAC2 2 /* macro name */ #define MAC2 3 typedef char *chPtr; /* user-defined type */ typedef short *chPtr; int cantRedeclare; /* variables */ double cantRedeclare; struct shortRec { int a; }; /* type tag names */ union shortRec { long one; int two; }; enum shortRec { rec1, rec2, rec3 }; struct repeats { int r1; /* component names */ char ch; float r1; }; union moreRepeats { float x; int y; double y; }; enum stillOthers { red, black, green, green }; double f1 ( ); /* function names */ char f1 (char k); printf ("Failed Deviance Test 4.2.2.1\n"); } \ No newline at end of file +/* Deviance Test 4.2.2.1: Ensure "hiding" identifiers with same scope is */ +/* detected */ + +#define MAC1 1 /* macro name */ +#define MAC1 8 + +typedef int *intPtr; /* user-defined type */ +typedef float *intPtr; + +int a; /* variables */ +double a; + +struct aRecord { int a; }; /* type tag names */ +union aRecord { long one; + int two; }; +enum aRecord { rec1, rec2, rec3 }; + +struct repeats { int r1; /* component names */ + char ch; + float r1; }; + +union moreRepeats { float x; + int y; + double y; }; + +enum stillOthers { red, black, green, green }; + +double D2 (int x, int z); /* function names */ +int D2 (char k); + +main () + { + #define MAC2 2 /* macro name */ + #define MAC2 3 + + typedef char *chPtr; /* user-defined type */ + typedef short *chPtr; + + int cantRedeclare; /* variables */ + double cantRedeclare; + + struct shortRec { int a; }; /* type tag names */ + union shortRec { long one; + int two; }; + enum shortRec { rec1, rec2, rec3 }; + + struct repeats { int r1; /* component names */ + char ch; + float r1; }; + + union moreRepeats { float x; + int y; + double y; }; + + enum stillOthers { red, black, green, green }; + + double f1 ( ); /* function names */ + char f1 (char k); + + printf ("Failed Deviance Test 4.2.2.1\n"); + } diff --git a/Tests/Deviance/D4.2.3.1.CC b/Tests/Deviance/D4.2.3.1.CC old mode 100755 new mode 100644 index 4e594af..cd429ed --- a/Tests/Deviance/D4.2.3.1.CC +++ b/Tests/Deviance/D4.2.3.1.CC @@ -1 +1,21 @@ -/* Deviance Test 4.2.3.1: Ensure illegal forward references are detected */ main () { int i; aPtr x; /* forward reference to user-defined type */ struct complex y; /* forward reference to type tag */ struct complex { float real; float imag; }; i = F1 ('a'); /* forward reference to prototyped function */ j = 3 * 7; /* forward reference to variable */ v.one = 1; /* forward reference to component */ } /*****************************************************************************/ int F1 (char ch) { return (int) ch; } \ No newline at end of file +/* Deviance Test 4.2.3.1: Ensure illegal forward references are detected */ + +main () + { + int i; + aPtr x; /* forward reference to user-defined type */ + struct complex y; /* forward reference to type tag */ + struct complex { float real; + float imag; }; + + i = F1 ('a'); /* forward reference to prototyped function */ + j = 3 * 7; /* forward reference to variable */ + v.one = 1; /* forward reference to component */ + } + +/*****************************************************************************/ + +int F1 (char ch) + { + return (int) ch; + } diff --git a/Tests/Deviance/D4.2.5.1.CC b/Tests/Deviance/D4.2.5.1.CC old mode 100755 new mode 100644 index a079fb5..263fbc6 --- a/Tests/Deviance/D4.2.5.1.CC +++ b/Tests/Deviance/D4.2.5.1.CC @@ -1 +1,113 @@ -/* Deviance Test 4.2.5.1: Ensure duplicate declarations of the same */ /* identifiers in the same overloading class and */ /* sharing the same scope are detected */ /* Errors at top level */ #define macro1 "hey" /* preprocessor macro names */ #define macro1 8 struct s1 { int a; /* type tags */ int b; }; union s1 { int x; float y; }; enum s1 { a, b, c}; struct s2 { int r; /* component names */ char ch; float r; }; union u1 { int x; long x; }; double a [5]; /* all other names: variables, */ float *a; /* functions, typedef names, */ extern int F1 (void); /* enumeration constants */ int F1; typedef float real; float real; enum flowers { rose, iris, daisy, thistle }; int rose; int i; typedef int i; typedef double d1; typedef int d1; float F2 (int m); typedef int *F2; typedef float iris; double p; extern double p (void); extern void Daisy (void); typedef double doublePrec; extern float doublePrec (void); int L [10]; float one (int abc); typedef int *two; enum numbers { L, one, two }; /* Errors within a function */ main () { #define macro99 99 /* preprocessor macro names */ #define macro99 999 struct ll { char z; /* type tags */ int m; }; union ll { int x; float y; }; enum ll { lll, llll, lllll }; struct jy { float f0; /* component names */ char ch; float f0; }; union u1 { int x [3]; long x; }; double b [5]; /* all other names: variables, */ float *b; /* functions, typedef names, */ int Moth (int m0); /* enumeration constants */ int Moth; typedef extended ext; double ext; enum people { Joe, Mike, Patty, Jim }; char Jim; float floatOne; typedef float floatOne; typedef int *repeatIt; typedef int *repeatIt; extended Ext2 (extended ext2); typedef int *Ext2; typedef void Joe; long aLongNum; extern long aLongNum (long longLong); extern void Mike (int Patty); typedef unsigned UnSigned; extern int UnSigned (void); extended array [98]; double Func1 (double doubleDouble); typedef long *Long; enum objects { array, Long, Func1 }; printf ("Failed Deviance Test 4.2.5.1\n"); } /* Two functions with same name */ /****************************************************************************/ int Xx (void) { } /****************************************************************************/ double Xx (char a) { } \ No newline at end of file +/* Deviance Test 4.2.5.1: Ensure duplicate declarations of the same */ +/* identifiers in the same overloading class and */ +/* sharing the same scope are detected */ + +/* Errors at top level */ + +#define macro1 "hey" /* preprocessor macro names */ +#define macro1 8 + +struct s1 { int a; /* type tags */ + int b; }; +union s1 { int x; + float y; }; +enum s1 { a, b, c}; + +struct s2 { int r; /* component names */ + char ch; + float r; }; +union u1 { int x; + long x; }; + +double a [5]; /* all other names: variables, */ +float *a; /* functions, typedef names, */ +extern int F1 (void); /* enumeration constants */ +int F1; +typedef float real; +float real; +enum flowers { rose, iris, daisy, thistle }; +int rose; + +int i; +typedef int i; +typedef double d1; +typedef int d1; +float F2 (int m); +typedef int *F2; +typedef float iris; + +double p; +extern double p (void); +extern void Daisy (void); +typedef double doublePrec; +extern float doublePrec (void); + +int L [10]; +float one (int abc); +typedef int *two; +enum numbers { L, one, two }; + + +/* Errors within a function */ + +main () + { +#define macro99 99 /* preprocessor macro names */ +#define macro99 999 + + struct ll { char z; /* type tags */ + int m; }; + union ll { int x; + float y; }; + enum ll { lll, llll, lllll }; + + struct jy { float f0; /* component names */ + char ch; + float f0; }; + union u1 { int x [3]; + long x; }; + + double b [5]; /* all other names: variables, */ + float *b; /* functions, typedef names, */ + int Moth (int m0); /* enumeration constants */ + int Moth; + typedef extended ext; + double ext; + enum people { Joe, Mike, Patty, Jim }; + char Jim; + + float floatOne; + typedef float floatOne; + typedef int *repeatIt; + typedef int *repeatIt; + extended Ext2 (extended ext2); + typedef int *Ext2; + typedef void Joe; + + long aLongNum; + extern long aLongNum (long longLong); + extern void Mike (int Patty); + typedef unsigned UnSigned; + extern int UnSigned (void); + + extended array [98]; + double Func1 (double doubleDouble); + typedef long *Long; + enum objects { array, Long, Func1 }; + + printf ("Failed Deviance Test 4.2.5.1\n"); + } + +/* Two functions with same name */ + +/****************************************************************************/ + +int Xx (void) + { + } + +/****************************************************************************/ + +double Xx (char a) + { + } diff --git a/Tests/Deviance/D4.2.9.1.CC b/Tests/Deviance/D4.2.9.1.CC old mode 100755 new mode 100644 index bc5f1e7..367f2f0 --- a/Tests/Deviance/D4.2.9.1.CC +++ b/Tests/Deviance/D4.2.9.1.CC @@ -1 +1,30 @@ -/* Deviance Test 4.2.9.1: Ensure illegal scoping of extern variables is */ /* detected */ double X; main () { int i; if (i - 1) /* variable E should not be visible */ { /* in the else clause */ extern extended E; E = 5.7; } else { E = 1.0; } printf ("Failed Deviance Test 4.2.9.1\n"); } /*****************************************************************************/ double F1 (int x, int y) { int x; /* both declarations are in error -- */ float y; /* cannot redefine function parms */ } \ No newline at end of file +/* Deviance Test 4.2.9.1: Ensure illegal scoping of extern variables is */ +/* detected */ + +double X; + +main () + { + int i; + + if (i - 1) /* variable E should not be visible */ + { /* in the else clause */ + extern extended E; + E = 5.7; + } + else + { + E = 1.0; + } + + printf ("Failed Deviance Test 4.2.9.1\n"); + + } + +/*****************************************************************************/ + +double F1 (int x, int y) + { + int x; /* both declarations are in error -- */ + float y; /* cannot redefine function parms */ + } diff --git a/Tests/Deviance/D4.3.0.1.CC b/Tests/Deviance/D4.3.0.1.CC old mode 100755 new mode 100644 index 8c9f4dd..dbd013a --- a/Tests/Deviance/D4.3.0.1.CC +++ b/Tests/Deviance/D4.3.0.1.CC @@ -1 +1,47 @@ -/* Deviance Test 4.3.0.1: Ensure illegal storage class specifications are */ /* detected */ typedef double DblFunc (void); static int ReturnInt (long l); /* ReturnInt should be defined later in file */ auto int s; /* auto can only be used in head of block */ register short f; /* register can only be used with local */ /* variables and function parameters */ main () { int i; extern auto float y; /* only 1 storage class per declaration */ auto int register a; static typedef int *l; i = ReturnInt (55); /* call static function declared but not defined */ printf ("Failed Deviance Test 4.3.0.1\n"); } /****************************************************************************/ auto double F1 (int a) /* functions can only be extern or static */ { } /****************************************************************************/ register int Int (void) /* functions can only be extern or static */ { } /****************************************************************************/ DblFunc FF (void) /* cannot inherit type of function definition */ { /* from a typedef name */ } /****************************************************************************/ /* Function parameters can only have storage class register */ static long Long (auto int i, extern float f, static long m, typedef int ptr) { } \ No newline at end of file +/* Deviance Test 4.3.0.1: Ensure illegal storage class specifications are */ +/* detected */ + +typedef double DblFunc (void); + +static int ReturnInt (long l); /* ReturnInt should be defined later in file */ + +auto int s; /* auto can only be used in head of block */ +register short f; /* register can only be used with local */ + /* variables and function parameters */ +main () + { + int i; + + extern auto float y; /* only 1 storage class per declaration */ + auto int register a; + static typedef int *l; + + i = ReturnInt (55); /* call static function declared but not defined */ + printf ("Failed Deviance Test 4.3.0.1\n"); + } + +/****************************************************************************/ + +auto double F1 (int a) /* functions can only be extern or static */ + { + } + +/****************************************************************************/ + +register int Int (void) /* functions can only be extern or static */ + { + } + +/****************************************************************************/ + +DblFunc FF (void) /* cannot inherit type of function definition */ + { /* from a typedef name */ + } + +/****************************************************************************/ + +/* Function parameters can only have storage class register */ + +static long Long (auto int i, extern float f, static long m, typedef int ptr) + { + } diff --git a/Tests/Deviance/D4.4.1.1.CC b/Tests/Deviance/D4.4.1.1.CC old mode 100755 new mode 100644 index 710d91f..fa1f168 --- a/Tests/Deviance/D4.4.1.1.CC +++ b/Tests/Deviance/D4.4.1.1.CC @@ -1 +1,9 @@ -/* Deviance Test 4.4.1.1: Ensure declarations contain either a type specifier */ /* or storage class specifier or both */ main () { j; printf ("Failed Deviance Test 4.4.1.1\n"); } \ No newline at end of file +/* Deviance Test 4.4.1.1: Ensure declarations contain either a type specifier */ +/* or storage class specifier or both */ + +main () + { + j; + + printf ("Failed Deviance Test 4.4.1.1\n"); + } diff --git a/Tests/Deviance/D4.5.3.1.CC b/Tests/Deviance/D4.5.3.1.CC old mode 100755 new mode 100644 index cd8a981..8a04cbf --- a/Tests/Deviance/D4.5.3.1.CC +++ b/Tests/Deviance/D4.5.3.1.CC @@ -1 +1,40 @@ -/* Deviance Test 4.5.3.0.1: Ensure illegal array dimensions are detected */ static int x [0]; /* zero not allowed for dimension */ static float y [0] [5] [9]; static double k [3] [6] [2] [0]; static extended L [-3] [7]; /* negative dimension not allowed */ static long M [8] [2] []; /* must specify LAST n-1 dimensions */ /*****************************************************************************/ int F1 (float n [3] []) { return 0; } /*****************************************************************************/ long L1 (char ch1 [] []) { return 0; } /*****************************************************************************/ main () { char ch0 [0], ch2 [9] [0], ch3 [8] [7] [0] [6]; extended ext [2] [0] [9] [0]; int i [3] [] = { 1, 2 }; /* must specify LAST n-1 dimensions */ int k; float n [5] [3]; k = F1 (n [5] []); k = F1 (n); printf ("Failed Deviance Test 4.5.3.0.1\n"); } \ No newline at end of file +/* Deviance Test 4.5.3.0.1: Ensure illegal array dimensions are detected */ + +static int x [0]; /* zero not allowed for dimension */ +static float y [0] [5] [9]; +static double k [3] [6] [2] [0]; + +static extended L [-3] [7]; /* negative dimension not allowed */ +static long M [8] [2] []; /* must specify LAST n-1 dimensions */ + +/*****************************************************************************/ + +int F1 (float n [3] []) + { + return 0; + } + + +/*****************************************************************************/ + +long L1 (char ch1 [] []) + { + return 0; + } + +/*****************************************************************************/ + + +main () + { + char ch0 [0], ch2 [9] [0], ch3 [8] [7] [0] [6]; + extended ext [2] [0] [9] [0]; + int i [3] [] = { 1, 2 }; /* must specify LAST n-1 dimensions */ + int k; + float n [5] [3]; + + k = F1 (n [5] []); + k = F1 (n); + + printf ("Failed Deviance Test 4.5.3.0.1\n"); + } diff --git a/Tests/Deviance/D4.6.0.1.CC b/Tests/Deviance/D4.6.0.1.CC old mode 100755 new mode 100644 index 7d7cdef..e787ff2 --- a/Tests/Deviance/D4.6.0.1.CC +++ b/Tests/Deviance/D4.6.0.1.CC @@ -1 +1,13 @@ -/* Deviance Test 4.6.0.1: Ensure attempt to initialize variables of type */ /* void and function is detected */ static void v1 = 5; void v2 = 88; static int F1 (char ch) = 5; float F2 (double d3) = 5.6; main () { printf ("Failed Deviance Test 4.6.0.1\n"); } \ No newline at end of file +/* Deviance Test 4.6.0.1: Ensure attempt to initialize variables of type */ +/* void and function is detected */ + +static void v1 = 5; +void v2 = 88; + +static int F1 (char ch) = 5; +float F2 (double d3) = 5.6; + +main () + { + printf ("Failed Deviance Test 4.6.0.1\n"); + } diff --git a/Tests/Deviance/D4.6.0.2.CC b/Tests/Deviance/D4.6.0.2.CC old mode 100755 new mode 100644 index 82efd8a..9e3eade --- a/Tests/Deviance/D4.6.0.2.CC +++ b/Tests/Deviance/D4.6.0.2.CC @@ -1 +1,12 @@ -/* Deviance Test 4.6.0.2: Ensure attempt to initialize variables of type */ /* void and function is detected */ main () { void v3 = 99.0; register void v4 = 'a'; static char F3 (void) = 'm'; extended F4 (int x, int y) = 4.0E300; printf ("Failed Deviance Test 4.6.0.2\n"); } \ No newline at end of file +/* Deviance Test 4.6.0.2: Ensure attempt to initialize variables of type */ +/* void and function is detected */ + +main () + { + void v3 = 99.0; + register void v4 = 'a'; + static char F3 (void) = 'm'; + extended F4 (int x, int y) = 4.0E300; + + printf ("Failed Deviance Test 4.6.0.2\n"); + } diff --git a/Tests/Deviance/D4.6.1.1.CC b/Tests/Deviance/D4.6.1.1.CC old mode 100755 new mode 100644 index bb9a07b..628ff46 --- a/Tests/Deviance/D4.6.1.1.CC +++ b/Tests/Deviance/D4.6.1.1.CC @@ -1 +1,26 @@ -/* Deviance Test 4.6.1.1: Ensure non-constant initialization of static and */ /* extern variables is detected */ static int i = 5; static int j = i + 2; static long L1 = &i - j; static char ch1 = (char) L1 / i; static unsigned int u1 = 5 >> ch1; static unsigned long ul1 = (unsigned long) (u1); int ext1 = r7 * 7; long ext2 = (int) 98.7 - i; char ext3 = ch1 / ch1; unsigned int ext4 = ext3 || ext1; unsigned long ext5 = ul1; main () { static int m1 = m1 - 0; static long m2 = ch1; static char m3 = 'a' + 'b' - ext3; static unsigned int m4 = m2 + ul1; static unsigned long m5 = ext5; printf ("Failed Deviance Test 4.6.1.1\n"); } \ No newline at end of file +/* Deviance Test 4.6.1.1: Ensure non-constant initialization of static and */ +/* extern variables is detected */ + +static int i = 5; +static int j = i + 2; +static long L1 = &i - j; +static char ch1 = (char) L1 / i; +static unsigned int u1 = 5 >> ch1; +static unsigned long ul1 = (unsigned long) (u1); + +int ext1 = r7 * 7; +long ext2 = (int) 98.7 - i; +char ext3 = ch1 / ch1; +unsigned int ext4 = ext3 || ext1; +unsigned long ext5 = ul1; + +main () + { + static int m1 = m1 - 0; + static long m2 = ch1; + static char m3 = 'a' + 'b' - ext3; + static unsigned int m4 = m2 + ul1; + static unsigned long m5 = ext5; + + printf ("Failed Deviance Test 4.6.1.1\n"); + } diff --git a/Tests/Deviance/D4.6.2.1.CC b/Tests/Deviance/D4.6.2.1.CC old mode 100755 new mode 100644 index 4afaa68..6d7cfeb --- a/Tests/Deviance/D4.6.2.1.CC +++ b/Tests/Deviance/D4.6.2.1.CC @@ -1 +1,25 @@ -/* Deviance Test 4.6.2.1: Ensure non-constant floating-point initializers */ /* for static and extern variables is detected */ static float f0 = 1.0; static float f1 = f0 * 2.0; static double d1 = f0 + f1; static extended e1 = f0 / 4.6; float f2 = (float) e1; double d2 = f0--; extended e2 = f0 - f1; main () { float f00 = 5.6 * f0; static float f3 = f00; static double d3 = 3.5 / f3; static extended e3 = f00; extern float f4 = 8.1; /* extern + initializers are not allowed */ extern double d4 = f0; extern extended e4 = (extended) 5.0; printf ("Failed Deviance Test 4.6.2.1\n"); } \ No newline at end of file +/* Deviance Test 4.6.2.1: Ensure non-constant floating-point initializers */ +/* for static and extern variables is detected */ + +static float f0 = 1.0; +static float f1 = f0 * 2.0; +static double d1 = f0 + f1; +static extended e1 = f0 / 4.6; + +float f2 = (float) e1; +double d2 = f0--; +extended e2 = f0 - f1; + +main () + { + float f00 = 5.6 * f0; + static float f3 = f00; + static double d3 = 3.5 / f3; + static extended e3 = f00; + + extern float f4 = 8.1; /* extern + initializers are not allowed */ + extern double d4 = f0; + extern extended e4 = (extended) 5.0; + + printf ("Failed Deviance Test 4.6.2.1\n"); + } diff --git a/Tests/Deviance/D4.6.3.1.CC b/Tests/Deviance/D4.6.3.1.CC old mode 100755 new mode 100644 index 51811f3..f1be800 --- a/Tests/Deviance/D4.6.3.1.CC +++ b/Tests/Deviance/D4.6.3.1.CC @@ -1 +1,15 @@ -/* Deviance Test 4.6.3.1: Ensure illegal pointer initializations are detected */ main () { int i2 [5], i1 = 5; static int i1Ptr = i2; /* can't take address of local array */ extern int i2Ptr = &i2 [3]; register float f1 [10]; /* no such thing as register arrays */ float *fptr = (float) (i1 - 1.0); /* expression is not integral constant */ printf ("Failed Deviance Test 4.6.3.1\n"); } \ No newline at end of file +/* Deviance Test 4.6.3.1: Ensure illegal pointer initializations are detected */ + +main () + { + int i2 [5], i1 = 5; + + static int i1Ptr = i2; /* can't take address of local array */ + extern int i2Ptr = &i2 [3]; + + register float f1 [10]; /* no such thing as register arrays */ + + float *fptr = (float) (i1 - 1.0); /* expression is not integral constant */ + + printf ("Failed Deviance Test 4.6.3.1\n"); + } diff --git a/Tests/Deviance/D4.6.4.1.CC b/Tests/Deviance/D4.6.4.1.CC old mode 100755 new mode 100644 index ec4c367..6cc05e9 --- a/Tests/Deviance/D4.6.4.1.CC +++ b/Tests/Deviance/D4.6.4.1.CC @@ -1 +1,35 @@ -/* Deviance Test 4.6.4.1: Ensure illegal array initializations are detected */ static int i1 [3] = { 1, 2, 3, 4 }; /* too many elements */ static long L1 [4] = { 1, 2, 3, 4, 5, 5, 7 }; static double d1 [3] = { 1.0, 2.0, 3.0, 4.0 }; static struct S1 { int i; float f; } s1 [2] = { {2, 1.0}, {3, 2.0}, {4, 3.0}, {5, 4.0} }; char ch1 [2] = "oh, what a beautiful baby!!"; comp c1 [3] = { 1, 2, 3, 4, 5, 6 }; float f1 [1] = { 0, 0, 0, 0, 0, 0 }; int i2 = 3; float f2 = 3.0; /* non-constant values */ static short i3 [] = { i2 * 2, i2 / 2 }; static double d3 [3] = { 3.0, (double) f2 }; static struct S1 s2 [2] = { i3 [0], f2 }; unsigned int i4 [2] = { i3 [1], i2 }; unsigned long L2 [4] = { (unsigned long) f2 + 3 }; main () { int i5 [7] = { 14, 15, 16, 17, 18, 19, 20, 21 }; /* too many elements */ float f5 [3] = { 1.1, 1.1, 1.1, 1.1, 4.4 }; char ch [5] = "abcde"; /* no room for ending */ /* null */ double d5 [3] = { (double) (i2 * 2.3) }; /* non-constant values */ struct S1 s5 [2] = { i2 - (i2 + 2), f2 / 7.2 }; printf ("Failed Deviance Test 4.6.4.1\n"); } \ No newline at end of file +/* Deviance Test 4.6.4.1: Ensure illegal array initializations are detected */ + +static int i1 [3] = { 1, 2, 3, 4 }; /* too many elements */ +static long L1 [4] = { 1, 2, 3, 4, 5, 5, 7 }; +static double d1 [3] = { 1.0, 2.0, 3.0, 4.0 }; +static struct S1 { int i; float f; } s1 [2] = { {2, 1.0}, {3, 2.0}, + {4, 3.0}, {5, 4.0} }; + +char ch1 [2] = "oh, what a beautiful baby!!"; +comp c1 [3] = { 1, 2, 3, 4, 5, 6 }; +float f1 [1] = { 0, 0, 0, 0, 0, 0 }; + +int i2 = 3; +float f2 = 3.0; + + /* non-constant values */ +static short i3 [] = { i2 * 2, i2 / 2 }; +static double d3 [3] = { 3.0, (double) f2 }; +static struct S1 s2 [2] = { i3 [0], f2 }; + +unsigned int i4 [2] = { i3 [1], i2 }; +unsigned long L2 [4] = { (unsigned long) f2 + 3 }; + +main () + { + int i5 [7] = { 14, 15, 16, 17, 18, 19, 20, 21 }; /* too many elements */ + float f5 [3] = { 1.1, 1.1, 1.1, 1.1, 4.4 }; + char ch [5] = "abcde"; /* no room for ending */ + /* null */ + + double d5 [3] = { (double) (i2 * 2.3) }; /* non-constant values */ + struct S1 s5 [2] = { i2 - (i2 + 2), f2 / 7.2 }; + + printf ("Failed Deviance Test 4.6.4.1\n"); + } diff --git a/Tests/Deviance/D4.6.5.1.CC b/Tests/Deviance/D4.6.5.1.CC old mode 100755 new mode 100644 index 0cce76f..5a360b1 --- a/Tests/Deviance/D4.6.5.1.CC +++ b/Tests/Deviance/D4.6.5.1.CC @@ -1 +1,16 @@ -/* Deviance Test 4.6.5.1: Ensure illegal enumeration initializations are */ /* detected */ static struct S { int i; float f; } s = { 2, 4.5 }; static char ch [] = "hey!"; static enum E1 { a, b, c } e1 = s; enum E2 { d, e, f } e2 = &ch; main () { enum E3 { g, h } e3 = &s; register enum E4 { i, j, k } e4 = ch; printf ("Failed Deviance Test 4.6.5.1\n"); } \ No newline at end of file +/* Deviance Test 4.6.5.1: Ensure illegal enumeration initializations are */ +/* detected */ + +static struct S { int i; float f; } s = { 2, 4.5 }; +static char ch [] = "hey!"; + +static enum E1 { a, b, c } e1 = s; +enum E2 { d, e, f } e2 = &ch; + +main () + { + enum E3 { g, h } e3 = &s; + register enum E4 { i, j, k } e4 = ch; + + printf ("Failed Deviance Test 4.6.5.1\n"); + } diff --git a/Tests/Deviance/D4.6.6.1.CC b/Tests/Deviance/D4.6.6.1.CC old mode 100755 new mode 100644 index 26b01e1..de28804 --- a/Tests/Deviance/D4.6.6.1.CC +++ b/Tests/Deviance/D4.6.6.1.CC @@ -1 +1,27 @@ -/* Deviance Test 4.6.6.1: Ensure illegal initialization of structures is */ /* detected */ struct S1 { int i; float f; } s1 = { 3, 8.0, 'a' }; /* too many values */ struct S1 s2 = 2, 7.6; /* can't omit outer braces */ static struct S1 s3 = { 5, 5.0, 6.0, 77.77 }; /* too many values */ static struct S1 s4 = 0, 0.0; /* can't omit outer braces */ main () { int i = 8; float f = 3.5; auto struct S1 s1 = { i * 2, f }; /* can only use constants */ register struct S1 s2 = { s1.i, f / 3.0 }; auto struct S1 s3 = { 4, 4, 5, }; /* too many values */ register struct S1 s4 = { 3, 2.0, 5.0E10 }; auto struct S1 s5 = 6, 17.9; /* can't omit outer braces */ register struct S1 s6 = 77, 90.0; printf ("Failed Deviance Test 4.6.6.1\n"); } \ No newline at end of file +/* Deviance Test 4.6.6.1: Ensure illegal initialization of structures is */ +/* detected */ + +struct S1 { int i; + float f; } s1 = { 3, 8.0, 'a' }; /* too many values */ + +struct S1 s2 = 2, 7.6; /* can't omit outer braces */ + +static struct S1 s3 = { 5, 5.0, 6.0, 77.77 }; /* too many values */ +static struct S1 s4 = 0, 0.0; /* can't omit outer braces */ + +main () + { + int i = 8; + float f = 3.5; + + auto struct S1 s1 = { i * 2, f }; /* can only use constants */ + register struct S1 s2 = { s1.i, f / 3.0 }; + + auto struct S1 s3 = { 4, 4, 5, }; /* too many values */ + register struct S1 s4 = { 3, 2.0, 5.0E10 }; + + auto struct S1 s5 = 6, 17.9; /* can't omit outer braces */ + register struct S1 s6 = 77, 90.0; + + printf ("Failed Deviance Test 4.6.6.1\n"); + } diff --git a/Tests/Deviance/D4.6.7.1.CC b/Tests/Deviance/D4.6.7.1.CC old mode 100755 new mode 100644 index 3c1cf3d..af841ee --- a/Tests/Deviance/D4.6.7.1.CC +++ b/Tests/Deviance/D4.6.7.1.CC @@ -1 +1,23 @@ -/* Deviance Test 4.6.7.1: Ensure illegal initialization of unions is detected */ union U1 { int i; long L; char ch [5]; }; union U1 u1 = "hey, you!"; /* init. must be valid for only 1st type */ static union U1 u2 = &u1.i; union U1 u3 = { 5, 6, "a", 2, 3 }; /* too many values */ static union U1 u4 = { 2, 4, 6.0 }; main () { int i = 5; auto union U1 u5 = { "abb" }; /* init. must be valid for only 1st type */ static union U1 u6 = { &i }; union U1 u7 = { 5, 7, 8.8 }; /* too many values */ printf ("Failed Deviance Test 4.6.7.1\n"); } \ No newline at end of file +/* Deviance Test 4.6.7.1: Ensure illegal initialization of unions is detected */ + +union U1 { int i; + long L; + char ch [5]; }; + +union U1 u1 = "hey, you!"; /* init. must be valid for only 1st type */ +static union U1 u2 = &u1.i; + +union U1 u3 = { 5, 6, "a", 2, 3 }; /* too many values */ +static union U1 u4 = { 2, 4, 6.0 }; + + +main () + { + int i = 5; + + auto union U1 u5 = { "abb" }; /* init. must be valid for only 1st type */ + static union U1 u6 = { &i }; + union U1 u7 = { 5, 7, 8.8 }; /* too many values */ + + printf ("Failed Deviance Test 4.6.7.1\n"); + } diff --git a/Tests/Deviance/D4.6.8.1.CC b/Tests/Deviance/D4.6.8.1.CC old mode 100755 new mode 100644 index 34e2a6d..915bd16 --- a/Tests/Deviance/D4.6.8.1.CC +++ b/Tests/Deviance/D4.6.8.1.CC @@ -1 +1,19 @@ -/* Deviance Test 4.6.8.1: Ensure improper dropping of initializer braces */ /* is detected */ static int i1 [3] = 1, 2, 3; /* can't drop outer braces for arrays */ float f1 [2] = 3.1, 2.3; /* and structures */ struct S1 { char ch; float f; }; static struct S1 s1 = 'a', 3.3; struct S1 s2 = 'b', 4.4; struct S2 { comp c1 [3]; long L1 [2]; char ch; }; main () { unsigned int ui1 [4] = 2, 3; /* can't drop outer braces for arrays */ struct S1 s3 = 'a', 3.3; /* and structures */ printf ("Failed Deviance Test 4.6.8.1\n"); } \ No newline at end of file +/* Deviance Test 4.6.8.1: Ensure improper dropping of initializer braces */ +/* is detected */ + +static int i1 [3] = 1, 2, 3; /* can't drop outer braces for arrays */ +float f1 [2] = 3.1, 2.3; /* and structures */ + +struct S1 { char ch; float f; }; +static struct S1 s1 = 'a', 3.3; +struct S1 s2 = 'b', 4.4; + +struct S2 { comp c1 [3]; long L1 [2]; char ch; }; + +main () + { + unsigned int ui1 [4] = 2, 3; /* can't drop outer braces for arrays */ + struct S1 s3 = 'a', 3.3; /* and structures */ + + printf ("Failed Deviance Test 4.6.8.1\n"); + } diff --git a/Tests/Deviance/D7.1.1.1.CC b/Tests/Deviance/D7.1.1.1.CC old mode 100755 new mode 100644 index 9ddb6d7..e72cc20 --- a/Tests/Deviance/D7.1.1.1.CC +++ b/Tests/Deviance/D7.1.1.1.CC @@ -1 +1,25 @@ -/* Deviance Test 7.1.1.1: Ensure illegal use of non-lvalues is detected */ main () { int i [10]; /* names of arrays, functions, enum */ enum E {a, b, c}; /* constants, & void variables */ void v; /* are not lvalues */ static float F (void); float (*fptr) (); i = 5; /* cannot apply &, ++, --, or assign */ a++; /* operators to non-lvalues */ v = F (); fptr = &(F--); --i; ++b; --c; printf ("Failed Deviance Test 7.1.1.1\n"); } static float F (void) { return 1.0; } \ No newline at end of file +/* Deviance Test 7.1.1.1: Ensure illegal use of non-lvalues is detected */ + +main () + { + int i [10]; /* names of arrays, functions, enum */ + enum E {a, b, c}; /* constants, & void variables */ + void v; /* are not lvalues */ + static float F (void); + float (*fptr) (); + + i = 5; /* cannot apply &, ++, --, or assign */ + a++; /* operators to non-lvalues */ + v = F (); + fptr = &(F--); + --i; + ++b; + --c; + + printf ("Failed Deviance Test 7.1.1.1\n"); + } + +static float F (void) + { + return 1.0; + } diff --git a/Tests/Deviance/D7.5.4.1.CC b/Tests/Deviance/D7.5.4.1.CC old mode 100755 new mode 100644 index bda9909..2a4e945 --- a/Tests/Deviance/D7.5.4.1.CC +++ b/Tests/Deviance/D7.5.4.1.CC @@ -1 +1,23 @@ -/* Deviance Test 7.5.4.1: Ensure illegal use of bitwise negation is detected */ #include main () { float f = 1.1; /* can only apply ~ operator to integers */ double d = 2.2; extended e = 3.3; static float F (void); f = ~f; d = ~d; e = ~e; F = ~F (); printf ("Failed Deviance Test 7.5.4.1\n"); } static float F (void) { return 1.0; } \ No newline at end of file +/* Deviance Test 7.5.4.1: Ensure illegal use of bitwise negation is detected */ + +#include + +main () + { + float f = 1.1; /* can only apply ~ operator to integers */ + double d = 2.2; + extended e = 3.3; + static float F (void); + + f = ~f; + d = ~d; + e = ~e; + F = ~F (); + + printf ("Failed Deviance Test 7.5.4.1\n"); + } + +static float F (void) + { + return 1.0; + } diff --git a/Tests/Deviance/D7.6.1.1.CC b/Tests/Deviance/D7.6.1.1.CC old mode 100755 new mode 100644 index 0638e47..6015d48 --- a/Tests/Deviance/D7.6.1.1.CC +++ b/Tests/Deviance/D7.6.1.1.CC @@ -1 +1,23 @@ -/* Deviance Test 7.6.1.1: Ensure illegal use of remainder op is detected */ #include main () { float f = 1.1; /* can only apply % operator to integers */ double d = 2.2; extended e = 3.3; static float F (void); f = f % 1.0; d = d % 5; e = e % e; f = 88 % F (); printf ("Failed Deviance Test 7.6.1.1\n"); } static float F (void) { return 1.0; } \ No newline at end of file +/* Deviance Test 7.6.1.1: Ensure illegal use of remainder op is detected */ + +#include + +main () + { + float f = 1.1; /* can only apply % operator to integers */ + double d = 2.2; + extended e = 3.3; + static float F (void); + + f = f % 1.0; + d = d % 5; + e = e % e; + f = 88 % F (); + + printf ("Failed Deviance Test 7.6.1.1\n"); + } + +static float F (void) + { + return 1.0; + } diff --git a/Tests/Deviance/D7.6.1.2.CC b/Tests/Deviance/D7.6.1.2.CC old mode 100755 new mode 100644 index 4541e31..f8073e0 --- a/Tests/Deviance/D7.6.1.2.CC +++ b/Tests/Deviance/D7.6.1.2.CC @@ -1 +1,13 @@ -/* Deviance Test 7.6.1.2: Check for illegal / in a constant expression */ #include void main(void) { int i; i = 4/0; printf("Failed Deviance Test 7.6.1.2\n"); } \ No newline at end of file +/* Deviance Test 7.6.1.2: Check for illegal / in a constant expression */ + +#include + +void main(void) + +{ +int i; + +i = 4/0; + +printf("Failed Deviance Test 7.6.1.2\n"); +} diff --git a/Tests/Deviance/D7.6.1.3.CC b/Tests/Deviance/D7.6.1.3.CC old mode 100755 new mode 100644 index 8c80ffb..1cf342e --- a/Tests/Deviance/D7.6.1.3.CC +++ b/Tests/Deviance/D7.6.1.3.CC @@ -1 +1,13 @@ -/* Deviance Test 7.6.1.3: Check for illegal % in a constant expression */ #include void main(void) { int i; i = 4%(-1); printf("Failed Deviance Test 7.6.1.3\n"); } \ No newline at end of file +/* Deviance Test 7.6.1.3: Check for illegal % in a constant expression */ + +#include + +void main(void) + +{ +int i; + +i = 4%(-1); + +printf("Failed Deviance Test 7.6.1.3\n"); +} diff --git a/Tests/Deviance/D7.6.1.4.CC b/Tests/Deviance/D7.6.1.4.CC old mode 100755 new mode 100644 index a5770c7..5a6599f --- a/Tests/Deviance/D7.6.1.4.CC +++ b/Tests/Deviance/D7.6.1.4.CC @@ -1 +1,13 @@ -/* Deviance Test 7.6.1.4: Check for illegal float / in a constant expression */ #include void main(void) { float f; f = 4.0 / 0.0; printf("Failed Deviance Test 7.6.1.4\n"); } \ No newline at end of file +/* Deviance Test 7.6.1.4: Check for illegal float / in a constant expression */ + +#include + +void main(void) + +{ +float f; + +f = 4.0 / 0.0; + +printf("Failed Deviance Test 7.6.1.4\n"); +} diff --git a/Tests/Deviance/D7.6.3.1.CC b/Tests/Deviance/D7.6.3.1.CC old mode 100755 new mode 100644 index 304d906..1fdb144 --- a/Tests/Deviance/D7.6.3.1.CC +++ b/Tests/Deviance/D7.6.3.1.CC @@ -1 +1,28 @@ -/* Deviance Test 7.6.3.1: Ensure illegal use of shift operators is detected */ #include main () { float f = 1.1; /* can only apply >>, << operators to integers */ double d = 2.2; extended e = 3.3; static float F (void); f = f >> 1.0; d = d >> 5; e = e >> e; f = 88 >> F (); f = f << 1.0; d = d << 5; e = e << e; f = 88 << F (); printf ("Failed Deviance Test 7.6.3.1\n"); } static float F (void) { return 1.0; } \ No newline at end of file +/* Deviance Test 7.6.3.1: Ensure illegal use of shift operators is detected */ + +#include + +main () + { + float f = 1.1; /* can only apply >>, << operators to integers */ + double d = 2.2; + extended e = 3.3; + static float F (void); + + f = f >> 1.0; + d = d >> 5; + e = e >> e; + f = 88 >> F (); + + f = f << 1.0; + d = d << 5; + e = e << e; + f = 88 << F (); + + printf ("Failed Deviance Test 7.6.3.1\n"); + } + +static float F (void) + { + return 1.0; + } diff --git a/Tests/Deviance/D7.6.4.1.CC b/Tests/Deviance/D7.6.4.1.CC old mode 100755 new mode 100644 index 0e60682..5f737ec --- a/Tests/Deviance/D7.6.4.1.CC +++ b/Tests/Deviance/D7.6.4.1.CC @@ -1 +1,20 @@ -/* Deviance Test 7.6.4.1: Ensure illegal use of relational operators is */ /* detected */ #include main () { float f = 1.1, *fptr = &f; /* can only compare pointers with pointers */ char ch = 'a', *chptr = &ch; int i; i = (fptr <= 0xabcd); i = (i < fptr); i = chptr >= ch; i = 'Z' > chptr; i = fptr < 5.5; printf ("Failed Deviance Test 7.6.4.1\n"); } \ No newline at end of file +/* Deviance Test 7.6.4.1: Ensure illegal use of relational operators is */ +/* detected */ + +#include + +main () + { + float f = 1.1, *fptr = &f; /* can only compare pointers with pointers */ + char ch = 'a', *chptr = &ch; + + int i; + + i = (fptr <= 0xabcd); + i = (i < fptr); + i = chptr >= ch; + i = 'Z' > chptr; + i = fptr < 5.5; + + printf ("Failed Deviance Test 7.6.4.1\n"); + } diff --git a/Tests/Deviance/D7.6.6.1.CC b/Tests/Deviance/D7.6.6.1.CC old mode 100755 new mode 100644 index 19d9115..aa162fd --- a/Tests/Deviance/D7.6.6.1.CC +++ b/Tests/Deviance/D7.6.6.1.CC @@ -1 +1,23 @@ -/* Deviance Test 7.6.6.1: Ensure illegal use of bitwise AND is detected */ #include main () { float f = 1.1; /* can only apply & operator to integers */ double d = 2.2; extended e = 3.3; static float F (void); f = f & 1.0; d = d & 5; e = e & e; f = 88 & F (); printf ("Failed Deviance Test 7.6.6.1\n"); } static float F (void) { return 1.0; } \ No newline at end of file +/* Deviance Test 7.6.6.1: Ensure illegal use of bitwise AND is detected */ + +#include + +main () + { + float f = 1.1; /* can only apply & operator to integers */ + double d = 2.2; + extended e = 3.3; + static float F (void); + + f = f & 1.0; + d = d & 5; + e = e & e; + f = 88 & F (); + + printf ("Failed Deviance Test 7.6.6.1\n"); + } + +static float F (void) + { + return 1.0; + } diff --git a/Tests/Deviance/D7.6.7.1.CC b/Tests/Deviance/D7.6.7.1.CC old mode 100755 new mode 100644 index d3e43f8..6a3ad1a --- a/Tests/Deviance/D7.6.7.1.CC +++ b/Tests/Deviance/D7.6.7.1.CC @@ -1 +1,23 @@ -/* Deviance Test 7.6.7.1: Ensure illegal use of bitwise XOR is detected */ #include main () { float f = 1.1; /* can only apply ^ operator to integers */ double d = 2.2; extended e = 3.3; static float F (void); f = f ^ 1.0; d = d ^ 5; e = e ^ e; f = 88 ^ F (); printf ("Failed Deviance Test 7.6.7.1\n"); } static float F (void) { return 1.0; } \ No newline at end of file +/* Deviance Test 7.6.7.1: Ensure illegal use of bitwise XOR is detected */ + +#include + +main () + { + float f = 1.1; /* can only apply ^ operator to integers */ + double d = 2.2; + extended e = 3.3; + static float F (void); + + f = f ^ 1.0; + d = d ^ 5; + e = e ^ e; + f = 88 ^ F (); + + printf ("Failed Deviance Test 7.6.7.1\n"); + } + +static float F (void) + { + return 1.0; + } diff --git a/Tests/Deviance/D7.6.8.1.CC b/Tests/Deviance/D7.6.8.1.CC old mode 100755 new mode 100644 index bd19c4a..0727065 --- a/Tests/Deviance/D7.6.8.1.CC +++ b/Tests/Deviance/D7.6.8.1.CC @@ -1 +1,23 @@ -/* Deviance Test 7.6.8.1: Ensure illegal use of bitwise OR is detected */ #include main () { float f = 1.1; /* can only apply | operator to integers */ double d = 2.2; extended e = 3.3; static float F (void); f = f | 1.0; d = d | 5; e = e | e; f = 88 | F (); printf ("Failed Deviance Test 7.6.8.1\n"); } static float F (void) { return 1.0; } \ No newline at end of file +/* Deviance Test 7.6.8.1: Ensure illegal use of bitwise OR is detected */ + +#include + +main () + { + float f = 1.1; /* can only apply | operator to integers */ + double d = 2.2; + extended e = 3.3; + static float F (void); + + f = f | 1.0; + d = d | 5; + e = e | e; + f = 88 | F (); + + printf ("Failed Deviance Test 7.6.8.1\n"); + } + +static float F (void) + { + return 1.0; + } diff --git a/Tests/Deviance/D8.7.0.1.CC b/Tests/Deviance/D8.7.0.1.CC old mode 100755 new mode 100644 index 02941bf..8f63bf2 --- a/Tests/Deviance/D8.7.0.1.CC +++ b/Tests/Deviance/D8.7.0.1.CC @@ -1 +1,51 @@ -/* Deviance Test 8.7.0.1: Ensure illegal switch statements are detected */ #include main () { int i = 3, j = 4; unsigned short s = 7; switch 3 /* omit switch expr's () */ default: ; switch (i) /* non-constant case expressions */ { case i * j: break; case j: break; } switch (j) /* omit case expression */ case: break; switch (i) /* non-unique case expressions */ { case 3: break; case 4: break; default: break; case 3: break; } switch (s) /* case expression of different */ { /* type than switch expression */ case -3: break; case -88: break; } switch (i) /* only 1 default label allowed */ { case 1: break; default: break; case 2: default: break; } case 22: i = 3; /* case label only allowed in switch body */ default: j = 90; /* default label only allowed in switch */ switch (76.443); /* switch expr can't be floating point typ*/ switch (&j + 1); /* switch expr can't be pointer type */ printf ("Failed Deviance Test 8.7.0.1\n"); } \ No newline at end of file +/* Deviance Test 8.7.0.1: Ensure illegal switch statements are detected */ + +#include + +main () + { + int i = 3, j = 4; + unsigned short s = 7; + + switch 3 /* omit switch expr's () */ + default: ; + + switch (i) /* non-constant case expressions */ + { + case i * j: break; + case j: break; + } + + switch (j) /* omit case expression */ + case: break; + + switch (i) /* non-unique case expressions */ + { + case 3: break; + case 4: break; + default: break; + case 3: break; + } + + switch (s) /* case expression of different */ + { /* type than switch expression */ + case -3: break; + case -88: break; + } + + switch (i) /* only 1 default label allowed */ + { + case 1: break; + default: break; + case 2: default: + break; + } + + case 22: i = 3; /* case label only allowed in switch body */ + default: j = 90; /* default label only allowed in switch */ + + switch (76.443); /* switch expr can't be floating point typ*/ + switch (&j + 1); /* switch expr can't be pointer type */ + + printf ("Failed Deviance Test 8.7.0.1\n"); + } diff --git a/Tests/Deviance/D8.8.0.1.CC b/Tests/Deviance/D8.8.0.1.CC old mode 100755 new mode 100644 index 0783b19..d51c5c4 --- a/Tests/Deviance/D8.8.0.1.CC +++ b/Tests/Deviance/D8.8.0.1.CC @@ -1 +1,17 @@ -/* Deviance Test 8.8.0.1: Ensure illegal break and continue statements are */ /* detected */ #include main () { break; /* break outside of while, do, for, switch statement */ continue; /* continue outside of while, do, for statement */ switch (1) { case 1: continue; } printf ("Failed Deviance Test 8.8.0.1\n"); } \ No newline at end of file +/* Deviance Test 8.8.0.1: Ensure illegal break and continue statements are */ +/* detected */ + +#include + +main () + { + break; /* break outside of while, do, for, switch statement */ + continue; /* continue outside of while, do, for statement */ + + switch (1) + { + case 1: continue; + } + + printf ("Failed Deviance Test 8.8.0.1\n"); + } diff --git a/Tests/Deviance/D9.2.0.1.CC b/Tests/Deviance/D9.2.0.1.CC old mode 100755 new mode 100644 index ab14685..a7d2faf --- a/Tests/Deviance/D9.2.0.1.CC +++ b/Tests/Deviance/D9.2.0.1.CC @@ -1 +1,28 @@ -/* Deviance Test 9.2.0.1: Ensure attempt to return an array or function */ /* from a function is detected */ #include /*****************************************************************************/ int ( g (float f) ) [] /* g is a func returning an array of integers */ { printf ("This message should never appear\n"); } /*****************************************************************************/ void ( f (void) ) () /* f is a func returning a func returning void */ { printf ("This message should never appear\n"); } /*****************************************************************************/ main () { printf ("Failed Deviance Test 9.2.0.1\n"); } \ No newline at end of file +/* Deviance Test 9.2.0.1: Ensure attempt to return an array or function */ +/* from a function is detected */ + + +#include + + +/*****************************************************************************/ + +int ( g (float f) ) [] /* g is a func returning an array of integers */ + { + printf ("This message should never appear\n"); + } + +/*****************************************************************************/ + +void ( f (void) ) () /* f is a func returning a func returning void */ + { + printf ("This message should never appear\n"); + } + +/*****************************************************************************/ + + +main () + { + printf ("Failed Deviance Test 9.2.0.1\n"); + } diff --git a/Tests/Deviance/DOIT b/Tests/Deviance/DOIT old mode 100755 new mode 100644 index b4e5ca5..fc64a0e --- a/Tests/Deviance/DOIT +++ b/Tests/Deviance/DOIT @@ -1 +1,58 @@ -{1} D2.1.0.1.CC {1} D2.2.0.2.CC {1} D2.4.0.1.CC {1} D2.5.0.1.CC {1} D2.5.0.2.CC {1} D2.7.1.1.CC {1} D2.7.1.2.CC {1} D2.7.2.1.CC {1} D2.7.3.1.CC {1} D2.7.3.2.CC {1} D2.7.3.3.CC {1} D2.7.4.1.CC {1} D2.7.4.4.CC {1} D25.0.1.CC {1} D25.0.2.CC {1} D3.3.1.1.CC {1} D3.3.10.1.CC {1} D3.3.2.1.CC {1} D3.3.3.1.CC {1} D3.3.4.1.CC {1} D3.3.5.1.CC {1} D3.4.0.1.CC {1} D3.5.1.1.CC {1} D3.5.2.1.CC {1} D3.5.3.1.CC {1} D3.5.5.1.CC {1} D4.2.1.1.CC {1} D4.2.2.1.CC {1} D4.2.3.1.CC {1} D4.2.5.1.CC {1} D4.2.9.1.CC {1} D4.3.0.1.CC {1} D4.4.1.1.CC {1} D4.5.3.1.CC {1} D4.6.0.1.CC {1} D4.6.0.2.CC {1} D4.6.1.1.CC {1} D4.6.2.1.CC {1} D4.6.3.1.CC {1} D4.6.4.1.CC {1} D4.6.5.1.CC {1} D4.6.6.1.CC {1} D4.6.7.1.CC {1} D4.6.8.1.CC {1} D7.1.1.1.CC {1} D7.5.4.1.CC {1} D7.6.1.1.CC {1} D7.6.1.2.CC {1} D7.6.1.3.CC {1} D7.6.1.4.CC {1} D7.6.3.1.CC {1} D7.6.4.1.CC {1} D7.6.6.1.CC {1} D7.6.7.1.CC {1} D7.6.8.1.CC {1} D8.7.0.1.CC {1} D8.8.0.1.CC {1} D9.2.0.1.CC \ No newline at end of file +{1} D2.1.0.1.CC +{1} D2.2.0.2.CC +{1} D2.4.0.1.CC +{1} D2.5.0.1.CC +{1} D2.5.0.2.CC +{1} D2.7.1.1.CC +{1} D2.7.1.2.CC +{1} D2.7.2.1.CC +{1} D2.7.3.1.CC +{1} D2.7.3.2.CC +{1} D2.7.3.3.CC +{1} D2.7.4.1.CC +{1} D2.7.4.4.CC +{1} D25.0.1.CC +{1} D25.0.2.CC +{1} D3.3.1.1.CC +{1} D3.3.10.1.CC +{1} D3.3.2.1.CC +{1} D3.3.3.1.CC +{1} D3.3.4.1.CC +{1} D3.3.5.1.CC +{1} D3.4.0.1.CC +{1} D3.5.1.1.CC +{1} D3.5.2.1.CC +{1} D3.5.3.1.CC +{1} D3.5.5.1.CC +{1} D4.2.1.1.CC +{1} D4.2.2.1.CC +{1} D4.2.3.1.CC +{1} D4.2.5.1.CC +{1} D4.2.9.1.CC +{1} D4.3.0.1.CC +{1} D4.4.1.1.CC +{1} D4.5.3.1.CC +{1} D4.6.0.1.CC +{1} D4.6.0.2.CC +{1} D4.6.1.1.CC +{1} D4.6.2.1.CC +{1} D4.6.3.1.CC +{1} D4.6.4.1.CC +{1} D4.6.5.1.CC +{1} D4.6.6.1.CC +{1} D4.6.7.1.CC +{1} D4.6.8.1.CC +{1} D7.1.1.1.CC +{1} D7.5.4.1.CC +{1} D7.6.1.1.CC +{1} D7.6.1.2.CC +{1} D7.6.1.3.CC +{1} D7.6.1.4.CC +{1} D7.6.3.1.CC +{1} D7.6.4.1.CC +{1} D7.6.6.1.CC +{1} D7.6.7.1.CC +{1} D7.6.8.1.CC +{1} D8.7.0.1.CC +{1} D8.8.0.1.CC +{1} D9.2.0.1.CC diff --git a/Tests/Deviance/RUN.DEVIANCE b/Tests/Deviance/RUN.DEVIANCE old mode 100755 new mode 100644 index c5a7500..34620e1 --- a/Tests/Deviance/RUN.DEVIANCE +++ b/Tests/Deviance/RUN.DEVIANCE @@ -1 +1,115 @@ -* * * EXEC file to run the deviance tests for the ORCA/C compiler. Script file * * simply ensures that compiler's error reporting doesn't crash. * * * * The EXEC file accepts one parameter, the name of the file to receive output * * from the test * * * unset exit if {#} != 0 set out ">> {1} >>& {1}" end * Run tests for Chapter 2, Harbison and Steele for i in 1.0.1 2.0.2 4.0.1 5.0.1 5.0.2 7.1.1 7.1.2 7.2.1 echo Test d2.{i}.cc if {#} != 0 echo Test d2.{i}.cc {out} end run d2.{i}.cc keep=3/tmp {out} end for i in 3.1 3.2 3.3 4.1 4.3 4.4 echo Test d2.7.{i}.cc if {#} != 0 echo Test d2.7.{i}.cc {out} end run d2.7.{i}.cc keep=3/tmp {out} end * Run tests for Chapter 3, Harbison and Steele for i in 3.1 3.2 3.3 3.4 3.5 3.10 4.0 5.1 5.2 echo Test d3.{i}.1.cc if {#} != 0 echo Test d3.{i}.1.cc {out} end run d3.{i}.1.cc keep=3/tmp {out} end for i in 3.1 5.1 echo Test d3.5.{i}.cc if {#} != 0 echo Test d3.5.{i}.cc {out} end run d3.5.{i}.cc keep=3/tmp {out} end * Run tests for Chapter 4, Harbison and Steele for i in 2.1 2.2 2.3 2.5 2.9 3.0 4.1 5.3 6.0 echo Test d4.{i}.1.cc if {#} != 0 echo Test d4.{i}.1.cc {out} end run d4.{i}.1.cc keep=3/tmp {out} end for i in 6.0.2 6.1.1 6.2.1 6.3.1 6.4.1 6.5.1 echo Test d4.{i}.cc if {#} != 0 echo Test d4.{i}.cc {out} end run d4.{i}.cc keep=3/tmp {out} end for i in 6 7 8 echo Test d4.6.{i}.1.cc if {#} != 0 echo Test d4.6.{i}.1.cc {out} end run d4.6.{i}.1.cc keep=3/tmp {out} end * Run tests for Chapter 7, Harbison and Steele for i in 1.1 5.4 6.1 6.3 6.4 6.6 6.7 6.8 echo Test d7.{i}.1.cc if {#} != 0 echo Test d7.{i}.1.cc {out} end run d7.{i}.1.cc keep=3/tmp {out} end for i in 2 3 4 echo Test d7.6.1.{i}.cc if {#} != 0 echo Test d7.6.1.{i}.cc {out} end run d7.6.1.{i}.cc keep=3/tmp {out} end * Run tests for Chapters 8, and 9, Harbison and Steele for i in 8.7 8.8 9.2 echo Test d{i}.0.1.cc if {#} != 0 echo Test d{i}.0.1.cc {out} end run d{i}.0.1.cc keep=3/tmp {out} end * Run tests for mini-assembler for i in 1 2 echo Test d25.0.{i}.cc if {#} != 0 echo Test d25.0.{i}.cc {out} end run d25.0.{i}.cc keep=3/tmp {out} end \ No newline at end of file +* * +* EXEC file to run the deviance tests for the ORCA/C compiler. Script file * +* simply ensures that compiler's error reporting doesn't crash. * +* * +* The EXEC file accepts one parameter, the name of the file to receive output * +* from the test * +* * + +unset exit +if {#} != 0 + set out ">> {1} >>& {1}" +end + +* Run tests for Chapter 2, Harbison and Steele + +for i in 1.0.1 2.0.2 4.0.1 5.0.1 5.0.2 7.1.1 7.1.2 7.2.1 + echo Test d2.{i}.cc + if {#} != 0 + echo Test d2.{i}.cc {out} + end + run d2.{i}.cc keep=3/tmp {out} +end + +for i in 3.1 3.2 3.3 4.1 4.3 4.4 + echo Test d2.7.{i}.cc + if {#} != 0 + echo Test d2.7.{i}.cc {out} + end + run d2.7.{i}.cc keep=3/tmp {out} +end + + +* Run tests for Chapter 3, Harbison and Steele + +for i in 3.1 3.2 3.3 3.4 3.5 3.10 4.0 5.1 5.2 + echo Test d3.{i}.1.cc + if {#} != 0 + echo Test d3.{i}.1.cc {out} + end + run d3.{i}.1.cc keep=3/tmp {out} +end + +for i in 3.1 5.1 + echo Test d3.5.{i}.cc + if {#} != 0 + echo Test d3.5.{i}.cc {out} + end + run d3.5.{i}.cc keep=3/tmp {out} +end + + +* Run tests for Chapter 4, Harbison and Steele + +for i in 2.1 2.2 2.3 2.5 2.9 3.0 4.1 5.3 6.0 + echo Test d4.{i}.1.cc + if {#} != 0 + echo Test d4.{i}.1.cc {out} + end + run d4.{i}.1.cc keep=3/tmp {out} +end + +for i in 6.0.2 6.1.1 6.2.1 6.3.1 6.4.1 6.5.1 + echo Test d4.{i}.cc + if {#} != 0 + echo Test d4.{i}.cc {out} + end + run d4.{i}.cc keep=3/tmp {out} +end + +for i in 6 7 8 + echo Test d4.6.{i}.1.cc + if {#} != 0 + echo Test d4.6.{i}.1.cc {out} + end + run d4.6.{i}.1.cc keep=3/tmp {out} +end + + +* Run tests for Chapter 7, Harbison and Steele + +for i in 1.1 5.4 6.1 6.3 6.4 6.6 6.7 6.8 + echo Test d7.{i}.1.cc + if {#} != 0 + echo Test d7.{i}.1.cc {out} + end + run d7.{i}.1.cc keep=3/tmp {out} +end + +for i in 2 3 4 + echo Test d7.6.1.{i}.cc + if {#} != 0 + echo Test d7.6.1.{i}.cc {out} + end + run d7.6.1.{i}.cc keep=3/tmp {out} +end + +* Run tests for Chapters 8, and 9, Harbison and Steele + +for i in 8.7 8.8 9.2 + echo Test d{i}.0.1.cc + if {#} != 0 + echo Test d{i}.0.1.cc {out} + end + run d{i}.0.1.cc keep=3/tmp {out} +end + +* Run tests for mini-assembler + +for i in 1 2 + echo Test d25.0.{i}.cc + if {#} != 0 + echo Test d25.0.{i}.cc {out} + end + run d25.0.{i}.cc keep=3/tmp {out} +end diff --git a/Tests/Deviance/TEST b/Tests/Deviance/TEST old mode 100755 new mode 100644 index aa32ccb..55d8cbf --- a/Tests/Deviance/TEST +++ b/Tests/Deviance/TEST @@ -1 +1,7 @@ -unset exit compile -e -i {1} keep=3/t >3/temp if {status} == 0 echo Failed {1} else echo Passed {1} end \ No newline at end of file +unset exit +compile -e -i {1} keep=3/t >3/temp +if {status} == 0 + echo Failed {1} +else + echo Passed {1} +end diff --git a/Tests/Deviance/TEST2 b/Tests/Deviance/TEST2 old mode 100755 new mode 100644 index f72eaee..35fb766 --- a/Tests/Deviance/TEST2 +++ b/Tests/Deviance/TEST2 @@ -1 +1,7 @@ -unset exit compile -e -i {1} keep=3/t if {status} == 0 echo Failed {1} else echo Passed {1} end \ No newline at end of file +unset exit +compile -e -i {1} keep=3/t +if {status} == 0 + echo Failed {1} +else + echo Passed {1} +end diff --git a/Tests/Spec.Conform/CFILE1 b/Tests/Spec.Conform/CFILE1 old mode 100755 new mode 100644 index 086e2a1..4f98cac --- a/Tests/Spec.Conform/CFILE1 +++ b/Tests/Spec.Conform/CFILE1 @@ -1 +1,2 @@ -#define TEN 10 #define NINE 9 \ No newline at end of file +#define TEN 10 +#define NINE 9 diff --git a/Tests/Spec.Conform/LIBFILE2 b/Tests/Spec.Conform/LIBFILE2 old mode 100755 new mode 100644 index b59af9b..c688f84 --- a/Tests/Spec.Conform/LIBFILE2 +++ b/Tests/Spec.Conform/LIBFILE2 @@ -1 +1,7 @@ - printf ("Passed Special Conformance Test 3.4.0.1\n"); return 0; Fail: printf ("Failed Special Conformance Test 3.4.0.1\n"); return 0; } \ No newline at end of file + printf ("Passed Special Conformance Test 3.4.0.1\n"); + return 0; + +Fail: + printf ("Failed Special Conformance Test 3.4.0.1\n"); + return 0; + } diff --git a/Tests/Spec.Conform/SPC13.2.0.1.CC b/Tests/Spec.Conform/SPC13.2.0.1.CC old mode 100755 new mode 100644 index f598ad6..0c8f915 --- a/Tests/Spec.Conform/SPC13.2.0.1.CC +++ b/Tests/Spec.Conform/SPC13.2.0.1.CC @@ -1 +1,41 @@ -/* */ /* Special Conformance Test 13.2.0.1: Verification of error handling */ /* facilities in the standard library */ /* */ /* Tester needs to verify that an error message is written for each */ /* invocation of strerror and perror. She should also check that the */ /* output from perror is in this form: User's message, colon, blank, and */ /* then the standard error message. Finally, the tester needs to ensure */ /* that when errno is set to EDOM and ERANGE, the error message written */ /* is appropriate. */ /* */ #include #include #include #include #include main () { int i; char ch [] = "Error message is"; for (errno = 1; errno <= sys_nerr; errno++) { printf ("Errno = %d\n", errno); printf ("%s\n", strerror (errno)); perror (ch); } errno = EDOM; printf ("Errno = %d\n", errno); printf ("%s\n", strerror (errno)); perror (ch); errno = ERANGE; printf ("Errno = %d\n", errno); printf ("%s\n", strerror (errno)); perror (ch); } \ No newline at end of file +/* */ +/* Special Conformance Test 13.2.0.1: Verification of error handling */ +/* facilities in the standard library */ +/* */ +/* Tester needs to verify that an error message is written for each */ +/* invocation of strerror and perror. She should also check that the */ +/* output from perror is in this form: User's message, colon, blank, and */ +/* then the standard error message. Finally, the tester needs to ensure */ +/* that when errno is set to EDOM and ERANGE, the error message written */ +/* is appropriate. */ +/* */ + +#include +#include +#include +#include +#include + +main () + { + int i; + char ch [] = "Error message is"; + + + for (errno = 1; errno <= sys_nerr; errno++) + { + printf ("Errno = %d\n", errno); + printf ("%s\n", strerror (errno)); + perror (ch); + } + + errno = EDOM; + printf ("Errno = %d\n", errno); + printf ("%s\n", strerror (errno)); + perror (ch); + + errno = ERANGE; + printf ("Errno = %d\n", errno); + printf ("%s\n", strerror (errno)); + perror (ch); + } diff --git a/Tests/Spec.Conform/SPC13.4.0.1.CC b/Tests/Spec.Conform/SPC13.4.0.1.CC old mode 100755 new mode 100644 index 684e028..f9081f0 --- a/Tests/Spec.Conform/SPC13.4.0.1.CC +++ b/Tests/Spec.Conform/SPC13.4.0.1.CC @@ -1 +1,73 @@ -/* */ /* Special Conformance Test 13.4.0.1: Verification of stdarg library facility */ /* */ /* The tester needs to verify that the values 2, 'c', 1.3, 4.4, and 7.7 are */ /* printed to standard out. */ /* */ #pragma optimize -1 #include enum types { integer, character, singlePrecision, doublePrecision, extendedPrecision, endOfList }; main () { int i = 2; char ch = 'c'; float f = 1.3; double d = 4.4; extended e = 7.7; enum types typesArray [80]; void VariablePrint ( enum types *typesArray, ... ); typesArray [0] = integer; /* init. array of types of values */ typesArray [1] = character; /* to print */ typesArray [2] = singlePrecision; typesArray [3] = doublePrecision; typesArray [4] = extendedPrecision; typesArray [5] = endOfList; VariablePrint ( typesArray, i, ch, f, d, e ); /* call function which takes */ } /* variable number args */ /****************************************************************************/ void VariablePrint ( enum types *typesArray, ... ) { va_list ap; enum types nextType; va_start (ap, typesArray); /* initialize variable argument ptr */ while ( (nextType = *typesArray++) != endOfList ) { switch (nextType) { case integer: printf ("int: %d\n", va_arg (ap, int)); break; case character: printf ("char: %c\n", va_arg (ap, int)); break; case singlePrecision: case doublePrecision: case extendedPrecision: printf ("extended: %e\n", va_arg (ap, extended)); break; default: printf ("Error in VariablePrint"); break; } /* end switch */ } /* end while */ va_end (ap); /* clean up stack, etc. */ } \ No newline at end of file +/* */ +/* Special Conformance Test 13.4.0.1: Verification of stdarg library facility */ +/* */ +/* The tester needs to verify that the values 2, 'c', 1.3, 4.4, and 7.7 are */ +/* printed to standard out. */ +/* */ + +#pragma optimize -1 +#include + +enum types { integer, character, singlePrecision, doublePrecision, + extendedPrecision, endOfList }; + + +main () + { + int i = 2; + char ch = 'c'; + float f = 1.3; + double d = 4.4; + extended e = 7.7; + + enum types typesArray [80]; + + void VariablePrint ( enum types *typesArray, ... ); + + + typesArray [0] = integer; /* init. array of types of values */ + typesArray [1] = character; /* to print */ + typesArray [2] = singlePrecision; + typesArray [3] = doublePrecision; + typesArray [4] = extendedPrecision; + typesArray [5] = endOfList; + VariablePrint ( typesArray, i, ch, f, d, e ); /* call function which takes */ + } /* variable number args */ + + +/****************************************************************************/ + +void VariablePrint ( enum types *typesArray, ... ) + { + va_list ap; + enum types nextType; + + + va_start (ap, typesArray); /* initialize variable argument ptr */ + while ( (nextType = *typesArray++) != endOfList ) + { + switch (nextType) + { + case integer: + printf ("int: %d\n", va_arg (ap, int)); + break; + + case character: + printf ("char: %c\n", va_arg (ap, int)); + break; + + case singlePrecision: + case doublePrecision: + case extendedPrecision: + printf ("extended: %e\n", va_arg (ap, extended)); + break; + + default: + printf ("Error in VariablePrint"); + break; + + } /* end switch */ + } /* end while */ + + va_end (ap); /* clean up stack, etc. */ + } diff --git a/Tests/Spec.Conform/SPC17.16.0.1.CC b/Tests/Spec.Conform/SPC17.16.0.1.CC old mode 100755 new mode 100644 index 197f82c..919f3c2 --- a/Tests/Spec.Conform/SPC17.16.0.1.CC +++ b/Tests/Spec.Conform/SPC17.16.0.1.CC @@ -1 +1,136 @@ -/* Special Conformance Test 17.16.0.1: Verification of tmpnam function */ /* */ /* The temporary filenames that the system generates will be displayed. */ /* The tester needs to verify that these files are created after the */ /* the test is complete. */ #include #include struct S { int i; float f; char c; }; main () { struct S s [3] = { 1, 1.0, 'a', 2, 2.0, 'b', 3, 3.0, 'c' }; struct S buff [3]; FILE *f1, *f2, *f3; int i; char filename [3] [L_tmpnam]; /* filename buffers */ char *namePtr; /* Call tmpnam to obtain 3 filenames and display the names to the tester. */ namePtr = tmpnam (filename [0]); if (namePtr == NULL) goto Fail; if (strcmp (namePtr,filename [0])) goto Fail; printf ("The first filename is: %s\n", filename [0]); namePtr = tmpnam (filename [1]); if (namePtr == NULL) goto Fail; if (strcmp (namePtr, filename [1])) goto Fail; printf ("The second filename is: %s\n", filename [1]); namePtr = tmpnam (NULL); /* test sending NULL pointer */ if (namePtr == NULL) goto Fail; printf ("The third filename is: %s\n", namePtr); namePtr = strcpy (filename [2], namePtr); if (strcmp (namePtr, filename [2])) goto Fail; /* Create 3 temp files and write the elements to the files. */ f1 = fopen (filename [0], "w+b"); if (f1 == NULL) goto Fail1; i = fwrite ((void *) s, sizeof (struct S), 3, f1); if (i != 3) goto Fail; f2 = fopen (filename [1], "w+b"); if (f2 == NULL) goto Fail1; i = fwrite ((void *) s, sizeof (struct S), 3, f2); if (i != 3) goto Fail; f3 = fopen (filename [2], "w+b"); if (f3 == NULL) goto Fail1; i = fwrite ((void *) s, sizeof (struct S), 3, f3); if (i != 3) goto Fail; /* Read the elements from the files. */ rewind (f1); i = fread ((void *) buff, sizeof (struct S), 3, f1); if (i != 3) goto Fail; if ((s [0].i != 1) || (s [1].i != 2) || (s [2].i != 3)) goto Fail; if ((s [0].f != 1.0) || (s [1].f != 2.0) || (s [2].f != 3.0)) goto Fail; if ((s [0].c != 'a') || (s [1].c != 'b') || (s [2].c != 'c')) goto Fail; rewind (f2); i = fread ((void *) buff, sizeof (struct S), 3, f2); if (i != 3) goto Fail; if ((s [0].i != 1) || (s [1].i != 2) || (s [2].i != 3)) goto Fail; if ((s [0].f != 1.0) || (s [1].f != 2.0) || (s [2].f != 3.0)) goto Fail; if ((s [0].c != 'a') || (s [1].c != 'b') || (s [2].c != 'c')) goto Fail; rewind (f2); i = fread ((void *) buff, sizeof (struct S), 3, f2); if (i != 3) goto Fail; if ((s [0].i != 1) || (s [1].i != 2) || (s [2].i != 3)) goto Fail; if ((s [0].f != 1.0) || (s [1].f != 2.0) || (s [2].f != 3.0)) goto Fail; if ((s [0].c != 'a') || (s [1].c != 'b') || (s [2].c != 'c')) goto Fail; i = fclose (f1); /* close the files and quit */ if (i == EOF) goto Fail2; i = fclose (f2); if (i == EOF) goto Fail2; i = fclose (f3); if (i == EOF) goto Fail2; printf ("Passed Special Conformance Test 17.16.0.1\n"); return; Fail: printf ("Failed Special Conformance Test 17.16.0.1\n"); exit (0); Fail1: printf ("Unable to open temp file for Special Conformance Test 17.16.0.1\n"); exit (0); Fail2: printf ("Unable to close output file for Special Conformance Test 17.16.0.1\n"); exit (0); } \ No newline at end of file +/* Special Conformance Test 17.16.0.1: Verification of tmpnam function */ +/* */ +/* The temporary filenames that the system generates will be displayed. */ +/* The tester needs to verify that these files are created after the */ +/* the test is complete. */ + +#include +#include + +struct S { int i; + float f; + char c; }; + +main () + { + struct S s [3] = { 1, 1.0, 'a', 2, 2.0, 'b', 3, 3.0, 'c' }; + struct S buff [3]; + FILE *f1, *f2, *f3; + int i; + + char filename [3] [L_tmpnam]; /* filename buffers */ + char *namePtr; + + + /* Call tmpnam to obtain 3 filenames and display the names to the tester. */ + + namePtr = tmpnam (filename [0]); + if (namePtr == NULL) + goto Fail; + if (strcmp (namePtr,filename [0])) + goto Fail; + printf ("The first filename is: %s\n", filename [0]); + + namePtr = tmpnam (filename [1]); + if (namePtr == NULL) + goto Fail; + if (strcmp (namePtr, filename [1])) + goto Fail; + printf ("The second filename is: %s\n", filename [1]); + + namePtr = tmpnam (NULL); /* test sending NULL pointer */ + if (namePtr == NULL) + goto Fail; + printf ("The third filename is: %s\n", namePtr); + namePtr = strcpy (filename [2], namePtr); + if (strcmp (namePtr, filename [2])) + goto Fail; + + + /* Create 3 temp files and write the elements to the files. */ + + f1 = fopen (filename [0], "w+b"); + if (f1 == NULL) + goto Fail1; + i = fwrite ((void *) s, sizeof (struct S), 3, f1); + if (i != 3) + goto Fail; + + f2 = fopen (filename [1], "w+b"); + if (f2 == NULL) + goto Fail1; + i = fwrite ((void *) s, sizeof (struct S), 3, f2); + if (i != 3) + goto Fail; + + f3 = fopen (filename [2], "w+b"); + if (f3 == NULL) + goto Fail1; + i = fwrite ((void *) s, sizeof (struct S), 3, f3); + if (i != 3) + goto Fail; + + + /* Read the elements from the files. */ + + rewind (f1); + i = fread ((void *) buff, sizeof (struct S), 3, f1); + if (i != 3) + goto Fail; + if ((s [0].i != 1) || (s [1].i != 2) || (s [2].i != 3)) + goto Fail; + if ((s [0].f != 1.0) || (s [1].f != 2.0) || (s [2].f != 3.0)) + goto Fail; + if ((s [0].c != 'a') || (s [1].c != 'b') || (s [2].c != 'c')) + goto Fail; + + rewind (f2); + i = fread ((void *) buff, sizeof (struct S), 3, f2); + if (i != 3) + goto Fail; + if ((s [0].i != 1) || (s [1].i != 2) || (s [2].i != 3)) + goto Fail; + if ((s [0].f != 1.0) || (s [1].f != 2.0) || (s [2].f != 3.0)) + goto Fail; + if ((s [0].c != 'a') || (s [1].c != 'b') || (s [2].c != 'c')) + goto Fail; + + rewind (f2); + i = fread ((void *) buff, sizeof (struct S), 3, f2); + if (i != 3) + goto Fail; + if ((s [0].i != 1) || (s [1].i != 2) || (s [2].i != 3)) + goto Fail; + if ((s [0].f != 1.0) || (s [1].f != 2.0) || (s [2].f != 3.0)) + goto Fail; + if ((s [0].c != 'a') || (s [1].c != 'b') || (s [2].c != 'c')) + goto Fail; + + + i = fclose (f1); /* close the files and quit */ + if (i == EOF) + goto Fail2; + + i = fclose (f2); + if (i == EOF) + goto Fail2; + + i = fclose (f3); + if (i == EOF) + goto Fail2; + + printf ("Passed Special Conformance Test 17.16.0.1\n"); + return; + +Fail: + printf ("Failed Special Conformance Test 17.16.0.1\n"); + exit (0); + +Fail1: + printf ("Unable to open temp file for Special Conformance Test 17.16.0.1\n"); + exit (0); + +Fail2: + printf ("Unable to close output file for Special Conformance Test 17.16.0.1\n"); + exit (0); + } diff --git a/Tests/Spec.Conform/SPC17.2.0.1.CC b/Tests/Spec.Conform/SPC17.2.0.1.CC old mode 100755 new mode 100644 index bcdc183..056d3ad --- a/Tests/Spec.Conform/SPC17.2.0.1.CC +++ b/Tests/Spec.Conform/SPC17.2.0.1.CC @@ -1 +1,166 @@ -/* */ /* Special Conformance Test 17.2.0.1: Verification of fopen and fclose: */ /* creating new files */ /* */ /* Tester needs to verify that the 12 files named spc17.2.0.a - spc17.2.0.l */ /* are created on the work prefix. */ /* */ #include main () { int i, count = 0; FILE *f1, *f2, *f3, *f4, *f5, *f6, *f7, *f8; /* must be able to open */ /* 8 files at a time */ char fn1 [14] = "3/spc17.2.0.a"; /* define filenames */ char fn2 [14] = "3/spc17.2.0.b"; char fn3 [14] = "3/spc17.2.0.c"; char fn4 [14] = "3/spc17.2.0.d"; char fn5 [14] = "3/spc17.2.0.e"; char fn6 [14] = "3/spc17.2.0.f"; char fn7 [14] = "3/spc17.2.0.g"; char fn8 [14] = "3/spc17.2.0.h"; char fn9 [14] = "3/spc17.2.0.i"; char fn10 [14] = "3/spc17.2.0.j"; char fn11 [14] = "3/spc17.2.0.k"; char fn12 [14] = "3/spc17.2.0.l"; count++; f1 = fopen (fn1, "w"); /* open for writing */ if (f1 == NULL) goto Fail; count++; f2 = fopen (fn2, "w"); if (f2 == NULL) goto Fail; count++; f3 = fopen (fn3, "a"); /* open for appending */ if (f3 == NULL) goto Fail; count++; f4 = fopen (fn4, "w+"); /* open for update, starting at */ if (f4 == NULL) /* beginning of file */ goto Fail; count++; f5 = fopen (fn5, "w+"); /* open for update, clearing file */ if (f5 == NULL) /* contents */ goto Fail; count++; f6 = fopen (fn6, "a+"); /* open for update, starting at */ if (f6 == NULL) /* end of file */ goto Fail; /* Open two more files, then shut 4 open ones before opening the */ /* last four files. These files will be open in "binary" mode. */ count++; f7 = fopen (fn7, "wb"); /* open binary file for writing */ if (f7 == NULL) goto Fail; count++; f8 = fopen (fn8, "wb"); if (f8 == NULL) goto Fail; count++; i = fclose (f1); /* close the first four files */ if (i == EOF) goto Fail2; count++; i = fclose (f2); if (i == EOF) goto Fail2; count++; i = fclose (f3); if (i == EOF) goto Fail2; count++; i = fclose (f4); if (i == EOF) goto Fail2; count++; f1 = fopen (fn9, "ab"); /* open binary file for appending */ if (f1 == NULL) goto Fail; count++; f2 = fopen (fn10, "wb+"); /* open binary file for update, */ if (f2 == NULL) /* starting at beginning of file */ goto Fail; count++; f3 = fopen (fn11, "wb+"); /* open binary file for update, */ if (f3 == NULL) /* clearing file contents first */ goto Fail; count++; f4 = fopen (fn12, "ab+"); /* open binary file for update, */ if (f4 == NULL) /* starting at end of file */ goto Fail; count++; i = fclose (f1); /* close all of the open files */ if (i == EOF) goto Fail2; count++; i = fclose (f2); if (i == EOF) goto Fail2; count++; i = fclose (f3); if (i == EOF) goto Fail2; count++; i = fclose (f4); if (i == EOF) goto Fail2; count++; i = fclose (f5); if (i == EOF) goto Fail2; count++; i = fclose (f6); if (i == EOF) goto Fail2; count++; i = fclose (f7); if (i == EOF) goto Fail2; count++; i = fclose (f8); if (i == EOF) goto Fail2; printf ("Passed Special Conformance Test 17.2.0.1 "); return; Fail: printf ("count = %d\n", count); perror ("File creation failure in Special Conformance Test 17.2.0.1 "); return; Fail2: printf ("count = %d\n", count); printf ("Error when closing file"); } \ No newline at end of file +/* */ +/* Special Conformance Test 17.2.0.1: Verification of fopen and fclose: */ +/* creating new files */ +/* */ +/* Tester needs to verify that the 12 files named spc17.2.0.a - spc17.2.0.l */ +/* are created on the work prefix. */ +/* */ + +#include + +main () + { + int i, count = 0; + + FILE *f1, *f2, *f3, *f4, *f5, *f6, *f7, *f8; /* must be able to open */ + /* 8 files at a time */ + + char fn1 [14] = "3/spc17.2.0.a"; /* define filenames */ + char fn2 [14] = "3/spc17.2.0.b"; + char fn3 [14] = "3/spc17.2.0.c"; + char fn4 [14] = "3/spc17.2.0.d"; + char fn5 [14] = "3/spc17.2.0.e"; + char fn6 [14] = "3/spc17.2.0.f"; + char fn7 [14] = "3/spc17.2.0.g"; + char fn8 [14] = "3/spc17.2.0.h"; + char fn9 [14] = "3/spc17.2.0.i"; + char fn10 [14] = "3/spc17.2.0.j"; + char fn11 [14] = "3/spc17.2.0.k"; + char fn12 [14] = "3/spc17.2.0.l"; + + + count++; + f1 = fopen (fn1, "w"); /* open for writing */ + if (f1 == NULL) + goto Fail; + + count++; + f2 = fopen (fn2, "w"); + if (f2 == NULL) + goto Fail; + + count++; + f3 = fopen (fn3, "a"); /* open for appending */ + if (f3 == NULL) + goto Fail; + + count++; + f4 = fopen (fn4, "w+"); /* open for update, starting at */ + if (f4 == NULL) /* beginning of file */ + goto Fail; + + count++; + f5 = fopen (fn5, "w+"); /* open for update, clearing file */ + if (f5 == NULL) /* contents */ + goto Fail; + + count++; + f6 = fopen (fn6, "a+"); /* open for update, starting at */ + if (f6 == NULL) /* end of file */ + goto Fail; + + /* Open two more files, then shut 4 open ones before opening the */ + /* last four files. These files will be open in "binary" mode. */ + + count++; + f7 = fopen (fn7, "wb"); /* open binary file for writing */ + if (f7 == NULL) + goto Fail; + + count++; + f8 = fopen (fn8, "wb"); + if (f8 == NULL) + goto Fail; + + count++; + i = fclose (f1); /* close the first four files */ + if (i == EOF) + goto Fail2; + + count++; + i = fclose (f2); + if (i == EOF) + goto Fail2; + + count++; + i = fclose (f3); + if (i == EOF) + goto Fail2; + + count++; + i = fclose (f4); + if (i == EOF) + goto Fail2; + + count++; + f1 = fopen (fn9, "ab"); /* open binary file for appending */ + if (f1 == NULL) + goto Fail; + + count++; + f2 = fopen (fn10, "wb+"); /* open binary file for update, */ + if (f2 == NULL) /* starting at beginning of file */ + goto Fail; + + count++; + f3 = fopen (fn11, "wb+"); /* open binary file for update, */ + if (f3 == NULL) /* clearing file contents first */ + goto Fail; + + count++; + f4 = fopen (fn12, "ab+"); /* open binary file for update, */ + if (f4 == NULL) /* starting at end of file */ + goto Fail; + + count++; + i = fclose (f1); /* close all of the open files */ + if (i == EOF) + goto Fail2; + + count++; + i = fclose (f2); + if (i == EOF) + goto Fail2; + + count++; + i = fclose (f3); + if (i == EOF) + goto Fail2; + + count++; + i = fclose (f4); + if (i == EOF) + goto Fail2; + + count++; + i = fclose (f5); + if (i == EOF) + goto Fail2; + + count++; + i = fclose (f6); + if (i == EOF) + goto Fail2; + + count++; + i = fclose (f7); + if (i == EOF) + goto Fail2; + + count++; + i = fclose (f8); + if (i == EOF) + goto Fail2; + + printf ("Passed Special Conformance Test 17.2.0.1 "); + return; + +Fail: + printf ("count = %d\n", count); + perror ("File creation failure in Special Conformance Test 17.2.0.1 "); + return; + +Fail2: + printf ("count = %d\n", count); + printf ("Error when closing file"); + } diff --git a/Tests/Spec.Conform/SPC17.2.0.2.CC b/Tests/Spec.Conform/SPC17.2.0.2.CC old mode 100755 new mode 100644 index 00c8c36..f44472f --- a/Tests/Spec.Conform/SPC17.2.0.2.CC +++ b/Tests/Spec.Conform/SPC17.2.0.2.CC @@ -1 +1,250 @@ -/* */ /* Special Conformance Test 17.2.0.2: Verification of fflush */ /* */ /* Other files needed: spc17.202.exec - EXEC file which flushes the contents */ /* of 12 data files to the printer */ /* spc17.2.0.a - spc17.2.0.l - data files for the test */ /* */ /* Tester needs to verify that the 12 files named spc17.2.0.a - spc17.2.0.l, */ /* and located on the work prefix, are dumped to the printer */ /* */ #include main () { int i, count = 0; FILE *f1, *f2, *f3, *f4, *f5, *f6, *f7, *f8; /* must be able to open */ /* 8 files at a time */ char fn1 [14] = "3/spc17.2.0.a"; /* define filenames */ char fn2 [14] = "3/spc17.2.0.b"; char fn3 [14] = "3/spc17.2.0.c"; char fn4 [14] = "3/spc17.2.0.d"; char fn5 [14] = "3/spc17.2.0.e"; char fn6 [14] = "3/spc17.2.0.f"; char fn7 [14] = "3/spc17.2.0.g"; char fn8 [14] = "3/spc17.2.0.h"; char fn9 [14] = "3/spc17.2.0.i"; char fn10 [14] = "3/spc17.2.0.j"; char fn11 [14] = "3/spc17.2.0.k"; char fn12 [14] = "3/spc17.2.0.l"; count++; f1 = fopen (fn1, "w"); /* open for writing */ if (f1 == NULL) goto Fail; i = fputs ("This is file 3/spc17.2.0.a", f1); if (i == EOF) goto Fail2; i = fflush (f1); if (i == EOF) goto Fail3; count++; f2 = fopen (fn2, "a"); /* open for appending */ if (f2 == NULL) goto Fail; i = fputs ("This is file 3/spc17.2.0.b", f2); if (i == EOF) goto Fail2; i = fflush (f2); if (i == EOF) goto Fail3; count++; f3 = fopen (fn3, "a"); /* open for appending */ if (f3 == NULL) goto Fail; i = fputs ("This is file 3/spc17.2.0.c", f3); if (i == EOF) goto Fail2; i = fflush (f3); if (i == EOF) goto Fail3; count++; f4 = fopen (fn4, "w+"); /* open for update, starting at */ if (f4 == NULL) /* beginning of file */ goto Fail; i = fputs ("This is file 3/spc17.2.0.d", f4); if (i == EOF) goto Fail2; i = fflush (f4); if (i == EOF) goto Fail3; count++; f5 = fopen (fn5, "w+"); /* open for update, clearing file */ if (f5 == NULL) /* contents */ goto Fail; i = fputs ("This is file 3/spc17.2.0.e", f5); if (i == EOF) goto Fail2; i = fflush (f5); if (i == EOF) goto Fail3; count++; f6 = fopen (fn6, "a+"); /* open for update, starting at */ if (f6 == NULL) /* end of file */ goto Fail; i = fputs ("This is file 3/spc17.2.0.f", f6); if (i == EOF) goto Fail2; i = fflush (f6); if (i == EOF) goto Fail3; /* Open two more files, then shut 4 open ones before opening the */ /* last four files. These files will be open in "binary" mode. */ count++; f7 = fopen (fn7, "wb"); /* open binary file for writing */ if (f7 == NULL) goto Fail; i = fprintf (f7, "%f", -43.876); if (i == EOF) goto Fail2; i = fflush (f7); if (i == EOF) goto Fail3; count++; f8 = fopen (fn8, "wb"); /* open binary file for writing */ if (f8 == NULL) goto Fail; i = fprintf (f8, "%d", 32767); if (i == EOF) goto Fail2; i = fflush (f8); if (i == EOF) goto Fail3; count++; i = fclose (f1); /* close the first four files */ if (i == EOF) goto Fail4; count++; i = fclose (f2); if (i == EOF) goto Fail4; count++; i = fclose (f3); if (i == EOF) goto Fail4; count++; i = fclose (f4); if (i == EOF) goto Fail4; count++; f1 = fopen (fn9, "ab"); /* open binary file for appending */ if (f1 == NULL) goto Fail; i = fprintf (f1, "%e", 23.8e+90); if (i == EOF) goto Fail2; i = fflush (f1); if (i == EOF) goto Fail3; count++; f2 = fopen (fn10, "wb+"); /* open binary file for update, */ if (f2 == NULL) /* starting at beginning of file */ goto Fail; i = fprintf (f2, "%c", 0x07); if (i == EOF) goto Fail2; i = fflush (f2); if (i == EOF) goto Fail3; count++; f3 = fopen (fn11, "wb+"); /* open binary file for update, */ if (f3 == NULL) /* clearing file contents first */ goto Fail; i = fprintf (f3, "%%"); if (i == EOF) goto Fail2; i = fflush (f3); if (i == EOF) goto Fail3; count++; f4 = fopen (fn12, "ab+"); /* open binary file for update, */ if (f4 == NULL) /* starting at end of file */ goto Fail; i = fprintf (f4, "%d", count); if (i == EOF) goto Fail2; i = fflush (f4); if (i == EOF) goto Fail3; count++; i = fclose (f1); /* close all of the open files */ if (i == EOF) goto Fail4; count++; i = fclose (f2); if (i == EOF) goto Fail4; count++; i = fclose (f3); if (i == EOF) goto Fail4; count++; i = fclose (f4); if (i == EOF) goto Fail4; count++; i = fclose (f5); if (i == EOF) goto Fail4; count++; i = fclose (f6); if (i == EOF) goto Fail4; count++; i = fclose (f7); if (i == EOF) goto Fail4; count++; i = fclose (f8); if (i == EOF) goto Fail4; printf ("Passed Special Conformance Test 17.2.0.2 "); return; Fail: perror ("File open failure in Special Conformance Test 17.2.0.2 "); goto Out; Fail2: printf ("Error when writing to file\n"); goto Out; Fail3: printf ("Error when flushing file\n"); goto Out; Fail4: printf ("Error when closing file\n"); Out: printf ("count = %d\n", count); } \ No newline at end of file +/* */ +/* Special Conformance Test 17.2.0.2: Verification of fflush */ +/* */ +/* Other files needed: spc17.202.exec - EXEC file which flushes the contents */ +/* of 12 data files to the printer */ +/* spc17.2.0.a - spc17.2.0.l - data files for the test */ +/* */ +/* Tester needs to verify that the 12 files named spc17.2.0.a - spc17.2.0.l, */ +/* and located on the work prefix, are dumped to the printer */ +/* */ + +#include + +main () + { + int i, count = 0; + + FILE *f1, *f2, *f3, *f4, *f5, *f6, *f7, *f8; /* must be able to open */ + /* 8 files at a time */ + + char fn1 [14] = "3/spc17.2.0.a"; /* define filenames */ + char fn2 [14] = "3/spc17.2.0.b"; + char fn3 [14] = "3/spc17.2.0.c"; + char fn4 [14] = "3/spc17.2.0.d"; + char fn5 [14] = "3/spc17.2.0.e"; + char fn6 [14] = "3/spc17.2.0.f"; + char fn7 [14] = "3/spc17.2.0.g"; + char fn8 [14] = "3/spc17.2.0.h"; + char fn9 [14] = "3/spc17.2.0.i"; + char fn10 [14] = "3/spc17.2.0.j"; + char fn11 [14] = "3/spc17.2.0.k"; + char fn12 [14] = "3/spc17.2.0.l"; + + + count++; + f1 = fopen (fn1, "w"); /* open for writing */ + if (f1 == NULL) + goto Fail; + i = fputs ("This is file 3/spc17.2.0.a", f1); + if (i == EOF) + goto Fail2; + i = fflush (f1); + if (i == EOF) + goto Fail3; + + count++; + f2 = fopen (fn2, "a"); /* open for appending */ + if (f2 == NULL) + goto Fail; + i = fputs ("This is file 3/spc17.2.0.b", f2); + if (i == EOF) + goto Fail2; + i = fflush (f2); + if (i == EOF) + goto Fail3; + + count++; + f3 = fopen (fn3, "a"); /* open for appending */ + if (f3 == NULL) + goto Fail; + i = fputs ("This is file 3/spc17.2.0.c", f3); + if (i == EOF) + goto Fail2; + i = fflush (f3); + if (i == EOF) + goto Fail3; + + count++; + f4 = fopen (fn4, "w+"); /* open for update, starting at */ + if (f4 == NULL) /* beginning of file */ + goto Fail; + i = fputs ("This is file 3/spc17.2.0.d", f4); + if (i == EOF) + goto Fail2; + i = fflush (f4); + if (i == EOF) + goto Fail3; + + count++; + f5 = fopen (fn5, "w+"); /* open for update, clearing file */ + if (f5 == NULL) /* contents */ + goto Fail; + i = fputs ("This is file 3/spc17.2.0.e", f5); + if (i == EOF) + goto Fail2; + i = fflush (f5); + if (i == EOF) + goto Fail3; + + count++; + f6 = fopen (fn6, "a+"); /* open for update, starting at */ + if (f6 == NULL) /* end of file */ + goto Fail; + i = fputs ("This is file 3/spc17.2.0.f", f6); + if (i == EOF) + goto Fail2; + i = fflush (f6); + if (i == EOF) + goto Fail3; + + /* Open two more files, then shut 4 open ones before opening the */ + /* last four files. These files will be open in "binary" mode. */ + + count++; + f7 = fopen (fn7, "wb"); /* open binary file for writing */ + if (f7 == NULL) + goto Fail; + i = fprintf (f7, "%f", -43.876); + if (i == EOF) + goto Fail2; + i = fflush (f7); + if (i == EOF) + goto Fail3; + + count++; + f8 = fopen (fn8, "wb"); /* open binary file for writing */ + if (f8 == NULL) + goto Fail; + i = fprintf (f8, "%d", 32767); + if (i == EOF) + goto Fail2; + i = fflush (f8); + if (i == EOF) + goto Fail3; + + count++; + i = fclose (f1); /* close the first four files */ + if (i == EOF) + goto Fail4; + + count++; + i = fclose (f2); + if (i == EOF) + goto Fail4; + + count++; + i = fclose (f3); + if (i == EOF) + goto Fail4; + + count++; + i = fclose (f4); + if (i == EOF) + goto Fail4; + + count++; + f1 = fopen (fn9, "ab"); /* open binary file for appending */ + if (f1 == NULL) + goto Fail; + i = fprintf (f1, "%e", 23.8e+90); + if (i == EOF) + goto Fail2; + i = fflush (f1); + if (i == EOF) + goto Fail3; + + count++; + f2 = fopen (fn10, "wb+"); /* open binary file for update, */ + if (f2 == NULL) /* starting at beginning of file */ + goto Fail; + i = fprintf (f2, "%c", 0x07); + if (i == EOF) + goto Fail2; + i = fflush (f2); + if (i == EOF) + goto Fail3; + + count++; + f3 = fopen (fn11, "wb+"); /* open binary file for update, */ + if (f3 == NULL) /* clearing file contents first */ + goto Fail; + i = fprintf (f3, "%%"); + if (i == EOF) + goto Fail2; + i = fflush (f3); + if (i == EOF) + goto Fail3; + + count++; + f4 = fopen (fn12, "ab+"); /* open binary file for update, */ + if (f4 == NULL) /* starting at end of file */ + goto Fail; + i = fprintf (f4, "%d", count); + if (i == EOF) + goto Fail2; + i = fflush (f4); + if (i == EOF) + goto Fail3; + + count++; + i = fclose (f1); /* close all of the open files */ + if (i == EOF) + goto Fail4; + + count++; + i = fclose (f2); + if (i == EOF) + goto Fail4; + + count++; + i = fclose (f3); + if (i == EOF) + goto Fail4; + + count++; + i = fclose (f4); + if (i == EOF) + goto Fail4; + + count++; + i = fclose (f5); + if (i == EOF) + goto Fail4; + + count++; + i = fclose (f6); + if (i == EOF) + goto Fail4; + + count++; + i = fclose (f7); + if (i == EOF) + goto Fail4; + + count++; + i = fclose (f8); + if (i == EOF) + goto Fail4; + + printf ("Passed Special Conformance Test 17.2.0.2 "); + return; + +Fail: + perror ("File open failure in Special Conformance Test 17.2.0.2 "); + goto Out; + +Fail2: + printf ("Error when writing to file\n"); + goto Out; + +Fail3: + printf ("Error when flushing file\n"); + goto Out; + +Fail4: + printf ("Error when closing file\n"); + +Out: + printf ("count = %d\n", count); + } diff --git a/Tests/Spec.Conform/SPC17.2.0.3.CC b/Tests/Spec.Conform/SPC17.2.0.3.CC old mode 100755 new mode 100644 index 1a2a3e2..d3996b8 --- a/Tests/Spec.Conform/SPC17.2.0.3.CC +++ b/Tests/Spec.Conform/SPC17.2.0.3.CC @@ -1 +1,202 @@ -/* */ /* Special Conformance Test 17.2.0.3: Verification of freopen */ /* */ /* Other files needed: spc17.2.0.a - spc17.2.0.d - data files for the test */ /* */ /* Tester needs to verify that the files named spc17.2.0.a - spc17.2.0.d, */ /* and located on the work prefix, have previously been created with the */ /* test Special Conformance 17.2.0.2. */ /* */ /* The first action of the test will be to open spc17.2.0.a, and print its */ /* contents on the screen. The tester needs to verify that the contents are */ /* correct. */ /* */ /* The next action is to verify that standard input is working. The tester */ /* will be prompted for a string; this string will then be written to both */ /* standard out and standard error out. The tester needs to verify that the */ /* output strings are correct. */ /* */ /* The test will then redirect standard in, standard out, and standard error */ /* out. The contents of spc17.2.0.b will be sent to the files spc17.0.c, */ /* the new standard out, and spc17.2.0.d, the new standard error out. The */ /* tester needs to verify that the three files are identical. */ /* */ /* Finally, standard in, standard out, and standard error out will be reset */ /* to their original values. The tester will be prompted for a new string */ /* to be entered from the keyboard. The tester needs to verify that the */ /* string is correctly echoed to the screen twice (once for standard out and */ /* once for standard error out). */ /* */ #include #include main () { int i, j; char s [255]; /* input buffer */ FILE *f1, *f2, *f3, *f4; FILE *saveStdin, *saveStdout, *saveStderr; char fn1 [14] = "3/spc17.2.0.a"; /* define filenames */ char fn2 [14] = "3/spc17.2.0.b"; char fn3 [14] = "3/spc17.2.0.c"; char fn4 [14] = "3/spc17.2.0.d"; f1 = fopen (fn1, "r"); /* open for reading */ if (f1 == NULL) goto Fail; i = 0; while ((j = fgetc (f1)) != EOF) /* read successive */ s [i++] = (char) j; /* chars into string */ s [i] = '\0'; printf ("This is the contents of 3/spc17.2.0.a:\n%s\n", s); f1 = freopen (fn2, "a+", f1); /* reassign file pointer */ if (f1 == NULL) goto Fail2; i = fseek (f1, 0L, SEEK_END); /* move to end of file */ if (i) goto Fail5; i = fputs ("This is the second line of file 3/spc17.2.0.b", f1); if (i == EOF) goto Fail3; rewind (f1); i = 0; while ((j = fgetc (f1)) != EOF) /* read successive */ s [i++] = (char) j; /* chars into string */ s [i] = '\0'; printf ("\nThese are the updated contents of 3/spc17.2.0.b:\n%s\n", s); /* This part of the test verifies reopening standard in, standard out, and */ /* standard error out. */ printf ("Please enter a string\n"); /* 1st verify that standard in */ j = 0; /* standard out and standard */ while ((i = fgetc (stdin)) != '\n') /* error out work */ { if (i == EOF) goto Fail7; s [j++] = i; } s [j] = '\0'; printf ("The string entered is:\n"); i = fputs (s, stdout); if (i) goto Fail8; printf ("\n"); i = fputs (s, stderr); if (i) goto Fail9; printf ("\n"); saveStdin = stdin; stdin = freopen (fn1, "r", f1); /* reassign standard in */ if (stdin == NULL) goto Fail2; f3 = fopen (fn3, "w"); /* open stream to get new FILE ptr */ if (f3 == NULL) goto Fail; saveStdout = stdout; stdout = freopen (fn3, "w", f3); /* reassign standard out */ if (stdout == NULL) goto Fail2; saveStderr = stderr; f4 = fopen (fn4, "w"); /* open stream to get new FILE ptr */ if (f4 == NULL) goto Fail; stderr = freopen (fn4, "w", f4); /* reassign standard error */ if (stderr == NULL) goto Fail2; i = fscanf (stdin, "%s", s); /* read input string from file */ if (i == EOF) goto Fail7; i = puts (s); /* write string to files */ if (i) goto Fail8; i = fputs (s, stderr); if (i) goto Fail9; /* Now reset standard in, standard out, and standard error, and ensure */ /* they're ok. */ i = fclose (stdin); /* close disk files attached */ if (i == EOF) /* to stdin, stdout, stderr */ goto Fail4; i = fclose (stdout); if (i == EOF) goto Fail4; i = fclose (stderr); if (i == EOF) goto Fail4; stdin = saveStdin; /* reassign standard in */ stdout = saveStdout; /* reassign standard out */ stderr = saveStderr; /* reassign standard error */ printf ("Please enter a string\n"); /* Prompt the tester to input */ j = 0; /* a string & then check that*/ while ((i = fgetc (stdin)) != '\n') /* it's written to stdout & */ { /* stderr */ if (i == EOF) goto Fail7; s [j++] = i; } s [j] = '\0'; printf ("The string entered is:\n"); i = puts (s); if (i) goto Fail8; printf ("\n"); i = fputs (s, stderr); if (i) goto Fail9; printf ("\n"); printf ("Passed Special Conformance Test 17.2.0.3 "); return; Fail: perror ("File open failure in Special Conformance Test 17.2.0.3 "); exit (0); Fail2: printf ("Error when reopening stream\n"); exit (0); Fail3: printf ("Error when writing file\n"); exit (0); Fail4: printf ("Error when closing file\n"); exit (0); Fail5: printf ("Error when seeking file\n"); exit (0); Fail6: printf ("Error when appending to file\n"); exit (0); Fail7: printf ("Error when reading from standard in\n"); exit (0); Fail8: printf ("Error when writing to standard out\n"); exit (0); Fail9: printf ("Error when writing to standard error out\n"); exit (0); } \ No newline at end of file +/* */ +/* Special Conformance Test 17.2.0.3: Verification of freopen */ +/* */ +/* Other files needed: spc17.2.0.a - spc17.2.0.d - data files for the test */ +/* */ +/* Tester needs to verify that the files named spc17.2.0.a - spc17.2.0.d, */ +/* and located on the work prefix, have previously been created with the */ +/* test Special Conformance 17.2.0.2. */ +/* */ +/* The first action of the test will be to open spc17.2.0.a, and print its */ +/* contents on the screen. The tester needs to verify that the contents are */ +/* correct. */ +/* */ +/* The next action is to verify that standard input is working. The tester */ +/* will be prompted for a string; this string will then be written to both */ +/* standard out and standard error out. The tester needs to verify that the */ +/* output strings are correct. */ +/* */ +/* The test will then redirect standard in, standard out, and standard error */ +/* out. The contents of spc17.2.0.b will be sent to the files spc17.0.c, */ +/* the new standard out, and spc17.2.0.d, the new standard error out. The */ +/* tester needs to verify that the three files are identical. */ +/* */ +/* Finally, standard in, standard out, and standard error out will be reset */ +/* to their original values. The tester will be prompted for a new string */ +/* to be entered from the keyboard. The tester needs to verify that the */ +/* string is correctly echoed to the screen twice (once for standard out and */ +/* once for standard error out). */ +/* */ + +#include +#include + +main () + { + int i, j; + char s [255]; /* input buffer */ + + FILE *f1, *f2, *f3, *f4; + FILE *saveStdin, *saveStdout, *saveStderr; + + char fn1 [14] = "3/spc17.2.0.a"; /* define filenames */ + char fn2 [14] = "3/spc17.2.0.b"; + char fn3 [14] = "3/spc17.2.0.c"; + char fn4 [14] = "3/spc17.2.0.d"; + + f1 = fopen (fn1, "r"); /* open for reading */ + if (f1 == NULL) + goto Fail; + i = 0; + while ((j = fgetc (f1)) != EOF) /* read successive */ + s [i++] = (char) j; /* chars into string */ + s [i] = '\0'; + printf ("This is the contents of 3/spc17.2.0.a:\n%s\n", s); + + f1 = freopen (fn2, "a+", f1); /* reassign file pointer */ + if (f1 == NULL) + goto Fail2; + i = fseek (f1, 0L, SEEK_END); /* move to end of file */ + if (i) + goto Fail5; + i = fputs ("This is the second line of file 3/spc17.2.0.b", f1); + if (i == EOF) + goto Fail3; + rewind (f1); + i = 0; + while ((j = fgetc (f1)) != EOF) /* read successive */ + s [i++] = (char) j; /* chars into string */ + s [i] = '\0'; + printf ("\nThese are the updated contents of 3/spc17.2.0.b:\n%s\n", s); + + + /* This part of the test verifies reopening standard in, standard out, and */ + /* standard error out. */ + + printf ("Please enter a string\n"); /* 1st verify that standard in */ + j = 0; /* standard out and standard */ + while ((i = fgetc (stdin)) != '\n') /* error out work */ + { + if (i == EOF) + goto Fail7; + s [j++] = i; + } + s [j] = '\0'; + printf ("The string entered is:\n"); + i = fputs (s, stdout); + if (i) + goto Fail8; + printf ("\n"); + i = fputs (s, stderr); + if (i) + goto Fail9; + printf ("\n"); + + + saveStdin = stdin; + stdin = freopen (fn1, "r", f1); /* reassign standard in */ + if (stdin == NULL) + goto Fail2; + + f3 = fopen (fn3, "w"); /* open stream to get new FILE ptr */ + if (f3 == NULL) + goto Fail; + saveStdout = stdout; + stdout = freopen (fn3, "w", f3); /* reassign standard out */ + if (stdout == NULL) + goto Fail2; + + saveStderr = stderr; + f4 = fopen (fn4, "w"); /* open stream to get new FILE ptr */ + if (f4 == NULL) + goto Fail; + stderr = freopen (fn4, "w", f4); /* reassign standard error */ + if (stderr == NULL) + goto Fail2; + + i = fscanf (stdin, "%s", s); /* read input string from file */ + if (i == EOF) + goto Fail7; + i = puts (s); /* write string to files */ + if (i) + goto Fail8; + i = fputs (s, stderr); + if (i) + goto Fail9; + + + /* Now reset standard in, standard out, and standard error, and ensure */ + /* they're ok. */ + + i = fclose (stdin); /* close disk files attached */ + if (i == EOF) /* to stdin, stdout, stderr */ + goto Fail4; + i = fclose (stdout); + if (i == EOF) + goto Fail4; + i = fclose (stderr); + if (i == EOF) + goto Fail4; + + stdin = saveStdin; /* reassign standard in */ + stdout = saveStdout; /* reassign standard out */ + stderr = saveStderr; /* reassign standard error */ + + printf ("Please enter a string\n"); /* Prompt the tester to input */ + j = 0; /* a string & then check that*/ + while ((i = fgetc (stdin)) != '\n') /* it's written to stdout & */ + { /* stderr */ + if (i == EOF) + goto Fail7; + s [j++] = i; + } + s [j] = '\0'; + printf ("The string entered is:\n"); + i = puts (s); + if (i) + goto Fail8; + printf ("\n"); + i = fputs (s, stderr); + if (i) + goto Fail9; + printf ("\n"); + + printf ("Passed Special Conformance Test 17.2.0.3 "); + return; + +Fail: + perror ("File open failure in Special Conformance Test 17.2.0.3 "); + exit (0); + +Fail2: + printf ("Error when reopening stream\n"); + exit (0); + +Fail3: + printf ("Error when writing file\n"); + exit (0); + +Fail4: + printf ("Error when closing file\n"); + exit (0); + +Fail5: + printf ("Error when seeking file\n"); + exit (0); + +Fail6: + printf ("Error when appending to file\n"); + exit (0); + +Fail7: + printf ("Error when reading from standard in\n"); + exit (0); + +Fail8: + printf ("Error when writing to standard out\n"); + exit (0); + +Fail9: + printf ("Error when writing to standard error out\n"); + exit (0); + } diff --git a/Tests/Spec.Conform/SPC17.3.0.1.CC b/Tests/Spec.Conform/SPC17.3.0.1.CC old mode 100755 new mode 100644 index a9ec202..1c0bbaa --- a/Tests/Spec.Conform/SPC17.3.0.1.CC +++ b/Tests/Spec.Conform/SPC17.3.0.1.CC @@ -1 +1,69 @@ -/* Special Conformance Test 17.3.0.1: Verification of buffering facility */ /* setvbuf. */ /* */ /* Tester needs to verify that the file 3/tmp is created and contains the */ /* following characters: ASCII $20 through $6E, plus ~ and } */ #include main () { FILE *f1; /* file pointer */ char buf [80]; /* buffer */ int i, j; f1 = fopen ("3/tmp", "w"); /* create file to work on */ if (f1 == NULL) goto Fail1; i = setvbuf (f1, buf, _IOFBF, 80); /* allocate write buffer for file */ if (i) goto Fail2; for (i = 0; i < 79; i++) /* write 79 charaters to the file */ { j = fputc ( (char) (i + 0x20), f1); if (j == EOF) goto Fail3; } for (j = 0x20, i = 0; i < 79; i++) /* check buffer contents */ if (buf [i] != j++) goto Fail; j = fputc ('~', f1); /* 2 more chars should cause*/ if (j == EOF) /* buffer to be flushed */ goto Fail3; j = fputc ('}', f1); if (j == EOF) goto Fail3; if (buf [0] != '}') goto Fail; i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail4; printf ("Passed Special Conformance Test 17.3.0.1\n"); return; Fail: printf ("Failed Special Conformance Test 17.3.0.1\n"); return; Fail1: printf ("Could not open tmp file for Special Conformance Test 17.3.0.1\n"); return; Fail2: printf ("Could not allocate buffer for Special Conformance Test 17.3.0.1\n"); return; Fail3: printf ("Could not write to file for Special Conformance Test 17.3.0.1\n"); return; Fail4: printf ("Could not close file for Special Conformance Test 17.3.0.1\n"); return; } \ No newline at end of file +/* Special Conformance Test 17.3.0.1: Verification of buffering facility */ +/* setvbuf. */ +/* */ +/* Tester needs to verify that the file 3/tmp is created and contains the */ +/* following characters: ASCII $20 through $6E, plus ~ and } */ + +#include + +main () + { + FILE *f1; /* file pointer */ + char buf [80]; /* buffer */ + int i, j; + + + f1 = fopen ("3/tmp", "w"); /* create file to work on */ + if (f1 == NULL) + goto Fail1; + i = setvbuf (f1, buf, _IOFBF, 80); /* allocate write buffer for file */ + if (i) + goto Fail2; + for (i = 0; i < 79; i++) /* write 79 charaters to the file */ + { + j = fputc ( (char) (i + 0x20), f1); + if (j == EOF) + goto Fail3; + } + + for (j = 0x20, i = 0; i < 79; i++) /* check buffer contents */ + if (buf [i] != j++) + goto Fail; + + j = fputc ('~', f1); /* 2 more chars should cause*/ + if (j == EOF) /* buffer to be flushed */ + goto Fail3; + j = fputc ('}', f1); + if (j == EOF) + goto Fail3; + if (buf [0] != '}') + goto Fail; + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail4; + + printf ("Passed Special Conformance Test 17.3.0.1\n"); + return; + +Fail: + printf ("Failed Special Conformance Test 17.3.0.1\n"); + return; + +Fail1: + printf ("Could not open tmp file for Special Conformance Test 17.3.0.1\n"); + return; + +Fail2: + printf ("Could not allocate buffer for Special Conformance Test 17.3.0.1\n"); + return; + +Fail3: + printf ("Could not write to file for Special Conformance Test 17.3.0.1\n"); + return; + +Fail4: + printf ("Could not close file for Special Conformance Test 17.3.0.1\n"); + return; + + } diff --git a/Tests/Spec.Conform/SPC17.3.0.2.CC b/Tests/Spec.Conform/SPC17.3.0.2.CC old mode 100755 new mode 100644 index d748041..f524f9a --- a/Tests/Spec.Conform/SPC17.3.0.2.CC +++ b/Tests/Spec.Conform/SPC17.3.0.2.CC @@ -1 +1,68 @@ -/* Special Conformance Test 17.3.0.2: Verification of buffering facility */ /* setvbuf using line buffering. */ /* */ /* Tester needs to verify that the file 3/tmp is created and contains the */ /* 2 lines: all good people are here */ /* ...and maybe some 'bad' ones, too */ #include #include main () { FILE *f1; /* file pointer */ char buf [80]; /* buffer */ int i, j; f1 = fopen ("3/tmp", "w"); /* create file to work on */ if (f1 == NULL) goto Fail1; i = setvbuf (f1, buf, _IOLBF, 80); /* allocate write buffer for file */ if (i) goto Fail2; i = fputs ("all good people are here\n", f1); /* write 1 line to the file */ if (i) goto Fail3; if (strncmp (buf, "all good people are here", 24)) /* check buffer */ goto Fail; /* contents */ i = fputs ("...and maybe some 'bad' ones, too\n", f1);/* write 1 more line */ if (i) /* to the file */ goto Fail3; /* Check buffer contents again */ if (strncmp (buf, "...and maybe some 'bad' ones, too", 33)) goto Fail; i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail4; printf ("Passed Special Conformance Test 17.3.0.2\n"); return; Fail: printf ("Failed Special Conformance Test 17.3.0.2\n"); return; Fail1: printf ("Could not open tmp file for Special Conformance Test 17.3.0.2\n"); return; Fail2: printf ("Could not allocate buffer for Special Conformance Test 17.3.0.2\n"); return; Fail3: printf ("Could not write to file for Special Conformance Test 17.3.0.2\n"); return; Fail4: printf ("Could not close file for Special Conformance Test 17.3.0.2\n"); return; } \ No newline at end of file +/* Special Conformance Test 17.3.0.2: Verification of buffering facility */ +/* setvbuf using line buffering. */ +/* */ +/* Tester needs to verify that the file 3/tmp is created and contains the */ +/* 2 lines: all good people are here */ +/* ...and maybe some 'bad' ones, too */ + +#include +#include + +main () + { + FILE *f1; /* file pointer */ + char buf [80]; /* buffer */ + int i, j; + + + f1 = fopen ("3/tmp", "w"); /* create file to work on */ + if (f1 == NULL) + goto Fail1; + + i = setvbuf (f1, buf, _IOLBF, 80); /* allocate write buffer for file */ + if (i) + goto Fail2; + + i = fputs ("all good people are here\n", f1); /* write 1 line to the file */ + if (i) + goto Fail3; + + if (strncmp (buf, "all good people are here", 24)) /* check buffer */ + goto Fail; /* contents */ + + i = fputs ("...and maybe some 'bad' ones, too\n", f1);/* write 1 more line */ + if (i) /* to the file */ + goto Fail3; + + /* Check buffer contents again */ + + if (strncmp (buf, "...and maybe some 'bad' ones, too", 33)) + goto Fail; + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail4; + + printf ("Passed Special Conformance Test 17.3.0.2\n"); + return; + +Fail: + printf ("Failed Special Conformance Test 17.3.0.2\n"); + return; + +Fail1: + printf ("Could not open tmp file for Special Conformance Test 17.3.0.2\n"); + return; + +Fail2: + printf ("Could not allocate buffer for Special Conformance Test 17.3.0.2\n"); + return; + +Fail3: + printf ("Could not write to file for Special Conformance Test 17.3.0.2\n"); + return; + +Fail4: + printf ("Could not close file for Special Conformance Test 17.3.0.2\n"); + return; + } diff --git a/Tests/Spec.Conform/SPC17.3.0.3.CC b/Tests/Spec.Conform/SPC17.3.0.3.CC old mode 100755 new mode 100644 index 9ebc459..2f47943 --- a/Tests/Spec.Conform/SPC17.3.0.3.CC +++ b/Tests/Spec.Conform/SPC17.3.0.3.CC @@ -1 +1,51 @@ -/* Special Conformance Test 17.3.0.3: Verification of buffering facility */ /* setvbuf: no buffering */ /* */ /* Tester needs to verify that the file 3/tmp is created and contains the */ /* lower case alphabetic characters. */ #include main () { FILE *f1; /* file pointer */ int i, j; char c; f1 = fopen ("3/tmp", "w"); /* create file to work on */ if (f1 == NULL) goto Fail1; i = setvbuf (f1, NULL, _IONBF, 0); /* allocate write buffer for file */ if (i) goto Fail2; for (c = 'a', i = 0; i < 26; i++, c++) /* write 26 charaters to the file */ { j = fputc (c, f1); if (j == EOF) goto Fail3; } i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail4; printf ("Passed Special Conformance Test 17.3.0.3\n"); return; Fail1: printf ("Could not open tmp file for Special Conformance Test 17.3.0.3\n"); return; Fail2: printf ("setvbuf command failed in Special Conformance Test 17.3.0.3\n"); return; Fail3: printf ("Could not write to file for Special Conformance Test 17.3.0.3\n"); return; Fail4: printf ("Could not close file for Special Conformance Test 17.3.0.3\n"); return; } \ No newline at end of file +/* Special Conformance Test 17.3.0.3: Verification of buffering facility */ +/* setvbuf: no buffering */ +/* */ +/* Tester needs to verify that the file 3/tmp is created and contains the */ +/* lower case alphabetic characters. */ + +#include + +main () + { + FILE *f1; /* file pointer */ + int i, j; + char c; + + f1 = fopen ("3/tmp", "w"); /* create file to work on */ + if (f1 == NULL) + goto Fail1; + i = setvbuf (f1, NULL, _IONBF, 0); /* allocate write buffer for file */ + if (i) + goto Fail2; + for (c = 'a', i = 0; i < 26; i++, c++) /* write 26 charaters to the file */ + { + j = fputc (c, f1); + if (j == EOF) + goto Fail3; + } + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail4; + + printf ("Passed Special Conformance Test 17.3.0.3\n"); + return; + +Fail1: + printf ("Could not open tmp file for Special Conformance Test 17.3.0.3\n"); + return; + +Fail2: + printf ("setvbuf command failed in Special Conformance Test 17.3.0.3\n"); + return; + +Fail3: + printf ("Could not write to file for Special Conformance Test 17.3.0.3\n"); + return; + +Fail4: + printf ("Could not close file for Special Conformance Test 17.3.0.3\n"); + return; + + } diff --git a/Tests/Spec.Conform/SPC17.3.0.4.CC b/Tests/Spec.Conform/SPC17.3.0.4.CC old mode 100755 new mode 100644 index 82976a6..4ad9ede --- a/Tests/Spec.Conform/SPC17.3.0.4.CC +++ b/Tests/Spec.Conform/SPC17.3.0.4.CC @@ -1 +1,72 @@ -/* Special Conformance Test 17.3.0.4: Verification of buffering facility */ /* setbuf. */ /* */ /* Tester needs to verify that the file 3/tmp is created and contains the */ /* following characters: ASCII $20 through $6E, plus ~ and } */ #include static char buf [BUFSIZ]; main () { int count = 0; FILE *f1; /* file pointer */ char ch; int i, j; long L; count++; f1 = fopen ("3/tmp", "w"); /* create file to work on */ if (f1 == NULL) goto Fail1; setbuf (f1, buf); /* allocate write buffer for file */ /* just hope it works */ for (ch = ' ', i = 0; i < 30; ch++, i++) /* write 30 chars to the file */ { j = fputc (ch, f1); if (j == EOF) goto Fail2; } for (j = 0x20, i = 0; i < 30; i++) /* check buffer contents */ if (buf [i] != j++) goto Fail; count++; for (L = 30; L < BUFSIZ; L++) /* fill buffer so that it'll */ { /* be flushed */ j = fputc ('a', f1); if (j == EOF) goto Fail2; } j = fputc ('~', f1); /* write 1 more char to buf */ if (j == EOF) /* & then check contents */ goto Fail2; if (buf [0] != '~') goto Fail; i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail3; printf ("Passed Special Conformance Test 17.3.0.4\n"); return; Fail: printf ("Failed Special Conformance Test 17.3.0.4: count = %d\n", count); return; Fail1: printf ("Could not open tmp file for Special Conformance Test 17.3.0.4\n"); return; Fail2: printf ("Could not write to file for Special Conformance Test 17.3.0.4\n"); return; Fail3: printf ("Could not close file for Special Conformance Test 17.3.0.4\n"); return; } \ No newline at end of file +/* Special Conformance Test 17.3.0.4: Verification of buffering facility */ +/* setbuf. */ +/* */ +/* Tester needs to verify that the file 3/tmp is created and contains the */ +/* following characters: ASCII $20 through $6E, plus ~ and } */ + +#include +static char buf [BUFSIZ]; + +main () + { + int count = 0; + FILE *f1; /* file pointer */ + char ch; + int i, j; + long L; + + count++; + f1 = fopen ("3/tmp", "w"); /* create file to work on */ + if (f1 == NULL) + goto Fail1; + setbuf (f1, buf); /* allocate write buffer for file */ + /* just hope it works */ + for (ch = ' ', i = 0; i < 30; ch++, i++) /* write 30 chars to the file */ + { + j = fputc (ch, f1); + if (j == EOF) + goto Fail2; + } + + for (j = 0x20, i = 0; i < 30; i++) /* check buffer contents */ + if (buf [i] != j++) + goto Fail; + + count++; + for (L = 30; L < BUFSIZ; L++) /* fill buffer so that it'll */ + { /* be flushed */ + j = fputc ('a', f1); + if (j == EOF) + goto Fail2; + } + + j = fputc ('~', f1); /* write 1 more char to buf */ + if (j == EOF) /* & then check contents */ + goto Fail2; + if (buf [0] != '~') + goto Fail; + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail3; + + printf ("Passed Special Conformance Test 17.3.0.4\n"); + return; + +Fail: + printf ("Failed Special Conformance Test 17.3.0.4: count = %d\n", count); + return; + +Fail1: + printf ("Could not open tmp file for Special Conformance Test 17.3.0.4\n"); + return; + +Fail2: + printf ("Could not write to file for Special Conformance Test 17.3.0.4\n"); + return; + +Fail3: + printf ("Could not close file for Special Conformance Test 17.3.0.4\n"); + return; + + } diff --git a/Tests/Spec.Conform/SPC17.3.0.5.CC b/Tests/Spec.Conform/SPC17.3.0.5.CC old mode 100755 new mode 100644 index e45221d..10866f2 --- a/Tests/Spec.Conform/SPC17.3.0.5.CC +++ b/Tests/Spec.Conform/SPC17.3.0.5.CC @@ -1 +1,52 @@ -/* */ /* Special Conformance Test 17.3.0.5: Verification of buffering facility */ /* setbuf. */ /* */ /* Tester needs to verify that the file 3/tmp is created and contains the */ /* 26 uppercase alphabetic characters. */ /* */ #include main () { FILE *f1; /* file pointer */ int i, j; char ch; f1 = fopen ("3/tmp", "w"); /* create file to work on */ if (f1 == NULL) goto Fail1; setbuf (f1, NULL); /* specify no buffering for file */ /* just hope it works */ for (ch = 'A', i = 0; i < 26; ch++, i++) /* write 79 chars to the file */ { j = fputc (ch, f1); if (j == EOF) goto Fail2; } i = fclose (f1); /* close the file and quit */ if (i == EOF) goto Fail3; printf ("Passed Special Conformance Test 17.3.0.5\n"); return; Fail: printf ("Failed Special Conformance Test 17.3.0.5\n"); return; Fail1: printf ("Could not open tmp file for Special Conformance Test 17.3.0.5\n"); return; Fail2: printf ("Could not write to file for Special Conformance Test 17.3.0.5\n"); return; Fail3: printf ("Could not close file for Special Conformance Test 17.3.0.5\n"); return; } \ No newline at end of file +/* */ +/* Special Conformance Test 17.3.0.5: Verification of buffering facility */ +/* setbuf. */ +/* */ +/* Tester needs to verify that the file 3/tmp is created and contains the */ +/* 26 uppercase alphabetic characters. */ +/* */ + +#include + +main () + { + FILE *f1; /* file pointer */ + int i, j; + char ch; + + f1 = fopen ("3/tmp", "w"); /* create file to work on */ + if (f1 == NULL) + goto Fail1; + setbuf (f1, NULL); /* specify no buffering for file */ + /* just hope it works */ + for (ch = 'A', i = 0; i < 26; ch++, i++) /* write 79 chars to the file */ + { + j = fputc (ch, f1); + if (j == EOF) + goto Fail2; + } + + i = fclose (f1); /* close the file and quit */ + if (i == EOF) + goto Fail3; + + printf ("Passed Special Conformance Test 17.3.0.5\n"); + return; + +Fail: + printf ("Failed Special Conformance Test 17.3.0.5\n"); + return; + +Fail1: + printf ("Could not open tmp file for Special Conformance Test 17.3.0.5\n"); + return; + +Fail2: + printf ("Could not write to file for Special Conformance Test 17.3.0.5\n"); + return; + +Fail3: + printf ("Could not close file for Special Conformance Test 17.3.0.5\n"); + return; + + } diff --git a/Tests/Spec.Conform/SPC17.6.0.1.CC b/Tests/Spec.Conform/SPC17.6.0.1.CC old mode 100755 new mode 100644 index 92df9cf..e99df1a --- a/Tests/Spec.Conform/SPC17.6.0.1.CC +++ b/Tests/Spec.Conform/SPC17.6.0.1.CC @@ -1 +1,242 @@ -/* Special Conformance Test 17.6.0.1: Verification of fgetc, getc, getchar, */ /* and ungetc with standard input */ /* */ /* The first action of the test is to verify that standard input is working. */ /* The tester will be prompted for a string three times (once each for fgetc,*/ /* getc, and getchar); this string will then be echoed to standard out and to*/ /* standard error out. The tester needs to verify that the output string is */ /* correct. */ /* */ /* The test will then redirect standard input to a temporary file created on */ /* the work prefix. The tester needs to verify that the characters sent to */ /* standard output and standard error output are the lower case alphabetic */ /* characters. */ /* */ /* Finally, standard input is reset to the keyboard. The tester will be */ /* prompted for a new string to be entered from the keyboard. The tester */ /* needs to verify that the string is correctly echoed to the screen. */ #include #include main () { int i, j; char s [255], ch; FILE *f1, *saveStdin; /* This part of the test that standard input and standard output are working */ printf ("Please enter a string\n"); /* test fgetc with standard in */ j = 0; while ((i = fgetc (stdin)) != '\n') { if (i == EOF) goto Fail3; s [j++] = i; } s [j] = '\0'; printf ("The string entered is:\n"); i = fputs (s, stdout); if (i) goto Fail4; printf ("\n"); i = fputs (s, stderr); if (i) goto Fail5; printf ("\n"); printf ("Please enter a string\n"); /* test getc with standard in */ j = 0; while ((i = getc (stdin)) != '\n') { if (i == EOF) goto Fail3; s [j++] = i; } s [j] = '\0'; printf ("The string entered is:\n"); i = fputs (s, stdout); if (i) goto Fail4; printf ("\n"); i = fputs (s, stderr); if (i) goto Fail5; printf ("\n"); printf ("Please enter a string\n"); /* test getchar */ j = 0; while ( (i = getchar ()) != '\n' ) { if (i == EOF) goto Fail3; s [j++] = i; } s [j] = '\0'; printf ("The string entered is:\n"); i = fputs (s, stdout); if (i) goto Fail4; printf ("\n"); i = fputs (s, stderr); if (i) goto Fail5; printf ("\n"); /* Now test fgetc, getc, and getchar by redirecting standard input. */ f1 = fopen ("3/tmp", "w"); /* create new file */ if (f1 == NULL) goto Fail; for (ch = 'a', i = 0; i < 26; i++) { j = fputc (ch, f1); if ( (char) j != ch ) goto Fail2; ch++; } j = fputc ('\n', f1); if (j != '\n') goto Fail2; saveStdin = stdin; stdin = freopen ("3/tmp", "r", f1); /* reassign standard in */ if (stdin == NULL) goto Fail1; j = 0; /* read file with fgetc */ while ( (i = fgetc (stdin)) != EOF) { putchar(i); s [j++] = i; } s [j] = '\0'; if (! feof (stdin) ) goto Fail3; printf ("The string read from the temp file is:\n"); i = fputs (s, stdout); if (i) goto Fail4; i = fputs (s, stderr); if (i) goto Fail5; rewind (stdin); /* read file with getc */ j = 0; while ( (i = getc (stdin)) != EOF) s [j++] = i; s [j] = '\0'; if (! feof (stdin) ) goto Fail3; printf ("The string read from the temp file is:\n"); i = fputs (s, stdout); if (i) goto Fail4; i = fputs (s, stderr); if (i) goto Fail5; rewind (stdin); /* read file with getchar */ j = 0; while ( (i = getchar ()) != EOF) s [j++] = i; s [j] = '\0'; if (! feof (stdin) ) goto Fail3; printf ("The string read from the temp file is:\n"); i = fputs (s, stdout); if (i) goto Fail4; i = fputs (s, stderr); if (i) goto Fail5; /* Now reset standard input and ensure it's ok. */ stdin = saveStdin; /* reassign standard in */ printf ("Please enter a string\n"); /* read standard in with fgetc */ j = 0; while ((i = fgetc (stdin)) != '\n') { if (i == EOF) goto Fail3; s [j++] = i; } s [j] = '\0'; printf ("The string entered is:\n"); i = fputs (s, stdout); if (i) goto Fail4; printf ("\n"); i = fputs (s, stderr); if (i) goto Fail5; printf ("\n"); printf ("Please enter a string\n"); /* read standard in with getc */ j = 0; while ((i = getc (stdin)) != '\n') { if (i == EOF) goto Fail3; s [j++] = i; } s [j] = '\0'; printf ("The string entered is:\n"); i = fputs (s, stdout); if (i) goto Fail4; printf ("\n"); i = fputs (s, stderr); if (i) goto Fail5; printf ("\n"); printf ("Please enter a string\n"); /* read standard in with getchar */ j = 0; while ( (i = getchar ()) != '\n' ) { if (i == EOF) goto Fail3; s [j++] = i; } s [j] = '\0'; printf ("The string entered is:\n"); i = fputs (s, stdout); if (i) goto Fail4; printf ("\n"); i = fputs (s, stderr); if (i) goto Fail5; printf ("\n"); return; Fail: perror ("File open failure in Special Conformance Test 17.6.0.1 "); exit (0); Fail1: printf ("Error when reopening stream\n"); exit (0); Fail2: printf ("Error when writing file\n"); exit (0); Fail3: printf ("Error when reading from standard in\n"); exit (0); Fail4: printf ("Error when writing to standard out\n"); exit (0); Fail5: printf ("Error when writing to standard error out\n"); exit (0); } \ No newline at end of file +/* Special Conformance Test 17.6.0.1: Verification of fgetc, getc, getchar, */ +/* and ungetc with standard input */ +/* */ +/* The first action of the test is to verify that standard input is working. */ +/* The tester will be prompted for a string three times (once each for fgetc,*/ +/* getc, and getchar); this string will then be echoed to standard out and to*/ +/* standard error out. The tester needs to verify that the output string is */ +/* correct. */ +/* */ +/* The test will then redirect standard input to a temporary file created on */ +/* the work prefix. The tester needs to verify that the characters sent to */ +/* standard output and standard error output are the lower case alphabetic */ +/* characters. */ +/* */ +/* Finally, standard input is reset to the keyboard. The tester will be */ +/* prompted for a new string to be entered from the keyboard. The tester */ +/* needs to verify that the string is correctly echoed to the screen. */ + +#include +#include + +main () + { + int i, j; + char s [255], ch; + FILE *f1, *saveStdin; + + + /* This part of the test that standard input and standard output are working */ + + printf ("Please enter a string\n"); /* test fgetc with standard in */ + j = 0; + while ((i = fgetc (stdin)) != '\n') + { + if (i == EOF) + goto Fail3; + s [j++] = i; + } + s [j] = '\0'; + printf ("The string entered is:\n"); + i = fputs (s, stdout); + if (i) + goto Fail4; + printf ("\n"); + i = fputs (s, stderr); + if (i) + goto Fail5; + printf ("\n"); + + printf ("Please enter a string\n"); /* test getc with standard in */ + j = 0; + while ((i = getc (stdin)) != '\n') + { + if (i == EOF) + goto Fail3; + s [j++] = i; + } + s [j] = '\0'; + printf ("The string entered is:\n"); + i = fputs (s, stdout); + if (i) + goto Fail4; + printf ("\n"); + i = fputs (s, stderr); + if (i) + goto Fail5; + printf ("\n"); + + printf ("Please enter a string\n"); /* test getchar */ + j = 0; + while ( (i = getchar ()) != '\n' ) + { + if (i == EOF) + goto Fail3; + s [j++] = i; + } + s [j] = '\0'; + printf ("The string entered is:\n"); + i = fputs (s, stdout); + if (i) + goto Fail4; + printf ("\n"); + i = fputs (s, stderr); + if (i) + goto Fail5; + printf ("\n"); + + + /* Now test fgetc, getc, and getchar by redirecting standard input. */ + + f1 = fopen ("3/tmp", "w"); /* create new file */ + if (f1 == NULL) + goto Fail; + for (ch = 'a', i = 0; i < 26; i++) + { + j = fputc (ch, f1); + if ( (char) j != ch ) + goto Fail2; + ch++; + } + j = fputc ('\n', f1); + if (j != '\n') + goto Fail2; + + saveStdin = stdin; + stdin = freopen ("3/tmp", "r", f1); /* reassign standard in */ + if (stdin == NULL) + goto Fail1; + + j = 0; /* read file with fgetc */ + while ( (i = fgetc (stdin)) != EOF) { + putchar(i); + s [j++] = i; + } + s [j] = '\0'; + if (! feof (stdin) ) + goto Fail3; + printf ("The string read from the temp file is:\n"); + i = fputs (s, stdout); + if (i) + goto Fail4; + i = fputs (s, stderr); + if (i) + goto Fail5; + + rewind (stdin); /* read file with getc */ + j = 0; + while ( (i = getc (stdin)) != EOF) + s [j++] = i; + s [j] = '\0'; + if (! feof (stdin) ) + goto Fail3; + printf ("The string read from the temp file is:\n"); + i = fputs (s, stdout); + if (i) + goto Fail4; + i = fputs (s, stderr); + if (i) + goto Fail5; + + rewind (stdin); /* read file with getchar */ + j = 0; + while ( (i = getchar ()) != EOF) + s [j++] = i; + s [j] = '\0'; + if (! feof (stdin) ) + goto Fail3; + printf ("The string read from the temp file is:\n"); + i = fputs (s, stdout); + if (i) + goto Fail4; + i = fputs (s, stderr); + if (i) + goto Fail5; + + + /* Now reset standard input and ensure it's ok. */ + + stdin = saveStdin; /* reassign standard in */ + printf ("Please enter a string\n"); /* read standard in with fgetc */ + j = 0; + while ((i = fgetc (stdin)) != '\n') + { + if (i == EOF) + goto Fail3; + s [j++] = i; + } + s [j] = '\0'; + printf ("The string entered is:\n"); + i = fputs (s, stdout); + if (i) + goto Fail4; + printf ("\n"); + i = fputs (s, stderr); + if (i) + goto Fail5; + printf ("\n"); + + printf ("Please enter a string\n"); /* read standard in with getc */ + j = 0; + while ((i = getc (stdin)) != '\n') + { + if (i == EOF) + goto Fail3; + s [j++] = i; + } + s [j] = '\0'; + printf ("The string entered is:\n"); + i = fputs (s, stdout); + if (i) + goto Fail4; + printf ("\n"); + i = fputs (s, stderr); + if (i) + goto Fail5; + printf ("\n"); + + printf ("Please enter a string\n"); /* read standard in with getchar */ + j = 0; + while ( (i = getchar ()) != '\n' ) + { + if (i == EOF) + goto Fail3; + s [j++] = i; + } + s [j] = '\0'; + printf ("The string entered is:\n"); + i = fputs (s, stdout); + if (i) + goto Fail4; + printf ("\n"); + i = fputs (s, stderr); + if (i) + goto Fail5; + printf ("\n"); + + return; + +Fail: + perror ("File open failure in Special Conformance Test 17.6.0.1 "); + exit (0); + +Fail1: + printf ("Error when reopening stream\n"); + exit (0); + +Fail2: + printf ("Error when writing file\n"); + exit (0); + +Fail3: + printf ("Error when reading from standard in\n"); + exit (0); + +Fail4: + printf ("Error when writing to standard out\n"); + exit (0); + +Fail5: + printf ("Error when writing to standard error out\n"); + exit (0); + } diff --git a/Tests/Spec.Conform/SPC17.7.0.1.CC b/Tests/Spec.Conform/SPC17.7.0.1.CC old mode 100755 new mode 100644 index c618e74..da2bfa6 --- a/Tests/Spec.Conform/SPC17.7.0.1.CC +++ b/Tests/Spec.Conform/SPC17.7.0.1.CC @@ -1 +1,74 @@ -/* Special Conformance Test 17.7.0.1: Verification of gets function */ /* */ /* The tester will be asked to enter some strings. The strings will */ /* then be echoed to the screen. The strings should be verified */ /* that they are the same as those entered. */ #include main () { int i; char string [20] = ""; /* initialize input string to null string */ char *strPtr; printf ("Please enter a string which is shorter than 20 characters.\n"); printf ("Signal string is complete with CR.\n"); strPtr = gets (string); /* test reading until CR seen */ if (strPtr == NULL) goto Fail; printf ("The string entered was:\n"); i = puts (string); if (i) goto Fail1; printf ("This message should appear immediately below the string.\n"); printf ("Please enter only the end-of-file character sequence (CTRL@)\n"); strPtr = gets (string); /* test reading with EOF seen before */ if (strPtr != NULL) /* any other characters */ goto Fail2; if (! feof (stdin)) goto Fail3; i = fseek (stdin, 0L, SEEK_CUR); /* clear EOF indication */ if (i) goto Fail4; printf ("The first string entered was:\n"); /* string shouldn't change */ i = puts (string); if (i) goto Fail1; printf ("\n"); printf ("Please enter a string which is shorter than 20 characters.\n"); strPtr = gets (string); /* test reading until CR seen */ if (strPtr == NULL) goto Fail; printf ("The string entered was:\n"); i = puts (string); if (i) goto Fail1; printf ("This message should appear immediately below the string.\n"); return 0; Fail: printf ("Failed Special Conformance Test 17.7.0.1\n"); return 0; Fail1: printf ("Unable to write to standard out\n"); return 0; Fail2: printf ("Reading EOF before any other chars doesn't return NULL ptr\n"); return 0; Fail3: printf ("EOF for standard input not detected\n"); return 0; Fail4: printf ("Unable to FSEEK on stdin\n"); return 0; } \ No newline at end of file +/* Special Conformance Test 17.7.0.1: Verification of gets function */ +/* */ +/* The tester will be asked to enter some strings. The strings will */ +/* then be echoed to the screen. The strings should be verified */ +/* that they are the same as those entered. */ + +#include + +main () + { + int i; + char string [20] = ""; /* initialize input string to null string */ + char *strPtr; + + + printf ("Please enter a string which is shorter than 20 characters.\n"); + printf ("Signal string is complete with CR.\n"); + strPtr = gets (string); /* test reading until CR seen */ + if (strPtr == NULL) + goto Fail; + printf ("The string entered was:\n"); + i = puts (string); + if (i) + goto Fail1; + printf ("This message should appear immediately below the string.\n"); + + printf ("Please enter only the end-of-file character sequence (CTRL@)\n"); + strPtr = gets (string); /* test reading with EOF seen before */ + if (strPtr != NULL) /* any other characters */ + goto Fail2; + if (! feof (stdin)) + goto Fail3; + i = fseek (stdin, 0L, SEEK_CUR); /* clear EOF indication */ + if (i) + goto Fail4; + + printf ("The first string entered was:\n"); /* string shouldn't change */ + i = puts (string); + if (i) + goto Fail1; + printf ("\n"); + + printf ("Please enter a string which is shorter than 20 characters.\n"); + strPtr = gets (string); /* test reading until CR seen */ + if (strPtr == NULL) + goto Fail; + printf ("The string entered was:\n"); + i = puts (string); + if (i) + goto Fail1; + printf ("This message should appear immediately below the string.\n"); + + return 0; + +Fail: + printf ("Failed Special Conformance Test 17.7.0.1\n"); + return 0; + +Fail1: + printf ("Unable to write to standard out\n"); + return 0; + +Fail2: + printf ("Reading EOF before any other chars doesn't return NULL ptr\n"); + return 0; + +Fail3: + printf ("EOF for standard input not detected\n"); + return 0; + +Fail4: + printf ("Unable to FSEEK on stdin\n"); + return 0; + } diff --git a/Tests/Spec.Conform/SPC2.1.0.1.CC b/Tests/Spec.Conform/SPC2.1.0.1.CC old mode 100755 new mode 100644 index b5bceb3..5fc47d8 --- a/Tests/Spec.Conform/SPC2.1.0.1.CC +++ b/Tests/Spec.Conform/SPC2.1.0.1.CC @@ -1 +1,15 @@ -/* Special Conformance Test 2.1.0.1: Verification of character set */ #include main () { int c; /* Read chars from keyboard; echo to a device. Tester must */ /* check correct output of characters. The test should be */ /* repeated 3 times, with output going to console, to printer */ /* and to a file. */ while ((c = getchar ()) != EOF) putchar (c); } \ No newline at end of file +/* Special Conformance Test 2.1.0.1: Verification of character set */ + +#include + +main () + { + int c; + + /* Read chars from keyboard; echo to a device. Tester must */ + /* check correct output of characters. The test should be */ + /* repeated 3 times, with output going to console, to printer */ + /* and to a file. */ + while ((c = getchar ()) != EOF) + putchar (c); + } diff --git a/Tests/Spec.Conform/SPC20.2.0.1.CC b/Tests/Spec.Conform/SPC20.2.0.1.CC old mode 100755 new mode 100644 index e3ae276..4c8a555 --- a/Tests/Spec.Conform/SPC20.2.0.1.CC +++ b/Tests/Spec.Conform/SPC20.2.0.1.CC @@ -1 +1,79 @@ -/* Special Conformance Test 20.2.0.1: Verification of time, asctime, ctime, */ /* localtime, gmtime, mktime, difftime */ /* */ /* The tester needs to verify that the printed time is accurate for the */ /* current clock setting of machine. */ #include #include main () { time_t secondTime, theTime, *tptr = &theTime; char *timeString; struct tm *TM; double d; theTime = time (tptr); /* call time to get current date & time */ if (theTime == -1) /* represented as an integral type */ goto Fail; if (theTime != *tptr) goto Fail; /* Call ctime to get current date/time in the form: */ /* Day Mon 99 99:99:99 yyyy\n\0 where Day = day of week; Mon = month; */ /* 99 = day of month; 99:99:99 = current hour:min:sec; yyyy = current year */ timeString = ctime (tptr); printf ("The current date/time is: %s\n", timeString); /* Call localtime and gmtime and then echo the fields to the screen. */ TM = localtime (tptr); if (TM == NULL) goto Fail; printf ("localtime is:\n"); printf ("sec = %d min = %d hour = %d day = %d month = %d year = %d\n", TM->tm_sec, TM->tm_min, TM->tm_hour, TM->tm_mday, TM->tm_mon, TM->tm_year); printf ("day of week = %d day of year = %d not daylight savings = %d\n\n", TM->tm_wday, TM->tm_yday, TM->tm_isdst); TM = gmtime (tptr); if (TM == NULL) goto Fail; printf ("gmtime is:\n"); printf ("sec = %d min = %d hour = %d day = %d month = %d year = %d\n", TM->tm_sec, TM->tm_min, TM->tm_hour, TM->tm_mday, TM->tm_mon, TM->tm_year); printf ("day of week = %d day of year = %d not daylight savings = %d\n\n", TM->tm_wday, TM->tm_yday, TM->tm_isdst); /* Test mktime: should return original time as returned by time. */ secondTime = mktime (TM); if (secondTime != theTime) goto Fail; /* Test asctime: should return same time as returned by ctime. */ timeString = asctime (TM); printf ("The current date/time is: %s\n", timeString); /* Test difftime. Value returned should be zero. */ d = difftime (theTime, secondTime); if (d != 0.0) goto Fail; return; Fail: printf ("Call to a time function in spc20.2.0.1\n"); } \ No newline at end of file +/* Special Conformance Test 20.2.0.1: Verification of time, asctime, ctime, */ +/* localtime, gmtime, mktime, difftime */ +/* */ +/* The tester needs to verify that the printed time is accurate for the */ +/* current clock setting of machine. */ + +#include +#include + +main () + { + time_t secondTime, theTime, *tptr = &theTime; + char *timeString; + struct tm *TM; + double d; + + + theTime = time (tptr); /* call time to get current date & time */ + if (theTime == -1) /* represented as an integral type */ + goto Fail; + if (theTime != *tptr) + goto Fail; + + + /* Call ctime to get current date/time in the form: */ + /* Day Mon 99 99:99:99 yyyy\n\0 where Day = day of week; Mon = month; */ + /* 99 = day of month; 99:99:99 = current hour:min:sec; yyyy = current year */ + + timeString = ctime (tptr); + printf ("The current date/time is: %s\n", timeString); + + + /* Call localtime and gmtime and then echo the fields to the screen. */ + + TM = localtime (tptr); + if (TM == NULL) + goto Fail; + printf ("localtime is:\n"); + printf ("sec = %d min = %d hour = %d day = %d month = %d year = %d\n", + TM->tm_sec, TM->tm_min, TM->tm_hour, TM->tm_mday, TM->tm_mon, + TM->tm_year); + printf ("day of week = %d day of year = %d not daylight savings = %d\n\n", + TM->tm_wday, TM->tm_yday, TM->tm_isdst); + + TM = gmtime (tptr); + if (TM == NULL) + goto Fail; + printf ("gmtime is:\n"); + printf ("sec = %d min = %d hour = %d day = %d month = %d year = %d\n", + TM->tm_sec, TM->tm_min, TM->tm_hour, TM->tm_mday, TM->tm_mon, + TM->tm_year); + printf ("day of week = %d day of year = %d not daylight savings = %d\n\n", + TM->tm_wday, TM->tm_yday, TM->tm_isdst); + + + /* Test mktime: should return original time as returned by time. */ + + secondTime = mktime (TM); + if (secondTime != theTime) + goto Fail; + + + /* Test asctime: should return same time as returned by ctime. */ + + timeString = asctime (TM); + printf ("The current date/time is: %s\n", timeString); + + + /* Test difftime. Value returned should be zero. */ + + d = difftime (theTime, secondTime); + if (d != 0.0) + goto Fail; + + return; + +Fail: + printf ("Call to a time function in spc20.2.0.1\n"); + } diff --git a/Tests/Spec.Conform/SPC21.1.0.1.CC b/Tests/Spec.Conform/SPC21.1.0.1.CC old mode 100755 new mode 100644 index ad39d55..03b6568 --- a/Tests/Spec.Conform/SPC21.1.0.1.CC +++ b/Tests/Spec.Conform/SPC21.1.0.1.CC @@ -1 +1,13 @@ -/* Special Conformance Test 21.1.0.1: Verification of assert, ndebug macros */ /* */ /* The tester should verify that the program halts with the error message: */ /* "Assertion failed: file spc21.1.0.1.cc, line 14" */ #undef NDEBUG #include main () { assert (0); printf ("Failed Special Conformance Test 21.1.0.1\n"); } \ No newline at end of file +/* Special Conformance Test 21.1.0.1: Verification of assert, ndebug macros */ +/* */ +/* The tester should verify that the program halts with the error message: */ +/* "Assertion failed: file spc21.1.0.1.cc, line 14" */ + +#undef NDEBUG +#include + +main () + { + assert (0); + printf ("Failed Special Conformance Test 21.1.0.1\n"); + } diff --git a/Tests/Spec.Conform/SPC21.2.0.1.CC b/Tests/Spec.Conform/SPC21.2.0.1.CC old mode 100755 new mode 100644 index b50d608..cdde5cd --- a/Tests/Spec.Conform/SPC21.2.0.1.CC +++ b/Tests/Spec.Conform/SPC21.2.0.1.CC @@ -1 +1,15 @@ -/* */ /* Special Conformance Test 21.2.0.1: Verification of system function */ /* */ /* The tester should verify that the shell's CATALOG command is executed */ /* and that status is zero if the command worked. */ /* */ #include main () { int i; i = system ("catalog\r"); exit (i); } \ No newline at end of file +/* */ +/* Special Conformance Test 21.2.0.1: Verification of system function */ +/* */ +/* The tester should verify that the shell's CATALOG command is executed */ +/* and that status is zero if the command worked. */ +/* */ + +#include + +main () + { + int i; + i = system ("catalog\r"); + exit (i); + } diff --git a/Tests/Spec.Conform/SPC22.1.0.1.CC b/Tests/Spec.Conform/SPC22.1.0.1.CC old mode 100755 new mode 100644 index 8ddb2cf..d8cd43f --- a/Tests/Spec.Conform/SPC22.1.0.1.CC +++ b/Tests/Spec.Conform/SPC22.1.0.1.CC @@ -1 +1,37 @@ -/* Special Conformance Test 22.1.0.1: Verification of argv, argc */ /* */ /* Other files needed: spc22.101.exec - EXEC file which compiles, */ /* links, and executes test */ /* file with 3 parameters */ int main (int argc, char *argv []) { int count = 0; count++; if (argc != 4) goto Fail; count++; if (strcmp (argv [0], "3/spc22.1")) goto Fail; count++; if (strcmp (argv [1], "cat")) goto Fail; count++; if (strcmp (argv [2], "dog")) goto Fail; count++; if (strcmp (argv [3], "run")) goto Fail; printf ("Passed Special Conformance Test 22.1.0.1\n"); return 0; Fail: printf ("count = %d\n", count); printf ("Failed Special Conformance Test 22.1.0.1\n"); } \ No newline at end of file +/* Special Conformance Test 22.1.0.1: Verification of argv, argc */ +/* */ +/* Other files needed: spc22.101.exec - EXEC file which compiles, */ +/* links, and executes test */ +/* file with 3 parameters */ + +int main (int argc, char *argv []) + { + int count = 0; + + count++; + if (argc != 4) + goto Fail; + + count++; + if (strcmp (argv [0], "3/spc22.1")) + goto Fail; + + count++; + if (strcmp (argv [1], "cat")) + goto Fail; + + count++; + if (strcmp (argv [2], "dog")) + goto Fail; + + count++; + if (strcmp (argv [3], "run")) + goto Fail; + + printf ("Passed Special Conformance Test 22.1.0.1\n"); + return 0; + +Fail: + printf ("count = %d\n", count); + printf ("Failed Special Conformance Test 22.1.0.1\n"); + } diff --git a/Tests/Spec.Conform/SPC22.101.EXEC b/Tests/Spec.Conform/SPC22.101.EXEC old mode 100755 new mode 100644 index 996d166..54c9120 --- a/Tests/Spec.Conform/SPC22.101.EXEC +++ b/Tests/Spec.Conform/SPC22.101.EXEC @@ -1 +1,6 @@ -cmpl spc22.1.0.1.cc keep=3/spc22.1 if {status} == 0 3/spc22.1 cat dog run else echo Unable to compile/link Special Conformance Test 22.1.0.1 end \ No newline at end of file +cmpl spc22.1.0.1.cc keep=3/spc22.1 +if {status} == 0 + 3/spc22.1 cat dog run +else + echo Unable to compile/link Special Conformance Test 22.1.0.1 +end diff --git a/Tests/Spec.Conform/SPC23.2.0.1.CC b/Tests/Spec.Conform/SPC23.2.0.1.CC old mode 100755 new mode 100644 index 3ad19df..c328e91 --- a/Tests/Spec.Conform/SPC23.2.0.1.CC +++ b/Tests/Spec.Conform/SPC23.2.0.1.CC @@ -1 +1,22 @@ -/* Special Conformance Test 23.2.0.1: Verification of commandline */ /* */ /* Other files needed: spc23.201.exec - EXEC file which compiles, */ /* links, and executes test */ /* file with parameters */ #include main () { char *cmdLine; cmdLine = commandline (); if (strcmp (cmdLine, "3/spc23.2 one two three four")) goto Fail; printf ("Passed Special Conformance Test 23.2.0.1\n"); return; Fail: printf ("Failed Special Conformance Test 23.2.0.1\n"); } \ No newline at end of file +/* Special Conformance Test 23.2.0.1: Verification of commandline */ +/* */ +/* Other files needed: spc23.201.exec - EXEC file which compiles, */ +/* links, and executes test */ +/* file with parameters */ + +#include + +main () + { + char *cmdLine; + + cmdLine = commandline (); + if (strcmp (cmdLine, "3/spc23.2 one two three four")) + goto Fail; + + printf ("Passed Special Conformance Test 23.2.0.1\n"); + return; + +Fail: + printf ("Failed Special Conformance Test 23.2.0.1\n"); + } diff --git a/Tests/Spec.Conform/SPC23.201.EXEC b/Tests/Spec.Conform/SPC23.201.EXEC old mode 100755 new mode 100644 index 9d45734..6a49375 --- a/Tests/Spec.Conform/SPC23.201.EXEC +++ b/Tests/Spec.Conform/SPC23.201.EXEC @@ -1 +1,6 @@ -cmpl spc23.2.0.1.cc keep=3/spc23.2 if {status} == 0 3/spc23.2 one two three four else echo Unable to compile/link Special Conformance Test 23.2.0.1 end \ No newline at end of file +cmpl spc23.2.0.1.cc keep=3/spc23.2 +if {status} == 0 + 3/spc23.2 one two three four +else + echo Unable to compile/link Special Conformance Test 23.2.0.1 +end diff --git a/Tests/Spec.Conform/SPC25.0.1.CC b/Tests/Spec.Conform/SPC25.0.1.CC old mode 100755 new mode 100644 index d8c553e..1d3b5cc --- a/Tests/Spec.Conform/SPC25.0.1.CC +++ b/Tests/Spec.Conform/SPC25.0.1.CC @@ -1 +1,93 @@ -/* Special Conformance Test 25.0.1: Verification of mini-assembler exprs. */ /* */ /* Other files needed: spc25.1.exec - EXEC file which separately compiles, */ /* links, and executes the two files */ /* comprising this test */ /* spc25.1.1.cc - Separately compiled file which */ /* contains global data and routines */ /* accessed by the main program */ /* spc25.1.h - Header file containing global */ /* declarations for second source file */ #include #include "spc25.1.h" static int i1 = 33; main () { int count = 0, i; char *chPtr; int *iPtr; long *lPtr; unsigned char *uchPtr; unsigned int *uiPtr; unsigned long *ulPtr; /* Call routines to initialize global arrays. Verify initialization. */ count++; chPtr = Init_Ch (ch0); if ((*chPtr != 'e') || (chPtr [1] != 'd') || (chPtr [2] != 'c')) goto Fail; count++; iPtr = Init_Int (i0); if ((*iPtr != 10) || (iPtr [1] != 20) || (iPtr [2] != 30)) goto Fail; count++; lPtr = Init_Long (L0); if ((*lPtr != 0) || (lPtr [1] != 100) || (lPtr [2] != 200)) goto Fail; count++; uchPtr = Init_UCh (); if ((*uchPtr != 'r') || (uchPtr [1] != 'q') || (uchPtr [2] != 'p')) goto Fail; count++; uiPtr = Init_UI (ui0); if ((*uiPtr != 0) || (uiPtr [1] != 16) || (uiPtr [2] != 32)) goto Fail; count++; ulPtr = Init_UL (ul0); if ((*ulPtr != 0x777) || (ulPtr [1] != 0x778) || (ulPtr [2] != 0x779)) goto Fail; asm { bra Test uch1: dcb 't' /* Test expressions */ Test: lda i1 sta i cmp #33 bne Err lda uch1 and #0x00FF sta i cmp #0x0074 bne Err lda [iPtr] cmp #10 beq Out Err: inc count jmp Fail } Out: printf ("Passed Conformance Test 25.0.1\n"); return; Fail: printf ("count = %d i = %d\n", count, i); printf ("Failed Conformance Test 25.0.1\n"); } \ No newline at end of file +/* Special Conformance Test 25.0.1: Verification of mini-assembler exprs. */ +/* */ +/* Other files needed: spc25.1.exec - EXEC file which separately compiles, */ +/* links, and executes the two files */ +/* comprising this test */ +/* spc25.1.1.cc - Separately compiled file which */ +/* contains global data and routines */ +/* accessed by the main program */ +/* spc25.1.h - Header file containing global */ +/* declarations for second source file */ + +#include +#include "spc25.1.h" + +static int i1 = 33; + +main () + { + int count = 0, i; + char *chPtr; + int *iPtr; + long *lPtr; + unsigned char *uchPtr; + unsigned int *uiPtr; + unsigned long *ulPtr; + + + /* Call routines to initialize global arrays. Verify initialization. */ + + count++; + chPtr = Init_Ch (ch0); + if ((*chPtr != 'e') || (chPtr [1] != 'd') || (chPtr [2] != 'c')) + goto Fail; + + count++; + iPtr = Init_Int (i0); + if ((*iPtr != 10) || (iPtr [1] != 20) || (iPtr [2] != 30)) + goto Fail; + + count++; + lPtr = Init_Long (L0); + if ((*lPtr != 0) || (lPtr [1] != 100) || (lPtr [2] != 200)) + goto Fail; + + count++; + uchPtr = Init_UCh (); + if ((*uchPtr != 'r') || (uchPtr [1] != 'q') || (uchPtr [2] != 'p')) + goto Fail; + + count++; + uiPtr = Init_UI (ui0); + if ((*uiPtr != 0) || (uiPtr [1] != 16) || (uiPtr [2] != 32)) + goto Fail; + + count++; + ulPtr = Init_UL (ul0); + if ((*ulPtr != 0x777) || (ulPtr [1] != 0x778) || (ulPtr [2] != 0x779)) + goto Fail; + + asm + { + bra Test + + uch1: dcb 't' + + /* Test expressions */ + + Test: lda i1 + sta i + cmp #33 + bne Err + + lda uch1 + and #0x00FF + sta i + cmp #0x0074 + bne Err + + lda [iPtr] + cmp #10 + beq Out + Err: inc count + jmp Fail + } + +Out: + printf ("Passed Conformance Test 25.0.1\n"); + return; + +Fail: + printf ("count = %d i = %d\n", count, i); + printf ("Failed Conformance Test 25.0.1\n"); + } diff --git a/Tests/Spec.Conform/SPC25.0.2.CC b/Tests/Spec.Conform/SPC25.0.2.CC old mode 100755 new mode 100644 index a118556..c92d1af --- a/Tests/Spec.Conform/SPC25.0.2.CC +++ b/Tests/Spec.Conform/SPC25.0.2.CC @@ -1 +1,72 @@ -/* Special Conformance Test 25.0.2: Verification of long addressing in mini- */ /* assembler when using large memory model */ /* */ /* Other files needed: spc25.2.exec - EXEC file which separately compiles, */ /* links, and executes the two files */ /* comprising this test */ /* spc25.2.1.cc - Separately compiled file which */ /* contains global data and routines */ /* accessed by the main program */ #pragma memorymodel 1 #include static int i1 = 33; extern char ch0 []; extern int i0 []; extern char * Init_Ch (void); extern int * Init_Int (int i []); main () { char *chPtr; int *iPtr; int count = 0; /* Call routines to initialize global arrays. Verify initialization. */ count++; chPtr = Init_Ch (); if ((*chPtr != 'e') || (chPtr [1] != 'd') || (chPtr [2] != 'c')) goto Fail; count++; iPtr = Init_Int (i0); if ((*iPtr != 10) || (iPtr [1] != 20) || (iPtr [2] != 30)) goto Fail; asm { bra Test uch1: dcb 't' /* Test expressions */ Test: lda i1 cmp #33 bne Err lda uch1 and #0x00FF cmp #0x0074 bne Err lda [iPtr] cmp #10 beq Out Err: inc count jmp Fail } Out: printf ("Passed Conformance Test 25.0.2\n"); return; Fail: printf ("count = %d\n", count); printf ("Failed Conformance Test 25.0.2\n"); } \ No newline at end of file +/* Special Conformance Test 25.0.2: Verification of long addressing in mini- */ +/* assembler when using large memory model */ +/* */ +/* Other files needed: spc25.2.exec - EXEC file which separately compiles, */ +/* links, and executes the two files */ +/* comprising this test */ +/* spc25.2.1.cc - Separately compiled file which */ +/* contains global data and routines */ +/* accessed by the main program */ + +#pragma memorymodel 1 +#include + +static int i1 = 33; + +extern char ch0 []; +extern int i0 []; + +extern char * Init_Ch (void); +extern int * Init_Int (int i []); + + +main () + { + char *chPtr; + int *iPtr; + int count = 0; + + /* Call routines to initialize global arrays. Verify initialization. */ + + count++; + chPtr = Init_Ch (); + if ((*chPtr != 'e') || (chPtr [1] != 'd') || (chPtr [2] != 'c')) + goto Fail; + + count++; + iPtr = Init_Int (i0); + if ((*iPtr != 10) || (iPtr [1] != 20) || (iPtr [2] != 30)) + goto Fail; + + asm + { + bra Test + + uch1: dcb 't' + + /* Test expressions */ + + Test: lda i1 + cmp #33 + bne Err + + lda uch1 + and #0x00FF + cmp #0x0074 + bne Err + + lda [iPtr] + cmp #10 + beq Out + Err: inc count + jmp Fail + } + +Out: + printf ("Passed Conformance Test 25.0.2\n"); + return; + +Fail: + printf ("count = %d\n", count); + printf ("Failed Conformance Test 25.0.2\n"); + } diff --git a/Tests/Spec.Conform/SPC25.1.1.CC b/Tests/Spec.Conform/SPC25.1.1.CC old mode 100755 new mode 100644 index b0e28be..c7c5e5e --- a/Tests/Spec.Conform/SPC25.1.1.CC +++ b/Tests/Spec.Conform/SPC25.1.1.CC @@ -1 +1,114 @@ -/* Second file comprising Special Conformance Test 25.0.1 */ #define SIZE 3 char ch0 [3]; /* global integers */ int i0 [3]; long L0 [3]; unsigned char uch0 [3]; unsigned int ui0 [3]; unsigned long ul0 [3]; /* global functions */ /*****************************************************************************/ char * Init_Ch (char ch []) { char * chPtr = ch; asm { lda #<'c' /* init starting value for array */ sep #0x20 /* set the accumulator to 8 bits */ ldy #SIZE Top: dey ; loop to initialize ch array bmi Out sta [chPtr],Y inc A bra Top Out: rep #0x20 /* reset accumulator to 16 bits */ } return chPtr; } /*****************************************************************************/ int * Init_Int (int i []) { int j, *iptr = i; asm { lda #10 /* init starting value for array */ sta j ldx #SIZE ldy #0 Top: sta [iptr],Y ; loop to initialize i array lda j clc adc #10 sta j iny iny dex bne Top } return (iptr); } /*****************************************************************************/ long * Init_Long (long L []) { int j; for (j = 0; j < SIZE; j++) L [j] = j * 100; return (L); } /*****************************************************************************/ unsigned char * Init_UCh (void) { asm { lda #<'p' /* init starting value for array */ sep #0x20 /* set the accumulator to 8 bits */ ldx #SIZE Top: dex ; loop to initialize uch0 array bmi Out sta uch0,X inc A bra Top Out: rep #0x20 /* reset accumulator to 16 bits */ } return (uch0); } /*****************************************************************************/ unsigned int * Init_UI (unsigned int ui []) { int j; for (j = 0; j < SIZE; j++) ui [j] = (unsigned int) (j << 4); return (ui); } /*****************************************************************************/ unsigned long * Init_UL (unsigned long ul []) { int j; for (j = 0; j < SIZE; j++) ul [j] = (unsigned long) (j + 0x777); return (ul); } \ No newline at end of file +/* Second file comprising Special Conformance Test 25.0.1 */ + +#define SIZE 3 + +char ch0 [3]; /* global integers */ +int i0 [3]; +long L0 [3]; +unsigned char uch0 [3]; +unsigned int ui0 [3]; +unsigned long ul0 [3]; + /* global functions */ + +/*****************************************************************************/ + +char * Init_Ch (char ch []) + { + char * chPtr = ch; + + asm + { + lda #<'c' /* init starting value for array */ + sep #0x20 /* set the accumulator to 8 bits */ + ldy #SIZE + Top: dey ; loop to initialize ch array + bmi Out + sta [chPtr],Y + inc A + bra Top + Out: rep #0x20 /* reset accumulator to 16 bits */ + } + return chPtr; + } + + +/*****************************************************************************/ + +int * Init_Int (int i []) + { + int j, *iptr = i; + + asm + { + lda #10 /* init starting value for array */ + sta j + ldx #SIZE + ldy #0 + Top: sta [iptr],Y ; loop to initialize i array + lda j + clc + adc #10 + sta j + iny + iny + dex + bne Top + } + return (iptr); + } + + +/*****************************************************************************/ + +long * Init_Long (long L []) + { + int j; + + for (j = 0; j < SIZE; j++) + L [j] = j * 100; + return (L); + } + + +/*****************************************************************************/ + +unsigned char * Init_UCh (void) + { + asm + { + lda #<'p' /* init starting value for array */ + sep #0x20 /* set the accumulator to 8 bits */ + ldx #SIZE + Top: dex ; loop to initialize uch0 array + bmi Out + sta uch0,X + inc A + bra Top + Out: rep #0x20 /* reset accumulator to 16 bits */ + } + return (uch0); + } + + +/*****************************************************************************/ + +unsigned int * Init_UI (unsigned int ui []) + { + int j; + + for (j = 0; j < SIZE; j++) + ui [j] = (unsigned int) (j << 4); + return (ui); + } + + +/*****************************************************************************/ + +unsigned long * Init_UL (unsigned long ul []) + { + int j; + + for (j = 0; j < SIZE; j++) + ul [j] = (unsigned long) (j + 0x777); + return (ul); + } diff --git a/Tests/Spec.Conform/SPC25.1.EXEC b/Tests/Spec.Conform/SPC25.1.EXEC old mode 100755 new mode 100644 index f4ed1f5..603b0fa --- a/Tests/Spec.Conform/SPC25.1.EXEC +++ b/Tests/Spec.Conform/SPC25.1.EXEC @@ -1 +1,26 @@ -* Exec file to run Special Conformance Test 25.0.1 * unset exit compile spc25.0.1.cc keep=3/spc25.1 if {status} == 0 compile spc25.1.1.cc keep=3/spc25.1.1 if {status} == 0 link 3/spc25.1 3/spc25.1.1 keep=3/spc25.1 if {status} == 0 3/spc25.1 else echo Unable to link Special Conformance Test 25.0.1 end else echo Unable to compile file spc25.1.1.cc end else echo Unable to compile file spc25.0.1.cc end \ No newline at end of file +* Exec file to run Special Conformance Test 25.0.1 * + +unset exit + +compile spc25.0.1.cc keep=3/spc25.1 + +if {status} == 0 + compile spc25.1.1.cc keep=3/spc25.1.1 + + if {status} == 0 + link 3/spc25.1 3/spc25.1.1 keep=3/spc25.1 + + if {status} == 0 + 3/spc25.1 + + else + echo Unable to link Special Conformance Test 25.0.1 + end + + else + echo Unable to compile file spc25.1.1.cc + end + +else + echo Unable to compile file spc25.0.1.cc +end diff --git a/Tests/Spec.Conform/SPC25.1.H b/Tests/Spec.Conform/SPC25.1.H old mode 100755 new mode 100644 index 53a580e..fa75541 --- a/Tests/Spec.Conform/SPC25.1.H +++ b/Tests/Spec.Conform/SPC25.1.H @@ -1 +1,15 @@ -/* Global declarations for Special Conformance Test 25.0.1 */ extern char ch0 [3]; extern int i0 [3]; extern long L0 [3]; extern unsigned char uch0 [3]; extern unsigned int ui0 [3]; extern unsigned long ul0 [3]; extern char * Init_Ch (char ch []); extern int * Init_Int (int i []); extern long * Init_Long (long L []); extern unsigned char * Init_UCh (void); extern unsigned int * Init_UI (unsigned int ui []); extern unsigned long * Init_UL (unsigned long ul []); \ No newline at end of file +/* Global declarations for Special Conformance Test 25.0.1 */ + +extern char ch0 [3]; +extern int i0 [3]; +extern long L0 [3]; +extern unsigned char uch0 [3]; +extern unsigned int ui0 [3]; +extern unsigned long ul0 [3]; + +extern char * Init_Ch (char ch []); +extern int * Init_Int (int i []); +extern long * Init_Long (long L []); +extern unsigned char * Init_UCh (void); +extern unsigned int * Init_UI (unsigned int ui []); +extern unsigned long * Init_UL (unsigned long ul []); diff --git a/Tests/Spec.Conform/SPC25.2.1.CC b/Tests/Spec.Conform/SPC25.2.1.CC old mode 100755 new mode 100644 index b9dd4dc..d3b189f --- a/Tests/Spec.Conform/SPC25.2.1.CC +++ b/Tests/Spec.Conform/SPC25.2.1.CC @@ -1 +1,53 @@ -/* Second file comprising Special Conformance Test 25.0.2 */ #pragma memorymodel 1 #define SIZE 3 char ch0 [3]; /* global integers */ int i0 [3]; /* global functions */ /*****************************************************************************/ char * Init_Ch (void) { asm { lda #'c' /* init starting value for array */ sep #0x20 /* set the accumulator to 8 bits */ ldx #SIZE Top: dex ; loop to initialize uch0 array bmi Out sta ch0,X inc A bra Top Out: rep #0x20 /* reset accumulator to 16 bits */ } return (ch0); } /*****************************************************************************/ int * Init_Int (int i []) { int j, *iptr = i; asm { lda #10 /* init starting value for array */ sta j ldx #SIZE ldy #0 Top: sta [iptr],Y ; loop to initialize i array lda j clc adc #10 sta j iny iny dex bne Top } return (iptr); } \ No newline at end of file +/* Second file comprising Special Conformance Test 25.0.2 */ + +#pragma memorymodel 1 +#define SIZE 3 + +char ch0 [3]; /* global integers */ +int i0 [3]; + /* global functions */ + +/*****************************************************************************/ + +char * Init_Ch (void) + { + asm + { + lda #'c' /* init starting value for array */ + sep #0x20 /* set the accumulator to 8 bits */ + ldx #SIZE + Top: dex ; loop to initialize uch0 array + bmi Out + sta ch0,X + inc A + bra Top + Out: rep #0x20 /* reset accumulator to 16 bits */ + } + return (ch0); + } + + +/*****************************************************************************/ + +int * Init_Int (int i []) + { + int j, *iptr = i; + + asm + { + lda #10 /* init starting value for array */ + sta j + ldx #SIZE + ldy #0 + Top: sta [iptr],Y ; loop to initialize i array + lda j + clc + adc #10 + sta j + iny + iny + dex + bne Top + } + return (iptr); + } diff --git a/Tests/Spec.Conform/SPC25.2.EXEC b/Tests/Spec.Conform/SPC25.2.EXEC old mode 100755 new mode 100644 index e1eacb1..697c1c6 --- a/Tests/Spec.Conform/SPC25.2.EXEC +++ b/Tests/Spec.Conform/SPC25.2.EXEC @@ -1 +1,29 @@ -* Exec file to run Special Conformance Test 25.0.2 * unset exit compile spc25.0.2.cc keep=3/spc25.2 set errNo {status} if {errNo} == 0 compile spc25.2.1.cc keep=3/spc25.2.1 set errNo {status} if {errNo} == 0 link 3/spc25.2 3/spc25.2.1 keep=3/spc25.2 set errNo {status} if {errNo} == 0 3/spc25.2 else echo Unable to link Special Conformance Test 25.0.2 end else echo Unable to compile file spc25.2.1.cc end else echo Unable to compile file spc25.0.2.cc end \ No newline at end of file +* Exec file to run Special Conformance Test 25.0.2 * + +unset exit + +compile spc25.0.2.cc keep=3/spc25.2 +set errNo {status} + +if {errNo} == 0 + compile spc25.2.1.cc keep=3/spc25.2.1 + + set errNo {status} + if {errNo} == 0 + link 3/spc25.2 3/spc25.2.1 keep=3/spc25.2 + + set errNo {status} + if {errNo} == 0 + 3/spc25.2 + + else + echo Unable to link Special Conformance Test 25.0.2 + end + + else + echo Unable to compile file spc25.2.1.cc + end + +else + echo Unable to compile file spc25.0.2.cc +end diff --git a/Tests/Spec.Conform/SPC3.3.4.1.CC b/Tests/Spec.Conform/SPC3.3.4.1.CC old mode 100755 new mode 100644 index fa771fe..e532220 --- a/Tests/Spec.Conform/SPC3.3.4.1.CC +++ b/Tests/Spec.Conform/SPC3.3.4.1.CC @@ -1 +1,13 @@ -/* Special Conformance Test 3.3.4.1: Verification of __DATE__ and __TIME__ */ /* predefined macros */ /* */ /* The user should verify that the __DATE__ macro returns the computer's */ /* current clock date, in the form: Mmm dd yyyy. The user should also */ /* verify that the __TIME__ macro return the computer's current clock time */ /* in the form: hh:mm:ss. */ main () { printf ("The current date is: '%s'\n", __DATE__); printf ("The current time is: '%s'\n", __TIME__); } \ No newline at end of file +/* Special Conformance Test 3.3.4.1: Verification of __DATE__ and __TIME__ */ +/* predefined macros */ +/* */ +/* The user should verify that the __DATE__ macro returns the computer's */ +/* current clock date, in the form: Mmm dd yyyy. The user should also */ +/* verify that the __TIME__ macro return the computer's current clock time */ +/* in the form: hh:mm:ss. */ + +main () + { + printf ("The current date is: '%s'\n", __DATE__); + printf ("The current time is: '%s'\n", __TIME__); + } diff --git a/Tests/Spec.Conform/SPC3.4.0.1.CC b/Tests/Spec.Conform/SPC3.4.0.1.CC old mode 100755 new mode 100644 index 7e53b73..c267403 --- a/Tests/Spec.Conform/SPC3.4.0.1.CC +++ b/Tests/Spec.Conform/SPC3.4.0.1.CC @@ -1 +1,14 @@ -/* Special Conformance Test 3.4.0.1: Verification of #include command. */ /* First run the EXEC file spc3401.exec */ /* */ /* Other files needed: cfile1 */ /* libfile2 */ /* ufile1 */ /* userfile2 */ #define libFile(x) #define userFile(x) x #include libFile(cfile1) #include userFile("ufile1") #include "userfile2" #include \ No newline at end of file +/* Special Conformance Test 3.4.0.1: Verification of #include command. */ +/* First run the EXEC file spc3401.exec */ +/* */ +/* Other files needed: cfile1 */ +/* libfile2 */ +/* ufile1 */ +/* userfile2 */ + +#define libFile(x) +#define userFile(x) x +#include libFile(cfile1) +#include userFile("ufile1") +#include "userfile2" +#include diff --git a/Tests/Spec.Conform/SPC3.4.0.2.CC b/Tests/Spec.Conform/SPC3.4.0.2.CC old mode 100755 new mode 100644 index dab720a..22037ce --- a/Tests/Spec.Conform/SPC3.4.0.2.CC +++ b/Tests/Spec.Conform/SPC3.4.0.2.CC @@ -1 +1,7 @@ -/* Special Conformance Test 3.4.0.2: Ensure #include files can be nested to */ /* a depth of at least 8 */ /* */ /* Other files needed: spc34021, spc34022, spc34023, spc34024, spc34025 */ /* spc34026, spc34027, spc34028 */ #include "spc34021" \ No newline at end of file +/* Special Conformance Test 3.4.0.2: Ensure #include files can be nested to */ +/* a depth of at least 8 */ +/* */ +/* Other files needed: spc34021, spc34022, spc34023, spc34024, spc34025 */ +/* spc34026, spc34027, spc34028 */ + +#include "spc34021" diff --git a/Tests/Spec.Conform/SPC3.6.0.1.CC b/Tests/Spec.Conform/SPC3.6.0.1.CC old mode 100755 new mode 100644 index 342a700..f3e6a68 --- a/Tests/Spec.Conform/SPC3.6.0.1.CC +++ b/Tests/Spec.Conform/SPC3.6.0.1.CC @@ -1 +1,15 @@ -/* Special Conformance Test 3.6.0.1: Test explicit line numbering (#line) */ #pragma debug 9 /* enable range checking and trace back */ void Sub (void) { int a [4080]; /* ensure stack overflow into SANE's area */ } #line 9999 /* expect trace back to report error on line */ /* 9999+4 (call to Sub) */ main () { Sub (); } \ No newline at end of file +/* Special Conformance Test 3.6.0.1: Test explicit line numbering (#line) */ + +#pragma debug 9 /* enable range checking and trace back */ + +void Sub (void) + { + int a [4080]; /* ensure stack overflow into SANE's area */ + } + +#line 9999 /* expect trace back to report error on line */ + /* 9999+4 (call to Sub) */ +main () + { + Sub (); + } diff --git a/Tests/Spec.Conform/SPC3.6.0.2.CC b/Tests/Spec.Conform/SPC3.6.0.2.CC old mode 100755 new mode 100644 index f42ea54..7dc05f1 --- a/Tests/Spec.Conform/SPC3.6.0.2.CC +++ b/Tests/Spec.Conform/SPC3.6.0.2.CC @@ -1 +1,23 @@ -/* Special Conformance Test 3.6.0.2: Test explicit line numbering (#line) */ /* with a filename */ #define lineNum(x) x #pragma debug 9 /* enable range checking and trace back */ void Sub (void) { int a [4080]; /* ensure stack overflow into SANE's area */ } #line lineNum(88) "noFile" /* expect trace back to report error on line */ /* 91 (call to Sub), in file noFile */ Sub2() { Sub(); } main () { Sub2 (); } \ No newline at end of file +/* Special Conformance Test 3.6.0.2: Test explicit line numbering (#line) */ +/* with a filename */ + +#define lineNum(x) x + +#pragma debug 9 /* enable range checking and trace back */ + +void Sub (void) + { + int a [4080]; /* ensure stack overflow into SANE's area */ + } + +#line lineNum(88) "noFile" /* expect trace back to report error on line */ + /* 91 (call to Sub), in file noFile */ +Sub2() +{ +Sub(); +} + +main () + { + Sub2 (); + } diff --git a/Tests/Spec.Conform/SPC3.6.0.3.CC b/Tests/Spec.Conform/SPC3.6.0.3.CC old mode 100755 new mode 100644 index ea2b254..3d3e32f --- a/Tests/Spec.Conform/SPC3.6.0.3.CC +++ b/Tests/Spec.Conform/SPC3.6.0.3.CC @@ -1 +1,20 @@ -/* Special Conformance Test 3.6.0.3: Test explicit line numbering (#line) */ /* with filenames */ #include #define FileName(x) x #define LINE_NUM 10 #line LINE_NUM FileName ("onemorefile") main () { if (strcmp (__FILE__, "onemorefile")) { printf ("Failed Special Conformance Test 3.6.0.3\n"); printf ("Macro substitution in LINE fails\n"); printf ("__FILE__ = %s\n", __FILE__); } else printf ("Passed Special Conformance Test 3.6.0.3\n"); } \ No newline at end of file +/* Special Conformance Test 3.6.0.3: Test explicit line numbering (#line) */ +/* with filenames */ + +#include +#define FileName(x) x +#define LINE_NUM 10 +#line LINE_NUM FileName ("onemorefile") + +main () + { + if (strcmp (__FILE__, "onemorefile")) + { + printf ("Failed Special Conformance Test 3.6.0.3\n"); + printf ("Macro substitution in LINE fails\n"); + printf ("__FILE__ = %s\n", __FILE__); + } + + else + printf ("Passed Special Conformance Test 3.6.0.3\n"); + } diff --git a/Tests/Spec.Conform/SPC3401.EXEC b/Tests/Spec.Conform/SPC3401.EXEC old mode 100755 new mode 100644 index 1d1a04f..b0d642f --- a/Tests/Spec.Conform/SPC3401.EXEC +++ b/Tests/Spec.Conform/SPC3401.EXEC @@ -1 +1,2 @@ -copy -c cfile1 2/orcacdefs copy -c libfile2 2/orcacdefs \ No newline at end of file +copy -c cfile1 2/orcacdefs +copy -c libfile2 2/orcacdefs diff --git a/Tests/Spec.Conform/SPC34021 b/Tests/Spec.Conform/SPC34021 old mode 100755 new mode 100644 index 23c2985..31ac5a8 --- a/Tests/Spec.Conform/SPC34021 +++ b/Tests/Spec.Conform/SPC34021 @@ -1 +1,3 @@ -/* First included file for Special Conformance Test spc3.4.0.2.cc */ #include "spc34022" \ No newline at end of file +/* First included file for Special Conformance Test spc3.4.0.2.cc */ + +#include "spc34022" diff --git a/Tests/Spec.Conform/SPC34022 b/Tests/Spec.Conform/SPC34022 old mode 100755 new mode 100644 index 0740e08..cc48a45 --- a/Tests/Spec.Conform/SPC34022 +++ b/Tests/Spec.Conform/SPC34022 @@ -1 +1,3 @@ -/* Second include file for Special Conformance Test spc3.4.0.2.cc */ #include "spc34023" \ No newline at end of file +/* Second include file for Special Conformance Test spc3.4.0.2.cc */ + +#include "spc34023" diff --git a/Tests/Spec.Conform/SPC34023 b/Tests/Spec.Conform/SPC34023 old mode 100755 new mode 100644 index e9af0f2..9a9e440 --- a/Tests/Spec.Conform/SPC34023 +++ b/Tests/Spec.Conform/SPC34023 @@ -1 +1,3 @@ -/* Third include file for Special Conformance Test spc3.4.0.2.cc */ #include "spc34024" \ No newline at end of file +/* Third include file for Special Conformance Test spc3.4.0.2.cc */ + +#include "spc34024" diff --git a/Tests/Spec.Conform/SPC34024 b/Tests/Spec.Conform/SPC34024 old mode 100755 new mode 100644 index 536a8ad..34797e7 --- a/Tests/Spec.Conform/SPC34024 +++ b/Tests/Spec.Conform/SPC34024 @@ -1 +1,3 @@ -/* Fouth include file for Special Conformance Test spc3.4.0.2.cc */ #include "spc34025" \ No newline at end of file +/* Fouth include file for Special Conformance Test spc3.4.0.2.cc */ + +#include "spc34025" diff --git a/Tests/Spec.Conform/SPC34025 b/Tests/Spec.Conform/SPC34025 old mode 100755 new mode 100644 index 0956a38..56e0ba2 --- a/Tests/Spec.Conform/SPC34025 +++ b/Tests/Spec.Conform/SPC34025 @@ -1 +1,3 @@ -/* Fifth include file for Special Conformance Test spc3.4.0.2.cc */ #include "spc34026" \ No newline at end of file +/* Fifth include file for Special Conformance Test spc3.4.0.2.cc */ + +#include "spc34026" diff --git a/Tests/Spec.Conform/SPC34026 b/Tests/Spec.Conform/SPC34026 old mode 100755 new mode 100644 index 9cea25c..27afc38 --- a/Tests/Spec.Conform/SPC34026 +++ b/Tests/Spec.Conform/SPC34026 @@ -1 +1,3 @@ -/* Sixth include file for Special Conformance Test spc3.4.0.2.cc */ #include "spc34027" \ No newline at end of file +/* Sixth include file for Special Conformance Test spc3.4.0.2.cc */ + +#include "spc34027" diff --git a/Tests/Spec.Conform/SPC34027 b/Tests/Spec.Conform/SPC34027 old mode 100755 new mode 100644 index 6c4e36c..e54be71 --- a/Tests/Spec.Conform/SPC34027 +++ b/Tests/Spec.Conform/SPC34027 @@ -1 +1,3 @@ -/* Seventh include file for Special Conformance Test spc3.4.0.2.cc */ #include "spc34028" \ No newline at end of file +/* Seventh include file for Special Conformance Test spc3.4.0.2.cc */ + +#include "spc34028" diff --git a/Tests/Spec.Conform/SPC34028 b/Tests/Spec.Conform/SPC34028 old mode 100755 new mode 100644 index c73ea96..73c4b8f --- a/Tests/Spec.Conform/SPC34028 +++ b/Tests/Spec.Conform/SPC34028 @@ -1 +1,6 @@ -/* Final include file for Special Conformance Test spc3.4.0.2.cc */ main () { printf ("Passed Special Conformance Test 3.4.0.2\n"); } \ No newline at end of file +/* Final include file for Special Conformance Test spc3.4.0.2.cc */ + +main () + { + printf ("Passed Special Conformance Test 3.4.0.2\n"); + } diff --git a/Tests/Spec.Conform/SPC4.3.0.1.CC b/Tests/Spec.Conform/SPC4.3.0.1.CC old mode 100755 new mode 100644 index ca2a871..0bd0af5 --- a/Tests/Spec.Conform/SPC4.3.0.1.CC +++ b/Tests/Spec.Conform/SPC4.3.0.1.CC @@ -1 +1,90 @@ -/*****************************************************************************/ /* */ /* Special Conformance Test 4.3.0.1: Ensure static variables and functions */ /* are not passed to the linker, and that */ /* extern variables and functions are */ /* passed to the linker */ /* */ /* Other files needed: spc4301.h - header file for separate compilation */ /* spc4301.1.cc - separately compiled file */ /* spc4301.2.cc - separately compiled file */ /* spc4301.exec - controls compilation and linking */ /* {workDisk}/spc4301.symt - linker's global symbol */ /* table for spc4.3.0.1.cc */ /* */ /* Special instructions: Use the EXEC file spc4301.exec to separately */ /* compile and link the three files. A symbol table */ /* is produced in the output file {workDisk}/ */ /* spc4301.symt. The tester should use the linker's */ /* symbol table to verify that only the extern */ /* functions and variables are in the global symbol */ /* table. In addition, the EXEC file will try to */ /* execute the program. If all is well, a Pass/Fail */ /* message will be written to standard out. */ /* */ /* The global functions are: ChangeChar, L0 */ /* The global variables are: real, i, longNum */ /* */ /*****************************************************************************/ #include #include "spc4301.h" main () { int count = 0; static extended E1 (double x, float y); static char ch; char *chPtr; extern int i; extern long L0 (int *j); count++; i = 0; while (chArray [i] != '\0') { ChangeChar (&chArray [i]); ++i; } chPtr = chArray; if ((strcmp (chPtr, "bcde")) != 0) goto Fail; count++; real = E1 (2.1, 1.5); if ( (fabs (real - 3.15)) > 0.1 ) goto Fail; count++; ch = F1 (2.3, 'a'); if (ch != 'c') goto Fail; count++; longNum = L0 ((int *) chArray); if (longNum != 25442) goto Fail; printf ("Passed Special Conformance Test spc4.3.0.1\n"); return 0; Fail: printf ("Failed Special Conformance Test spc4.3.0.1: count = %d\n", count); return 0; } /*****************************************************************************/ static extended E1 (double x, float y) { return (x * y); } /*****************************************************************************/ static int F1 (float a, char ch) { return ((long) a) + ((long) ch); } \ No newline at end of file +/*****************************************************************************/ +/* */ +/* Special Conformance Test 4.3.0.1: Ensure static variables and functions */ +/* are not passed to the linker, and that */ +/* extern variables and functions are */ +/* passed to the linker */ +/* */ +/* Other files needed: spc4301.h - header file for separate compilation */ +/* spc4301.1.cc - separately compiled file */ +/* spc4301.2.cc - separately compiled file */ +/* spc4301.exec - controls compilation and linking */ +/* {workDisk}/spc4301.symt - linker's global symbol */ +/* table for spc4.3.0.1.cc */ +/* */ +/* Special instructions: Use the EXEC file spc4301.exec to separately */ +/* compile and link the three files. A symbol table */ +/* is produced in the output file {workDisk}/ */ +/* spc4301.symt. The tester should use the linker's */ +/* symbol table to verify that only the extern */ +/* functions and variables are in the global symbol */ +/* table. In addition, the EXEC file will try to */ +/* execute the program. If all is well, a Pass/Fail */ +/* message will be written to standard out. */ +/* */ +/* The global functions are: ChangeChar, L0 */ +/* The global variables are: real, i, longNum */ +/* */ +/*****************************************************************************/ + +#include +#include "spc4301.h" + +main () + { + int count = 0; + + static extended E1 (double x, float y); + static char ch; + char *chPtr; + + extern int i; + extern long L0 (int *j); + + count++; + i = 0; + while (chArray [i] != '\0') + { + ChangeChar (&chArray [i]); + ++i; + } + chPtr = chArray; + if ((strcmp (chPtr, "bcde")) != 0) + goto Fail; + + count++; + real = E1 (2.1, 1.5); + if ( (fabs (real - 3.15)) > 0.1 ) + goto Fail; + + count++; + ch = F1 (2.3, 'a'); + if (ch != 'c') + goto Fail; + + count++; + longNum = L0 ((int *) chArray); + if (longNum != 25442) + goto Fail; + + printf ("Passed Special Conformance Test spc4.3.0.1\n"); + return 0; + +Fail: + printf ("Failed Special Conformance Test spc4.3.0.1: count = %d\n", count); + return 0; + } + +/*****************************************************************************/ + +static extended E1 (double x, float y) + { + return (x * y); + } + +/*****************************************************************************/ + +static int F1 (float a, char ch) + { + return ((long) a) + ((long) ch); + } diff --git a/Tests/Spec.Conform/SPC4.3.1.1.CC b/Tests/Spec.Conform/SPC4.3.1.1.CC old mode 100755 new mode 100644 index 69835de..8235f61 --- a/Tests/Spec.Conform/SPC4.3.1.1.CC +++ b/Tests/Spec.Conform/SPC4.3.1.1.CC @@ -1 +1,33 @@ -/* Special Conformance Test 4.3.1.1: Ensure default storage class for */ /* functions declared at the head of a */ /* block is extern */ /* */ /* Other files needed: spc4311.cc - separately compiled file containing */ /* functions called in this file */ /* spc4311.exec - EXEC file which separately compiles */ /* links and runs the files comprising */ /* this test */ /* */ main () { int I1 (char ch); double D1 (float f); char c; float f; c = I1 ('z'); if (c != 'Z') goto Fail; f = D1 (8.9); if (f != 8.0) goto Fail; printf ("Passed Special Conformance Test 4.3.1.1\n"); return; Fail: printf ("Failed Special Conformance Test 4.3.1.1\n"); } \ No newline at end of file +/* Special Conformance Test 4.3.1.1: Ensure default storage class for */ +/* functions declared at the head of a */ +/* block is extern */ +/* */ +/* Other files needed: spc4311.cc - separately compiled file containing */ +/* functions called in this file */ +/* spc4311.exec - EXEC file which separately compiles */ +/* links and runs the files comprising */ +/* this test */ +/* */ + +main () + { + int I1 (char ch); + double D1 (float f); + + char c; + float f; + + c = I1 ('z'); + if (c != 'Z') + goto Fail; + + f = D1 (8.9); + if (f != 8.0) + goto Fail; + + printf ("Passed Special Conformance Test 4.3.1.1\n"); + return; + +Fail: + printf ("Failed Special Conformance Test 4.3.1.1\n"); + } diff --git a/Tests/Spec.Conform/SPC4.4.1.1.CC b/Tests/Spec.Conform/SPC4.4.1.1.CC old mode 100755 new mode 100644 index 036e3e7..39a64eb --- a/Tests/Spec.Conform/SPC4.4.1.1.CC +++ b/Tests/Spec.Conform/SPC4.4.1.1.CC @@ -1 +1,60 @@ -/* Special Conformance Test 4.4.1.1: Verification of ability to omit either */ /* type specifier or storage class in */ /* declarations, and both in function */ /* definitions */ /* */ /* Other files needed: spc4411.exec - separately compiles, links, and */ /* executes the files spc4.4.1.1.cc and */ /* spc4411.1.cc */ /* */ static x; /* type of x is int */ float y; /* storage class of y is extern */ static F1 (); /* non-prototyped form: returns int */ double G1 (); /* also non-prototyped form: storage */ /* class is extern */ main () { x = 0x7f << 2; /* if type is not int, error would be */ if (x != 0x1FC) /* flagged */ goto Fail1; y = 8.7; y = G1 (x); if (y != 508.0) goto Fail2; x = F1 (3, 4); if (x != 7) goto Fail; printf ("Passed Special Conformance Test 4.4.1.1\n"); return; Fail: printf ("Failed Special Conformance Test 4.4.1.1\n"); return; Fail1: printf ("extern int x not set correctly: x = %d\n", x); goto Fail; Fail2: printf ("extern double function G1 returns incorrect value: y = %f\n", y); goto Fail; Fail3: printf ("static int function F1 returns incorrect value: x = %d\n", x); goto Fail; } /******************************************************************************/ F1 (x, y) int x; int y; { return x + y; } \ No newline at end of file +/* Special Conformance Test 4.4.1.1: Verification of ability to omit either */ +/* type specifier or storage class in */ +/* declarations, and both in function */ +/* definitions */ +/* */ +/* Other files needed: spc4411.exec - separately compiles, links, and */ +/* executes the files spc4.4.1.1.cc and */ +/* spc4411.1.cc */ +/* */ + +static x; /* type of x is int */ +float y; /* storage class of y is extern */ + +static F1 (); /* non-prototyped form: returns int */ +double G1 (); /* also non-prototyped form: storage */ + /* class is extern */ + +main () + { + x = 0x7f << 2; /* if type is not int, error would be */ + if (x != 0x1FC) /* flagged */ + goto Fail1; + + y = 8.7; + y = G1 (x); + if (y != 508.0) + goto Fail2; + + x = F1 (3, 4); + if (x != 7) + goto Fail; + + printf ("Passed Special Conformance Test 4.4.1.1\n"); + return; + +Fail: + printf ("Failed Special Conformance Test 4.4.1.1\n"); + return; + +Fail1: + printf ("extern int x not set correctly: x = %d\n", x); + goto Fail; + +Fail2: + printf ("extern double function G1 returns incorrect value: y = %f\n", y); + goto Fail; + +Fail3: + printf ("static int function F1 returns incorrect value: x = %d\n", x); + goto Fail; + } + +/******************************************************************************/ + +F1 (x, y) + int x; + int y; + { + return x + y; + } diff --git a/Tests/Spec.Conform/SPC4.5.2.1.CC b/Tests/Spec.Conform/SPC4.5.2.1.CC old mode 100755 new mode 100644 index edf1a91..52db811 --- a/Tests/Spec.Conform/SPC4.5.2.1.CC +++ b/Tests/Spec.Conform/SPC4.5.2.1.CC @@ -1 +1,15 @@ -/* Special Conformance Test 4.5.2.1: Verification of pointer declarators for */ /* external data */ /* */ /* Other files needed: spc4521.exec - EXEC file which separately compiles, */ /* links, and executes test 4.5.2.1 */ /* spc4521.h - header file containing extern references*/ /* spc4521.1.cc - other source file comprising the test */ #include "spc4521.h" main () { extern void F1 (void); F1 (); } \ No newline at end of file +/* Special Conformance Test 4.5.2.1: Verification of pointer declarators for */ +/* external data */ +/* */ +/* Other files needed: spc4521.exec - EXEC file which separately compiles, */ +/* links, and executes test 4.5.2.1 */ +/* spc4521.h - header file containing extern references*/ +/* spc4521.1.cc - other source file comprising the test */ + +#include "spc4521.h" + +main () + { + extern void F1 (void); + F1 (); + } diff --git a/Tests/Spec.Conform/SPC4.5.3.1.CC b/Tests/Spec.Conform/SPC4.5.3.1.CC old mode 100755 new mode 100644 index 04ca147..7e1c680 --- a/Tests/Spec.Conform/SPC4.5.3.1.CC +++ b/Tests/Spec.Conform/SPC4.5.3.1.CC @@ -1 +1,40 @@ -/* Special Conformance Test 4.5.3.1: Verfication of global array declarations */ /* */ /* Other files needed: spc4531.exec - Separately compiles, links, and */ /* executes the files needed to run test */ /* spc4531.1.cc - Extern function which tests the arrays */ /* spc4531.h - Header file declaring global arrays */ int i1 [50], i3 [3] [5] [8]; /* all basic types */ long L1 [9], L2 [2] [6]; unsigned int ui3 [4] [5] [1], ui1 [7]; unsigned long ul2 [5] [3], ul1 [1]; comp c1 [3], c2 [2] [3]; char ch2 [6] [5], ch1 [10]; float f1 [3], f4 [2] [3] [1] [4]; double d2 [2] [4], d1 [8]; extended e1 [9], e2 [7] [3]; /* conglomerate types */ struct s { int a; float f; }; struct s s1 [10], s2 [5] [4]; enum colors { red, black, green }; enum colors C3 [2] [1] [3], C1 [6]; union longOrShort { int first; long second; }; union longOrShort u2 [3] [3], u1 [12]; main () { extern int TestArray (void); if ( TestArray() ) printf ("Passed Special Conformance Test 4.5.3.1\n"); else printf ("Failed Special Conformance Test 4.5.3.1\n"); } \ No newline at end of file +/* Special Conformance Test 4.5.3.1: Verfication of global array declarations */ +/* */ +/* Other files needed: spc4531.exec - Separately compiles, links, and */ +/* executes the files needed to run test */ +/* spc4531.1.cc - Extern function which tests the arrays */ +/* spc4531.h - Header file declaring global arrays */ + +int i1 [50], i3 [3] [5] [8]; /* all basic types */ +long L1 [9], L2 [2] [6]; + +unsigned int ui3 [4] [5] [1], ui1 [7]; +unsigned long ul2 [5] [3], ul1 [1]; + +comp c1 [3], c2 [2] [3]; +char ch2 [6] [5], ch1 [10]; +float f1 [3], f4 [2] [3] [1] [4]; +double d2 [2] [4], d1 [8]; +extended e1 [9], e2 [7] [3]; + + /* conglomerate types */ +struct s { int a; + float f; }; +struct s s1 [10], s2 [5] [4]; + +enum colors { red, black, green }; +enum colors C3 [2] [1] [3], C1 [6]; + +union longOrShort { int first; + long second; }; +union longOrShort u2 [3] [3], u1 [12]; + +main () + { + extern int TestArray (void); + + if ( TestArray() ) + printf ("Passed Special Conformance Test 4.5.3.1\n"); + else + printf ("Failed Special Conformance Test 4.5.3.1\n"); + } diff --git a/Tests/Spec.Conform/SPC4.5.3.2.CC b/Tests/Spec.Conform/SPC4.5.3.2.CC old mode 100755 new mode 100644 index 717290c..3565e11 --- a/Tests/Spec.Conform/SPC4.5.3.2.CC +++ b/Tests/Spec.Conform/SPC4.5.3.2.CC @@ -1 +1,43 @@ -/* Special Conformance Test 4.5.3.2: Verfication of external array */ /* declarations: arrays of pointers */ /* */ /* Other files needed: spc4532.1.cc - separately compiled file */ /* containing test of arrays */ /* spc4532.h - header file containing extern */ /* declarations needed by second file */ /* spc4532.exec - EXEC file which separately compiles*/ /* links and executes test 4.5.3.0.2 */ int *i1 [50]; /* all basic types */ long *L1 [9]; comp *c1 [3]; char *ch1 [10]; float *f1 [3]; double *d1 [8]; extended *e1 [9]; unsigned int *ui3 [4] [5] [1], *ui1 [7]; unsigned long *ul2 [5] [3], *ul1 [1]; /* conglomerate types */ struct s { int a; float f; }; struct s *s1 [10], S; enum colors { red, black, green }; enum colors *en [6], C; union longOrShort { int first; long second; }; union longOrShort *u1 [12], U; main () { extern int TestEm (void); if (TestEm) printf ("Passed Special Conformance Test 4.5.3.2\n"); else printf ("Failed Special Conformance Test 4.5.3.2\n"); } \ No newline at end of file +/* Special Conformance Test 4.5.3.2: Verfication of external array */ +/* declarations: arrays of pointers */ +/* */ +/* Other files needed: spc4532.1.cc - separately compiled file */ +/* containing test of arrays */ +/* spc4532.h - header file containing extern */ +/* declarations needed by second file */ +/* spc4532.exec - EXEC file which separately compiles*/ +/* links and executes test 4.5.3.0.2 */ + +int *i1 [50]; /* all basic types */ +long *L1 [9]; +comp *c1 [3]; +char *ch1 [10]; +float *f1 [3]; +double *d1 [8]; +extended *e1 [9]; + +unsigned int *ui3 [4] [5] [1], *ui1 [7]; +unsigned long *ul2 [5] [3], *ul1 [1]; + + /* conglomerate types */ +struct s { int a; + float f; }; +struct s *s1 [10], S; + +enum colors { red, black, green }; +enum colors *en [6], C; + +union longOrShort { int first; + long second; }; +union longOrShort *u1 [12], U; + + +main () + { + extern int TestEm (void); + + if (TestEm) + printf ("Passed Special Conformance Test 4.5.3.2\n"); + else + printf ("Failed Special Conformance Test 4.5.3.2\n"); + } diff --git a/Tests/Spec.Conform/SPC4.6.3.1.CC b/Tests/Spec.Conform/SPC4.6.3.1.CC old mode 100755 new mode 100644 index c793aa1..1150239 --- a/Tests/Spec.Conform/SPC4.6.3.1.CC +++ b/Tests/Spec.Conform/SPC4.6.3.1.CC @@ -1 +1,326 @@ -/* Special Conformance Test 4.6.3.1: Verification of pointer initializers; */ /* setting to name of a function. */ /* */ /* Other files needed: spc4631.1.cc - File containing the external functions */ /* called by main */ /* spc4631.exec - EXEC file which separately compiles, */ /* links, and executes files to run test */ #include /* static and extern pointer variables can use only constant expressions */ struct S { int a; float b; }; union U { int i; long L; }; static int I1 (void); /* declare static functions */ static char Ch1 (void); static long L1 (void); static comp C1 (void); static float F1 (void); static double D1 (void); static extended E1 (void); static unsigned int UI1 (void); static unsigned long UL1 (void); static struct S S1 (void); static union U U1 (void); extern int I2 (void); /* declare extern functions */ extern char Ch2 (void); extern long L2 (void); extern comp C2 (void); extern float F2 (void); extern double D2 (void); extern extended E2 (void); extern unsigned int UI2 (void); extern unsigned long UL2 (void); extern struct S S2 (void); extern union U U2 (void); /* initialize variables to name of function */ static int (*i1Ptr) (void) = I1; static char (*ch1Ptr) (void) = Ch1; static long (*L1Ptr) (void) = L1; static comp (*c1Ptr) (void) = C1; static float (*f1Ptr) (void) = F1; static double (*d1Ptr) (void) = D1; static extended (*e1Ptr) (void) = E1; static unsigned int (*ui1Ptr) (void) = UI1; static unsigned long (*uL1Ptr) (void) = UL1; static struct S (*struct1Ptr) (void) = S1; static union U (*union1Ptr ) (void) = U1; int (*i2Ptr) (void) = I2; char (*ch2Ptr) (void) = Ch2; long (*L2Ptr) (void) = L2; comp (*c2Ptr) (void) = C2; float (*f2Ptr) (void) = F2; double (*d2Ptr) (void) = D2; extended (*e2Ptr) (void) = E2; unsigned int (*ui2Ptr) (void) = UI2; unsigned long (*uL2Ptr) (void) = UL2; struct S (*struct2Ptr) (void) = S2; union U (*union2Ptr ) (void) = U2; /* Other external variables */ struct S extStruct1 = { 2, 5.7 }; struct S extStruct2 = { 18, 0.3 }; union U extUnion1 = { 32767 }; union U extUnion2 = { 29 }; /* Function dispatchers */ /*****************************************************************************/ int DispI (int (*func) (void)) { return (*func) (); } /*****************************************************************************/ char DispCh (char (*func) (void)) { return (*func) (); } /*****************************************************************************/ long DispL (long (*func) (void)) { return (*func) (); } /*****************************************************************************/ comp DispC (comp (*func) (void)) { return (*func) (); } /*****************************************************************************/ float DispF (float (*func) (void)) { return (*func) (); } /*****************************************************************************/ double DispD (double (*func) (void)) { return (*func) (); } /*****************************************************************************/ extended DispE (extended (*func) (void)) { return (*func) (); } /*****************************************************************************/ unsigned int DispUI (unsigned int (*func) (void)) { return (*func) (); } /*****************************************************************************/ unsigned long DispUL (unsigned long (*func) (void)) { return (*func) (); } /*****************************************************************************/ struct S DispS (struct S (*func) (void)) { return (*func) (); } /*****************************************************************************/ union U DispU (union U (*func) (void)) { return (*func) (); } /*****************************************************************************/ main () { extern int ExternTest (void); int count = 0; int i; char ch; long LL; comp c; float f; double d; extended e; unsigned int unInt; unsigned long unLong; struct S svar; union U uvar; count++; i = DispI (i1Ptr); if (i != 1) goto Fail; count++; ch = DispCh (ch1Ptr); if (ch != 'a') goto Fail; count++; LL = DispL (L1Ptr); if (LL != 0x65535) goto Fail; count++; c = DispC (c1Ptr); if (c != 4294967295ul) goto Fail; count++; f = DispF (f1Ptr); if (f != 3.5) goto Fail; count++; d = DispD (d1Ptr); if (d != 108.0e20) goto Fail; count++; e = DispE (e1Ptr); if (e != 0.123E-300) goto Fail; count++; unInt = DispUI (ui1Ptr); if (unInt != 65534) goto Fail; count++; unLong = DispUL (uL1Ptr); if (unLong != 0x7F) goto Fail; count++; svar = DispS (struct1Ptr); if ((svar.a != 2) || (fabs (svar.b - 5.7) > 0.0001)) goto Fail; count++; uvar = DispU (union1Ptr); if (uvar.i != 32767) goto Fail; count++; if ( ExternTest () ) goto Fail; printf ("Passed Special Conformance Test 4.6.3.1\n"); return 0; Fail: printf ("Failed Special Conformance Test 4.6.3.1: count = %d\n", count); return 0; } /****************************************************************************/ static int I1 (void) { return 1; } /****************************************************************************/ static char Ch1 (void) { return 'a'; } /****************************************************************************/ static long L1 (void) { return 0x65535; } /****************************************************************************/ static comp C1 (void) { return 4294967295ul; } /****************************************************************************/ static float F1 (void) { return 3.5; } /****************************************************************************/ static double D1 (void) { return 108.0E20; } /****************************************************************************/ static extended E1 (void) { return .123e-300; } /****************************************************************************/ static unsigned int UI1 (void) { return 65534; } /****************************************************************************/ static unsigned long UL1 (void) { return 0x7f; } /****************************************************************************/ static struct S S1 (void) { return extStruct1; } /****************************************************************************/ static union U U1 (void) { return extUnion1; } \ No newline at end of file +/* Special Conformance Test 4.6.3.1: Verification of pointer initializers; */ +/* setting to name of a function. */ +/* */ +/* Other files needed: spc4631.1.cc - File containing the external functions */ +/* called by main */ +/* spc4631.exec - EXEC file which separately compiles, */ +/* links, and executes files to run test */ + +#include + +/* static and extern pointer variables can use only constant expressions */ + +struct S { int a; + float b; }; +union U { int i; + long L; }; + +static int I1 (void); /* declare static functions */ +static char Ch1 (void); +static long L1 (void); +static comp C1 (void); +static float F1 (void); +static double D1 (void); +static extended E1 (void); + +static unsigned int UI1 (void); +static unsigned long UL1 (void); + +static struct S S1 (void); +static union U U1 (void); + +extern int I2 (void); /* declare extern functions */ +extern char Ch2 (void); +extern long L2 (void); +extern comp C2 (void); +extern float F2 (void); +extern double D2 (void); +extern extended E2 (void); + +extern unsigned int UI2 (void); +extern unsigned long UL2 (void); + +extern struct S S2 (void); +extern union U U2 (void); + +/* initialize variables to name of function */ + +static int (*i1Ptr) (void) = I1; +static char (*ch1Ptr) (void) = Ch1; +static long (*L1Ptr) (void) = L1; +static comp (*c1Ptr) (void) = C1; +static float (*f1Ptr) (void) = F1; +static double (*d1Ptr) (void) = D1; +static extended (*e1Ptr) (void) = E1; + +static unsigned int (*ui1Ptr) (void) = UI1; +static unsigned long (*uL1Ptr) (void) = UL1; + +static struct S (*struct1Ptr) (void) = S1; +static union U (*union1Ptr ) (void) = U1; + +int (*i2Ptr) (void) = I2; +char (*ch2Ptr) (void) = Ch2; +long (*L2Ptr) (void) = L2; +comp (*c2Ptr) (void) = C2; +float (*f2Ptr) (void) = F2; +double (*d2Ptr) (void) = D2; +extended (*e2Ptr) (void) = E2; + +unsigned int (*ui2Ptr) (void) = UI2; +unsigned long (*uL2Ptr) (void) = UL2; + +struct S (*struct2Ptr) (void) = S2; +union U (*union2Ptr ) (void) = U2; + + +/* Other external variables */ + +struct S extStruct1 = { 2, 5.7 }; +struct S extStruct2 = { 18, 0.3 }; +union U extUnion1 = { 32767 }; +union U extUnion2 = { 29 }; + + +/* Function dispatchers */ + +/*****************************************************************************/ + +int DispI (int (*func) (void)) + { + return (*func) (); + } + +/*****************************************************************************/ + +char DispCh (char (*func) (void)) + { + return (*func) (); + } + +/*****************************************************************************/ + +long DispL (long (*func) (void)) + { + return (*func) (); + } + +/*****************************************************************************/ + +comp DispC (comp (*func) (void)) + { + return (*func) (); + } + +/*****************************************************************************/ + +float DispF (float (*func) (void)) + { + return (*func) (); + } + +/*****************************************************************************/ + +double DispD (double (*func) (void)) + { + return (*func) (); + } + +/*****************************************************************************/ + +extended DispE (extended (*func) (void)) + { + return (*func) (); + } + +/*****************************************************************************/ + +unsigned int DispUI (unsigned int (*func) (void)) + { + return (*func) (); + } + +/*****************************************************************************/ + +unsigned long DispUL (unsigned long (*func) (void)) + { + return (*func) (); + } + +/*****************************************************************************/ + +struct S DispS (struct S (*func) (void)) + { + return (*func) (); + } + +/*****************************************************************************/ + +union U DispU (union U (*func) (void)) + { + return (*func) (); + } + +/*****************************************************************************/ + +main () + { + extern int ExternTest (void); + + int count = 0; + + int i; + char ch; + long LL; + comp c; + float f; + double d; + extended e; + unsigned int unInt; + unsigned long unLong; + struct S svar; + union U uvar; + + count++; + i = DispI (i1Ptr); + if (i != 1) + goto Fail; + + count++; + ch = DispCh (ch1Ptr); + if (ch != 'a') + goto Fail; + + count++; + LL = DispL (L1Ptr); + if (LL != 0x65535) + goto Fail; + + count++; + c = DispC (c1Ptr); + if (c != 4294967295ul) + goto Fail; + + count++; + f = DispF (f1Ptr); + if (f != 3.5) + goto Fail; + + count++; + d = DispD (d1Ptr); + if (d != 108.0e20) + goto Fail; + + count++; + e = DispE (e1Ptr); + if (e != 0.123E-300) + goto Fail; + + count++; + unInt = DispUI (ui1Ptr); + if (unInt != 65534) + goto Fail; + + count++; + unLong = DispUL (uL1Ptr); + if (unLong != 0x7F) + goto Fail; + + count++; + svar = DispS (struct1Ptr); + if ((svar.a != 2) || (fabs (svar.b - 5.7) > 0.0001)) + goto Fail; + + count++; + uvar = DispU (union1Ptr); + if (uvar.i != 32767) + goto Fail; + + count++; + if ( ExternTest () ) + goto Fail; + + printf ("Passed Special Conformance Test 4.6.3.1\n"); + return 0; + +Fail: + printf ("Failed Special Conformance Test 4.6.3.1: count = %d\n", count); + return 0; + } + +/****************************************************************************/ + +static int I1 (void) + { + return 1; + } + +/****************************************************************************/ + +static char Ch1 (void) + { + return 'a'; + } + +/****************************************************************************/ + +static long L1 (void) + { + return 0x65535; + } + +/****************************************************************************/ + +static comp C1 (void) + { + return 4294967295ul; + } + +/****************************************************************************/ + +static float F1 (void) + { + return 3.5; + } + +/****************************************************************************/ + +static double D1 (void) + { + return 108.0E20; + } + +/****************************************************************************/ + +static extended E1 (void) + { + return .123e-300; + } + +/****************************************************************************/ + +static unsigned int UI1 (void) + { + return 65534; + } + +/****************************************************************************/ + +static unsigned long UL1 (void) + { + return 0x7f; + } + +/****************************************************************************/ + +static struct S S1 (void) + { + return extStruct1; + } + +/****************************************************************************/ + +static union U U1 (void) + { + return extUnion1; + } diff --git a/Tests/Spec.Conform/SPC4.6.3.2.CC b/Tests/Spec.Conform/SPC4.6.3.2.CC old mode 100755 new mode 100644 index fe0bc9a..1f3bd67 --- a/Tests/Spec.Conform/SPC4.6.3.2.CC +++ b/Tests/Spec.Conform/SPC4.6.3.2.CC @@ -1 +1,149 @@ -/* Special Conformance Test 4.6.3.2: Verification of static & extern pointer */ /* initializers: setting pointer to name */ /* of a static or extern array. */ /* */ /* Other files needed: spc4632.1.cc - separately compiled file which accesses */ /* external arrays initialized here */ /* spc4632.exec - EXEC file which separately compiles the */ /* two source files and then links and */ /* executes them to perform the test */ #include /* static and extern pointer variables can use only constant expressions */ struct S { int a; float b; }; union U { int i; long L; }; /* Declare and initialize static arrays */ static int I1 [2] = { 1, 2 }; static char Ch1 [2] = { 'a', 'b' }; static long L1 [2] = { 32778, 32889 }; static comp C1 [2] = { 65535, 65530 }; static float F1 [2] = { 1.1, 1.2, }; static double D1 [2] = { 2.2, 2.3, }; static extended E1 [2] = { 3.0, 3.3, }; static unsigned int UI1 [2] = { 0xFFFF, 0x0011 }; static unsigned long UL1 [2] = { 0xFFFFFFFF, 0x7FFFFFFF }; static struct S S1 [2] = { { 4, 8.0 }, { 10, 15.0 } }; static union U U1 [2] = { 3 }; /* Declare and initialize extern arrays */ int I2 [2] = { 8, 9 }; char Ch2 [2] = { 'x', 'y' }; long L2 [2] = { 17, 23 }; comp C2 [2] = { 45000, 500000 }; float F2 [2] = { 123.456, 6.0e7 }; double D2 [2] = { 0.5e10, 3.27 }; extended E2 [2] = { 7.4, 9.9 }; unsigned int UI2 [2] = { 10, 11 }; unsigned long UL2 [2] = { 4, 4 }; struct S S2 [2] = { 888, 8.88, 999, 9.99 }; union U U2 [2] = { 7777 }; /* initialize pointer variables to names of static and extern arrays */ static int (*i1Ptr) = I1; static char (*ch1Ptr) = Ch1; static long (*L1Ptr) = L1; static comp (*c1Ptr) = C1; static float (*f1Ptr) = F1; static double (*d1Ptr) = D1; static extended (*e1Ptr) = E1; static unsigned int (*ui1Ptr) = UI1; static unsigned long (*uL1Ptr) = UL1; static struct S (*struct1Ptr) = S1; static union U (*union1Ptr ) = U1; int (*i2Ptr) = I2; char (*ch2Ptr) = Ch2; long (*L2Ptr) = L2; comp (*c2Ptr) = C2; float (*f2Ptr) = F2; double (*d2Ptr) = D2; extended (*e2Ptr) = E2; unsigned int (*ui2Ptr) = UI2; unsigned long (*uL2Ptr) = UL2; struct S (*struct2Ptr) = S2; union U (*union2Ptr ) = U2; main () { int count = 0; extern int ExternTest (void); count++; if ((*(i1Ptr) != 1) || (*(i1Ptr + 1) != 2)) goto Fail; count++; if ((*(ch1Ptr) != 'a') || (*(ch1Ptr + 1) != 'b')) goto Fail; count++; if ((*(L1Ptr) != 32778) || (*(L1Ptr + 1) != 32889)) goto Fail; count++; if ((*(c1Ptr) != 65535) || (*(c1Ptr + 1) != 65530)) goto Fail; count++; if ((fabs (*(f1Ptr) - 1.1) > 0.0001) || (fabs (*(f1Ptr + 1) - 1.2) > 0.0001)) goto Fail; count++; if ((fabs (*(d1Ptr) - 2.2) > 0.0001) || (fabs (*(d1Ptr + 1) - 2.3) > 0.0001)) goto Fail; count++; if ((fabs (*(e1Ptr) - 3.0) > 0.0001) || (fabs (*(e1Ptr + 1) - 3.3) > 0.0001)) goto Fail; count++; if ((*(ui1Ptr) != 0xFFFF) || (*(ui1Ptr + 1) != 0x0011)) goto Fail; count++; if ((*(uL1Ptr) != 0xffffffff) || (*(uL1Ptr + 1) != 0x7fffffff)) goto Fail; count++; if ((struct1Ptr->a != 4) || ((struct1Ptr + 1)->a != 10)) goto Fail; count++; if ((fabs (struct1Ptr->b - 8.0) > 0.0001) || (fabs ((struct1Ptr + 1)->b - 15.0) > 0.0001)) goto Fail; count++; if ((union1Ptr->i != 3) || ((union1Ptr + 1)->i != 0)) goto Fail; if ( ExternTest () ) goto Fail2; printf ("Passed Special Conformance Test 4.6.3.2\n"); return; Fail: printf ("count = %d\n", count); Fail2: printf ("Failed Special Conformance Test 4.6.3.2\n"); } \ No newline at end of file +/* Special Conformance Test 4.6.3.2: Verification of static & extern pointer */ +/* initializers: setting pointer to name */ +/* of a static or extern array. */ +/* */ +/* Other files needed: spc4632.1.cc - separately compiled file which accesses */ +/* external arrays initialized here */ +/* spc4632.exec - EXEC file which separately compiles the */ +/* two source files and then links and */ +/* executes them to perform the test */ + +#include + +/* static and extern pointer variables can use only constant expressions */ + +struct S { int a; + float b; }; +union U { int i; + long L; }; + +/* Declare and initialize static arrays */ + +static int I1 [2] = { 1, 2 }; +static char Ch1 [2] = { 'a', 'b' }; +static long L1 [2] = { 32778, 32889 }; +static comp C1 [2] = { 65535, 65530 }; +static float F1 [2] = { 1.1, 1.2, }; +static double D1 [2] = { 2.2, 2.3, }; +static extended E1 [2] = { 3.0, 3.3, }; + +static unsigned int UI1 [2] = { 0xFFFF, 0x0011 }; +static unsigned long UL1 [2] = { 0xFFFFFFFF, 0x7FFFFFFF }; + +static struct S S1 [2] = { { 4, 8.0 }, { 10, 15.0 } }; +static union U U1 [2] = { 3 }; + + +/* Declare and initialize extern arrays */ + +int I2 [2] = { 8, 9 }; +char Ch2 [2] = { 'x', 'y' }; +long L2 [2] = { 17, 23 }; +comp C2 [2] = { 45000, 500000 }; +float F2 [2] = { 123.456, 6.0e7 }; +double D2 [2] = { 0.5e10, 3.27 }; +extended E2 [2] = { 7.4, 9.9 }; + +unsigned int UI2 [2] = { 10, 11 }; +unsigned long UL2 [2] = { 4, 4 }; + +struct S S2 [2] = { 888, 8.88, 999, 9.99 }; +union U U2 [2] = { 7777 }; + + +/* initialize pointer variables to names of static and extern arrays */ + +static int (*i1Ptr) = I1; +static char (*ch1Ptr) = Ch1; +static long (*L1Ptr) = L1; +static comp (*c1Ptr) = C1; +static float (*f1Ptr) = F1; +static double (*d1Ptr) = D1; +static extended (*e1Ptr) = E1; + +static unsigned int (*ui1Ptr) = UI1; +static unsigned long (*uL1Ptr) = UL1; + +static struct S (*struct1Ptr) = S1; +static union U (*union1Ptr ) = U1; + +int (*i2Ptr) = I2; +char (*ch2Ptr) = Ch2; +long (*L2Ptr) = L2; +comp (*c2Ptr) = C2; +float (*f2Ptr) = F2; +double (*d2Ptr) = D2; +extended (*e2Ptr) = E2; + +unsigned int (*ui2Ptr) = UI2; +unsigned long (*uL2Ptr) = UL2; + +struct S (*struct2Ptr) = S2; +union U (*union2Ptr ) = U2; + + +main () + { + int count = 0; + extern int ExternTest (void); + + count++; + if ((*(i1Ptr) != 1) || (*(i1Ptr + 1) != 2)) + goto Fail; + + count++; + if ((*(ch1Ptr) != 'a') || (*(ch1Ptr + 1) != 'b')) + goto Fail; + + count++; + if ((*(L1Ptr) != 32778) || (*(L1Ptr + 1) != 32889)) + goto Fail; + + count++; + if ((*(c1Ptr) != 65535) || (*(c1Ptr + 1) != 65530)) + goto Fail; + + count++; + if ((fabs (*(f1Ptr) - 1.1) > 0.0001) || (fabs (*(f1Ptr + 1) - 1.2) > 0.0001)) + goto Fail; + + count++; + if ((fabs (*(d1Ptr) - 2.2) > 0.0001) || (fabs (*(d1Ptr + 1) - 2.3) > 0.0001)) + goto Fail; + + count++; + if ((fabs (*(e1Ptr) - 3.0) > 0.0001) || (fabs (*(e1Ptr + 1) - 3.3) > 0.0001)) + goto Fail; + + count++; + if ((*(ui1Ptr) != 0xFFFF) || (*(ui1Ptr + 1) != 0x0011)) + goto Fail; + + count++; + if ((*(uL1Ptr) != 0xffffffff) || (*(uL1Ptr + 1) != 0x7fffffff)) + goto Fail; + + count++; + if ((struct1Ptr->a != 4) || ((struct1Ptr + 1)->a != 10)) + goto Fail; + + count++; + if ((fabs (struct1Ptr->b - 8.0) > 0.0001) || + (fabs ((struct1Ptr + 1)->b - 15.0) > 0.0001)) + goto Fail; + + count++; + if ((union1Ptr->i != 3) || ((union1Ptr + 1)->i != 0)) + goto Fail; + + if ( ExternTest () ) + goto Fail2; + + printf ("Passed Special Conformance Test 4.6.3.2\n"); + return; + +Fail: + printf ("count = %d\n", count); +Fail2: + printf ("Failed Special Conformance Test 4.6.3.2\n"); + } diff --git a/Tests/Spec.Conform/SPC4.6.3.3.CC b/Tests/Spec.Conform/SPC4.6.3.3.CC old mode 100755 new mode 100644 index ef7c5aa..beefaab --- a/Tests/Spec.Conform/SPC4.6.3.3.CC +++ b/Tests/Spec.Conform/SPC4.6.3.3.CC @@ -1 +1,143 @@ -/* Special Conformance Test 4.6.3.3: Verification of static & extern pointer */ /* initializers: setting pointer to name */ /* of a static or extern variable. */ /* */ /* Other files needed: spc4633.1.cc - separately compiled file which accesses */ /* external arrays initialized here */ /* spc4633.exec - EXEC file which separately compiles the */ /* two source files and then links and */ /* executes them to perform the test */ #include /* static and extern pointer variables can use only constant expressions */ struct S { int a; float b; }; union U { int i; long L; }; /* Declare and initialize static variables */ static int I1 = { 1, }; static char Ch1 = { 'a', }; static long L1 = { 32778, }; static comp C1 = { 65535, }; static float F1 = { 1.1, }; static double D1 = { 2.2, }; static extended E1 = { 3.0, }; static unsigned int UI1 = { 0xFFFF, }; static unsigned long UL1 = { 0xFFFFFFFF, }; static struct S S1 = { 4, 8.0 }; static union U U1 = { 3 }; /* Declare and initialize extern variables */ int I2 = { 8, }; char Ch2 = { 'x', }; long L2 = { 17, }; comp C2 = { 45000, }; float F2 = { 123.456, }; double D2 = { 0.5e10, }; extended E2 = { 7.4, }; unsigned int UI2 = { 10, }; unsigned long UL2 = { 4, }; struct S S2 = { 888, 8.88, }; union U U2 = { 7777 }; /* initialize pointer variables to names of static and extern variables */ static int (*i1Ptr) = &I1; static char (*ch1Ptr) = &Ch1; static long (*L1Ptr) = &L1; static comp (*c1Ptr) = &C1; static float (*f1Ptr) = &F1; static double (*d1Ptr) = &D1; static extended (*e1Ptr) = &E1; static unsigned int (*ui1Ptr) = &UI1; static unsigned long (*uL1Ptr) = &UL1; static struct S (*struct1Ptr) = &S1; static union U (*union1Ptr ) = &U1; int (*i2Ptr) = &I2; char (*ch2Ptr) = &Ch2; long (*L2Ptr) = &L2; comp (*c2Ptr) = &C2; float (*f2Ptr) = &F2; double (*d2Ptr) = &D2; extended (*e2Ptr) = &E2; unsigned int (*ui2Ptr) = &UI2; unsigned long (*uL2Ptr) = &UL2; struct S (*struct2Ptr) = &S2; union U (*union2Ptr ) = &U2; main () { int count = 0; extern int ExternTest (void); count++; if (*(i1Ptr) != 1) goto Fail; count++; if (*(ch1Ptr) != 'a') goto Fail; count++; if (*(L1Ptr) != 32778) goto Fail; count++; if (*(c1Ptr) != 65535) goto Fail; count++; if (fabs (*(f1Ptr) - 1.1) > 0.0001) goto Fail; count++; if (fabs (*(d1Ptr) - 2.2) > 0.0001) goto Fail; count++; if (fabs (*(e1Ptr) - 3.0) > 0.0001) goto Fail; count++; if (*(ui1Ptr) != 0xFFFF) goto Fail; count++; if (*(uL1Ptr) != 0xffffffff) goto Fail; count++; if ((struct1Ptr->a != 4) || (fabs (struct1Ptr->b - 8.0) > 0.0001)) goto Fail; count++; if (union1Ptr->i != 3) goto Fail; if ( ExternTest () ) goto Fail; printf ("Passed Special Conformance Test 4.6.3.3\n"); return; Fail: printf ("count = %d\n", count); printf ("Failed Special Conformance Test 4.6.3.3\n"); } \ No newline at end of file +/* Special Conformance Test 4.6.3.3: Verification of static & extern pointer */ +/* initializers: setting pointer to name */ +/* of a static or extern variable. */ +/* */ +/* Other files needed: spc4633.1.cc - separately compiled file which accesses */ +/* external arrays initialized here */ +/* spc4633.exec - EXEC file which separately compiles the */ +/* two source files and then links and */ +/* executes them to perform the test */ + +#include + +/* static and extern pointer variables can use only constant expressions */ + +struct S { int a; + float b; }; +union U { int i; + long L; }; + +/* Declare and initialize static variables */ + +static int I1 = { 1, }; +static char Ch1 = { 'a', }; +static long L1 = { 32778, }; +static comp C1 = { 65535, }; +static float F1 = { 1.1, }; +static double D1 = { 2.2, }; +static extended E1 = { 3.0, }; + +static unsigned int UI1 = { 0xFFFF, }; +static unsigned long UL1 = { 0xFFFFFFFF, }; + +static struct S S1 = { 4, 8.0 }; +static union U U1 = { 3 }; + + +/* Declare and initialize extern variables */ + +int I2 = { 8, }; +char Ch2 = { 'x', }; +long L2 = { 17, }; +comp C2 = { 45000, }; +float F2 = { 123.456, }; +double D2 = { 0.5e10, }; +extended E2 = { 7.4, }; + +unsigned int UI2 = { 10, }; +unsigned long UL2 = { 4, }; + +struct S S2 = { 888, 8.88, }; +union U U2 = { 7777 }; + + +/* initialize pointer variables to names of static and extern variables */ + +static int (*i1Ptr) = &I1; +static char (*ch1Ptr) = &Ch1; +static long (*L1Ptr) = &L1; +static comp (*c1Ptr) = &C1; +static float (*f1Ptr) = &F1; +static double (*d1Ptr) = &D1; +static extended (*e1Ptr) = &E1; + +static unsigned int (*ui1Ptr) = &UI1; +static unsigned long (*uL1Ptr) = &UL1; + +static struct S (*struct1Ptr) = &S1; +static union U (*union1Ptr ) = &U1; + +int (*i2Ptr) = &I2; +char (*ch2Ptr) = &Ch2; +long (*L2Ptr) = &L2; +comp (*c2Ptr) = &C2; +float (*f2Ptr) = &F2; +double (*d2Ptr) = &D2; +extended (*e2Ptr) = &E2; + +unsigned int (*ui2Ptr) = &UI2; +unsigned long (*uL2Ptr) = &UL2; + +struct S (*struct2Ptr) = &S2; +union U (*union2Ptr ) = &U2; + + +main () + { + int count = 0; + extern int ExternTest (void); + + count++; + if (*(i1Ptr) != 1) + goto Fail; + + count++; + if (*(ch1Ptr) != 'a') + goto Fail; + + count++; + if (*(L1Ptr) != 32778) + goto Fail; + + count++; + if (*(c1Ptr) != 65535) + goto Fail; + + count++; + if (fabs (*(f1Ptr) - 1.1) > 0.0001) + goto Fail; + + count++; + if (fabs (*(d1Ptr) - 2.2) > 0.0001) + goto Fail; + + count++; + if (fabs (*(e1Ptr) - 3.0) > 0.0001) + goto Fail; + + count++; + if (*(ui1Ptr) != 0xFFFF) + goto Fail; + + count++; + if (*(uL1Ptr) != 0xffffffff) + goto Fail; + + count++; + if ((struct1Ptr->a != 4) || (fabs (struct1Ptr->b - 8.0) > 0.0001)) + goto Fail; + + count++; + if (union1Ptr->i != 3) + goto Fail; + + if ( ExternTest () ) + goto Fail; + + printf ("Passed Special Conformance Test 4.6.3.3\n"); + return; + +Fail: + printf ("count = %d\n", count); + printf ("Failed Special Conformance Test 4.6.3.3\n"); + } diff --git a/Tests/Spec.Conform/SPC4.6.3.4.CC b/Tests/Spec.Conform/SPC4.6.3.4.CC old mode 100755 new mode 100644 index 4ed0665..0b73a65 --- a/Tests/Spec.Conform/SPC4.6.3.4.CC +++ b/Tests/Spec.Conform/SPC4.6.3.4.CC @@ -1 +1,145 @@ -/* Special Conformance Test 4.6.3.4: Verification of static & extern pointer */ /* initializers: setting pointer to element*/ /* of a static or extern array. */ /* */ /* Other files needed: spc4634.1.cc - separately compiled file which accesses */ /* external addresses initialized here */ /* spc4634.exec - EXEC file which separately compiles the */ /* two source files and then links and */ /* executes them to perform the test */ #include /* static and extern pointer variables can use only constant expressions */ struct S { int a; float b; }; union U { int i; long L; }; /* Declare and initialize static arrays */ static int I1 [2] = { 1, 2 }; static char Ch1 [2] = { 'a', 'b' }; static long L1 [2] = { 32778, }; static comp C1 [2] = { 65535, 978 }; static float F1 [2] = { 1.1, 3.4 }; static double D1 [2] = { 2.2, 3.7 }; static extended E1 [2] = { 3.0, 4.0 }; static unsigned int UI1 [2] = { 0xFFFF, 0xabcd }; static unsigned long UL1 [2] = { 0xFFFFFFFF, 0xef010101 }; static struct S S1 [2] = { 4, 8.0, 10, 20.5 }; static union U U1 [2] = { 3, 32767 }; /* Declare and initialize extern variables */ int I2 [2] = { 8, 9 }; char Ch2 [2] = { 'x', 'z' }; long L2 [2] = { 17, 27 }; comp C2 [2] = { 45000, 100000 }; float F2 [2] = { 123.456, 12.3456 }; double D2 [2] = { 0.5e10, 0.65 }; extended E2 [2] = { 7.4, 4.7 }; unsigned int UI2 [2] = { 10, 20 }; unsigned long UL2 [2] = { 4, 88 }; struct S S2 [2] = { 888, 8.88, 999, 9.99 }; union U U2 [2] = { 7777 }; /* Initialize pointer variables to array addresses */ static int (*i1Ptr) = &I1 [1]; static char (*ch1Ptr) = &Ch1 [1]; static long (*L1Ptr) = &L1 [1]; static comp (*c1Ptr) = &C1 [1]; static float (*f1Ptr) = &F1 [1]; static double (*d1Ptr) = &D1 [1]; static extended (*e1Ptr) = &E1 [1]; static unsigned int (*ui1Ptr) = &UI1 [1]; static unsigned long (*uL1Ptr) = &UL1 [1]; static struct S (*struct1Ptr) = &S1 [1]; static union U (*union1Ptr ) = &U1 [1]; int (*i2Ptr) = &I2 [1]; char (*ch2Ptr) = &Ch2 [1]; long (*L2Ptr) = &L2 [1]; comp (*c2Ptr) = &C2 [1]; float (*f2Ptr) = &F2 [1]; double (*d2Ptr) = &D2 [1]; extended (*e2Ptr) = &E2 [1]; unsigned int (*ui2Ptr) = &UI2 [1]; unsigned long (*uL2Ptr) = &UL2 [1]; struct S (*struct2Ptr) = &S2 [1]; union U (*union2Ptr ) = &U2 [1]; main () { int count = 0; extern int ExternTest (void); count++; if (*(i1Ptr) != 2) goto Fail; count++; if (*(ch1Ptr) != 'b') goto Fail; count++; if (*(L1Ptr) != 0) goto Fail; count++; if (*c1Ptr != 978) goto Fail; count++; if (fabs (*(f1Ptr) - 3.4) > 0.0001) goto Fail; count++; if (fabs (*(d1Ptr) - 3.7) > 0.0001) goto Fail; count++; if (fabs (*(e1Ptr) - 4.0) > 0.0001) goto Fail; count++; if (*(ui1Ptr) != 0xABCD) goto Fail; count++; if (*(uL1Ptr) != 0xEF010101) goto Fail; count++; if ((struct1Ptr->a != 10) || (fabs (struct1Ptr->b - 20.5) > 0.0001)) goto Fail; count++; if (union1Ptr->i != 32767) goto Fail; count++; if ( ExternTest () ) goto Fail; printf ("Passed Special Conformance Test 4.6.3.4\n"); return 0; Fail: printf ("count = %d\n", count); printf ("Failed Special Conformance Test 4.6.3.4\n"); return 0; } \ No newline at end of file +/* Special Conformance Test 4.6.3.4: Verification of static & extern pointer */ +/* initializers: setting pointer to element*/ +/* of a static or extern array. */ +/* */ +/* Other files needed: spc4634.1.cc - separately compiled file which accesses */ +/* external addresses initialized here */ +/* spc4634.exec - EXEC file which separately compiles the */ +/* two source files and then links and */ +/* executes them to perform the test */ + +#include + +/* static and extern pointer variables can use only constant expressions */ + +struct S { int a; + float b; }; +union U { int i; + long L; }; + +/* Declare and initialize static arrays */ + +static int I1 [2] = { 1, 2 }; +static char Ch1 [2] = { 'a', 'b' }; +static long L1 [2] = { 32778, }; +static comp C1 [2] = { 65535, 978 }; +static float F1 [2] = { 1.1, 3.4 }; +static double D1 [2] = { 2.2, 3.7 }; +static extended E1 [2] = { 3.0, 4.0 }; + +static unsigned int UI1 [2] = { 0xFFFF, 0xabcd }; +static unsigned long UL1 [2] = { 0xFFFFFFFF, 0xef010101 }; + +static struct S S1 [2] = { 4, 8.0, 10, 20.5 }; +static union U U1 [2] = { 3, 32767 }; + + +/* Declare and initialize extern variables */ + +int I2 [2] = { 8, 9 }; +char Ch2 [2] = { 'x', 'z' }; +long L2 [2] = { 17, 27 }; +comp C2 [2] = { 45000, 100000 }; +float F2 [2] = { 123.456, 12.3456 }; +double D2 [2] = { 0.5e10, 0.65 }; +extended E2 [2] = { 7.4, 4.7 }; + +unsigned int UI2 [2] = { 10, 20 }; +unsigned long UL2 [2] = { 4, 88 }; + +struct S S2 [2] = { 888, 8.88, 999, 9.99 }; +union U U2 [2] = { 7777 }; + + +/* Initialize pointer variables to array addresses */ + +static int (*i1Ptr) = &I1 [1]; +static char (*ch1Ptr) = &Ch1 [1]; +static long (*L1Ptr) = &L1 [1]; +static comp (*c1Ptr) = &C1 [1]; +static float (*f1Ptr) = &F1 [1]; +static double (*d1Ptr) = &D1 [1]; +static extended (*e1Ptr) = &E1 [1]; + +static unsigned int (*ui1Ptr) = &UI1 [1]; +static unsigned long (*uL1Ptr) = &UL1 [1]; + +static struct S (*struct1Ptr) = &S1 [1]; +static union U (*union1Ptr ) = &U1 [1]; + +int (*i2Ptr) = &I2 [1]; +char (*ch2Ptr) = &Ch2 [1]; +long (*L2Ptr) = &L2 [1]; +comp (*c2Ptr) = &C2 [1]; +float (*f2Ptr) = &F2 [1]; +double (*d2Ptr) = &D2 [1]; +extended (*e2Ptr) = &E2 [1]; + +unsigned int (*ui2Ptr) = &UI2 [1]; +unsigned long (*uL2Ptr) = &UL2 [1]; + +struct S (*struct2Ptr) = &S2 [1]; +union U (*union2Ptr ) = &U2 [1]; + + +main () + { + int count = 0; + extern int ExternTest (void); + + count++; + if (*(i1Ptr) != 2) + goto Fail; + + count++; + if (*(ch1Ptr) != 'b') + goto Fail; + + count++; + if (*(L1Ptr) != 0) + goto Fail; + + count++; + if (*c1Ptr != 978) + goto Fail; + + count++; + if (fabs (*(f1Ptr) - 3.4) > 0.0001) + goto Fail; + + count++; + if (fabs (*(d1Ptr) - 3.7) > 0.0001) + goto Fail; + + count++; + if (fabs (*(e1Ptr) - 4.0) > 0.0001) + goto Fail; + + count++; + if (*(ui1Ptr) != 0xABCD) + goto Fail; + + count++; + if (*(uL1Ptr) != 0xEF010101) + goto Fail; + + count++; + if ((struct1Ptr->a != 10) || (fabs (struct1Ptr->b - 20.5) > 0.0001)) + goto Fail; + + count++; + if (union1Ptr->i != 32767) + goto Fail; + + count++; + if ( ExternTest () ) + goto Fail; + + printf ("Passed Special Conformance Test 4.6.3.4\n"); + return 0; + +Fail: + printf ("count = %d\n", count); + printf ("Failed Special Conformance Test 4.6.3.4\n"); + return 0; + } diff --git a/Tests/Spec.Conform/SPC4.6.3.5.CC b/Tests/Spec.Conform/SPC4.6.3.5.CC old mode 100755 new mode 100644 index 222a29b..c8be93d --- a/Tests/Spec.Conform/SPC4.6.3.5.CC +++ b/Tests/Spec.Conform/SPC4.6.3.5.CC @@ -1 +1,22 @@ -/* Special Conformance Test 4.6.3.5: Verification of pointer initialization: */ /* setting pointer to integer constant */ /* */ /* Tester needs to enter one character from the keyboard and then check that */ /* the key echoed is the same key. */ /* */ main () { static char *keyBoard = (char *) 0xC000ul, *strobe = (char *) 0xC010ul, ch; *keyBoard = 0; printf ("Please type one character\n"); while (!(*keyBoard & 0x0080)) ; *strobe = 1; ch = *keyBoard; printf ("The character typed is: %c\n", ch); return; Fail: printf ("Failed Special Conformance Test 4.6.3.5\n"); } \ No newline at end of file +/* Special Conformance Test 4.6.3.5: Verification of pointer initialization: */ +/* setting pointer to integer constant */ +/* */ +/* Tester needs to enter one character from the keyboard and then check that */ +/* the key echoed is the same key. */ +/* */ + +main () + { + static char *keyBoard = (char *) 0xC000ul, *strobe = (char *) 0xC010ul, ch; + + *keyBoard = 0; + printf ("Please type one character\n"); + while (!(*keyBoard & 0x0080)) ; + *strobe = 1; + ch = *keyBoard; + printf ("The character typed is: %c\n", ch); + return; + +Fail: + printf ("Failed Special Conformance Test 4.6.3.5\n"); + } diff --git a/Tests/Spec.Conform/SPC4.6.3.6.CC b/Tests/Spec.Conform/SPC4.6.3.6.CC old mode 100755 new mode 100644 index b6a1fa1..a7fde24 --- a/Tests/Spec.Conform/SPC4.6.3.6.CC +++ b/Tests/Spec.Conform/SPC4.6.3.6.CC @@ -1 +1,144 @@ -/* Special Conformance Test 4.6.3.6: Verification of static & extern pointer */ /* initializers: setting pointer to name */ /* of a static or extern array + constant */ /* */ /* Other files needed: spc4636.1.cc - separately compiled file which accesses */ /* external arrays initialized here */ /* spc4636.exec - EXEC file which separately compiles the */ /* two source files and then links and */ /* executes them to perform the test */ #include /* static and extern pointer variables can use only constant expressions */ struct S { int a; float b; }; union U { int i; long L; }; /* Declare and initialize static arrays */ static int I1 [2] = { 1, 2 }; static char Ch1 [2] = { 'a', 'b' }; static long L1 [2] = { 32778, 32889 }; static comp C1 [2] = { 65535, 65530 }; static float F1 [2] = { 1.1, 1.2 }; static double D1 [2] = { 2.2, 2.3 }; static extended E1 [2] = { 3.0, 3.3 }; static unsigned int UI1 [2] = { 0xFFFF, 0x0011 }; static unsigned long UL1 [2] = { 0xFFFFFFFF, 0x7FFFFFFF }; static struct S S1 [2] = { { 4, 8.0 }, { 10, 15.0 } }; static union U U1 [2] = { 3 }; /* Declare and initialize extern arrays */ int I2 [2] = { 8, 9 }; char Ch2 [2] = { 'x', 'y' }; long L2 [2] = { 17, 23 }; comp C2 [2] = { 45000, 500000 }; float F2 [2] = { 123.456, 6.0e7 }; double D2 [2] = { 0.5e10, 3.27 }; extended E2 [2] = { 7.4, 9.9 }; unsigned int UI2 [2] = { 10, 11 }; unsigned long UL2 [2] = { 4, 4 }; struct S S2 [2] = { 888, 8.88, 999, 9.99 }; union U U2 [2] = { 7777 }; /* Initialize pointer variables to (names of static and extern arrays) + 1 */ static int (*i1Ptr) = I1 + 1; static char (*ch1Ptr) = Ch1 + 1; static long (*L1Ptr) = L1 + 1; static comp (*c1Ptr) = C1 + 1; static float (*f1Ptr) = F1 + 1; static double (*d1Ptr) = D1 + 1; static extended (*e1Ptr) = E1 + 1; static unsigned int (*ui1Ptr) = UI1 + 1; static unsigned long (*uL1Ptr) = UL1 + 1; static struct S (*struct1Ptr) = S1 + 1; static union U (*union1Ptr ) = U1 + 1; int (*i2Ptr) = I2 + 1; char (*ch2Ptr) = Ch2 + 1; long (*L2Ptr) = L2 + 1; comp (*c2Ptr) = C2 + 1; float (*f2Ptr) = F2 + 1; double (*d2Ptr) = D2 + 1; extended (*e2Ptr) = E2 + 1; unsigned int (*ui2Ptr) = UI2 + 1; unsigned long (*uL2Ptr) = UL2 + 1; struct S (*struct2Ptr) = S2 + 1; union U (*union2Ptr ) = U2 + 1; main () { int count = 0; extern int ExternTest (void); count++; if (*(i1Ptr) != 2) goto Fail; count++; if (*(ch1Ptr) != 'b') goto Fail; count++; if (*(L1Ptr) != 32889) goto Fail; /* count++; if (*(c1Ptr) != 65530) goto Fail; */ count++; if (fabs (*(f1Ptr) - 1.2) > 0.0001) goto Fail; count++; if (fabs (*(d1Ptr) - 2.3) > 0.0001) goto Fail; count++; if (fabs (*(e1Ptr) - 3.3) > 0.0001) goto Fail; count++; if (*(ui1Ptr) != 0x0011) goto Fail; count++; if (*(uL1Ptr) != 0x7fffffff) goto Fail; count++; if ((struct1Ptr->a != 10) || (fabs (struct1Ptr->b - 15.0) > 0.0001)) goto Fail; count++; if (union1Ptr->i != 0) goto Fail; if ( ExternTest () ) goto Fail2; printf ("Passed Special Conformance Test 4.6.3.6\n"); return; Fail: printf ("count = %d\n", count); Fail2: printf ("Failed Special Conformance Test 4.6.3.6\n"); } \ No newline at end of file +/* Special Conformance Test 4.6.3.6: Verification of static & extern pointer */ +/* initializers: setting pointer to name */ +/* of a static or extern array + constant */ +/* */ +/* Other files needed: spc4636.1.cc - separately compiled file which accesses */ +/* external arrays initialized here */ +/* spc4636.exec - EXEC file which separately compiles the */ +/* two source files and then links and */ +/* executes them to perform the test */ + +#include + +/* static and extern pointer variables can use only constant expressions */ + +struct S { int a; + float b; }; +union U { int i; + long L; }; + +/* Declare and initialize static arrays */ + +static int I1 [2] = { 1, 2 }; +static char Ch1 [2] = { 'a', 'b' }; +static long L1 [2] = { 32778, 32889 }; +static comp C1 [2] = { 65535, 65530 }; +static float F1 [2] = { 1.1, 1.2 }; +static double D1 [2] = { 2.2, 2.3 }; +static extended E1 [2] = { 3.0, 3.3 }; + +static unsigned int UI1 [2] = { 0xFFFF, 0x0011 }; +static unsigned long UL1 [2] = { 0xFFFFFFFF, 0x7FFFFFFF }; + +static struct S S1 [2] = { { 4, 8.0 }, { 10, 15.0 } }; +static union U U1 [2] = { 3 }; + + +/* Declare and initialize extern arrays */ + +int I2 [2] = { 8, 9 }; +char Ch2 [2] = { 'x', 'y' }; +long L2 [2] = { 17, 23 }; +comp C2 [2] = { 45000, 500000 }; +float F2 [2] = { 123.456, 6.0e7 }; +double D2 [2] = { 0.5e10, 3.27 }; +extended E2 [2] = { 7.4, 9.9 }; + +unsigned int UI2 [2] = { 10, 11 }; +unsigned long UL2 [2] = { 4, 4 }; + +struct S S2 [2] = { 888, 8.88, 999, 9.99 }; +union U U2 [2] = { 7777 }; + + +/* Initialize pointer variables to (names of static and extern arrays) + 1 */ + +static int (*i1Ptr) = I1 + 1; +static char (*ch1Ptr) = Ch1 + 1; +static long (*L1Ptr) = L1 + 1; +static comp (*c1Ptr) = C1 + 1; +static float (*f1Ptr) = F1 + 1; +static double (*d1Ptr) = D1 + 1; +static extended (*e1Ptr) = E1 + 1; + +static unsigned int (*ui1Ptr) = UI1 + 1; +static unsigned long (*uL1Ptr) = UL1 + 1; + +static struct S (*struct1Ptr) = S1 + 1; +static union U (*union1Ptr ) = U1 + 1; + +int (*i2Ptr) = I2 + 1; +char (*ch2Ptr) = Ch2 + 1; +long (*L2Ptr) = L2 + 1; +comp (*c2Ptr) = C2 + 1; +float (*f2Ptr) = F2 + 1; +double (*d2Ptr) = D2 + 1; +extended (*e2Ptr) = E2 + 1; + +unsigned int (*ui2Ptr) = UI2 + 1; +unsigned long (*uL2Ptr) = UL2 + 1; + +struct S (*struct2Ptr) = S2 + 1; +union U (*union2Ptr ) = U2 + 1; + + +main () + { + int count = 0; + extern int ExternTest (void); + + count++; + if (*(i1Ptr) != 2) + goto Fail; + + count++; + if (*(ch1Ptr) != 'b') + goto Fail; + + count++; + if (*(L1Ptr) != 32889) + goto Fail; + +/* count++; + if (*(c1Ptr) != 65530) + goto Fail; */ + + count++; + if (fabs (*(f1Ptr) - 1.2) > 0.0001) + goto Fail; + + count++; + if (fabs (*(d1Ptr) - 2.3) > 0.0001) + goto Fail; + + count++; + if (fabs (*(e1Ptr) - 3.3) > 0.0001) + goto Fail; + + count++; + if (*(ui1Ptr) != 0x0011) + goto Fail; + + count++; + if (*(uL1Ptr) != 0x7fffffff) + goto Fail; + + count++; + if ((struct1Ptr->a != 10) || (fabs (struct1Ptr->b - 15.0) > 0.0001)) + goto Fail; + + count++; + if (union1Ptr->i != 0) + goto Fail; + + if ( ExternTest () ) + goto Fail2; + + printf ("Passed Special Conformance Test 4.6.3.6\n"); + return; + +Fail: + printf ("count = %d\n", count); +Fail2: + printf ("Failed Special Conformance Test 4.6.3.6\n"); + } diff --git a/Tests/Spec.Conform/SPC4301.1.CC b/Tests/Spec.Conform/SPC4301.1.CC old mode 100755 new mode 100644 index 54fd4ad..0f55b49 --- a/Tests/Spec.Conform/SPC4301.1.CC +++ b/Tests/Spec.Conform/SPC4301.1.CC @@ -1 +1,13 @@ -/* The first separately compiled file for Special Conformance Test 4.3.0.1 */ /* Function L0 and variables longNum and i are accessed by main. */ long longNum; int i; long L0 (int *j) { if (i != 4) return 0; else return (long) (*j); } \ No newline at end of file +/* The first separately compiled file for Special Conformance Test 4.3.0.1 */ +/* Function L0 and variables longNum and i are accessed by main. */ + +long longNum; +int i; + +long L0 (int *j) + { + if (i != 4) + return 0; + else + return (long) (*j); + } diff --git a/Tests/Spec.Conform/SPC4301.2.CC b/Tests/Spec.Conform/SPC4301.2.CC old mode 100755 new mode 100644 index bbe6952..89a35b7 --- a/Tests/Spec.Conform/SPC4301.2.CC +++ b/Tests/Spec.Conform/SPC4301.2.CC @@ -1 +1,9 @@ -/* The second separately compiled file for Special Conformance Test 4.3.0.1 */ /* Function ChangeChar and variable real are accessed by main. */ float real; void ChangeChar (char *ch) { *ch += 1; } \ No newline at end of file +/* The second separately compiled file for Special Conformance Test 4.3.0.1 */ +/* Function ChangeChar and variable real are accessed by main. */ + +float real; + +void ChangeChar (char *ch) + { + *ch += 1; + } diff --git a/Tests/Spec.Conform/SPC4301.EXEC b/Tests/Spec.Conform/SPC4301.EXEC old mode 100755 new mode 100644 index 0c28dd6..6705c5b --- a/Tests/Spec.Conform/SPC4301.EXEC +++ b/Tests/Spec.Conform/SPC4301.EXEC @@ -1 +1,36 @@ -* Exec file to run Special Conformance Test 4.3.0.1 * set exit on echo compile spc4.3.0.1.cc compile spc4.3.0.1.cc keep=3/out if {status} == 0 echo compile spc4301.1.cc compile spc4301.1.cc keep=3/out1 if {status} == 0 echo compile spc4301.2.cc compile spc4301.2.cc keep=3/out2 if {status} == 0 link +s 3/out 3/out1 3/out2 keep=3/out >3/spc4301.symt if {status} == 0 3/out else echo "Unable to link Special Conformance Test 4.3.0.1" end else echo "Unable to compile file spc4301.2.cc" end else echo "Unable to compile file spc4301.1.cc" end else echo "Unable to compile file spc4.3.0.1.cc" end \ No newline at end of file +* Exec file to run Special Conformance Test 4.3.0.1 * + +set exit on + +echo compile spc4.3.0.1.cc +compile spc4.3.0.1.cc keep=3/out + +if {status} == 0 + echo compile spc4301.1.cc + compile spc4301.1.cc keep=3/out1 + + if {status} == 0 + echo compile spc4301.2.cc + compile spc4301.2.cc keep=3/out2 + + if {status} == 0 + link +s 3/out 3/out1 3/out2 keep=3/out >3/spc4301.symt + + if {status} == 0 + 3/out + + else + echo "Unable to link Special Conformance Test 4.3.0.1" + end + + else + echo "Unable to compile file spc4301.2.cc" + end + + else + echo "Unable to compile file spc4301.1.cc" + end + +else + echo "Unable to compile file spc4.3.0.1.cc" +end diff --git a/Tests/Spec.Conform/SPC4301.H b/Tests/Spec.Conform/SPC4301.H old mode 100755 new mode 100644 index 2fdbad2..fdedca3 --- a/Tests/Spec.Conform/SPC4301.H +++ b/Tests/Spec.Conform/SPC4301.H @@ -1 +1,8 @@ -/* Header file for Special Conformance Test 4.3.0.1 */ static int F1 (float a, char ch); static char chArray [] = { "abcd" }; extern void ChangeChar (char *ch); extern float real; extern long longNum; \ No newline at end of file +/* Header file for Special Conformance Test 4.3.0.1 */ + +static int F1 (float a, char ch); +static char chArray [] = { "abcd" }; + +extern void ChangeChar (char *ch); +extern float real; +extern long longNum; diff --git a/Tests/Spec.Conform/SPC4311.1.CC b/Tests/Spec.Conform/SPC4311.1.CC old mode 100755 new mode 100644 index 98bb874..510eeb7 --- a/Tests/Spec.Conform/SPC4311.1.CC +++ b/Tests/Spec.Conform/SPC4311.1.CC @@ -1 +1,19 @@ -/* Separately compiled file containing functions called from main program in */ /* the file spc4.3.1.1.cc. */ #include int I1 (char ch) { if (islower (ch)) return toupper (ch); } /*****************************************************************************/ #include double D1 (float f) { return floor (f); } \ No newline at end of file +/* Separately compiled file containing functions called from main program in */ +/* the file spc4.3.1.1.cc. */ + +#include + +int I1 (char ch) + { + if (islower (ch)) + return toupper (ch); + } + +/*****************************************************************************/ + +#include + +double D1 (float f) + { + return floor (f); + } diff --git a/Tests/Spec.Conform/SPC4311.EXEC b/Tests/Spec.Conform/SPC4311.EXEC old mode 100755 new mode 100644 index 163766a..80e801b --- a/Tests/Spec.Conform/SPC4311.EXEC +++ b/Tests/Spec.Conform/SPC4311.EXEC @@ -1 +1,30 @@ -* Exec file to run Special Conformance Test 4.3.1.1 * unset exit set echo on compile spc4.3.1.1.cc keep=3/spc4311.mn set errNo {status} if {errNo} == 0 compile spc4311.1.cc keep=3/spc4311.1 set errNo {status} if {errNo} == 0 link 3/spc4311.mn 3/spc4311.1 keep=3/spc4311 set errNo {status} if {errNo} == 0 3/spc4311 else echo Unable to link Special Conformance Test 4.3.1.1 end else echo Unable to compile file spc4311.1.cc end else echo Unable to compile file spc4.3.1.1.cc end \ No newline at end of file +* Exec file to run Special Conformance Test 4.3.1.1 * + +unset exit +set echo on + +compile spc4.3.1.1.cc keep=3/spc4311.mn +set errNo {status} + +if {errNo} == 0 + compile spc4311.1.cc keep=3/spc4311.1 + + set errNo {status} + if {errNo} == 0 + link 3/spc4311.mn 3/spc4311.1 keep=3/spc4311 + + set errNo {status} + if {errNo} == 0 + 3/spc4311 + + else + echo Unable to link Special Conformance Test 4.3.1.1 + end + + else + echo Unable to compile file spc4311.1.cc + end + +else + echo Unable to compile file spc4.3.1.1.cc +end diff --git a/Tests/Spec.Conform/SPC4411.1.CC b/Tests/Spec.Conform/SPC4411.1.CC old mode 100755 new mode 100644 index 4764a15..ee1096e --- a/Tests/Spec.Conform/SPC4411.1.CC +++ b/Tests/Spec.Conform/SPC4411.1.CC @@ -1 +1,13 @@ -/* Other file needed to run Special Conformance Test 4.4.1.1 */ #include extern float y; double G1 (x) int x; { if ( (fabs (y - 8.7)) > 0.0001 ) return 0.0; else return (double) x; } \ No newline at end of file +/* Other file needed to run Special Conformance Test 4.4.1.1 */ + +#include +extern float y; + +double G1 (x) + int x; + { + if ( (fabs (y - 8.7)) > 0.0001 ) + return 0.0; + else + return (double) x; + } diff --git a/Tests/Spec.Conform/SPC4521.1.CC b/Tests/Spec.Conform/SPC4521.1.CC old mode 100755 new mode 100644 index c571c89..47c6f01 --- a/Tests/Spec.Conform/SPC4521.1.CC +++ b/Tests/Spec.Conform/SPC4521.1.CC @@ -1 +1,123 @@ -/* Separately compiled file needed to run Special Conformance Test 4.5.2.1 */ #include #include /* Global data */ int *intPtr, i; /* pointers to all the basic types */ long *longPtr, L; unsigned int *uintPtr, ui; unsigned long *ulongPtr, ulong; comp *compPtr, cmp; char *charPtr, ch; float *floatPtr, fl; double *doublePtr, dbl; extended *extPtr, ext; /* pointers to conglomerate types */ struct s { int a; long L; } *structPtr, s; enum colors { red, black, green } *colorPtr, color; union longOrShort { int first; long second; } *unionPtr, un; void F1 (void) { int count = 0; count += 1; intPtr = &i; i = 3; if (*intPtr != 3) goto Fail; count += 1; longPtr = &L; L = INT_MAX + 2L; if (*longPtr != 32769) goto Fail; count += 1; uintPtr = &ui; ui = UINT_MAX; if (*uintPtr != 65535u) goto Fail; count += 1; ulongPtr = &ulong; ulong = ULONG_MAX; if (*ulongPtr != 4294967295ul) goto Fail; count += 1; compPtr = &cmp; cmp = ulong + 4; if (*compPtr != ULONG_MAX + 4) goto Fail; count += 1; charPtr = &ch; ch = 'A'; if (*charPtr != 'A') goto Fail; count += 1; floatPtr = &fl; fl = 123.456; if ( (fabs (*floatPtr - 123.456)) > 0.0001 ) goto Fail; count += 1; doublePtr = &dbl; dbl = 0.0; if (fabs (*doublePtr - 0.0) > 0.00001) goto Fail; count += 1; extPtr = &ext; ext = 12.3e20; if ( (fabs (*extPtr - 123.0E19)) > 0.0001 ) goto Fail; count += 1; structPtr = &s; s.a = INT_MAX; s.L = LONG_MAX; if ((structPtr->L != 2147483647l) || (structPtr->a != 32767)) goto Fail; count += 1; intPtr = &(s.a); if (*intPtr != 32767) goto Fail; count += 1; longPtr = &(s.L); if (*longPtr != LONG_MAX) goto Fail; count += 1; colorPtr = &color; color = black; if (*colorPtr != black) goto Fail; count += 1; unionPtr = &un; un.first = 12; if (unionPtr->first != 12) goto Fail; count += 1; un.second = 2147483646; if (unionPtr->second != 2147483646) goto Fail; printf ("Passed Special Conformance Test 4.5.2.1\n"); return; Fail: printf ("Failed Special Conformance Test 4.5.2.1\n"); printf ("count = %d\n", count); } \ No newline at end of file +/* Separately compiled file needed to run Special Conformance Test 4.5.2.1 */ + +#include +#include + +/* Global data */ + +int *intPtr, i; /* pointers to all the basic types */ +long *longPtr, L; +unsigned int *uintPtr, ui; +unsigned long *ulongPtr, ulong; +comp *compPtr, cmp; +char *charPtr, ch; +float *floatPtr, fl; +double *doublePtr, dbl; +extended *extPtr, ext; + + /* pointers to conglomerate types */ +struct s { int a; + long L; } *structPtr, s; +enum colors { red, black, green } *colorPtr, color; +union longOrShort { int first; + long second; } *unionPtr, un; + +void F1 (void) + { + int count = 0; + + count += 1; + intPtr = &i; + i = 3; + if (*intPtr != 3) + goto Fail; + + count += 1; + longPtr = &L; + L = INT_MAX + 2L; + if (*longPtr != 32769) + goto Fail; + + count += 1; + uintPtr = &ui; + ui = UINT_MAX; + if (*uintPtr != 65535u) + goto Fail; + + count += 1; + ulongPtr = &ulong; + ulong = ULONG_MAX; + if (*ulongPtr != 4294967295ul) + goto Fail; + + count += 1; + compPtr = &cmp; + cmp = ulong + 4; + if (*compPtr != ULONG_MAX + 4) + goto Fail; + + count += 1; + charPtr = &ch; + ch = 'A'; + if (*charPtr != 'A') + goto Fail; + + count += 1; + floatPtr = &fl; + fl = 123.456; + if ( (fabs (*floatPtr - 123.456)) > 0.0001 ) + goto Fail; + + count += 1; + doublePtr = &dbl; + dbl = 0.0; + if (fabs (*doublePtr - 0.0) > 0.00001) + goto Fail; + + count += 1; + extPtr = &ext; + ext = 12.3e20; + if ( (fabs (*extPtr - 123.0E19)) > 0.0001 ) + goto Fail; + + count += 1; + structPtr = &s; + s.a = INT_MAX; + s.L = LONG_MAX; + if ((structPtr->L != 2147483647l) || (structPtr->a != 32767)) + goto Fail; + + count += 1; + intPtr = &(s.a); + if (*intPtr != 32767) + goto Fail; + + count += 1; + longPtr = &(s.L); + if (*longPtr != LONG_MAX) + goto Fail; + + count += 1; + colorPtr = &color; + color = black; + if (*colorPtr != black) + goto Fail; + + count += 1; + unionPtr = &un; + un.first = 12; + if (unionPtr->first != 12) + goto Fail; + + count += 1; + un.second = 2147483646; + if (unionPtr->second != 2147483646) + goto Fail; + + printf ("Passed Special Conformance Test 4.5.2.1\n"); + return; + +Fail: + printf ("Failed Special Conformance Test 4.5.2.1\n"); + printf ("count = %d\n", count); + } diff --git a/Tests/Spec.Conform/SPC4521.EXEC b/Tests/Spec.Conform/SPC4521.EXEC old mode 100755 new mode 100644 index 5fec407..5852de5 --- a/Tests/Spec.Conform/SPC4521.EXEC +++ b/Tests/Spec.Conform/SPC4521.EXEC @@ -1 +1,29 @@ -* Exec file to run Special Conformance Test 4.5.2.1 * unset exit echo compile spc4.5.2.1.cc compile spc4.5.2.1.cc keep=3/out if {status} == 0 echo compile spc4521.1.cc compile spc4521.1.cc keep=3/out1 if {status} == 0 echo link spc4.5.2.1.cc link 3/out 3/out1 keep=3/out if {status} == 0 3/out else echo Unable to link Special Conformance Test 4.5.2.1 end else echo Unable to compile file spc4521.1.cc end else echo Unable to compile file spc4.5.2.1.cc end \ No newline at end of file +* Exec file to run Special Conformance Test 4.5.2.1 * + +unset exit + +echo compile spc4.5.2.1.cc +compile spc4.5.2.1.cc keep=3/out + +if {status} == 0 + echo compile spc4521.1.cc + compile spc4521.1.cc keep=3/out1 + + if {status} == 0 + echo link spc4.5.2.1.cc + link 3/out 3/out1 keep=3/out + + if {status} == 0 + 3/out + + else + echo Unable to link Special Conformance Test 4.5.2.1 + end + + else + echo Unable to compile file spc4521.1.cc + end + +else + echo Unable to compile file spc4.5.2.1.cc +end diff --git a/Tests/Spec.Conform/SPC4521.H b/Tests/Spec.Conform/SPC4521.H old mode 100755 new mode 100644 index 3243a8d..f263dec --- a/Tests/Spec.Conform/SPC4521.H +++ b/Tests/Spec.Conform/SPC4521.H @@ -1 +1,20 @@ -/* Header file for Special Conformance Test 4.5.2.1 */ /* pointers to all the basic types */ extern int *intPtr, i; extern long *longPtr, L; extern unsigned int *uintPtr, ui; extern unsigned long *ulongPtr, ulong; extern comp *compPtr, cmp; extern char *charPtr, ch; extern float *floatPtr, fl; extern double *doublePtr, dbl; extern extended *extPtr, ext; /* pointers to conglomerate types */ extern struct s { int a; long L; } *structPtr, s; extern enum colors { red, black, green } *colorPtr, color; extern union longOrShort { int first; long second; } *unionPtr, un; \ No newline at end of file +/* Header file for Special Conformance Test 4.5.2.1 */ + + /* pointers to all the basic types */ +extern int *intPtr, i; +extern long *longPtr, L; +extern unsigned int *uintPtr, ui; +extern unsigned long *ulongPtr, ulong; +extern comp *compPtr, cmp; +extern char *charPtr, ch; +extern float *floatPtr, fl; +extern double *doublePtr, dbl; +extern extended *extPtr, ext; + + /* pointers to conglomerate types */ + +extern struct s { int a; + long L; } *structPtr, s; +extern enum colors { red, black, green } *colorPtr, color; +extern union longOrShort { int first; + long second; } *unionPtr, un; diff --git a/Tests/Spec.Conform/SPC4531.1.CC b/Tests/Spec.Conform/SPC4531.1.CC old mode 100755 new mode 100644 index 25cb985..6233bfc --- a/Tests/Spec.Conform/SPC4531.1.CC +++ b/Tests/Spec.Conform/SPC4531.1.CC @@ -1 +1,258 @@ -#include #include "spc4531.h" /****************************************************************************/ int TestArray ( void ) { int count = 0; int i, j, k, n; /* loop indices */ long L; /* l-values */ char ch; float f; double d; extended e; unsigned int ui; unsigned long ul; count += 1; for (i = 0; i < 50; i++) /* assign & check singly-dimensioned */ i1 [i] = i; /* integer array */ for (i = 49; i >= 0; i--) if (i1 [i] != i) goto Fail; count += 1; for (i = 0; i < 3; i++) /* assign & check multiply-dimensioned */ for (j = 0; j < 5; j++) /* integer array */ for (k = 0; k < 8; k++) i3 [i] [j] [k] = k; for (i = 2; i >= 0; i--) for (j = 4; j >= 0; j--) for (k = 7; k >= 0; k--) if (i3 [i] [j] [k] != k) goto Fail; count += 1; for (ch = 'a', i = 0; i < 6; i++) /* assign & check multiply-dimensioned */ for (j = 0; j < 5; j++) /* character arrays */ ch2 [i] [j] = ch++; for (ch = '~', n = 5; n >= 0; n--) for (k = 4; k >= 0; k--) if (ch2 [n] [k] != ch--) goto Fail; count += 1; for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ ch1 [i] = (char) (i + 0x41); /* character arrays */ for (ch = 'J', i = 9; i >= 0; i--) if (ch1 [i] != ch--) goto Fail; count += 1; for (i = 8; i >= 0; i--) /* assign & check singly-dimensioned */ L1 [i] = 2147483647; /* long integer array */ for (i = 0; i < 9; i++) if (L1 [i] != 2147483647) goto Fail; count += 1; for (L = 2147483646, i = 0; i < 2; i++) /* assign & check multiply- */ for (j = 0; j < 6; j++) /* dimensioned long integer*/ L2 [i] [j] = L--; /* array */ for (L = 2147483634, i = 1; i >= 0; i--) for (j = 5; j >= 0; j--) if (L2 [i] [j] != ++L) goto Fail; count += 1; for (ui = 65534, i = 0; i < 7; i++) /* assign & check singly-dimensioned */ ui1 [i] = ui--; /* unsigned integer array */ for (ui = 65527, i = 6; i >= 0; i--) if (ui1 [i] != ++ui) goto Fail; count += 1; for (ui = 65534, i = 0; i < 4; i++) /* assign & check multiply-dimensioned */ for (j = 0; j < 5; j++) /* unsigned integer array */ for (k = 0; k < 1; k++) ui3 [i] [j] [k] = ui--; for (ui = 65514, i = 3, k = 0; i >= 0; i--) for (j = 4; j >= 0; j--) if (ui3 [i] [j] [k] != ++ui) goto Fail; count += 1; for (ul = 4294967279ul, i = 0; i < 5; i++) /* assign & check multiply- */ for (j = 0; j < 3; j++) /* dimensioned unsigned */ ul2 [i] [j] = ul++; /* long integer array */ for (ul = 4294967294ul, i = 4; i >= 0; i--) for (j = 2; j >= 0; j--) if (ul2 [i] [j] != --ul) goto Fail; count += 1; ul1 [0] = ul; /* assign & check singly-dimensioned */ if (ul1 [0] != 4294967279ul) /* unsigned long integer array */ goto Fail; count += 1; for (i = 0; i < 3; i++) /* assign & check singly-dimensioned */ c1 [i] = i; /* comp array */ for (j = 2; j >= 0; j--) if (c1 [j] != j) goto Fail; count += 1; for (i = 0; i < 2; i++) /* assign & check multiply-dimensioned */ for (j = 0; j < 3; j++) /* comp array */ c2 [i] [j] = 0; for (k = 1; k >= 0; k--) for (i = 2; i >= 0; i--) if (c2 [i] [j] != 0) goto Fail; count += 1; f1 [0] = f1 [1] = f1 [2] = 43.8; /* assign & check singly-dimensioned */ for (k = 0; k < 3; k++) /* float array */ if ( (fabs (f1 [k] - 43.8)) > 0.0001 ) goto Fail; for (f = 1.0, i = 0; i < 2; i++) /* assign & check multiply-dimensioned */ for (j = 0; j < 3; j++) /* float array */ for (k = 0; k < 1; k++) for (n = 0; n < 4; n++) f4 [i] [j] [k] [n] = f++; count += 1; for (f = 24.0, k = 0, i = 1; i >= 0; i--) for (j = 2; j >= 0; j--) for (n = 3; n >= 0; n--) if (f4 [i] [j] [k] [n] != f--) goto Fail; count += 1; for (i = 0; i < 2; i++) /* assign & check multiply-dimensioned */ for (j = 0; j < 4; j++) /* double array */ d2 [i] [j] = 0.00; for (d = 0, k = 1; k >= 0; k--) for (i = 3; i >= 0; i--) if (d2 [k] [i] != d) goto Fail; count += 1; for (d1 [0] = 5.6, i = 1; i < 8; i++) /* assign & check singly- */ d1 [i] = d1 [i-1] + 1.0; /* dimensioned double array */ for (d = 12.6, k = 7; k >= 0; k--) if ( (fabs (d1 [k] - d--)) > 0.0001 ) goto Fail; count += 1; for (e = 96e-75, i = 0; i < 7; i++) /* assign & check multiply-dimensioned */ for (j = 0; j < 3; j++) /* extended array */ e2 [i] [j] = e; for (i = 0; i < 7; i++) for (j = 0; j < 3; j++) if ( (fabs (e2 [i] [j] - 96.0e-75)) > 0.0001 ) goto Fail; count += 1; for (k = 8; k >= 0; k--) /* assign & check singly-dimensioned */ e1 [k] = 0; /* extended array */ for (e = 0.000, i = 0; i < 9; i++) if (e1 [i] != e) goto Fail; count += 1; for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ { /* array of structures */ s1 [i].a = i; s1 [i].f = (float) i * 2.0; } for (f = 18.0, i = 9; i >= 0; i--) { if ((s1 [i].a != i) || (fabs (s1 [i].f - f) > 0.0001) ) goto Fail; f -= 2.0; } for (n = 32766, f = 29.8E10, i = 0; i < 5; i++) /* assign & check multipy- */ for (j = 0; j < 4; j++) /* dimensioned array of */ { /* structures */ s2 [i] [j].a = n--; s2 [i] [j].f = f; } count += 1; for (n = 32746, k = 4; k >= 0; k--) for (j = 3; j >= 0; j--) if ((s2 [k] [j].a != ++n) || (fabs (s2 [k] [j].f - f) > 0.0001) ) goto Fail; count += 1; for (i = 1, j = 0, k = 0; k < 3; k++) /* assign & check multiply- */ C3 [i] [j] [k] = red; /* dimensioned array of */ for (i = 0, k = 0; k < 3; k++) /* enumerations */ C3 [i] [j] [k] = green; for (k = 0; k < 3; k++) if (C3 [0] [0] [k] != green) goto Fail; for (k = 0; k < 3; k++) if (C3 [1] [0] [k] != red) goto Fail; count += 1; for (n = 5; n >= 0; n--) /* assign & check singly- */ C1 [n] = black; /* dimensioned array of */ for (k = 0; k < 6; k++) /* enumerations */ if (C1 [k] != 1) goto Fail; count += 1; for (i = 0; i < 3; i++) /* assign & check multiply- */ for (j = 0; j < 3; j++) /* dimensioned array of */ u2 [i] [j].first = j; /* unions */ for (n = 2; n >= 0; n--) if (u2 [n] [0].first != 0) goto Fail; count += 1; for (n = 2; n >= 0; n--) if (u2 [n] [1].first != 1) goto Fail; count += 1; for (n = 2; n >= 0; n--) if (u2 [n] [2].first != 2) goto Fail; count += 1; for (L = 2147483646, i = 0; i < 3; i++) for (j = 0; j < 3; j++) u2 [i] [j].second = L--; for (L = 2147483637, k = 2; k >= 0; k--) for (n = 2; n >= 0; n--) if (u2 [k] [n].second != ++L) goto Fail; count += 1; for (i = 0; i < 12; i++) /* assign & check singly-dimensioned */ u1 [i].first = i; /* array of unions */ for (k = 11; k >= 0; k--) if (u1 [k].first != k) goto Fail; count += 1; for (L = 32767, j = 0; j < 12; j++) u1 [j].second = L++; for (L = 32778, n = 11; n >= 0; n--) if (u1 [n].second != L--) goto Fail; return (1); Fail: printf ("count = %d\n", count); return (0); } \ No newline at end of file +#include +#include "spc4531.h" + +/****************************************************************************/ + +int TestArray ( void ) + { + int count = 0; + + int i, j, k, n; /* loop indices */ + long L; /* l-values */ + char ch; + float f; + double d; + extended e; + unsigned int ui; + unsigned long ul; + + count += 1; + for (i = 0; i < 50; i++) /* assign & check singly-dimensioned */ + i1 [i] = i; /* integer array */ + for (i = 49; i >= 0; i--) + if (i1 [i] != i) + goto Fail; + + count += 1; + for (i = 0; i < 3; i++) /* assign & check multiply-dimensioned */ + for (j = 0; j < 5; j++) /* integer array */ + for (k = 0; k < 8; k++) + i3 [i] [j] [k] = k; + for (i = 2; i >= 0; i--) + for (j = 4; j >= 0; j--) + for (k = 7; k >= 0; k--) + if (i3 [i] [j] [k] != k) + goto Fail; + + count += 1; + for (ch = 'a', i = 0; i < 6; i++) /* assign & check multiply-dimensioned */ + for (j = 0; j < 5; j++) /* character arrays */ + ch2 [i] [j] = ch++; + for (ch = '~', n = 5; n >= 0; n--) + for (k = 4; k >= 0; k--) + if (ch2 [n] [k] != ch--) + goto Fail; + + count += 1; + for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ + ch1 [i] = (char) (i + 0x41); /* character arrays */ + for (ch = 'J', i = 9; i >= 0; i--) + if (ch1 [i] != ch--) + goto Fail; + + count += 1; + for (i = 8; i >= 0; i--) /* assign & check singly-dimensioned */ + L1 [i] = 2147483647; /* long integer array */ + for (i = 0; i < 9; i++) + if (L1 [i] != 2147483647) + goto Fail; + + count += 1; + for (L = 2147483646, i = 0; i < 2; i++) /* assign & check multiply- */ + for (j = 0; j < 6; j++) /* dimensioned long integer*/ + L2 [i] [j] = L--; /* array */ + for (L = 2147483634, i = 1; i >= 0; i--) + for (j = 5; j >= 0; j--) + if (L2 [i] [j] != ++L) + goto Fail; + + count += 1; + for (ui = 65534, i = 0; i < 7; i++) /* assign & check singly-dimensioned */ + ui1 [i] = ui--; /* unsigned integer array */ + for (ui = 65527, i = 6; i >= 0; i--) + if (ui1 [i] != ++ui) + goto Fail; + + count += 1; + for (ui = 65534, i = 0; i < 4; i++) /* assign & check multiply-dimensioned */ + for (j = 0; j < 5; j++) /* unsigned integer array */ + for (k = 0; k < 1; k++) + ui3 [i] [j] [k] = ui--; + for (ui = 65514, i = 3, k = 0; i >= 0; i--) + for (j = 4; j >= 0; j--) + if (ui3 [i] [j] [k] != ++ui) + goto Fail; + + count += 1; + for (ul = 4294967279ul, i = 0; i < 5; i++) /* assign & check multiply- */ + for (j = 0; j < 3; j++) /* dimensioned unsigned */ + ul2 [i] [j] = ul++; /* long integer array */ + for (ul = 4294967294ul, i = 4; i >= 0; i--) + for (j = 2; j >= 0; j--) + if (ul2 [i] [j] != --ul) + goto Fail; + + count += 1; + ul1 [0] = ul; /* assign & check singly-dimensioned */ + if (ul1 [0] != 4294967279ul) /* unsigned long integer array */ + goto Fail; + + count += 1; + for (i = 0; i < 3; i++) /* assign & check singly-dimensioned */ + c1 [i] = i; /* comp array */ + for (j = 2; j >= 0; j--) + if (c1 [j] != j) + goto Fail; + + count += 1; + for (i = 0; i < 2; i++) /* assign & check multiply-dimensioned */ + for (j = 0; j < 3; j++) /* comp array */ + c2 [i] [j] = 0; + for (k = 1; k >= 0; k--) + for (i = 2; i >= 0; i--) + if (c2 [i] [j] != 0) + goto Fail; + + count += 1; + f1 [0] = f1 [1] = f1 [2] = 43.8; /* assign & check singly-dimensioned */ + for (k = 0; k < 3; k++) /* float array */ + if ( (fabs (f1 [k] - 43.8)) > 0.0001 ) + goto Fail; + + for (f = 1.0, i = 0; i < 2; i++) /* assign & check multiply-dimensioned */ + for (j = 0; j < 3; j++) /* float array */ + for (k = 0; k < 1; k++) + for (n = 0; n < 4; n++) + f4 [i] [j] [k] [n] = f++; + + count += 1; + for (f = 24.0, k = 0, i = 1; i >= 0; i--) + for (j = 2; j >= 0; j--) + for (n = 3; n >= 0; n--) + if (f4 [i] [j] [k] [n] != f--) + goto Fail; + + count += 1; + for (i = 0; i < 2; i++) /* assign & check multiply-dimensioned */ + for (j = 0; j < 4; j++) /* double array */ + d2 [i] [j] = 0.00; + for (d = 0, k = 1; k >= 0; k--) + for (i = 3; i >= 0; i--) + if (d2 [k] [i] != d) + goto Fail; + + count += 1; + for (d1 [0] = 5.6, i = 1; i < 8; i++) /* assign & check singly- */ + d1 [i] = d1 [i-1] + 1.0; /* dimensioned double array */ + for (d = 12.6, k = 7; k >= 0; k--) + if ( (fabs (d1 [k] - d--)) > 0.0001 ) + goto Fail; + + count += 1; + for (e = 96e-75, i = 0; i < 7; i++) /* assign & check multiply-dimensioned */ + for (j = 0; j < 3; j++) /* extended array */ + e2 [i] [j] = e; + for (i = 0; i < 7; i++) + for (j = 0; j < 3; j++) + if ( (fabs (e2 [i] [j] - 96.0e-75)) > 0.0001 ) + goto Fail; + + count += 1; + for (k = 8; k >= 0; k--) /* assign & check singly-dimensioned */ + e1 [k] = 0; /* extended array */ + for (e = 0.000, i = 0; i < 9; i++) + if (e1 [i] != e) + goto Fail; + + count += 1; + for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ + { /* array of structures */ + s1 [i].a = i; + s1 [i].f = (float) i * 2.0; + } + for (f = 18.0, i = 9; i >= 0; i--) + { + if ((s1 [i].a != i) || (fabs (s1 [i].f - f) > 0.0001) ) + goto Fail; + f -= 2.0; + } + + for (n = 32766, f = 29.8E10, i = 0; i < 5; i++) /* assign & check multipy- */ + for (j = 0; j < 4; j++) /* dimensioned array of */ + { /* structures */ + s2 [i] [j].a = n--; + s2 [i] [j].f = f; + } + + count += 1; + for (n = 32746, k = 4; k >= 0; k--) + for (j = 3; j >= 0; j--) + if ((s2 [k] [j].a != ++n) || (fabs (s2 [k] [j].f - f) > 0.0001) ) + goto Fail; + + count += 1; + for (i = 1, j = 0, k = 0; k < 3; k++) /* assign & check multiply- */ + C3 [i] [j] [k] = red; /* dimensioned array of */ + for (i = 0, k = 0; k < 3; k++) /* enumerations */ + C3 [i] [j] [k] = green; + for (k = 0; k < 3; k++) + if (C3 [0] [0] [k] != green) + goto Fail; + for (k = 0; k < 3; k++) + if (C3 [1] [0] [k] != red) + goto Fail; + + count += 1; + for (n = 5; n >= 0; n--) /* assign & check singly- */ + C1 [n] = black; /* dimensioned array of */ + for (k = 0; k < 6; k++) /* enumerations */ + if (C1 [k] != 1) + goto Fail; + + count += 1; + for (i = 0; i < 3; i++) /* assign & check multiply- */ + for (j = 0; j < 3; j++) /* dimensioned array of */ + u2 [i] [j].first = j; /* unions */ + for (n = 2; n >= 0; n--) + if (u2 [n] [0].first != 0) + goto Fail; + + count += 1; + for (n = 2; n >= 0; n--) + if (u2 [n] [1].first != 1) + goto Fail; + + count += 1; + for (n = 2; n >= 0; n--) + if (u2 [n] [2].first != 2) + goto Fail; + + count += 1; + for (L = 2147483646, i = 0; i < 3; i++) + for (j = 0; j < 3; j++) + u2 [i] [j].second = L--; + for (L = 2147483637, k = 2; k >= 0; k--) + for (n = 2; n >= 0; n--) + if (u2 [k] [n].second != ++L) + goto Fail; + + count += 1; + for (i = 0; i < 12; i++) /* assign & check singly-dimensioned */ + u1 [i].first = i; /* array of unions */ + for (k = 11; k >= 0; k--) + if (u1 [k].first != k) + goto Fail; + + count += 1; + for (L = 32767, j = 0; j < 12; j++) + u1 [j].second = L++; + for (L = 32778, n = 11; n >= 0; n--) + if (u1 [n].second != L--) + goto Fail; + + return (1); + +Fail: + printf ("count = %d\n", count); + return (0); + } diff --git a/Tests/Spec.Conform/SPC4531.EXEC b/Tests/Spec.Conform/SPC4531.EXEC old mode 100755 new mode 100644 index 4950602..c17c07c --- a/Tests/Spec.Conform/SPC4531.EXEC +++ b/Tests/Spec.Conform/SPC4531.EXEC @@ -1 +1,29 @@ -* Exec file to run Special Conformance Test 4.5.3.1 * unset exit compile spc4.5.3.1.cc keep=3/spc4531 set errNo {status} if {errNo} == 0 compile spc4531.1.cc keep=3/spc4531.1 set errNo {status} if {errNo} == 0 link 3/spc4531 3/spc4531.1 keep=3/spc4531 set errNo {status} if {errNo} == 0 3/spc4531 else echo Unable to link Special Conformance Test 4.5.3.1 end else echo Unable to compile file spc4531.1.cc end else echo Unable to compile file spc4.5.3.1.cc end \ No newline at end of file +* Exec file to run Special Conformance Test 4.5.3.1 * + +unset exit + +compile spc4.5.3.1.cc keep=3/spc4531 +set errNo {status} + +if {errNo} == 0 + compile spc4531.1.cc keep=3/spc4531.1 + + set errNo {status} + if {errNo} == 0 + link 3/spc4531 3/spc4531.1 keep=3/spc4531 + + set errNo {status} + if {errNo} == 0 + 3/spc4531 + + else + echo Unable to link Special Conformance Test 4.5.3.1 + end + + else + echo Unable to compile file spc4531.1.cc + end + +else + echo Unable to compile file spc4.5.3.1.cc +end diff --git a/Tests/Spec.Conform/SPC4531.H b/Tests/Spec.Conform/SPC4531.H old mode 100755 new mode 100644 index 83c299a..c0a723f --- a/Tests/Spec.Conform/SPC4531.H +++ b/Tests/Spec.Conform/SPC4531.H @@ -1 +1,25 @@ -/* External array declarations needed to run Special Conformance Test 4.5.3.1 */ extern int i1 [50], i3 [3] [5] [8]; /* all basic types */ extern long L1 [9], L2 [2] [6]; extern unsigned int ui3 [4] [5] [1], ui1 [7]; extern unsigned long ul2 [5] [3], ul1 [1]; extern comp c1 [3], c2 [2] [3]; extern char ch2 [6] [5], ch1 [10]; extern float f1 [3], f4 [2] [3] [1] [4]; extern double d2 [2] [4], d1 [8]; extern extended e1 [9], e2 [7] [3]; /* conglomerate types */ struct s { int a; float f; }; extern struct s s1 [10], s2 [5] [4]; enum colors { red, black, green }; extern enum colors C3 [2] [1] [3], C1 [6]; union longOrShort { int first; long second; }; extern union longOrShort u2 [3] [3], u1 [12]; \ No newline at end of file +/* External array declarations needed to run Special Conformance Test 4.5.3.1 */ + +extern int i1 [50], i3 [3] [5] [8]; /* all basic types */ +extern long L1 [9], L2 [2] [6]; + +extern unsigned int ui3 [4] [5] [1], ui1 [7]; +extern unsigned long ul2 [5] [3], ul1 [1]; + +extern comp c1 [3], c2 [2] [3]; +extern char ch2 [6] [5], ch1 [10]; +extern float f1 [3], f4 [2] [3] [1] [4]; +extern double d2 [2] [4], d1 [8]; +extern extended e1 [9], e2 [7] [3]; + + /* conglomerate types */ +struct s { int a; + float f; }; +extern struct s s1 [10], s2 [5] [4]; + +enum colors { red, black, green }; +extern enum colors C3 [2] [1] [3], C1 [6]; + +union longOrShort { int first; + long second; }; +extern union longOrShort u2 [3] [3], u1 [12]; diff --git a/Tests/Spec.Conform/SPC4532.1.CC b/Tests/Spec.Conform/SPC4532.1.CC old mode 100755 new mode 100644 index b6554c5..47541c6 --- a/Tests/Spec.Conform/SPC4532.1.CC +++ b/Tests/Spec.Conform/SPC4532.1.CC @@ -1 +1,126 @@ -/* Separately compiled file named spc4532.1.cc, needed to perform Special */ /* Conformance Test 4.5.3.2 */ #include "spc4532.h" int TestEm (void) { int count = 0; int i, j, k, n; /* loop indices */ char ch; long L; /* l-values */ float f; double d; extended e; unsigned int ui; unsigned long ul; comp ci; count += 1; for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ ch1 [i] = &ch; /* array of pointers to character */ ch = 'z'; for (i = 9; i >= 0; i--) if (*(ch1 [i]) != 'z') goto Fail; count += 1; for (i = 0; i < 50; i++) /* assign & check singly-dimensioned */ i1 [i] = &n; /* array of pointers to int */ n = 32767; for (i = 49; i >= 0; i--) if (*(i1 [i]) != 32767) goto Fail; count += 1; for (i = 8; i >= 0; i--) /* assign & check singly-dimensioned */ L1 [i] = &L; /* array of pointers to long int */ L = 2147483647; for (i = 0; i < 9; i++) if (*(L1 [i]) != 2147483647) goto Fail; count += 1; for (i = 0; i < 7; i++) /* assign & check singly-dimensioned */ ui1 [i] = &ui; /* array of ptrs to unsigned int */ ui = 65535; for (i = 6; i >= 0; i--) if (*(ui1 [i]) != 65535) goto Fail; count += 1; ul1 [0] = &ul; /* assign & check singly-dimensioned */ ul = 4294967278ul; /* array of ptrs to long unsigned int*/ if (*(ul1 [0]) != 0xffffffff) goto Fail; count += 1; for (i = 0; i < 3; i++) /* assign & check singly-dimensioned */ c1 [i] = &ci; /* array of pointers to comp */ ci = 2147483647; for (j = 2; j >= 0; j--) if (*(c1 [j]) != 2147483647) goto Fail; count += 1; f1 [0] = f1 [1] = f1 [2] = &f; /* assign & check singly-dimensioned */ f = 32.8; /* array of pointers to float */ for (k = 0; k < 3; k++) if (*(f1 [k]) != 32.8) goto Fail; count += 1; for (i = 1; i < 8; i++) /* assign & check singly- */ d1 [i] = &d; /* dimensioned array of */ d = 123.0e50; /* pointers to double */ for (k = 7; k >= 0; k--) if (*(d1 [k]) != 0.123E53) goto Fail; count += 1; for (k = 8; k >= 0; k--) /* assign & check singly-dimensioned */ e1 [k] = &e; /* array of pointers to extended */ e = 0.0e-300; for (i = 0; i < 9; i++) if (*(e1 [i]) != 0) goto Fail; count += 1; for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ s1 [i] = &S; /* array of pointers to structures */ S.a = 7; S.f = 6.4; for (i = 9; i >= 0; i--) if ((s1 [i]->a != 7) || (s1 [i]->f != 6.4)) goto Fail; count += 1; for (n = 5; n >= 0; n--) /* assign & check singly-dimensioned */ en [n] = &C; /* array of pointers to enumerations*/ C = black; for (k = 0; k < 6; k++) if (*(en [k]) != 1) goto Fail; count += 1; for (i = 0; i < 12; i++) /* assign & check singly-dimensioned */ u1 [i] = &U; /* array of pointers to union */ U.first = -45; for (k = 11; k >= 0; k--) if (u1 [k]->first != -45) goto Fail; count += 1; U.second = 32770; for (n = 11; n >= 0; n--) if (u1 [n]->second != 32770) goto Fail; return 1; Fail: printf ("count = %d\n", count); return 0; } \ No newline at end of file +/* Separately compiled file named spc4532.1.cc, needed to perform Special */ +/* Conformance Test 4.5.3.2 */ + +#include "spc4532.h" + +int TestEm (void) + { + int count = 0; + + int i, j, k, n; /* loop indices */ + char ch; + long L; /* l-values */ + float f; + double d; + extended e; + unsigned int ui; + unsigned long ul; + comp ci; + + + count += 1; + for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ + ch1 [i] = &ch; /* array of pointers to character */ + ch = 'z'; + for (i = 9; i >= 0; i--) + if (*(ch1 [i]) != 'z') + goto Fail; + + count += 1; + for (i = 0; i < 50; i++) /* assign & check singly-dimensioned */ + i1 [i] = &n; /* array of pointers to int */ + n = 32767; + for (i = 49; i >= 0; i--) + if (*(i1 [i]) != 32767) + goto Fail; + + count += 1; + for (i = 8; i >= 0; i--) /* assign & check singly-dimensioned */ + L1 [i] = &L; /* array of pointers to long int */ + L = 2147483647; + for (i = 0; i < 9; i++) + if (*(L1 [i]) != 2147483647) + goto Fail; + + count += 1; + for (i = 0; i < 7; i++) /* assign & check singly-dimensioned */ + ui1 [i] = &ui; /* array of ptrs to unsigned int */ + ui = 65535; + for (i = 6; i >= 0; i--) + if (*(ui1 [i]) != 65535) + goto Fail; + + count += 1; + ul1 [0] = &ul; /* assign & check singly-dimensioned */ + ul = 4294967278ul; /* array of ptrs to long unsigned int*/ + if (*(ul1 [0]) != 0xffffffff) + goto Fail; + + count += 1; + for (i = 0; i < 3; i++) /* assign & check singly-dimensioned */ + c1 [i] = &ci; /* array of pointers to comp */ + ci = 2147483647; + for (j = 2; j >= 0; j--) + if (*(c1 [j]) != 2147483647) + goto Fail; + + count += 1; + f1 [0] = f1 [1] = f1 [2] = &f; /* assign & check singly-dimensioned */ + f = 32.8; /* array of pointers to float */ + for (k = 0; k < 3; k++) + if (*(f1 [k]) != 32.8) + goto Fail; + + count += 1; + for (i = 1; i < 8; i++) /* assign & check singly- */ + d1 [i] = &d; /* dimensioned array of */ + d = 123.0e50; /* pointers to double */ + for (k = 7; k >= 0; k--) + if (*(d1 [k]) != 0.123E53) + goto Fail; + + count += 1; + for (k = 8; k >= 0; k--) /* assign & check singly-dimensioned */ + e1 [k] = &e; /* array of pointers to extended */ + e = 0.0e-300; + for (i = 0; i < 9; i++) + if (*(e1 [i]) != 0) + goto Fail; + + count += 1; + for (i = 0; i < 10; i++) /* assign & check singly-dimensioned */ + s1 [i] = &S; /* array of pointers to structures */ + S.a = 7; + S.f = 6.4; + for (i = 9; i >= 0; i--) + if ((s1 [i]->a != 7) || (s1 [i]->f != 6.4)) + goto Fail; + + count += 1; + for (n = 5; n >= 0; n--) /* assign & check singly-dimensioned */ + en [n] = &C; /* array of pointers to enumerations*/ + C = black; + for (k = 0; k < 6; k++) + if (*(en [k]) != 1) + goto Fail; + + count += 1; + for (i = 0; i < 12; i++) /* assign & check singly-dimensioned */ + u1 [i] = &U; /* array of pointers to union */ + U.first = -45; + for (k = 11; k >= 0; k--) + if (u1 [k]->first != -45) + goto Fail; + + count += 1; + U.second = 32770; + for (n = 11; n >= 0; n--) + if (u1 [n]->second != 32770) + goto Fail; + + return 1; + +Fail: + printf ("count = %d\n", count); + return 0; + } diff --git a/Tests/Spec.Conform/SPC4532.EXEC b/Tests/Spec.Conform/SPC4532.EXEC old mode 100755 new mode 100644 index 8fd40f6..ce7ca88 --- a/Tests/Spec.Conform/SPC4532.EXEC +++ b/Tests/Spec.Conform/SPC4532.EXEC @@ -1 +1,29 @@ -* Exec file to run Special Conformance Test 4.5.3.2 * unset exit compile spc4.5.3.2.cc keep=3/spc4532 set errNo {status} if {errNo} == 0 compile spc4532.1.cc keep=3/spc4532.1 set errNo {status} if {errNo} == 0 link 3/spc4532 3/spc4532.1 keep=3/spc4532 set errNo {status} if {errNo} == 0 3/spc4532 else echo Unable to link Special Conformance Test 4.5.3.2 end else echo Unable to compile file spc4532.1.cc end else echo Unable to compile file spc4.5.3.2.cc end \ No newline at end of file +* Exec file to run Special Conformance Test 4.5.3.2 * + +unset exit + +compile spc4.5.3.2.cc keep=3/spc4532 +set errNo {status} + +if {errNo} == 0 + compile spc4532.1.cc keep=3/spc4532.1 + + set errNo {status} + if {errNo} == 0 + link 3/spc4532 3/spc4532.1 keep=3/spc4532 + + set errNo {status} + if {errNo} == 0 + 3/spc4532 + + else + echo Unable to link Special Conformance Test 4.5.3.2 + end + + else + echo Unable to compile file spc4532.1.cc + end + +else + echo Unable to compile file spc4.5.3.2.cc +end diff --git a/Tests/Spec.Conform/SPC4532.H b/Tests/Spec.Conform/SPC4532.H old mode 100755 new mode 100644 index 30242c2..38e6304 --- a/Tests/Spec.Conform/SPC4532.H +++ b/Tests/Spec.Conform/SPC4532.H @@ -1 +1,24 @@ -/* Header file for Special Conformance Test 4.5.3.2 */ extern int *i1 [50]; /* all basic types */ extern long *L1 [9]; extern comp *c1 [3]; extern char *ch1 [10]; extern float *f1 [3]; extern double *d1 [8]; extern extended *e1 [9]; extern unsigned int *ui3 [4] [5] [1], *ui1 [7]; extern unsigned long *ul2 [5] [3], *ul1 [1]; /* conglomerate types */ struct s { int a; float f; }; extern struct s *s1 [10], S; enum colors { red, black, green }; extern enum colors *en [6], C; union longOrShort { int first; long second; }; extern union longOrShort *u1 [12], U; \ No newline at end of file +/* Header file for Special Conformance Test 4.5.3.2 */ + +extern int *i1 [50]; /* all basic types */ +extern long *L1 [9]; +extern comp *c1 [3]; +extern char *ch1 [10]; +extern float *f1 [3]; +extern double *d1 [8]; +extern extended *e1 [9]; + +extern unsigned int *ui3 [4] [5] [1], *ui1 [7]; +extern unsigned long *ul2 [5] [3], *ul1 [1]; + + /* conglomerate types */ +struct s { int a; + float f; }; +extern struct s *s1 [10], S; + +enum colors { red, black, green }; +extern enum colors *en [6], C; + +union longOrShort { int first; + long second; }; +extern union longOrShort *u1 [12], U; diff --git a/Tests/Spec.Conform/SPC4631.1.CC b/Tests/Spec.Conform/SPC4631.1.CC old mode 100755 new mode 100644 index 648ffa3..adb08cd --- a/Tests/Spec.Conform/SPC4631.1.CC +++ b/Tests/Spec.Conform/SPC4631.1.CC @@ -1 +1,196 @@ -/* Second file containing functions and variables accessed by main to run */ /* test Special Conformance 4.6.3.1 */ #include struct S { int a; float b; }; union U { int i; long L; }; extern int (*i2Ptr) (void); /* declare external variables */ extern char (*ch2Ptr) (void); extern long (*L2Ptr) (void); extern comp (*c2Ptr) (void); extern float (*f2Ptr) (void); extern double (*d2Ptr) (void); extern extended (*e2Ptr) (void); extern unsigned int (*ui2Ptr) (void); extern unsigned long (*uL2Ptr) (void); extern struct S (*struct2Ptr) (void), extStruct1, extStruct2; extern union U (*union2Ptr) (void), extUnion1, extUnion2; extern int DispI (int (*func) (void)); /* declare external functions */ extern char DispCh (char (*func) (void)); extern long DispL (long (*func) (void)); extern comp DispC (comp (*func) (void)); extern float DispF (float (*func) (void)); extern double DispD (double (*func) (void)); extern extended DispE (extended (*func) (void)); extern unsigned int DispUI (unsigned int (*func) (void)); extern unsigned long DispUL (unsigned long (*func) (void)); extern struct S DispS (struct S (*func) (void)); extern union U DispU (union U (*func) (void)); /***************************************************************************/ int ExternTest (void) { int count = 0; int i; char ch; long LL; comp c; float f; double d; extended e; unsigned int unInt; unsigned long unLong; struct S svar; union U uvar; count++; i = DispI (i2Ptr); if (i != 2) goto Fail; count++; ch = DispCh (ch2Ptr); if (ch != 'b') goto Fail; count++; LL = DispL (L2Ptr); if (LL != 9) goto Fail; count++; c = DispC (c2Ptr); if (c != 56) goto Fail; count++; f = DispF (f2Ptr); if (fabs (f - 97.9) > 0.0001) goto Fail; count++; d = DispD (d2Ptr); if (fabs (d - 25.5e-7) > 0.0001) goto Fail; count++; e = DispE (e2Ptr); if (fabs (e - 0.4) > 0.0001) goto Fail; count++; unInt = DispUI (ui2Ptr); if (unInt != 0x7E) goto Fail; count++; unLong = DispUL (uL2Ptr); if (unLong != 0xFEDCBA98) goto Fail; count++; svar = DispS (struct2Ptr); if ((svar.a != 18) || (fabs (svar.b - 0.3) > 0.0001)) goto Fail; count++; uvar = DispU (union2Ptr); if (uvar.i != 29) goto Fail; return 0; Fail: printf ("Failed ExternTest: count = %d\n", count); return 1; } /***************************************************************************/ int I2 (void) { return 2; } /***************************************************************************/ char Ch2 (void) { return 'b'; } /***************************************************************************/ long L2 (void) { return 9; } /***************************************************************************/ comp C2 (void) { return 8 * 7; } /***************************************************************************/ float F2 (void) { return 97.9; } /***************************************************************************/ double D2 (void) { return 25.5e-7; } /***************************************************************************/ extended E2 (void) { return 0.4; } /***************************************************************************/ unsigned int UI2 (void) { return 0x7e; } /***************************************************************************/ unsigned long UL2 (void) { return 0xfedcba98; } /***************************************************************************/ struct S S2 (void) { return extStruct2; } /***************************************************************************/ union U U2 (void) { return extUnion2; } \ No newline at end of file +/* Second file containing functions and variables accessed by main to run */ +/* test Special Conformance 4.6.3.1 */ + +#include + +struct S { int a; + float b; }; +union U { int i; + long L; }; + +extern int (*i2Ptr) (void); /* declare external variables */ +extern char (*ch2Ptr) (void); +extern long (*L2Ptr) (void); +extern comp (*c2Ptr) (void); +extern float (*f2Ptr) (void); +extern double (*d2Ptr) (void); +extern extended (*e2Ptr) (void); + +extern unsigned int (*ui2Ptr) (void); +extern unsigned long (*uL2Ptr) (void); + +extern struct S (*struct2Ptr) (void), extStruct1, extStruct2; +extern union U (*union2Ptr) (void), extUnion1, extUnion2; + + +extern int DispI (int (*func) (void)); /* declare external functions */ +extern char DispCh (char (*func) (void)); +extern long DispL (long (*func) (void)); +extern comp DispC (comp (*func) (void)); +extern float DispF (float (*func) (void)); +extern double DispD (double (*func) (void)); +extern extended DispE (extended (*func) (void)); + +extern unsigned int DispUI (unsigned int (*func) (void)); +extern unsigned long DispUL (unsigned long (*func) (void)); + +extern struct S DispS (struct S (*func) (void)); +extern union U DispU (union U (*func) (void)); + + +/***************************************************************************/ + +int ExternTest (void) + { + int count = 0; + + int i; + char ch; + long LL; + comp c; + float f; + double d; + extended e; + unsigned int unInt; + unsigned long unLong; + struct S svar; + union U uvar; + + count++; + i = DispI (i2Ptr); + if (i != 2) + goto Fail; + + count++; + ch = DispCh (ch2Ptr); + if (ch != 'b') + goto Fail; + + count++; + LL = DispL (L2Ptr); + if (LL != 9) + goto Fail; + + count++; + c = DispC (c2Ptr); + if (c != 56) + goto Fail; + + count++; + f = DispF (f2Ptr); + if (fabs (f - 97.9) > 0.0001) + goto Fail; + + count++; + d = DispD (d2Ptr); + if (fabs (d - 25.5e-7) > 0.0001) + goto Fail; + + count++; + e = DispE (e2Ptr); + if (fabs (e - 0.4) > 0.0001) + goto Fail; + + count++; + unInt = DispUI (ui2Ptr); + if (unInt != 0x7E) + goto Fail; + + count++; + unLong = DispUL (uL2Ptr); + if (unLong != 0xFEDCBA98) + goto Fail; + + count++; + svar = DispS (struct2Ptr); + if ((svar.a != 18) || (fabs (svar.b - 0.3) > 0.0001)) + goto Fail; + + count++; + uvar = DispU (union2Ptr); + if (uvar.i != 29) + goto Fail; + + return 0; + +Fail: + printf ("Failed ExternTest: count = %d\n", count); + return 1; + } + +/***************************************************************************/ + +int I2 (void) + { + return 2; + } + +/***************************************************************************/ + +char Ch2 (void) + { + return 'b'; + } + +/***************************************************************************/ + +long L2 (void) + { + return 9; + } + +/***************************************************************************/ + +comp C2 (void) + { + return 8 * 7; + } + +/***************************************************************************/ + +float F2 (void) + { + return 97.9; + } + +/***************************************************************************/ + +double D2 (void) + { + return 25.5e-7; + } + +/***************************************************************************/ + +extended E2 (void) + { + return 0.4; + } + +/***************************************************************************/ + +unsigned int UI2 (void) + { + return 0x7e; + } + +/***************************************************************************/ + +unsigned long UL2 (void) + { + return 0xfedcba98; + } + +/***************************************************************************/ + +struct S S2 (void) + { + return extStruct2; + } + +/***************************************************************************/ + +union U U2 (void) + { + return extUnion2; + } diff --git a/Tests/Spec.Conform/SPC4631.EXEC b/Tests/Spec.Conform/SPC4631.EXEC old mode 100755 new mode 100644 index ca9b433..a3da730 --- a/Tests/Spec.Conform/SPC4631.EXEC +++ b/Tests/Spec.Conform/SPC4631.EXEC @@ -1 +1,27 @@ -* Exec file to run Special Conformance Test 4.6.3.1 * set exit on echo compile spc4.6.3.1.cc compile spc4.6.3.1.cc keep=3/out if {status} == 0 echo compile spc4631.1.cc compile spc4631.1.cc keep=3/out1 if {status} == 0 link 3/out 3/out1 keep=3/out if {status} == 0 3/out else echo Unable to link Special Conformance Test 4.6.3.1 end else echo Unable to compile file spc4631.1.cc end else echo Unable to compile file spc4.6.3.1.cc end \ No newline at end of file +* Exec file to run Special Conformance Test 4.6.3.1 * + +set exit on + +echo compile spc4.6.3.1.cc +compile spc4.6.3.1.cc keep=3/out + +if {status} == 0 + echo compile spc4631.1.cc + compile spc4631.1.cc keep=3/out1 + + if {status} == 0 + link 3/out 3/out1 keep=3/out + + if {status} == 0 + 3/out + else + echo Unable to link Special Conformance Test 4.6.3.1 + end + + else + echo Unable to compile file spc4631.1.cc + end + +else + echo Unable to compile file spc4.6.3.1.cc +end diff --git a/Tests/Spec.Conform/SPC4632.1.CC b/Tests/Spec.Conform/SPC4632.1.CC old mode 100755 new mode 100644 index e0e0248..2af9373 --- a/Tests/Spec.Conform/SPC4632.1.CC +++ b/Tests/Spec.Conform/SPC4632.1.CC @@ -1 +1,91 @@ -/* File spc4632.1.cc; the second source file which accesses the external */ /* arrays defined in the main source file. Part of Special Conformance */ /* Test 4.6.3.2 */ #include int ExternTest (void) { int count = 0; struct S { int a; float b; }; union U { int i; long L; }; /* Declare extern pointers */ extern int (*i2Ptr); extern char (*ch2Ptr); extern long (*L2Ptr); extern comp (*c2Ptr); extern float (*f2Ptr); extern double (*d2Ptr); extern extended (*e2Ptr); extern unsigned int (*ui2Ptr); extern unsigned long (*uL2Ptr); extern struct S (*struct2Ptr); extern union U (*union2Ptr ); /* also test pointer subscripting */ count++; if ((*(i2Ptr) != 8) || (i2Ptr [1] != 9)) goto Fail; count++; if ((*(ch2Ptr) != 'x') || (ch2Ptr [1] != 'y')) goto Fail; count++; if ((*(L2Ptr) != 17) || (L2Ptr [1] != 23)) goto Fail; count++; if ((*(c2Ptr) != 45000) || (c2Ptr [1] != 500000)) goto Fail; count++; if ((fabs (*(f2Ptr) - 123.456) > 0.0001) || (fabs (f2Ptr [1] - 6.0e7) > 0.0001)) goto Fail; count++; if ((fabs (*(d2Ptr) - 0.5e10) > 0.0001) || (fabs (d2Ptr [1] - 3.27) > 0.0001)) goto Fail; count++; if ((fabs (*(e2Ptr) - 7.4) > 0.0001) || (fabs (e2Ptr [1] - 9.9) > 0.0001)) goto Fail; count++; if ((*(ui2Ptr) != 10) || (ui2Ptr [1] != 11)) goto Fail; count++; if ((*(uL2Ptr) != 4) || (uL2Ptr [1] != 4)) goto Fail; count++; if ((struct2Ptr->a != 888) || ((struct2Ptr + 1)->a != 999)) goto Fail; count++; if ((fabs (struct2Ptr->b - 8.88) > 0.0001) || (fabs ((struct2Ptr + 1)->b - 9.99) > 0.0001)) goto Fail; count++; if ((union2Ptr->i != 7777) || ((union2Ptr + 1)->i != 0)) goto Fail; return 0; Fail: printf ("failure in ExternTest: count = %d\n", count); return 1; } \ No newline at end of file +/* File spc4632.1.cc; the second source file which accesses the external */ +/* arrays defined in the main source file. Part of Special Conformance */ +/* Test 4.6.3.2 */ + +#include + +int ExternTest (void) + { + int count = 0; + + struct S { int a; + float b; }; + union U { int i; + long L; }; + + /* Declare extern pointers */ + + extern int (*i2Ptr); + extern char (*ch2Ptr); + extern long (*L2Ptr); + extern comp (*c2Ptr); + extern float (*f2Ptr); + extern double (*d2Ptr); + extern extended (*e2Ptr); + + extern unsigned int (*ui2Ptr); + extern unsigned long (*uL2Ptr); + + extern struct S (*struct2Ptr); + extern union U (*union2Ptr ); + + /* also test pointer subscripting */ + + count++; + if ((*(i2Ptr) != 8) || (i2Ptr [1] != 9)) + goto Fail; + + count++; + if ((*(ch2Ptr) != 'x') || (ch2Ptr [1] != 'y')) + goto Fail; + + count++; + if ((*(L2Ptr) != 17) || (L2Ptr [1] != 23)) + goto Fail; + + count++; + if ((*(c2Ptr) != 45000) || (c2Ptr [1] != 500000)) + goto Fail; + + count++; + if ((fabs (*(f2Ptr) - 123.456) > 0.0001) || + (fabs (f2Ptr [1] - 6.0e7) > 0.0001)) + goto Fail; + + count++; + if ((fabs (*(d2Ptr) - 0.5e10) > 0.0001) || + (fabs (d2Ptr [1] - 3.27) > 0.0001)) + goto Fail; + + count++; + if ((fabs (*(e2Ptr) - 7.4) > 0.0001) || + (fabs (e2Ptr [1] - 9.9) > 0.0001)) + goto Fail; + + count++; + if ((*(ui2Ptr) != 10) || (ui2Ptr [1] != 11)) + goto Fail; + + count++; + if ((*(uL2Ptr) != 4) || (uL2Ptr [1] != 4)) + goto Fail; + + count++; + if ((struct2Ptr->a != 888) || ((struct2Ptr + 1)->a != 999)) + goto Fail; + + count++; + if ((fabs (struct2Ptr->b - 8.88) > 0.0001) || + (fabs ((struct2Ptr + 1)->b - 9.99) > 0.0001)) + goto Fail; + + count++; + if ((union2Ptr->i != 7777) || ((union2Ptr + 1)->i != 0)) + goto Fail; + + return 0; + +Fail: + printf ("failure in ExternTest: count = %d\n", count); + return 1; + } diff --git a/Tests/Spec.Conform/SPC4632.EXEC b/Tests/Spec.Conform/SPC4632.EXEC old mode 100755 new mode 100644 index feafbad..9434912 --- a/Tests/Spec.Conform/SPC4632.EXEC +++ b/Tests/Spec.Conform/SPC4632.EXEC @@ -1 +1,27 @@ -* Exec file to run Special Conformance Test 4.6.3.2 * set exit on echo compile spc4.6.3.2.cc compile spc4.6.3.2.cc keep=3/out if {status} == 0 echo compile spc4632.1.cc compile spc4632.1.cc keep=3/out1 if {status} == 0 link 3/out 3/out1 keep=3/out if {status} == 0 3/out else echo Unable to link Special Conformance Test 4.6.3.2 end else echo Unable to compile file spc4632.1.cc end else echo Unable to compile file spc4.6.3.2.cc end \ No newline at end of file +* Exec file to run Special Conformance Test 4.6.3.2 * + +set exit on + +echo compile spc4.6.3.2.cc +compile spc4.6.3.2.cc keep=3/out + +if {status} == 0 + echo compile spc4632.1.cc + compile spc4632.1.cc keep=3/out1 + + if {status} == 0 + link 3/out 3/out1 keep=3/out + + if {status} == 0 + 3/out + else + echo Unable to link Special Conformance Test 4.6.3.2 + end + + else + echo Unable to compile file spc4632.1.cc + end + +else + echo Unable to compile file spc4.6.3.2.cc +end diff --git a/Tests/Spec.Conform/SPC4633.1.CC b/Tests/Spec.Conform/SPC4633.1.CC old mode 100755 new mode 100644 index 1dc13a6..cb70317 --- a/Tests/Spec.Conform/SPC4633.1.CC +++ b/Tests/Spec.Conform/SPC4633.1.CC @@ -1 +1,82 @@ -/* File spc4633.1.cc; the second source file which accesses the external */ /* variables defined in the main source file. Part of Special Conformance */ /* Test 4.6.3.3 */ #include int ExternTest (void) { int count = 0; struct S { int a; float b; }; union U { int i; long L; }; /* Declare extern pointers */ extern int (*i2Ptr); extern char (*ch2Ptr); extern long (*L2Ptr); extern comp (*c2Ptr); extern float (*f2Ptr); extern double (*d2Ptr); extern extended (*e2Ptr); extern unsigned int (*ui2Ptr); extern unsigned long (*uL2Ptr); extern struct S (*struct2Ptr); extern union U (*union2Ptr ); count++; if (*(i2Ptr) != 8) goto Fail; count++; if (*(ch2Ptr) != 'x') goto Fail; count++; if (*(L2Ptr) != 17) goto Fail; count++; if (*(c2Ptr) != 45000) goto Fail; count++; if (fabs (*(f2Ptr) - 123.456) > 0.0001) goto Fail; count++; if (fabs (*(d2Ptr) - 0.5e10) > 0.0001) goto Fail; count++; if (fabs (*(e2Ptr) - 7.4) > 0.0001) goto Fail; count++; if (*(ui2Ptr) != 10) goto Fail; count++; if (*(uL2Ptr) != 4) goto Fail; count++; if ((struct2Ptr->a != 888) || (fabs (struct2Ptr->b - 8.88) > 0.0001)) goto Fail; count++; if (union2Ptr->i != 7777) goto Fail; return 0; Fail: printf ("Failure in ExternTest: count = %d\n", count); return 1; } \ No newline at end of file +/* File spc4633.1.cc; the second source file which accesses the external */ +/* variables defined in the main source file. Part of Special Conformance */ +/* Test 4.6.3.3 */ + +#include + +int ExternTest (void) + { + int count = 0; + + struct S { int a; + float b; }; + union U { int i; + long L; }; + + /* Declare extern pointers */ + + extern int (*i2Ptr); + extern char (*ch2Ptr); + extern long (*L2Ptr); + extern comp (*c2Ptr); + extern float (*f2Ptr); + extern double (*d2Ptr); + extern extended (*e2Ptr); + + extern unsigned int (*ui2Ptr); + extern unsigned long (*uL2Ptr); + + extern struct S (*struct2Ptr); + extern union U (*union2Ptr ); + + + count++; + if (*(i2Ptr) != 8) + goto Fail; + + count++; + if (*(ch2Ptr) != 'x') + goto Fail; + + count++; + if (*(L2Ptr) != 17) + goto Fail; + + count++; + if (*(c2Ptr) != 45000) + goto Fail; + + count++; + if (fabs (*(f2Ptr) - 123.456) > 0.0001) + goto Fail; + + count++; + if (fabs (*(d2Ptr) - 0.5e10) > 0.0001) + goto Fail; + + count++; + if (fabs (*(e2Ptr) - 7.4) > 0.0001) + goto Fail; + + count++; + if (*(ui2Ptr) != 10) + goto Fail; + + count++; + if (*(uL2Ptr) != 4) + goto Fail; + + count++; + if ((struct2Ptr->a != 888) || (fabs (struct2Ptr->b - 8.88) > 0.0001)) + goto Fail; + + count++; + if (union2Ptr->i != 7777) + goto Fail; + + return 0; + +Fail: + printf ("Failure in ExternTest: count = %d\n", count); + return 1; + } diff --git a/Tests/Spec.Conform/SPC4633.EXEC b/Tests/Spec.Conform/SPC4633.EXEC old mode 100755 new mode 100644 index 7ae432a..3a709fc --- a/Tests/Spec.Conform/SPC4633.EXEC +++ b/Tests/Spec.Conform/SPC4633.EXEC @@ -1 +1,27 @@ -* Exec file to run Special Conformance Test 4.6.3.3 * set exit on echo compile spc4.6.3.3.cc compile +t +e spc4.6.3.3.cc keep=3/out if {status} == 0 echo compile spc4633.1.cc compile +t +e spc4633.1.cc keep=3/out1 if {status} == 0 link 3/out 3/out1 keep=3/out if {status} == 0 3/out else echo Unable to link Special Conformance Test 4.6.3.3 end else echo Unable to compile file spc4633.1.cc end else echo Unable to compile file spc4.6.3.3.cc end \ No newline at end of file +* Exec file to run Special Conformance Test 4.6.3.3 * + +set exit on + +echo compile spc4.6.3.3.cc +compile +t +e spc4.6.3.3.cc keep=3/out + +if {status} == 0 + echo compile spc4633.1.cc + compile +t +e spc4633.1.cc keep=3/out1 + + if {status} == 0 + link 3/out 3/out1 keep=3/out + + if {status} == 0 + 3/out + else + echo Unable to link Special Conformance Test 4.6.3.3 + end + + else + echo Unable to compile file spc4633.1.cc + end + +else + echo Unable to compile file spc4.6.3.3.cc +end diff --git a/Tests/Spec.Conform/SPC4634.1.CC b/Tests/Spec.Conform/SPC4634.1.CC old mode 100755 new mode 100644 index 86f2491..8d45441 --- a/Tests/Spec.Conform/SPC4634.1.CC +++ b/Tests/Spec.Conform/SPC4634.1.CC @@ -1 +1,82 @@ -/* File spc4634.1.cc; the second source file which accesses the external */ /* variables defined in the main source file. Part of Special Conformance */ /* Test 4.6.3.4 */ #include int ExternTest (void) { int count = 0; struct S { int a; float b; }; union U { int i; long L; }; /* Declare extern pointers */ extern int (*i2Ptr); extern char (*ch2Ptr); extern long (*L2Ptr); extern comp (*c2Ptr); extern float (*f2Ptr); extern double (*d2Ptr); extern extended (*e2Ptr); extern unsigned int (*ui2Ptr); extern unsigned long (*uL2Ptr); extern struct S (*struct2Ptr); extern union U (*union2Ptr ); count++; if (*(i2Ptr) != 9) goto Fail; count++; if (*(ch2Ptr) != 'z') goto Fail; count++; if (*(L2Ptr) != 27) goto Fail; count++; if (*(c2Ptr) != 100000) goto Fail; count++; if (fabs (*(f2Ptr) - 12.3456) > 0.0001) goto Fail; count++; if (fabs (*(d2Ptr) - 0.65) > 0.0001) goto Fail; count++; if (fabs (*(e2Ptr) - 4.7) > 0.0001) goto Fail; count++; if (*(ui2Ptr) != 20) goto Fail; count++; if (*(uL2Ptr) != 88) goto Fail; count++; if ((struct2Ptr->a != 999) || (fabs (struct2Ptr->b - 9.99) > 0.0001)) goto Fail; count++; if (union2Ptr->i != 0) goto Fail; return 0; Fail: printf ("Failed ExternTest: count = %d\n", count); return 1; } \ No newline at end of file +/* File spc4634.1.cc; the second source file which accesses the external */ +/* variables defined in the main source file. Part of Special Conformance */ +/* Test 4.6.3.4 */ + +#include + +int ExternTest (void) + { + int count = 0; + + struct S { int a; + float b; }; + union U { int i; + long L; }; + + /* Declare extern pointers */ + + extern int (*i2Ptr); + extern char (*ch2Ptr); + extern long (*L2Ptr); + extern comp (*c2Ptr); + extern float (*f2Ptr); + extern double (*d2Ptr); + extern extended (*e2Ptr); + + extern unsigned int (*ui2Ptr); + extern unsigned long (*uL2Ptr); + + extern struct S (*struct2Ptr); + extern union U (*union2Ptr ); + + + count++; + if (*(i2Ptr) != 9) + goto Fail; + + count++; + if (*(ch2Ptr) != 'z') + goto Fail; + + count++; + if (*(L2Ptr) != 27) + goto Fail; + + count++; + if (*(c2Ptr) != 100000) + goto Fail; + + count++; + if (fabs (*(f2Ptr) - 12.3456) > 0.0001) + goto Fail; + + count++; + if (fabs (*(d2Ptr) - 0.65) > 0.0001) + goto Fail; + + count++; + if (fabs (*(e2Ptr) - 4.7) > 0.0001) + goto Fail; + + count++; + if (*(ui2Ptr) != 20) + goto Fail; + + count++; + if (*(uL2Ptr) != 88) + goto Fail; + + count++; + if ((struct2Ptr->a != 999) || (fabs (struct2Ptr->b - 9.99) > 0.0001)) + goto Fail; + + count++; + if (union2Ptr->i != 0) + goto Fail; + + return 0; + +Fail: + printf ("Failed ExternTest: count = %d\n", count); + return 1; + } diff --git a/Tests/Spec.Conform/SPC4634.EXEC b/Tests/Spec.Conform/SPC4634.EXEC old mode 100755 new mode 100644 index 5c44ed8..ebd0505 --- a/Tests/Spec.Conform/SPC4634.EXEC +++ b/Tests/Spec.Conform/SPC4634.EXEC @@ -1 +1,27 @@ -* Exec file to run Special Conformance Test 4.6.3.4 * set exit on echo compile spc4.6.3.4.cc compile spc4.6.3.4.cc keep=3/out if {status} == 0 echo compile spc4634.1.cc compile spc4634.1.cc keep=3/out1 if {status} == 0 link 3/out 3/out1 keep=3/out if {status} == 0 3/out else echo Unable to link Special Conformance Test 4.6.3.4 end else echo Unable to compile file spc4634.1.cc end else echo Unable to compile file spc4.6.3.4.cc end \ No newline at end of file +* Exec file to run Special Conformance Test 4.6.3.4 * + +set exit on + +echo compile spc4.6.3.4.cc +compile spc4.6.3.4.cc keep=3/out + +if {status} == 0 + echo compile spc4634.1.cc + compile spc4634.1.cc keep=3/out1 + + if {status} == 0 + link 3/out 3/out1 keep=3/out + + if {status} == 0 + 3/out + else + echo Unable to link Special Conformance Test 4.6.3.4 + end + + else + echo Unable to compile file spc4634.1.cc + end + +else + echo Unable to compile file spc4.6.3.4.cc +end diff --git a/Tests/Spec.Conform/SPC4636.1.CC b/Tests/Spec.Conform/SPC4636.1.CC old mode 100755 new mode 100644 index e46eb73..d713b74 --- a/Tests/Spec.Conform/SPC4636.1.CC +++ b/Tests/Spec.Conform/SPC4636.1.CC @@ -1 +1,80 @@ -/* File spc4636.1.cc; the second source file which accesses the external */ /* arrays defined in the main source file. Part of Special Conformance */ /* Test 4.6.3.6 */ int ExternTest (void) { int count = 0; struct S { int a; float b; }; union U { int i; long L; }; /* Declare extern pointers */ extern int (*i2Ptr); extern char (*ch2Ptr); extern long (*L2Ptr); extern comp (*c2Ptr); extern float (*f2Ptr); extern double (*d2Ptr); extern extended (*e2Ptr); extern unsigned int (*ui2Ptr); extern unsigned long (*uL2Ptr); extern struct S (*struct2Ptr); extern union U (*union2Ptr ); count++; if (*(i2Ptr) != 9) goto Fail; count++; if (*(ch2Ptr) != 'y') goto Fail; count++; if (*(L2Ptr) != 23) goto Fail; /* count++; if (*(c2Ptr) != 500000) goto Fail; */ count++; if (fabs (*(f2Ptr) - 6.0E7) > 0.0001) goto Fail; count++; if (fabs (*(d2Ptr) - 3.27) > 0.0001) goto Fail; count++; if (fabs (*(e2Ptr) - 9.9) > 0.0001) goto Fail; count++; if (*(ui2Ptr) != 11) goto Fail; count++; if (*(uL2Ptr) != 4) goto Fail; count++; if ((struct2Ptr->a != 999) || (fabs (struct2Ptr->b - 9.99) > 0.0001)) goto Fail; count++; if (union2Ptr->i != 0) goto Fail; return 0; Fail: printf ("Failure in ExternTest: count = %d\n", count); return 1; } \ No newline at end of file +/* File spc4636.1.cc; the second source file which accesses the external */ +/* arrays defined in the main source file. Part of Special Conformance */ +/* Test 4.6.3.6 */ + + +int ExternTest (void) + { + int count = 0; + + struct S { int a; + float b; }; + union U { int i; + long L; }; + + /* Declare extern pointers */ + + extern int (*i2Ptr); + extern char (*ch2Ptr); + extern long (*L2Ptr); + extern comp (*c2Ptr); + extern float (*f2Ptr); + extern double (*d2Ptr); + extern extended (*e2Ptr); + + extern unsigned int (*ui2Ptr); + extern unsigned long (*uL2Ptr); + + extern struct S (*struct2Ptr); + extern union U (*union2Ptr ); + + count++; + if (*(i2Ptr) != 9) + goto Fail; + + count++; + if (*(ch2Ptr) != 'y') + goto Fail; + + count++; + if (*(L2Ptr) != 23) + goto Fail; + +/* count++; + if (*(c2Ptr) != 500000) + goto Fail; */ + + count++; + if (fabs (*(f2Ptr) - 6.0E7) > 0.0001) + goto Fail; + + count++; + if (fabs (*(d2Ptr) - 3.27) > 0.0001) + goto Fail; + + count++; + if (fabs (*(e2Ptr) - 9.9) > 0.0001) + goto Fail; + + count++; + if (*(ui2Ptr) != 11) + goto Fail; + + count++; + if (*(uL2Ptr) != 4) + goto Fail; + + count++; + if ((struct2Ptr->a != 999) || (fabs (struct2Ptr->b - 9.99) > 0.0001)) + goto Fail; + + count++; + if (union2Ptr->i != 0) + goto Fail; + + return 0; + +Fail: + printf ("Failure in ExternTest: count = %d\n", count); + return 1; + } diff --git a/Tests/Spec.Conform/SPC4636.EXEC b/Tests/Spec.Conform/SPC4636.EXEC old mode 100755 new mode 100644 index 8284149..ac8c228 --- a/Tests/Spec.Conform/SPC4636.EXEC +++ b/Tests/Spec.Conform/SPC4636.EXEC @@ -1 +1,29 @@ -* Exec file to run Special Conformance Test 4.6.3.6 * unset exit compile spc4.6.3.6.cc keep=3/spc4636 set errNo {status} if {errNo} == 0 compile spc4636.1.cc keep=3/spc4636.1 set errNo {status} if {errNo} == 0 link 3/spc4636 3/spc4636.1 keep=3/spc4636 set errNo {status} if {errNo} == 0 3/spc4636 else echo Unable to link Special Conformance Test 4.6.3.6 end else echo Unable to compile file spc4636.1.cc end else echo Unable to compile file spc4.6.3.6.cc end \ No newline at end of file +* Exec file to run Special Conformance Test 4.6.3.6 * + +unset exit + +compile spc4.6.3.6.cc keep=3/spc4636 +set errNo {status} + +if {errNo} == 0 + compile spc4636.1.cc keep=3/spc4636.1 + + set errNo {status} + if {errNo} == 0 + link 3/spc4636 3/spc4636.1 keep=3/spc4636 + + set errNo {status} + if {errNo} == 0 + 3/spc4636 + + else + echo Unable to link Special Conformance Test 4.6.3.6 + end + + else + echo Unable to compile file spc4636.1.cc + end + +else + echo Unable to compile file spc4.6.3.6.cc +end diff --git a/Tests/Spec.Conform/UFILE1 b/Tests/Spec.Conform/UFILE1 old mode 100755 new mode 100644 index df770b0..9853a4f --- a/Tests/Spec.Conform/UFILE1 +++ b/Tests/Spec.Conform/UFILE1 @@ -1 +1,3 @@ -main () { int x; \ No newline at end of file +main () + { + int x; diff --git a/Tests/Spec.Conform/USERFILE2 b/Tests/Spec.Conform/USERFILE2 old mode 100755 new mode 100644 index 52dd54c..9e9d2aa --- a/Tests/Spec.Conform/USERFILE2 +++ b/Tests/Spec.Conform/USERFILE2 @@ -1 +1,3 @@ - x = TEN + NINE; if (x != 19) goto Fail; \ No newline at end of file + x = TEN + NINE; + if (x != 19) + goto Fail; diff --git a/Tests/Spec.Conform/spc21.3.0.1.cc b/Tests/Spec.Conform/spc21.3.0.1.cc old mode 100755 new mode 100644 index 3d68885..1a1b9ee --- a/Tests/Spec.Conform/spc21.3.0.1.cc +++ b/Tests/Spec.Conform/spc21.3.0.1.cc @@ -1 +1,56 @@ -/* */ /* Special Conformance Test 21.3.0.1: Verification of exit, atexit functions */ /* */ /* The tester should verify that the sequence of messages "return from */ /* function 1", "return from function 2", "return from function 3" are */ /* displayed on the screen, and that the {status} shell variable is set to */ /* 3 upon completion of the program. */ /* */ #include /******************************************************************************/ void F1 () { printf ("Return from function 1\n"); } /******************************************************************************/ void F2 () { printf ("Return from function 2\n"); } /******************************************************************************/ void F3 () { printf ("Return from function 3\n"); } /******************************************************************************/ main () { int i; i = atexit (F3); if (i != 0) goto Fail; i = atexit (F2); if (i != 0) goto Fail; i = atexit (F1); if (i != 0) goto Fail; exit (3); Fail: printf ("Failure of atexit function in Special Conformance Test 21.3.0.1\n"); } \ No newline at end of file +/* */ +/* Special Conformance Test 21.3.0.1: Verification of exit, atexit functions */ +/* */ +/* The tester should verify that the sequence of messages "return from */ +/* function 1", "return from function 2", "return from function 3" are */ +/* displayed on the screen, and that the {status} shell variable is set to */ +/* 3 upon completion of the program. */ +/* */ + +#include + +/******************************************************************************/ + +void F1 () + { + printf ("Return from function 1\n"); + } + +/******************************************************************************/ + +void F2 () + { + printf ("Return from function 2\n"); + } + +/******************************************************************************/ + +void F3 () + { + printf ("Return from function 3\n"); + } + +/******************************************************************************/ + + +main () + { + int i; + + i = atexit (F3); + if (i != 0) + goto Fail; + + i = atexit (F2); + if (i != 0) + goto Fail; + + i = atexit (F1); + if (i != 0) + goto Fail; + + exit (3); + +Fail: + printf ("Failure of atexit function in Special Conformance Test 21.3.0.1\n"); + } diff --git a/Tests/Spec.Conform/spc21.3.0.2.cc b/Tests/Spec.Conform/spc21.3.0.2.cc old mode 100755 new mode 100644 index ed333b5..a109941 --- a/Tests/Spec.Conform/spc21.3.0.2.cc +++ b/Tests/Spec.Conform/spc21.3.0.2.cc @@ -1 +1,56 @@ -/* */ /* Special Conformance Test 21.3.0.2: Verification of _exit function */ /* */ /* The tester should verify that the program halts and that the {status} */ /* shell variable is set to 10 upon completion of the program. No messages */ /* should be printed by any of the functions registered with atexit. */ /* */ #include /******************************************************************************/ void F1 () { printf ("Return from function 1\n"); } /******************************************************************************/ void F2 () { printf ("Return from function 2\n"); } /******************************************************************************/ void F3 () { printf ("Return from function 3\n"); } /******************************************************************************/ main () { int i; i = atexit (F3); if (i != 0) goto Fail; i = atexit (F2); if (i != 0) goto Fail; i = atexit (F1); if (i != 0) goto Fail; _exit (10); Fail: printf ("Failure of atexit function in Special Conformance Test 21.3.0.2\n"); } \ No newline at end of file +/* */ +/* Special Conformance Test 21.3.0.2: Verification of _exit function */ +/* */ +/* The tester should verify that the program halts and that the {status} */ +/* shell variable is set to 10 upon completion of the program. No messages */ +/* should be printed by any of the functions registered with atexit. */ +/* */ + +#include + + +/******************************************************************************/ + +void F1 () + { + printf ("Return from function 1\n"); + } + +/******************************************************************************/ + +void F2 () + { + printf ("Return from function 2\n"); + } + +/******************************************************************************/ + +void F3 () + { + printf ("Return from function 3\n"); + } + +/******************************************************************************/ + + +main () + { + int i; + + i = atexit (F3); + if (i != 0) + goto Fail; + + i = atexit (F2); + if (i != 0) + goto Fail; + + i = atexit (F1); + if (i != 0) + goto Fail; + + _exit (10); + +Fail: + printf ("Failure of atexit function in Special Conformance Test 21.3.0.2\n"); + } diff --git a/Tests/Spec.Conform/spc21.3.0.3.cc b/Tests/Spec.Conform/spc21.3.0.3.cc old mode 100755 new mode 100644 index a670593..55c14e7 --- a/Tests/Spec.Conform/spc21.3.0.3.cc +++ b/Tests/Spec.Conform/spc21.3.0.3.cc @@ -1 +1,56 @@ -/* */ /* Special Conformance Test 21.3.0.3: Verification of abort function */ /* */ /* The tester should verify that the program halts and that the {status} */ /* shell variable is set to -1 upon completion of the program. No messages */ /* should be printed by any of the functions registered with atexit. */ /* */ #include /******************************************************************************/ void F1 () { printf ("Return from function 1\n"); } /******************************************************************************/ void F2 () { printf ("Return from function 2\n"); } /******************************************************************************/ void F3 () { printf ("Return from function 3\n"); } /******************************************************************************/ main () { int i; i = atexit (F3); if (i != 0) goto Fail; i = atexit (F2); if (i != 0) goto Fail; i = atexit (F1); if (i != 0) goto Fail; abort (); Fail: printf ("Failure of atexit function in Special Conformance Test 21.3.0.3\n"); } \ No newline at end of file +/* */ +/* Special Conformance Test 21.3.0.3: Verification of abort function */ +/* */ +/* The tester should verify that the program halts and that the {status} */ +/* shell variable is set to -1 upon completion of the program. No messages */ +/* should be printed by any of the functions registered with atexit. */ +/* */ + +#include + + +/******************************************************************************/ + +void F1 () + { + printf ("Return from function 1\n"); + } + +/******************************************************************************/ + +void F2 () + { + printf ("Return from function 2\n"); + } + +/******************************************************************************/ + +void F3 () + { + printf ("Return from function 3\n"); + } + +/******************************************************************************/ + + +main () + { + int i; + + i = atexit (F3); + if (i != 0) + goto Fail; + + i = atexit (F2); + if (i != 0) + goto Fail; + + i = atexit (F1); + if (i != 0) + goto Fail; + + abort (); + +Fail: + printf ("Failure of atexit function in Special Conformance Test 21.3.0.3\n"); + } diff --git a/Tests/Spec.Conform/spc4411.exec b/Tests/Spec.Conform/spc4411.exec old mode 100755 new mode 100644 index bbbeed3..22d64ba --- a/Tests/Spec.Conform/spc4411.exec +++ b/Tests/Spec.Conform/spc4411.exec @@ -1 +1,33 @@ -* Exec file to run Special Conformance Test 4.4.1.1 * unset exit echo compile spc4.4.1.1.cc compile spc4.4.1.1.cc keep=14:spc4411.mn set errNo {status} if {errNo} == 0 echo compile spc4411.1.cc compile spc4411.1.cc keep=14:spc4411.1 set errNo {status} if {errNo} == 0 echo link spc4.4.1.1.cc link 14:spc4411.mn 14:spc4411.1 keep=14:spc4411 set errNo {status} if {errNo} == 0 echo execute spc4.4.1.1.cc 14:spc4411 else echo Unable to link Special Conformance Test 4.4.1.1 end else echo Unable to compile file spc4411.1.cc end else echo Unable to compile file spc4.4.1.1.cc end \ No newline at end of file +* Exec file to run Special Conformance Test 4.4.1.1 * + +unset exit + +echo compile spc4.4.1.1.cc +compile spc4.4.1.1.cc keep=14:spc4411.mn +set errNo {status} + +if {errNo} == 0 + echo compile spc4411.1.cc + compile spc4411.1.cc keep=14:spc4411.1 + + set errNo {status} + if {errNo} == 0 + echo link spc4.4.1.1.cc + link 14:spc4411.mn 14:spc4411.1 keep=14:spc4411 + + set errNo {status} + if {errNo} == 0 + echo execute spc4.4.1.1.cc + 14:spc4411 + + else + echo Unable to link Special Conformance Test 4.4.1.1 + end + + else + echo Unable to compile file spc4411.1.cc + end + +else + echo Unable to compile file spc4.4.1.1.cc +end diff --git a/Tests/Spec.Deviance/DOIT b/Tests/Spec.Deviance/DOIT old mode 100755 new mode 100644 index 220e360..f9fc672 --- a/Tests/Spec.Deviance/DOIT +++ b/Tests/Spec.Deviance/DOIT @@ -1 +1,15 @@ -{1} SPD17.2.0.1.CC {1} SPD17.2.0.2.CC {1} SPD17.2.0.3.CC {1} SPD17.2.0.4.CC {1} SPD17.2.0.5.CC {1} SPD17.2.0.7.CC {1} SPD17.3.0.1.CC {1} SPD17.3.0.2.CC {1} SPD17.3.0.3.CC {1} SPD17.5.0.1.CC {1} SPD17.5.0.2.CC {1} SPD17.6.0.1.CC {1} SPD17.6.0.2.CC {1} SPD17.6.0.3.CC {1} SPD17.7.0.1.CC \ No newline at end of file +{1} SPD17.2.0.1.CC +{1} SPD17.2.0.2.CC +{1} SPD17.2.0.3.CC +{1} SPD17.2.0.4.CC +{1} SPD17.2.0.5.CC +{1} SPD17.2.0.7.CC +{1} SPD17.3.0.1.CC +{1} SPD17.3.0.2.CC +{1} SPD17.3.0.3.CC +{1} SPD17.5.0.1.CC +{1} SPD17.5.0.2.CC +{1} SPD17.6.0.1.CC +{1} SPD17.6.0.2.CC +{1} SPD17.6.0.3.CC +{1} SPD17.7.0.1.CC diff --git a/Tests/Spec.Deviance/SPD17.2.0.1.CC b/Tests/Spec.Deviance/SPD17.2.0.1.CC old mode 100755 new mode 100644 index 93ffdec..d7e50cd --- a/Tests/Spec.Deviance/SPD17.2.0.1.CC +++ b/Tests/Spec.Deviance/SPD17.2.0.1.CC @@ -1 +1,19 @@ -/* Deviance Test 17.2.0.1: Ensure illegal parameters supplied to fopen */ /* are detected */ #include main () { FILE *f1; f1 = fopen ("123badfile", "r"); /* try to open file with invalid */ if (f1 != NULL) /* filename */ goto Fail; printf ("Passed Deviance Test 17.2.0.1\n"); return; Fail: printf ("Failed Deviance Test 17.2.0.1\n"); } \ No newline at end of file +/* Deviance Test 17.2.0.1: Ensure illegal parameters supplied to fopen */ +/* are detected */ + +#include + +main () + { + FILE *f1; + + f1 = fopen ("123badfile", "r"); /* try to open file with invalid */ + if (f1 != NULL) /* filename */ + goto Fail; + + printf ("Passed Deviance Test 17.2.0.1\n"); + return; + +Fail: + printf ("Failed Deviance Test 17.2.0.1\n"); + } diff --git a/Tests/Spec.Deviance/SPD17.2.0.2.CC b/Tests/Spec.Deviance/SPD17.2.0.2.CC old mode 100755 new mode 100644 index 18d925d..1d0ce5f --- a/Tests/Spec.Deviance/SPD17.2.0.2.CC +++ b/Tests/Spec.Deviance/SPD17.2.0.2.CC @@ -1 +1,19 @@ -/* Deviance Test 17.2.0.2: Ensure illegal parameters supplied to freopen */ /* are detected */ #include main () { FILE *f1; f1 = freopen ("123badfile", "r", f1); /* invalid stream to freopen */ if (f1 != NULL) goto Fail; printf ("Passed Deviance Test 17.2.0.2\n"); return; Fail: printf ("Failed Deviance Test 17.2.0.2\n"); } \ No newline at end of file +/* Deviance Test 17.2.0.2: Ensure illegal parameters supplied to freopen */ +/* are detected */ + +#include + +main () + { + FILE *f1; + + f1 = freopen ("123badfile", "r", f1); /* invalid stream to freopen */ + if (f1 != NULL) + goto Fail; + + printf ("Passed Deviance Test 17.2.0.2\n"); + return; + +Fail: + printf ("Failed Deviance Test 17.2.0.2\n"); + } diff --git a/Tests/Spec.Deviance/SPD17.2.0.3.CC b/Tests/Spec.Deviance/SPD17.2.0.3.CC old mode 100755 new mode 100644 index 29cefd5..15fccda --- a/Tests/Spec.Deviance/SPD17.2.0.3.CC +++ b/Tests/Spec.Deviance/SPD17.2.0.3.CC @@ -1 +1,19 @@ -/* Deviance Test 17.2.0.3: Ensure illegal parameters supplied to freopen */ /* are detected */ #include main () { FILE *f1; f1 = freopen ("3/thirdFile", "t", f1); /* try to open with invalid type */ if (f1 != NULL) goto Fail; printf ("Passed Deviance Test 17.2.0.3\n"); return; Fail: printf ("Failed Deviance Test 17.2.0.3\n"); } \ No newline at end of file +/* Deviance Test 17.2.0.3: Ensure illegal parameters supplied to freopen */ +/* are detected */ + +#include + +main () + { + FILE *f1; + + f1 = freopen ("3/thirdFile", "t", f1); /* try to open with invalid type */ + if (f1 != NULL) + goto Fail; + + printf ("Passed Deviance Test 17.2.0.3\n"); + return; + +Fail: + printf ("Failed Deviance Test 17.2.0.3\n"); + } diff --git a/Tests/Spec.Deviance/SPD17.2.0.4.CC b/Tests/Spec.Deviance/SPD17.2.0.4.CC old mode 100755 new mode 100644 index 6bfd704..cdbdae7 --- a/Tests/Spec.Deviance/SPD17.2.0.4.CC +++ b/Tests/Spec.Deviance/SPD17.2.0.4.CC @@ -1 +1,20 @@ -/* Deviance Test 17.2.0.4: Ensure illegal parameters supplied to fclose */ /* are detected */ #include main () { FILE *f1; int i; i = fclose (f1); /* pass fclose an invalid file pointer */ if (i != EOF) goto Fail; printf ("Passed Deviance Test 17.2.0.4\n"); return; Fail: printf ("Failed Deviance Test 17.2.0.4\n"); } \ No newline at end of file +/* Deviance Test 17.2.0.4: Ensure illegal parameters supplied to fclose */ +/* are detected */ + +#include + +main () + { + FILE *f1; + int i; + + i = fclose (f1); /* pass fclose an invalid file pointer */ + if (i != EOF) + goto Fail; + + printf ("Passed Deviance Test 17.2.0.4\n"); + return; + +Fail: + printf ("Failed Deviance Test 17.2.0.4\n"); + } diff --git a/Tests/Spec.Deviance/SPD17.2.0.5.CC b/Tests/Spec.Deviance/SPD17.2.0.5.CC old mode 100755 new mode 100644 index 5d40266..3ba99cd --- a/Tests/Spec.Deviance/SPD17.2.0.5.CC +++ b/Tests/Spec.Deviance/SPD17.2.0.5.CC @@ -1 +1,20 @@ -/* Deviance Test 17.2.0.5: Ensure illegal parameters supplied to fflush */ /* are detected */ #include main () { FILE *f1; int i; i = fflush (f1); /* pass fflush an invalid file pointer */ if (i != EOF) goto Fail; printf ("Passed Deviance Test 17.2.0.5\n"); return; Fail: printf ("Failed Deviance Test 17.2.0.5\n"); } \ No newline at end of file +/* Deviance Test 17.2.0.5: Ensure illegal parameters supplied to fflush */ +/* are detected */ + +#include + +main () + { + FILE *f1; + int i; + + i = fflush (f1); /* pass fflush an invalid file pointer */ + if (i != EOF) + goto Fail; + + printf ("Passed Deviance Test 17.2.0.5\n"); + return; + +Fail: + printf ("Failed Deviance Test 17.2.0.5\n"); + } diff --git a/Tests/Spec.Deviance/SPD17.2.0.7.CC b/Tests/Spec.Deviance/SPD17.2.0.7.CC old mode 100755 new mode 100644 index 9d1ca29..fa0f6e0 --- a/Tests/Spec.Deviance/SPD17.2.0.7.CC +++ b/Tests/Spec.Deviance/SPD17.2.0.7.CC @@ -1 +1,20 @@ -/* Deviance Test 17.2.0.7: Ensure illegal parameters supplied to fopen */ /* are detected */ #include main () { FILE *f1; int i; f1 = fopen ("3/fourthFile", "99"); /* try to open with invalid type */ if (f1 != NULL) goto Fail; printf ("Passed Deviance Test 17.2.0.7\n"); return; Fail: printf ("Failed Deviance Test 17.2.0.7\n"); } \ No newline at end of file +/* Deviance Test 17.2.0.7: Ensure illegal parameters supplied to fopen */ +/* are detected */ + +#include + +main () + { + FILE *f1; + int i; + + f1 = fopen ("3/fourthFile", "99"); /* try to open with invalid type */ + if (f1 != NULL) + goto Fail; + + printf ("Passed Deviance Test 17.2.0.7\n"); + return; + +Fail: + printf ("Failed Deviance Test 17.2.0.7\n"); + } diff --git a/Tests/Spec.Deviance/SPD17.3.0.1.CC b/Tests/Spec.Deviance/SPD17.3.0.1.CC old mode 100755 new mode 100644 index 80c438d..f4e2ac0 --- a/Tests/Spec.Deviance/SPD17.3.0.1.CC +++ b/Tests/Spec.Deviance/SPD17.3.0.1.CC @@ -1 +1,21 @@ -/* Deviance Test 17.3.0.1: Ensure illegal setvbuf calls are detected */ #include main () { FILE *f1; char buf [80]; int i; i = setvbuf (f1, buf, _IOLBF, 0); /* call setvbuf before file opened */ if (!i) goto Fail; printf ("Passed Deviance Test 17.3.0.1\n"); return; Fail: printf ("Failed Deviance Test 17.3.0.1\n"); return; } \ No newline at end of file +/* Deviance Test 17.3.0.1: Ensure illegal setvbuf calls are detected */ + +#include + +main () + { + FILE *f1; + char buf [80]; + int i; + + i = setvbuf (f1, buf, _IOLBF, 0); /* call setvbuf before file opened */ + if (!i) + goto Fail; + + printf ("Passed Deviance Test 17.3.0.1\n"); + return; + +Fail: + printf ("Failed Deviance Test 17.3.0.1\n"); + return; + } diff --git a/Tests/Spec.Deviance/SPD17.3.0.2.CC b/Tests/Spec.Deviance/SPD17.3.0.2.CC old mode 100755 new mode 100644 index d5d04c1..e12d722 --- a/Tests/Spec.Deviance/SPD17.3.0.2.CC +++ b/Tests/Spec.Deviance/SPD17.3.0.2.CC @@ -1 +1,35 @@ -/* Deviance Test 17.3.0.2: Ensure illegal setvbuf calls are detected */ #include main () { FILE *f1; char buf [80]; int i; f1 = fopen ("3/tmp", "w"); /* call setvbuf after I/O already done */ if (f1 == NULL) goto Fail1; i = fputc ('a', f1); /* write a character to the file */ if (i == EOF) goto Fail2; i = setvbuf (f1, NULL, _IONBF, 0); if (!i) goto Fail; printf ("Passed Deviance Test 17.3.0.2\n"); return; Fail: printf ("Failed Deviance Test 17.3.0.2\n"); return; Fail1: printf ("Unable to open work file for Deviance Test 17.3.0.2\n"); return; Fail2: printf ("Unable to write to file for Deviance Test 17.3.0.2\n"); return; } \ No newline at end of file +/* Deviance Test 17.3.0.2: Ensure illegal setvbuf calls are detected */ + +#include + +main () + { + FILE *f1; + char buf [80]; + int i; + + f1 = fopen ("3/tmp", "w"); /* call setvbuf after I/O already done */ + if (f1 == NULL) + goto Fail1; + i = fputc ('a', f1); /* write a character to the file */ + if (i == EOF) + goto Fail2; + i = setvbuf (f1, NULL, _IONBF, 0); + if (!i) + goto Fail; + + printf ("Passed Deviance Test 17.3.0.2\n"); + return; + +Fail: + printf ("Failed Deviance Test 17.3.0.2\n"); + return; + +Fail1: + printf ("Unable to open work file for Deviance Test 17.3.0.2\n"); + return; + +Fail2: + printf ("Unable to write to file for Deviance Test 17.3.0.2\n"); + return; + } diff --git a/Tests/Spec.Deviance/SPD17.3.0.3.CC b/Tests/Spec.Deviance/SPD17.3.0.3.CC old mode 100755 new mode 100644 index 6222515..c149424 --- a/Tests/Spec.Deviance/SPD17.3.0.3.CC +++ b/Tests/Spec.Deviance/SPD17.3.0.3.CC @@ -1 +1,28 @@ -/* Deviance Test 17.3.0.3: Ensure illegal setvbuf calls are detected */ #include main () { FILE *f1; char buf [80]; int i; f1 = fopen ("3/tmp", "w"); /* call setvbuf with an ivalid buffering type */ if (f1 == NULL) goto Fail1; i = setvbuf (f1, buf, 3, 80); if (!i) goto Fail; printf ("Passed Deviance Test 17.3.0.3\n"); return; Fail: printf ("Failed Deviance Test 17.3.0.3\n"); return; Fail1: printf ("Unable to open work file for Deviance Test 17.3.0.3\n"); return; } \ No newline at end of file +/* Deviance Test 17.3.0.3: Ensure illegal setvbuf calls are detected */ + +#include + +main () + { + FILE *f1; + char buf [80]; + int i; + + f1 = fopen ("3/tmp", "w"); /* call setvbuf with an ivalid buffering type */ + if (f1 == NULL) + goto Fail1; + i = setvbuf (f1, buf, 3, 80); + if (!i) + goto Fail; + + printf ("Passed Deviance Test 17.3.0.3\n"); + return; + +Fail: + printf ("Failed Deviance Test 17.3.0.3\n"); + return; + +Fail1: + printf ("Unable to open work file for Deviance Test 17.3.0.3\n"); + return; + } diff --git a/Tests/Spec.Deviance/SPD17.5.0.1.CC b/Tests/Spec.Deviance/SPD17.5.0.1.CC old mode 100755 new mode 100644 index 6c45bcb..9762de2 --- a/Tests/Spec.Deviance/SPD17.5.0.1.CC +++ b/Tests/Spec.Deviance/SPD17.5.0.1.CC @@ -1 +1,27 @@ -/* Deviance Test 17.5.0.1: Ensure illegal parameters passed to fseek are */ /* detected */ #include #include main () { FILE *f1; int i, j; i = fseek (f1, 10L, SEEK_SET); /* try to seek on unopened stream */ if (!i) goto Fail; i = fseek (f1, 10L, SEEK_CUR); if (!i) goto Fail; i = fseek (f1, 10L, SEEK_END); if (!i) goto Fail; printf ("Passed Deviance Test 17.5.0.1\n"); return; Fail: printf ("Failed Deviance Test 17.5.0.1\n"); } \ No newline at end of file +/* Deviance Test 17.5.0.1: Ensure illegal parameters passed to fseek are */ +/* detected */ + +#include +#include + +main () + { + FILE *f1; + int i, j; + + i = fseek (f1, 10L, SEEK_SET); /* try to seek on unopened stream */ + if (!i) + goto Fail; + i = fseek (f1, 10L, SEEK_CUR); + if (!i) + goto Fail; + i = fseek (f1, 10L, SEEK_END); + if (!i) + goto Fail; + + printf ("Passed Deviance Test 17.5.0.1\n"); + return; + +Fail: + printf ("Failed Deviance Test 17.5.0.1\n"); + } diff --git a/Tests/Spec.Deviance/SPD17.5.0.2.CC b/Tests/Spec.Deviance/SPD17.5.0.2.CC old mode 100755 new mode 100644 index 5e4aa85..1fa941f --- a/Tests/Spec.Deviance/SPD17.5.0.2.CC +++ b/Tests/Spec.Deviance/SPD17.5.0.2.CC @@ -1 +1,23 @@ -/* Deviance Test 17.5.0.2: Ensure illegal parameters passed to ftell */ /* are detected */ #include #include main () { FILE *f1; long L1; errno = 0; L1 = ftell (f1); /* try to get current file position */ if ((L1 != -1L) || (errno == 0)) /* on unopened stream */ goto Fail; printf ("Passed Deviance Test 17.5.0.2\n"); return; Fail: printf ("Failed Deviance Test 17.5.0.2\n"); return; } \ No newline at end of file +/* Deviance Test 17.5.0.2: Ensure illegal parameters passed to ftell */ +/* are detected */ + +#include +#include + +main () + { + FILE *f1; + long L1; + + errno = 0; + L1 = ftell (f1); /* try to get current file position */ + if ((L1 != -1L) || (errno == 0)) /* on unopened stream */ + goto Fail; + + printf ("Passed Deviance Test 17.5.0.2\n"); + return; + +Fail: + printf ("Failed Deviance Test 17.5.0.2\n"); + return; + } diff --git a/Tests/Spec.Deviance/SPD17.6.0.1.CC b/Tests/Spec.Deviance/SPD17.6.0.1.CC old mode 100755 new mode 100644 index dfcbdb9..ab5042c --- a/Tests/Spec.Deviance/SPD17.6.0.1.CC +++ b/Tests/Spec.Deviance/SPD17.6.0.1.CC @@ -1 +1,21 @@ -/* Deviance Test 17.6.0.1: Ensure illegal parameters for fgetc are detected */ #include main () { FILE *f1; int i; i = fgetc (f1); /* trying to read an unopened stream */ if (i != EOF) goto Fail; if (! (feof (f1)) ) /* ensure error and not just EOF */ goto Fail; printf ("Passed Deviance Test 17.6.0.1\n"); return; Fail: printf ("Failed Deviance Test 17.6.0.1\n"); } \ No newline at end of file +/* Deviance Test 17.6.0.1: Ensure illegal parameters for fgetc are detected */ + +#include + +main () + { + FILE *f1; + int i; + + i = fgetc (f1); /* trying to read an unopened stream */ + if (i != EOF) + goto Fail; + if (! (feof (f1)) ) /* ensure error and not just EOF */ + goto Fail; + + printf ("Passed Deviance Test 17.6.0.1\n"); + return; + +Fail: + printf ("Failed Deviance Test 17.6.0.1\n"); + } diff --git a/Tests/Spec.Deviance/SPD17.6.0.2.CC b/Tests/Spec.Deviance/SPD17.6.0.2.CC old mode 100755 new mode 100644 index 24458ea..2741f5d --- a/Tests/Spec.Deviance/SPD17.6.0.2.CC +++ b/Tests/Spec.Deviance/SPD17.6.0.2.CC @@ -1 +1,21 @@ -/* Deviance Test 17.6.0.2: Ensure illegal parameters for getc are detected */ #include main () { FILE *f1; int i; i = getc (f1); /* try to read from closed stream */ if (i != EOF) goto Fail; if (! (feof (f1)) ) goto Fail; printf ("Passed Deviance Test 17.6.0.2\n"); return; Fail: printf ("Failed Deviance Test 17.6.0.2\n"); } \ No newline at end of file +/* Deviance Test 17.6.0.2: Ensure illegal parameters for getc are detected */ + +#include + +main () + { + FILE *f1; + int i; + + i = getc (f1); /* try to read from closed stream */ + if (i != EOF) + goto Fail; + if (! (feof (f1)) ) + goto Fail; + + printf ("Passed Deviance Test 17.6.0.2\n"); + return; + +Fail: + printf ("Failed Deviance Test 17.6.0.2\n"); + } diff --git a/Tests/Spec.Deviance/SPD17.6.0.3.CC b/Tests/Spec.Deviance/SPD17.6.0.3.CC old mode 100755 new mode 100644 index 57d4b33..cc9c12e --- a/Tests/Spec.Deviance/SPD17.6.0.3.CC +++ b/Tests/Spec.Deviance/SPD17.6.0.3.CC @@ -1 +1,22 @@ -/* Deviance Test 17.6.0.3: Ensure illegal parameters for ungetc are detected */ #include FILE *f1; int i; main () { i = ungetc ('a', f1); /* trying to read an unopened stream */ if (i != EOF) goto Fail; if (! (feof (f1)) ) /* ensure error and not just EOF */ goto Fail; printf ("Passed Deviance Test 17.6.0.3\n"); return; Fail: printf ("Failed Deviance Test 17.6.0.3\n"); } \ No newline at end of file +/* Deviance Test 17.6.0.3: Ensure illegal parameters for ungetc are detected */ + +#include + +FILE *f1; +int i; + +main () + { + + i = ungetc ('a', f1); /* trying to read an unopened stream */ + if (i != EOF) + goto Fail; + if (! (feof (f1)) ) /* ensure error and not just EOF */ + goto Fail; + + printf ("Passed Deviance Test 17.6.0.3\n"); + return; + +Fail: + printf ("Failed Deviance Test 17.6.0.3\n"); + } diff --git a/Tests/Spec.Deviance/SPD17.7.0.1.CC b/Tests/Spec.Deviance/SPD17.7.0.1.CC old mode 100755 new mode 100644 index afb11db..494b8c3 --- a/Tests/Spec.Deviance/SPD17.7.0.1.CC +++ b/Tests/Spec.Deviance/SPD17.7.0.1.CC @@ -1 +1,23 @@ -/* Deviance Test 17.7.0.1: Ensure illegal parameters for fgets are detected */ #include FILE *f1; char string [80], *s; int i; main () { s = fgets (string, 90, f1); /* trying to read an unopened stream */ if (s != NULL) goto Fail; if (! (feof (f1)) ) /* ensure error and not just EOF */ goto Fail; printf ("Passed Deviance Test 17.7.0.1\n"); return; Fail: printf ("Failed Deviance Test 17.7.0.1\n"); } \ No newline at end of file +/* Deviance Test 17.7.0.1: Ensure illegal parameters for fgets are detected */ + +#include + +FILE *f1; +char string [80], *s; +int i; + +main () + { + + s = fgets (string, 90, f1); /* trying to read an unopened stream */ + if (s != NULL) + goto Fail; + if (! (feof (f1)) ) /* ensure error and not just EOF */ + goto Fail; + + printf ("Passed Deviance Test 17.7.0.1\n"); + return; + +Fail: + printf ("Failed Deviance Test 17.7.0.1\n"); + } diff --git a/Tests/Spec.Deviance/TEST b/Tests/Spec.Deviance/TEST old mode 100755 new mode 100644 index a773a55..a80b289 --- a/Tests/Spec.Deviance/TEST +++ b/Tests/Spec.Deviance/TEST @@ -1 +1,4 @@ -echo {1} cmpl {1} keep=3/t >3/tt unset exit 3/t \ No newline at end of file +echo {1} +cmpl {1} keep=3/t >3/tt +unset exit +3/t diff --git a/backup b/backup old mode 100755 new mode 100644 index ef53042..b296dc8 --- a/backup +++ b/backup @@ -1 +1,33 @@ -if "{#}" != "1" echo Form: backup [day] exit 65535 end set dest /library/mike/{1}/cc set list make make2 smake linkit linkit2 count backup cc.notes set list {list} CC.pas CC.rez CC.rez2 set list {list} CCommon.pas CCommon.asm CCommon.macros set list {list} MM.pas MM.asm MM.macros set list {list} Table.pas Table.asm Table.macros set list {list} Symbol.pas Symbol.Print Symbol.asm Symbol.macros set list {list} Scanner.pas Scanner.debug Scanner.asm Scanner.macros set list {list} Asm.pas set list {list} Expression.pas Expression.asm Exp.macros set list {list} Parser.pas set list {list} CGC.pas CGC.asm CGC.macros set list {list} CGI.pas CGI.Comments CGI.Debug set list {list} ObjOut.pas ObjOut.asm ObjOut2.pas ObjOut2.asm ObjOut.macros set list {list} Native.pas Native2.pas Native.asm Native.macros set list {list} DAG.pas DAG2.pas set list {list} Gen.pas set list {list} Header.pas Header2.pas unset exit create {dest} >.null >&.null for i in {list} newer {dest}/{i} {i} if {Status} != 0 copy -c {i} {dest}/{i} end end \ No newline at end of file +if "{#}" != "1" + echo Form: backup [day] + exit 65535 +end + +set dest /library/mike/{1}/cc + +set list make make2 smake linkit linkit2 count backup cc.notes +set list {list} CC.pas CC.rez CC.rez2 +set list {list} CCommon.pas CCommon.asm CCommon.macros +set list {list} MM.pas MM.asm MM.macros +set list {list} Table.pas Table.asm Table.macros +set list {list} Symbol.pas Symbol.Print Symbol.asm Symbol.macros +set list {list} Scanner.pas Scanner.debug Scanner.asm Scanner.macros +set list {list} Asm.pas +set list {list} Expression.pas Expression.asm Exp.macros +set list {list} Parser.pas +set list {list} CGC.pas CGC.asm CGC.macros +set list {list} CGI.pas CGI.Comments CGI.Debug +set list {list} ObjOut.pas ObjOut.asm ObjOut2.pas ObjOut2.asm ObjOut.macros +set list {list} Native.pas Native2.pas Native.asm Native.macros +set list {list} DAG.pas DAG2.pas +set list {list} Gen.pas +set list {list} Header.pas Header2.pas + +unset exit +create {dest} >.null >&.null +for i in {list} + newer {dest}/{i} {i} + if {Status} != 0 + copy -c {i} {dest}/{i} + end +end diff --git a/bin/Libraries/ORCACDefs/ace.h b/bin/Libraries/ORCACDefs/ace.h index 053ffc8..a8470b5 100644 --- a/bin/Libraries/ORCACDefs/ace.h +++ b/bin/Libraries/ORCACDefs/ace.h @@ -1 +1,46 @@ -/******************************************** * * Audio Compression and Expansion Tool Set * * Copyright Apple Computer, Inc.1986-91 * All Rights Reserved * * Copyright 1992, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __ACE__ #define __ACE__ /* Error Codes */ #define aceNoError 0x0000 #define aceIsActive 0x1D01 #define aceBadDP 0x1D02 #define aceNotActive 0x1D03 #define aceNoSuchParam 0x1D04 #define aceBadMethod 0x1D05 #define aceBadSrc 0x1D06 #define aceBadDest 0x1D07 #define aceDataOverlap 0x1D08 #define aceNotImplemented 0x1DFF extern pascal void ACEBootInit(void) inline(0x011D,dispatcher); extern pascal void ACEStartUp(Word) inline(0x021D,dispatcher); extern pascal void ACEShutDown(void) inline(0x031D,dispatcher); extern pascal Word ACEVersion(void) inline(0x041D,dispatcher); extern pascal void ACEReset(void) inline(0x051D,dispatcher); extern pascal Boolean ACEStatus(void) inline(0x061D,dispatcher); extern pascal LongWord ACEInfo(Word) inline(0x071D,dispatcher); extern pascal void ACECompBegin(void) inline(0x0B1D,dispatcher); extern pascal void ACECompress(Handle, Long, Handle, Long, Word, Word) inline(0x091D,dispatcher); extern pascal void ACEExpand(Handle, Long, Handle, Long, Word, Word) inline(0x0A1D,dispatcher); extern pascal void ACEExpBegin(void) inline(0x0C1D,dispatcher); extern pascal void GetACEExpState(Ptr) inline(0x0D1D,dispatcher); extern pascal void SetACEExpState(Ptr) inline(0x0E1D,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Audio Compression and Expansion Tool Set +* +* Copyright Apple Computer, Inc.1986-91 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __ACE__ +#define __ACE__ + +/* Error Codes */ +#define aceNoError 0x0000 +#define aceIsActive 0x1D01 +#define aceBadDP 0x1D02 +#define aceNotActive 0x1D03 +#define aceNoSuchParam 0x1D04 +#define aceBadMethod 0x1D05 +#define aceBadSrc 0x1D06 +#define aceBadDest 0x1D07 +#define aceDataOverlap 0x1D08 +#define aceNotImplemented 0x1DFF + +extern pascal void ACEBootInit(void) inline(0x011D,dispatcher); +extern pascal void ACEStartUp(Word) inline(0x021D,dispatcher); +extern pascal void ACEShutDown(void) inline(0x031D,dispatcher); +extern pascal Word ACEVersion(void) inline(0x041D,dispatcher); +extern pascal void ACEReset(void) inline(0x051D,dispatcher); +extern pascal Boolean ACEStatus(void) inline(0x061D,dispatcher); +extern pascal LongWord ACEInfo(Word) inline(0x071D,dispatcher); +extern pascal void ACECompBegin(void) inline(0x0B1D,dispatcher); +extern pascal void ACECompress(Handle, Long, Handle, Long, Word, Word) inline(0x091D,dispatcher); +extern pascal void ACEExpand(Handle, Long, Handle, Long, Word, Word) inline(0x0A1D,dispatcher); +extern pascal void ACEExpBegin(void) inline(0x0C1D,dispatcher); + +extern pascal void GetACEExpState(Ptr) inline(0x0D1D,dispatcher); +extern pascal void SetACEExpState(Ptr) inline(0x0E1D,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/adb.h b/bin/Libraries/ORCACDefs/adb.h index 30a5ff7..7c0f32f 100644 --- a/bin/Libraries/ORCACDefs/adb.h +++ b/bin/Libraries/ORCACDefs/adb.h @@ -1 +1,109 @@ -/******************************************** * * Apple Desktop Bus Tool Set * * Copyright Apple Computer, Inc.1986-90 * All Rights Reserved * * Copyright 1992, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __ADB__ #define __ADB__ /* Error Codes */ #define cmndIncomplete 0x0910 /* Command not completed. */ #define cantSync 0x0911 /* Can't synchronize */ #define adbBusy 0x0982 /* Busy (command pending) */ #define devNotAtAddr 0x0983 /* Device not present at address */ #define srqListFull 0x0984 /* List full */ /* ReadKeyMicroData Codes */ #define readModes 0x000A #define readConfig 0x000B #define readADBError 0x000C #define readVersionNum 0x000D #define readAvailCharSet 0x000E #define readAvailLayout 0x000F /* SendInfo Commands */ #define abortKbd 0x0001 #define resetKbd 0x0002 #define flushKbd 0x0003 #define setModes 0x0004 /* 2nd param is pointer to mode byte */ #define clearModes 0x0005 /* 2nd param is pointer to mode Byte */ #define setConfig 0x0006 /* 2nd param is pointer to SetConfigRec */ #define synch 0x0007 /* 2nd param is pointer to SynchRec */ #define writeMicroMem 0x0008 /* 2nd param is pointer to MicroControlMemRec */ #define resetSys 0x0010 #define keyCode 0x0011 /* 2nd param is pointer to key code byte. */ #define resetADB 0x0040 #define transmitADBBytes 0x0047 /* add number of bytes to this */ #define enableSRQ 0x0050 /* ADB address in low nibble */ #define flushADBDevBuf 0x0060 /* ADB address in low nibble */ #define disableSRQ 0x0070 /* ADB address in low nibble */ #define transmit2ADBBytes 0x0080 /* add ADB address to this */ #define listen 0x0080 /* adbCommand = listen + ( 16 * reg) + (adb address) */ #define talk 0x00C0 /* adbCommand = talk + ( 16 * reg) + (adb address) */ /* Other Constants */ #define readMicroMem 0x0009 struct ReadConfigRec { Byte rcADBAddr; /* Output Byte: ADB address - keyboard and mouse */ Byte rcLayoutOrLang; /* Output Byte: Layout / Language */ Byte rcRepeatDelay; /* Output Byte: Repeat / Delay */ }; typedef struct ReadConfigRec ReadConfigRec, *ReadConfigRecPtr; struct SetConfigRec { Byte scADBAddr; /* keyboard and mouse */ Byte scLayoutOrLang; Byte scRepeatDelay; }; typedef struct SetConfigRec SetConfigRec, *SetConfigRecPtr; struct SynchRec { Byte synchMode; Byte synchKybdMouseAddr; Byte synchLayoutOrLang; Byte synchRepeatDelay; }; typedef struct SynchRec SynchRec, *SynchRecPtr; struct ScaleRec { Word xDivide; Word yDivide; Word xOffset; Word yOffset; Word xMultiply; Word yMultiply; } ; typedef struct ScaleRec ScaleRec, *ScaleRecPtr; extern pascal void ADBBootInit(void) inline(0x0109,dispatcher); extern pascal void ADBStartUp(void) inline(0x0209,dispatcher); extern pascal void ADBShutDown(void) inline(0x0309,dispatcher); extern pascal Word ADBVersion(void) inline(0x0409,dispatcher); extern pascal void ADBReset(void) inline(0x0509,dispatcher); extern pascal Boolean ADBStatus(void) inline(0x0609,dispatcher); extern pascal void AbsOn(void) inline(0x0F09,dispatcher); extern pascal void AbsOff(void) inline(0x1009,dispatcher); extern pascal void AsyncADBReceive(Pointer, Word) inline(0x0D09,dispatcher); extern pascal void ClearSRQTable(void) inline(0x1609,dispatcher); extern pascal void GetAbsScale(ScaleRecPtr) inline(0x1309,dispatcher); extern pascal Word ReadAbs(void) inline(0x1109,dispatcher); extern pascal void ReadKeyMicroData(Word, Pointer, Word) inline(0x0A09,dispatcher); extern pascal void ReadKeyMicroMemory(Pointer, Pointer, Word) inline(0x0B09,dispatcher); extern pascal void SendInfo(Word, Pointer, Word) inline(0x0909,dispatcher); extern pascal void SetAbsScale(ScaleRecPtr) inline(0x1209,dispatcher); extern pascal void SRQPoll(Pointer, Word) inline(0x1409,dispatcher); extern pascal void SRQRemove(Word) inline(0x1509,dispatcher); extern pascal void SyncADBReceive(Word, Pointer, Word) inline(0x0E09,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Apple Desktop Bus Tool Set +* +* Copyright Apple Computer, Inc.1986-90 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __ADB__ +#define __ADB__ + +/* Error Codes */ +#define cmndIncomplete 0x0910 /* Command not completed. */ +#define cantSync 0x0911 /* Can't synchronize */ +#define adbBusy 0x0982 /* Busy (command pending) */ +#define devNotAtAddr 0x0983 /* Device not present at address */ +#define srqListFull 0x0984 /* List full */ + +/* ReadKeyMicroData Codes */ +#define readModes 0x000A +#define readConfig 0x000B +#define readADBError 0x000C +#define readVersionNum 0x000D +#define readAvailCharSet 0x000E +#define readAvailLayout 0x000F + +/* SendInfo Commands */ +#define abortKbd 0x0001 +#define resetKbd 0x0002 +#define flushKbd 0x0003 +#define setModes 0x0004 /* 2nd param is pointer to mode byte */ +#define clearModes 0x0005 /* 2nd param is pointer to mode Byte */ +#define setConfig 0x0006 /* 2nd param is pointer to SetConfigRec */ +#define synch 0x0007 /* 2nd param is pointer to SynchRec */ +#define writeMicroMem 0x0008 /* 2nd param is pointer to MicroControlMemRec */ +#define resetSys 0x0010 +#define keyCode 0x0011 /* 2nd param is pointer to key code byte. */ +#define resetADB 0x0040 +#define transmitADBBytes 0x0047 /* add number of bytes to this */ +#define enableSRQ 0x0050 /* ADB address in low nibble */ +#define flushADBDevBuf 0x0060 /* ADB address in low nibble */ +#define disableSRQ 0x0070 /* ADB address in low nibble */ +#define transmit2ADBBytes 0x0080 /* add ADB address to this */ +#define listen 0x0080 /* adbCommand = listen + ( 16 * reg) + (adb address) */ +#define talk 0x00C0 /* adbCommand = talk + ( 16 * reg) + (adb address) */ + +/* Other Constants */ +#define readMicroMem 0x0009 + +struct ReadConfigRec { + Byte rcADBAddr; /* Output Byte: ADB address - keyboard and mouse */ + Byte rcLayoutOrLang; /* Output Byte: Layout / Language */ + Byte rcRepeatDelay; /* Output Byte: Repeat / Delay */ + }; +typedef struct ReadConfigRec ReadConfigRec, *ReadConfigRecPtr; + +struct SetConfigRec { + Byte scADBAddr; /* keyboard and mouse */ + Byte scLayoutOrLang; + Byte scRepeatDelay; + }; +typedef struct SetConfigRec SetConfigRec, *SetConfigRecPtr; + +struct SynchRec { + Byte synchMode; + Byte synchKybdMouseAddr; + Byte synchLayoutOrLang; + Byte synchRepeatDelay; + }; +typedef struct SynchRec SynchRec, *SynchRecPtr; + +struct ScaleRec { + Word xDivide; + Word yDivide; + Word xOffset; + Word yOffset; + Word xMultiply; + Word yMultiply; +} ; +typedef struct ScaleRec ScaleRec, *ScaleRecPtr; + +extern pascal void ADBBootInit(void) inline(0x0109,dispatcher); +extern pascal void ADBStartUp(void) inline(0x0209,dispatcher); +extern pascal void ADBShutDown(void) inline(0x0309,dispatcher); +extern pascal Word ADBVersion(void) inline(0x0409,dispatcher); +extern pascal void ADBReset(void) inline(0x0509,dispatcher); +extern pascal Boolean ADBStatus(void) inline(0x0609,dispatcher); +extern pascal void AbsOn(void) inline(0x0F09,dispatcher); +extern pascal void AbsOff(void) inline(0x1009,dispatcher); +extern pascal void AsyncADBReceive(Pointer, Word) inline(0x0D09,dispatcher); +extern pascal void ClearSRQTable(void) inline(0x1609,dispatcher); +extern pascal void GetAbsScale(ScaleRecPtr) inline(0x1309,dispatcher); +extern pascal Word ReadAbs(void) inline(0x1109,dispatcher); +extern pascal void ReadKeyMicroData(Word, Pointer, Word) inline(0x0A09,dispatcher); +extern pascal void ReadKeyMicroMemory(Pointer, Pointer, Word) inline(0x0B09,dispatcher); +extern pascal void SendInfo(Word, Pointer, Word) inline(0x0909,dispatcher); +extern pascal void SetAbsScale(ScaleRecPtr) inline(0x1209,dispatcher); +extern pascal void SRQPoll(Pointer, Word) inline(0x1409,dispatcher); +extern pascal void SRQRemove(Word) inline(0x1509,dispatcher); +extern pascal void SyncADBReceive(Word, Pointer, Word) inline(0x0E09,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/appleshare.h b/bin/Libraries/ORCACDefs/appleshare.h index 61bef85..081f19a 100644 --- a/bin/Libraries/ORCACDefs/appleshare.h +++ b/bin/Libraries/ORCACDefs/appleshare.h @@ -1 +1,213 @@ -/******************************************** ; File: AppleShare.h ; ; ; Copyright Apple Computer, Inc.1986-90 ; All Rights Reserved ; ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __GSOS__ #include #endif #ifndef __APPLESHARE__ #define __APPLESHARE__ /* Command Numbers */ #define ASBufferControl 0x0001 #define ASByteRangeLock 0x0002 #define ASSpecialOpenFork 0x0003 #define ASGetPrivileges 0x0004 #define ASSetPrivileges 0x0005 #define ASUserInfo 0x0006 #define ASCopyFile 0x0007 #define ASGetUserPath 0x0008 #define ASOpenDesktop 0x0009 #define ASCloseDesktop 0x000A #define ASGetComment 0x000B #define ASSetComment 0x000C #define ASGetSrvrName 0x000D /* Error Codes */ #define appleShareNetError 0x8888 /* AppleShare Network Error */ #define unknownUser 0x007E /* specified user name not registered */ #define unknownGroup 0x007F /* specified group name not the name of a group */ /* Masks */ #define lockRange 0x8000 #define relativeToEOF 0x4000 #define seeFolders 0x01 #define seeFiles 0x02 #define makeChanges 0x0004 #define folderOwner 0x80 /* File Info Masks */ #define onDesktop 0x0001 #define bFOwnAppl 0x0002 /* used internally */ #define bFNever 0x0010 /* never SwitchLaunch */ #define bFAlways 0x0020 /* always SwitchLaunch */ #define shareApplication 0x0040 /* set if file is a shareable application */ #define fileIsInited 0x0100 /* seen by Finder */ #define fileHasChanged 0x0200 /* used internally by Finder */ #define fileIsBusy 0x0400 /* copied from File System busy bit */ #define fileNoCopy 0x0800 /* not used in 5.0 and later, formally BOZO */ #define fileIsSystem 0x1000 /* set if file is a system file */ #define fileHasBundle 0x2000 #define fileIsInvisible 0x4000 #define fileIsLocked 0x8000 /* Window Info Masks */ #define inTrashWindow 0xFFFD #define inDesktopWindow 0xFFFE #define inDiskWindow 0x0000 /* accessWord Masks */ #define requestReadAccess 0x0001 #define requestWriteAccess 0x0002 #define denyReadAccess 0x0010 #define denyWriteAccess 0x0020 /* forkNum Masks */ #define dataForkNum 0x0000 #define resourceForkNum 0x0001 /* Other Constants */ #define disableBuffering 0x8000 #define enableBuffering 0x0000 struct BufferControlRec { Word pCount; Word fstNum; Word commandNum; Word refNum; /* */ Word flags; /* */ } ; typedef struct BufferControlRec BufferControlRec, *BufferControlRecPtr; struct SpecialOpenForkRec { Word pCount; Word fstNum; Word commandNum; Word refNum; GSString255Ptr pathname; Word accessMode; Word forkNum; } ; typedef struct SpecialOpenForkRec SpecialOpenForkRec, *SpecialOpenForkRecPtr; struct ByteRangeLockRec { Word pCount; Word fstNum; Word commandNum; Word refNum; Word lockFlag; LongWord fileOffset; LongWord rangeLength; /* */ LongWord rangeStart; /* */ } ; typedef struct ByteRangeLockRec ByteRangeLockRec, *ByteRangeLockRecPtr; struct GetAccessRightsRec { Byte userSummary; Byte world; Byte group; Byte owner; } ; typedef struct GetAccessRightsRec GetAccessRightsRec, *GetAccessRightsRecPtr; struct GetPrivilegesRec { Word pCount; Word fstNum; Word commandNum; GSString255Ptr pathname; GetAccessRightsRec accessRights; ResultBuf255Ptr ownerName; ResultBuf255Ptr groupName; } ; typedef struct GetPrivilegesRec GetPrivilegesRec, *GetPrivilegesRecPtr; struct SetAccessRightsRec { Byte reserved; Byte world; Byte group; Byte owner; } ; typedef struct SetAccessRightsRec SetAccessRightsRec, *SetAccessRightsRecPtr; struct SetPrivilegesRec { Word pCount; Word fstNum; Word commandNum; GSString255Ptr pathname; SetAccessRightsRec accessRights; ResultBuf255Ptr ownerName; ResultBuf255Ptr groupName; } ; typedef struct SetPrivilegesRec SetPrivilegesRec, *SetPrivilegesRecPtr; struct UserInfoRec { Word pCount; Word fstNum; Word commandNum; Word deviceNum; ResultBuf255Ptr userName; ResultBuf255Ptr primaryGroupName; } ; typedef struct UserInfoRec UserInfoRec, *UserInfoRecPtr; struct CopyFileRec { Word pCount; Word fstNum; Word commandNum; GSString255Ptr sourcePathname; GSString255Ptr destPathname; } ; typedef struct CopyFileRec CopyFileRec, *CopyFileRecPtr; struct GetUserPathRec { Word pCount; Word fstNum; Word commandNum; GSString255Ptr prefix; } ; typedef struct GetUserPathRec GetUserPathRec, *GetUserPathRecPtr; struct DesktopRec { Word pCount; Word fstNum; Word commandNum; Word desktopRefNum; GSString255Ptr pathname; } ; typedef struct DesktopRec DesktopRec, *DesktopRecPtr; struct GetCommentRec { Word pCount; Word fstNum; Word commandNum; Word desktopRefNum; GSString255Ptr pathname; ResultBuf255Ptr comment; } ; typedef struct GetCommentRec GetCommentRec, *GetCommentRecPtr; struct SetCommentRec { Word pCount; Word fstNum; Word commandNum; Word desktopRefNum; GSString255Ptr pathname; GSString255Ptr comment; } ; typedef struct SetCommentRec SetCommentRec, *SetCommentRecPtr; struct GetServerNameRec { Word pCount; Word fstNum; Word commandNum; GSString255Ptr pathname; ResultBuf255Ptr serverName; ResultBuf255Ptr zoneName; } ; typedef struct GetServerNameRec GetServerNameRec, *GetServerNameRecPtr; struct ASOptionListRec { Word bufferSize; /* */ Word dataSize; /* */ Word theFileSysID; /* */ Byte finderInfo[32]; /* */ LongWord parentDirID; /* */ LongWord accessRights; /* */ } ; typedef struct ASOptionListRec ASOptionListRec, *ASOptionListRecPtr; #endif \ No newline at end of file +/******************************************** +; File: AppleShare.h +; +; +; Copyright Apple Computer, Inc.1986-90 +; All Rights Reserved +; +********************************************/ +#ifndef __TYPES__ +#include +#endif + +#ifndef __GSOS__ +#include +#endif + +#ifndef __APPLESHARE__ +#define __APPLESHARE__ + + +/* Command Numbers */ +#define ASBufferControl 0x0001 +#define ASByteRangeLock 0x0002 +#define ASSpecialOpenFork 0x0003 +#define ASGetPrivileges 0x0004 +#define ASSetPrivileges 0x0005 +#define ASUserInfo 0x0006 +#define ASCopyFile 0x0007 +#define ASGetUserPath 0x0008 +#define ASOpenDesktop 0x0009 +#define ASCloseDesktop 0x000A +#define ASGetComment 0x000B +#define ASSetComment 0x000C +#define ASGetSrvrName 0x000D + +/* Error Codes */ +#define appleShareNetError 0x8888 /* AppleShare Network Error */ +#define unknownUser 0x007E /* specified user name not registered */ +#define unknownGroup 0x007F /* specified group name not the name of a group */ + +/* Masks */ +#define lockRange 0x8000 +#define relativeToEOF 0x4000 +#define seeFolders 0x01 +#define seeFiles 0x02 +#define makeChanges 0x0004 +#define folderOwner 0x80 + +/* File Info Masks */ +#define onDesktop 0x0001 +#define bFOwnAppl 0x0002 /* used internally */ +#define bFNever 0x0010 /* never SwitchLaunch */ +#define bFAlways 0x0020 /* always SwitchLaunch */ +#define shareApplication 0x0040 /* set if file is a shareable application */ +#define fileIsInited 0x0100 /* seen by Finder */ +#define fileHasChanged 0x0200 /* used internally by Finder */ +#define fileIsBusy 0x0400 /* copied from File System busy bit */ +#define fileNoCopy 0x0800 /* not used in 5.0 and later, formally BOZO */ +#define fileIsSystem 0x1000 /* set if file is a system file */ +#define fileHasBundle 0x2000 +#define fileIsInvisible 0x4000 +#define fileIsLocked 0x8000 + +/* Window Info Masks */ +#define inTrashWindow 0xFFFD +#define inDesktopWindow 0xFFFE +#define inDiskWindow 0x0000 + +/* accessWord Masks */ +#define requestReadAccess 0x0001 +#define requestWriteAccess 0x0002 +#define denyReadAccess 0x0010 +#define denyWriteAccess 0x0020 + +/* forkNum Masks */ +#define dataForkNum 0x0000 +#define resourceForkNum 0x0001 + +/* Other Constants */ +#define disableBuffering 0x8000 +#define enableBuffering 0x0000 +struct BufferControlRec { + Word pCount; + Word fstNum; + Word commandNum; + Word refNum; /* */ + Word flags; /* */ +} ; +typedef struct BufferControlRec BufferControlRec, *BufferControlRecPtr; +struct SpecialOpenForkRec { + Word pCount; + Word fstNum; + Word commandNum; + Word refNum; + GSString255Ptr pathname; + Word accessMode; + Word forkNum; +} ; +typedef struct SpecialOpenForkRec SpecialOpenForkRec, *SpecialOpenForkRecPtr; +struct ByteRangeLockRec { + Word pCount; + Word fstNum; + Word commandNum; + Word refNum; + Word lockFlag; + LongWord fileOffset; + LongWord rangeLength; /* */ + LongWord rangeStart; /* */ +} ; +typedef struct ByteRangeLockRec ByteRangeLockRec, *ByteRangeLockRecPtr; +struct GetAccessRightsRec { + Byte userSummary; + Byte world; + Byte group; + Byte owner; +} ; +typedef struct GetAccessRightsRec GetAccessRightsRec, *GetAccessRightsRecPtr; +struct GetPrivilegesRec { + Word pCount; + Word fstNum; + Word commandNum; + GSString255Ptr pathname; + GetAccessRightsRec accessRights; + ResultBuf255Ptr ownerName; + ResultBuf255Ptr groupName; +} ; +typedef struct GetPrivilegesRec GetPrivilegesRec, *GetPrivilegesRecPtr; +struct SetAccessRightsRec { + Byte reserved; + Byte world; + Byte group; + Byte owner; +} ; +typedef struct SetAccessRightsRec SetAccessRightsRec, *SetAccessRightsRecPtr; +struct SetPrivilegesRec { + Word pCount; + Word fstNum; + Word commandNum; + GSString255Ptr pathname; + SetAccessRightsRec accessRights; + ResultBuf255Ptr ownerName; + ResultBuf255Ptr groupName; +} ; +typedef struct SetPrivilegesRec SetPrivilegesRec, *SetPrivilegesRecPtr; +struct UserInfoRec { + Word pCount; + Word fstNum; + Word commandNum; + Word deviceNum; + ResultBuf255Ptr userName; + ResultBuf255Ptr primaryGroupName; +} ; +typedef struct UserInfoRec UserInfoRec, *UserInfoRecPtr; +struct CopyFileRec { + Word pCount; + Word fstNum; + Word commandNum; + GSString255Ptr sourcePathname; + GSString255Ptr destPathname; +} ; +typedef struct CopyFileRec CopyFileRec, *CopyFileRecPtr; +struct GetUserPathRec { + Word pCount; + Word fstNum; + Word commandNum; + GSString255Ptr prefix; +} ; +typedef struct GetUserPathRec GetUserPathRec, *GetUserPathRecPtr; +struct DesktopRec { + Word pCount; + Word fstNum; + Word commandNum; + Word desktopRefNum; + GSString255Ptr pathname; +} ; +typedef struct DesktopRec DesktopRec, *DesktopRecPtr; +struct GetCommentRec { + Word pCount; + Word fstNum; + Word commandNum; + Word desktopRefNum; + GSString255Ptr pathname; + ResultBuf255Ptr comment; +} ; +typedef struct GetCommentRec GetCommentRec, *GetCommentRecPtr; +struct SetCommentRec { + Word pCount; + Word fstNum; + Word commandNum; + Word desktopRefNum; + GSString255Ptr pathname; + GSString255Ptr comment; +} ; +typedef struct SetCommentRec SetCommentRec, *SetCommentRecPtr; +struct GetServerNameRec { + Word pCount; + Word fstNum; + Word commandNum; + GSString255Ptr pathname; + ResultBuf255Ptr serverName; + ResultBuf255Ptr zoneName; +} ; +typedef struct GetServerNameRec GetServerNameRec, *GetServerNameRecPtr; +struct ASOptionListRec { + Word bufferSize; /* */ + Word dataSize; /* */ + Word theFileSysID; /* */ + Byte finderInfo[32]; /* */ + LongWord parentDirID; /* */ + LongWord accessRights; /* */ +} ; +typedef struct ASOptionListRec ASOptionListRec, *ASOptionListRecPtr; +#endif diff --git a/bin/Libraries/ORCACDefs/assert.h b/bin/Libraries/ORCACDefs/assert.h index 2cef299..8a9ec39 100644 --- a/bin/Libraries/ORCACDefs/assert.h +++ b/bin/Libraries/ORCACDefs/assert.h @@ -1 +1,23 @@ -/**************************************************************** * * assert.h - debugging facilities * * February 1989 * Mike Westerfield * * Copyright 1989,1990, 1996 * Byte Works, Inc. * ****************************************************************/ #ifdef assert #undef assert #endif extern void __assert(char *, int, char *); #ifndef NDEBUG #define assert(expression) (expression) ? ((void) 0) : (__assert(__FILE__, __LINE__, #expression)) #else #define assert(expression) ((void) 0) #endif \ No newline at end of file +/**************************************************************** +* +* assert.h - debugging facilities +* +* February 1989 +* Mike Westerfield +* +* Copyright 1989,1990, 1996 +* Byte Works, Inc. +* +****************************************************************/ + +#ifdef assert +#undef assert +#endif + +extern void __assert(char *, int, char *); + +#ifndef NDEBUG +#define assert(expression) (expression) ? ((void) 0) : (__assert(__FILE__, __LINE__, #expression)) +#else +#define assert(expression) ((void) 0) +#endif diff --git a/bin/Libraries/ORCACDefs/control.h b/bin/Libraries/ORCACDefs/control.h index 7f7332d..8e011a5 100644 --- a/bin/Libraries/ORCACDefs/control.h +++ b/bin/Libraries/ORCACDefs/control.h @@ -1 +1,429 @@ -/******************************************** * * Control Manager * * Copyright Apple Computer, Inc.1986-91 * All Rights Reserved * * Copyright 1992, 1993, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __CONTROL__ #define __CONTROL__ /* Axis Parameters */ #define noConstraint 0x0000 /* No constraint on movement. */ #define hAxisOnly 0x0001 /* Horizontal axis only. */ #define vAxisOnly 0x0002 /* Vertical axis only. */ /* CtlFlag */ #define simpRound 0x0000 /* Simple button flag */ #define upFlag 0x0001 /* Scroll bar flag. */ #define boldButton 0x0001 /* Bold round cornered outlined button. */ #define simpBRound 0x0001 /* Simple button flag */ #define downFlag 0x0002 /* Scroll bar flag. */ #define simpSquare 0x0002 /* Simple button flag */ #define simpDropSquare 0x0003 /* Simple button flag */ #define leftFlag 0x0004 /* Scroll bar flag. */ #define rightFlag 0x0008 /* Scroll bar flag. */ #define dirScroll 0x0010 /* Scroll bar flag. */ #define horScroll 0x0010 /* Scroll bar flag. */ #define family 0x007F /* Mask for radio button family number */ #define ctlInVis 0x0080 /* invisible mask for any type of control */ #define fCallWindowMgr 0x0001 /* Control Template flag value */ #define fSubstituteText 0x0002 #define fSubTextType 0x0001 #define inListBox 0x88 #define fBlastText 0x0004 /* static text control */ #define fTextCanDim 0x0008 /* static text control */ #define fSquishText 0x0010 /* static text control */ #define fNoTrackIcon 0x0008 /* make Icon Button play dead */ /* CtlProc Codes */ #define simpleProc 0x00000000L #define checkProc 0x02000000L #define radioProc 0x04000000L #define scrollProc 0x06000000L #define growProc 0x08000000L /* DefProc Commands */ #define drawCtl 0x0000 /* Draw control command. */ #define calcCRect 0x0001 /* Compute drag RECT command. */ #define testCtl 0x0002 /* Hit test command. */ #define initCtl 0x0003 /* Initialize command. */ #define dispCtl 0x0004 /* Dispose command. */ #define posCtl 0x0005 /* Move indicator command. */ #define thumbCtl 0x0006 /* Compute drag parameters command. */ #define dragCtl 0x0007 /* Drag command. */ #define autoTrack 0x0008 /* Action command. */ #define newValue 0x0009 /* Set new value command. */ #define setParams 0x000A /* Set new parameters command. */ #define moveCtl 0x000B /* Move command. */ #define recSize 0x000C /* Return record size command. */ #define ctlHandleEvent 0x000D /* Handle a keystroke or menu selection */ #define ctlChangeTarget 0x000E /* Issued when control's target status has changed */ #define ctlChangeBounds 0x000F /* Issued when control's boundary rectangle has changed */ #define ctlWindChangeSize 0x0010 /* Window has been grown or zoomed */ #define ctlHandleTab 0x0011 /* Control has been tabbed to */ #define ctlNotifyMultiPart 0x0012 /* A multipart control has been hidden, drawn or shown */ #define ctlWinStateChange 0x0013 /* Window state has changed */ /* hiliteState Codes */ #define noHilite 0x0000 /* Param to HiliteControl */ #define inactiveHilite 0x00FF /* Param to HiliteControl */ /* PartCode Numbers */ #define noPart 0x0000 #define simpleButton 0x0002 #define checkBox 0x0003 #define radioButton 0x0004 #define upArrow 0x0005 #define downArrow 0x0006 #define pageUp 0x0007 #define pageDown 0x0008 #define growBox 0x000A #define thumb 0x0081 /* moreFlags Codes */ #define fCtlTarget 0x8000 /* is current target of typing commands */ #define fCtlCanBeTarget 0x4000 /* can be made the target control */ #define fCtlWantEvent 0x2000 /* control can be called view SendEventToCtl */ #define fCtlWantsEvent 0x2000 /* control can be called view SendEventToCtl */ #define fCtlWantEvents 0x2000 /* control can be called view SendEventToCtl */ #define fCtlWantsEvents 0x2000 /* control can be called view SendEventToCtl */ #define fCtlProcRefNotPtr 0x1000 /* set = ID of defproc, clear = pointer to defproc */ #define fCtlTellAboutSize 0x0800 /* set if ctl needs notification when size of owning window changes */ #define fCtlIsMultiPart 0x0400 /* set if ctl needs notification to be hidden */ #define fMenuDefIsText 0x0004 #define fDrawIconInResult 0x0020 #define fDrawPopDownIcon 0x0080 #define colorDescriptor 0x000C /* indicates type of reference in colorRef */ #define styleDescriptor 0x0003 /* indicates type of reference in styleRef */ /* Ctl Verbs */ #define titleIsPtr 0x00 #define titleIsHandle 0x01 #define titleIsResource 0x02 #define colorTableIsPtr 0x00 #define colorTableIsHandle 0x04 #define colorTableIsResource 0x08 #define ctlHideCtl 0x12 /* InputVerb Codes */ #define singlePtr 0x0000 #define singleHandle 0x0001 #define singleResource 0x0002 #define ptrToPtr 0x0003 #define ptrToHandle 0x0004 #define ptrToResource 0x0005 #define handleToPtr 0x0006 #define handleToHandle 0x0007 #define handleToResource 0x0008 #define resourceToResource 0x0009 /* ProcRefs */ #define simpleButtonControl 0x80000000L #define checkControl 0x82000000L #define radioControl 0x84000000L #define scrollBarControl 0x86000000L #define growControl 0x88000000L #define statTextControl 0x81000000L #define editLineControl 0x83000000L #define editTextControl 0x85000000L #define popUpControl 0x87000000L #define listControl 0x89000000L #define pictureControl 0x8D000000L #define iconButtonControl 0x87FF0001L #define thermometerControl 0x87FF0002L #define rectangleControl 0x87FF0003L /* Error Codes */ #define wmNotStartedUp 0x1001 /* Window manager was not initialized */ #define cmNotInitialized 0x1002 /* Control manager was not initialized */ #define noCtlInList 0x1003 /* Control not in window list */ #define noCtlError 0x1004 /* no controls in window */ #define noSuperCtlError 0x1005 /* no super controls in window */ #define noCtlTargetError 0x1006 /* no target super control */ #define notSuperCtlError 0x1007 /* action can only be done on super control */ #define canNotBeTargetError 0x1008 /* conrol cannot be made target */ #define noSuchIDError 0x1009 /* specified ID cannot be found */ #define tooFewParmsError 0x100A /* not enough params specified */ #define noCtlToBeTargetError 0x100B /* NextCtl call, no ctl could be target */ #define noFrontWindowError 0x100C /* there is no front window */ /* displayMode flags */ #define selectedIcon 0x0001 #define openIcon 0x0002 #define offline 0x0004 /* listType values */ #define fListString 0x0001 #define fListSelect 0x0002 #define fListScrollBar 0x0004 /* PopUp control flag values */ #define fRightJustifyResult 0x0001 #define fRightJustifyTitle 0x0002 #define fInWindowOnly 0x0004 #define fDontDrawResult 0x0008 #define fDontDrawTitle 0x0010 #define fDontHiliteTitle 0x0020 #define fType2PopUp 0x0040 struct BoxColors { Word boxReserved; /* reserved */ Word boxNor; /* color of box when not checked */ Word boxSel; /* color of box when checked */ Word boxTitle; /* color of check box's title */ }; typedef struct BoxColors BoxColors, *BoxColorsPtr, **BoxColorsHndl; struct BttnColors { Word bttnOutline; /* color of outline */ Word bttnNorBack; /* color of background when not selected */ Word bttnSelBack; /* color of background when selected */ Word bttnNorText; /* color of title's text when not selected */ Word bttnSelText; /* color of title's text when selected */ }; typedef struct BttnColors BttnColors, *BttnColorsPtr, **BttnColorsHndl; struct LimitBlk { Rect boundRect; /* Drag bounds. */ Rect slopRect; /* Cursor bounds. */ Word axisParam; /* Movement constrains. */ Pointer dragPatt; /* Pointer to 32 byte Pattern for drag outline. */ }; typedef struct LimitBlk LimitBlk, *LimitBlkPtr, **LimitBlkHndl; struct RadioColors { Word radReserved; /* reserved */ Word radNor; /* color of radio button when off */ Word radSel; /* color of radio button when on */ Word radTitle; /* color of radio button's title text */ }; typedef struct RadioColors RadioColors, *RadioColorsPtr, **RadioColorsHndl; struct KeystrokeRec { Byte key1; Byte key2; Word keyModifiers; Word keyCareBits; }; typedef struct KeystrokeRec KeystrokeRec; struct ControlTemplate { Word pCount; LongWord ID; Rect rect; LongWord procRef; Word flag; Word moreFlags; LongWord refCon; }; typedef struct ControlTemplate ControlTemplate; struct SimpleButtonTemplate { ControlTemplate ctlTemplate; Ref titleRef; Ref colorTableRef; KeystrokeRec keyEquivalent; }; typedef struct SimpleButtonTemplate SimpleButtonTemplate; struct CheckBoxTemplate { ControlTemplate ctlTemplate; Ref titleRef; Word initalValue; Ref colorTableRef; KeystrokeRec keyEquivalent; }; typedef struct CheckBoxTemplate CheckBoxTemplate; struct IconButtonTemplate { ControlTemplate ctlTemplate; Ref iconRef; Ref titleRef; Ref colorTableRef; Word displayMode; KeystrokeRec keyEquivalent; }; typedef struct IconButtonTemplate IconButtonTemplate; struct LineEditTemplate { ControlTemplate ctlTemplate; Word maxSize; Ref defaultRef; Word passwordChar; }; typedef struct LineEditTemplate LineEditTemplate; struct ListTemplate { ControlTemplate ctlTemplate; Word listSize; Word listView; Word listType; Word listStart; ProcPtr listDraw; Word listMemHeight; Word listMemSize; Ref listRef; Ref colorTableRef; }; typedef struct ListTemplate ListTemplate; struct PictureTemplate { ControlTemplate ctlTemplate; Ref pictureRef; }; typedef struct PictureTemplate PictureTemplate; struct PopupTemplate { ControlTemplate ctlTemplate; Word titleWidth; Ref menuRef; Word initialValue; Ref colorTableRef; }; typedef struct PopupTemplate PopupTemplate; struct RadioButtonTemplate { ControlTemplate ctlTemplate; Ref titleRef; Word initalValue; Ref colorTableRef; KeystrokeRec keyEquivalent; }; typedef struct RadioButtonTemplate RadioButtonTemplate; struct RectangleTemplate { ControlTemplate ctlTemplate; Word penHeight; Word penWidth; Mask penMask; Pattern penPattern; }; typedef struct RectangleTemplate RectangleTemplate; struct ScrollBarTemplate { ControlTemplate ctlTemplate; Word maxSize; Word viewSize; Word initalValue; Ref colorTableRef; }; typedef struct ScrollBarTemplate ScrollBarTemplate; struct SizeBoxTemplate { ControlTemplate ctlTemplate; Ref colorTableRef; }; typedef struct SizeBoxTemplate SizeBoxTemplate; struct StaticTextTemplate { ControlTemplate ctlTemplate; Ref textRef; Word textSize; Word just; }; typedef struct StaticTextTemplate StaticTextTemplate; struct TextEditTemplate { ControlTemplate ctlTemplate; LongWord textFlags; Rect indentRect; CtlRecHndl vertBar; Word vertAmount; CtlRecHndl horzBar; Word horzAmount; Ref styleRef; Word textDescriptor; Ref textRef; LongWord textLength; LongWord maxChars; LongWord maxLines; Word maxCharsPerLine; Word maxHeight; Ref colorRef; Word drawMode; ProcPtr filterProcPtr; }; typedef struct TextEditTemplate TextEditTemplate; struct ThermometerTemplate { ControlTemplate ctlTemplate; Word value; Word data; Ref colorTableRef; }; typedef struct ThermometerTemplate ThermometerTemplate; extern pascal void CtlBootInit(void) inline(0x0110,dispatcher); extern pascal void CtlStartUp(Word, Word) inline(0x0210,dispatcher); extern pascal void CtlShutDown(void) inline(0x0310,dispatcher); extern pascal Word CtlVersion(void) inline(0x0410,dispatcher); extern pascal void CtlReset(void) inline(0x0510,dispatcher); extern pascal Boolean CtlStatus(void) inline(0x0610,dispatcher); extern pascal void CtlNewRes(void) inline(0x1210,dispatcher); extern pascal void DisposeControl(CtlRecHndl) inline(0x0A10,dispatcher); extern pascal void DragControl(Integer, Integer, Rect *, Rect *, Word, CtlRecHndl) inline(0x1710,dispatcher); extern pascal Point DragRect(VoidProcPtr, Pattern, Integer, Integer, Rect *, Rect *, Rect *, Word) inline(0x1D10,dispatcher); extern pascal void DrawControls(GrafPortPtr) inline(0x1010,dispatcher); extern pascal void DrawOneCtl(CtlRecHndl) inline(0x2510,dispatcher); extern pascal void EraseControl(CtlRecHndl) inline(0x2410,dispatcher); extern pascal Word FindControl(CtlRecHndl *, Integer, Integer, GrafPortPtr) inline(0x1310,dispatcher); extern pascal LongProcPtr GetCtlAction(CtlRecHndl) inline(0x2110,dispatcher); extern pascal Word GetCtlDPage(void) inline(0x1F10,dispatcher); extern pascal LongWord GetCtlParams(CtlRecHndl) inline(0x1C10,dispatcher); extern pascal LongWord GetCtlRefCon(CtlRecHndl) inline(0x2310,dispatcher); extern pascal Pointer GetCtlTitle(CtlRecHndl) inline(0x0D10,dispatcher); extern pascal Word GetCtlValue(CtlRecHndl) inline(0x1A10,dispatcher); extern pascal LongWord GrowSize(void) inline(0x1E10,dispatcher); extern pascal void HideControl(CtlRecHndl) inline(0x0E10,dispatcher); extern pascal void HiliteControl(Word, CtlRecHndl) inline(0x1110,dispatcher); extern pascal void KillControls(GrafPortPtr) inline(0x0B10,dispatcher); extern pascal void MoveControl(Integer, Integer, CtlRecHndl) inline(0x1610,dispatcher); extern pascal CtlRecHndl NewControl(GrafPortPtr, Rect *, Pointer, Word, Word, Word, Word, LongProcPtr, Longint, Pointer) inline(0x0910,dispatcher); extern pascal void SetCtlAction(LongProcPtr, CtlRecHndl) inline(0x2010,dispatcher); extern pascal FontHndl SetCtlIcons(FontHndl) inline(0x1810,dispatcher); extern pascal void SetCtlParams(Word, Word, CtlRecHndl) inline(0x1B10,dispatcher); extern pascal void SetCtlRefCon(Longint, CtlRecHndl) inline(0x2210,dispatcher); extern pascal void SetCtlTitle(Pointer, Handle) inline(0x0C10,dispatcher); extern pascal void SetCtlValue(Word, CtlRecHndl) inline(0x1910,dispatcher); extern pascal void ShowControl(CtlRecHndl) inline(0x0F10,dispatcher); extern pascal Word TestControl(Integer, Integer, CtlRecHndl) inline(0x1410,dispatcher); extern pascal Word TrackControl(Integer, Integer, LongProcPtr, CtlRecHndl) inline(0x1510,dispatcher); extern pascal LongWord CallCtlDefProc(CtlRecHndl, Word, Long) inline(0x2C10,dispatcher); extern pascal Handle CMLoadResource(Word, Long) inline(0x3210,dispatcher); extern pascal void CMReleaseResource(Word, Long) inline(0x3310,dispatcher); extern pascal CtlRecHndl FindTargetCtl(void) inline(0x2610,dispatcher); extern pascal CtlRecHndl GetCtlHandleFromID(WindowPtr, Long) inline(0x3010,dispatcher); extern pascal LongWord GetCtlID(CtlRecHndl) inline(0x2A10,dispatcher); extern pascal Word GetCtlMoreFlags(CtlRecHndl) inline(0x2E10,dispatcher); extern pascal Pointer GetCtlParamPtr(void) inline(0x3510,dispatcher); extern pascal void InvalCtls(WindowPtr) inline(0x3710,dispatcher); extern pascal CtlRecHndl MakeNextCtlTarget(void) inline(0x2710,dispatcher); extern pascal void MakeThisCtlTarget(CtlRecHndl) inline(0x2810,dispatcher); extern pascal CtlRecHndl NewControl2(WindowPtr, Word, Ref) inline(0x3110,dispatcher); extern pascal void NotifyControls(Word, Word, Long, WindowPtr) inline(0x2D10,dispatcher); extern pascal void NotifyCtls(Word, Word, Long, WindowPtr) inline(0x2D10,dispatcher); extern pascal Boolean SendEventToCtl(Boolean, WindowPtr, EventRecordPtr) inline(0x2910,dispatcher); extern pascal void SetCtlID(Long, CtlRecHndl) inline(0x2B10,dispatcher); extern pascal void SetCtlMoreFlags(Word, CtlRecHndl) inline(0x2F10,dispatcher); extern pascal void SetCtlParamPtr(Pointer) inline(0x3410,dispatcher); extern pascal Word FindRadioButton(WindowPtr, Word) inline(0x3910,dispatcher); extern pascal void GetLETextByID(WindowPtr, Long, StringPtr) inline(0x3B10,dispatcher); extern pascal void SetLETextByID(WindowPtr, Long, StringPtr) inline(0x3A10,dispatcher); extern pascal void SetCtlValueByID(Word, GrafPortPtr, Long) inline(0x3C10,dispatcher); extern pascal Word GetCtlValueByID(GrafPortPtr, Long) inline(0x3D10,dispatcher); extern pascal void InvalOneCtlByID(GrafPortPtr, Long) inline(0x3E10,dispatcher); extern pascal void HiliteCtlByID(Word, GrafPortPtr, Long) inline(0x3F10,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Control Manager +* +* Copyright Apple Computer, Inc.1986-91 +* All Rights Reserved +* +* Copyright 1992, 1993, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __CONTROL__ +#define __CONTROL__ + +/* Axis Parameters */ +#define noConstraint 0x0000 /* No constraint on movement. */ +#define hAxisOnly 0x0001 /* Horizontal axis only. */ +#define vAxisOnly 0x0002 /* Vertical axis only. */ + +/* CtlFlag */ +#define simpRound 0x0000 /* Simple button flag */ +#define upFlag 0x0001 /* Scroll bar flag. */ +#define boldButton 0x0001 /* Bold round cornered outlined button. */ +#define simpBRound 0x0001 /* Simple button flag */ +#define downFlag 0x0002 /* Scroll bar flag. */ +#define simpSquare 0x0002 /* Simple button flag */ +#define simpDropSquare 0x0003 /* Simple button flag */ +#define leftFlag 0x0004 /* Scroll bar flag. */ +#define rightFlag 0x0008 /* Scroll bar flag. */ +#define dirScroll 0x0010 /* Scroll bar flag. */ +#define horScroll 0x0010 /* Scroll bar flag. */ +#define family 0x007F /* Mask for radio button family number */ +#define ctlInVis 0x0080 /* invisible mask for any type of control */ +#define fCallWindowMgr 0x0001 /* Control Template flag value */ +#define fSubstituteText 0x0002 +#define fSubTextType 0x0001 +#define inListBox 0x88 +#define fBlastText 0x0004 /* static text control */ +#define fTextCanDim 0x0008 /* static text control */ +#define fSquishText 0x0010 /* static text control */ +#define fNoTrackIcon 0x0008 /* make Icon Button play dead */ + +/* CtlProc Codes */ +#define simpleProc 0x00000000L +#define checkProc 0x02000000L +#define radioProc 0x04000000L +#define scrollProc 0x06000000L +#define growProc 0x08000000L + +/* DefProc Commands */ +#define drawCtl 0x0000 /* Draw control command. */ +#define calcCRect 0x0001 /* Compute drag RECT command. */ +#define testCtl 0x0002 /* Hit test command. */ +#define initCtl 0x0003 /* Initialize command. */ +#define dispCtl 0x0004 /* Dispose command. */ +#define posCtl 0x0005 /* Move indicator command. */ +#define thumbCtl 0x0006 /* Compute drag parameters command. */ +#define dragCtl 0x0007 /* Drag command. */ +#define autoTrack 0x0008 /* Action command. */ +#define newValue 0x0009 /* Set new value command. */ +#define setParams 0x000A /* Set new parameters command. */ +#define moveCtl 0x000B /* Move command. */ +#define recSize 0x000C /* Return record size command. */ +#define ctlHandleEvent 0x000D /* Handle a keystroke or menu selection */ +#define ctlChangeTarget 0x000E /* Issued when control's target status has changed */ +#define ctlChangeBounds 0x000F /* Issued when control's boundary rectangle has changed */ +#define ctlWindChangeSize 0x0010 /* Window has been grown or zoomed */ +#define ctlHandleTab 0x0011 /* Control has been tabbed to */ +#define ctlNotifyMultiPart 0x0012 /* A multipart control has been hidden, drawn or shown */ +#define ctlWinStateChange 0x0013 /* Window state has changed */ + +/* hiliteState Codes */ +#define noHilite 0x0000 /* Param to HiliteControl */ +#define inactiveHilite 0x00FF /* Param to HiliteControl */ + +/* PartCode Numbers */ +#define noPart 0x0000 +#define simpleButton 0x0002 +#define checkBox 0x0003 +#define radioButton 0x0004 +#define upArrow 0x0005 +#define downArrow 0x0006 +#define pageUp 0x0007 +#define pageDown 0x0008 +#define growBox 0x000A +#define thumb 0x0081 + +/* moreFlags Codes */ +#define fCtlTarget 0x8000 /* is current target of typing commands */ +#define fCtlCanBeTarget 0x4000 /* can be made the target control */ +#define fCtlWantEvent 0x2000 /* control can be called view SendEventToCtl */ +#define fCtlWantsEvent 0x2000 /* control can be called view SendEventToCtl */ +#define fCtlWantEvents 0x2000 /* control can be called view SendEventToCtl */ +#define fCtlWantsEvents 0x2000 /* control can be called view SendEventToCtl */ +#define fCtlProcRefNotPtr 0x1000 /* set = ID of defproc, clear = pointer to defproc */ +#define fCtlTellAboutSize 0x0800 /* set if ctl needs notification when size of owning window changes */ +#define fCtlIsMultiPart 0x0400 /* set if ctl needs notification to be hidden */ +#define fMenuDefIsText 0x0004 +#define fDrawIconInResult 0x0020 +#define fDrawPopDownIcon 0x0080 +#define colorDescriptor 0x000C /* indicates type of reference in colorRef */ +#define styleDescriptor 0x0003 /* indicates type of reference in styleRef */ + +/* Ctl Verbs */ +#define titleIsPtr 0x00 +#define titleIsHandle 0x01 +#define titleIsResource 0x02 +#define colorTableIsPtr 0x00 +#define colorTableIsHandle 0x04 +#define colorTableIsResource 0x08 +#define ctlHideCtl 0x12 + +/* InputVerb Codes */ +#define singlePtr 0x0000 +#define singleHandle 0x0001 +#define singleResource 0x0002 +#define ptrToPtr 0x0003 +#define ptrToHandle 0x0004 +#define ptrToResource 0x0005 +#define handleToPtr 0x0006 +#define handleToHandle 0x0007 +#define handleToResource 0x0008 +#define resourceToResource 0x0009 + +/* ProcRefs */ +#define simpleButtonControl 0x80000000L +#define checkControl 0x82000000L +#define radioControl 0x84000000L +#define scrollBarControl 0x86000000L +#define growControl 0x88000000L +#define statTextControl 0x81000000L +#define editLineControl 0x83000000L +#define editTextControl 0x85000000L +#define popUpControl 0x87000000L +#define listControl 0x89000000L +#define pictureControl 0x8D000000L +#define iconButtonControl 0x87FF0001L +#define thermometerControl 0x87FF0002L +#define rectangleControl 0x87FF0003L + +/* Error Codes */ +#define wmNotStartedUp 0x1001 /* Window manager was not initialized */ +#define cmNotInitialized 0x1002 /* Control manager was not initialized */ +#define noCtlInList 0x1003 /* Control not in window list */ +#define noCtlError 0x1004 /* no controls in window */ +#define noSuperCtlError 0x1005 /* no super controls in window */ +#define noCtlTargetError 0x1006 /* no target super control */ +#define notSuperCtlError 0x1007 /* action can only be done on super control */ +#define canNotBeTargetError 0x1008 /* conrol cannot be made target */ +#define noSuchIDError 0x1009 /* specified ID cannot be found */ +#define tooFewParmsError 0x100A /* not enough params specified */ +#define noCtlToBeTargetError 0x100B /* NextCtl call, no ctl could be target */ +#define noFrontWindowError 0x100C /* there is no front window */ + +/* displayMode flags */ +#define selectedIcon 0x0001 +#define openIcon 0x0002 +#define offline 0x0004 + +/* listType values */ +#define fListString 0x0001 +#define fListSelect 0x0002 +#define fListScrollBar 0x0004 + +/* PopUp control flag values */ +#define fRightJustifyResult 0x0001 +#define fRightJustifyTitle 0x0002 +#define fInWindowOnly 0x0004 +#define fDontDrawResult 0x0008 +#define fDontDrawTitle 0x0010 +#define fDontHiliteTitle 0x0020 +#define fType2PopUp 0x0040 + +struct BoxColors { + Word boxReserved; /* reserved */ + Word boxNor; /* color of box when not checked */ + Word boxSel; /* color of box when checked */ + Word boxTitle; /* color of check box's title */ + }; +typedef struct BoxColors BoxColors, *BoxColorsPtr, **BoxColorsHndl; + +struct BttnColors { + Word bttnOutline; /* color of outline */ + Word bttnNorBack; /* color of background when not selected */ + Word bttnSelBack; /* color of background when selected */ + Word bttnNorText; /* color of title's text when not selected */ + Word bttnSelText; /* color of title's text when selected */ + }; +typedef struct BttnColors BttnColors, *BttnColorsPtr, **BttnColorsHndl; + +struct LimitBlk { + Rect boundRect; /* Drag bounds. */ + Rect slopRect; /* Cursor bounds. */ + Word axisParam; /* Movement constrains. */ + Pointer dragPatt; /* Pointer to 32 byte Pattern for drag outline. */ + }; +typedef struct LimitBlk LimitBlk, *LimitBlkPtr, **LimitBlkHndl; + +struct RadioColors { + Word radReserved; /* reserved */ + Word radNor; /* color of radio button when off */ + Word radSel; /* color of radio button when on */ + Word radTitle; /* color of radio button's title text */ + }; +typedef struct RadioColors RadioColors, *RadioColorsPtr, **RadioColorsHndl; + +struct KeystrokeRec { + Byte key1; + Byte key2; + Word keyModifiers; + Word keyCareBits; + }; +typedef struct KeystrokeRec KeystrokeRec; + +struct ControlTemplate { + Word pCount; + LongWord ID; + Rect rect; + LongWord procRef; + Word flag; + Word moreFlags; + LongWord refCon; + }; +typedef struct ControlTemplate ControlTemplate; + +struct SimpleButtonTemplate { + ControlTemplate ctlTemplate; + Ref titleRef; + Ref colorTableRef; + KeystrokeRec keyEquivalent; + }; +typedef struct SimpleButtonTemplate SimpleButtonTemplate; + +struct CheckBoxTemplate { + ControlTemplate ctlTemplate; + Ref titleRef; + Word initalValue; + Ref colorTableRef; + KeystrokeRec keyEquivalent; + }; +typedef struct CheckBoxTemplate CheckBoxTemplate; + +struct IconButtonTemplate { + ControlTemplate ctlTemplate; + Ref iconRef; + Ref titleRef; + Ref colorTableRef; + Word displayMode; + KeystrokeRec keyEquivalent; + }; +typedef struct IconButtonTemplate IconButtonTemplate; + +struct LineEditTemplate { + ControlTemplate ctlTemplate; + Word maxSize; + Ref defaultRef; + Word passwordChar; + }; +typedef struct LineEditTemplate LineEditTemplate; + +struct ListTemplate { + ControlTemplate ctlTemplate; + Word listSize; + Word listView; + Word listType; + Word listStart; + ProcPtr listDraw; + Word listMemHeight; + Word listMemSize; + Ref listRef; + Ref colorTableRef; + }; +typedef struct ListTemplate ListTemplate; + +struct PictureTemplate { + ControlTemplate ctlTemplate; + Ref pictureRef; + }; +typedef struct PictureTemplate PictureTemplate; + +struct PopupTemplate { + ControlTemplate ctlTemplate; + Word titleWidth; + Ref menuRef; + Word initialValue; + Ref colorTableRef; + }; +typedef struct PopupTemplate PopupTemplate; + +struct RadioButtonTemplate { + ControlTemplate ctlTemplate; + Ref titleRef; + Word initalValue; + Ref colorTableRef; + KeystrokeRec keyEquivalent; + }; +typedef struct RadioButtonTemplate RadioButtonTemplate; + +struct RectangleTemplate { + ControlTemplate ctlTemplate; + Word penHeight; + Word penWidth; + Mask penMask; + Pattern penPattern; + }; +typedef struct RectangleTemplate RectangleTemplate; + +struct ScrollBarTemplate { + ControlTemplate ctlTemplate; + Word maxSize; + Word viewSize; + Word initalValue; + Ref colorTableRef; + }; +typedef struct ScrollBarTemplate ScrollBarTemplate; + +struct SizeBoxTemplate { + ControlTemplate ctlTemplate; + Ref colorTableRef; + }; +typedef struct SizeBoxTemplate SizeBoxTemplate; + +struct StaticTextTemplate { + ControlTemplate ctlTemplate; + Ref textRef; + Word textSize; + Word just; + }; +typedef struct StaticTextTemplate StaticTextTemplate; + +struct TextEditTemplate { + ControlTemplate ctlTemplate; + LongWord textFlags; + Rect indentRect; + CtlRecHndl vertBar; + Word vertAmount; + CtlRecHndl horzBar; + Word horzAmount; + Ref styleRef; + Word textDescriptor; + Ref textRef; + LongWord textLength; + LongWord maxChars; + LongWord maxLines; + Word maxCharsPerLine; + Word maxHeight; + Ref colorRef; + Word drawMode; + ProcPtr filterProcPtr; + }; +typedef struct TextEditTemplate TextEditTemplate; + +struct ThermometerTemplate { + ControlTemplate ctlTemplate; + Word value; + Word data; + Ref colorTableRef; + }; +typedef struct ThermometerTemplate ThermometerTemplate; + +extern pascal void CtlBootInit(void) inline(0x0110,dispatcher); +extern pascal void CtlStartUp(Word, Word) inline(0x0210,dispatcher); +extern pascal void CtlShutDown(void) inline(0x0310,dispatcher); +extern pascal Word CtlVersion(void) inline(0x0410,dispatcher); +extern pascal void CtlReset(void) inline(0x0510,dispatcher); +extern pascal Boolean CtlStatus(void) inline(0x0610,dispatcher); +extern pascal void CtlNewRes(void) inline(0x1210,dispatcher); +extern pascal void DisposeControl(CtlRecHndl) inline(0x0A10,dispatcher); +extern pascal void DragControl(Integer, Integer, Rect *, Rect *, Word, CtlRecHndl) inline(0x1710,dispatcher); +extern pascal Point DragRect(VoidProcPtr, Pattern, Integer, Integer, Rect *, Rect *, Rect *, Word) inline(0x1D10,dispatcher); +extern pascal void DrawControls(GrafPortPtr) inline(0x1010,dispatcher); +extern pascal void DrawOneCtl(CtlRecHndl) inline(0x2510,dispatcher); +extern pascal void EraseControl(CtlRecHndl) inline(0x2410,dispatcher); +extern pascal Word FindControl(CtlRecHndl *, Integer, Integer, GrafPortPtr) inline(0x1310,dispatcher); +extern pascal LongProcPtr GetCtlAction(CtlRecHndl) inline(0x2110,dispatcher); +extern pascal Word GetCtlDPage(void) inline(0x1F10,dispatcher); +extern pascal LongWord GetCtlParams(CtlRecHndl) inline(0x1C10,dispatcher); +extern pascal LongWord GetCtlRefCon(CtlRecHndl) inline(0x2310,dispatcher); +extern pascal Pointer GetCtlTitle(CtlRecHndl) inline(0x0D10,dispatcher); +extern pascal Word GetCtlValue(CtlRecHndl) inline(0x1A10,dispatcher); +extern pascal LongWord GrowSize(void) inline(0x1E10,dispatcher); +extern pascal void HideControl(CtlRecHndl) inline(0x0E10,dispatcher); +extern pascal void HiliteControl(Word, CtlRecHndl) inline(0x1110,dispatcher); +extern pascal void KillControls(GrafPortPtr) inline(0x0B10,dispatcher); +extern pascal void MoveControl(Integer, Integer, CtlRecHndl) inline(0x1610,dispatcher); +extern pascal CtlRecHndl NewControl(GrafPortPtr, Rect *, Pointer, Word, Word, Word, Word, LongProcPtr, Longint, Pointer) inline(0x0910,dispatcher); +extern pascal void SetCtlAction(LongProcPtr, CtlRecHndl) inline(0x2010,dispatcher); +extern pascal FontHndl SetCtlIcons(FontHndl) inline(0x1810,dispatcher); +extern pascal void SetCtlParams(Word, Word, CtlRecHndl) inline(0x1B10,dispatcher); +extern pascal void SetCtlRefCon(Longint, CtlRecHndl) inline(0x2210,dispatcher); +extern pascal void SetCtlTitle(Pointer, Handle) inline(0x0C10,dispatcher); +extern pascal void SetCtlValue(Word, CtlRecHndl) inline(0x1910,dispatcher); +extern pascal void ShowControl(CtlRecHndl) inline(0x0F10,dispatcher); +extern pascal Word TestControl(Integer, Integer, CtlRecHndl) inline(0x1410,dispatcher); +extern pascal Word TrackControl(Integer, Integer, LongProcPtr, CtlRecHndl) inline(0x1510,dispatcher); + +extern pascal LongWord CallCtlDefProc(CtlRecHndl, Word, Long) inline(0x2C10,dispatcher); +extern pascal Handle CMLoadResource(Word, Long) inline(0x3210,dispatcher); +extern pascal void CMReleaseResource(Word, Long) inline(0x3310,dispatcher); +extern pascal CtlRecHndl FindTargetCtl(void) inline(0x2610,dispatcher); +extern pascal CtlRecHndl GetCtlHandleFromID(WindowPtr, Long) inline(0x3010,dispatcher); +extern pascal LongWord GetCtlID(CtlRecHndl) inline(0x2A10,dispatcher); +extern pascal Word GetCtlMoreFlags(CtlRecHndl) inline(0x2E10,dispatcher); +extern pascal Pointer GetCtlParamPtr(void) inline(0x3510,dispatcher); +extern pascal void InvalCtls(WindowPtr) inline(0x3710,dispatcher); +extern pascal CtlRecHndl MakeNextCtlTarget(void) inline(0x2710,dispatcher); +extern pascal void MakeThisCtlTarget(CtlRecHndl) inline(0x2810,dispatcher); +extern pascal CtlRecHndl NewControl2(WindowPtr, Word, Ref) inline(0x3110,dispatcher); +extern pascal void NotifyControls(Word, Word, Long, WindowPtr) inline(0x2D10,dispatcher); +extern pascal void NotifyCtls(Word, Word, Long, WindowPtr) inline(0x2D10,dispatcher); +extern pascal Boolean SendEventToCtl(Boolean, WindowPtr, EventRecordPtr) inline(0x2910,dispatcher); +extern pascal void SetCtlID(Long, CtlRecHndl) inline(0x2B10,dispatcher); +extern pascal void SetCtlMoreFlags(Word, CtlRecHndl) inline(0x2F10,dispatcher); +extern pascal void SetCtlParamPtr(Pointer) inline(0x3410,dispatcher); + +extern pascal Word FindRadioButton(WindowPtr, Word) inline(0x3910,dispatcher); +extern pascal void GetLETextByID(WindowPtr, Long, StringPtr) inline(0x3B10,dispatcher); +extern pascal void SetLETextByID(WindowPtr, Long, StringPtr) inline(0x3A10,dispatcher); + +extern pascal void SetCtlValueByID(Word, GrafPortPtr, Long) inline(0x3C10,dispatcher); +extern pascal Word GetCtlValueByID(GrafPortPtr, Long) inline(0x3D10,dispatcher); +extern pascal void InvalOneCtlByID(GrafPortPtr, Long) inline(0x3E10,dispatcher); +extern pascal void HiliteCtlByID(Word, GrafPortPtr, Long) inline(0x3F10,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/ctype.h b/bin/Libraries/ORCACDefs/ctype.h index fb471c7..f3509d5 100644 --- a/bin/Libraries/ORCACDefs/ctype.h +++ b/bin/Libraries/ORCACDefs/ctype.h @@ -1 +1,61 @@ -/**************************************************************** * * ctype.h - character types * * February 1989 * Mike Westerfield * * Copyright 1989 * Byte Works, Inc. * ****************************************************************/ #ifndef __ctype__ #define __ctype__ extern char __ctype[],__ctype2[]; #define __digit 0x01 #define __upper 0x02 #define __lower 0x04 #define __control 0x08 #define __punctuation 0x10 #define __space 0x20 #define __hex 0x40 #define __print 0x80 #define __csym 0x01 #define __csymf 0x02 #define __octal 0x04 #define isalnum(c) ((__ctype)[(c)+1] & (__upper|__lower|__digit)) #define isalpha(c) ((__ctype)[(c)+1] & (__upper|__lower)) #ifndef __KeepNamespacePure__ #define isascii(c) ((unsigned)(c) < 0x0080) #endif #define iscntrl(c) ((__ctype)[(c)+1] & __control) #ifndef __KeepNamespacePure__ #define iscsym(c) ((__ctype2)[(c)+1] & __csym) #define iscsymf(c) ((__ctype2)[(c)+1] & __csymf) #endif #define isdigit(c) ((__ctype)[(c)+1] & __digit) #define isgraph(c) ((__ctype)[(c)+1] & (__upper|__lower|__digit|__punctuation)) #define islower(c) ((__ctype)[(c)+1] & __lower) #ifndef __KeepNamespacePure__ #define isodigit(c) ((__ctype2)[(c)+1] & __octal) #endif #define isprint(c) ((__ctype)[(c)+1] & __print) #define ispunct(c) ((__ctype)[(c)+1] & __punctuation) #define isspace(c) ((__ctype)[(c)+1] & __space) #define isupper(c) ((__ctype)[(c)+1] & __upper) #define isxdigit(c) ((__ctype)[(c)+1] & __hex) #ifndef __KeepNamespacePure__ #define toascii(c) ((c) & 0x7F) #endif int toint(char); int tolower(int); int toupper(int); #define _tolower(c) ((c) | 0x20) #define _toupper(c) ((c) & 0x5F) #endif \ No newline at end of file +/**************************************************************** +* +* ctype.h - character types +* +* February 1989 +* Mike Westerfield +* +* Copyright 1989 +* Byte Works, Inc. +* +****************************************************************/ + +#ifndef __ctype__ +#define __ctype__ + +extern char __ctype[],__ctype2[]; + +#define __digit 0x01 +#define __upper 0x02 +#define __lower 0x04 +#define __control 0x08 +#define __punctuation 0x10 +#define __space 0x20 +#define __hex 0x40 +#define __print 0x80 + +#define __csym 0x01 +#define __csymf 0x02 +#define __octal 0x04 + +#define isalnum(c) ((__ctype)[(c)+1] & (__upper|__lower|__digit)) +#define isalpha(c) ((__ctype)[(c)+1] & (__upper|__lower)) +#ifndef __KeepNamespacePure__ + #define isascii(c) ((unsigned)(c) < 0x0080) +#endif +#define iscntrl(c) ((__ctype)[(c)+1] & __control) +#ifndef __KeepNamespacePure__ + #define iscsym(c) ((__ctype2)[(c)+1] & __csym) + #define iscsymf(c) ((__ctype2)[(c)+1] & __csymf) +#endif +#define isdigit(c) ((__ctype)[(c)+1] & __digit) +#define isgraph(c) ((__ctype)[(c)+1] & (__upper|__lower|__digit|__punctuation)) +#define islower(c) ((__ctype)[(c)+1] & __lower) +#ifndef __KeepNamespacePure__ + #define isodigit(c) ((__ctype2)[(c)+1] & __octal) +#endif +#define isprint(c) ((__ctype)[(c)+1] & __print) +#define ispunct(c) ((__ctype)[(c)+1] & __punctuation) +#define isspace(c) ((__ctype)[(c)+1] & __space) +#define isupper(c) ((__ctype)[(c)+1] & __upper) +#define isxdigit(c) ((__ctype)[(c)+1] & __hex) +#ifndef __KeepNamespacePure__ + #define toascii(c) ((c) & 0x7F) +#endif +int toint(char); +int tolower(int); +int toupper(int); +#define _tolower(c) ((c) | 0x20) +#define _toupper(c) ((c) & 0x5F) + +#endif diff --git a/bin/Libraries/ORCACDefs/desk.h b/bin/Libraries/ORCACDefs/desk.h index baa088a..b6d52ca 100644 --- a/bin/Libraries/ORCACDefs/desk.h +++ b/bin/Libraries/ORCACDefs/desk.h @@ -1 +1,112 @@ -/******************************************** * * Desk Manager * * Copyright Apple Computer, Inc.1986-91 * All Rights Reserved * * Copyright 1992, 1993, Bute Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __DESK__ #define __DESK__ /* Error Codes */ #define daNotFound 0x0510 /* desk accessory not found */ #define notSysWindow 0x0511 /* not the system window */ #define deskBadSelector 0x0520 /* bad selector for GetDeskAccInfo */ /* NDA Action Codes */ #define eventAction 0x0001 #define runAction 0x0002 #define cursorAction 0x0003 #define undoAction 0x0005 #define cutAction 0x0006 #define copyAction 0x0007 #define pasteAction 0x0008 #define clearAction 0x0009 #define sysClickAction 0x000A #define optionalCloseAction 0x000B /* SystemEdit Codes */ #define undoEdit 0x0001 #define cutEdit 0x0002 #define copyEdit 0x0003 #define pasteEdit 0x0004 #define clearEdit 0x0005 /* constants for GetDeskAccInfo */ #define getCDAinfo 0x8000 #define getNDAinfo 0x0000 #define daRefIsWindPtr 0x0001 #define daRefIsIndex 0x0000 /* constants for GetDeskGlobal */ #define deskGlobalWindow 0x0000 /* constants for CallDeskAcc */ #define daCallCDA 0x8000 #define daCallNDA 0x0000 #define daCallInit 0x0002 #define daCallAction 0x0000 /* System Window structure for GetAuxWindInfo */ struct NDASysWindRecord { Word status; /* use 0, reserved for Desk Mgr */ LongProcPtr openProc; /* reserved, use nil */ ProcPtr closeProc; /* pointer to your Close routine */ ProcPtr actionProc; /* pointer to your Action routine */ ProcPtr initProc; /* reserved, use nil */ Word period; Word eventMask; /* your event mask, like for an NDA */ LongWord lastServiced; /* reserved, use 0 */ LongWord windowPtr; /* reserved, use 0 */ LongWord ndaHandle; /* reserved, use 0 */ Word memoryID; /* your memory ID, important! */ }; typedef struct NDASysWindRecord NDASysWindRecord, *NDASysWindRecPtr; extern pascal void DeskBootInit(void) inline(0x0105,dispatcher); extern pascal void DeskStartUp(void) inline(0x0205,dispatcher); extern pascal void DeskShutDown(void) inline(0x0305,dispatcher); extern pascal Word DeskVersion(void) inline(0x0405,dispatcher); extern pascal void DeskReset(void) inline(0x0505,dispatcher); extern pascal Boolean DeskStatus(void) inline(0x0605,dispatcher); extern pascal void ChooseCDA(void) inline(0x1105,dispatcher); extern pascal void CloseAllNDAs(void) inline(0x1D05,dispatcher); extern pascal void CloseNDA(Word) inline(0x1605,dispatcher); extern pascal void CloseNDAbyWinPtr(GrafPortPtr) inline(0x1C05,dispatcher); extern pascal void CloseNDAByWinPtr(GrafPortPtr) inline(0x1C05,dispatcher); extern pascal void FixAppleMenu(Word) inline(0x1E05,dispatcher); extern pascal Pointer GetDAStrPtr(void) inline(0x1405,dispatcher); extern pascal Word GetNumNDAs(void) inline(0x1B05,dispatcher); extern pascal void InstallCDA(Handle) inline(0x0F05,dispatcher); extern pascal void InstallNDA(Handle) inline(0x0E05,dispatcher); extern pascal Word OpenNDA(Word) inline(0x1505,dispatcher); extern pascal void RestAll(void) inline(0x0C05,dispatcher); extern pascal void RestScrn(void) inline(0x0A05,dispatcher); extern pascal void SaveAll(void) inline(0x0B05,dispatcher); extern pascal void SaveScrn(void) inline(0x0905,dispatcher); extern pascal void SetDAStrPtr(Handle, Pointer) inline(0x1305,dispatcher); extern pascal void SystemClick(EventRecordPtr, GrafPortPtr, Word) inline(0x1705,dispatcher); extern pascal Boolean SystemEdit(Word) inline(0x1805,dispatcher); extern pascal Boolean SystemEvent(Word, Long, Long, Point, Word) inline(0x1A05,dispatcher); extern pascal void SystemTask(void) inline(0x1905,dispatcher); extern pascal void AddToRunQ(Pointer) inline(0x1F05,dispatcher); extern pascal void RemoveCDA(Handle) inline(0x2105,dispatcher); extern pascal void RemoveFromRunQ(Pointer) inline(0x2005,dispatcher); extern pascal void RemoveNDA(Handle) inline(0x2205,dispatcher); extern pascal Word CallDeskAcc(Word, Long, Word, Long) inline(0x2405,dispatcher); extern pascal void GetDeskAccInfo(Word, Long, Word, Ptr) inline(0x2305,dispatcher); extern pascal LongWord GetDeskGlobal(Word) inline(0x2505,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Desk Manager +* +* Copyright Apple Computer, Inc.1986-91 +* All Rights Reserved +* +* Copyright 1992, 1993, Bute Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __DESK__ +#define __DESK__ + + +/* Error Codes */ +#define daNotFound 0x0510 /* desk accessory not found */ +#define notSysWindow 0x0511 /* not the system window */ +#define deskBadSelector 0x0520 /* bad selector for GetDeskAccInfo */ + +/* NDA Action Codes */ +#define eventAction 0x0001 +#define runAction 0x0002 +#define cursorAction 0x0003 +#define undoAction 0x0005 +#define cutAction 0x0006 +#define copyAction 0x0007 +#define pasteAction 0x0008 +#define clearAction 0x0009 +#define sysClickAction 0x000A +#define optionalCloseAction 0x000B + +/* SystemEdit Codes */ +#define undoEdit 0x0001 +#define cutEdit 0x0002 +#define copyEdit 0x0003 +#define pasteEdit 0x0004 +#define clearEdit 0x0005 + +/* constants for GetDeskAccInfo */ +#define getCDAinfo 0x8000 +#define getNDAinfo 0x0000 +#define daRefIsWindPtr 0x0001 +#define daRefIsIndex 0x0000 + +/* constants for GetDeskGlobal */ +#define deskGlobalWindow 0x0000 + +/* constants for CallDeskAcc */ +#define daCallCDA 0x8000 +#define daCallNDA 0x0000 +#define daCallInit 0x0002 +#define daCallAction 0x0000 + +/* System Window structure for GetAuxWindInfo */ + +struct NDASysWindRecord { + Word status; /* use 0, reserved for Desk Mgr */ + LongProcPtr openProc; /* reserved, use nil */ + ProcPtr closeProc; /* pointer to your Close routine */ + ProcPtr actionProc; /* pointer to your Action routine */ + ProcPtr initProc; /* reserved, use nil */ + Word period; + Word eventMask; /* your event mask, like for an NDA */ + LongWord lastServiced; /* reserved, use 0 */ + LongWord windowPtr; /* reserved, use 0 */ + LongWord ndaHandle; /* reserved, use 0 */ + Word memoryID; /* your memory ID, important! */ + }; +typedef struct NDASysWindRecord NDASysWindRecord, *NDASysWindRecPtr; + +extern pascal void DeskBootInit(void) inline(0x0105,dispatcher); +extern pascal void DeskStartUp(void) inline(0x0205,dispatcher); +extern pascal void DeskShutDown(void) inline(0x0305,dispatcher); +extern pascal Word DeskVersion(void) inline(0x0405,dispatcher); +extern pascal void DeskReset(void) inline(0x0505,dispatcher); +extern pascal Boolean DeskStatus(void) inline(0x0605,dispatcher); +extern pascal void ChooseCDA(void) inline(0x1105,dispatcher); +extern pascal void CloseAllNDAs(void) inline(0x1D05,dispatcher); +extern pascal void CloseNDA(Word) inline(0x1605,dispatcher); +extern pascal void CloseNDAbyWinPtr(GrafPortPtr) inline(0x1C05,dispatcher); +extern pascal void CloseNDAByWinPtr(GrafPortPtr) inline(0x1C05,dispatcher); +extern pascal void FixAppleMenu(Word) inline(0x1E05,dispatcher); +extern pascal Pointer GetDAStrPtr(void) inline(0x1405,dispatcher); +extern pascal Word GetNumNDAs(void) inline(0x1B05,dispatcher); +extern pascal void InstallCDA(Handle) inline(0x0F05,dispatcher); +extern pascal void InstallNDA(Handle) inline(0x0E05,dispatcher); +extern pascal Word OpenNDA(Word) inline(0x1505,dispatcher); +extern pascal void RestAll(void) inline(0x0C05,dispatcher); +extern pascal void RestScrn(void) inline(0x0A05,dispatcher); +extern pascal void SaveAll(void) inline(0x0B05,dispatcher); +extern pascal void SaveScrn(void) inline(0x0905,dispatcher); +extern pascal void SetDAStrPtr(Handle, Pointer) inline(0x1305,dispatcher); +extern pascal void SystemClick(EventRecordPtr, GrafPortPtr, Word) inline(0x1705,dispatcher); +extern pascal Boolean SystemEdit(Word) inline(0x1805,dispatcher); +extern pascal Boolean SystemEvent(Word, Long, Long, Point, Word) inline(0x1A05,dispatcher); +extern pascal void SystemTask(void) inline(0x1905,dispatcher); + +extern pascal void AddToRunQ(Pointer) inline(0x1F05,dispatcher); +extern pascal void RemoveCDA(Handle) inline(0x2105,dispatcher); +extern pascal void RemoveFromRunQ(Pointer) inline(0x2005,dispatcher); +extern pascal void RemoveNDA(Handle) inline(0x2205,dispatcher); + +extern pascal Word CallDeskAcc(Word, Long, Word, Long) inline(0x2405,dispatcher); +extern pascal void GetDeskAccInfo(Word, Long, Word, Ptr) inline(0x2305,dispatcher); +extern pascal LongWord GetDeskGlobal(Word) inline(0x2505,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/dialog.h b/bin/Libraries/ORCACDefs/dialog.h index 1af0e2c..39ad404 100644 --- a/bin/Libraries/ORCACDefs/dialog.h +++ b/bin/Libraries/ORCACDefs/dialog.h @@ -1 +1,183 @@ -/******************************************** * * Dialog Manager * * Copyright Apple Computer, Inc.1986-90 * All Rights Reserved * * Copyright 1992, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __DIALOG__ #define __DIALOG__ /* Error Codes */ #define badItemType 0x150A #define newItemFailed 0x150B #define itemNotFound 0x150C #define notModalDialog 0x150D /* Command Codes */ #define getInitView 0x0001 #define getInitTotal 0x0002 #define getInitValue 0x0003 #define scrollLineUp 0x0004 #define scrollLineDown 0x0005 #define scrollPageUp 0x0006 #define scrollPageDown 0x0007 #define scrollThumb 0x0008 /* Item Type Codes */ #define buttonItem 0x000A #define checkItem 0x000B #define radioItem 0x000C #define scrollBarItem 0x000D #define userCtlItem 0x000E #define statText 0x000F #define longStatText 0x0010 #define editLine 0x0011 #define iconItem 0x0012 #define picItem 0x0013 #define userItem 0x0014 #define userCtlItem2 0x0015 #define longStatText2 0x0016 #define itemDisable 0x8000 /* Item Type Ranges */ #define minItemType 0x000A #define maxItemType 0x0016 /* ItemID Codes */ #define ok 0x0001 #define cancel 0x0002 /* Part Codes */ #define inButton 0x0002 #define inCheckBox 0x0003 #define inRadioButton 0x0004 #define inUpArrow 0x0005 #define inDownArrow 0x0006 #define inPageUp 0x0007 #define inPageDown 0x0008 #define inStatText 0x0009 #define inGrow 0x000A #define inEditLine 0x000B #define inUserItem 0x000C #define inLongStatText 0x000D #define inIconItem 0x000E #define inLongStatText2 0x000F #define inThumb 0x0081 /* Stage Bit Vectors */ #define okDefault 0x0000 #define cancelDefault 0x0040 #define alertDrawn 0x0080 /* Other Constants */ #ifndef atItemListLength /* AlertTemplate - Default number of Item Templates */ #define atItemListLength 0x0005 #endif #ifndef dtItemListLength /* DialogTemplate - Default number of Item Templates */ #define dtItemListLength 0x0008 #endif typedef GrafPortPtr DialogPtr; struct ItemTemplate { Word itemID; Rect itemRect; Word itemType; Pointer itemDescr; Word itemValue; Word itemFlag; Pointer itemColor; /* pointer to appropriate type of color table */ }; typedef struct ItemTemplate ItemTemplate, *ItemTempPtr, **ItemTempHndl; struct AlertTemplate { Rect atBoundsRect; Word atAlertID; Byte atStage1; Byte atStage2; Byte atStage3; Byte atStage4; ItemTempPtr atItemList[atItemListLength]; /* Null terminated array */ }; typedef struct AlertTemplate AlertTemplate, *AlertTempPtr, **AlertTempHndl; struct DialogTemplate { Rect dtBoundsRect; Boolean dtVisible; Longint dtRefCon; ItemTempPtr dtItemList[dtItemListLength]; /* Null terminated array */ }; typedef struct DialogTemplate DialogTemplate, *DlgTempPtr, **DlgTempHndl; struct UserCtlItemPB { LongProcPtr defProcParm; Pointer titleParm; Word param2; Word param1; }; typedef struct UserCtlItemPB UserCtlItemPB, *UserCtlItemPBPtr, **UserCtlItemPBHndl; extern pascal void DialogBootInit(void) inline(0x0115,dispatcher); extern pascal void DialogStartUp(Word) inline(0x0215,dispatcher); extern pascal void DialogShutDown(void) inline(0x0315,dispatcher); extern pascal Word DialogVersion(void) inline(0x0415,dispatcher); extern pascal void DialogReset(void) inline(0x0515,dispatcher); extern pascal Boolean DialogStatus(void) inline(0x0615,dispatcher); extern pascal Word Alert(AlertTempPtr, WordProcPtr) inline(0x1715,dispatcher); extern pascal Word CautionAlert(AlertTempPtr, WordProcPtr) inline(0x1A15,dispatcher); extern pascal void CloseDialog(GrafPortPtr) inline(0x0C15,dispatcher); extern pascal Boolean DefaultFilter(GrafPortPtr, EventRecordPtr, Word *) inline(0x3615,dispatcher); extern pascal Boolean DialogSelect(EventRecordPtr, GrafPortPtr *, Word *) inline(0x1115,dispatcher); extern pascal void DisableDItem(GrafPortPtr, Word) inline(0x3915,dispatcher); extern pascal void DlgCopy(GrafPortPtr) inline(0x1315,dispatcher); extern pascal void DlgCut(GrafPortPtr) inline(0x1215,dispatcher); extern pascal void DlgDelete(GrafPortPtr) inline(0x1515,dispatcher); extern pascal void DlgPaste(GrafPortPtr) inline(0x1415,dispatcher); extern pascal void DrawDialog(GrafPortPtr) inline(0x1615,dispatcher); extern pascal void EnableDItem(GrafPortPtr, Word) inline(0x3A15,dispatcher); extern pascal void ErrorSound(VoidProcPtr) inline(0x0915,dispatcher); extern pascal Word FindDItem(GrafPortPtr, Point) inline(0x2415,dispatcher); extern pascal Word GetAlertStage(void) inline(0x3415,dispatcher); extern pascal CtlRecHndl GetControlDItem(GrafPortPtr, Word) inline(0x1E15,dispatcher); extern pascal Word GetDefButton(GrafPortPtr) inline(0x3715,dispatcher); extern pascal void GetDItemBox(GrafPortPtr, Word, Rect *) inline(0x2815,dispatcher); extern pascal Word GetDItemType(GrafPortPtr, Word) inline(0x2615,dispatcher); extern pascal Word GetDItemValue(GrafPortPtr, Word) inline(0x2E15,dispatcher); extern pascal Word GetFirstDItem(GrafPortPtr) inline(0x2A15,dispatcher); extern pascal void GetIText(GrafPortPtr, Word, Pointer) inline(0x1F15,dispatcher); extern pascal void GetNewDItem(GrafPortPtr, ItemTempPtr) inline(0x3315,dispatcher); extern pascal DialogPtr GetNewModalDialog(DlgTempPtr) inline(0x3215,dispatcher); extern pascal Word GetNextDItem(GrafPortPtr, Word) inline(0x2B15,dispatcher); extern pascal void HideDItem(GrafPortPtr, Word) inline(0x2215,dispatcher); extern pascal Boolean IsDialogEvent(EventRecordPtr) inline(0x1015,dispatcher); extern pascal Word ModalDialog(WordProcPtr) inline(0x0F15,dispatcher); extern pascal LongWord ModalDialog2(WordProcPtr) inline(0x2C15,dispatcher); extern pascal void NewDItem(GrafPortPtr, Word, Rect *, Word, Pointer, Word, Word, Pointer) inline(0x0D15,dispatcher); extern pascal DialogPtr NewModalDialog(Rect *, Boolean, LongWord) inline(0x0A15,dispatcher); extern pascal DialogPtr NewModelessDialog(Rect *, Pointer, GrafPortPtr, Word, LongWord, Rect *) inline(0x0B15,dispatcher); extern pascal Word NoteAlert(AlertTempPtr, WordProcPtr) inline(0x1915,dispatcher); extern pascal void ParamText(Pointer, Pointer, Pointer, Pointer) inline(0x1B15,dispatcher); extern pascal void RemoveDItem(GrafPortPtr, Word) inline(0x0E15,dispatcher); extern pascal void ResetAlertStage(void) inline(0x3515,dispatcher); extern pascal void SelectIText(GrafPortPtr, Word, Word, Word) inline(0x2115,dispatcher); extern pascal void SelIText(GrafPortPtr, Word, Word, Word) inline(0x2115,dispatcher); extern pascal void SetDAFont(FontHndl) inline(0x1C15,dispatcher); extern pascal void SetDefButton(Word, GrafPortPtr) inline(0x3815,dispatcher); extern pascal void SetDItemBox(GrafPortPtr, Word, Rect *) inline(0x2915,dispatcher); extern pascal void SetDItemType(Word, GrafPortPtr, Word) inline(0x2715,dispatcher); extern pascal void SetDItemValue(Word, GrafPortPtr, Word) inline(0x2F15,dispatcher); extern pascal void SetIText(GrafPortPtr, Word, Pointer) inline(0x2015,dispatcher); extern pascal void ShowDItem(GrafPortPtr, Word) inline(0x2315,dispatcher); extern pascal Word StopAlert(AlertTempPtr, WordProcPtr) inline(0x1815,dispatcher); extern pascal void UpdateDialog(GrafPortPtr, Handle) inline(0x2515,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Dialog Manager +* +* Copyright Apple Computer, Inc.1986-90 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __DIALOG__ +#define __DIALOG__ + +/* Error Codes */ +#define badItemType 0x150A +#define newItemFailed 0x150B +#define itemNotFound 0x150C +#define notModalDialog 0x150D + +/* Command Codes */ +#define getInitView 0x0001 +#define getInitTotal 0x0002 +#define getInitValue 0x0003 +#define scrollLineUp 0x0004 +#define scrollLineDown 0x0005 +#define scrollPageUp 0x0006 +#define scrollPageDown 0x0007 +#define scrollThumb 0x0008 + +/* Item Type Codes */ +#define buttonItem 0x000A +#define checkItem 0x000B +#define radioItem 0x000C +#define scrollBarItem 0x000D +#define userCtlItem 0x000E +#define statText 0x000F +#define longStatText 0x0010 +#define editLine 0x0011 +#define iconItem 0x0012 +#define picItem 0x0013 +#define userItem 0x0014 +#define userCtlItem2 0x0015 +#define longStatText2 0x0016 +#define itemDisable 0x8000 + +/* Item Type Ranges */ +#define minItemType 0x000A +#define maxItemType 0x0016 + +/* ItemID Codes */ +#define ok 0x0001 +#define cancel 0x0002 + +/* Part Codes */ +#define inButton 0x0002 +#define inCheckBox 0x0003 +#define inRadioButton 0x0004 +#define inUpArrow 0x0005 +#define inDownArrow 0x0006 +#define inPageUp 0x0007 +#define inPageDown 0x0008 +#define inStatText 0x0009 +#define inGrow 0x000A +#define inEditLine 0x000B +#define inUserItem 0x000C +#define inLongStatText 0x000D +#define inIconItem 0x000E +#define inLongStatText2 0x000F +#define inThumb 0x0081 + +/* Stage Bit Vectors */ +#define okDefault 0x0000 +#define cancelDefault 0x0040 +#define alertDrawn 0x0080 + +/* Other Constants */ +#ifndef atItemListLength /* AlertTemplate - Default number of Item Templates */ +#define atItemListLength 0x0005 +#endif +#ifndef dtItemListLength /* DialogTemplate - Default number of Item Templates */ +#define dtItemListLength 0x0008 +#endif + +typedef GrafPortPtr DialogPtr; + +struct ItemTemplate { + Word itemID; + Rect itemRect; + Word itemType; + Pointer itemDescr; + Word itemValue; + Word itemFlag; + Pointer itemColor; /* pointer to appropriate type of color table */ + }; +typedef struct ItemTemplate ItemTemplate, *ItemTempPtr, **ItemTempHndl; + +struct AlertTemplate { + Rect atBoundsRect; + Word atAlertID; + Byte atStage1; + Byte atStage2; + Byte atStage3; + Byte atStage4; + ItemTempPtr atItemList[atItemListLength]; /* Null terminated array */ + }; +typedef struct AlertTemplate AlertTemplate, *AlertTempPtr, **AlertTempHndl; + +struct DialogTemplate { + Rect dtBoundsRect; + Boolean dtVisible; + Longint dtRefCon; + ItemTempPtr dtItemList[dtItemListLength]; /* Null terminated array */ + }; +typedef struct DialogTemplate DialogTemplate, *DlgTempPtr, **DlgTempHndl; + +struct UserCtlItemPB { + LongProcPtr defProcParm; + Pointer titleParm; + Word param2; + Word param1; + }; +typedef struct UserCtlItemPB UserCtlItemPB, *UserCtlItemPBPtr, **UserCtlItemPBHndl; + +extern pascal void DialogBootInit(void) inline(0x0115,dispatcher); +extern pascal void DialogStartUp(Word) inline(0x0215,dispatcher); +extern pascal void DialogShutDown(void) inline(0x0315,dispatcher); +extern pascal Word DialogVersion(void) inline(0x0415,dispatcher); +extern pascal void DialogReset(void) inline(0x0515,dispatcher); +extern pascal Boolean DialogStatus(void) inline(0x0615,dispatcher); +extern pascal Word Alert(AlertTempPtr, WordProcPtr) inline(0x1715,dispatcher); +extern pascal Word CautionAlert(AlertTempPtr, WordProcPtr) inline(0x1A15,dispatcher); +extern pascal void CloseDialog(GrafPortPtr) inline(0x0C15,dispatcher); +extern pascal Boolean DefaultFilter(GrafPortPtr, EventRecordPtr, Word *) inline(0x3615,dispatcher); +extern pascal Boolean DialogSelect(EventRecordPtr, GrafPortPtr *, Word *) inline(0x1115,dispatcher); +extern pascal void DisableDItem(GrafPortPtr, Word) inline(0x3915,dispatcher); +extern pascal void DlgCopy(GrafPortPtr) inline(0x1315,dispatcher); +extern pascal void DlgCut(GrafPortPtr) inline(0x1215,dispatcher); +extern pascal void DlgDelete(GrafPortPtr) inline(0x1515,dispatcher); +extern pascal void DlgPaste(GrafPortPtr) inline(0x1415,dispatcher); +extern pascal void DrawDialog(GrafPortPtr) inline(0x1615,dispatcher); +extern pascal void EnableDItem(GrafPortPtr, Word) inline(0x3A15,dispatcher); +extern pascal void ErrorSound(VoidProcPtr) inline(0x0915,dispatcher); +extern pascal Word FindDItem(GrafPortPtr, Point) inline(0x2415,dispatcher); +extern pascal Word GetAlertStage(void) inline(0x3415,dispatcher); +extern pascal CtlRecHndl GetControlDItem(GrafPortPtr, Word) inline(0x1E15,dispatcher); +extern pascal Word GetDefButton(GrafPortPtr) inline(0x3715,dispatcher); +extern pascal void GetDItemBox(GrafPortPtr, Word, Rect *) inline(0x2815,dispatcher); +extern pascal Word GetDItemType(GrafPortPtr, Word) inline(0x2615,dispatcher); +extern pascal Word GetDItemValue(GrafPortPtr, Word) inline(0x2E15,dispatcher); +extern pascal Word GetFirstDItem(GrafPortPtr) inline(0x2A15,dispatcher); +extern pascal void GetIText(GrafPortPtr, Word, Pointer) inline(0x1F15,dispatcher); +extern pascal void GetNewDItem(GrafPortPtr, ItemTempPtr) inline(0x3315,dispatcher); +extern pascal DialogPtr GetNewModalDialog(DlgTempPtr) inline(0x3215,dispatcher); +extern pascal Word GetNextDItem(GrafPortPtr, Word) inline(0x2B15,dispatcher); +extern pascal void HideDItem(GrafPortPtr, Word) inline(0x2215,dispatcher); +extern pascal Boolean IsDialogEvent(EventRecordPtr) inline(0x1015,dispatcher); +extern pascal Word ModalDialog(WordProcPtr) inline(0x0F15,dispatcher); +extern pascal LongWord ModalDialog2(WordProcPtr) inline(0x2C15,dispatcher); +extern pascal void NewDItem(GrafPortPtr, Word, Rect *, Word, Pointer, Word, Word, Pointer) inline(0x0D15,dispatcher); +extern pascal DialogPtr NewModalDialog(Rect *, Boolean, LongWord) inline(0x0A15,dispatcher); +extern pascal DialogPtr NewModelessDialog(Rect *, Pointer, GrafPortPtr, Word, LongWord, Rect *) inline(0x0B15,dispatcher); +extern pascal Word NoteAlert(AlertTempPtr, WordProcPtr) inline(0x1915,dispatcher); +extern pascal void ParamText(Pointer, Pointer, Pointer, Pointer) inline(0x1B15,dispatcher); +extern pascal void RemoveDItem(GrafPortPtr, Word) inline(0x0E15,dispatcher); +extern pascal void ResetAlertStage(void) inline(0x3515,dispatcher); +extern pascal void SelectIText(GrafPortPtr, Word, Word, Word) inline(0x2115,dispatcher); +extern pascal void SelIText(GrafPortPtr, Word, Word, Word) inline(0x2115,dispatcher); +extern pascal void SetDAFont(FontHndl) inline(0x1C15,dispatcher); +extern pascal void SetDefButton(Word, GrafPortPtr) inline(0x3815,dispatcher); +extern pascal void SetDItemBox(GrafPortPtr, Word, Rect *) inline(0x2915,dispatcher); +extern pascal void SetDItemType(Word, GrafPortPtr, Word) inline(0x2715,dispatcher); +extern pascal void SetDItemValue(Word, GrafPortPtr, Word) inline(0x2F15,dispatcher); +extern pascal void SetIText(GrafPortPtr, Word, Pointer) inline(0x2015,dispatcher); +extern pascal void ShowDItem(GrafPortPtr, Word) inline(0x2315,dispatcher); +extern pascal Word StopAlert(AlertTempPtr, WordProcPtr) inline(0x1815,dispatcher); +extern pascal void UpdateDialog(GrafPortPtr, Handle) inline(0x2515,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/errno.h b/bin/Libraries/ORCACDefs/errno.h index ca89058..c529fde 100644 --- a/bin/Libraries/ORCACDefs/errno.h +++ b/bin/Libraries/ORCACDefs/errno.h @@ -1 +1,30 @@ -/**************************************************************** * * errno.h - standard error numbers * * February 1989 * Mike Westerfield * * Copyright 1989 * Byte Works, Inc. * ****************************************************************/ #ifndef __errno__ #define __errno__ #define EDOM 1 /* domain error */ #define ERANGE 2 /* # too large, too small, or illegal */ #define ENOMEM 3 /* Not enough memory */ #define ENOENT 4 /* No such file or directory */ #define EIO 5 /* I/O error */ #define EINVAL 6 /* Invalid argument */ #define EBADF 7 /* bad file descriptor */ #define EMFILE 8 /* too many files are open */ #define EACCESS 9 /* access bits prevent the operation */ #define EEXIST 10 /* the file exists */ #define ENOSPC 11 /* the file is too large */ extern int errno; #endif \ No newline at end of file +/**************************************************************** +* +* errno.h - standard error numbers +* +* February 1989 +* Mike Westerfield +* +* Copyright 1989 +* Byte Works, Inc. +* +****************************************************************/ + +#ifndef __errno__ +#define __errno__ + +#define EDOM 1 /* domain error */ +#define ERANGE 2 /* # too large, too small, or illegal */ +#define ENOMEM 3 /* Not enough memory */ +#define ENOENT 4 /* No such file or directory */ +#define EIO 5 /* I/O error */ +#define EINVAL 6 /* Invalid argument */ +#define EBADF 7 /* bad file descriptor */ +#define EMFILE 8 /* too many files are open */ +#define EACCESS 9 /* access bits prevent the operation */ +#define EEXIST 10 /* the file exists */ +#define ENOSPC 11 /* the file is too large */ + +extern int errno; + +#endif diff --git a/bin/Libraries/ORCACDefs/event.h b/bin/Libraries/ORCACDefs/event.h index b2e3fc0..25a88f4 100644 --- a/bin/Libraries/ORCACDefs/event.h +++ b/bin/Libraries/ORCACDefs/event.h @@ -1 +1,119 @@ -/******************************************** * * Event Manager * * Copyright Apple Computer, Inc.1986-90 * All Rights Reserved * * Copyright 1992, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __EVENT__ #define __EVENT__ /* Error Codes */ #define emDupStrtUpErr 0x0601 /* duplicate EMStartup Call */ #define emResetErr 0x0602 /* can't reset error the Event Manager */ #define emNotActErr 0x0603 /* event manager not active */ #define emBadEvtCodeErr 0x0604 /* illegal event code */ #define emBadBttnNoErr 0x0605 /* illegal button number */ #define emQSiz2LrgErr 0x0606 /* queue size too large */ #define emNoMemQueueErr 0x0607 /* not enough memory for queue */ #define emBadEvtQErr 0x0681 /* fatal sys error - event queue damaged */ #define emBadQHndlErr 0x0682 /* fatal sys error - queue handle damaged */ /* Event Codes */ #define nullEvt 0x0000 #define mouseDownEvt 0x0001 #define mouseUpEvt 0x0002 #define keyDownEvt 0x0003 #define autoKeyEvt 0x0005 #define updateEvt 0x0006 #define activateEvt 0x0008 #define switchEvt 0x0009 #define deskAccEvt 0x000A #define driverEvt 0x000B #define app1Evt 0x000C #define app2Evt 0x000D #define app3Evt 0x000E #define app4Evt 0x000F /* Event Masks */ #define mDownMask 0x0002 #define mUpMask 0x0004 #define keyDownMask 0x0008 #define autoKeyMask 0x0020 #define updateMask 0x0040 #define activeMask 0x0100 #define switchMask 0x0200 #define deskAccMask 0x0400 #define driverMask 0x0800 #define app1Mask 0x1000 #define app2Mask 0x2000 #define app3Mask 0x4000 #define app4Mask 0x8000 #define everyEvent 0xFFFF /* Journal Codes */ #define jcTickCount 0x00 /* TickCount call */ #define jcGetMouse 0x01 /* GetMouse call */ #define jcButton 0x02 /* Button call */ #define jcEvent 0x04 /* GetNextEvent and EventAvail calls */ /* Modifiers Flags */ #define activeFlag 0x0001 /* set if window being activated */ #define changeFlag 0x0002 /* set if active wind. changed state */ #define btn1State 0x0040 /* set if button 1 up */ #define btn0State 0x0080 /* set if button 0 up */ #define appleKey 0x0100 /* set if Apple key down */ #define shiftKey 0x0200 /* set if shift key down */ #define capsLock 0x0400 /* set if caps lock key down */ #define optionKey 0x0800 /* set if option key down */ #define controlKey 0x1000 /* set if Control key down */ #define keyPad 0x2000 /* set if keypress from key pad */ /* kTransID */ #define keyboardTransIIGS 0x0000 /* use old-style Apple IIGS mapping */ #define keyboardTransMac 0x00FF /* use Macintosh mapping */ struct EventJournalRec { Word statusMode; Word yLocation; Word xLocation; }; typedef struct EventJournalRec EventJournalRec, *EventJournalRecPtr, **EventJournalRecHndl; extern pascal void EMBootInit(void) inline(0x0106,dispatcher); extern pascal void EMStartUp(Word, Word, Integer, Integer, Integer, Integer, Word) inline(0x0206,dispatcher); extern pascal void EMShutDown(void) inline(0x0306,dispatcher); extern pascal Word EMVersion(void) inline(0x0406,dispatcher); extern pascal void EMReset(void) inline(0x0506,dispatcher); extern pascal Boolean EMStatus(void) inline(0x0606,dispatcher); extern pascal Boolean Button(Word) inline(0x0D06,dispatcher); extern pascal Word DoWindows(void) inline(0x0906,dispatcher); extern pascal Boolean EventAvail(Word, EventRecordPtr) inline(0x0B06,dispatcher); extern pascal void FakeMouse(Word, Word, Integer, Integer, Word) inline(0x1906,dispatcher); extern pascal Word FlushEvents(Word, Word) inline(0x1506,dispatcher); extern pascal LongWord GetCaretTime(void) inline(0x1206,dispatcher); extern pascal LongWord GetDblTime(void) inline(0x1106,dispatcher); extern pascal void GetMouse(Point *) inline(0x0C06,dispatcher); extern pascal Boolean GetNextEvent(Word, EventRecordPtr) inline(0x0A06,dispatcher); extern pascal Boolean GetOSEvent(Word, EventRecordPtr) inline(0x1606,dispatcher); extern pascal Boolean OSEventAvail(Word, EventRecordPtr) inline(0x1706,dispatcher); extern pascal Word PostEvent(Word, LongWord) inline(0x1406,dispatcher); extern pascal void SetEventMask(Word) inline(0x1806,dispatcher); extern pascal void SetSwitch(void) inline(0x1306,dispatcher); extern pascal Boolean StillDown(Word) inline(0x0E06,dispatcher); extern pascal LongWord TickCount(void) inline(0x1006,dispatcher); extern pascal Boolean WaitMouseUp(Word) inline(0x0F06,dispatcher); extern pascal Word GetKeyTranslation(void) inline(0x1B06,dispatcher); extern pascal void SetAutoKeyLimit(Word) inline(0x1A06,dispatcher); extern pascal void SetKeyTranslation(Word) inline(0x1C06,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Event Manager +* +* Copyright Apple Computer, Inc.1986-90 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __EVENT__ +#define __EVENT__ + +/* Error Codes */ +#define emDupStrtUpErr 0x0601 /* duplicate EMStartup Call */ +#define emResetErr 0x0602 /* can't reset error the Event Manager */ +#define emNotActErr 0x0603 /* event manager not active */ +#define emBadEvtCodeErr 0x0604 /* illegal event code */ +#define emBadBttnNoErr 0x0605 /* illegal button number */ +#define emQSiz2LrgErr 0x0606 /* queue size too large */ +#define emNoMemQueueErr 0x0607 /* not enough memory for queue */ +#define emBadEvtQErr 0x0681 /* fatal sys error - event queue damaged */ +#define emBadQHndlErr 0x0682 /* fatal sys error - queue handle damaged */ + +/* Event Codes */ +#define nullEvt 0x0000 +#define mouseDownEvt 0x0001 +#define mouseUpEvt 0x0002 +#define keyDownEvt 0x0003 +#define autoKeyEvt 0x0005 +#define updateEvt 0x0006 +#define activateEvt 0x0008 +#define switchEvt 0x0009 +#define deskAccEvt 0x000A +#define driverEvt 0x000B +#define app1Evt 0x000C +#define app2Evt 0x000D +#define app3Evt 0x000E +#define app4Evt 0x000F + +/* Event Masks */ +#define mDownMask 0x0002 +#define mUpMask 0x0004 +#define keyDownMask 0x0008 +#define autoKeyMask 0x0020 +#define updateMask 0x0040 +#define activeMask 0x0100 +#define switchMask 0x0200 +#define deskAccMask 0x0400 +#define driverMask 0x0800 +#define app1Mask 0x1000 +#define app2Mask 0x2000 +#define app3Mask 0x4000 +#define app4Mask 0x8000 +#define everyEvent 0xFFFF + +/* Journal Codes */ +#define jcTickCount 0x00 /* TickCount call */ +#define jcGetMouse 0x01 /* GetMouse call */ +#define jcButton 0x02 /* Button call */ +#define jcEvent 0x04 /* GetNextEvent and EventAvail calls */ + +/* Modifiers Flags */ +#define activeFlag 0x0001 /* set if window being activated */ +#define changeFlag 0x0002 /* set if active wind. changed state */ +#define btn1State 0x0040 /* set if button 1 up */ +#define btn0State 0x0080 /* set if button 0 up */ +#define appleKey 0x0100 /* set if Apple key down */ +#define shiftKey 0x0200 /* set if shift key down */ +#define capsLock 0x0400 /* set if caps lock key down */ +#define optionKey 0x0800 /* set if option key down */ +#define controlKey 0x1000 /* set if Control key down */ +#define keyPad 0x2000 /* set if keypress from key pad */ + +/* kTransID */ +#define keyboardTransIIGS 0x0000 /* use old-style Apple IIGS mapping */ +#define keyboardTransMac 0x00FF /* use Macintosh mapping */ + +struct EventJournalRec { + Word statusMode; + Word yLocation; + Word xLocation; + }; +typedef struct EventJournalRec EventJournalRec, *EventJournalRecPtr, **EventJournalRecHndl; + +extern pascal void EMBootInit(void) inline(0x0106,dispatcher); +extern pascal void EMStartUp(Word, Word, Integer, Integer, Integer, Integer, Word) inline(0x0206,dispatcher); +extern pascal void EMShutDown(void) inline(0x0306,dispatcher); +extern pascal Word EMVersion(void) inline(0x0406,dispatcher); +extern pascal void EMReset(void) inline(0x0506,dispatcher); +extern pascal Boolean EMStatus(void) inline(0x0606,dispatcher); +extern pascal Boolean Button(Word) inline(0x0D06,dispatcher); +extern pascal Word DoWindows(void) inline(0x0906,dispatcher); +extern pascal Boolean EventAvail(Word, EventRecordPtr) inline(0x0B06,dispatcher); +extern pascal void FakeMouse(Word, Word, Integer, Integer, Word) inline(0x1906,dispatcher); +extern pascal Word FlushEvents(Word, Word) inline(0x1506,dispatcher); +extern pascal LongWord GetCaretTime(void) inline(0x1206,dispatcher); +extern pascal LongWord GetDblTime(void) inline(0x1106,dispatcher); +extern pascal void GetMouse(Point *) inline(0x0C06,dispatcher); +extern pascal Boolean GetNextEvent(Word, EventRecordPtr) inline(0x0A06,dispatcher); +extern pascal Boolean GetOSEvent(Word, EventRecordPtr) inline(0x1606,dispatcher); +extern pascal Boolean OSEventAvail(Word, EventRecordPtr) inline(0x1706,dispatcher); +extern pascal Word PostEvent(Word, LongWord) inline(0x1406,dispatcher); +extern pascal void SetEventMask(Word) inline(0x1806,dispatcher); +extern pascal void SetSwitch(void) inline(0x1306,dispatcher); +extern pascal Boolean StillDown(Word) inline(0x0E06,dispatcher); +extern pascal LongWord TickCount(void) inline(0x1006,dispatcher); +extern pascal Boolean WaitMouseUp(Word) inline(0x0F06,dispatcher); + +extern pascal Word GetKeyTranslation(void) inline(0x1B06,dispatcher); +extern pascal void SetAutoKeyLimit(Word) inline(0x1A06,dispatcher); +extern pascal void SetKeyTranslation(Word) inline(0x1C06,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/fcntl.h b/bin/Libraries/ORCACDefs/fcntl.h index bd2dbd2..29224b1 100644 --- a/bin/Libraries/ORCACDefs/fcntl.h +++ b/bin/Libraries/ORCACDefs/fcntl.h @@ -1 +1,40 @@ -/**************************************************************** * * fcntl.h - UNIX primitive input/output facilities * * October 1989 * Mike Westerfield * * Copyright 1989 * Byte Works, Inc. * ****************************************************************/ #ifndef __fcntl__ #define __fcntl__ #define OPEN_MAX 30 #define F_DUPFD 1 #define O_RDONLY 0x0001 #define O_WRONLY 0x0002 #define O_RDWR 0x0004 #define O_NDELAY 0x0008 #define O_APPEND 0x0010 #define O_CREAT 0x0020 #define O_TRUNC 0x0040 #define O_EXCL 0x0080 #define O_BINARY 0x0100 int chmod(const char *, int); int close(int); int creat(const char *, int); int dup(int); int fcntl(int, int, ...); long lseek(int, long, int); int open(const char *, int, ...); int read(int, void *, unsigned); int write(int, void *, unsigned); #endif \ No newline at end of file +/**************************************************************** +* +* fcntl.h - UNIX primitive input/output facilities +* +* October 1989 +* Mike Westerfield +* +* Copyright 1989 +* Byte Works, Inc. +* +****************************************************************/ + +#ifndef __fcntl__ +#define __fcntl__ + +#define OPEN_MAX 30 + +#define F_DUPFD 1 + +#define O_RDONLY 0x0001 +#define O_WRONLY 0x0002 +#define O_RDWR 0x0004 +#define O_NDELAY 0x0008 +#define O_APPEND 0x0010 +#define O_CREAT 0x0020 +#define O_TRUNC 0x0040 +#define O_EXCL 0x0080 +#define O_BINARY 0x0100 + +int chmod(const char *, int); +int close(int); +int creat(const char *, int); +int dup(int); +int fcntl(int, int, ...); +long lseek(int, long, int); +int open(const char *, int, ...); +int read(int, void *, unsigned); +int write(int, void *, unsigned); + +#endif diff --git a/bin/Libraries/ORCACDefs/finder.h b/bin/Libraries/ORCACDefs/finder.h index b18c920..2e04b0b 100644 --- a/bin/Libraries/ORCACDefs/finder.h +++ b/bin/Libraries/ORCACDefs/finder.h @@ -1 +1,459 @@ -/******************************************** ; File: Finder.h ; ; Copyright Apple Computer, Inc. 1991-92 ; All Rights Reserved ; ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __QUICKDRAW__ #include #endif #ifndef __EVENT__ #include #endif #ifndef __WINDOW__ #include #endif #ifndef __FINDER__ #define __FINDER__ /* target name for SendRequest to Finder */ #define NAME_OF_FINDER "\pApple~Finder~" /* SendRequest codes sent by the Finder */ #define finderSaysHello 0x0100 #define finderSaysGoodbye 0x0101 #define finderSaysSelectionChanged 0x0102 #define finderSaysMItemSelected 0x0103 #define finderSaysBeforeOpen 0x0104 #define finderSaysOpenFailed 0x0105 #define finderSaysBeforeCopy 0x0106 #define finderSaysIdle 0x0107 #define finderSaysExtrasChosen 0x0108 #define finderSaysBeforeRename 0x0109 #define finderSaysKeyHit 0x010A /************************************************************************************************/ /* SendRequest codes sent to the Finder (target = "Apple~Finder~") */ #define tellFinderGetDebugInfo 0x8000 #define tellFinderAreYouThere 0x8001 #define askFinderAreYouThere 0x8001 #define tellFinderOpenWindow 0x8002 #define tellFinderCloseWindow 0x8003 #define tellFinderGetSelectedIcons 0x8004 #define tellFinderSetSelectedIcons 0x8005 #define tellFinderLaunchThis 0x8006 #define tellFinderShutDown 0x8007 #define tellFinderMItemSelected 0x8008 #define tellFinderMatchFileToIcon 0x800A #define tellFinderAddBundle 0x800B #define tellFinderAboutChange 0x800C #define tellFinderCheckDatabase 0x800D #define tellFinderColorSelection 0x800E #define tellFinderAddToExtras 0x800F #define tellFinderIdleHowLong 0x8011 #define askFinderIdleHowLong 0x8011 #define tellFinderGetWindowIcons 0x8012 #define tellFinderGetWindowInfo 0x8013 #define tellFinderRemoveFromExtras 0x8014 #define tellFinderSpecialPreferences 0x8015 /************************************************************************************************/ /* Finder menu item IDs */ #define finderItemAbout 0x012D #define finderItemHelp 0x012E #define finderItemNewFolder 0x015F #define finderItemOpen 0x0160 #define finderItemPrint 0x0161 #define finderItemClose 0x0162 #define finderItemCloseAll 0x0163 #define finderItemDuplicate 0x0164 #define finderItemPutAway 0x0165 #define finderItemValidate 0x0166 #define finderItemUndo 0x00FA #define finderItemCut 0x00FB #define finderItemCopy 0x00FC #define finderItemPaste 0x00FD #define finderItemClear 0x00FE #define finderItemSelectAll 0x0191 #define finderItemShowClipboard 0x0192 #define finderItemStackWindows 0x01C3 #define finderItemByIcon 0x01F5 #define finderItemBySmallIcon 0x01F6 #define finderItemByName 0x01F7 #define finderItemByDate 0x01F8 #define finderItemBySize 0x01F9 #define finderItemByKind 0x01FA #define finderItemFormat 0x0227 #define finderItemErase 0x0228 #define finderItemVerify 0x0229 #define finderItemEject 0x022A #define finderItemCleanUp 0x0259 #define finderItemEmptyTrash 0x025A #define finderItemPreferences 0x025B #define finderItemIconInfo 0x025C #define finderItemShutDown 0x025D #define finderItemCleanUpByName 0x025E #define finderItemColorBlack 0x028B #define finderItemColorBlue 0x028C #define finderItemColorYellowBrown 0x028D #define finderItemColorGray1 0x028E #define finderItemColorRed 0x028F #define finderItemColorPurple 0x0290 #define finderItemColorOrange 0x0291 #define finderItemColorPink 0x0292 #define finderItemColorDarkGreen 0x0293 #define finderItemColorAqua 0x0294 #define finderItemColorBrightGreen 0x0295 #define finderItemColorPaleGreen 0x0296 #define finderItemColorPeriwinkleBlue 0x0298 #define finderItemColorYellow 0x0299 #define finderItemColorWhite 0x029A /************************************************************************************************/ /* Finder SendRequest Result Error Codes */ #define fErrNoError 0x0000 /* no error */ #define fErrBadInput 0x4201 /* bad input value */ #define fErrFailed 0x4202 /* could not complete request */ #define fErrCancel 0x4203 /* user cancelled operation */ #define fErrDimmed 0x4204 /* menu item was dimmed */ #define fErrBusy 0x4205 /* not now, finder has headache */ #define fErrNotPrudent 0x4206 /* can't add Finder's resources to desktop file */ #define fErrBadBundle 0x4207 /* unknown rBundle version, or rBundle damaged */ #define fErrNotImp 0x42FF /* request not implemented */ /************************************************************************************************/ /* general Finder data structures */ typedef struct iconObj *iconObjPtr, **iconObjHandle; typedef struct iconObj { iconObjHandle icNext; /* next icon in list (NIL = no more) */ iconObjHandle icLast; /* previous icon in list (NIL = no more) */ WindowPtr icMom; /* window the icon is currently in (NIL = desktop) */ WindowPtr icWind; /* window the icon is opened into */ iconObjHandle icDisk; /* disk iconObj which owns this icon */ long icFlag; /* see below */ word icFType; /* icon's file type */ long icFileInfo; /* file's auxtype or disk's file system */ char *icKind; /* pointer to Kind pstring, or NIL */ word icy; /* vertical position of bottom of icon */ word icx; /* horizontal position of center of icon */ word icTextY; /* icon's vertical position when viewed by text */ word icTitleLen; /* half the width of the icon's title */ char icName[34]; /* pstring name of icon */ word icLocalAccess; /* icon's current local access */ word icForked; /* bit 15 set if file is extended */ long icFBlocks; /* file's size in blocks, or number of used blocks on disk */ long icFBytes; /* file's size in bytes, or total blocks on disk */ TimeRec icCDate; /* create date/time */ TimeRec icMDate; /* last-modified date/time */ long icIcon; /* index into Finder's list of icon images */ long icSmallIcon; /* index into Finder's list of icon images */ Handle icRBundle; /* handle of rBundle which matched this icon, or NIL */ long icOneDocOffset; /* offset to oneDoc within rBundle handle */ WindowPtr icInfo; /* pointer to Icon Info window, or NIL */ word icDevNum; /* device number (valid for disk/device icons) */ word icDevInfo; /* device characteristics (valid for disk/device icons) */ word icOptionList; /* beginning of option list--length */ word icFST; /* FST ID (first data word of option list) */ char bodyOfOptionList[36]; /* next 36 bytes of option list */ long icNetworkAccess; /* access information if FST ID is $0D (AppleShare) */ } iconObj; /* icFlag values */ #define ICSELECTED 0x00000001L #define ICOPENED 0x00000002L #define ICOFFLINE 0x00000004L #define ICEXTENDED 0x00000008L #define ICLOCKED 0x00000080L #define ICFORECLR 0x00000f00L #define ICBACKCLR 0x0000F000L #define ICNETACCESS 0x000F0000L #define ICNETWORK 0x01000000L #define ICREADABLE 0x02000000L typedef struct finderWindBlk { iconObjHandle windIcons; word windID; word windView; iconObjHandle windIc; iconObjHandle windDiskIc; word windItems; long windUsed; long windFree; word windFST; word windAccess; word windDirty; char windTitle[54]; word windMenuItem; char windMenuText[52]; TimeRec windDate; char windPath[991]; } finderWindBlk, *finderWindBlkPtr; /************************************************************************************************/ /* finderSays DataIn Structures */ typedef struct finderSaysHelloIn { word pCount; long versNum; word finderUserID; word iconObjectSize; } finderSaysHelloIn, *finderSaysHelloInPtr; typedef struct finderSaysMItemSelectedIn { word pCount; word menuItemID; word menuID; word modifiers; } finderSaysMItemSelectedIn, *finderSaysMItemSelectedInPtr; typedef struct finderSaysBeforeOpenIn { word pCount; pointer pathname; RectPtr zoomRect; word filetype; long auxtype; word modifiers; iconObjHandle theIconObj; word printFlag; } finderSaysBeforeOpenIn, *finderSaysBeforeOpenInPtr, finderSaysOpenFailedIn, *finderSaysOpenFailedInPtr; typedef struct finderSaysBeforeCopyIn { word pCount; ptr sourcePathname; ptr destinationPathname; } finderSaysBeforeCopyIn, *finderSaysBeforeCopyInPtr; typedef struct finderSaysBeforeRenameIn { word pCount; ptr oldPathname; ptr newPathname; word filetype; long auxtype; } finderSaysBeforeRenameIn, *finderSaysBeforeRenameInPtr; typedef struct finderSaysKeyHitIn { word pCount; word message; word modifiers; } finderSaysKeyHitIn, *finderSaysKeyHitInPtr; /************************************************************************************************/ /* finderSays DataOut Structures */ typedef struct finderSaysMItemSelectedOut { word recvCount; word abortItFlag; } finderSaysMItemSelectedOut, *finderSaysMItemSelectedOutPtr; typedef struct finderSaysBeforeCopyOut { word recvCount; word abortFlag; /* 0 = continue, 1 = abort, 2 - $FFFF reserved */ } finderSaysBeforeCopyOut, *finderSaysBeforeCopyOutPtr; typedef struct finderSaysBeforeRenameOut { word recvCount; word abortFlag; /* boolean, non-zero to abort rename */ } finderSaysBeforeRenameOut, *finderSaysBeforeRenameOutPtr; /************************************************************************************************/ /* tellFinder DataIn Structures */ typedef struct tellFinderLaunchThisIn { word launchprint; ptr pathname; } tellFinderLaunchThisIn, *tellFinderLaunchThisInPtr; typedef struct tellFinderMItemSelectedIn { word menuItemID; word modifiers; word flags; /* bit 15 = hilite, all other bits reserved */ } tellFinderMItemSelectedIn, *tellFinderMItemSelectedInPtr; typedef struct tellFinderMatchFileToIconIn { word pCount; /* 11, minimum 10 */ word votingBits; word whichMatch; /* we want 1 or higher */ word filetype; long auxtype; ptr matchFilenamePtr; ptr createFileInfoPtr; ptr modFileInfoPtr; word localAccess; word flags; /* bit 15 = extended file, all other bits reserved */ ptr optionListPtr; long combinedEOF; /* resource and data fork EOF */ } tellFinderMatchFileToIconIn, *tellFinderMatchFileToIconInPtr; typedef struct tellFinderAddBundleIn { word addHow; /* bit 15 = to Desktop file, bit 14 = to memory */ ptr pathnamePtr; ptr desktopPathnamePtr; long rBundleID; /* NIL if adding to memory only */ } tellFinderAddBundleIn, *tellFinderAddBundleInPtr; typedef struct tellFinderCheckDatabaseIn { word update; /* high bit set if update should take place if match found */ ptr updatePathnamePtr; /* ptr to use for update, NIL if no update */ ptr rVersionPtr; /* must lock this resource */ } tellFinderCheckDatabaseIn, *tellFinderCheckDatabaseInPtr; typedef struct tellFinderSpecialPreferencesIn { word pCount; /* minimum 1 */ word dragHDtoTrash; /* 0=disallow, 1=allow */ } tellFinderSpecialPreferencesIn, *tellFinderSpecialPreferencesInPtr; /************************************************************************************************/ /* tellFinder DataOut Structures */ typedef struct tellFinderGetDebugInfoOut { word recvCount; word finderResult; word pCount; word directPage; handle deskIcon; handle nameChainH; pointer filetypeBlock; pointer deviceBlock; handle masterChainH; handle rFPListHandle; word rFPCount; long reserved[64]; } tellFinderGetDebugInfoOut, *tellFinderGetDebugInfoOutPtr; typedef struct tellFinderAreYouThereOut { word recvCount; word finderResult; } tellFinderAreYouThereOut, *tellFinderAreYouThereOutPtr; typedef struct tellFinderOpenWindowOut { word recvCount; word finderResult; WindowPtr window; } tellFinderOpenWindowOut, *tellFinderOpenWindowOutPtr; typedef struct tellFinderCloseWindowOut { word recvCount; word finderResult; } tellFinderCloseWindowOut, *tellFinderCloseWindowOutPtr; typedef struct tellFinderGetSelectedIconsOut { word recvCount; word finderResult; WindowPtr iconWindowPtr; Handle stringListHandle; } tellFinderGetSelectedIconsOut, *tellFinderGetSelectedIconsOutPtr; typedef struct tellFinderSetSelectedIconsOut { word recvCount; word finderResult; } tellFinderSetSelectedIconsOut, *tellFinderSetSelectedIconsOutPtr; typedef struct tellFinderLaunchThisOut { word recvCount; word finderResult; } tellFinderLaunchThisOut, *tellFinderLaunchThisOutPtr; typedef struct tellFinderShutDownOut { word recvCount; word finderResult; } tellFinderShutDownOut, *tellFinderShutDownOutPtr; typedef struct tellFinderMItemSelectedOut { word recvCount; word finderResult; } tellFinderMItemSelectedOut, *tellFinderMItemSelectedOutPtr; typedef struct tellFinderMatchFileToIconOut { word recvCount; word finderResult; long oneDocOffset; /* NIL if no match */ Handle rBundleHandle; /* NIL if no match */ Handle smallIconHandle; /* Never NIL */ Handle largeIconHandle; /* Never NIL */ Handle rFInderPathHandle; /* NIL if no one owns icon */ } tellFinderMatchFileToIconOut, *tellFinderMatchFileToIconOutPtr; typedef struct tellFinderAddBundleOut { word recvCount; word finderResult; } tellFinderAddBundleOut, *tellFinderAddBundleOutPtr; typedef struct tellFinderAboutChangeOut { word recvCount; word finderResult; } tellFinderAboutChangeOut, *tellFinderAboutChangeOutPtr; typedef struct tellFinderCheckDatabaseOut { word recvCount; word finderResult; word match; /* 0 if no match found, non-zero if match found */ } tellFinderCheckDatabaseOut, *tellFinderCheckDatabaseOutPtr; typedef struct tellFinderColorSelectionOut { word recvCount; word finderResult; } tellFinderColorSelectionOut, *tellFinderColorSelectionOutPtr; typedef struct tellFinderAddToExtrasOut { word recvCount; word finderResult; word menuItemID; word menuID; } tellFinderAddToExtrasOut, *tellFinderAddToExtrasOutPtr; typedef struct tellFinderIdleHowLongOut { word recvCount; word finderResult; long tickCount; } tellFinderIdleHowLongOut, *tellFinderIdleHowLongOutPtr; typedef struct tellFinderGetWindowIconsOut { word recvCount; word finderResult; Handle stringListHandle; } tellFinderGetWindowIconsOut, *tellFinderGetWindowIconsOutPtr; typedef struct tellFinderGetWindowInfoOut { word recvCount; word finderResult; word windowType; word windView; word windFST; char *windTitle; ptr windPath; long reserved1; long reserved2; } tellFinderGetWindowInfoOut, *tellFinderGetWindowInfoOutPtr; typedef struct tellFinderRemoveFromExtrasOut { word recvCount; word finderResult; } tellFinderRemoveFromExtrasOut, *tellFinderRemoveFromExtrasOutPtr; typedef struct tellFinderSpecialPreferencesOut { word recvCount; word finderResult; } tellFinderSpecialPreferencesOut, *tellFinderSpecialPreferencesOutPtr; #endif \ No newline at end of file +/******************************************** +; File: Finder.h +; +; Copyright Apple Computer, Inc. 1991-92 +; All Rights Reserved +; +********************************************/ +#ifndef __TYPES__ +#include +#endif + +#ifndef __QUICKDRAW__ +#include +#endif + +#ifndef __EVENT__ +#include +#endif + +#ifndef __WINDOW__ +#include +#endif + +#ifndef __FINDER__ +#define __FINDER__ + +/* target name for SendRequest to Finder */ +#define NAME_OF_FINDER "\pApple~Finder~" + +/* SendRequest codes sent by the Finder */ +#define finderSaysHello 0x0100 +#define finderSaysGoodbye 0x0101 +#define finderSaysSelectionChanged 0x0102 +#define finderSaysMItemSelected 0x0103 +#define finderSaysBeforeOpen 0x0104 +#define finderSaysOpenFailed 0x0105 +#define finderSaysBeforeCopy 0x0106 +#define finderSaysIdle 0x0107 +#define finderSaysExtrasChosen 0x0108 +#define finderSaysBeforeRename 0x0109 +#define finderSaysKeyHit 0x010A + +/************************************************************************************************/ + +/* SendRequest codes sent to the Finder (target = "Apple~Finder~") */ +#define tellFinderGetDebugInfo 0x8000 +#define tellFinderAreYouThere 0x8001 +#define askFinderAreYouThere 0x8001 +#define tellFinderOpenWindow 0x8002 +#define tellFinderCloseWindow 0x8003 +#define tellFinderGetSelectedIcons 0x8004 +#define tellFinderSetSelectedIcons 0x8005 +#define tellFinderLaunchThis 0x8006 +#define tellFinderShutDown 0x8007 +#define tellFinderMItemSelected 0x8008 +#define tellFinderMatchFileToIcon 0x800A +#define tellFinderAddBundle 0x800B +#define tellFinderAboutChange 0x800C +#define tellFinderCheckDatabase 0x800D +#define tellFinderColorSelection 0x800E +#define tellFinderAddToExtras 0x800F +#define tellFinderIdleHowLong 0x8011 +#define askFinderIdleHowLong 0x8011 +#define tellFinderGetWindowIcons 0x8012 +#define tellFinderGetWindowInfo 0x8013 +#define tellFinderRemoveFromExtras 0x8014 +#define tellFinderSpecialPreferences 0x8015 + +/************************************************************************************************/ + +/* Finder menu item IDs */ +#define finderItemAbout 0x012D +#define finderItemHelp 0x012E +#define finderItemNewFolder 0x015F +#define finderItemOpen 0x0160 +#define finderItemPrint 0x0161 +#define finderItemClose 0x0162 +#define finderItemCloseAll 0x0163 +#define finderItemDuplicate 0x0164 +#define finderItemPutAway 0x0165 +#define finderItemValidate 0x0166 +#define finderItemUndo 0x00FA +#define finderItemCut 0x00FB +#define finderItemCopy 0x00FC +#define finderItemPaste 0x00FD +#define finderItemClear 0x00FE +#define finderItemSelectAll 0x0191 +#define finderItemShowClipboard 0x0192 +#define finderItemStackWindows 0x01C3 +#define finderItemByIcon 0x01F5 +#define finderItemBySmallIcon 0x01F6 +#define finderItemByName 0x01F7 +#define finderItemByDate 0x01F8 +#define finderItemBySize 0x01F9 +#define finderItemByKind 0x01FA +#define finderItemFormat 0x0227 +#define finderItemErase 0x0228 +#define finderItemVerify 0x0229 +#define finderItemEject 0x022A +#define finderItemCleanUp 0x0259 +#define finderItemEmptyTrash 0x025A +#define finderItemPreferences 0x025B +#define finderItemIconInfo 0x025C +#define finderItemShutDown 0x025D +#define finderItemCleanUpByName 0x025E +#define finderItemColorBlack 0x028B +#define finderItemColorBlue 0x028C +#define finderItemColorYellowBrown 0x028D +#define finderItemColorGray1 0x028E +#define finderItemColorRed 0x028F +#define finderItemColorPurple 0x0290 +#define finderItemColorOrange 0x0291 +#define finderItemColorPink 0x0292 +#define finderItemColorDarkGreen 0x0293 +#define finderItemColorAqua 0x0294 +#define finderItemColorBrightGreen 0x0295 +#define finderItemColorPaleGreen 0x0296 +#define finderItemColorPeriwinkleBlue 0x0298 +#define finderItemColorYellow 0x0299 +#define finderItemColorWhite 0x029A + +/************************************************************************************************/ + +/* Finder SendRequest Result Error Codes */ +#define fErrNoError 0x0000 /* no error */ +#define fErrBadInput 0x4201 /* bad input value */ +#define fErrFailed 0x4202 /* could not complete request */ +#define fErrCancel 0x4203 /* user cancelled operation */ +#define fErrDimmed 0x4204 /* menu item was dimmed */ +#define fErrBusy 0x4205 /* not now, finder has headache */ +#define fErrNotPrudent 0x4206 /* can't add Finder's resources to desktop file */ +#define fErrBadBundle 0x4207 /* unknown rBundle version, or rBundle damaged */ +#define fErrNotImp 0x42FF /* request not implemented */ + +/************************************************************************************************/ + +/* general Finder data structures */ + +typedef struct iconObj *iconObjPtr, **iconObjHandle; +typedef struct iconObj { + iconObjHandle icNext; /* next icon in list (NIL = no more) */ + iconObjHandle icLast; /* previous icon in list (NIL = no more) */ + WindowPtr icMom; /* window the icon is currently in (NIL = desktop) */ + WindowPtr icWind; /* window the icon is opened into */ + iconObjHandle icDisk; /* disk iconObj which owns this icon */ + long icFlag; /* see below */ + word icFType; /* icon's file type */ + long icFileInfo; /* file's auxtype or disk's file system */ + char *icKind; /* pointer to Kind pstring, or NIL */ + word icy; /* vertical position of bottom of icon */ + word icx; /* horizontal position of center of icon */ + word icTextY; /* icon's vertical position when viewed by text */ + word icTitleLen; /* half the width of the icon's title */ + char icName[34]; /* pstring name of icon */ + word icLocalAccess; /* icon's current local access */ + word icForked; /* bit 15 set if file is extended */ + long icFBlocks; /* file's size in blocks, or number of used blocks on disk */ + long icFBytes; /* file's size in bytes, or total blocks on disk */ + TimeRec icCDate; /* create date/time */ + TimeRec icMDate; /* last-modified date/time */ + long icIcon; /* index into Finder's list of icon images */ + long icSmallIcon; /* index into Finder's list of icon images */ + Handle icRBundle; /* handle of rBundle which matched this icon, or NIL */ + long icOneDocOffset; /* offset to oneDoc within rBundle handle */ + WindowPtr icInfo; /* pointer to Icon Info window, or NIL */ + word icDevNum; /* device number (valid for disk/device icons) */ + word icDevInfo; /* device characteristics (valid for disk/device icons) */ + word icOptionList; /* beginning of option list--length */ + word icFST; /* FST ID (first data word of option list) */ + char bodyOfOptionList[36]; /* next 36 bytes of option list */ + long icNetworkAccess; /* access information if FST ID is $0D (AppleShare) */ + } iconObj; + +/* icFlag values */ + +#define ICSELECTED 0x00000001L +#define ICOPENED 0x00000002L +#define ICOFFLINE 0x00000004L +#define ICEXTENDED 0x00000008L +#define ICLOCKED 0x00000080L +#define ICFORECLR 0x00000f00L +#define ICBACKCLR 0x0000F000L +#define ICNETACCESS 0x000F0000L +#define ICNETWORK 0x01000000L +#define ICREADABLE 0x02000000L + +typedef struct finderWindBlk { + iconObjHandle windIcons; + word windID; + word windView; + iconObjHandle windIc; + iconObjHandle windDiskIc; + word windItems; + long windUsed; + long windFree; + word windFST; + word windAccess; + word windDirty; + char windTitle[54]; + word windMenuItem; + char windMenuText[52]; + TimeRec windDate; + char windPath[991]; + } finderWindBlk, *finderWindBlkPtr; + +/************************************************************************************************/ + +/* finderSays DataIn Structures */ + +typedef struct finderSaysHelloIn { + word pCount; + long versNum; + word finderUserID; + word iconObjectSize; + } finderSaysHelloIn, *finderSaysHelloInPtr; + +typedef struct finderSaysMItemSelectedIn { + word pCount; + word menuItemID; + word menuID; + word modifiers; + } finderSaysMItemSelectedIn, *finderSaysMItemSelectedInPtr; + +typedef struct finderSaysBeforeOpenIn { + word pCount; + pointer pathname; + RectPtr zoomRect; + word filetype; + long auxtype; + word modifiers; + iconObjHandle theIconObj; + word printFlag; + } finderSaysBeforeOpenIn, *finderSaysBeforeOpenInPtr, + finderSaysOpenFailedIn, *finderSaysOpenFailedInPtr; + +typedef struct finderSaysBeforeCopyIn { + word pCount; + ptr sourcePathname; + ptr destinationPathname; + } finderSaysBeforeCopyIn, *finderSaysBeforeCopyInPtr; + +typedef struct finderSaysBeforeRenameIn { + word pCount; + ptr oldPathname; + ptr newPathname; + word filetype; + long auxtype; + } finderSaysBeforeRenameIn, *finderSaysBeforeRenameInPtr; + +typedef struct finderSaysKeyHitIn { + word pCount; + word message; + word modifiers; + } finderSaysKeyHitIn, *finderSaysKeyHitInPtr; + +/************************************************************************************************/ + +/* finderSays DataOut Structures */ + +typedef struct finderSaysMItemSelectedOut { + word recvCount; + word abortItFlag; + } finderSaysMItemSelectedOut, *finderSaysMItemSelectedOutPtr; + +typedef struct finderSaysBeforeCopyOut { + word recvCount; + word abortFlag; /* 0 = continue, 1 = abort, 2 - $FFFF reserved */ + } finderSaysBeforeCopyOut, *finderSaysBeforeCopyOutPtr; + +typedef struct finderSaysBeforeRenameOut { + word recvCount; + word abortFlag; /* boolean, non-zero to abort rename */ + } finderSaysBeforeRenameOut, *finderSaysBeforeRenameOutPtr; + + +/************************************************************************************************/ + +/* tellFinder DataIn Structures */ + +typedef struct tellFinderLaunchThisIn { + word launchprint; + ptr pathname; + } tellFinderLaunchThisIn, *tellFinderLaunchThisInPtr; + +typedef struct tellFinderMItemSelectedIn { + word menuItemID; + word modifiers; + word flags; /* bit 15 = hilite, all other bits reserved */ +} tellFinderMItemSelectedIn, *tellFinderMItemSelectedInPtr; + +typedef struct tellFinderMatchFileToIconIn { + word pCount; /* 11, minimum 10 */ + word votingBits; + word whichMatch; /* we want 1 or higher */ + word filetype; + long auxtype; + ptr matchFilenamePtr; + ptr createFileInfoPtr; + ptr modFileInfoPtr; + word localAccess; + word flags; /* bit 15 = extended file, all other bits reserved */ + ptr optionListPtr; + long combinedEOF; /* resource and data fork EOF */ + } tellFinderMatchFileToIconIn, *tellFinderMatchFileToIconInPtr; + +typedef struct tellFinderAddBundleIn { + word addHow; /* bit 15 = to Desktop file, bit 14 = to memory */ + ptr pathnamePtr; + ptr desktopPathnamePtr; + long rBundleID; /* NIL if adding to memory only */ + } tellFinderAddBundleIn, *tellFinderAddBundleInPtr; + +typedef struct tellFinderCheckDatabaseIn { + word update; /* high bit set if update should take place if match found */ + ptr updatePathnamePtr; /* ptr to use for update, NIL if no update */ + ptr rVersionPtr; /* must lock this resource */ + } tellFinderCheckDatabaseIn, *tellFinderCheckDatabaseInPtr; + +typedef struct tellFinderSpecialPreferencesIn { + word pCount; /* minimum 1 */ + word dragHDtoTrash; /* 0=disallow, 1=allow */ + } tellFinderSpecialPreferencesIn, *tellFinderSpecialPreferencesInPtr; + +/************************************************************************************************/ + +/* tellFinder DataOut Structures */ + +typedef struct tellFinderGetDebugInfoOut { + word recvCount; + word finderResult; + word pCount; + word directPage; + handle deskIcon; + handle nameChainH; + pointer filetypeBlock; + pointer deviceBlock; + handle masterChainH; + handle rFPListHandle; + word rFPCount; + long reserved[64]; + } tellFinderGetDebugInfoOut, *tellFinderGetDebugInfoOutPtr; + +typedef struct tellFinderAreYouThereOut { + word recvCount; + word finderResult; + } tellFinderAreYouThereOut, *tellFinderAreYouThereOutPtr; + +typedef struct tellFinderOpenWindowOut { + word recvCount; + word finderResult; + WindowPtr window; + } tellFinderOpenWindowOut, *tellFinderOpenWindowOutPtr; + +typedef struct tellFinderCloseWindowOut { + word recvCount; + word finderResult; + } tellFinderCloseWindowOut, *tellFinderCloseWindowOutPtr; + +typedef struct tellFinderGetSelectedIconsOut { + word recvCount; + word finderResult; + WindowPtr iconWindowPtr; + Handle stringListHandle; + } tellFinderGetSelectedIconsOut, *tellFinderGetSelectedIconsOutPtr; + +typedef struct tellFinderSetSelectedIconsOut { + word recvCount; + word finderResult; + } tellFinderSetSelectedIconsOut, *tellFinderSetSelectedIconsOutPtr; + +typedef struct tellFinderLaunchThisOut { + word recvCount; + word finderResult; + } tellFinderLaunchThisOut, *tellFinderLaunchThisOutPtr; + +typedef struct tellFinderShutDownOut { + word recvCount; + word finderResult; + } tellFinderShutDownOut, *tellFinderShutDownOutPtr; + +typedef struct tellFinderMItemSelectedOut { + word recvCount; + word finderResult; + } tellFinderMItemSelectedOut, *tellFinderMItemSelectedOutPtr; + +typedef struct tellFinderMatchFileToIconOut { + word recvCount; + word finderResult; + long oneDocOffset; /* NIL if no match */ + Handle rBundleHandle; /* NIL if no match */ + Handle smallIconHandle; /* Never NIL */ + Handle largeIconHandle; /* Never NIL */ + Handle rFInderPathHandle; /* NIL if no one owns icon */ + } tellFinderMatchFileToIconOut, *tellFinderMatchFileToIconOutPtr; + +typedef struct tellFinderAddBundleOut { + word recvCount; + word finderResult; + } tellFinderAddBundleOut, *tellFinderAddBundleOutPtr; + +typedef struct tellFinderAboutChangeOut { + word recvCount; + word finderResult; + } tellFinderAboutChangeOut, *tellFinderAboutChangeOutPtr; + +typedef struct tellFinderCheckDatabaseOut { + word recvCount; + word finderResult; + word match; /* 0 if no match found, non-zero if match found */ + } tellFinderCheckDatabaseOut, *tellFinderCheckDatabaseOutPtr; + +typedef struct tellFinderColorSelectionOut { + word recvCount; + word finderResult; + } tellFinderColorSelectionOut, *tellFinderColorSelectionOutPtr; + +typedef struct tellFinderAddToExtrasOut { + word recvCount; + word finderResult; + word menuItemID; + word menuID; + } tellFinderAddToExtrasOut, *tellFinderAddToExtrasOutPtr; + +typedef struct tellFinderIdleHowLongOut { + word recvCount; + word finderResult; + long tickCount; + } tellFinderIdleHowLongOut, *tellFinderIdleHowLongOutPtr; + +typedef struct tellFinderGetWindowIconsOut { + word recvCount; + word finderResult; + Handle stringListHandle; + } tellFinderGetWindowIconsOut, *tellFinderGetWindowIconsOutPtr; + +typedef struct tellFinderGetWindowInfoOut { + word recvCount; + word finderResult; + word windowType; + word windView; + word windFST; + char *windTitle; + ptr windPath; + long reserved1; + long reserved2; + } tellFinderGetWindowInfoOut, *tellFinderGetWindowInfoOutPtr; + +typedef struct tellFinderRemoveFromExtrasOut { + word recvCount; + word finderResult; + } tellFinderRemoveFromExtrasOut, *tellFinderRemoveFromExtrasOutPtr; + +typedef struct tellFinderSpecialPreferencesOut { + word recvCount; + word finderResult; + } tellFinderSpecialPreferencesOut, *tellFinderSpecialPreferencesOutPtr; + + +#endif diff --git a/bin/Libraries/ORCACDefs/float.h b/bin/Libraries/ORCACDefs/float.h index f5de853..1ac820c 100644 --- a/bin/Libraries/ORCACDefs/float.h +++ b/bin/Libraries/ORCACDefs/float.h @@ -1 +1,56 @@ -/**************************************************************** * * float.h - limits on the size of real numbers * * October 1989 * Mike Westerfield * * Copyright 1989 * Byte Works, Inc. * ****************************************************************/ #ifndef __float__ #define __float__ #define FLT_ROUNDS 1 #define FLT_RADIX 2 #define FLT_MANT_DIG 24 #define DBL_MANT_DIG 53 #define LDBL_MANT_DIG 53 #define FLT_DIG 6 #define DBL_DIG 15 #define LDBL_DIG 15 #define FLT_MIN_EXP -125 #define DBL_MIN_EXP -1021 #define LDBL_MIN_EXP -1021 #define FLT_MIN_10_EXP -37 #define DBL_MIN_10_EXP -307 #define LDBL_MIN_10_EXP -307 #define FLT_MAX_EXP 128 #define DBL_MAX_EXP 1024 #define LDBL_MAX_EXP 1024 #define FLT_MAX_10_EXP 38 #define DBL_MAX_10_EXP 308 #define LDBL_MAX_10_EXP 308 #define FLT_MAX 3.40282347E+38F #define DBL_MAX 1.7976931348623157E+308 #define LDBL_MAX 1.7976931348623157E+308 #define FLT_EPSILON 1.19209290E-07F #define DBL_EPSILON 2.2204460492503131E-16 #define LDBL_EPSILON 2.2204460492503131E-16 #define FLT_MIN 1.17549435E-38F #define DBL_MIN 2.2250738585072014E-308 #define LDBL_MIN 2.2250738585072014E-308 #endif \ No newline at end of file +/**************************************************************** +* +* float.h - limits on the size of real numbers +* +* October 1989 +* Mike Westerfield +* +* Copyright 1989 +* Byte Works, Inc. +* +****************************************************************/ + +#ifndef __float__ +#define __float__ + +#define FLT_ROUNDS 1 + +#define FLT_RADIX 2 + +#define FLT_MANT_DIG 24 +#define DBL_MANT_DIG 53 +#define LDBL_MANT_DIG 53 + +#define FLT_DIG 6 +#define DBL_DIG 15 +#define LDBL_DIG 15 + +#define FLT_MIN_EXP -125 +#define DBL_MIN_EXP -1021 +#define LDBL_MIN_EXP -1021 + +#define FLT_MIN_10_EXP -37 +#define DBL_MIN_10_EXP -307 +#define LDBL_MIN_10_EXP -307 + +#define FLT_MAX_EXP 128 +#define DBL_MAX_EXP 1024 +#define LDBL_MAX_EXP 1024 + +#define FLT_MAX_10_EXP 38 +#define DBL_MAX_10_EXP 308 +#define LDBL_MAX_10_EXP 308 + +#define FLT_MAX 3.40282347E+38F +#define DBL_MAX 1.7976931348623157E+308 +#define LDBL_MAX 1.7976931348623157E+308 + +#define FLT_EPSILON 1.19209290E-07F +#define DBL_EPSILON 2.2204460492503131E-16 +#define LDBL_EPSILON 2.2204460492503131E-16 + +#define FLT_MIN 1.17549435E-38F +#define DBL_MIN 2.2250738585072014E-308 +#define LDBL_MIN 2.2250738585072014E-308 + +#endif diff --git a/bin/Libraries/ORCACDefs/font.h b/bin/Libraries/ORCACDefs/font.h index 382d9a5..e8fc6a5 100644 --- a/bin/Libraries/ORCACDefs/font.h +++ b/bin/Libraries/ORCACDefs/font.h @@ -1 +1,111 @@ -/******************************************** * * Font Manager * * Copyright Apple Computer, Inc. 1986-91 * All Rights Reserved * * Copyright 1992, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __FONT__ #define __FONT__ /* Error Codes */ #define fmDupStartUpErr 0x1B01 /* duplicate FMStartUp call */ #define fmResetErr 0x1B02 /* can't reset the Font Manager */ #define fmNotActiveErr 0x1B03 /* Font Manager not active */ #define fmFamNotFndErr 0x1B04 /* family not found */ #define fmFontNtFndErr 0x1B05 /* font not found */ #define fmFontMemErr 0x1B06 /* font not in memory */ #define fmSysFontErr 0x1B07 /* system font cannot be purgeable */ #define fmBadFamNumErr 0x1B08 /* illegal family number */ #define fmBadSizeErr 0x1B09 /* illegal size */ #define fmBadNameErr 0x1B0A /* illegal name length */ #define fmMenuErr 0x1B0B /* fix font menu never called */ #define fmScaleSizeErr 0x1B0C /* scaled size of font exeeds limits */ #define fmBadParmErr 0x1B0D /* Font Family Numbers */ #define chicago 0xFFFD #define shaston 0xFFFE #define systemFont0 0x0000 #define systemFont1 0x0001 #define newYork 0x0002 #define geneva 0x0003 #define monaco 0x0004 #define venice 0x0005 #define london 0x0006 #define athens 0x0007 #define sanFrancisco 0x0008 #define toronto 0x0009 #define cairo 0x000B #define losAngeles 0x000C #define zapfDingbats 0x000D #define bookman 0x000E #define helveticaNarrow 0x000F #define palatino 0x0010 #define zapfChancery 0x0012 #define times 0x0014 #define helvetica 0x0015 #define courier 0x0016 #define symbol 0x0017 #define taliesin 0x0018 #define avanteGarde 0x0021 #define newCenturySchoolbook 0x0022 #define baseOnlyBit 0x0020 /* FamSpecBits */ #define notBaseBit 0x0020 /* FamStatBits */ #define memOnlyBit 0x0001 /* FontSpecBits */ #define realOnlyBit 0x0002 /* FontSpecBits */ #define anyFamBit 0x0004 /* FontSpecBits */ #define anyStyleBit 0x0008 /* FontSpecBits */ #define anySizeBit 0x0010 /* FontSpecBits */ #define memBit 0x0001 /* FontStatBits */ #define unrealBit 0x0002 /* FontStatBits */ #define apFamBit 0x0004 /* FontStatBits */ #define apVarBit 0x0008 /* FontStatBits */ #define purgeBit 0x0010 /* FontStatBits */ #define notDiskBit 0x0020 /* FontStatBits */ #define notFoundBit 0x8000 /* FontStatBits */ #define dontScaleBit 0x0001 /* Scale Word */ struct FontStatRec { FontID resultID; Word resultStats; }; typedef struct FontStatRec FontStatRec, *FontStatRecPtr, **FontStatRecHndl; extern pascal void FMBootInit(void) inline(0x011B,dispatcher); extern pascal void FMStartUp(Word, Word) inline(0x021B,dispatcher); extern pascal void FMShutDown(void) inline(0x031B,dispatcher); extern pascal Word FMVersion(void) inline(0x041B,dispatcher); extern pascal void FMReset(void) inline(0x051B,dispatcher); extern pascal Boolean FMStatus(void) inline(0x061B,dispatcher); extern pascal void AddFamily(Word, Pointer) inline(0x0D1B,dispatcher); extern pascal void AddFontVar(FontHndl, Word) inline(0x141B,dispatcher); extern pascal LongWord ChooseFont(FontID, Word) inline(0x161B,dispatcher); extern pascal Word CountFamilies(Word) inline(0x091B,dispatcher); extern pascal Word CountFonts(FontID, Word) inline(0x101B,dispatcher); extern pascal Word FamNum2ItemID(Word) inline(0x1B1B,dispatcher); extern pascal Word FindFamily(Word, Word, Pointer) inline(0x0A1B,dispatcher); extern pascal void FindFontStats(FontID, Word, Word, FontStatRecPtr) inline(0x111B,dispatcher); extern pascal void FixFontMenu(Word, Word, Word) inline(0x151B,dispatcher); extern pascal LongWord FMGetCurFID(void) inline(0x1A1B,dispatcher); extern pascal LongWord FMGetSysFID(void) inline(0x191B,dispatcher); extern pascal void FMSetSysFont(FontID) inline(0x181B,dispatcher); extern pascal Word GetFamInfo(Word, Pointer) inline(0x0B1B,dispatcher); extern pascal Word GetFamNum(Pointer) inline(0x0C1B,dispatcher); extern pascal void InstallFont(FontID, Word) inline(0x0E1B,dispatcher); extern pascal Word ItemID2FamNum(Word) inline(0x171B,dispatcher); extern pascal void LoadFont(FontID, Word, Word, FontStatRecPtr) inline(0x121B,dispatcher); extern pascal void LoadSysFont(void) inline(0x131B,dispatcher); extern pascal void SetPurgeStat(FontID, Word) inline(0x0F1B,dispatcher); extern pascal void InstallWithStats(FontID, Word, Pointer) inline(0x1C1B,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Font Manager +* +* Copyright Apple Computer, Inc. 1986-91 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __FONT__ +#define __FONT__ + +/* Error Codes */ +#define fmDupStartUpErr 0x1B01 /* duplicate FMStartUp call */ +#define fmResetErr 0x1B02 /* can't reset the Font Manager */ +#define fmNotActiveErr 0x1B03 /* Font Manager not active */ +#define fmFamNotFndErr 0x1B04 /* family not found */ +#define fmFontNtFndErr 0x1B05 /* font not found */ +#define fmFontMemErr 0x1B06 /* font not in memory */ +#define fmSysFontErr 0x1B07 /* system font cannot be purgeable */ +#define fmBadFamNumErr 0x1B08 /* illegal family number */ +#define fmBadSizeErr 0x1B09 /* illegal size */ +#define fmBadNameErr 0x1B0A /* illegal name length */ +#define fmMenuErr 0x1B0B /* fix font menu never called */ +#define fmScaleSizeErr 0x1B0C /* scaled size of font exeeds limits */ +#define fmBadParmErr 0x1B0D + +/* Font Family Numbers */ +#define chicago 0xFFFD +#define shaston 0xFFFE +#define systemFont0 0x0000 +#define systemFont1 0x0001 +#define newYork 0x0002 +#define geneva 0x0003 +#define monaco 0x0004 +#define venice 0x0005 +#define london 0x0006 +#define athens 0x0007 +#define sanFrancisco 0x0008 +#define toronto 0x0009 +#define cairo 0x000B +#define losAngeles 0x000C +#define zapfDingbats 0x000D +#define bookman 0x000E +#define helveticaNarrow 0x000F +#define palatino 0x0010 +#define zapfChancery 0x0012 +#define times 0x0014 +#define helvetica 0x0015 +#define courier 0x0016 +#define symbol 0x0017 +#define taliesin 0x0018 +#define avanteGarde 0x0021 +#define newCenturySchoolbook 0x0022 +#define baseOnlyBit 0x0020 /* FamSpecBits */ +#define notBaseBit 0x0020 /* FamStatBits */ +#define memOnlyBit 0x0001 /* FontSpecBits */ +#define realOnlyBit 0x0002 /* FontSpecBits */ +#define anyFamBit 0x0004 /* FontSpecBits */ +#define anyStyleBit 0x0008 /* FontSpecBits */ +#define anySizeBit 0x0010 /* FontSpecBits */ +#define memBit 0x0001 /* FontStatBits */ +#define unrealBit 0x0002 /* FontStatBits */ +#define apFamBit 0x0004 /* FontStatBits */ +#define apVarBit 0x0008 /* FontStatBits */ +#define purgeBit 0x0010 /* FontStatBits */ +#define notDiskBit 0x0020 /* FontStatBits */ +#define notFoundBit 0x8000 /* FontStatBits */ +#define dontScaleBit 0x0001 /* Scale Word */ + +struct FontStatRec { + FontID resultID; + Word resultStats; + }; +typedef struct FontStatRec FontStatRec, *FontStatRecPtr, **FontStatRecHndl; + +extern pascal void FMBootInit(void) inline(0x011B,dispatcher); +extern pascal void FMStartUp(Word, Word) inline(0x021B,dispatcher); +extern pascal void FMShutDown(void) inline(0x031B,dispatcher); +extern pascal Word FMVersion(void) inline(0x041B,dispatcher); +extern pascal void FMReset(void) inline(0x051B,dispatcher); +extern pascal Boolean FMStatus(void) inline(0x061B,dispatcher); +extern pascal void AddFamily(Word, Pointer) inline(0x0D1B,dispatcher); +extern pascal void AddFontVar(FontHndl, Word) inline(0x141B,dispatcher); +extern pascal LongWord ChooseFont(FontID, Word) inline(0x161B,dispatcher); +extern pascal Word CountFamilies(Word) inline(0x091B,dispatcher); +extern pascal Word CountFonts(FontID, Word) inline(0x101B,dispatcher); +extern pascal Word FamNum2ItemID(Word) inline(0x1B1B,dispatcher); +extern pascal Word FindFamily(Word, Word, Pointer) inline(0x0A1B,dispatcher); +extern pascal void FindFontStats(FontID, Word, Word, FontStatRecPtr) inline(0x111B,dispatcher); +extern pascal void FixFontMenu(Word, Word, Word) inline(0x151B,dispatcher); +extern pascal LongWord FMGetCurFID(void) inline(0x1A1B,dispatcher); +extern pascal LongWord FMGetSysFID(void) inline(0x191B,dispatcher); +extern pascal void FMSetSysFont(FontID) inline(0x181B,dispatcher); +extern pascal Word GetFamInfo(Word, Pointer) inline(0x0B1B,dispatcher); +extern pascal Word GetFamNum(Pointer) inline(0x0C1B,dispatcher); +extern pascal void InstallFont(FontID, Word) inline(0x0E1B,dispatcher); +extern pascal Word ItemID2FamNum(Word) inline(0x171B,dispatcher); +extern pascal void LoadFont(FontID, Word, Word, FontStatRecPtr) inline(0x121B,dispatcher); +extern pascal void LoadSysFont(void) inline(0x131B,dispatcher); +extern pascal void SetPurgeStat(FontID, Word) inline(0x0F1B,dispatcher); + +extern pascal void InstallWithStats(FontID, Word, Pointer) inline(0x1C1B,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/gsbug.h b/bin/Libraries/ORCACDefs/gsbug.h index 721b771..4352a6b 100644 --- a/bin/Libraries/ORCACDefs/gsbug.h +++ b/bin/Libraries/ORCACDefs/gsbug.h @@ -1 +1,26 @@ -/******************************************** ; File: GSBug.h ; ; ; Copyright Apple Computer, Inc. 1991 ; All Rights Reserved ; ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __GSBUG__ #define __GSBUG__ #define dgiProgramCounter 0 /* for DebugGetInfo */ extern pascal Word DebugVersion() inline(0x04FF,dispatcher); extern pascal Word DebugStatus() inline(0x06FF,dispatcher); extern pascal void DebugStr() inline(0x09FF,dispatcher); extern pascal void SetMileStone() inline(0x0AFF,dispatcher); extern pascal void DebugSetHook() inline(0x0BFF,dispatcher); extern pascal LongWord DebugGetInfo() inline(0x0CFF,dispatcher); #endif \ No newline at end of file +/******************************************** +; File: GSBug.h +; +; +; Copyright Apple Computer, Inc. 1991 +; All Rights Reserved +; +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __GSBUG__ +#define __GSBUG__ + +#define dgiProgramCounter 0 /* for DebugGetInfo */ + +extern pascal Word DebugVersion() inline(0x04FF,dispatcher); +extern pascal Word DebugStatus() inline(0x06FF,dispatcher); +extern pascal void DebugStr() inline(0x09FF,dispatcher); +extern pascal void SetMileStone() inline(0x0AFF,dispatcher); +extern pascal void DebugSetHook() inline(0x0BFF,dispatcher); +extern pascal LongWord DebugGetInfo() inline(0x0CFF,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/gsos.h b/bin/Libraries/ORCACDefs/gsos.h index 51af05a..34f4a93 100644 --- a/bin/Libraries/ORCACDefs/gsos.h +++ b/bin/Libraries/ORCACDefs/gsos.h @@ -1 +1,632 @@ -/******************************************** * * GS/OS * * Copyright Apple Computer, Inc.1986-91 * All Rights Reserved * * Copyright 1992, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __GSOS__ #define __GSOS__ /* Read/Write enable bit Codes for CreateRec/OpenRec access and requestAccess fields */ #define readEnableAllowWrite 0x0000 #define readEnable 0x0001 #define writeEnable 0x0002 #define readWriteEnable 0x0003 #define fileInvisible 0x0004 /* Invisible bit */ #define backupNeeded 0x0020 /* backup needed bit: CreateRec/ OpenRec access field. (Must be 0 in requestAccess field ) */ #define renameEnable 0x0040 /* rename enable bit: CreateRec/ OpenRec access and requestAccess fields */ #define destroyEnable 0x0080 /* destroy enable bit: CreateRec/ OpenRec access and requestAccess fields */ #define startPlus 0x0000 /* base -> setMark = displacement */ #define eofMinus 0x0001 /* base -> setMark = eof - displacement */ #define markPlus 0x0002 /* base -> setMark = mark + displacement */ #define markMinus 0x0003 /* base -> setMark = mark - displacement */ /* cachePriority Codes */ #define cacheOff 0x0000 /* do not cache blocks invloved in this read */ #define cacheOn 0x0001 /* cache blocks invloved in this read if possible */ /* Error Codes */ #define badSystemCall 0x0001 /* bad system call number */ #define invalidPcount 0x0004 /* invalid parameter count */ #define gsosActive 0x0007 /* GS/OS already active */ #ifndef devNotFound /* device not found */ #define devNotFound 0x0010 #endif #define invalidDevNum 0x0011 /* invalid device number */ #define drvrBadReq 0x0020 /* bad request or command */ #define drvrBadCode 0x0021 /* bad control or status code */ #define drvrBadParm 0x0022 /* bad call parameter */ #define drvrNotOpen 0x0023 /* character device not open */ #define drvrPriorOpen 0x0024 /* character device already open */ #define irqTableFull 0x0025 /* interrupt table full */ #define drvrNoResrc 0x0026 /* resources not available */ #define drvrIOError 0x0027 /* I/O error */ #define drvrNoDevice 0x0028 /* device not connected */ #define drvrBusy 0x0029 /* call aborted; driver is busy */ #define drvrWrtProt 0x002B /* device is write protected */ #define drvrBadCount 0x002C /* invalid byte count */ #define drvrBadBlock 0x002D /* invalid block address */ #define drvrDiskSwitch 0x002E /* disk has been switched */ #define drvrOffLine 0x002F /* device off line/ no media present */ #define badPathSyntax 0x0040 /* invalid pathname syntax */ #define tooManyFilesOpen 0x0042 /* too many files open on server volume */ #define invalidRefNum 0x0043 /* invalid reference number */ #ifndef pathNotFound /* subdirectory does not exist */ #define pathNotFound 0x0044 #endif #define volNotFound 0x0045 /* volume not found */ #ifndef fileNotFound /* file not found */ #define fileNotFound 0x0046 #endif #define dupPathname 0x0047 /* create or rename with existing name */ #define volumeFull 0x0048 /* volume full error */ #define volDirFull 0x0049 /* volume directory full */ #define badFileFormat 0x004A /* version error (incompatible file format) */ #ifndef badStoreType /* unsupported (or incorrect) storage type */ #define badStoreType 0x004B #endif #ifndef eofEncountered /* end-of-file encountered */ #define eofEncountered 0x004C #endif #define outOfRange 0x004D /* position out of range */ #define invalidAccess 0x004E /* access not allowed */ #define buffTooSmall 0x004F /* buffer too small */ #define fileBusy 0x0050 /* file is already open */ #define dirError 0x0051 /* directory error */ #define unknownVol 0x0052 /* unknown volume type */ #ifndef paramRangeErr /* parameter out of range */ #define paramRangeErr 0x0053 #endif #define outOfMem 0x0054 /* out of memory */ #define dupVolume 0x0057 /* duplicate volume name */ #define notBlockDev 0x0058 /* not a block device */ #ifndef invalidLevel /* specifield level outside legal range */ #define invalidLevel 0x0059 #endif #define damagedBitMap 0x005A /* block number too large */ #define badPathNames 0x005B /* invalid pathnames for ChangePath */ #define notSystemFile 0x005C /* not an executable file */ #define osUnsupported 0x005D /* Operating System not supported */ #ifndef stackOverflow /* too many applications on stack */ #define stackOverflow 0x005F #endif #define dataUnavail 0x0060 /* Data unavailable */ #define endOfDir 0x0061 /* end of directory has been reached */ #define invalidClass 0x0062 /* invalid FST call class */ #define resForkNotFound 0x0063 /* file does not contain required resource */ #define invalidFSTID 0x0064 /* error - FST ID is invalid */ #define invalidFSTop 0x0065 /* invalid FST operation */ #define fstCaution 0x0066 /* FST handled call, but result is weird */ #define devNameErr 0x0067 /* device exists with same name as replacement name */ #define defListFull 0x0068 /* device list is full */ #define supListFull 0x0069 /* supervisor list is full */ #define fstError 0x006a /* generic FST error */ #define resExistsErr 0x0070 /* cannot expand file, resource already exists */ #define resAddErr 0x0071 /* cannot add resource fork to this type file */ #define networkError 0x0088 /* generic network error */ /* fileSys IDs */ #define proDOSFSID 0x0001 /* ProDOS/SOS */ #define dos33FSID 0x0002 /* DOS 3.3 */ #define dos32FSID 0x0003 /* DOS 3.2 */ #define dos31FSID 0x0003 /* DOS 3.1 */ #define appleIIPascalFSID 0x0004 /* Apple II Pascal */ #define mfsFSID 0x0005 /* Macintosh (flat file system) */ #define hfsFSID 0x0006 /* Macintosh (hierarchical file system) */ #define lisaFSID 0x0007 /* Lisa file system */ #define appleCPMFSID 0x0008 /* Apple CP/M */ #define charFSTFSID 0x0009 /* Character FST */ #define msDOSFSID 0x000A /* MS/DOS */ #define highSierraFSID 0x000B /* High Sierra */ #define iso9660FSID 0x000C /* ISO 9660 */ #define appleShareFSID 0x000D /* ISO 9660 */ /* FSTInfo.attributes Codes */ #define characterFST 0x4000 /* character FST */ #define ucFST 0x8000 /* SCM should upper case pathnames before passing them to the FST */ /* QuitRec.flags Codes */ #define onStack 0x8000 /* place state information about quitting program on the quit return stack */ #define restartable 0x4000 /* the quitting program is capable of being restarted from its dormant memory */ /* storageType Codes */ #define seedling 0x0001 /* standard file with seedling structure */ #define standardFile 0x0001 /* standard file type (no resource fork) */ #define sapling 0x0002 /* standard file with sapling structure */ #define tree 0x0003 /* standard file with tree structure */ #define pascalRegion 0x0004 /* UCSD Pascal region on a partitioned disk */ #define extendedFile 0x0005 /* extended file type (with resource fork) */ #define directoryFile 0x000D /* volume directory or subdirectory file */ /* version Codes */ #define minorRelNumMask 0x00FF /* minor release number */ #define majorRelNumMask 0x7F00 /* major release number */ #define finalRelNumMask 0x8000 /* final release number */ /* Other Constants */ #define isFileExtended 0x8000 /* GetDirEntryGS */ /* DControl Codes */ #define resetDevice 0x0000 #define formatDevice 0x0001 #define eject 0x0002 #define setConfigParameters 0x0003 #define setWaitStatus 0x0004 #define setFormatOptions 0x0005 #define assignPartitionOwner 0x0006 #define armSignal 0x0007 #define disarmSignal 0x0008 #define setPartitionMap 0x0009 typedef struct ChangePathRecGS { Word pCount; GSString255Ptr pathname; GSString255Ptr newPathname; Word flags; } ChangePathRecGS, *ChangePathRecPtrGS; typedef struct CreateRecGS { Word pCount; GSString255Ptr pathname; Word access; Word fileType; LongWord auxType; Word storageType; LongWord eof; LongWord resourceEOF; } CreateRecGS, *CreateRecPtrGS; typedef struct DAccessRecGS { Word pCount; Word devNum; Word code; Pointer list; LongWord requestCount; LongWord transferCount; } DAccessRecGS, *DAccessRecPtrGS; typedef struct DevNumRecGS { Word pCount; GSString32Ptr devName; Word devNum; } DevNumRecGS, *DevNumRecPtrGS; typedef struct DInfoRecGS { Word pCount; /* minimum = 2 */ Word devNum; ResultBuf32Ptr devName; Word characteristics; LongWord totalBlocks; Word slotNum; Word unitNum; Word version; Word deviceID; Word headLink; Word forwardLink; Pointer extendedDIBPtr; } DInfoRecGS, *DInfoRecPtrGS; typedef struct DIORecGS { Word pCount; Word devNum; Pointer buffer; LongWord requestCount; LongWord startingBlock; Word blockSize; LongWord transferCount; } DIORecGS, *DIORecPtrGS; typedef struct DirEntryRecGS { Word pCount; Word refNum; Word flags; Word base; Word displacement; ResultBuf255Ptr name; Word entryNum; Word fileType; Longint eof; LongWord blockCount; TimeRec createDateTime; TimeRec modDateTime; Word access; LongWord auxType; Word fileSysID; ResultBuf255Ptr optionList; LongWord resourceEOF; LongWord resourceBlocks; } DirEntryRecGS, *DirEntryRecPtrGS; typedef struct DRenameRecGS { Word pCount; Word devNum; GSString32Ptr strPtr; } DRenameRecGS, *DRenameRecGSPtr; typedef struct ExpandPathRecGS { Word pCount; GSString255Ptr inputPath; ResultBuf255Ptr outputPath; Word flags; } ExpandPathRecGS, *ExpandPathRecPtrGS; typedef struct FileInfoRecGS { Word pCount; GSString255Ptr pathname; Word access; Word fileType; LongWord auxType; Word storageType; /* must be 0 for SetFileInfo */ TimeRec createDateTime; TimeRec modDateTime; ResultBuf255Ptr optionList; LongWord eof; LongWord blocksUsed; /* must be 0 for SetFileInfo */ LongWord resourceEOF; /* must be 0 for SetFileInfo */ LongWord resourceBlocks; /* must be 0 for SetFileInfo */ } FileInfoRecGS, *FileInfoRecPtrGS; typedef struct FormatRecGS { Word pCount; GSString32Ptr devName; /* device name pointer */ GSString32Ptr volName; /* volume name pointer */ Word fileSysID; /* file system ID */ Word reqFileSysID; /* in; */ Word flags; ResultBuf255Ptr realVolName; } FormatRecGS, *FormatRecPtrGS; typedef struct FSTInfoRecGS { Word pCount; Word fstNum; Word fileSysID; ResultBuf255Ptr fstName; Word version; Word attributes; Word blockSize; LongWord maxVolSize; LongWord maxFileSize; } FSTInfoRecGS, *FSTInfoRecPtrGS; typedef struct InterruptRecGS { Word pCount; Word intNum; Word vrn; /* used only by BindInt */ ProcPtr intCode; /* used only by BindInt */ } InterruptRecGS, *InterruptRecPtrGS; typedef struct IORecGS { Word pCount; Word refNum; Pointer dataBuffer; LongWord requestCount; LongWord transferCount; Word cachePriority; } IORecGS, *IORecPtrGS; typedef struct JudgeNameRecGS { Word pCount; Word fileSysID; Word nameType; Pointer syntax; Word maxLen; ResultBuf255Ptr name; Word nameFlags; } JudgeNameRecGS, *JudgeNameRecPtrGS; typedef struct LevelRecGS { Word pCount; Word level; Word levelMode; } LevelRecGS, *LevelRecPtrGS; typedef struct NameRecGS { Word pCount; GSString255Ptr pathname; /* full pathname or a filename depending on call */ } NameRecGS, *NameRecPtrGS; typedef struct NotifyProcRecGS { Word pCount; ProcPtr procPointer; } NotifyProcRecGS, *NotifyProcRecGSPtr; typedef struct GetNameRecGS { Word pCount; ResultBuf255Ptr dataBuffer; /* full pathname or a filename depending on call */ Word userID; } GetNameRecGS, *GetNameRecPtrGS; typedef struct NewlineRecGS { Word pCount; Word refNum; Word enableMask; Word numChars; Pointer newlineTable; } NewlineRecGS, *NewlineRecPtrGS; typedef struct OpenRecGS { Word pCount; Word refNum; GSString255Ptr pathname; Word requestAccess; Word resourceNumber; /* For extended files: dataFork/resourceFork */ Word access; /* Value of file's access attribute */ Word fileType; /* Value of file's fileType attribute */ LongWord auxType; Word storageType; TimeRec createDateTime; TimeRec modDateTime; ResultBuf255Ptr optionList; LongWord eof; LongWord blocksUsed; LongWord resourceEOF; LongWord resourceBlocks; } OpenRecGS, *OpenRecPtrGS; typedef struct OSShutDownRecGS { Word pCount; Word shutdownFlag; } OSShutDownRecGS, *OSShutDownRecPtrGS; typedef struct PositionRecGS { Word pCount; Word refNum; LongWord position; } PositionRecGS, *PositionRecPtrGS; typedef struct EOFRecGS { Word pCount; Word refNum; LongWord eof; } EOFRecGS, *EOFRecPtrGS; typedef struct PrefixRecGS { Word pCount; Word prefixNum; union { ResultBuf255Ptr getPrefix; GSString255Ptr setPrefix; } buffer; } PrefixRecGS, *PrefixRecPtrGS; typedef struct QuitRecGS { Word pCount; GSString255Ptr pathname; /* pathname of next app to run */ Word flags; } QuitRecGS, *QuitRecPtrGS; typedef struct RefNumRecGS { Word pCount; Word refNum; } RefNumRecGS, *RefnumRecPtrGS; typedef struct GetRefNumRecGS { Word pCount; GSString255Ptr pathname; Word refNum; Word access; Word resNum; Boolean caseSense; Word displacement; } GetRefNumRecGS, *GetRefNumRecPtrGS; typedef struct StdRefNumRecGS { Word pCount; Word prefixNum; Word refNum; } StdRefNumRecGS, *StdRefNumRecGSPtr; typedef struct SessionStatusRecGS { Word pCount; /* in: min = 1 */ Word status; /* out: */ } SessionStatusRecGS, *SessionStatusRecPtrGS; typedef struct SetPositionRecGS { Word pCount; Word refNum; Word base; LongWord displacement; } SetPositionRecGS, *SetPositionRecPtrGS; typedef struct SysPrefsRecGS { Word pCount; Word preferences; } SysPrefsRecGS, *SysPrefsRecPtrGS; typedef struct VersionRecGS { Word pCount; Word version; } VersionRecGS, *VersionRecPtrGS; typedef struct VolumeRecGS { Word pCount; GSString32Ptr devName; ResultBuf255Ptr volName; LongWord totalBlocks; LongWord freeBlocks; Word fileSysID; Word blockSize; Word characteristics; Word deviceID; } VolumeRecGS, *VolumeRecPtrGS; typedef struct RefInfoRecGS { Word pCount; Word refNum; Word access; ResultBuf255Ptr pathname; Word resourceNumber; Word level; } RefInfoRecGS, *RefInfoRecGSPtr; #ifndef stackEntry #define stackEntry 0xE100B0 #endif #ifndef PDosInt extern pascal void PDosInt(unsigned, void *); #endif #define AddNotifyProcGS(pBlockPtr) PDosInt(0x2034,pBlockPtr) #define BeginSessionGS(pBlockPtr) PDosInt(0x201D,pBlockPtr) #define BindIntGS(pBlockPtr) PDosInt(0x2031,pBlockPtr) #define ChangePathGS(pBlockPtr) PDosInt(0x2004,pBlockPtr) #define ClearBackupBitGS(pBlockPtr) PDosInt(0x200B,pBlockPtr) #define CloseGS(pBlockPtr) PDosInt(0x2014,pBlockPtr) #define CreateGS(pBlockPtr) PDosInt(0x2001,pBlockPtr) #define DControlGS(pBlockPtr) PDosInt(0x202E,pBlockPtr) #define DelNotifyProcGS(pBlockPtr) PDosInt(0x2035,pBlockPtr) #define DestroyGS(pBlockPtr) PDosInt(0x2002,pBlockPtr) #define DInfoGS(pBlockPtr) PDosInt(0x202C,pBlockPtr) #define DReadGS(pBlockPtr) PDosInt(0x202F,pBlockPtr) #define DRenameGS(pBlockPtr) PDosInt(0x2036,pBlockPtr) #define DStatusGS(pBlockPtr) PDosInt(0x202D,pBlockPtr) #define DWriteGS(pBlockPtr) PDosInt(0x2030,pBlockPtr) #define EndSessionGS(pBlockPtr) PDosInt(0x201E,pBlockPtr) #define EraseDiskGS(pBlockPtr) PDosInt(0x2025,pBlockPtr) #define ExpandPathGS(pBlockPtr) PDosInt(0x200E,pBlockPtr) #define FlushGS(pBlockPtr) PDosInt(0x2015,pBlockPtr) #define FormatGS(pBlockPtr) PDosInt(0x2024,pBlockPtr) #define FSTSpecific(pBlockPtr) PDosInt(0x2033,pBlockPtr) #define GetBootVolGS(pBlockPtr) PDosInt(0x2028,pBlockPtr) #define GetDevNumberGS(pBlockPtr) PDosInt(0x2020,pBlockPtr) #define GetDirEntryGS(pBlockPtr) PDosInt(0x201C,pBlockPtr) #define GetEOFGS(pBlockPtr) PDosInt(0x2019,pBlockPtr) #define GetFileInfoGS(pBlockPtr) PDosInt(0x2006,pBlockPtr) #define GetFSTInfoGS(pBlockPtr) PDosInt(0x202B,pBlockPtr) #define GetLevelGS(pBlockPtr) PDosInt(0x201B,pBlockPtr) #define GetMarkGS(pBlockPtr) PDosInt(0x2017,pBlockPtr) #define GetNameGS(pBlockPtr) PDosInt(0x2027,pBlockPtr) #define GetPrefixGS(pBlockPtr) PDosInt(0x200A,pBlockPtr) #define GetRefInfoGS(pBlockPtr) PDosInt(0x2039,pBlockPtr) #define GetRefNumGS(pBlockPtr) PDosInt(0x2038,pBlockPtr) #define GetStdRefNumGS(pBlockPtr) PDosInt(0x2037,pBlockPtr) #define GetSysPrefsGS(pBlockPtr) PDosInt(0x200F,pBlockPtr) #define GetVersionGS(pBlockPtr) PDosInt(0x202A,pBlockPtr) #define JudgeNameGS(pBlockPtr) PDosInt(0x2007,pBlockPtr) #define NewlineGS(pBlockPtr) PDosInt(0x2011,pBlockPtr) #define NullGS(pBlockPtr) PDosInt(0x200D,pBlockPtr) #define OpenGS(pBlockPtr) PDosInt(0x2010,pBlockPtr) #define OSShutDownGS(pBlockPtr) PDosInt(0x2003,pBlockPtr) #define QuitGS(pBlockPtr) PDosInt(0x2029,pBlockPtr) #define ReadGS(pBlockPtr) PDosInt(0x2012,pBlockPtr) #define ResetCacheGS(pBlockPtr) PDosInt(0x2026,pBlockPtr) #define SessionStatusGS(pBlockPtr) PDosInt(0x201F,pBlockPtr) #define SetEOFGS(pBlockPtr) PDosInt(0x2018,pBlockPtr) #define SetFileInfoGS(pBlockPtr) PDosInt(0x2005,pBlockPtr) #define SetLevelGS(pBlockPtr) PDosInt(0x201A,pBlockPtr) #define SetMarkGS(pBlockPtr) PDosInt(0x2016,pBlockPtr) #define SetPrefixGS(pBlockPtr) PDosInt(0x2009,pBlockPtr) #define SetStdRefNumGS(pBlockPtr) PDosInt(0x203A,pBlockPtr) #define SetSysPrefsGS(pBlockPtr) PDosInt(0x200C,pBlockPtr) #define UnbindIntGS(pBlockPtr) PDosInt(0x2032,pBlockPtr) #define VolumeGS(pBlockPtr) PDosInt(0x2008,pBlockPtr) #define WriteGS(pBlockPtr) PDosInt(0x2013,pBlockPtr) #ifndef __PRODOS__ #define GetSysPrefs(arg) GetSysPrefsGS(arg) #define BeginSession(arg) BeginSessionGS(arg) #define EndSession(arg) EndSessionGS(arg) #define SessionStatus(arg) SessionStatusGS(arg) #define ResetCache(arg) ResetCacheGS(arg) #define ChangePath(arg) ChangePathGS(arg) #define ClearBackupBit(arg) ClearBackupBitGS(arg) #define Close(arg) CloseGS(arg) #define Create(arg) CreateGS(arg) #define DControl(arg) DControlGS(arg) #define Destroy(arg) DestroyGS(arg) #define DInfo(arg) DInfoGS(arg) #define DRead(arg) DReadGS(arg) #define DStatus(arg) DStatusGS(arg) #define DWrite(arg) DWriteGS(arg) #define EraseDisk(arg) EraseDiskGS(arg) #define ExpandPath(arg) ExpandPathGS(arg) #define Flush(arg) FlushGS(arg) #define Format(arg) FormatGS(arg) #define GetBootVol(arg) GetBootVolGS(arg) #define GetDevNumber(arg) GetDevNumberGS(arg) #define GetDirEntry(arg) GetDirEntryGS(arg) #define GetEOF(arg) GetEOFGS(arg) #define GetFileInfo(arg) GetFileInfoGS(arg) #define GetFSTInfo(arg) GetFSTInfoGS(arg) #define GetLevel(arg) GetLevelGS(arg) #define GetMark(arg) GetMarkGS(arg) #define GetName(arg) GetNameGS(arg) #define GetPrefix(arg) GetPrefixGS(arg) #define GetVersion(arg) GetVersionGS(arg) #define JudgeName(arg) JudgeNameGS(arg) #define Newline(arg) NewlineGS(arg) #define Null(arg) NullGS(arg) #define Open(arg) OpenGS(arg) #define Quit(arg) QuitGS(arg) #define Read(arg) ReadGS(arg) #define SetEOF(arg) SetEOFGS(arg) #define SetFileInfo(arg) SetFileInfoGS(arg) #define SetLevel(arg) SetLevelGS(arg) #define SetMark(arg) SetMarkGS(arg) #define SetPrefix(arg) SetPrefixGS(arg) #define UnbindInt(arg) UnbindIntGS(arg) #define Volume(arg) VolumeGS(arg) #define Write(arg) WriteGS(arg) #define BindInt(arg) BindIntGS(arg) #define ChangePathRec ChangePathRecGS #define CreateRec CreateRecGS #define DAccessRec DAccessRecGS #define DevNumRec DevNumRecGS #define DInfoRec DInfoRecGS #define DIORec DIORecGS #define DirEntryRec DirEntryRecGS #define EOFRec EOFRecGS #define ExpandPathRec ExpandPathRecGS #define FileInfoRec FileInfoRecGS #define FormatRec FormatRecGS #define FSTInfoRec FSTInfoRecGS #define InterruptRec InterruptRecGS #define IORec IORecGS #define JudgeNameRec JudgeNameRecGS #define LevelRec LevelRecGS #define NameRec NameRecGS #define GetNameRec GetNameRecGS #define NewlineRec NewlineRecGS #define OpenRec OpenRecGS #define PositionRec PositionRecGS #define PrefixRec PrefixRecGS #define QuitRec QuitRecGS #define RefNumRec RefNumRecGS #define SetPositionRec SetPositionRecGS #define SysPrefRec SysPrefRecGS #define VersionRec VersionRecGS #define VolumeRec VolumeRecGS #endif #endif \ No newline at end of file +/******************************************** +* +* GS/OS +* +* Copyright Apple Computer, Inc.1986-91 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __GSOS__ +#define __GSOS__ + +/* + Read/Write enable bit Codes + for CreateRec/OpenRec access and requestAccess fields +*/ + +#define readEnableAllowWrite 0x0000 +#define readEnable 0x0001 +#define writeEnable 0x0002 +#define readWriteEnable 0x0003 +#define fileInvisible 0x0004 /* Invisible bit */ +#define backupNeeded 0x0020 /* backup needed bit: CreateRec/ OpenRec access field. (Must be 0 in requestAccess field ) */ +#define renameEnable 0x0040 /* rename enable bit: CreateRec/ OpenRec access and requestAccess fields */ +#define destroyEnable 0x0080 /* destroy enable bit: CreateRec/ OpenRec access and requestAccess fields */ +#define startPlus 0x0000 /* base -> setMark = displacement */ +#define eofMinus 0x0001 /* base -> setMark = eof - displacement */ +#define markPlus 0x0002 /* base -> setMark = mark + displacement */ +#define markMinus 0x0003 /* base -> setMark = mark - displacement */ + +/* cachePriority Codes */ +#define cacheOff 0x0000 /* do not cache blocks invloved in this read */ +#define cacheOn 0x0001 /* cache blocks invloved in this read if possible */ + +/* Error Codes */ +#define badSystemCall 0x0001 /* bad system call number */ +#define invalidPcount 0x0004 /* invalid parameter count */ +#define gsosActive 0x0007 /* GS/OS already active */ + +#ifndef devNotFound /* device not found */ + #define devNotFound 0x0010 +#endif + +#define invalidDevNum 0x0011 /* invalid device number */ +#define drvrBadReq 0x0020 /* bad request or command */ +#define drvrBadCode 0x0021 /* bad control or status code */ +#define drvrBadParm 0x0022 /* bad call parameter */ +#define drvrNotOpen 0x0023 /* character device not open */ +#define drvrPriorOpen 0x0024 /* character device already open */ +#define irqTableFull 0x0025 /* interrupt table full */ +#define drvrNoResrc 0x0026 /* resources not available */ +#define drvrIOError 0x0027 /* I/O error */ +#define drvrNoDevice 0x0028 /* device not connected */ +#define drvrBusy 0x0029 /* call aborted; driver is busy */ +#define drvrWrtProt 0x002B /* device is write protected */ +#define drvrBadCount 0x002C /* invalid byte count */ +#define drvrBadBlock 0x002D /* invalid block address */ +#define drvrDiskSwitch 0x002E /* disk has been switched */ +#define drvrOffLine 0x002F /* device off line/ no media present */ +#define badPathSyntax 0x0040 /* invalid pathname syntax */ +#define tooManyFilesOpen 0x0042 /* too many files open on server volume */ +#define invalidRefNum 0x0043 /* invalid reference number */ + +#ifndef pathNotFound /* subdirectory does not exist */ + #define pathNotFound 0x0044 +#endif + +#define volNotFound 0x0045 /* volume not found */ + +#ifndef fileNotFound /* file not found */ + #define fileNotFound 0x0046 +#endif + +#define dupPathname 0x0047 /* create or rename with existing name */ +#define volumeFull 0x0048 /* volume full error */ +#define volDirFull 0x0049 /* volume directory full */ +#define badFileFormat 0x004A /* version error (incompatible file format) */ + +#ifndef badStoreType /* unsupported (or incorrect) storage type */ + #define badStoreType 0x004B +#endif + +#ifndef eofEncountered /* end-of-file encountered */ + #define eofEncountered 0x004C +#endif + +#define outOfRange 0x004D /* position out of range */ +#define invalidAccess 0x004E /* access not allowed */ +#define buffTooSmall 0x004F /* buffer too small */ +#define fileBusy 0x0050 /* file is already open */ +#define dirError 0x0051 /* directory error */ +#define unknownVol 0x0052 /* unknown volume type */ + +#ifndef paramRangeErr /* parameter out of range */ + #define paramRangeErr 0x0053 +#endif + +#define outOfMem 0x0054 /* out of memory */ +#define dupVolume 0x0057 /* duplicate volume name */ +#define notBlockDev 0x0058 /* not a block device */ + +#ifndef invalidLevel /* specifield level outside legal range */ + #define invalidLevel 0x0059 +#endif + +#define damagedBitMap 0x005A /* block number too large */ +#define badPathNames 0x005B /* invalid pathnames for ChangePath */ +#define notSystemFile 0x005C /* not an executable file */ +#define osUnsupported 0x005D /* Operating System not supported */ + +#ifndef stackOverflow /* too many applications on stack */ + #define stackOverflow 0x005F +#endif + +#define dataUnavail 0x0060 /* Data unavailable */ +#define endOfDir 0x0061 /* end of directory has been reached */ +#define invalidClass 0x0062 /* invalid FST call class */ +#define resForkNotFound 0x0063 /* file does not contain required resource */ +#define invalidFSTID 0x0064 /* error - FST ID is invalid */ +#define invalidFSTop 0x0065 /* invalid FST operation */ +#define fstCaution 0x0066 /* FST handled call, but result is weird */ +#define devNameErr 0x0067 /* device exists with same name as replacement name */ +#define defListFull 0x0068 /* device list is full */ +#define supListFull 0x0069 /* supervisor list is full */ +#define fstError 0x006a /* generic FST error */ +#define resExistsErr 0x0070 /* cannot expand file, resource already exists */ +#define resAddErr 0x0071 /* cannot add resource fork to this type file */ +#define networkError 0x0088 /* generic network error */ + +/* fileSys IDs */ +#define proDOSFSID 0x0001 /* ProDOS/SOS */ +#define dos33FSID 0x0002 /* DOS 3.3 */ +#define dos32FSID 0x0003 /* DOS 3.2 */ +#define dos31FSID 0x0003 /* DOS 3.1 */ +#define appleIIPascalFSID 0x0004 /* Apple II Pascal */ +#define mfsFSID 0x0005 /* Macintosh (flat file system) */ +#define hfsFSID 0x0006 /* Macintosh (hierarchical file system) */ +#define lisaFSID 0x0007 /* Lisa file system */ +#define appleCPMFSID 0x0008 /* Apple CP/M */ +#define charFSTFSID 0x0009 /* Character FST */ +#define msDOSFSID 0x000A /* MS/DOS */ +#define highSierraFSID 0x000B /* High Sierra */ +#define iso9660FSID 0x000C /* ISO 9660 */ +#define appleShareFSID 0x000D /* ISO 9660 */ + +/* FSTInfo.attributes Codes */ +#define characterFST 0x4000 /* character FST */ +#define ucFST 0x8000 /* SCM should upper case pathnames before passing them to the FST */ + +/* QuitRec.flags Codes */ +#define onStack 0x8000 /* place state information about quitting program on the quit return stack */ +#define restartable 0x4000 /* the quitting program is capable of being restarted from its dormant memory */ + +/* storageType Codes */ +#define seedling 0x0001 /* standard file with seedling structure */ +#define standardFile 0x0001 /* standard file type (no resource fork) */ +#define sapling 0x0002 /* standard file with sapling structure */ +#define tree 0x0003 /* standard file with tree structure */ +#define pascalRegion 0x0004 /* UCSD Pascal region on a partitioned disk */ +#define extendedFile 0x0005 /* extended file type (with resource fork) */ +#define directoryFile 0x000D /* volume directory or subdirectory file */ + +/* version Codes */ +#define minorRelNumMask 0x00FF /* minor release number */ +#define majorRelNumMask 0x7F00 /* major release number */ +#define finalRelNumMask 0x8000 /* final release number */ + +/* Other Constants */ +#define isFileExtended 0x8000 /* GetDirEntryGS */ + +/* DControl Codes */ +#define resetDevice 0x0000 +#define formatDevice 0x0001 +#define eject 0x0002 +#define setConfigParameters 0x0003 +#define setWaitStatus 0x0004 +#define setFormatOptions 0x0005 +#define assignPartitionOwner 0x0006 +#define armSignal 0x0007 +#define disarmSignal 0x0008 +#define setPartitionMap 0x0009 + +typedef struct ChangePathRecGS { + Word pCount; + GSString255Ptr pathname; + GSString255Ptr newPathname; + Word flags; + } ChangePathRecGS, *ChangePathRecPtrGS; + +typedef struct CreateRecGS { + Word pCount; + GSString255Ptr pathname; + Word access; + Word fileType; + LongWord auxType; + Word storageType; + LongWord eof; + LongWord resourceEOF; + } CreateRecGS, *CreateRecPtrGS; + +typedef struct DAccessRecGS { + Word pCount; + Word devNum; + Word code; + Pointer list; + LongWord requestCount; + LongWord transferCount; + } DAccessRecGS, *DAccessRecPtrGS; + +typedef struct DevNumRecGS { + Word pCount; + GSString32Ptr devName; + Word devNum; + } DevNumRecGS, *DevNumRecPtrGS; + +typedef struct DInfoRecGS { + Word pCount; /* minimum = 2 */ + Word devNum; + ResultBuf32Ptr devName; + Word characteristics; + LongWord totalBlocks; + Word slotNum; + Word unitNum; + Word version; + Word deviceID; + Word headLink; + Word forwardLink; + Pointer extendedDIBPtr; + } DInfoRecGS, *DInfoRecPtrGS; + +typedef struct DIORecGS { + Word pCount; + Word devNum; + Pointer buffer; + LongWord requestCount; + LongWord startingBlock; + Word blockSize; + LongWord transferCount; + } DIORecGS, *DIORecPtrGS; + +typedef struct DirEntryRecGS { + Word pCount; + Word refNum; + Word flags; + Word base; + Word displacement; + ResultBuf255Ptr name; + Word entryNum; + Word fileType; + Longint eof; + LongWord blockCount; + TimeRec createDateTime; + TimeRec modDateTime; + Word access; + LongWord auxType; + Word fileSysID; + ResultBuf255Ptr optionList; + LongWord resourceEOF; + LongWord resourceBlocks; + } DirEntryRecGS, *DirEntryRecPtrGS; + +typedef struct DRenameRecGS { + Word pCount; + Word devNum; + GSString32Ptr strPtr; + } DRenameRecGS, *DRenameRecGSPtr; + +typedef struct ExpandPathRecGS { + Word pCount; + GSString255Ptr inputPath; + ResultBuf255Ptr outputPath; + Word flags; + } ExpandPathRecGS, *ExpandPathRecPtrGS; + +typedef struct FileInfoRecGS { + Word pCount; + GSString255Ptr pathname; + Word access; + Word fileType; + LongWord auxType; + Word storageType; /* must be 0 for SetFileInfo */ + TimeRec createDateTime; + TimeRec modDateTime; + ResultBuf255Ptr optionList; + LongWord eof; + LongWord blocksUsed; /* must be 0 for SetFileInfo */ + LongWord resourceEOF; /* must be 0 for SetFileInfo */ + LongWord resourceBlocks; /* must be 0 for SetFileInfo */ + } FileInfoRecGS, *FileInfoRecPtrGS; + +typedef struct FormatRecGS { + Word pCount; + GSString32Ptr devName; /* device name pointer */ + GSString32Ptr volName; /* volume name pointer */ + Word fileSysID; /* file system ID */ + Word reqFileSysID; /* in; */ + Word flags; + ResultBuf255Ptr realVolName; + } FormatRecGS, *FormatRecPtrGS; + +typedef struct FSTInfoRecGS { + Word pCount; + Word fstNum; + Word fileSysID; + ResultBuf255Ptr fstName; + Word version; + Word attributes; + Word blockSize; + LongWord maxVolSize; + LongWord maxFileSize; + } FSTInfoRecGS, *FSTInfoRecPtrGS; + +typedef struct InterruptRecGS { + Word pCount; + Word intNum; + Word vrn; /* used only by BindInt */ + ProcPtr intCode; /* used only by BindInt */ + } InterruptRecGS, *InterruptRecPtrGS; + +typedef struct IORecGS { + Word pCount; + Word refNum; + Pointer dataBuffer; + LongWord requestCount; + LongWord transferCount; + Word cachePriority; + } IORecGS, *IORecPtrGS; + +typedef struct JudgeNameRecGS { + Word pCount; + Word fileSysID; + Word nameType; + Pointer syntax; + Word maxLen; + ResultBuf255Ptr name; + Word nameFlags; + } JudgeNameRecGS, *JudgeNameRecPtrGS; + +typedef struct LevelRecGS { + Word pCount; + Word level; + Word levelMode; + } LevelRecGS, *LevelRecPtrGS; + +typedef struct NameRecGS { + Word pCount; + GSString255Ptr pathname; /* full pathname or a filename depending on call */ + } NameRecGS, *NameRecPtrGS; + +typedef struct NotifyProcRecGS { + Word pCount; + ProcPtr procPointer; + } NotifyProcRecGS, *NotifyProcRecGSPtr; + +typedef struct GetNameRecGS { + Word pCount; + ResultBuf255Ptr dataBuffer; /* full pathname or a filename depending on call */ + Word userID; + } GetNameRecGS, *GetNameRecPtrGS; + +typedef struct NewlineRecGS { + Word pCount; + Word refNum; + Word enableMask; + Word numChars; + Pointer newlineTable; + } NewlineRecGS, *NewlineRecPtrGS; + +typedef struct OpenRecGS { + Word pCount; + Word refNum; + GSString255Ptr pathname; + Word requestAccess; + Word resourceNumber; /* For extended files: dataFork/resourceFork */ + Word access; /* Value of file's access attribute */ + Word fileType; /* Value of file's fileType attribute */ + LongWord auxType; + Word storageType; + TimeRec createDateTime; + TimeRec modDateTime; + ResultBuf255Ptr optionList; + LongWord eof; + LongWord blocksUsed; + LongWord resourceEOF; + LongWord resourceBlocks; + } OpenRecGS, *OpenRecPtrGS; + +typedef struct OSShutDownRecGS { + Word pCount; + Word shutdownFlag; + } OSShutDownRecGS, *OSShutDownRecPtrGS; + +typedef struct PositionRecGS { + Word pCount; + Word refNum; + LongWord position; + } PositionRecGS, *PositionRecPtrGS; + +typedef struct EOFRecGS { + Word pCount; + Word refNum; + LongWord eof; + } EOFRecGS, *EOFRecPtrGS; + +typedef struct PrefixRecGS { + Word pCount; + Word prefixNum; + union { + ResultBuf255Ptr getPrefix; + GSString255Ptr setPrefix; + } buffer; + } PrefixRecGS, *PrefixRecPtrGS; + +typedef struct QuitRecGS { + Word pCount; + GSString255Ptr pathname; /* pathname of next app to run */ + Word flags; + } QuitRecGS, *QuitRecPtrGS; + +typedef struct RefNumRecGS { + Word pCount; + Word refNum; + } RefNumRecGS, *RefnumRecPtrGS; + +typedef struct GetRefNumRecGS { + Word pCount; + GSString255Ptr pathname; + Word refNum; + Word access; + Word resNum; + Boolean caseSense; + Word displacement; + } GetRefNumRecGS, *GetRefNumRecPtrGS; + +typedef struct StdRefNumRecGS { + Word pCount; + Word prefixNum; + Word refNum; + } StdRefNumRecGS, *StdRefNumRecGSPtr; + +typedef struct SessionStatusRecGS { + Word pCount; /* in: min = 1 */ + Word status; /* out: */ + } SessionStatusRecGS, *SessionStatusRecPtrGS; + +typedef struct SetPositionRecGS { + Word pCount; + Word refNum; + Word base; + LongWord displacement; + } SetPositionRecGS, *SetPositionRecPtrGS; + +typedef struct SysPrefsRecGS { + Word pCount; + Word preferences; + } SysPrefsRecGS, *SysPrefsRecPtrGS; + +typedef struct VersionRecGS { + Word pCount; + Word version; + } VersionRecGS, *VersionRecPtrGS; + +typedef struct VolumeRecGS { + Word pCount; + GSString32Ptr devName; + ResultBuf255Ptr volName; + LongWord totalBlocks; + LongWord freeBlocks; + Word fileSysID; + Word blockSize; + Word characteristics; + Word deviceID; + } VolumeRecGS, *VolumeRecPtrGS; + +typedef struct RefInfoRecGS { + Word pCount; + Word refNum; + Word access; + ResultBuf255Ptr pathname; + Word resourceNumber; + Word level; + } RefInfoRecGS, *RefInfoRecGSPtr; + +#ifndef stackEntry + #define stackEntry 0xE100B0 +#endif + +#ifndef PDosInt +extern pascal void PDosInt(unsigned, void *); +#endif + +#define AddNotifyProcGS(pBlockPtr) PDosInt(0x2034,pBlockPtr) +#define BeginSessionGS(pBlockPtr) PDosInt(0x201D,pBlockPtr) +#define BindIntGS(pBlockPtr) PDosInt(0x2031,pBlockPtr) +#define ChangePathGS(pBlockPtr) PDosInt(0x2004,pBlockPtr) +#define ClearBackupBitGS(pBlockPtr) PDosInt(0x200B,pBlockPtr) +#define CloseGS(pBlockPtr) PDosInt(0x2014,pBlockPtr) +#define CreateGS(pBlockPtr) PDosInt(0x2001,pBlockPtr) +#define DControlGS(pBlockPtr) PDosInt(0x202E,pBlockPtr) +#define DelNotifyProcGS(pBlockPtr) PDosInt(0x2035,pBlockPtr) +#define DestroyGS(pBlockPtr) PDosInt(0x2002,pBlockPtr) +#define DInfoGS(pBlockPtr) PDosInt(0x202C,pBlockPtr) +#define DReadGS(pBlockPtr) PDosInt(0x202F,pBlockPtr) +#define DRenameGS(pBlockPtr) PDosInt(0x2036,pBlockPtr) +#define DStatusGS(pBlockPtr) PDosInt(0x202D,pBlockPtr) +#define DWriteGS(pBlockPtr) PDosInt(0x2030,pBlockPtr) +#define EndSessionGS(pBlockPtr) PDosInt(0x201E,pBlockPtr) +#define EraseDiskGS(pBlockPtr) PDosInt(0x2025,pBlockPtr) +#define ExpandPathGS(pBlockPtr) PDosInt(0x200E,pBlockPtr) +#define FlushGS(pBlockPtr) PDosInt(0x2015,pBlockPtr) +#define FormatGS(pBlockPtr) PDosInt(0x2024,pBlockPtr) +#define FSTSpecific(pBlockPtr) PDosInt(0x2033,pBlockPtr) +#define GetBootVolGS(pBlockPtr) PDosInt(0x2028,pBlockPtr) +#define GetDevNumberGS(pBlockPtr) PDosInt(0x2020,pBlockPtr) +#define GetDirEntryGS(pBlockPtr) PDosInt(0x201C,pBlockPtr) +#define GetEOFGS(pBlockPtr) PDosInt(0x2019,pBlockPtr) +#define GetFileInfoGS(pBlockPtr) PDosInt(0x2006,pBlockPtr) +#define GetFSTInfoGS(pBlockPtr) PDosInt(0x202B,pBlockPtr) +#define GetLevelGS(pBlockPtr) PDosInt(0x201B,pBlockPtr) +#define GetMarkGS(pBlockPtr) PDosInt(0x2017,pBlockPtr) +#define GetNameGS(pBlockPtr) PDosInt(0x2027,pBlockPtr) +#define GetPrefixGS(pBlockPtr) PDosInt(0x200A,pBlockPtr) +#define GetRefInfoGS(pBlockPtr) PDosInt(0x2039,pBlockPtr) +#define GetRefNumGS(pBlockPtr) PDosInt(0x2038,pBlockPtr) +#define GetStdRefNumGS(pBlockPtr) PDosInt(0x2037,pBlockPtr) +#define GetSysPrefsGS(pBlockPtr) PDosInt(0x200F,pBlockPtr) +#define GetVersionGS(pBlockPtr) PDosInt(0x202A,pBlockPtr) +#define JudgeNameGS(pBlockPtr) PDosInt(0x2007,pBlockPtr) +#define NewlineGS(pBlockPtr) PDosInt(0x2011,pBlockPtr) +#define NullGS(pBlockPtr) PDosInt(0x200D,pBlockPtr) +#define OpenGS(pBlockPtr) PDosInt(0x2010,pBlockPtr) +#define OSShutDownGS(pBlockPtr) PDosInt(0x2003,pBlockPtr) +#define QuitGS(pBlockPtr) PDosInt(0x2029,pBlockPtr) +#define ReadGS(pBlockPtr) PDosInt(0x2012,pBlockPtr) +#define ResetCacheGS(pBlockPtr) PDosInt(0x2026,pBlockPtr) +#define SessionStatusGS(pBlockPtr) PDosInt(0x201F,pBlockPtr) +#define SetEOFGS(pBlockPtr) PDosInt(0x2018,pBlockPtr) +#define SetFileInfoGS(pBlockPtr) PDosInt(0x2005,pBlockPtr) +#define SetLevelGS(pBlockPtr) PDosInt(0x201A,pBlockPtr) +#define SetMarkGS(pBlockPtr) PDosInt(0x2016,pBlockPtr) +#define SetPrefixGS(pBlockPtr) PDosInt(0x2009,pBlockPtr) +#define SetStdRefNumGS(pBlockPtr) PDosInt(0x203A,pBlockPtr) +#define SetSysPrefsGS(pBlockPtr) PDosInt(0x200C,pBlockPtr) +#define UnbindIntGS(pBlockPtr) PDosInt(0x2032,pBlockPtr) +#define VolumeGS(pBlockPtr) PDosInt(0x2008,pBlockPtr) +#define WriteGS(pBlockPtr) PDosInt(0x2013,pBlockPtr) + +#ifndef __PRODOS__ + #define GetSysPrefs(arg) GetSysPrefsGS(arg) + #define BeginSession(arg) BeginSessionGS(arg) + #define EndSession(arg) EndSessionGS(arg) + #define SessionStatus(arg) SessionStatusGS(arg) + #define ResetCache(arg) ResetCacheGS(arg) + #define ChangePath(arg) ChangePathGS(arg) + #define ClearBackupBit(arg) ClearBackupBitGS(arg) + #define Close(arg) CloseGS(arg) + #define Create(arg) CreateGS(arg) + #define DControl(arg) DControlGS(arg) + #define Destroy(arg) DestroyGS(arg) + #define DInfo(arg) DInfoGS(arg) + #define DRead(arg) DReadGS(arg) + #define DStatus(arg) DStatusGS(arg) + #define DWrite(arg) DWriteGS(arg) + #define EraseDisk(arg) EraseDiskGS(arg) + #define ExpandPath(arg) ExpandPathGS(arg) + #define Flush(arg) FlushGS(arg) + #define Format(arg) FormatGS(arg) + #define GetBootVol(arg) GetBootVolGS(arg) + #define GetDevNumber(arg) GetDevNumberGS(arg) + #define GetDirEntry(arg) GetDirEntryGS(arg) + #define GetEOF(arg) GetEOFGS(arg) + #define GetFileInfo(arg) GetFileInfoGS(arg) + #define GetFSTInfo(arg) GetFSTInfoGS(arg) + #define GetLevel(arg) GetLevelGS(arg) + #define GetMark(arg) GetMarkGS(arg) + #define GetName(arg) GetNameGS(arg) + #define GetPrefix(arg) GetPrefixGS(arg) + #define GetVersion(arg) GetVersionGS(arg) + #define JudgeName(arg) JudgeNameGS(arg) + #define Newline(arg) NewlineGS(arg) + #define Null(arg) NullGS(arg) + #define Open(arg) OpenGS(arg) + #define Quit(arg) QuitGS(arg) + #define Read(arg) ReadGS(arg) + #define SetEOF(arg) SetEOFGS(arg) + #define SetFileInfo(arg) SetFileInfoGS(arg) + #define SetLevel(arg) SetLevelGS(arg) + #define SetMark(arg) SetMarkGS(arg) + #define SetPrefix(arg) SetPrefixGS(arg) + #define UnbindInt(arg) UnbindIntGS(arg) + #define Volume(arg) VolumeGS(arg) + #define Write(arg) WriteGS(arg) + #define BindInt(arg) BindIntGS(arg) + + #define ChangePathRec ChangePathRecGS + #define CreateRec CreateRecGS + #define DAccessRec DAccessRecGS + #define DevNumRec DevNumRecGS + #define DInfoRec DInfoRecGS + #define DIORec DIORecGS + #define DirEntryRec DirEntryRecGS + #define EOFRec EOFRecGS + #define ExpandPathRec ExpandPathRecGS + #define FileInfoRec FileInfoRecGS + #define FormatRec FormatRecGS + #define FSTInfoRec FSTInfoRecGS + #define InterruptRec InterruptRecGS + #define IORec IORecGS + #define JudgeNameRec JudgeNameRecGS + #define LevelRec LevelRecGS + #define NameRec NameRecGS + #define GetNameRec GetNameRecGS + #define NewlineRec NewlineRecGS + #define OpenRec OpenRecGS + #define PositionRec PositionRecGS + #define PrefixRec PrefixRecGS + #define QuitRec QuitRecGS + #define RefNumRec RefNumRecGS + #define SetPositionRec SetPositionRecGS + #define SysPrefRec SysPrefRecGS + #define VersionRec VersionRecGS + #define VolumeRec VolumeRecGS + +#endif + +#endif diff --git a/bin/Libraries/ORCACDefs/hyperstudio.h b/bin/Libraries/ORCACDefs/hyperstudio.h index 4a08d2b..6fb8f36 100644 --- a/bin/Libraries/ORCACDefs/hyperstudio.h +++ b/bin/Libraries/ORCACDefs/hyperstudio.h @@ -1 +1,219 @@ -/**************************************************************** * * HyperStudio.h - Interface for HyperStudio * * December 1992 * Mike Westerfield * * Thanks to Ken Kashmarek, who supplied the original files from * wich I shamelessly swiped the names used here. (Of course, * that made it easier for him to convert his software!) * * Copyright 1992, 1993 * Byte Works, Inc. * ****************************************************************/ #ifndef __TYPES__ #include #endif #ifndef __hyperstudio__ #define __hyperstudio__ /* Callback numbers */ #define cMoveToFirst 1 #define cMoveToLast 2 #define cMovePrev 3 #define cMoveNext 4 #define cMoveToID 5 #define cRedrawCard 6 #define cGetStackName 7 #define cFindText 8 #define cPokeyFlag 9 #define cDoMenu 10 #define cGetHSMode 11 #define cGetHSVersion 12 #define cGetStackPathName 13 #define cGetNumCards 14 #define cGetNumButtons 15 #define cGetNumFields 16 #define cGetNumGraphics 17 #define cPoint2StackHead 18 #define cPoint2FirstCard 19 #define cPoint2CurrCard 20 #define cPoint2NextCard 21 #define cPoint2CardItems 22 #define cPoint2NextCdItem 23 #define cPoint2StackItem 24 #define cGetCallerAddr 25 #define cHideStackItem 26 #define cShowStackItem 27 #define cLockItem 28 #define cUnLockItem 29 #define cDeleteStackItem 30 #define cGetItemRect 31 #define cSetItemRect 32 #define cGetButtonIcon 33 #define cSetButtonIcon 34 #define cGetItemStats 35 #define cLaunchApplication 36 #define cGetItemLoc 37 #define cRedrawItem 38 #define cMouseClick 39 #define cGetHSCursorAdr 40 #define cPassText 41 #define cGetClickLoc 42 #define cExecuteButton 43 #define cScrollField 44 #define cSetHSFont 45 #define cSetBrushNum 46 #define cSetLineWidth 47 #define cGetOffScreen 48 #define cGetCurrentScore 49 #define cSetNextTransition 50 #define cIsMenuThere 51 #define cGetUndoBuffer 52 #define cGetCardPalette 53 #define cPlayDiskSound 54 #define cPlayResSound 55 #define cGetSelectedInfo 56 #define cGetPatterns 57 #define cGetFieldText 58 #define cSetFieldText 59 #define cGetHSFont 60 #define cLoadPaintFile 61 #define cSwapCardPos 62 #define cSortCards 63 #define cSetDirtyFlag 64 #define cAddScript2Button 65 #define cCreatePaletteWindow 66 #define cCallNBA 67 #define cCallHS_XCMD 68 #define cGetResRefNums 69 #define cSetBkgdDirty 70 #define cPlaySound 71 #define cGetAdvancedUser 72 #define cVideoOn 73 #define cVideoOff 74 #define cMakeTransMask 75 #define cInitTrans 76 #define cIncTrans 77 #define cHorizStrip 78 #define cVertStrip 79 #define cBrushDialog 80 #define cLineDialog 81 #define cPatternDialog 82 #define cColorDialog 83 #define cStartDrawing 84 #define cDrawToScreen 85 #define cDrawToOffScreen 86 #define cEndDrawing 87 #define cSetDrawColor 88 #define cGetNewBtnName 89 #define cGetSndStatus 90 #define cSetMarkedCard 91 #define cGetNewExtrasMenu 92 #define cGetOtherCursors 93 #define cDoButtonAnimation 94 #define cPlayAnimation 95 #define cFlush2Undo 96 #define cLoadStackField 97 #define cSaveStackField 98 #define cPrintStackField 99 #define cLoadText 100 #define cSaveText 101 #define cPrintText 102 #define cGetPaintVars 103 #define cGetItemHandle 104 #define cBeginXSound 105 #define cEndXSound 106 #define cGetColorCtlDefProc 107 #define mAboutHyperStudio 0 #define mPreferences 1 #define mNewStack 2 #define mOpenStack 3 #define mSaveStack 4 #define mSaveStackAs 5 #define mLoadBackground 6 #define mSaveBackground 7 #define mAddClipArt 8 #define mPageSetup 9 #define mPrint 10 #define mQuit 11 #define mUndo 12 #define mCut 13 #define mCopy 14 #define mPaste 15 #define mClear 16 #define mNewCard 17 #define mDeleteCard 18 #define mCutCard 19 #define mCopyCard 20 #define mFlipHorizontal 21 #define mFlipVertical 22 #define mEraseBackground 23 #define mBack 24 #define mHome 25 #define mFirstCard 26 #define mPreviousCard 27 #define mNextCard 28 #define mLastCard 29 #define mMoveToCard 30 #define mFindText 31 #define mSetCurrentTool 32 #define mItemInfo 33 #define mCardInfo 34 #define mBackgroundInfo 35 #define mStackInfo 36 #define mBringCloser 37 #define mSendFarther 38 #define mAddButton 39 #define mAddGraphic 40 #define mAddField 41 #define mAddVideo 42 #define mSetCurrentColor 43 #define mLineSizedialog 44 #define mBrushShapedialog 45 #define mToggleDrawFilled 46 #define mToggleDrawMultiple 47 #define mToggleDrawCentered 48 #define mTextStyledialog 49 #define mTextColordialog 50 #define mBackgroundColordialog 51 #define mReplaceColorsdialog 52 #define mEditPattern 53 #define mStandardPaletteRestore 54 #define mHideItems 55 #define mToggleMenubarVisibility 56 typedef struct wdString { /* word string */ word length; char string[]; } wdString, *wdStringPtr; typedef struct HSParams { /* HyperStudio parameters */ word ButtonID; word CardID; handle ScriptHand; longword ScriptLength; wdString *TextPassedPtr; ptr CallBack; word Version; word MemoryID; word Command; word SubCommand; longword CP1; longword CP2; longword CP3; longword CP4; longword CP5; } HSParams, *HSParamPtr; extern pascal void __NBACALLBACK (int, HSParamPtr); #endif \ No newline at end of file +/**************************************************************** +* +* HyperStudio.h - Interface for HyperStudio +* +* December 1992 +* Mike Westerfield +* +* Thanks to Ken Kashmarek, who supplied the original files from +* wich I shamelessly swiped the names used here. (Of course, +* that made it easier for him to convert his software!) +* +* Copyright 1992, 1993 +* Byte Works, Inc. +* +****************************************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __hyperstudio__ +#define __hyperstudio__ + +/* Callback numbers */ + +#define cMoveToFirst 1 +#define cMoveToLast 2 +#define cMovePrev 3 +#define cMoveNext 4 +#define cMoveToID 5 +#define cRedrawCard 6 +#define cGetStackName 7 +#define cFindText 8 +#define cPokeyFlag 9 +#define cDoMenu 10 +#define cGetHSMode 11 +#define cGetHSVersion 12 +#define cGetStackPathName 13 +#define cGetNumCards 14 +#define cGetNumButtons 15 +#define cGetNumFields 16 +#define cGetNumGraphics 17 +#define cPoint2StackHead 18 +#define cPoint2FirstCard 19 +#define cPoint2CurrCard 20 +#define cPoint2NextCard 21 +#define cPoint2CardItems 22 +#define cPoint2NextCdItem 23 +#define cPoint2StackItem 24 +#define cGetCallerAddr 25 +#define cHideStackItem 26 +#define cShowStackItem 27 +#define cLockItem 28 +#define cUnLockItem 29 +#define cDeleteStackItem 30 +#define cGetItemRect 31 +#define cSetItemRect 32 +#define cGetButtonIcon 33 +#define cSetButtonIcon 34 +#define cGetItemStats 35 +#define cLaunchApplication 36 +#define cGetItemLoc 37 +#define cRedrawItem 38 +#define cMouseClick 39 +#define cGetHSCursorAdr 40 +#define cPassText 41 +#define cGetClickLoc 42 +#define cExecuteButton 43 +#define cScrollField 44 +#define cSetHSFont 45 +#define cSetBrushNum 46 +#define cSetLineWidth 47 +#define cGetOffScreen 48 +#define cGetCurrentScore 49 +#define cSetNextTransition 50 +#define cIsMenuThere 51 +#define cGetUndoBuffer 52 +#define cGetCardPalette 53 +#define cPlayDiskSound 54 +#define cPlayResSound 55 +#define cGetSelectedInfo 56 +#define cGetPatterns 57 +#define cGetFieldText 58 +#define cSetFieldText 59 +#define cGetHSFont 60 +#define cLoadPaintFile 61 +#define cSwapCardPos 62 +#define cSortCards 63 +#define cSetDirtyFlag 64 +#define cAddScript2Button 65 +#define cCreatePaletteWindow 66 +#define cCallNBA 67 +#define cCallHS_XCMD 68 +#define cGetResRefNums 69 +#define cSetBkgdDirty 70 +#define cPlaySound 71 +#define cGetAdvancedUser 72 +#define cVideoOn 73 +#define cVideoOff 74 +#define cMakeTransMask 75 +#define cInitTrans 76 +#define cIncTrans 77 +#define cHorizStrip 78 +#define cVertStrip 79 +#define cBrushDialog 80 +#define cLineDialog 81 +#define cPatternDialog 82 +#define cColorDialog 83 +#define cStartDrawing 84 +#define cDrawToScreen 85 +#define cDrawToOffScreen 86 +#define cEndDrawing 87 +#define cSetDrawColor 88 +#define cGetNewBtnName 89 +#define cGetSndStatus 90 +#define cSetMarkedCard 91 +#define cGetNewExtrasMenu 92 +#define cGetOtherCursors 93 +#define cDoButtonAnimation 94 +#define cPlayAnimation 95 +#define cFlush2Undo 96 +#define cLoadStackField 97 +#define cSaveStackField 98 +#define cPrintStackField 99 +#define cLoadText 100 +#define cSaveText 101 +#define cPrintText 102 +#define cGetPaintVars 103 +#define cGetItemHandle 104 +#define cBeginXSound 105 +#define cEndXSound 106 +#define cGetColorCtlDefProc 107 + + + +#define mAboutHyperStudio 0 +#define mPreferences 1 +#define mNewStack 2 +#define mOpenStack 3 +#define mSaveStack 4 +#define mSaveStackAs 5 +#define mLoadBackground 6 +#define mSaveBackground 7 +#define mAddClipArt 8 +#define mPageSetup 9 +#define mPrint 10 +#define mQuit 11 +#define mUndo 12 +#define mCut 13 +#define mCopy 14 +#define mPaste 15 +#define mClear 16 +#define mNewCard 17 +#define mDeleteCard 18 +#define mCutCard 19 +#define mCopyCard 20 +#define mFlipHorizontal 21 +#define mFlipVertical 22 +#define mEraseBackground 23 +#define mBack 24 +#define mHome 25 +#define mFirstCard 26 +#define mPreviousCard 27 +#define mNextCard 28 +#define mLastCard 29 +#define mMoveToCard 30 +#define mFindText 31 +#define mSetCurrentTool 32 +#define mItemInfo 33 +#define mCardInfo 34 +#define mBackgroundInfo 35 +#define mStackInfo 36 +#define mBringCloser 37 +#define mSendFarther 38 +#define mAddButton 39 +#define mAddGraphic 40 +#define mAddField 41 +#define mAddVideo 42 +#define mSetCurrentColor 43 +#define mLineSizedialog 44 +#define mBrushShapedialog 45 +#define mToggleDrawFilled 46 +#define mToggleDrawMultiple 47 +#define mToggleDrawCentered 48 +#define mTextStyledialog 49 +#define mTextColordialog 50 +#define mBackgroundColordialog 51 +#define mReplaceColorsdialog 52 +#define mEditPattern 53 +#define mStandardPaletteRestore 54 +#define mHideItems 55 +#define mToggleMenubarVisibility 56 + +typedef struct wdString { /* word string */ + word length; + char string[]; + } wdString, *wdStringPtr; + +typedef struct HSParams { /* HyperStudio parameters */ + word ButtonID; + word CardID; + handle ScriptHand; + longword ScriptLength; + wdString *TextPassedPtr; + ptr CallBack; + word Version; + word MemoryID; + word Command; + word SubCommand; + longword CP1; + longword CP2; + longword CP3; + longword CP4; + longword CP5; + } HSParams, *HSParamPtr; + +extern pascal void __NBACALLBACK (int, HSParamPtr); + +#endif diff --git a/bin/Libraries/ORCACDefs/hyperxcmd.h b/bin/Libraries/ORCACDefs/hyperxcmd.h index 25d0785..b906a65 100644 --- a/bin/Libraries/ORCACDefs/hyperxcmd.h +++ b/bin/Libraries/ORCACDefs/hyperxcmd.h @@ -1 +1,134 @@ -/********************************************************* * * File: HyperXCMD.h * * Definition file for HyperCard XCMDs and XFCNs in C * For use with HyperCard IIGS Version 1.1 * * Copyright Apple Computer, Inc. 1990-91 * All Rights Reserved * * Copyright 1992, Byte Works, Inc. * *********************************************************/ #ifndef __TYPES__ #include #endif #ifndef __HYPERXCMD__ #define __HYPERXCMD__ #define _CallBackVector 0x00E10220L /* XCMDBlock constants for event.what... */ #define xOpenEvt 1000 /* the first event after you are created */ #define xCloseEvt 1001 /* your window is being forced close */ #define xHidePalettesEvt 1004 /* someone called HideHCPalettes */ #define xShowPalettesEvt 1005 /* someone called ShowHCPalettes */ #define xCursorWithin 1300 /* cursor is within the window */ /* XWindow styles */ #define xWindoidStyle 0 #define xRectStyle 1 #define xShadowStyle 2 #define xDialogStyle 3 typedef String(19) Str19, *String19Ptr, **String19Handle; typedef String(31) Str31, *String31Ptr, **String31Handle; struct XCMDBlock { int paramCount; Handle params[16]; Handle returnValue; Boolean passFlag; Word userID; Word returnStat; /* 0 if normal, 1 if error */ }; typedef struct XCMDBlock XCMDBlock, *XCMDPtr; struct XWEventInfo { WindowPtr eventWindow; EventRecord event; long eventParams[9]; Handle eventResult; }; typedef struct XWEventInfo XWEventInfo, *XWEventInfoPtr; /**** HyperTalk Utilities ****/ extern pascal Handle EvalExpr(Str255) inline(0x0002,_CallBackVector); extern pascal void SendCardMessage(Str255 msg) inline(0x0001,_CallBackVector); extern pascal void SendHCMessage(Str255) inline(0x0005,_CallBackVector); /**** Memory Utilities ****/ extern pascal Handle GetGlobal(Str255) inline(0x0012,_CallBackVector); extern pascal void SetGlobal(Str255, Handle) inline(0x0013,_CallBackVector); extern pascal void ZeroBytes(Ptr, long) inline(0x0006,_CallBackVector); /**** String Utilities ****/ extern pascal Boolean GSStringEqual(GSString255Hndl, GSString255Hndl) inline(0x0022,_CallBackVector); extern pascal void ScanToReturn(Ptr *) inline(0x001C,_CallBackVector); extern pascal void ScanToZero(Ptr *) inline(0x001D,_CallBackVector); extern pascal Boolean StringEqual(Str255, Str255) inline(0x001A,_CallBackVector); extern pascal Longint StringLength(Ptr) inline(0x0003,_CallBackVector); extern pascal Ptr StringMatch(Str255, Ptr) inline(0x0004,_CallBackVector); /**** String Conversions ****/ extern pascal Str31 BoolToStr(Boolean) inline(0x0010,_CallBackVector); extern pascal GSString255Hndl CopyGSString(GSString255Hndl) inline(0x0020,_CallBackVector); extern pascal Str31 ExtToStr(Extended) inline(0x0011,_CallBackVector); extern pascal GSString255Hndl GSConcat(GSString255Hndl, GSString255Hndl) inline(0x0021,_CallBackVector); extern pascal Str255 GSToPString(GSString255Hndl) inline(0x001E,_CallBackVector); extern pascal Handle GSToZero(GSString255Hndl) inline(0x0023,_CallBackVector); extern pascal Str31 LongToStr(Longint) inline(0x000D,_CallBackVector); extern pascal Str19 NumToHex(Longint, word) inline(0x000F,_CallBackVector); extern pascal Str31 NumToStr(Longint) inline(0x000E,_CallBackVector); extern pascal void PointToStr(Point, Str255) inline(0x002D,_CallBackVector); extern pascal Handle PasToZero(Str255) inline(0x0007,_CallBackVector); extern pascal GSString255Hndl PToGSString(Str255) inline(0x001F,_CallBackVector); extern pascal void RectToStr(Rect *, Str255) inline(0x002E,_CallBackVector); extern pascal void ReturnToPas(Ptr, Str255 *) inline(0x001B,_CallBackVector); extern pascal Boolean StrToBool(Str31) inline(0x000B,_CallBackVector); extern pascal extended StrToExt(Str31) inline(0x000C,_CallBackVector); extern pascal Longint StrToLong(Str31) inline(0x0009,_CallBackVector); extern pascal Longint StrToNum(Str31) inline(0x000A,_CallBackVector); extern pascal void StrToPoint(Str255, Point) inline(0x002F,_CallBackVector); extern pascal void StrToRect(Str255, Rect *) inline(0x0030,_CallBackVector); extern pascal GSString255Hndl ZeroToGS(Handle) inline(0x0024,_CallBackVector); extern pascal void ZeroToPas(Ptr, Str255 *) inline(0x0008,_CallBackVector); /**** Field Utilities ****/ extern pascal Handle GetFieldByID(Boolean, word) inline(0x0016,_CallBackVector); extern pascal Handle GetFieldByName(Boolean, Str255) inline(0x0014,_CallBackVector); extern pascal Handle GetFieldByNum(Boolean, word) inline(0x0015,_CallBackVector); extern pascal void SetFieldByID(Boolean, word, Handle) inline(0x0019,_CallBackVector); extern pascal void SetFieldByName(Boolean, Str255, Handle) inline(0x0017,_CallBackVector); extern pascal void SetFieldByNum(Boolean, word, Handle) inline(0x0018,_CallBackVector); /**** Graphic Utilities ****/ extern pascal void ChangedMaskAndData(word) inline(0x002C,_CallBackVector); extern pascal void GetMaskAndData(LocInfoPtr, LocInfoPtr) inline(0x002B,_CallBackVector); /**** Miscellaneous Utilities ****/ extern pascal void BeginXSound(void) inline(0x0029,_CallBackVector); extern pascal void EndXSound(void) inline(0x002A,_CallBackVector); /**** Resource Names Utilities ****/ extern pascal Boolean FindNamedResource(word, Str255, word *, long *) inline(0x0026,_CallBackVector); extern pascal Str255 GetResourceName(word, long) inline(0x0028,_CallBackVector); extern pascal Handle LoadNamedResource(word, Str255) inline(0x0025,_CallBackVector); extern pascal void SetResourceName(word, long, Str255) inline(0x0027,_CallBackVector); /**** Creating and Disposing XWindoids ****/ extern pascal WindowPtr NewXWindow(Rect, Str31, Boolean, word) inline(0x0031,_CallBackVector); extern pascal void CloseXWindow(WindowPtr) inline(0x0033,_CallBackVector); /**** XWindoid Utilities ****/ extern pascal Longint GetXWindowValue(WindowPtr) inline(0x0037,_CallBackVector); extern pascal void HideHCPalettes(void) inline(0x0034,_CallBackVector); extern pascal void ShowHCPalettes(void) inline(0x0035,_CallBackVector); extern pascal void SetXWIdleTime(WindowPtr, Longint) inline(0x0032,_CallBackVector); extern pascal void SetXWindowValue(WindowPtr, Longint) inline(0x0036,_CallBackVector); extern pascal void XWAllowReEntrancy(WindowPtr, Boolean, Boolean) inline(0x0038,_CallBackVector); #endif \ No newline at end of file +/********************************************************* +* +* File: HyperXCMD.h +* +* Definition file for HyperCard XCMDs and XFCNs in C +* For use with HyperCard IIGS Version 1.1 +* +* Copyright Apple Computer, Inc. 1990-91 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc. +* +*********************************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __HYPERXCMD__ +#define __HYPERXCMD__ + +#define _CallBackVector 0x00E10220L + +/* XCMDBlock constants for event.what... */ +#define xOpenEvt 1000 /* the first event after you are created */ +#define xCloseEvt 1001 /* your window is being forced close */ +#define xHidePalettesEvt 1004 /* someone called HideHCPalettes */ +#define xShowPalettesEvt 1005 /* someone called ShowHCPalettes */ +#define xCursorWithin 1300 /* cursor is within the window */ + +/* XWindow styles */ +#define xWindoidStyle 0 +#define xRectStyle 1 +#define xShadowStyle 2 +#define xDialogStyle 3 + +typedef String(19) Str19, *String19Ptr, **String19Handle; +typedef String(31) Str31, *String31Ptr, **String31Handle; + +struct XCMDBlock { + int paramCount; + Handle params[16]; + Handle returnValue; + Boolean passFlag; + Word userID; + Word returnStat; /* 0 if normal, 1 if error */ + }; +typedef struct XCMDBlock XCMDBlock, *XCMDPtr; + +struct XWEventInfo { + WindowPtr eventWindow; + EventRecord event; + long eventParams[9]; + Handle eventResult; + }; +typedef struct XWEventInfo XWEventInfo, *XWEventInfoPtr; + +/**** HyperTalk Utilities ****/ +extern pascal Handle EvalExpr(Str255) inline(0x0002,_CallBackVector); +extern pascal void SendCardMessage(Str255 msg) inline(0x0001,_CallBackVector); +extern pascal void SendHCMessage(Str255) inline(0x0005,_CallBackVector); + +/**** Memory Utilities ****/ +extern pascal Handle GetGlobal(Str255) inline(0x0012,_CallBackVector); +extern pascal void SetGlobal(Str255, Handle) inline(0x0013,_CallBackVector); +extern pascal void ZeroBytes(Ptr, long) inline(0x0006,_CallBackVector); + +/**** String Utilities ****/ +extern pascal Boolean GSStringEqual(GSString255Hndl, GSString255Hndl) inline(0x0022,_CallBackVector); +extern pascal void ScanToReturn(Ptr *) inline(0x001C,_CallBackVector); +extern pascal void ScanToZero(Ptr *) inline(0x001D,_CallBackVector); +extern pascal Boolean StringEqual(Str255, Str255) inline(0x001A,_CallBackVector); +extern pascal Longint StringLength(Ptr) inline(0x0003,_CallBackVector); +extern pascal Ptr StringMatch(Str255, Ptr) inline(0x0004,_CallBackVector); + +/**** String Conversions ****/ +extern pascal Str31 BoolToStr(Boolean) inline(0x0010,_CallBackVector); +extern pascal GSString255Hndl CopyGSString(GSString255Hndl) inline(0x0020,_CallBackVector); +extern pascal Str31 ExtToStr(Extended) inline(0x0011,_CallBackVector); +extern pascal GSString255Hndl GSConcat(GSString255Hndl, GSString255Hndl) inline(0x0021,_CallBackVector); +extern pascal Str255 GSToPString(GSString255Hndl) inline(0x001E,_CallBackVector); +extern pascal Handle GSToZero(GSString255Hndl) inline(0x0023,_CallBackVector); +extern pascal Str31 LongToStr(Longint) inline(0x000D,_CallBackVector); +extern pascal Str19 NumToHex(Longint, word) inline(0x000F,_CallBackVector); +extern pascal Str31 NumToStr(Longint) inline(0x000E,_CallBackVector); +extern pascal void PointToStr(Point, Str255) inline(0x002D,_CallBackVector); +extern pascal Handle PasToZero(Str255) inline(0x0007,_CallBackVector); +extern pascal GSString255Hndl PToGSString(Str255) inline(0x001F,_CallBackVector); +extern pascal void RectToStr(Rect *, Str255) inline(0x002E,_CallBackVector); +extern pascal void ReturnToPas(Ptr, Str255 *) inline(0x001B,_CallBackVector); +extern pascal Boolean StrToBool(Str31) inline(0x000B,_CallBackVector); +extern pascal extended StrToExt(Str31) inline(0x000C,_CallBackVector); +extern pascal Longint StrToLong(Str31) inline(0x0009,_CallBackVector); +extern pascal Longint StrToNum(Str31) inline(0x000A,_CallBackVector); +extern pascal void StrToPoint(Str255, Point) inline(0x002F,_CallBackVector); +extern pascal void StrToRect(Str255, Rect *) inline(0x0030,_CallBackVector); +extern pascal GSString255Hndl ZeroToGS(Handle) inline(0x0024,_CallBackVector); +extern pascal void ZeroToPas(Ptr, Str255 *) inline(0x0008,_CallBackVector); + +/**** Field Utilities ****/ +extern pascal Handle GetFieldByID(Boolean, word) inline(0x0016,_CallBackVector); +extern pascal Handle GetFieldByName(Boolean, Str255) inline(0x0014,_CallBackVector); +extern pascal Handle GetFieldByNum(Boolean, word) inline(0x0015,_CallBackVector); +extern pascal void SetFieldByID(Boolean, word, Handle) inline(0x0019,_CallBackVector); +extern pascal void SetFieldByName(Boolean, Str255, Handle) inline(0x0017,_CallBackVector); +extern pascal void SetFieldByNum(Boolean, word, Handle) inline(0x0018,_CallBackVector); + +/**** Graphic Utilities ****/ +extern pascal void ChangedMaskAndData(word) inline(0x002C,_CallBackVector); +extern pascal void GetMaskAndData(LocInfoPtr, LocInfoPtr) inline(0x002B,_CallBackVector); + +/**** Miscellaneous Utilities ****/ +extern pascal void BeginXSound(void) inline(0x0029,_CallBackVector); +extern pascal void EndXSound(void) inline(0x002A,_CallBackVector); + +/**** Resource Names Utilities ****/ +extern pascal Boolean FindNamedResource(word, Str255, word *, long *) inline(0x0026,_CallBackVector); +extern pascal Str255 GetResourceName(word, long) inline(0x0028,_CallBackVector); +extern pascal Handle LoadNamedResource(word, Str255) inline(0x0025,_CallBackVector); +extern pascal void SetResourceName(word, long, Str255) inline(0x0027,_CallBackVector); + +/**** Creating and Disposing XWindoids ****/ +extern pascal WindowPtr NewXWindow(Rect, Str31, Boolean, word) inline(0x0031,_CallBackVector); +extern pascal void CloseXWindow(WindowPtr) inline(0x0033,_CallBackVector); + +/**** XWindoid Utilities ****/ +extern pascal Longint GetXWindowValue(WindowPtr) inline(0x0037,_CallBackVector); +extern pascal void HideHCPalettes(void) inline(0x0034,_CallBackVector); +extern pascal void ShowHCPalettes(void) inline(0x0035,_CallBackVector); +extern pascal void SetXWIdleTime(WindowPtr, Longint) inline(0x0032,_CallBackVector); +extern pascal void SetXWindowValue(WindowPtr, Longint) inline(0x0036,_CallBackVector); +extern pascal void XWAllowReEntrancy(WindowPtr, Boolean, Boolean) inline(0x0038,_CallBackVector); + +#endif diff --git a/bin/Libraries/ORCACDefs/intmath.h b/bin/Libraries/ORCACDefs/intmath.h index 4287189..c752ad2 100644 --- a/bin/Libraries/ORCACDefs/intmath.h +++ b/bin/Libraries/ORCACDefs/intmath.h @@ -1 +1,104 @@ -/******************************************** * * Integer Math Tool Set * * Copyright Apple Computer, Inc.1986-90 * All Rights Reserved * * Copyright 1992, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __INTMATH__ #define __INTMATH__ /* Error Codes */ #define imBadInptParam 0x0B01 /* bad input parameter */ #define imIllegalChar 0x0B02 /* Illegal character in string */ #define imOverflow 0x0B03 /* integer or long integer overflow */ #define imStrOverflow 0x0B04 /* string overflow */ /* Limit Values */ #define minLongint 0x80000000 /* minimum negative signed long integer */ #define minFrac 0x80000000 /* pinned value for negative Frac overflow */ #define minFixed 0x80000000 /* pinned value for negative Fixed overflow */ #define minInt 0x8000 /* Minimum negative signed integer */ #define maxInt 0x7FFF /* Maximum positive signed integer */ #define maxUInt 0xFFFF /* Maximum positive unsigned integer */ #define maxLongint 0x7FFFFFFF /* maximum positive signed Longint */ #define maxFrac 0x7FFFFFFF /* pinned value for positive Frac overflow */ #define maxFixed 0x7FFFFFFF /* pinned value for positive Fixed overflow */ #define maxULong 0xFFFFFFFFL /* maximum unsigned Long */ struct IntDivRec { Word quotient; /* quotient from SDivide */ Word remainder; /* remainder from SDivide */ }; typedef struct IntDivRec IntDivRec, *IntDivRecPtr; struct LongDivRec { Longint quotient; /* Quotient from LongDiv */ Longint remainder; /* remainder from LongDiv */ }; typedef struct LongDivRec LongDivRec, *LongDivRecPtr; typedef LongDivRec DivRec, *DivRecPtr; /* for backward compatability */ struct LongMulRec { Longint lsResult; /* low 2 words of product */ Longint msResult; /* High 2 words of product */ }; typedef struct LongMulRec LongMulRec, *LongMulRecPtr; struct WordDivRec { Word quotient; /* Quotient from UDivide */ Word remainder; /* remainder from UDivide */ }; typedef struct WordDivRec WordDivRec, *WordDivRecPtr; extern pascal void IMBootInit(void) inline(0x010B,dispatcher); extern pascal void IMStartUp(void) inline(0x020B,dispatcher); extern pascal void IMShutDown(void) inline(0x030B,dispatcher); extern pascal Word IMVersion(void) inline(0x040B,dispatcher); extern pascal void IMReset(void) inline(0x050B,dispatcher); extern pascal Boolean IMStatus(void) inline(0x060B,dispatcher); extern pascal Integer Dec2Int(Pointer, Word, Boolean) inline(0x280B,dispatcher); extern pascal Longint Dec2Long(Pointer, Word, Boolean) inline(0x290B,dispatcher); extern pascal Frac Fix2Frac(Fixed) inline(0x1C0B,dispatcher); extern pascal Longint Fix2Long(Fixed) inline(0x1B0B,dispatcher); extern pascal void Fix2X(Fixed, ExtendedPtr) inline(0x1E0B,dispatcher); extern pascal Fixed FixATan2(Longint, Longint) inline(0x170B,dispatcher); extern pascal Fixed FixDiv(Longint, Longint) inline(0x110B,dispatcher); extern pascal Fixed FixMul(Fixed, Fixed) inline(0x0F0B,dispatcher); extern pascal Fixed FixRatio(Integer, Integer) inline(0x0E0B,dispatcher); extern pascal Integer FixRound(Fixed) inline(0x130B,dispatcher); extern pascal Fixed Frac2Fix(Frac) inline(0x1D0B,dispatcher); extern pascal void Frac2X(Frac, ExtendedPtr) inline(0x1F0B,dispatcher); extern pascal Frac FracCos(Fixed) inline(0x150B,dispatcher); extern pascal Frac FracDiv(Longint, Longint) inline(0x120B,dispatcher); extern pascal Frac FracMul(Frac, Frac) inline(0x100B,dispatcher); extern pascal Frac FracSin(Fixed) inline(0x160B,dispatcher); extern pascal Frac FracSqrt(Frac) inline(0x140B,dispatcher); extern pascal Word Hex2Int(Pointer, Word) inline(0x240B,dispatcher); extern pascal LongWord Hex2Long(Pointer, Word) inline(0x250B,dispatcher); extern pascal LongWord HexIt(Word) inline(0x2A0B,dispatcher); extern pascal Word HiWord(LongWord) inline(0x180B,dispatcher); extern pascal void Int2Dec(Integer, Pointer, Word, Boolean) inline(0x260B,dispatcher); extern pascal void Int2Hex(Word, Pointer, Word) inline(0x220B,dispatcher); extern pascal void Long2Dec(Longint, Pointer, Word, Boolean) inline(0x270B,dispatcher); extern pascal Fixed Long2Fix(Longint) inline(0x1A0B,dispatcher); extern pascal void Long2Hex(LongWord, Pointer, Word) inline(0x230B,dispatcher); extern LongDivRec LongDivide(Longint, Longint); extern LongMulRec LongMul(Longint, Longint); extern pascal Word LoWord(LongWord) inline(0x190B,dispatcher); extern pascal Longint Multiply(Integer, Integer) inline(0x090B,dispatcher); extern IntDivRec SDivide(Integer, Integer); extern WordDivRec UDivide(Word, Word); extern pascal Fixed X2Fix(ExtendedPtr) inline(0x200B,dispatcher); extern pascal Frac X2Frac(ExtendedPtr) inline(0x210B,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Integer Math Tool Set +* +* Copyright Apple Computer, Inc.1986-90 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __INTMATH__ +#define __INTMATH__ + +/* Error Codes */ +#define imBadInptParam 0x0B01 /* bad input parameter */ +#define imIllegalChar 0x0B02 /* Illegal character in string */ +#define imOverflow 0x0B03 /* integer or long integer overflow */ +#define imStrOverflow 0x0B04 /* string overflow */ + +/* Limit Values */ +#define minLongint 0x80000000 /* minimum negative signed long integer */ +#define minFrac 0x80000000 /* pinned value for negative Frac overflow */ +#define minFixed 0x80000000 /* pinned value for negative Fixed overflow */ +#define minInt 0x8000 /* Minimum negative signed integer */ +#define maxInt 0x7FFF /* Maximum positive signed integer */ +#define maxUInt 0xFFFF /* Maximum positive unsigned integer */ +#define maxLongint 0x7FFFFFFF /* maximum positive signed Longint */ +#define maxFrac 0x7FFFFFFF /* pinned value for positive Frac overflow */ +#define maxFixed 0x7FFFFFFF /* pinned value for positive Fixed overflow */ +#define maxULong 0xFFFFFFFFL /* maximum unsigned Long */ + +struct IntDivRec { + Word quotient; /* quotient from SDivide */ + Word remainder; /* remainder from SDivide */ + }; +typedef struct IntDivRec IntDivRec, *IntDivRecPtr; + +struct LongDivRec { + Longint quotient; /* Quotient from LongDiv */ + Longint remainder; /* remainder from LongDiv */ + }; +typedef struct LongDivRec LongDivRec, *LongDivRecPtr; + +typedef LongDivRec DivRec, *DivRecPtr; /* for backward compatability */ + +struct LongMulRec { + Longint lsResult; /* low 2 words of product */ + Longint msResult; /* High 2 words of product */ + }; +typedef struct LongMulRec LongMulRec, *LongMulRecPtr; + +struct WordDivRec { + Word quotient; /* Quotient from UDivide */ + Word remainder; /* remainder from UDivide */ + }; +typedef struct WordDivRec WordDivRec, *WordDivRecPtr; + +extern pascal void IMBootInit(void) inline(0x010B,dispatcher); +extern pascal void IMStartUp(void) inline(0x020B,dispatcher); +extern pascal void IMShutDown(void) inline(0x030B,dispatcher); +extern pascal Word IMVersion(void) inline(0x040B,dispatcher); +extern pascal void IMReset(void) inline(0x050B,dispatcher); +extern pascal Boolean IMStatus(void) inline(0x060B,dispatcher); +extern pascal Integer Dec2Int(Pointer, Word, Boolean) inline(0x280B,dispatcher); +extern pascal Longint Dec2Long(Pointer, Word, Boolean) inline(0x290B,dispatcher); +extern pascal Frac Fix2Frac(Fixed) inline(0x1C0B,dispatcher); +extern pascal Longint Fix2Long(Fixed) inline(0x1B0B,dispatcher); +extern pascal void Fix2X(Fixed, ExtendedPtr) inline(0x1E0B,dispatcher); +extern pascal Fixed FixATan2(Longint, Longint) inline(0x170B,dispatcher); +extern pascal Fixed FixDiv(Longint, Longint) inline(0x110B,dispatcher); +extern pascal Fixed FixMul(Fixed, Fixed) inline(0x0F0B,dispatcher); +extern pascal Fixed FixRatio(Integer, Integer) inline(0x0E0B,dispatcher); +extern pascal Integer FixRound(Fixed) inline(0x130B,dispatcher); +extern pascal Fixed Frac2Fix(Frac) inline(0x1D0B,dispatcher); +extern pascal void Frac2X(Frac, ExtendedPtr) inline(0x1F0B,dispatcher); +extern pascal Frac FracCos(Fixed) inline(0x150B,dispatcher); +extern pascal Frac FracDiv(Longint, Longint) inline(0x120B,dispatcher); +extern pascal Frac FracMul(Frac, Frac) inline(0x100B,dispatcher); +extern pascal Frac FracSin(Fixed) inline(0x160B,dispatcher); +extern pascal Frac FracSqrt(Frac) inline(0x140B,dispatcher); +extern pascal Word Hex2Int(Pointer, Word) inline(0x240B,dispatcher); +extern pascal LongWord Hex2Long(Pointer, Word) inline(0x250B,dispatcher); +extern pascal LongWord HexIt(Word) inline(0x2A0B,dispatcher); +extern pascal Word HiWord(LongWord) inline(0x180B,dispatcher); +extern pascal void Int2Dec(Integer, Pointer, Word, Boolean) inline(0x260B,dispatcher); +extern pascal void Int2Hex(Word, Pointer, Word) inline(0x220B,dispatcher); +extern pascal void Long2Dec(Longint, Pointer, Word, Boolean) inline(0x270B,dispatcher); +extern pascal Fixed Long2Fix(Longint) inline(0x1A0B,dispatcher); +extern pascal void Long2Hex(LongWord, Pointer, Word) inline(0x230B,dispatcher); +extern LongDivRec LongDivide(Longint, Longint); +extern LongMulRec LongMul(Longint, Longint); +extern pascal Word LoWord(LongWord) inline(0x190B,dispatcher); +extern pascal Longint Multiply(Integer, Integer) inline(0x090B,dispatcher); +extern IntDivRec SDivide(Integer, Integer); +extern WordDivRec UDivide(Word, Word); +extern pascal Fixed X2Fix(ExtendedPtr) inline(0x200B,dispatcher); +extern pascal Frac X2Frac(ExtendedPtr) inline(0x210B,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/limits.h b/bin/Libraries/ORCACDefs/limits.h index f3fbd29..904c3ad 100644 --- a/bin/Libraries/ORCACDefs/limits.h +++ b/bin/Libraries/ORCACDefs/limits.h @@ -1 +1,33 @@ -/**************************************************************** * * limits.h - limits on the size of numbers * * April 1989 * Mike Westerfield * * Copyright 1989 * Byte Works, Inc. * ****************************************************************/ #ifndef __limits__ #define __limits__ #define CHAR_BIT 8 #define CHAR_MAX 255u #define CHAR_MIN 0 #define SHRT_MAX 32767 #define SHRT_MIN (-32767-1) #define INT_MAX 32767 #define INT_MIN (-32767-1) #define LONG_MAX 2147483647 #define LONG_MIN (-2147483647-1) #define MB_LEN_MAX 1 #define SCHAR_MAX 127 #define SCHAR_MIN (-128) #define UCHAR_MAX 255u #define UINT_MAX 65535u #define ULONG_MAX 4294967295u #define USHRT_MAX 65535u #endif \ No newline at end of file +/**************************************************************** +* +* limits.h - limits on the size of numbers +* +* April 1989 +* Mike Westerfield +* +* Copyright 1989 +* Byte Works, Inc. +* +****************************************************************/ + +#ifndef __limits__ +#define __limits__ + +#define CHAR_BIT 8 +#define CHAR_MAX 255u +#define CHAR_MIN 0 +#define SHRT_MAX 32767 +#define SHRT_MIN (-32767-1) +#define INT_MAX 32767 +#define INT_MIN (-32767-1) +#define LONG_MAX 2147483647 +#define LONG_MIN (-2147483647-1) +#define MB_LEN_MAX 1 +#define SCHAR_MAX 127 +#define SCHAR_MIN (-128) +#define UCHAR_MAX 255u +#define UINT_MAX 65535u +#define ULONG_MAX 4294967295u +#define USHRT_MAX 65535u + +#endif diff --git a/bin/Libraries/ORCACDefs/lineedit.h b/bin/Libraries/ORCACDefs/lineedit.h index aa7fd07..eaefa1a 100644 --- a/bin/Libraries/ORCACDefs/lineedit.h +++ b/bin/Libraries/ORCACDefs/lineedit.h @@ -1 +1,98 @@ -/******************************************** * * LineEdit Tool Set * * Copyright Apple Computer, Inc.1986-90 * All Rights Reserved * * Copyright 1992, 1993, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __LINEEDIT__ #define __LINEEDIT__ /* Error Codes */ #define leDupStrtUpErr 0x1401 /* duplicate LEStartup call */ #define leResetError 0x1402 /* can't reset Line Edit */ #define leNotActiveErr 0x1403 /* Line Edit not active */ #define leScrapErr 0x1404 /* desk scrap too big to copy */ /* Justification Codes */ #define leJustLeft 0x0000 #define leJustCenter 0x0001 #define leJustFill 0x0002 #define leJustRight 0xFFFF /* LEClassifyKey result values */ #define leKeyIsSpecial 0x8000 #define leKeyIsNumber 0x4000 #define leKeyIsHex 0x2000 #define leKeyIsAlpha 0x1000 #define leKeyIsNonControl 0x0800 struct LERec { Handle leLineHandle; Word leLength; Word leMaxLength; Rect leDestRect; Rect leViewRect; GrafPortPtr lePort; Word leLineHite; Word leBaseHite; Word leSelStart; Word leSelEnd; Word leActFlg; Word leCarAct; Word leCarOn; LongWord leCarTime; VoidProcPtr leHiliteHook; VoidProcPtr leCaretHook; Word leJust; Word lePWChar; }; typedef struct LERec LERec, *LERecPtr, **LERecHndl; extern pascal void LEBootInit(void) inline(0x0114,dispatcher); extern pascal void LEStartUp(Word, Word) inline(0x0214,dispatcher); extern pascal void LEShutDown(void) inline(0x0314,dispatcher); extern pascal Word LEVersion(void) inline(0x0414,dispatcher); extern pascal void LEReset(void) inline(0x0514,dispatcher); extern pascal Boolean LEStatus(void) inline(0x0614,dispatcher); extern pascal void LEActivate(LERecHndl) inline(0x0F14,dispatcher); extern pascal void LEClick(EventRecordPtr, LERecHndl) inline(0x0D14,dispatcher); extern pascal void LECopy(LERecHndl) inline(0x1314,dispatcher); extern pascal void LECut(LERecHndl) inline(0x1214,dispatcher); extern pascal void LEDeactivate(LERecHndl) inline(0x1014,dispatcher); extern pascal void LEDelete(LERecHndl) inline(0x1514,dispatcher); extern pascal void LEDispose(LERecHndl) inline(0x0A14,dispatcher); extern pascal void LEFromScrap(void) inline(0x1914,dispatcher); extern pascal Word LEGetScrapLen(void) inline(0x1C14,dispatcher); extern pascal Handle LEGetTextHand(LERecHndl) inline(0x2214,dispatcher); extern pascal Word LEGetTextLen(LERecHndl) inline(0x2314,dispatcher); extern pascal void LEIdle(LERecHndl) inline(0x0C14,dispatcher); extern pascal void LEInsert(Pointer, Word, LERecHndl) inline(0x1614,dispatcher); extern pascal void LEKey(Word, Word, LERecHndl) inline(0x1114,dispatcher); extern pascal LERecHndl LENew(Rect *, Rect *, Word) inline(0x0914,dispatcher); extern pascal void LEPaste(LERecHndl) inline(0x1414,dispatcher); extern pascal Handle LEScrapHandle(void) inline(0x1B14,dispatcher); extern pascal void LESetCaret(VoidProcPtr, LERecHndl) inline(0x1F14,dispatcher); extern pascal void LESetHilite(VoidProcPtr, LERecHndl) inline(0x1E14,dispatcher); extern pascal void LESetJust(Word, LERecHndl) inline(0x2114,dispatcher); extern pascal void LESetScrapLen(Word) inline(0x1D14,dispatcher); extern pascal void LESetSelect(Word, Word, LERecHndl) inline(0x0E14,dispatcher); extern pascal void LESetText(Pointer, Word, LERecHndl) inline(0x0B14,dispatcher); extern pascal void LETextBox(Pointer, Word, Rect *, Word) inline(0x1814,dispatcher); extern pascal void LETextBox2(Pointer, Word, Rect *, Word) inline(0x2014,dispatcher); extern pascal void LEToScrap(void) inline(0x1A14,dispatcher); extern pascal void LEUpdate(LERecHndl) inline(0x1714,dispatcher); extern pascal Pointer GetLEDefProc(void) inline(0x2414,dispatcher); extern pascal Word LEClassifyKey(EventRecord) inline(0x2514,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* LineEdit Tool Set +* +* Copyright Apple Computer, Inc.1986-90 +* All Rights Reserved +* +* Copyright 1992, 1993, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __LINEEDIT__ +#define __LINEEDIT__ + +/* Error Codes */ +#define leDupStrtUpErr 0x1401 /* duplicate LEStartup call */ +#define leResetError 0x1402 /* can't reset Line Edit */ +#define leNotActiveErr 0x1403 /* Line Edit not active */ +#define leScrapErr 0x1404 /* desk scrap too big to copy */ + +/* Justification Codes */ +#define leJustLeft 0x0000 +#define leJustCenter 0x0001 +#define leJustFill 0x0002 +#define leJustRight 0xFFFF + +/* LEClassifyKey result values */ +#define leKeyIsSpecial 0x8000 +#define leKeyIsNumber 0x4000 +#define leKeyIsHex 0x2000 +#define leKeyIsAlpha 0x1000 +#define leKeyIsNonControl 0x0800 + +struct LERec { + Handle leLineHandle; + Word leLength; + Word leMaxLength; + Rect leDestRect; + Rect leViewRect; + GrafPortPtr lePort; + Word leLineHite; + Word leBaseHite; + Word leSelStart; + Word leSelEnd; + Word leActFlg; + Word leCarAct; + Word leCarOn; + LongWord leCarTime; + VoidProcPtr leHiliteHook; + VoidProcPtr leCaretHook; + Word leJust; + Word lePWChar; + }; +typedef struct LERec LERec, *LERecPtr, **LERecHndl; + +extern pascal void LEBootInit(void) inline(0x0114,dispatcher); +extern pascal void LEStartUp(Word, Word) inline(0x0214,dispatcher); +extern pascal void LEShutDown(void) inline(0x0314,dispatcher); +extern pascal Word LEVersion(void) inline(0x0414,dispatcher); +extern pascal void LEReset(void) inline(0x0514,dispatcher); +extern pascal Boolean LEStatus(void) inline(0x0614,dispatcher); +extern pascal void LEActivate(LERecHndl) inline(0x0F14,dispatcher); +extern pascal void LEClick(EventRecordPtr, LERecHndl) inline(0x0D14,dispatcher); +extern pascal void LECopy(LERecHndl) inline(0x1314,dispatcher); +extern pascal void LECut(LERecHndl) inline(0x1214,dispatcher); +extern pascal void LEDeactivate(LERecHndl) inline(0x1014,dispatcher); +extern pascal void LEDelete(LERecHndl) inline(0x1514,dispatcher); +extern pascal void LEDispose(LERecHndl) inline(0x0A14,dispatcher); +extern pascal void LEFromScrap(void) inline(0x1914,dispatcher); +extern pascal Word LEGetScrapLen(void) inline(0x1C14,dispatcher); +extern pascal Handle LEGetTextHand(LERecHndl) inline(0x2214,dispatcher); +extern pascal Word LEGetTextLen(LERecHndl) inline(0x2314,dispatcher); +extern pascal void LEIdle(LERecHndl) inline(0x0C14,dispatcher); +extern pascal void LEInsert(Pointer, Word, LERecHndl) inline(0x1614,dispatcher); +extern pascal void LEKey(Word, Word, LERecHndl) inline(0x1114,dispatcher); +extern pascal LERecHndl LENew(Rect *, Rect *, Word) inline(0x0914,dispatcher); +extern pascal void LEPaste(LERecHndl) inline(0x1414,dispatcher); +extern pascal Handle LEScrapHandle(void) inline(0x1B14,dispatcher); +extern pascal void LESetCaret(VoidProcPtr, LERecHndl) inline(0x1F14,dispatcher); +extern pascal void LESetHilite(VoidProcPtr, LERecHndl) inline(0x1E14,dispatcher); +extern pascal void LESetJust(Word, LERecHndl) inline(0x2114,dispatcher); +extern pascal void LESetScrapLen(Word) inline(0x1D14,dispatcher); +extern pascal void LESetSelect(Word, Word, LERecHndl) inline(0x0E14,dispatcher); +extern pascal void LESetText(Pointer, Word, LERecHndl) inline(0x0B14,dispatcher); +extern pascal void LETextBox(Pointer, Word, Rect *, Word) inline(0x1814,dispatcher); +extern pascal void LETextBox2(Pointer, Word, Rect *, Word) inline(0x2014,dispatcher); +extern pascal void LEToScrap(void) inline(0x1A14,dispatcher); +extern pascal void LEUpdate(LERecHndl) inline(0x1714,dispatcher); + +extern pascal Pointer GetLEDefProc(void) inline(0x2414,dispatcher); + +extern pascal Word LEClassifyKey(EventRecord) inline(0x2514,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/list.h b/bin/Libraries/ORCACDefs/list.h index 5137f9b..d55361f 100644 --- a/bin/Libraries/ORCACDefs/list.h +++ b/bin/Libraries/ORCACDefs/list.h @@ -1 +1,108 @@ -/******************************************** * * List Manager * * Copyright Apple Computer, Inc. 1986-91 * All Rights Reserved * * Copyright 1992, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __LIST__ #define __LIST__ /* error codes */ #define listRejectEvent 0x1C02 /* ListType Masks */ #define cString 0x0001 /* null terminated string type */ #define LIST_STRG 0x0001 /* null terminated string type */ #define selectOnlyOne 0x0002 /* only one selection allowed */ #define LIST_SELECT 0x0002 /* single selection only */ /* memFlag Codes */ #define memDisabled 0x40 /* Sets member flag to disabled */ #define memSelected 0x80 /* Sets member flag to selected */ struct LColorTable { Word listFrameClr; /* Frame color */ Word listNorTextClr; /* Unhighlighted text color */ Word listSelTextClr; /* Highlighted text color */ Word listNorBackClr; /* Unhighlighted background color */ Word listSelBackClr; /* Highlighted backgraound color */ }; typedef struct LColorTable LColorTable, *LColorTablePtr, **LColorTableHndl; struct MemRec { Pointer memPtr; /* Pointer to string, or custom */ Byte memFlag; /* Bit Flag */ }; typedef struct MemRec MemRec, *MemRecPtr, **MemRecHndl; /* The MemRec is followed by n bytes determined by value of listMemSize field */ struct ListCtlRec { CtlRecHndl ctlNext; /* Handle of Next Control */ WindowPtr ctlOwner; /* Window owner */ Rect ctlRect; /* Enclosing Rect */ Byte ctlFlag; /* Bit 7 visible; Bit 0 string type; Bit 1 multiple */ Byte ctlHilite; /* (not used) */ Word ctlValue; /* First member in display */ LongProcPtr ctlProc; /* Address of list definition procedure */ LongProcPtr ctlAction; /* Address of list action procedure */ LongWord ctlData; /* Low = view size; High = total members */ LongWord ctlRefCon; /* Not used */ Ptr ctlColor; /* Null for default colors */ VoidProcPtr ctlMemDraw; /* Address of routine to draw members */ Word ctlMemHeight; /* Member's Height in Pixels */ Word ctlMemSize; /* Bytes in member record */ MemRecPtr ctlList; /* Adress of first member record in array */ CtlRecHndl ctlListBar; /* Handle of list contrlo's scroll bar control */ }; typedef struct ListCtlRec ListCtlRec, *ListCtlRecPtr, **ListCtlRecHndl; struct ListRec { Rect listRect; /* Enclosing Rectangle */ Word listSize; /* Number of List Members */ Word listView; /* Max Viewable members */ Word listType; /* Bit Flag */ Word listStart; /* First member in view */ CtlRecHndl listCtl; /* List control's handle */ VoidProcPtr listDraw; /* Address of Custom drawing routine */ Word listMemHeight; /* Height of list members */ Word listMemSize; /* Size of Member Records */ MemRecPtr listPointer; /* Pointer to first element in MemRec array */ LongWord listRefCon; /* becomes Control's refCon */ BarColorsPtr listScrollClr; /* Color table for list's scroll bar */ }; typedef struct ListRec ListRec, *ListRecPtr, **ListRecHndl; extern pascal void ListBootInit(void) inline(0x011C,dispatcher); extern pascal void ListStartUp(void) inline(0x021C,dispatcher); extern pascal void ListShutDown(void) inline(0x031C,dispatcher); extern pascal Word ListVersion(void) inline(0x041C,dispatcher); extern pascal void ListReset(void) inline(0x051C,dispatcher); extern pascal Boolean ListStatus(void) inline(0x061C,dispatcher); extern pascal ListCtlRecHndl CreateList(GrafPortPtr, ListRecPtr) inline(0x091C,dispatcher); extern pascal void DrawMember(MemRecPtr, ListRecPtr) inline(0x0C1C,dispatcher); extern pascal LongProcPtr GetListDefProc(void) inline(0x0E1C,dispatcher); extern pascal void NewList(MemRecPtr, ListRecPtr) inline(0x101C,dispatcher); extern pascal MemRecPtr NextMember(MemRecPtr, ListRecPtr) inline(0x0B1C,dispatcher); extern pascal MemRecPtr ResetMember(ListRecPtr) inline(0x0F1C,dispatcher); extern pascal void SelectMember(MemRecPtr, ListRecPtr) inline(0x0D1C,dispatcher); extern pascal void SortList(VoidProcPtr, ListRecPtr) inline(0x0A1C,dispatcher); extern pascal void DrawMember2(Word, Handle) inline(0x111C,dispatcher); extern pascal void NewList2(Pointer, Word, Ref, Word, Word, Handle) inline(0x161C,dispatcher); extern pascal Word NextMember2(Word, Handle) inline(0x121C,dispatcher); extern pascal Word ResetMember2(Handle) inline(0x131C,dispatcher); extern pascal void SelectMember2(Word, Handle) inline(0x141C,dispatcher); extern pascal void SortList2(Pointer, Handle) inline(0x151C,dispatcher); extern pascal Word CompareStrings(Word, Ptr, Ptr) inline(0x181C,dispatcher); extern pascal void ListKey(Word, EventRecordPtr, CtlRecHndl) inline(0x171c, dispatcher); #endif \ No newline at end of file +/******************************************** +* +* List Manager +* +* Copyright Apple Computer, Inc. 1986-91 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __LIST__ +#define __LIST__ + +/* error codes */ +#define listRejectEvent 0x1C02 + +/* ListType Masks */ +#define cString 0x0001 /* null terminated string type */ +#define LIST_STRG 0x0001 /* null terminated string type */ +#define selectOnlyOne 0x0002 /* only one selection allowed */ +#define LIST_SELECT 0x0002 /* single selection only */ + +/* memFlag Codes */ +#define memDisabled 0x40 /* Sets member flag to disabled */ +#define memSelected 0x80 /* Sets member flag to selected */ +struct LColorTable { + Word listFrameClr; /* Frame color */ + Word listNorTextClr; /* Unhighlighted text color */ + Word listSelTextClr; /* Highlighted text color */ + Word listNorBackClr; /* Unhighlighted background color */ + Word listSelBackClr; /* Highlighted backgraound color */ + }; +typedef struct LColorTable LColorTable, *LColorTablePtr, **LColorTableHndl; + +struct MemRec { + Pointer memPtr; /* Pointer to string, or custom */ + Byte memFlag; /* Bit Flag */ + }; +typedef struct MemRec MemRec, *MemRecPtr, **MemRecHndl; + +/* The MemRec is followed by n bytes determined by value of listMemSize field */ +struct ListCtlRec { + CtlRecHndl ctlNext; /* Handle of Next Control */ + WindowPtr ctlOwner; /* Window owner */ + Rect ctlRect; /* Enclosing Rect */ + Byte ctlFlag; /* Bit 7 visible; Bit 0 string type; Bit 1 multiple */ + Byte ctlHilite; /* (not used) */ + Word ctlValue; /* First member in display */ + LongProcPtr ctlProc; /* Address of list definition procedure */ + LongProcPtr ctlAction; /* Address of list action procedure */ + LongWord ctlData; /* Low = view size; High = total members */ + LongWord ctlRefCon; /* Not used */ + Ptr ctlColor; /* Null for default colors */ + VoidProcPtr ctlMemDraw; /* Address of routine to draw members */ + Word ctlMemHeight; /* Member's Height in Pixels */ + Word ctlMemSize; /* Bytes in member record */ + MemRecPtr ctlList; /* Adress of first member record in array */ + CtlRecHndl ctlListBar; /* Handle of list contrlo's scroll bar control */ + }; +typedef struct ListCtlRec ListCtlRec, *ListCtlRecPtr, **ListCtlRecHndl; + +struct ListRec { + Rect listRect; /* Enclosing Rectangle */ + Word listSize; /* Number of List Members */ + Word listView; /* Max Viewable members */ + Word listType; /* Bit Flag */ + Word listStart; /* First member in view */ + CtlRecHndl listCtl; /* List control's handle */ + VoidProcPtr listDraw; /* Address of Custom drawing routine */ + Word listMemHeight; /* Height of list members */ + Word listMemSize; /* Size of Member Records */ + MemRecPtr listPointer; /* Pointer to first element in MemRec array */ + LongWord listRefCon; /* becomes Control's refCon */ + BarColorsPtr listScrollClr; /* Color table for list's scroll bar */ + }; +typedef struct ListRec ListRec, *ListRecPtr, **ListRecHndl; + +extern pascal void ListBootInit(void) inline(0x011C,dispatcher); +extern pascal void ListStartUp(void) inline(0x021C,dispatcher); +extern pascal void ListShutDown(void) inline(0x031C,dispatcher); +extern pascal Word ListVersion(void) inline(0x041C,dispatcher); +extern pascal void ListReset(void) inline(0x051C,dispatcher); +extern pascal Boolean ListStatus(void) inline(0x061C,dispatcher); +extern pascal ListCtlRecHndl CreateList(GrafPortPtr, ListRecPtr) inline(0x091C,dispatcher); +extern pascal void DrawMember(MemRecPtr, ListRecPtr) inline(0x0C1C,dispatcher); +extern pascal LongProcPtr GetListDefProc(void) inline(0x0E1C,dispatcher); +extern pascal void NewList(MemRecPtr, ListRecPtr) inline(0x101C,dispatcher); +extern pascal MemRecPtr NextMember(MemRecPtr, ListRecPtr) inline(0x0B1C,dispatcher); +extern pascal MemRecPtr ResetMember(ListRecPtr) inline(0x0F1C,dispatcher); +extern pascal void SelectMember(MemRecPtr, ListRecPtr) inline(0x0D1C,dispatcher); +extern pascal void SortList(VoidProcPtr, ListRecPtr) inline(0x0A1C,dispatcher); + +extern pascal void DrawMember2(Word, Handle) inline(0x111C,dispatcher); +extern pascal void NewList2(Pointer, Word, Ref, Word, Word, Handle) inline(0x161C,dispatcher); +extern pascal Word NextMember2(Word, Handle) inline(0x121C,dispatcher); +extern pascal Word ResetMember2(Handle) inline(0x131C,dispatcher); +extern pascal void SelectMember2(Word, Handle) inline(0x141C,dispatcher); +extern pascal void SortList2(Pointer, Handle) inline(0x151C,dispatcher); + +extern pascal Word CompareStrings(Word, Ptr, Ptr) inline(0x181C,dispatcher); +extern pascal void ListKey(Word, EventRecordPtr, CtlRecHndl) inline(0x171c, dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/loader.h b/bin/Libraries/ORCACDefs/loader.h index 381f3c9..a443dae 100644 --- a/bin/Libraries/ORCACDefs/loader.h +++ b/bin/Libraries/ORCACDefs/loader.h @@ -1 +1,87 @@ -/******************************************** * * Loader * * Copyright Apple Computer, Inc.1986-90 * All Rights Reserved * * Copyright 1992, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __LOADER__ #define __LOADER__ /* Error Codes */ #define idNotFound 0x1101 /* segment/application/entry not found */ #define idPathnameErr 0x1103 #define idNotLoadFile 0x1104 /* file is not a load file */ #define idBusyErr 0x1105 /* system loader is busy */ #define idFilVersErr 0x1107 /* file version error */ #define idUserIDErr 0x1108 /* user ID error */ #define idSequenceErr 0x1109 /* segnum out of sequence */ #define idBadRecordErr 0x110A /* illegal load record found */ #define idForeignSegErr 0x110B /* segment is foreign */ struct InitialLoadOutputRec { Word userID; Pointer startAddr; Word dPageAddr; Word buffSize; }; typedef struct InitialLoadOutputRec InitialLoadOutputRec, *InitialLoadOutputRecPtr; struct RestartOutRec { Word userID; Pointer startAddr; Word dPageAddr; Word buffSize; }; typedef struct RestartOutRec RestartOutRec, *RestartOutRecPtr; struct LoadSegNameOut { Pointer segAddr; Word userID; Word fileNum; Word segNum; }; typedef struct LoadSegNameOut LoadSegNameOut, *LoadSegNameOutPtr; struct UnloadSegOutRec { Word userID; Word fileNum; Word segNum; }; typedef struct UnloadSegOutRec UnloadSegOutRec, *UnloadSegOutRecPtr; extern pascal void GetLoadSegInfo(Word, Word, Word, Pointer) inline(0x0F11,dispatcher); extern pascal Word GetUserID(Pointer) inline(0x1011,dispatcher); extern pascal Word GetUserID2(Pointer) inline(0x2111,dispatcher); extern InitialLoadOutputRec InitialLoad(Word, Pointer, Word); extern InitialLoadOutputRec InitialLoad2(Word, Pointer, Word, Word); extern pascal Pointer LGetPathname(Word, Word) inline(0x1111,dispatcher); extern pascal Pointer LGetPathname2(Word, Word) inline(0x2211,dispatcher); extern pascal void LoaderInitialization(void) inline(0x0111,dispatcher); extern pascal void LoaderReset(void) inline(0x0511,dispatcher); extern pascal void LoaderShutDown(void) inline(0x0311,dispatcher); extern pascal void LoaderStartUp(void) inline(0x0211,dispatcher); extern pascal Boolean LoaderStatus(void) inline(0x0611,dispatcher); extern pascal Word LoaderVersion(void) inline(0x0411,dispatcher); extern LoadSegNameOut LoadSegName(Word, Pointer, Pointer); extern pascal Pointer LoadSegNum(Word, Word, Word) inline(0x0B11,dispatcher); extern pascal void RenamePathname(Pointer, Pointer) inline(0x1311,dispatcher); extern RestartOutRec Restart(Word); extern UnloadSegOutRec UnloadSeg(Longword); extern pascal void UnloadSegNum(Word, Word, Word) inline(0x0C11,dispatcher); extern pascal Word UserShutDown(Word, Word) inline(0x1211,dispatcher); /* Not documented. extern pascal Pointer GetPathname() inline(0x1111,dispatcher); extern pascal Pointer GetPathname2() inline(0x2211,dispatcher); */ #endif \ No newline at end of file +/******************************************** +* +* Loader +* +* Copyright Apple Computer, Inc.1986-90 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __LOADER__ +#define __LOADER__ + +/* Error Codes */ +#define idNotFound 0x1101 /* segment/application/entry not found */ +#define idPathnameErr 0x1103 +#define idNotLoadFile 0x1104 /* file is not a load file */ +#define idBusyErr 0x1105 /* system loader is busy */ +#define idFilVersErr 0x1107 /* file version error */ +#define idUserIDErr 0x1108 /* user ID error */ +#define idSequenceErr 0x1109 /* segnum out of sequence */ +#define idBadRecordErr 0x110A /* illegal load record found */ +#define idForeignSegErr 0x110B /* segment is foreign */ + +struct InitialLoadOutputRec { + Word userID; + Pointer startAddr; + Word dPageAddr; + Word buffSize; + }; +typedef struct InitialLoadOutputRec InitialLoadOutputRec, *InitialLoadOutputRecPtr; + +struct RestartOutRec { + Word userID; + Pointer startAddr; + Word dPageAddr; + Word buffSize; + }; +typedef struct RestartOutRec RestartOutRec, *RestartOutRecPtr; + +struct LoadSegNameOut { + Pointer segAddr; + Word userID; + Word fileNum; + Word segNum; + }; +typedef struct LoadSegNameOut LoadSegNameOut, *LoadSegNameOutPtr; + +struct UnloadSegOutRec { + Word userID; + Word fileNum; + Word segNum; + }; +typedef struct UnloadSegOutRec UnloadSegOutRec, *UnloadSegOutRecPtr; + +extern pascal void GetLoadSegInfo(Word, Word, Word, Pointer) inline(0x0F11,dispatcher); +extern pascal Word GetUserID(Pointer) inline(0x1011,dispatcher); +extern pascal Word GetUserID2(Pointer) inline(0x2111,dispatcher); +extern InitialLoadOutputRec InitialLoad(Word, Pointer, Word); +extern InitialLoadOutputRec InitialLoad2(Word, Pointer, Word, Word); +extern pascal Pointer LGetPathname(Word, Word) inline(0x1111,dispatcher); +extern pascal Pointer LGetPathname2(Word, Word) inline(0x2211,dispatcher); +extern pascal void LoaderInitialization(void) inline(0x0111,dispatcher); +extern pascal void LoaderReset(void) inline(0x0511,dispatcher); +extern pascal void LoaderShutDown(void) inline(0x0311,dispatcher); +extern pascal void LoaderStartUp(void) inline(0x0211,dispatcher); +extern pascal Boolean LoaderStatus(void) inline(0x0611,dispatcher); +extern pascal Word LoaderVersion(void) inline(0x0411,dispatcher); +extern LoadSegNameOut LoadSegName(Word, Pointer, Pointer); +extern pascal Pointer LoadSegNum(Word, Word, Word) inline(0x0B11,dispatcher); +extern pascal void RenamePathname(Pointer, Pointer) inline(0x1311,dispatcher); +extern RestartOutRec Restart(Word); +extern UnloadSegOutRec UnloadSeg(Longword); +extern pascal void UnloadSegNum(Word, Word, Word) inline(0x0C11,dispatcher); +extern pascal Word UserShutDown(Word, Word) inline(0x1211,dispatcher); + +/* Not documented. +extern pascal Pointer GetPathname() inline(0x1111,dispatcher); +extern pascal Pointer GetPathname2() inline(0x2211,dispatcher); +*/ + +#endif diff --git a/bin/Libraries/ORCACDefs/locator.h b/bin/Libraries/ORCACDefs/locator.h index 91306fb..0a8055f 100644 --- a/bin/Libraries/ORCACDefs/locator.h +++ b/bin/Libraries/ORCACDefs/locator.h @@ -1 +1,167 @@ -/******************************************** * * Tool Locator * * Copyright Apple Computer, Inc.1986-92 * All Rights Reserved * * Copyright 1992, 1993, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __LOCATOR__ #define __LOCATOR__ /* Error Codes */ #define toolNotFoundErr 0x0001 #define funcNotFoundErr 0x0002 #define sysStrtMtErr 0x0100 /* can't mount system startup volume */ #define tlBadRecFlag 0x0103 /* StartStop record invalid */ #define tlCantLoad 0x0104 /* A tool cannot be loaded */ #define toolVersionErr 0x0110 #define messNotFoundErr 0x0111 #define messageOvfl 0x0112 /* No message numbers available */ #define nameTooLong 0x0113 /* Message name too long */ #define reqNotAccepted 0x0120 /* SendRequest request not accepted */ #define duplicateName 0x0121 /* duplicate name for AcceptRequests */ #define invalidSendRequest 0x0122 /* bad combo of target and sendHow */ /* MessageCenter Codes */ #define fileInfoType 0x0001 /* Message type parameter */ #define addMessage 0x0001 /* action parameter */ #define getMessage 0x0002 /* action parameter */ #define deleteMessage 0x0003 /* action parameter */ #define fileInfoTypeGS 0x0011 /* Message type parameter (GS/OS strings) */ /* GetMsgHandle flags values */ #define gmhByIndex 0 #define gmhByType 1 #define gmhByName 2 /* SendRequest/AcceptRequests codes */ #define systemSaysBeep 0x0001 /* used by SysBeep2 */ #define systemSaysUnknownDisk 0x0002 /* used by HandleDiskInsert */ #define srqGoAway 0x0003 #define srqGetrSoundSample 0x0004 #define srqSynchronize 0x0005 #define srqPlayrSoundSample 0x0006 #define systemSaysNewDeskMsg 0x0008 #define systemSaysEjectingDev 0x000E #define systemSaysDeskStartUp 0x0502 #define systemSaysDeskShutDown 0x0503 #define systemSaysFixedAppleMenu 0x051E #define systemSaysMenuKey 0x0F01 #define systemSaysDoClipboard 0x000C #define systemSaysForceUndim 0x000D #define srqOpenOrPrint 0x0010 #define srqQuit 0x0011 #define systemSaysGetSysIcon 0x1201 /* SendRequest sendHow values */ #define stopAfterOne 0x8000 #define sendToAll 0 #define sendToName 1 #define sendToUserID 2 /* StartUpTools flag bits */ #define leaveScreenClean 0x0004 #define openResAsAllowed 0x0008 #define noResourceMgr 0x0010 /* for ShutDownTools, too */ /* TLMountVolume Codes */ #define mvReturn 0x0001 /* like ok for dialogs */ #define mvEscape 0x0002 /* like cancel for dialogs */ /* Tool Set Spec Codes */ #define sysTool 0x0000 #define userTool 0x8000 #ifndef theToolsLength /* ToolTable - default number of ToolSpecs */ #define theToolsLength 0x0010 #endif struct MessageRec { struct MessageRec **messageNext; Word messageType; Word messageData; Str255 fileNames[1]; }; typedef struct MessageRec MessageRec, *MessageRecPtr, **MessageRecHndl; typedef struct wString { Word length; /* Number of Chars in text field */ char text[255]; } wString, *wStringPtr, **wStringHndl; typedef wStringHndl *wStringHndlPtr; typedef struct MessageRecGS { long reserved; /* reserved */ Word messageType; Word printFlag; wString fileNames[1]; } MessageRecGS, *MessageRecGSPtr, **MessageRecGSHndl; struct ToolSpec { Word toolNumber; Word minVersion; }; typedef struct ToolSpec ToolSpec; struct ToolTable { Word toolCount; ToolSpec theTools[theToolsLength]; }; typedef struct ToolTable ToolTable, *ToolTablePtr; struct StartStopRecord { Word flags; Word videoMode; Word resFileID; Handle dPageHandle; Word numTools; ToolSpec theTools[theToolsLength]; }; typedef struct StartStopRecord StartStopRecord, *StartStopRecordPtr; typedef Long ResponseRecord; struct srqGoAwayOut { Word recvCount; Word resultID; /* returned UserID */ Word resultFlags; /* returned flags--bit 15=Restartable, 14-0=reserved */ }; typedef struct srqGoAwayOut srqGoAwayOut, *srqGoAwayOutPtr; extern pascal void TLBootInit(void) inline(0x0101,dispatcher); extern pascal void TLStartUp(void) inline(0x0201,dispatcher); extern pascal void TLShutDown(void) inline(0x0301,dispatcher); extern pascal Word TLVersion(void) inline(0x0401,dispatcher); extern pascal void TLReset(void) inline(0x0501,dispatcher); extern pascal Boolean TLStatus(void) inline(0x0601,dispatcher); extern pascal Pointer GetFuncPtr(Word, Word) inline(0x0B01,dispatcher); extern pascal Pointer GetTSPtr(Word, Word) inline(0x0901,dispatcher); extern pascal Pointer GetWAP(Word, Word) inline(0x0C01,dispatcher); extern pascal void LoadOneTool(Word, Word) inline(0x0F01,dispatcher); extern pascal void LoadTools(Pointer) inline(0x0E01,dispatcher); extern pascal void MessageCenter(Word, Word, Handle) inline(0x1501,dispatcher); extern pascal void RestoreTextState(Handle) inline(0x1401,dispatcher); extern pascal Handle SaveTextState(void) inline(0x1301,dispatcher); extern pascal void SetTSPtr(Word, Word, Pointer) inline(0x0A01,dispatcher); extern pascal void SetWAP(Word, Word, Pointer) inline(0x0D01,dispatcher); extern pascal Word TLMountVolume(Integer, Integer, Pointer, Pointer, Pointer, Pointer) inline(0x1101,dispatcher); extern pascal Word TLTextMountVolume(Pointer, Pointer, Pointer, Pointer) inline(0x1201,dispatcher); extern pascal void UnloadOneTool(Word) inline(0x1001,dispatcher); extern pascal ResponseRecord MessageByName(Boolean, Pointer) inline(0x1701,dispatcher); extern pascal void SetDefaultTPT(void) inline(0x1601,dispatcher); extern pascal void ShutDownTools(Word, Ref) inline(0x1901,dispatcher); extern pascal Ref StartUpTools(Word, Word, Ref) inline(0x1801,dispatcher); extern pascal void AcceptRequests(Pointer, Word, WordProcPtr) inline(0x1B01,dispatcher); extern pascal Handle GetMsgHandle(Word, Long) inline(0x1A01,dispatcher); extern pascal void SendRequest(Word, Word, Long, Long, Ptr) inline(0x1C01,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Tool Locator +* +* Copyright Apple Computer, Inc.1986-92 +* All Rights Reserved +* +* Copyright 1992, 1993, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __LOCATOR__ +#define __LOCATOR__ + +/* Error Codes */ +#define toolNotFoundErr 0x0001 +#define funcNotFoundErr 0x0002 +#define sysStrtMtErr 0x0100 /* can't mount system startup volume */ +#define tlBadRecFlag 0x0103 /* StartStop record invalid */ +#define tlCantLoad 0x0104 /* A tool cannot be loaded */ +#define toolVersionErr 0x0110 +#define messNotFoundErr 0x0111 +#define messageOvfl 0x0112 /* No message numbers available */ +#define nameTooLong 0x0113 /* Message name too long */ +#define reqNotAccepted 0x0120 /* SendRequest request not accepted */ +#define duplicateName 0x0121 /* duplicate name for AcceptRequests */ +#define invalidSendRequest 0x0122 /* bad combo of target and sendHow */ + +/* MessageCenter Codes */ +#define fileInfoType 0x0001 /* Message type parameter */ +#define addMessage 0x0001 /* action parameter */ +#define getMessage 0x0002 /* action parameter */ +#define deleteMessage 0x0003 /* action parameter */ +#define fileInfoTypeGS 0x0011 /* Message type parameter (GS/OS strings) */ + +/* GetMsgHandle flags values */ +#define gmhByIndex 0 +#define gmhByType 1 +#define gmhByName 2 + +/* SendRequest/AcceptRequests codes */ +#define systemSaysBeep 0x0001 /* used by SysBeep2 */ +#define systemSaysUnknownDisk 0x0002 /* used by HandleDiskInsert */ +#define srqGoAway 0x0003 +#define srqGetrSoundSample 0x0004 +#define srqSynchronize 0x0005 +#define srqPlayrSoundSample 0x0006 +#define systemSaysNewDeskMsg 0x0008 +#define systemSaysEjectingDev 0x000E +#define systemSaysDeskStartUp 0x0502 +#define systemSaysDeskShutDown 0x0503 +#define systemSaysFixedAppleMenu 0x051E +#define systemSaysMenuKey 0x0F01 +#define systemSaysDoClipboard 0x000C +#define systemSaysForceUndim 0x000D +#define srqOpenOrPrint 0x0010 +#define srqQuit 0x0011 +#define systemSaysGetSysIcon 0x1201 + +/* SendRequest sendHow values */ +#define stopAfterOne 0x8000 +#define sendToAll 0 +#define sendToName 1 +#define sendToUserID 2 + +/* StartUpTools flag bits */ +#define leaveScreenClean 0x0004 +#define openResAsAllowed 0x0008 +#define noResourceMgr 0x0010 /* for ShutDownTools, too */ + +/* TLMountVolume Codes */ +#define mvReturn 0x0001 /* like ok for dialogs */ +#define mvEscape 0x0002 /* like cancel for dialogs */ + +/* Tool Set Spec Codes */ +#define sysTool 0x0000 +#define userTool 0x8000 +#ifndef theToolsLength /* ToolTable - default number of ToolSpecs */ +#define theToolsLength 0x0010 +#endif + +struct MessageRec { + struct MessageRec **messageNext; + Word messageType; + Word messageData; + Str255 fileNames[1]; + }; +typedef struct MessageRec MessageRec, *MessageRecPtr, **MessageRecHndl; + +typedef struct wString { + Word length; /* Number of Chars in text field */ + char text[255]; + } wString, *wStringPtr, **wStringHndl; +typedef wStringHndl *wStringHndlPtr; + +typedef struct MessageRecGS { + long reserved; /* reserved */ + Word messageType; + Word printFlag; + wString fileNames[1]; + } MessageRecGS, *MessageRecGSPtr, **MessageRecGSHndl; + +struct ToolSpec { + Word toolNumber; + Word minVersion; + }; +typedef struct ToolSpec ToolSpec; + +struct ToolTable { + Word toolCount; + ToolSpec theTools[theToolsLength]; + }; +typedef struct ToolTable ToolTable, *ToolTablePtr; + +struct StartStopRecord { + Word flags; + Word videoMode; + Word resFileID; + Handle dPageHandle; + Word numTools; + ToolSpec theTools[theToolsLength]; + }; +typedef struct StartStopRecord StartStopRecord, *StartStopRecordPtr; + +typedef Long ResponseRecord; + +struct srqGoAwayOut { + Word recvCount; + Word resultID; /* returned UserID */ + Word resultFlags; /* returned flags--bit 15=Restartable, 14-0=reserved */ + }; +typedef struct srqGoAwayOut srqGoAwayOut, *srqGoAwayOutPtr; + +extern pascal void TLBootInit(void) inline(0x0101,dispatcher); +extern pascal void TLStartUp(void) inline(0x0201,dispatcher); +extern pascal void TLShutDown(void) inline(0x0301,dispatcher); +extern pascal Word TLVersion(void) inline(0x0401,dispatcher); +extern pascal void TLReset(void) inline(0x0501,dispatcher); +extern pascal Boolean TLStatus(void) inline(0x0601,dispatcher); +extern pascal Pointer GetFuncPtr(Word, Word) inline(0x0B01,dispatcher); +extern pascal Pointer GetTSPtr(Word, Word) inline(0x0901,dispatcher); +extern pascal Pointer GetWAP(Word, Word) inline(0x0C01,dispatcher); +extern pascal void LoadOneTool(Word, Word) inline(0x0F01,dispatcher); +extern pascal void LoadTools(Pointer) inline(0x0E01,dispatcher); +extern pascal void MessageCenter(Word, Word, Handle) inline(0x1501,dispatcher); +extern pascal void RestoreTextState(Handle) inline(0x1401,dispatcher); +extern pascal Handle SaveTextState(void) inline(0x1301,dispatcher); +extern pascal void SetTSPtr(Word, Word, Pointer) inline(0x0A01,dispatcher); +extern pascal void SetWAP(Word, Word, Pointer) inline(0x0D01,dispatcher); +extern pascal Word TLMountVolume(Integer, Integer, Pointer, Pointer, Pointer, Pointer) inline(0x1101,dispatcher); +extern pascal Word TLTextMountVolume(Pointer, Pointer, Pointer, Pointer) inline(0x1201,dispatcher); +extern pascal void UnloadOneTool(Word) inline(0x1001,dispatcher); + +extern pascal ResponseRecord MessageByName(Boolean, Pointer) inline(0x1701,dispatcher); +extern pascal void SetDefaultTPT(void) inline(0x1601,dispatcher); +extern pascal void ShutDownTools(Word, Ref) inline(0x1901,dispatcher); +extern pascal Ref StartUpTools(Word, Word, Ref) inline(0x1801,dispatcher); + +extern pascal void AcceptRequests(Pointer, Word, WordProcPtr) inline(0x1B01,dispatcher); +extern pascal Handle GetMsgHandle(Word, Long) inline(0x1A01,dispatcher); +extern pascal void SendRequest(Word, Word, Long, Long, Ptr) inline(0x1C01,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/math.h b/bin/Libraries/ORCACDefs/math.h index 8764af8..d6351f2 100644 --- a/bin/Libraries/ORCACDefs/math.h +++ b/bin/Libraries/ORCACDefs/math.h @@ -1 +1,45 @@ -/**************************************************************** * * math.h - math library * * February 1989 * Mike Westerfield * * Copyright 1989, 1992 * Byte Works, Inc. * ****************************************************************/ #ifndef __math__ #define __math__ #define HUGE_VAL 1e5000 #ifndef __KeepNamespacePure__ #define arctan(x) atan(x) #endif double acos(double); double asin(double); double atan(double); double cos(double); double cosh(double); double exp(double); double log(double); double log10(double); double sin(double); double sinh(double); double sqrt(double); double tan(double); double tanh(double); double atan2(double, double); double ceil(double); double fabs(double); double floor(double); double fmod(double, double); double frexp(double, int *); double ldexp(double, int); double modf(double, double *); double pow(double, double); #endif \ No newline at end of file +/**************************************************************** +* +* math.h - math library +* +* February 1989 +* Mike Westerfield +* +* Copyright 1989, 1992 +* Byte Works, Inc. +* +****************************************************************/ + +#ifndef __math__ +#define __math__ + +#define HUGE_VAL 1e5000 + +#ifndef __KeepNamespacePure__ + #define arctan(x) atan(x) +#endif + +double acos(double); +double asin(double); +double atan(double); +double cos(double); +double cosh(double); +double exp(double); +double log(double); +double log10(double); +double sin(double); +double sinh(double); +double sqrt(double); +double tan(double); +double tanh(double); +double atan2(double, double); +double ceil(double); +double fabs(double); +double floor(double); +double fmod(double, double); +double frexp(double, int *); +double ldexp(double, int); +double modf(double, double *); +double pow(double, double); + +#endif diff --git a/bin/Libraries/ORCACDefs/mediacontrol.h b/bin/Libraries/ORCACDefs/mediacontrol.h index 6c1da2d..7b455e9 100644 --- a/bin/Libraries/ORCACDefs/mediacontrol.h +++ b/bin/Libraries/ORCACDefs/mediacontrol.h @@ -1 +1,214 @@ -/******************************************** * * Media Control Tool Set * * Copyright Apple Computer, Inc.1986-90 * All Rights Reserved * * Copyright 1992, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __MEDIACONTROL__ #define __MEDIACONTROL__ /* Position unit types for MCGetPosition and other calls: */ #define mcInChapters 1 /* Position is measured in chapters */ #define mcInFrames 2 /* Position is measured in frames */ #define mcInTimes 3 /* Position is measured in hours,minutes,seconds,blocks */ /* Control values for MCControl: */ #define mcCInit 0x0001 /* Initialize player */ #define mcCEject 0x0002 /* Eject disc */ #define mcCVideoOn 0x0003 /* Turn video on */ #define mcCVideoOff 0x0004 /* Turn video off */ #define mcCDisplayOn 0x0005 /* Turn video position display on */ #define mcCDisplayOff 0x0006 /* Turn video position display off */ #define mcCBlankVideo 0x0007 /* Blank video for next MCSearchTo */ #define mcCDefaultCom 0x0008 /* Set default communications */ #define mcCLockDev 0x0009 /* Set the device to locked */ #define mcCUnLockDev 0x000A /* Unlock the device */ #define mcC8Data1Stop 0x0028 /* Set 8 - data 1 - stop bit */ #define mcC7Data1Stop 0x0029 /* Set 7 - data 1 - stop bit */ #define mcC6Data1Stop 0x002A /* Set 6 - data 1 - stop bit */ #define mcC5Data1Stop 0x002B /* Set 5 - data 1 - stop bit */ #define mcC8Data2Stop 0x002C /* Set 8 - data 2 - stop bit */ #define mcC7Data2Stop 0x002D /* Set 7 - data 2 - stop bit */ #define mcC6Data2Stop 0x002E /* Set 6 - data 2 - stop bit */ #define mcC5Data2Stop 0x002F /* Set 5 - data 2 - stop bit */ #define mcCBaudDflt 0x0032 /* Set baud rate to control panel setting */ #define mcCBaud50 0x0033 /* Set 50 baud */ #define mcCBaud75 0x0034 /* Set 75 baud */ #define mcCBaud110 0x0035 /* Set 110 baud */ #define mcCBaud134 0x0036 /* Set 134 baud */ #define mcCBaud150 0x0037 /* Set 150 baud */ #define mcCBaud300 0x0038 /* Set 300 baud */ #define mcCBaud600 0x0039 /* Set 600 baud */ #define mcCBaud1200 0x003A /* Set 1200 baud */ #define mcCBaud1800 0x003B /* Set 1800 baud */ #define mcCBaud2400 0x003C /* Set 2400 baud */ #define mcCBaud3600 0x003D /* Set 3600 baud */ #define mcCBaud4800 0x003E /* Set 4800 baud */ #define mcCBaud7200 0x003F /* Set 7200 baud */ #define mcCBaud9600 0x0040 /* Set 9600 baud */ #define mcCBaud19200 0x0041 /* Set 19200 baud */ #define mcCModem 0x0064 /* Set to modem port */ #define mcCPrinter 0x0065 /* Set to printer port */ #define mcCIgnoreDS 0x00C8 /* Ignore "disk switched" GSOS errors */ #define mcCReportDS 0x00C9 /* Report "disk switched" GSOS errors */ /* Values for MCGetFeatures: */ #define mcFTypes 0 /* How the disc is organized (frames, chapters, etc.) */ #define mcFStep 1 /* Maximum fps speed value (normal is 255) */ #define mcFRecord 2 /* Device supports MCRecord */ #define mcFVideo 3 /* Device supports toggling video */ #define mcFEject 4 /* Device supports ejecting medium */ #define mcFLock 5 /* Device supports user lock (locking user from physically operating the device) */ #define mcFVDisplay 6 /* Device supports video display of location */ #define mcFVOverlay 7 /* No. of lines of overlay characters device supports */ #define mcFVOChars 8 /* No. of chars/line supported by overlay */ #define mcFVolume 9 /* Does volume control? */ /* Status values for MCGetStatus: */ #define mcSUnknown 0x0000 /* Player unable to determine this status */ #define mcSDeviceType 0x0000 /* "Device type" selector */ #define mcSLaserDisc 0x0001 /* Video laser disc player */ #define mcSCDAudio 0x0002 /* Audio CD player */ #define mcSCDLaserCD 0x0003 /* Combination laser/CD player */ #define mcSVCR 0x0004 /* VCR */ #define mcSCamCorder 0x0005 /* Video camera */ #define mcSPlayStatus 0x0001 /* "Play status" selector */ #define mcSPlaying 0x0001 /* The device is playing */ #define mcSStill 0x0002 /* The device is not playing (paused) */ #define mcSParked 0x0003 /* The device is shut down */ #define mcSDoorStatus 0x0002 /* "Player door" status */ #define mcSDoorOpen 0x0001 #define mcSDoorClosed 0x0002 #define mcSDiscType 0x0003 /* "Disc type" selector */ #define mcS_CLV 0x0001 #define mcS_CAV 0x0002 #define mcS_CDV 0x0003 #define mcS_CD 0x0004 #define mcSDiscSize 0x0004 /* "Disc size" selector */ #define mcSDisc3inch 0x0003 #define mcSDisc5inch 0x0005 #define mcSDisc8inch 0x0008 #define mcSDisc12inch 0x000C #define mcSDiscSide 0x0005 /* "Disc side" selector */ #define mcSSideOne 0x0001 #define mcSSideTwo 0x0002 #define mcSVolumeL 0x0006 /* Current left volume selector */ #define mcSVolumeR 0x0007 /* Current right volume selector */ /* Time parameter values for MCGetTimes: */ #define mcElapsedTrack 0x0000 /* Elapsed time on current track/chapter */ #define mcRemainTrack 0x0001 /* Remaining time on current track/chapter */ #define mcElapsedDisc 0x0002 /* Elapsed time on disc */ #define mcRemainDisc 0x0003 /* Remaining time on disc */ #define mcTotalDisc 0x0004 /* Total run time on disc */ #define mcTotalFrames 0x0005 /* Total number of frames on disc */ #define mcTracks 0x0006 /* Binary start and ending track numbers (bits 31-16 = ending, bits 15-0 = starting track number.) */ #define mcDiscID 0x0007 /* returns a disc identifier */ /* Audio values: */ #define mcAudioOff 0x0000 /* Audio off */ #define mcAudioRight 0x0001 /* Audio thru right channel only */ #define mcAudioLinR 0x0002 /* Audio left in right only */ #define mcAudioMinR 0x0003 /* Audio mixed in right only */ #define mcAudioRinL 0x0004 /* Audio right in left only */ #define mcAudioRinLR 0x0005 /* Audio right in left and right */ #define mcAudioReverse 0x0006 /* Audio right in left, left in right */ #define mcAudioRinLMR 0x0007 /* Audio right in left, mixed in right */ #define mcAudioLeft 0x0008 /* Audio left channel only */ #define mcAudioStereo 0x0009 /* Audio both channels (in stereo) */ #define mcAudioLinLR 0x000A /* Audio left in left and right */ #define mcAudioLinLMR 0x000B /* Audio left in left, mixed in right */ #define mcAudioMinL 0x000C /* Audio mixed in left only */ #define mcAudioMinLRinR 0x000D /* Audio mixed in left, right in right */ #define mcAudioMinLLinR 0x000E /* Audio mixed in left, left in right */ #define mcAudioMonaural 0x000F /* Audio mixed in left and right (monaural) */ /* Error codes: */ #define mcUnImp 0x2601 /* Unimplemented for this device */ #define mcNotApplic 0x2601 /* */ #define mcBadSpeed 0x2602 /* Invalid speed specified */ #define mcBadUnitType 0x2603 /* Invalid unit type specified */ #define mcTimeOutErr 0x2604 /* Timed out during device read */ #define mcNotLoaded 0x2605 /* No driver is currently loaded */ #define mcBadAudio 0x2606 /* Invalid audio value */ #define mcDevRtnError 0x2607 /* Device returned error (unable to perform) */ #define mcUnRecStatus 0x2608 /* Unrecognizable status from device */ #define mcBadSelector 0x2609 /* Invalid selector value specified */ #define mcFunnyData 0x260A /* Funny data received (try again) */ #define mcInvalidPort 0x260B /* Invalid port specified */ #define mcOnlyOnce 0x260C /* Scans only once */ #define mcNoResMgr 0x260D /* Resource manager not active */ #define mcItemNotThere 0x260E /* Item not found in database */ #define mcWasShutDown 0x260F /* Media Control Toolset was already shut down */ #define mcWasStarted 0x2610 /* Media Control Toolset was already started */ #define mcBadChannel 0x2611 /* Invalid channel number */ #define mcInvalidParam 0x2612 /* Invalid parameter */ #define mcCallNotSupported 0x2613 /* Call is not supported */ extern pascal void MCBootInit(void) inline(0x0126,dispatcher); extern pascal void MCStartUp(Word) inline(0x0226,dispatcher); extern pascal void MCShutDown(void) inline(0x0326,dispatcher); extern pascal Word MCVersion(void) inline(0x0426,dispatcher); extern pascal void MCReset(void) inline(0x0526,dispatcher); extern pascal Boolean MCStatus(void) inline(0x0626,dispatcher); extern pascal Long MCBinToTime(Long) inline(0x0D26,dispatcher); extern pascal void MCControl(Word, Word) inline(0x1B26,dispatcher); extern pascal void MCDShutDown(Word) inline(0x1526,dispatcher); extern pascal void MCDStartUp(Word, Ptr, Word) inline(0x1426,dispatcher); extern pascal Long MCGetDiscID(Word) inline(0x2826,dispatcher); extern pascal void MCGetDiscTitle(Long, Ptr) inline(0x1226,dispatcher); extern pascal Long MCGetDiscTOC(Word, Word) inline(0x2726,dispatcher); extern pascal void MCGetErrorMsg(Word, Ptr) inline(0x0926,dispatcher); extern pascal Long MCGetFeatures(Word, Word) inline(0x1626,dispatcher); extern pascal void MCGetName(Word, Ptr) inline(0x2D26,dispatcher); extern pascal Word MCGetNoTracks(Word) inline(0x2926,dispatcher); extern pascal Long MCGetPosition(Word, Word) inline(0x2426,dispatcher); extern pascal void MCGetProgram(Long, Ptr) inline(0x1026,dispatcher); extern pascal void MCGetSpeeds(Word, Ptr) inline(0x1D26,dispatcher); extern pascal Word MCGetStatus(Word, Word) inline(0x1A26,dispatcher); extern pascal Long MCGetTimes(Word, Word) inline(0x2626,dispatcher); extern pascal void MCGetTrackTitle(Long, Word, Ptr) inline(0x0E26,dispatcher); extern pascal void MCJog(Word, Long, Word) inline(0x2026,dispatcher); extern pascal void MCLoadDriver(Word) inline(0x0A26,dispatcher); extern pascal void MCPause(Word) inline(0x1826,dispatcher); extern pascal void MCPlay(Word) inline(0x1726,dispatcher); extern pascal void MCRecord(Word) inline(0x2A26,dispatcher); extern pascal void MCScan(Word, Word) inline(0x1C26,dispatcher); extern pascal Boolean MCSearchDone(Word) inline(0x2226,dispatcher); extern pascal void MCSearchTo(Word, Word, Long) inline(0x2126,dispatcher); extern pascal void MCSearchWait(Word) inline(0x2326,dispatcher); extern pascal void MCSendRawData(Word, Long) inline(0x1926,dispatcher); extern pascal void MCSetAudio(Word, Word) inline(0x2526,dispatcher); extern pascal void MCSetDiscTitle(Long, Long) inline(0x1326,dispatcher); extern pascal void MCSetProgram(Long, Long) inline(0x1126,dispatcher); extern pascal void MCSetTrackTitle(Long, Word, Ptr) inline(0x0F26,dispatcher); extern pascal void MCSetVolume(Word, Word, Word) inline(0x2E26,dispatcher); extern pascal void MCSpeed(Word, Word) inline(0x1E26,dispatcher); extern pascal void MCStop(Word) inline(0x2B26,dispatcher); extern pascal void MCStopAt(Word, Word, Long) inline(0x1F26,dispatcher); extern pascal Long MCTimeToBin(Long) inline(0x0C26,dispatcher); extern pascal void MCUnLoadDriver(Word) inline(0x0B26,dispatcher); extern pascal void MCWaitRawData(Word, Ptr, Word, Word) inline(0x2C26,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Media Control Tool Set +* +* Copyright Apple Computer, Inc.1986-90 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __MEDIACONTROL__ +#define __MEDIACONTROL__ + +/* Position unit types for MCGetPosition and other calls: */ +#define mcInChapters 1 /* Position is measured in chapters */ +#define mcInFrames 2 /* Position is measured in frames */ +#define mcInTimes 3 /* Position is measured in hours,minutes,seconds,blocks */ + +/* Control values for MCControl: */ +#define mcCInit 0x0001 /* Initialize player */ +#define mcCEject 0x0002 /* Eject disc */ +#define mcCVideoOn 0x0003 /* Turn video on */ +#define mcCVideoOff 0x0004 /* Turn video off */ +#define mcCDisplayOn 0x0005 /* Turn video position display on */ +#define mcCDisplayOff 0x0006 /* Turn video position display off */ +#define mcCBlankVideo 0x0007 /* Blank video for next MCSearchTo */ +#define mcCDefaultCom 0x0008 /* Set default communications */ +#define mcCLockDev 0x0009 /* Set the device to locked */ +#define mcCUnLockDev 0x000A /* Unlock the device */ + +#define mcC8Data1Stop 0x0028 /* Set 8 - data 1 - stop bit */ +#define mcC7Data1Stop 0x0029 /* Set 7 - data 1 - stop bit */ +#define mcC6Data1Stop 0x002A /* Set 6 - data 1 - stop bit */ +#define mcC5Data1Stop 0x002B /* Set 5 - data 1 - stop bit */ +#define mcC8Data2Stop 0x002C /* Set 8 - data 2 - stop bit */ +#define mcC7Data2Stop 0x002D /* Set 7 - data 2 - stop bit */ +#define mcC6Data2Stop 0x002E /* Set 6 - data 2 - stop bit */ +#define mcC5Data2Stop 0x002F /* Set 5 - data 2 - stop bit */ + +#define mcCBaudDflt 0x0032 /* Set baud rate to control panel setting */ +#define mcCBaud50 0x0033 /* Set 50 baud */ +#define mcCBaud75 0x0034 /* Set 75 baud */ +#define mcCBaud110 0x0035 /* Set 110 baud */ +#define mcCBaud134 0x0036 /* Set 134 baud */ +#define mcCBaud150 0x0037 /* Set 150 baud */ +#define mcCBaud300 0x0038 /* Set 300 baud */ +#define mcCBaud600 0x0039 /* Set 600 baud */ +#define mcCBaud1200 0x003A /* Set 1200 baud */ +#define mcCBaud1800 0x003B /* Set 1800 baud */ +#define mcCBaud2400 0x003C /* Set 2400 baud */ +#define mcCBaud3600 0x003D /* Set 3600 baud */ +#define mcCBaud4800 0x003E /* Set 4800 baud */ +#define mcCBaud7200 0x003F /* Set 7200 baud */ +#define mcCBaud9600 0x0040 /* Set 9600 baud */ +#define mcCBaud19200 0x0041 /* Set 19200 baud */ + +#define mcCModem 0x0064 /* Set to modem port */ +#define mcCPrinter 0x0065 /* Set to printer port */ + +#define mcCIgnoreDS 0x00C8 /* Ignore "disk switched" GSOS errors */ +#define mcCReportDS 0x00C9 /* Report "disk switched" GSOS errors */ + +/* Values for MCGetFeatures: */ +#define mcFTypes 0 /* How the disc is organized (frames, chapters, etc.) */ +#define mcFStep 1 /* Maximum fps speed value (normal is 255) */ +#define mcFRecord 2 /* Device supports MCRecord */ +#define mcFVideo 3 /* Device supports toggling video */ +#define mcFEject 4 /* Device supports ejecting medium */ +#define mcFLock 5 /* Device supports user lock (locking user from physically operating the device) */ +#define mcFVDisplay 6 /* Device supports video display of location */ +#define mcFVOverlay 7 /* No. of lines of overlay characters device supports */ +#define mcFVOChars 8 /* No. of chars/line supported by overlay */ +#define mcFVolume 9 /* Does volume control? */ + + +/* Status values for MCGetStatus: */ +#define mcSUnknown 0x0000 /* Player unable to determine this status */ + +#define mcSDeviceType 0x0000 /* "Device type" selector */ +#define mcSLaserDisc 0x0001 /* Video laser disc player */ +#define mcSCDAudio 0x0002 /* Audio CD player */ +#define mcSCDLaserCD 0x0003 /* Combination laser/CD player */ +#define mcSVCR 0x0004 /* VCR */ +#define mcSCamCorder 0x0005 /* Video camera */ + +#define mcSPlayStatus 0x0001 /* "Play status" selector */ +#define mcSPlaying 0x0001 /* The device is playing */ +#define mcSStill 0x0002 /* The device is not playing (paused) */ +#define mcSParked 0x0003 /* The device is shut down */ + +#define mcSDoorStatus 0x0002 /* "Player door" status */ +#define mcSDoorOpen 0x0001 +#define mcSDoorClosed 0x0002 + +#define mcSDiscType 0x0003 /* "Disc type" selector */ +#define mcS_CLV 0x0001 +#define mcS_CAV 0x0002 +#define mcS_CDV 0x0003 +#define mcS_CD 0x0004 + +#define mcSDiscSize 0x0004 /* "Disc size" selector */ +#define mcSDisc3inch 0x0003 +#define mcSDisc5inch 0x0005 +#define mcSDisc8inch 0x0008 +#define mcSDisc12inch 0x000C + +#define mcSDiscSide 0x0005 /* "Disc side" selector */ +#define mcSSideOne 0x0001 +#define mcSSideTwo 0x0002 + +#define mcSVolumeL 0x0006 /* Current left volume selector */ +#define mcSVolumeR 0x0007 /* Current right volume selector */ + +/* Time parameter values for MCGetTimes: */ +#define mcElapsedTrack 0x0000 /* Elapsed time on current track/chapter */ +#define mcRemainTrack 0x0001 /* Remaining time on current track/chapter */ +#define mcElapsedDisc 0x0002 /* Elapsed time on disc */ +#define mcRemainDisc 0x0003 /* Remaining time on disc */ +#define mcTotalDisc 0x0004 /* Total run time on disc */ +#define mcTotalFrames 0x0005 /* Total number of frames on disc */ +#define mcTracks 0x0006 /* Binary start and ending track numbers (bits 31-16 = ending, bits 15-0 = starting track number.) */ +#define mcDiscID 0x0007 /* returns a disc identifier */ + +/* Audio values: */ +#define mcAudioOff 0x0000 /* Audio off */ +#define mcAudioRight 0x0001 /* Audio thru right channel only */ +#define mcAudioLinR 0x0002 /* Audio left in right only */ +#define mcAudioMinR 0x0003 /* Audio mixed in right only */ +#define mcAudioRinL 0x0004 /* Audio right in left only */ +#define mcAudioRinLR 0x0005 /* Audio right in left and right */ +#define mcAudioReverse 0x0006 /* Audio right in left, left in right */ +#define mcAudioRinLMR 0x0007 /* Audio right in left, mixed in right */ +#define mcAudioLeft 0x0008 /* Audio left channel only */ +#define mcAudioStereo 0x0009 /* Audio both channels (in stereo) */ +#define mcAudioLinLR 0x000A /* Audio left in left and right */ +#define mcAudioLinLMR 0x000B /* Audio left in left, mixed in right */ +#define mcAudioMinL 0x000C /* Audio mixed in left only */ +#define mcAudioMinLRinR 0x000D /* Audio mixed in left, right in right */ +#define mcAudioMinLLinR 0x000E /* Audio mixed in left, left in right */ +#define mcAudioMonaural 0x000F /* Audio mixed in left and right (monaural) */ + +/* Error codes: */ +#define mcUnImp 0x2601 /* Unimplemented for this device */ +#define mcNotApplic 0x2601 /* */ +#define mcBadSpeed 0x2602 /* Invalid speed specified */ +#define mcBadUnitType 0x2603 /* Invalid unit type specified */ +#define mcTimeOutErr 0x2604 /* Timed out during device read */ +#define mcNotLoaded 0x2605 /* No driver is currently loaded */ +#define mcBadAudio 0x2606 /* Invalid audio value */ +#define mcDevRtnError 0x2607 /* Device returned error (unable to perform) */ +#define mcUnRecStatus 0x2608 /* Unrecognizable status from device */ +#define mcBadSelector 0x2609 /* Invalid selector value specified */ +#define mcFunnyData 0x260A /* Funny data received (try again) */ +#define mcInvalidPort 0x260B /* Invalid port specified */ +#define mcOnlyOnce 0x260C /* Scans only once */ +#define mcNoResMgr 0x260D /* Resource manager not active */ +#define mcItemNotThere 0x260E /* Item not found in database */ +#define mcWasShutDown 0x260F /* Media Control Toolset was already shut down */ +#define mcWasStarted 0x2610 /* Media Control Toolset was already started */ +#define mcBadChannel 0x2611 /* Invalid channel number */ +#define mcInvalidParam 0x2612 /* Invalid parameter */ +#define mcCallNotSupported 0x2613 /* Call is not supported */ + +extern pascal void MCBootInit(void) inline(0x0126,dispatcher); +extern pascal void MCStartUp(Word) inline(0x0226,dispatcher); +extern pascal void MCShutDown(void) inline(0x0326,dispatcher); +extern pascal Word MCVersion(void) inline(0x0426,dispatcher); +extern pascal void MCReset(void) inline(0x0526,dispatcher); +extern pascal Boolean MCStatus(void) inline(0x0626,dispatcher); +extern pascal Long MCBinToTime(Long) inline(0x0D26,dispatcher); +extern pascal void MCControl(Word, Word) inline(0x1B26,dispatcher); +extern pascal void MCDShutDown(Word) inline(0x1526,dispatcher); +extern pascal void MCDStartUp(Word, Ptr, Word) inline(0x1426,dispatcher); +extern pascal Long MCGetDiscID(Word) inline(0x2826,dispatcher); +extern pascal void MCGetDiscTitle(Long, Ptr) inline(0x1226,dispatcher); +extern pascal Long MCGetDiscTOC(Word, Word) inline(0x2726,dispatcher); +extern pascal void MCGetErrorMsg(Word, Ptr) inline(0x0926,dispatcher); +extern pascal Long MCGetFeatures(Word, Word) inline(0x1626,dispatcher); +extern pascal void MCGetName(Word, Ptr) inline(0x2D26,dispatcher); +extern pascal Word MCGetNoTracks(Word) inline(0x2926,dispatcher); +extern pascal Long MCGetPosition(Word, Word) inline(0x2426,dispatcher); +extern pascal void MCGetProgram(Long, Ptr) inline(0x1026,dispatcher); +extern pascal void MCGetSpeeds(Word, Ptr) inline(0x1D26,dispatcher); +extern pascal Word MCGetStatus(Word, Word) inline(0x1A26,dispatcher); +extern pascal Long MCGetTimes(Word, Word) inline(0x2626,dispatcher); +extern pascal void MCGetTrackTitle(Long, Word, Ptr) inline(0x0E26,dispatcher); +extern pascal void MCJog(Word, Long, Word) inline(0x2026,dispatcher); +extern pascal void MCLoadDriver(Word) inline(0x0A26,dispatcher); +extern pascal void MCPause(Word) inline(0x1826,dispatcher); +extern pascal void MCPlay(Word) inline(0x1726,dispatcher); +extern pascal void MCRecord(Word) inline(0x2A26,dispatcher); +extern pascal void MCScan(Word, Word) inline(0x1C26,dispatcher); +extern pascal Boolean MCSearchDone(Word) inline(0x2226,dispatcher); +extern pascal void MCSearchTo(Word, Word, Long) inline(0x2126,dispatcher); +extern pascal void MCSearchWait(Word) inline(0x2326,dispatcher); +extern pascal void MCSendRawData(Word, Long) inline(0x1926,dispatcher); +extern pascal void MCSetAudio(Word, Word) inline(0x2526,dispatcher); +extern pascal void MCSetDiscTitle(Long, Long) inline(0x1326,dispatcher); +extern pascal void MCSetProgram(Long, Long) inline(0x1126,dispatcher); +extern pascal void MCSetTrackTitle(Long, Word, Ptr) inline(0x0F26,dispatcher); +extern pascal void MCSetVolume(Word, Word, Word) inline(0x2E26,dispatcher); +extern pascal void MCSpeed(Word, Word) inline(0x1E26,dispatcher); +extern pascal void MCStop(Word) inline(0x2B26,dispatcher); +extern pascal void MCStopAt(Word, Word, Long) inline(0x1F26,dispatcher); +extern pascal Long MCTimeToBin(Long) inline(0x0C26,dispatcher); +extern pascal void MCUnLoadDriver(Word) inline(0x0B26,dispatcher); +extern pascal void MCWaitRawData(Word, Ptr, Word, Word) inline(0x2C26,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/memory.h b/bin/Libraries/ORCACDefs/memory.h index 894fa7d..211e8ea 100644 --- a/bin/Libraries/ORCACDefs/memory.h +++ b/bin/Libraries/ORCACDefs/memory.h @@ -1 +1,83 @@ -/******************************************** * * Memory Manager * * Copyright Apple Computer, Inc.1986-91 * All Rights Reserved * * Copyright 1992, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __MEMORY__ #define __MEMORY__ /* Error Codes */ #define memErr 0x0201 /* unable to allocate block */ #define emptyErr 0x0202 /* illegal operation, empty handle */ #define notEmptyErr 0x0203 /* an empty handle was expected for this operation */ #define lockErr 0x0204 /* illegal operation on a locked block */ #define purgeErr 0x0205 /* attempt to purge an unpurgable block */ #define handleErr 0x0206 /* an invalid handle was given */ #define idErr 0x0207 /* an invalid owner ID was given */ #define attrErr 0x0208 /* operation illegal on block with given attributes */ /* Handle Attribute Bits */ #define attrNoPurge 0x0000 /* Not purgeable */ #define attrBank 0x0001 /* fixed bank */ #define attrAddr 0x0002 /* fixed address */ #define attrPage 0x0004 /* page aligned */ #define attrNoSpec 0x0008 /* may not use special memory */ #define attrNoCross 0x0010 /* may not cross banks */ #define attrPurge1 0x0100 /* Purge level 1 */ #define attrPurge2 0x0200 /* Purge level 2 */ #define attrPurge3 0x0300 /* Purge level 3 */ #define attrPurge 0x0300 /* test or set both purge bits */ #define attrHandle 0x1000 /* block of master pointers */ #define attrSystem 0x2000 /* system handle */ #define attrFixed 0x4000 /* not movable */ #define attrLocked 0x8000 /* locked */ extern pascal void MMBootInit(void) inline(0x0102,dispatcher); extern pascal Word MMStartUp(void) inline(0x0202,dispatcher); extern pascal void MMShutDown(Word) inline(0x0302,dispatcher); extern pascal Word MMVersion(void) inline(0x0402,dispatcher); extern pascal void MMReset(void) inline(0x0502,dispatcher); extern pascal Boolean MMStatus(void) inline(0x0602,dispatcher); extern pascal void BlockMove(Pointer, Pointer, LongWord) inline(0x2B02,dispatcher); extern pascal void CheckHandle(Handle) inline(0x1E02,dispatcher); extern pascal void CompactMem(void) inline(0x1F02,dispatcher); extern pascal void DisposeAll(Word) inline(0x1102,dispatcher); extern pascal void DisposeHandle(Handle) inline(0x1002,dispatcher); extern pascal Handle FindHandle(Pointer) inline(0x1A02,dispatcher); extern pascal LongWord FreeMem(void) inline(0x1B02,dispatcher); extern pascal LongWord GetHandleSize(Handle) inline(0x1802,dispatcher); extern pascal void HandToHand(Handle, Handle, LongWord) inline(0x2A02,dispatcher); extern pascal void HandToPtr(Handle, Pointer, LongWord) inline(0x2902,dispatcher); extern pascal void HLock(Handle) inline(0x2002,dispatcher); extern pascal void HLockAll(Word) inline(0x2102,dispatcher); extern pascal void HUnlock(Handle) inline(0x2202,dispatcher); extern pascal void HUnlockAll(Word) inline(0x2302,dispatcher); extern pascal LongWord MaxBlock(void) inline(0x1C02,dispatcher); extern pascal Handle NewHandle(LongWord, Word, Word, Pointer) inline(0x0902,dispatcher); extern pascal void PtrToHand(Pointer, Handle, LongWord) inline(0x2802,dispatcher); extern pascal void PurgeAll(Word) inline(0x1302,dispatcher); extern pascal void PurgeHandle(Handle) inline(0x1202,dispatcher); extern pascal void ReAllocHandle(LongWord, Word, Word, Pointer, Handle) inline(0x0A02,dispatcher); extern pascal void RestoreHandle(Handle) inline(0x0B02,dispatcher); extern pascal void SetHandleSize(LongWord, Handle) inline(0x1902,dispatcher); extern pascal void SetPurge(Word, Handle) inline(0x2402,dispatcher); extern pascal void SetPurgeAll(Word, Word) inline(0x2502,dispatcher); extern pascal LongWord TotalMem(void) inline(0x1D02,dispatcher); extern pascal void AddToOOMQueue(Pointer) inline(0x0C02,dispatcher); extern pascal LongWord RealFreeMem(void) inline(0x2F02,dispatcher); extern pascal void RemoveFromOOMQueue(Pointer) inline(0x0D02,dispatcher); extern pascal Word SetHandleID(Word, Handle) inline(0x3002,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Memory Manager +* +* Copyright Apple Computer, Inc.1986-91 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __MEMORY__ +#define __MEMORY__ + +/* Error Codes */ +#define memErr 0x0201 /* unable to allocate block */ +#define emptyErr 0x0202 /* illegal operation, empty handle */ +#define notEmptyErr 0x0203 /* an empty handle was expected for this operation */ +#define lockErr 0x0204 /* illegal operation on a locked block */ +#define purgeErr 0x0205 /* attempt to purge an unpurgable block */ +#define handleErr 0x0206 /* an invalid handle was given */ +#define idErr 0x0207 /* an invalid owner ID was given */ +#define attrErr 0x0208 /* operation illegal on block with given attributes */ + +/* Handle Attribute Bits */ +#define attrNoPurge 0x0000 /* Not purgeable */ +#define attrBank 0x0001 /* fixed bank */ +#define attrAddr 0x0002 /* fixed address */ +#define attrPage 0x0004 /* page aligned */ +#define attrNoSpec 0x0008 /* may not use special memory */ +#define attrNoCross 0x0010 /* may not cross banks */ +#define attrPurge1 0x0100 /* Purge level 1 */ +#define attrPurge2 0x0200 /* Purge level 2 */ +#define attrPurge3 0x0300 /* Purge level 3 */ +#define attrPurge 0x0300 /* test or set both purge bits */ +#define attrHandle 0x1000 /* block of master pointers */ +#define attrSystem 0x2000 /* system handle */ +#define attrFixed 0x4000 /* not movable */ +#define attrLocked 0x8000 /* locked */ + +extern pascal void MMBootInit(void) inline(0x0102,dispatcher); +extern pascal Word MMStartUp(void) inline(0x0202,dispatcher); +extern pascal void MMShutDown(Word) inline(0x0302,dispatcher); +extern pascal Word MMVersion(void) inline(0x0402,dispatcher); +extern pascal void MMReset(void) inline(0x0502,dispatcher); +extern pascal Boolean MMStatus(void) inline(0x0602,dispatcher); +extern pascal void BlockMove(Pointer, Pointer, LongWord) inline(0x2B02,dispatcher); +extern pascal void CheckHandle(Handle) inline(0x1E02,dispatcher); +extern pascal void CompactMem(void) inline(0x1F02,dispatcher); +extern pascal void DisposeAll(Word) inline(0x1102,dispatcher); +extern pascal void DisposeHandle(Handle) inline(0x1002,dispatcher); +extern pascal Handle FindHandle(Pointer) inline(0x1A02,dispatcher); +extern pascal LongWord FreeMem(void) inline(0x1B02,dispatcher); +extern pascal LongWord GetHandleSize(Handle) inline(0x1802,dispatcher); +extern pascal void HandToHand(Handle, Handle, LongWord) inline(0x2A02,dispatcher); +extern pascal void HandToPtr(Handle, Pointer, LongWord) inline(0x2902,dispatcher); +extern pascal void HLock(Handle) inline(0x2002,dispatcher); +extern pascal void HLockAll(Word) inline(0x2102,dispatcher); +extern pascal void HUnlock(Handle) inline(0x2202,dispatcher); +extern pascal void HUnlockAll(Word) inline(0x2302,dispatcher); +extern pascal LongWord MaxBlock(void) inline(0x1C02,dispatcher); +extern pascal Handle NewHandle(LongWord, Word, Word, Pointer) inline(0x0902,dispatcher); +extern pascal void PtrToHand(Pointer, Handle, LongWord) inline(0x2802,dispatcher); +extern pascal void PurgeAll(Word) inline(0x1302,dispatcher); +extern pascal void PurgeHandle(Handle) inline(0x1202,dispatcher); +extern pascal void ReAllocHandle(LongWord, Word, Word, Pointer, Handle) inline(0x0A02,dispatcher); +extern pascal void RestoreHandle(Handle) inline(0x0B02,dispatcher); +extern pascal void SetHandleSize(LongWord, Handle) inline(0x1902,dispatcher); +extern pascal void SetPurge(Word, Handle) inline(0x2402,dispatcher); +extern pascal void SetPurgeAll(Word, Word) inline(0x2502,dispatcher); +extern pascal LongWord TotalMem(void) inline(0x1D02,dispatcher); + +extern pascal void AddToOOMQueue(Pointer) inline(0x0C02,dispatcher); +extern pascal LongWord RealFreeMem(void) inline(0x2F02,dispatcher); +extern pascal void RemoveFromOOMQueue(Pointer) inline(0x0D02,dispatcher); + +extern pascal Word SetHandleID(Word, Handle) inline(0x3002,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/menu.h b/bin/Libraries/ORCACDefs/menu.h index 75a3bf8..75dc7ca 100644 --- a/bin/Libraries/ORCACDefs/menu.h +++ b/bin/Libraries/ORCACDefs/menu.h @@ -1 +1,226 @@ -/******************************************** * * Menu Manager * * Copyright Apple Computer, Inc. 1986-91 * All Rights Reserved * * CopyRight 1992, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __MENU__ #define __MENU__ /* error codes */ #define menuStarted 0x0F01 #define menuItemNotFound 0x0F02 #define menuNoStruct 0x0F03 #define dupMenuID 0x0F04 /* InsertPathMItems bit flags */ #define ipmiNotExpanded 0x0010 #define ipmiDevNumValid 0x0008 #define ipmiOpenFolders 0x0004 #define ipmiDeviceAtTop 0x0001 /* MenuDefProc Codes */ #define mDrawMsg 0x0000 #define mChooseMsg 0x0001 #define mSizeMsg 0x0002 #define mDrawTitle 0x0003 #define mDrawMItem 0x0004 #define mGetMItemID 0x0005 /* Reference Flags */ #define menuRefPtr 0x0000 #define mRefHandle 0x4000 #define mRefResource 0x8000 /* Menu Flags */ #define menuAllowCache 0x0008 #define menuCustom 0x0010 #define menuXOR 0x0020 #define menuDisabled 0x0080 #define menuAlwaysCallMChoose 0x0100 /* Item Flags */ #define itemBold 0x0001 #define itemItalic 0x0002 #define itemUnderline 0x0004 #define itemXOR 0x0020 #define itemDivider 0x0040 #define itemDisabled 0x0080 #define itemOutline 0x0800 #define itemShadow 0x1000 /* Old Menu Flags */ #define mInvis 0x0004 #define mCustom 0x0010 #define mXor 0x0020 #define mSelected 0x0040 #define mDisabled 0x0080 /* MenuFlag Masks */ #define menuCacheMask 0x0008 #define customMenu 0x0010 #define xorMItemHilite 0x0020 #define xorTitleHilite 0x0020 #define underMItem 0x0040 #define disableItem 0x0080 #define disableMenu 0x0080 #define enableItem 0xFF7F #define enableMenu 0xFF7F #define noUnderMItem 0xFFBF #define colorMItemHilite 0xFFDF #define colorTitleHilite 0xFFDF #define colorReplace 0xFFDF #define standardMenu 0xFFEF /* Other misc constants */ #define type2 0x0040 #ifndef mtItemRefArrayLength /* MenuTemplate - default number of Ref's */ #define mtItemRefArrayLength 0x0005 #endif #ifndef mbtMenuRefArrayLength /* MenuBarTemplate - default number of Ref's */ #define mbtMenuRefArrayLength 0x0005 #endif typedef CtlRec MenuBarRec, *MenuBarRecPtr, **MenuBarRecHndl; struct MenuRec { Word menuID; /* Menu's ID number */ Word menuWidth; /* Width of menu */ Word menuHeight; /* Height of menu */ WordProcPtr menuProc; /* Menu's definition procedure */ Word menuFlag; /* Bit flags */ Word numOfItems; Word titleWidth; /* Width of menu's title */ Pointer titleName; Handle menuCache; }; typedef struct MenuRec MenuRec, *MenuRecPtr, **MenuRecHndl; struct MenuItemTemplate { Word version; /* Version number (must be 0) */ Word itemID; /* Menu item ID */ Byte itemChar; /* Primary keystroke character */ Byte itemAltChar; /* Alternate keystroke character */ Word itemCheck; /* Character code for checked items */ Word itemFlag; /* Menu item flag word */ Ref itemTitleRef; /* Reference to item title string */ } ; typedef struct MenuItemTemplate MenuItemTemplate; struct MenuTemplate { Word version; /* Version number (must be 0) */ Word menuID; /* Menu ID */ Word menuFlag; /* Menu flag word */ Ref menuTitleRef; /* Reference to menu title string */ Ref itemRefArray[mtItemRefArrayLength]; /* mtItemRefArrayLength references to menu items */ }; typedef struct MenuTemplate MenuTemplate; struct MenuBarTemplate { Word version; /* Version number (must be 0) */ Word menuFlag; /* MenuBar flag word */ Ref menuRefArray[mbtMenuRefArrayLength]; /* mbtMenuRefArrayLength references to menus */ }; typedef struct MenuBarTemplate MenuBarTemplate; typedef struct itemStruct { Word itemFlag2; Ref itemTitleRef; Ref itemIconRef; }; typedef struct itemStruct itemStruct; typedef struct ipmiResultRec { Word highestID; Handle tempHandle1, tempHandle2; }; typedef struct ipmiResultRec ipmiResultRec; extern pascal void MenuBootInit(void) inline(0x010F,dispatcher); extern pascal void MenuStartUp(Word, Word) inline(0x020F,dispatcher); extern pascal void MenuShutDown(void) inline(0x030F,dispatcher); extern pascal Word MenuVersion(void) inline(0x040F,dispatcher); extern pascal void MenuReset(void) inline(0x050F,dispatcher); extern pascal Boolean MenuStatus(void) inline(0x060F,dispatcher); extern pascal void CalcMenuSize(Word, Word, Word) inline(0x1C0F,dispatcher); extern pascal void CheckMItem(Boolean, Word) inline(0x320F,dispatcher); extern pascal Word CountMItems(Word) inline(0x140F,dispatcher); extern pascal void DeleteMenu(Word) inline(0x0E0F,dispatcher); extern pascal void DeleteMItem(Word) inline(0x100F,dispatcher); extern pascal void DisableMItem(Word) inline(0x310F,dispatcher); extern pascal void DisposeMenu(MenuRecHndl) inline(0x2E0F,dispatcher); extern pascal void DrawMenuBar(void) inline(0x2A0F,dispatcher); extern pascal void EnableMItem(Word) inline(0x300F,dispatcher); extern pascal Word FixMenuBar (void) inline(0x130F,dispatcher); extern pascal void FlashMenuBar(void) inline(0x0C0F,dispatcher); extern pascal LongWord GetBarColors(void) inline(0x180F,dispatcher); extern pascal MenuBarRecHndl GetMenuBar(void) inline(0x0A0F,dispatcher); extern pascal Word GetMenuFlag(Word) inline(0x200F,dispatcher); extern pascal GrafPortPtr GetMenuMgrPort(void) inline(0x1B0F,dispatcher); extern pascal Pointer GetMenuTitle(Word) inline(0x220F,dispatcher); extern pascal MenuRecHndl GetMHandle(Word) inline(0x160F,dispatcher); extern pascal StringPtr GetMItem(Word) inline(0x250F,dispatcher); extern pascal Word GetMItemFlag(Word) inline(0x270F,dispatcher); extern pascal Word GetMItemMark(Word) inline(0x340F,dispatcher); extern pascal TextStyle GetMItemStyle(Word) inline(0x360F,dispatcher); extern pascal Word GetMTitleStart(void) inline(0x1A0F,dispatcher); extern pascal Word GetMTitleWidth(Word) inline(0x1E0F,dispatcher); extern pascal MenuBarRecHndl GetSysBar(void) inline(0x110F,dispatcher); extern pascal void HiliteMenu(Boolean, Word) inline(0x2C0F,dispatcher); extern pascal void InitPalette(void) inline(0x2F0F,dispatcher); extern pascal void InsertMenu(MenuRecHndl, Word) inline(0x0D0F,dispatcher); extern pascal void InsertMItem(Pointer, Word, Word) inline(0x0F0F,dispatcher); extern pascal Word MenuGlobal(Word) inline(0x230F,dispatcher); extern pascal void MenuKey(WmTaskRecPtr, MenuRecHndl) inline(0x090F,dispatcher); extern pascal void MenuNewRes(void) inline(0x290F,dispatcher); extern pascal void MenuRefresh(VoidProcPtr) inline(0x0B0F,dispatcher); extern pascal void MenuSelect(WmTaskRecPtr, MenuRecHndl) inline(0x2B0F,dispatcher); extern pascal MenuRecHndl NewMenu(Pointer) inline(0x2D0F,dispatcher); extern pascal MenuBarRecHndl NewMenuBar(GrafPortPtr) inline(0x150F,dispatcher); extern pascal void SetBarColors(Word, Word, Word) inline(0x170F,dispatcher); extern pascal void SetMenuBar(MenuBarRecHndl) inline(0x390F,dispatcher); extern pascal void SetMenuFlag(Word, Word) inline(0x1F0F,dispatcher); extern pascal void SetMenuID(Word, Word) inline(0x370F,dispatcher); extern pascal void SetMenuTitle(Pointer, Word) inline(0x210F,dispatcher); extern pascal void SetMItem(Pointer, Word) inline(0x240F,dispatcher); extern pascal void SetMItemBlink(Word) inline(0x280F,dispatcher); extern pascal void SetMItemFlag(Word, Word) inline(0x260F,dispatcher); extern pascal void SetMItemID(Word, Word) inline(0x380F,dispatcher); extern pascal void SetMItemMark(Word, Word) inline(0x330F,dispatcher); extern pascal void SetMItemName(Pointer, Word) inline(0x3A0F,dispatcher); extern pascal void SetMItemStyle(TextStyle, Word) inline(0x350F,dispatcher); extern pascal void SetMTitleStart(Word) inline(0x190F,dispatcher); extern pascal void SetMTitleWidth(Word, Word) inline(0x1D0F,dispatcher); extern pascal void SetSysBar(MenuBarRecHndl) inline(0x120F,dispatcher); extern pascal Pointer GetPopUpDefProc(void) inline(0x3B0F,dispatcher); extern pascal void HideMenuBar(void) inline(0x450F,dispatcher); extern pascal void InsertMItem2(Word, Ref, Word, Word) inline(0x3F0F,dispatcher); extern pascal MenuRecHndl NewMenu2(Word, Ref) inline(0x3E0F,dispatcher); extern pascal MenuBarRecHndl NewMenuBar2(Word, Ref, Pointer) inline(0x430F,dispatcher); extern pascal Word PopUpMenuSelect(Word, Word, Word, Word, MenuRecHndl) inline(0x3C0F,dispatcher); extern pascal void SetMenuTitle2(Word, Ref, Word) inline(0x400F,dispatcher); extern pascal void SetMItem2(Word, Ref, Word) inline(0x410F,dispatcher); extern pascal void SetMItemName2(Word, Ref, Word) inline(0x420F,dispatcher); extern pascal void ShowMenuBar(void) inline(0x460F,dispatcher); extern pascal Word GetMItemBlink(void) inline(0x4F0F,dispatcher); extern pascal Word GetMItemFlag2(Word) inline(0x4C0F,dispatcher); extern pascal Ref GetMItemIcon(Word) inline(0x480F,dispatcher); extern pascal Ref GetMItemStruct(Word) inline(0x4A0F,dispatcher); extern pascal void InsertPathMItems(Word, Pointer, Word, Word, Word, Word, Ptr) inline(0x500F,dispatcher); extern pascal void RemoveMItemStruct(Word) inline(0x4B0F,dispatcher); extern pascal void SetMItemFlag2(Word, Word) inline(0x4D0F,dispatcher); extern pascal void SetMItemIcon(Word, Ref, Word) inline(0x470F,dispatcher); extern pascal void SetMItemStruct(Word, Ref, Word) inline(0x490F,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Menu Manager +* +* Copyright Apple Computer, Inc. 1986-91 +* All Rights Reserved +* +* CopyRight 1992, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __MENU__ +#define __MENU__ + +/* error codes */ +#define menuStarted 0x0F01 +#define menuItemNotFound 0x0F02 +#define menuNoStruct 0x0F03 +#define dupMenuID 0x0F04 + +/* InsertPathMItems bit flags */ +#define ipmiNotExpanded 0x0010 +#define ipmiDevNumValid 0x0008 +#define ipmiOpenFolders 0x0004 +#define ipmiDeviceAtTop 0x0001 + +/* MenuDefProc Codes */ +#define mDrawMsg 0x0000 +#define mChooseMsg 0x0001 +#define mSizeMsg 0x0002 +#define mDrawTitle 0x0003 +#define mDrawMItem 0x0004 +#define mGetMItemID 0x0005 + +/* Reference Flags */ +#define menuRefPtr 0x0000 +#define mRefHandle 0x4000 +#define mRefResource 0x8000 + +/* Menu Flags */ +#define menuAllowCache 0x0008 +#define menuCustom 0x0010 +#define menuXOR 0x0020 +#define menuDisabled 0x0080 +#define menuAlwaysCallMChoose 0x0100 + +/* Item Flags */ +#define itemBold 0x0001 +#define itemItalic 0x0002 +#define itemUnderline 0x0004 +#define itemXOR 0x0020 +#define itemDivider 0x0040 +#define itemDisabled 0x0080 +#define itemOutline 0x0800 +#define itemShadow 0x1000 + +/* Old Menu Flags */ +#define mInvis 0x0004 +#define mCustom 0x0010 +#define mXor 0x0020 +#define mSelected 0x0040 +#define mDisabled 0x0080 + +/* MenuFlag Masks */ +#define menuCacheMask 0x0008 +#define customMenu 0x0010 +#define xorMItemHilite 0x0020 +#define xorTitleHilite 0x0020 +#define underMItem 0x0040 +#define disableItem 0x0080 +#define disableMenu 0x0080 +#define enableItem 0xFF7F +#define enableMenu 0xFF7F +#define noUnderMItem 0xFFBF +#define colorMItemHilite 0xFFDF +#define colorTitleHilite 0xFFDF +#define colorReplace 0xFFDF +#define standardMenu 0xFFEF + +/* Other misc constants */ +#define type2 0x0040 + +#ifndef mtItemRefArrayLength /* MenuTemplate - default number of Ref's */ +#define mtItemRefArrayLength 0x0005 +#endif +#ifndef mbtMenuRefArrayLength /* MenuBarTemplate - default number of Ref's */ +#define mbtMenuRefArrayLength 0x0005 +#endif + +typedef CtlRec MenuBarRec, *MenuBarRecPtr, **MenuBarRecHndl; +struct MenuRec { + Word menuID; /* Menu's ID number */ + Word menuWidth; /* Width of menu */ + Word menuHeight; /* Height of menu */ + WordProcPtr menuProc; /* Menu's definition procedure */ + Word menuFlag; /* Bit flags */ + Word numOfItems; + Word titleWidth; /* Width of menu's title */ + Pointer titleName; + Handle menuCache; + }; +typedef struct MenuRec MenuRec, *MenuRecPtr, **MenuRecHndl; + +struct MenuItemTemplate { + Word version; /* Version number (must be 0) */ + Word itemID; /* Menu item ID */ + Byte itemChar; /* Primary keystroke character */ + Byte itemAltChar; /* Alternate keystroke character */ + Word itemCheck; /* Character code for checked items */ + Word itemFlag; /* Menu item flag word */ + Ref itemTitleRef; /* Reference to item title string */ +} ; +typedef struct MenuItemTemplate MenuItemTemplate; + +struct MenuTemplate { + Word version; /* Version number (must be 0) */ + Word menuID; /* Menu ID */ + Word menuFlag; /* Menu flag word */ + Ref menuTitleRef; /* Reference to menu title string */ + Ref itemRefArray[mtItemRefArrayLength]; /* mtItemRefArrayLength references to menu items */ + }; +typedef struct MenuTemplate MenuTemplate; + +struct MenuBarTemplate { + Word version; /* Version number (must be 0) */ + Word menuFlag; /* MenuBar flag word */ + Ref menuRefArray[mbtMenuRefArrayLength]; /* mbtMenuRefArrayLength references to menus */ + }; +typedef struct MenuBarTemplate MenuBarTemplate; + +typedef struct itemStruct { + Word itemFlag2; + Ref itemTitleRef; + Ref itemIconRef; + }; +typedef struct itemStruct itemStruct; + +typedef struct ipmiResultRec { + Word highestID; + Handle tempHandle1, tempHandle2; + }; +typedef struct ipmiResultRec ipmiResultRec; + +extern pascal void MenuBootInit(void) inline(0x010F,dispatcher); +extern pascal void MenuStartUp(Word, Word) inline(0x020F,dispatcher); +extern pascal void MenuShutDown(void) inline(0x030F,dispatcher); +extern pascal Word MenuVersion(void) inline(0x040F,dispatcher); +extern pascal void MenuReset(void) inline(0x050F,dispatcher); +extern pascal Boolean MenuStatus(void) inline(0x060F,dispatcher); +extern pascal void CalcMenuSize(Word, Word, Word) inline(0x1C0F,dispatcher); +extern pascal void CheckMItem(Boolean, Word) inline(0x320F,dispatcher); +extern pascal Word CountMItems(Word) inline(0x140F,dispatcher); +extern pascal void DeleteMenu(Word) inline(0x0E0F,dispatcher); +extern pascal void DeleteMItem(Word) inline(0x100F,dispatcher); +extern pascal void DisableMItem(Word) inline(0x310F,dispatcher); +extern pascal void DisposeMenu(MenuRecHndl) inline(0x2E0F,dispatcher); +extern pascal void DrawMenuBar(void) inline(0x2A0F,dispatcher); +extern pascal void EnableMItem(Word) inline(0x300F,dispatcher); +extern pascal Word FixMenuBar (void) inline(0x130F,dispatcher); +extern pascal void FlashMenuBar(void) inline(0x0C0F,dispatcher); +extern pascal LongWord GetBarColors(void) inline(0x180F,dispatcher); +extern pascal MenuBarRecHndl GetMenuBar(void) inline(0x0A0F,dispatcher); +extern pascal Word GetMenuFlag(Word) inline(0x200F,dispatcher); +extern pascal GrafPortPtr GetMenuMgrPort(void) inline(0x1B0F,dispatcher); +extern pascal Pointer GetMenuTitle(Word) inline(0x220F,dispatcher); +extern pascal MenuRecHndl GetMHandle(Word) inline(0x160F,dispatcher); +extern pascal StringPtr GetMItem(Word) inline(0x250F,dispatcher); +extern pascal Word GetMItemFlag(Word) inline(0x270F,dispatcher); +extern pascal Word GetMItemMark(Word) inline(0x340F,dispatcher); +extern pascal TextStyle GetMItemStyle(Word) inline(0x360F,dispatcher); +extern pascal Word GetMTitleStart(void) inline(0x1A0F,dispatcher); +extern pascal Word GetMTitleWidth(Word) inline(0x1E0F,dispatcher); +extern pascal MenuBarRecHndl GetSysBar(void) inline(0x110F,dispatcher); +extern pascal void HiliteMenu(Boolean, Word) inline(0x2C0F,dispatcher); +extern pascal void InitPalette(void) inline(0x2F0F,dispatcher); +extern pascal void InsertMenu(MenuRecHndl, Word) inline(0x0D0F,dispatcher); +extern pascal void InsertMItem(Pointer, Word, Word) inline(0x0F0F,dispatcher); +extern pascal Word MenuGlobal(Word) inline(0x230F,dispatcher); +extern pascal void MenuKey(WmTaskRecPtr, MenuRecHndl) inline(0x090F,dispatcher); +extern pascal void MenuNewRes(void) inline(0x290F,dispatcher); +extern pascal void MenuRefresh(VoidProcPtr) inline(0x0B0F,dispatcher); +extern pascal void MenuSelect(WmTaskRecPtr, MenuRecHndl) inline(0x2B0F,dispatcher); +extern pascal MenuRecHndl NewMenu(Pointer) inline(0x2D0F,dispatcher); +extern pascal MenuBarRecHndl NewMenuBar(GrafPortPtr) inline(0x150F,dispatcher); +extern pascal void SetBarColors(Word, Word, Word) inline(0x170F,dispatcher); +extern pascal void SetMenuBar(MenuBarRecHndl) inline(0x390F,dispatcher); +extern pascal void SetMenuFlag(Word, Word) inline(0x1F0F,dispatcher); +extern pascal void SetMenuID(Word, Word) inline(0x370F,dispatcher); +extern pascal void SetMenuTitle(Pointer, Word) inline(0x210F,dispatcher); +extern pascal void SetMItem(Pointer, Word) inline(0x240F,dispatcher); +extern pascal void SetMItemBlink(Word) inline(0x280F,dispatcher); +extern pascal void SetMItemFlag(Word, Word) inline(0x260F,dispatcher); +extern pascal void SetMItemID(Word, Word) inline(0x380F,dispatcher); +extern pascal void SetMItemMark(Word, Word) inline(0x330F,dispatcher); +extern pascal void SetMItemName(Pointer, Word) inline(0x3A0F,dispatcher); +extern pascal void SetMItemStyle(TextStyle, Word) inline(0x350F,dispatcher); +extern pascal void SetMTitleStart(Word) inline(0x190F,dispatcher); +extern pascal void SetMTitleWidth(Word, Word) inline(0x1D0F,dispatcher); +extern pascal void SetSysBar(MenuBarRecHndl) inline(0x120F,dispatcher); + +extern pascal Pointer GetPopUpDefProc(void) inline(0x3B0F,dispatcher); +extern pascal void HideMenuBar(void) inline(0x450F,dispatcher); +extern pascal void InsertMItem2(Word, Ref, Word, Word) inline(0x3F0F,dispatcher); +extern pascal MenuRecHndl NewMenu2(Word, Ref) inline(0x3E0F,dispatcher); +extern pascal MenuBarRecHndl NewMenuBar2(Word, Ref, Pointer) inline(0x430F,dispatcher); +extern pascal Word PopUpMenuSelect(Word, Word, Word, Word, MenuRecHndl) inline(0x3C0F,dispatcher); +extern pascal void SetMenuTitle2(Word, Ref, Word) inline(0x400F,dispatcher); +extern pascal void SetMItem2(Word, Ref, Word) inline(0x410F,dispatcher); +extern pascal void SetMItemName2(Word, Ref, Word) inline(0x420F,dispatcher); +extern pascal void ShowMenuBar(void) inline(0x460F,dispatcher); + +extern pascal Word GetMItemBlink(void) inline(0x4F0F,dispatcher); +extern pascal Word GetMItemFlag2(Word) inline(0x4C0F,dispatcher); +extern pascal Ref GetMItemIcon(Word) inline(0x480F,dispatcher); +extern pascal Ref GetMItemStruct(Word) inline(0x4A0F,dispatcher); +extern pascal void InsertPathMItems(Word, Pointer, Word, Word, Word, Word, Ptr) inline(0x500F,dispatcher); +extern pascal void RemoveMItemStruct(Word) inline(0x4B0F,dispatcher); +extern pascal void SetMItemFlag2(Word, Word) inline(0x4D0F,dispatcher); +extern pascal void SetMItemIcon(Word, Ref, Word) inline(0x470F,dispatcher); +extern pascal void SetMItemStruct(Word, Ref, Word) inline(0x490F,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/midi.h b/bin/Libraries/ORCACDefs/midi.h index f218aca..df351df 100644 --- a/bin/Libraries/ORCACDefs/midi.h +++ b/bin/Libraries/ORCACDefs/midi.h @@ -1 +1,121 @@ -/******************************************** * * MIDI Tool Set * * Copyright Apple Computer, Inc.1986-90 * All Rights Reserved * * Copyright 1992, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __MIDI__ #define __MIDI__ /* MIDI */ #define miToolNum 0x0020 /* the tool number of the MIDI Tool Set */ #define miDrvrFileType 0x00BB /* filetype of MIDI device driver */ #define miNSVer 0x0102 /* minimum version of Note Synthesizer required by MIDI Tool Set */ #define miSTVer 0x0203 /* minimum version of Sound Tools needed by MIDI Tool Set */ #define miDrvrAuxType 0x0300 /* aux type of MIDI device driver */ /* Error Codes */ #define miStartUpErr 0x2000 /* MIDI Tool Set is not started */ #define miPacketErr 0x2001 /* incorrect length for a received MIDI command */ #define miArrayErr 0x2002 /* a designated array had an insufficient or illegal size */ #define miFullBufErr 0x2003 /* input buffer overflow */ #define miToolsErr 0x2004 /* the required tools were not started up or had insufficient versions */ #define miOutOffErr 0x2005 /* MIDI output must first be enabled */ #define miNoBufErr 0x2007 /* no buffer is currently allocated */ #define miDriverErr 0x2008 /* the designated file is not a legal MIDI device driver */ #define miBadFreqErr 0x2009 /* the MIDI clock cannot attain the requested frequency */ #define miClockErr 0x200A /* the MIDI clock value wrapped to zero */ #define miConflictErr 0x200B /* conflicting processes for MIDI input */ #define miNoDevErr 0x200C /* no MIDI device driver loaded */ #define miDevNotAvail 0x2080 /* the requested device is not available */ #define miDevSlotBusy 0x2081 /* requested slot is already in use */ #define miDevBusy 0x2082 /* the requested device is already in use */ #define miDevOverrun 0x2083 /* device overrun by incoming MIDI data */ #define miDevNoConnect 0x2084 /* no connection to MIDI */ #define miDevReadErr 0x2085 /* framing error in received MIDI data */ #define miDevVersion 0x2086 /* ROM version is incompatible with device driver */ #define miDevIntHndlr 0x2087 /* conflicting interrupt handler is installed */ /* MidiClock */ #define miSetClock 0x0000 /* set time stamp clock */ #define miStartClock 0x0001 /* start time stamp clock */ #define miStopClock 0x0002 /* stop time stamp clock */ #define miSetFreq 0x0003 /* set clock frequency */ /* MidiControl */ #define miRawMode 0x00000000L /* raw mode for MIDI input and output */ #define miSetRTVec 0x0000 /* set real-time message vector */ #define miPacketMode 0x00000001L /* packet mode for MIDI input and output */ #define miSetErrVec 0x0001 /* set real-time error vector */ #define miStandardMode 0x00000002L /* standard mode for MIDI input and output */ #define miSetInBuf 0x0002 /* set input buffer information */ #define miSetOutBuf 0x0003 /* set output buffer information */ #define miStartInput 0x0004 /* start MIDI input */ #define miStartOutput 0x0005 /* start MIDI output */ #define miStopInput 0x0006 /* stop MIDI input */ #define miStopOutput 0x0007 /* stop MIDI output */ #define miFlushInput 0x0008 /* discard contents of input buffer */ #define miFlushOutput 0x0009 /* discard contents of output buffer */ #define miFlushPacket 0x000A /* discard next input packet */ #define miWaitOutput 0x000B /* wait for output buffer to empty */ #define miSetInMode 0x000C /* set input mode */ #define miSetOutMode 0x000D /* set output mode */ #define miClrNotePad 0x000E /* clear all notes marked on in the note pad */ #define miSetDelay 0x000F /* set minimum delay between output packets */ #define miOutputStat 0x0010 /* enable/disable output of running-status */ #define miIgnoreSysEx 0x0011 /* ignore system exclusive input */ /* MidiDevice */ #define miSelectDrvr 0x0000 /* display device driver selection dialog */ #define miLoadDrvr 0x0001 /* load and initialize device driver */ #define miUnloadDrvr 0x0002 /* shutdown MIDI device, unload driver */ /* MidiInfo */ #define miNextPktLen 0x0000 /* return length of next packet */ #define miInputChars 0x0001 /* return number of characters in input buffer */ #define miOutputChars 0x0002 /* return number of characters in output buffer */ #define miMaxInChars 0x0003 /* return maximum number of characters in input buffer */ #define miMaxOutChars 0x0004 /* return maximum number of characters in output buffer */ #define miRecordAddr 0x0005 /* return current MidiRecordSeq address */ #define miPlayAddr 0x0006 /* return current MidiPlaySeq address */ #define miClockValue 0x0007 /* return current time stamp clock value */ #define miClockFreq 0x0008 /* return number of clock ticks per second */ #define midiInputPoll 0x00E101B2L /* MidiInputChannel - vector to poll MIDI input channel */ struct MiBufInfo { Word bufSize; /* size of buffer (0 for default) */ Pointer address; /* address of buffer (0 for auto-allocation) */ }; typedef struct MiBufInfo MiBufInfo; struct MiDriverInfo { Word slot; /* device slot */ Word external; /* slot internal (=0) / external (=1) */ Byte pathname[65]; /* device driver pathname */ }; typedef struct MiDriverInfo MiDriverInfo, *MiDriverInfoPtr; extern pascal void MidiBootInit(void) inline(0x0120,dispatcher); extern pascal void MidiStartUp(Word, Word) inline(0x0220,dispatcher); extern pascal void MidiShutDown(void) inline(0x0320,dispatcher); extern pascal Word MidiVersion(void) inline(0x0420,dispatcher); extern pascal void MidiReset(void) inline(0x0520,dispatcher); extern pascal Boolean MidiStatus(void) inline(0x0620,dispatcher); extern pascal void MidiClock(Word, Long) inline(0x0B20,dispatcher); extern pascal void MidiControl(Word, Long) inline(0x0920,dispatcher); extern pascal void MidiDevice(Word, Pointer) inline(0x0A20,dispatcher); extern pascal LongWord MidiInfo(Word) inline(0x0C20,dispatcher); #define MidiInputPoll() asm {jsl 0xE101B2} /* Not a true tool call. Made through its own vector */ extern pascal Word MidiReadPacket(Pointer, Word) inline(0x0D20,dispatcher); extern pascal Word MidiWritePacket(Pointer) inline(0x0E20,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* MIDI Tool Set +* +* Copyright Apple Computer, Inc.1986-90 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __MIDI__ +#define __MIDI__ + +/* MIDI */ +#define miToolNum 0x0020 /* the tool number of the MIDI Tool Set */ +#define miDrvrFileType 0x00BB /* filetype of MIDI device driver */ +#define miNSVer 0x0102 /* minimum version of Note Synthesizer required by MIDI Tool Set */ +#define miSTVer 0x0203 /* minimum version of Sound Tools needed by MIDI Tool Set */ +#define miDrvrAuxType 0x0300 /* aux type of MIDI device driver */ + +/* Error Codes */ +#define miStartUpErr 0x2000 /* MIDI Tool Set is not started */ +#define miPacketErr 0x2001 /* incorrect length for a received MIDI command */ +#define miArrayErr 0x2002 /* a designated array had an insufficient or illegal size */ +#define miFullBufErr 0x2003 /* input buffer overflow */ +#define miToolsErr 0x2004 /* the required tools were not started up or had insufficient versions */ +#define miOutOffErr 0x2005 /* MIDI output must first be enabled */ +#define miNoBufErr 0x2007 /* no buffer is currently allocated */ +#define miDriverErr 0x2008 /* the designated file is not a legal MIDI device driver */ +#define miBadFreqErr 0x2009 /* the MIDI clock cannot attain the requested frequency */ +#define miClockErr 0x200A /* the MIDI clock value wrapped to zero */ +#define miConflictErr 0x200B /* conflicting processes for MIDI input */ +#define miNoDevErr 0x200C /* no MIDI device driver loaded */ +#define miDevNotAvail 0x2080 /* the requested device is not available */ +#define miDevSlotBusy 0x2081 /* requested slot is already in use */ +#define miDevBusy 0x2082 /* the requested device is already in use */ +#define miDevOverrun 0x2083 /* device overrun by incoming MIDI data */ +#define miDevNoConnect 0x2084 /* no connection to MIDI */ +#define miDevReadErr 0x2085 /* framing error in received MIDI data */ +#define miDevVersion 0x2086 /* ROM version is incompatible with device driver */ +#define miDevIntHndlr 0x2087 /* conflicting interrupt handler is installed */ + +/* MidiClock */ +#define miSetClock 0x0000 /* set time stamp clock */ +#define miStartClock 0x0001 /* start time stamp clock */ +#define miStopClock 0x0002 /* stop time stamp clock */ +#define miSetFreq 0x0003 /* set clock frequency */ + +/* MidiControl */ +#define miRawMode 0x00000000L /* raw mode for MIDI input and output */ +#define miSetRTVec 0x0000 /* set real-time message vector */ +#define miPacketMode 0x00000001L /* packet mode for MIDI input and output */ +#define miSetErrVec 0x0001 /* set real-time error vector */ +#define miStandardMode 0x00000002L /* standard mode for MIDI input and output */ +#define miSetInBuf 0x0002 /* set input buffer information */ +#define miSetOutBuf 0x0003 /* set output buffer information */ +#define miStartInput 0x0004 /* start MIDI input */ +#define miStartOutput 0x0005 /* start MIDI output */ +#define miStopInput 0x0006 /* stop MIDI input */ +#define miStopOutput 0x0007 /* stop MIDI output */ +#define miFlushInput 0x0008 /* discard contents of input buffer */ +#define miFlushOutput 0x0009 /* discard contents of output buffer */ +#define miFlushPacket 0x000A /* discard next input packet */ +#define miWaitOutput 0x000B /* wait for output buffer to empty */ +#define miSetInMode 0x000C /* set input mode */ +#define miSetOutMode 0x000D /* set output mode */ +#define miClrNotePad 0x000E /* clear all notes marked on in the note pad */ +#define miSetDelay 0x000F /* set minimum delay between output packets */ +#define miOutputStat 0x0010 /* enable/disable output of running-status */ +#define miIgnoreSysEx 0x0011 /* ignore system exclusive input */ + +/* MidiDevice */ +#define miSelectDrvr 0x0000 /* display device driver selection dialog */ +#define miLoadDrvr 0x0001 /* load and initialize device driver */ +#define miUnloadDrvr 0x0002 /* shutdown MIDI device, unload driver */ + +/* MidiInfo */ +#define miNextPktLen 0x0000 /* return length of next packet */ +#define miInputChars 0x0001 /* return number of characters in input buffer */ +#define miOutputChars 0x0002 /* return number of characters in output buffer */ +#define miMaxInChars 0x0003 /* return maximum number of characters in input buffer */ +#define miMaxOutChars 0x0004 /* return maximum number of characters in output buffer */ +#define miRecordAddr 0x0005 /* return current MidiRecordSeq address */ +#define miPlayAddr 0x0006 /* return current MidiPlaySeq address */ +#define miClockValue 0x0007 /* return current time stamp clock value */ +#define miClockFreq 0x0008 /* return number of clock ticks per second */ +#define midiInputPoll 0x00E101B2L /* MidiInputChannel - vector to poll MIDI input channel */ + +struct MiBufInfo { + Word bufSize; /* size of buffer (0 for default) */ + Pointer address; /* address of buffer (0 for auto-allocation) */ + }; +typedef struct MiBufInfo MiBufInfo; + +struct MiDriverInfo { + Word slot; /* device slot */ + Word external; /* slot internal (=0) / external (=1) */ + Byte pathname[65]; /* device driver pathname */ + }; +typedef struct MiDriverInfo MiDriverInfo, *MiDriverInfoPtr; + +extern pascal void MidiBootInit(void) inline(0x0120,dispatcher); +extern pascal void MidiStartUp(Word, Word) inline(0x0220,dispatcher); +extern pascal void MidiShutDown(void) inline(0x0320,dispatcher); +extern pascal Word MidiVersion(void) inline(0x0420,dispatcher); +extern pascal void MidiReset(void) inline(0x0520,dispatcher); +extern pascal Boolean MidiStatus(void) inline(0x0620,dispatcher); +extern pascal void MidiClock(Word, Long) inline(0x0B20,dispatcher); +extern pascal void MidiControl(Word, Long) inline(0x0920,dispatcher); +extern pascal void MidiDevice(Word, Pointer) inline(0x0A20,dispatcher); +extern pascal LongWord MidiInfo(Word) inline(0x0C20,dispatcher); +#define MidiInputPoll() asm {jsl 0xE101B2} /* Not a true tool call. Made through its own vector */ +extern pascal Word MidiReadPacket(Pointer, Word) inline(0x0D20,dispatcher); +extern pascal Word MidiWritePacket(Pointer) inline(0x0E20,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/midisynth.h b/bin/Libraries/ORCACDefs/midisynth.h index 23c96cd..0c8a360 100644 --- a/bin/Libraries/ORCACDefs/midisynth.h +++ b/bin/Libraries/ORCACDefs/midisynth.h @@ -1 +1,203 @@ -/******************************************** * * MIDI Synth Tool Set * * Copyright Apple Computer, Inc. 1991 * All Rights Reserved * * Copyright 1992, Byte Works, Inc * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __MIDISYNTH__ #define __MIDISYNTH__ /* Error Codes */ #define msAlreadyStarted 0x2301 /* MidiSynth already started */ #define msNotStarted 0x2302 /* MidiSynth never started */ #define msNoDPMem 0x2303 /* Can't get direct page memory */ #define msNoMemBlock 0x2304 /* Can't get memory block */ #define msNoMiscTool 0x2305 /* Misc Tools not started */ #define msNoSoundTool 0x2306 /* Sound Tools not started */ #define msGenInUse 0x2307 /* Ensoniq generator in use */ #define msBadPortNum 0x2308 /* Illegal port number */ #define msPortBusy 0x2309 /* Port is busy */ #define msParamRangeErr 0x230a /* Parameter range error */ #define msMsgQueueFull 0x230b /* Message queue full */ #define msRecBufFull 0x230c /* Rec buffer is full */ #define msOutputDisabled 0x230d /* MIDI output disabled */ #define msMessageError 0x230e /* Message error */ #define msOutputBufFull 0x230f /* MIDI output buffer is full */ #define msDriverNotStarted 0x2310 /* Driver not started */ #define msDriverAlreadySet 0x2311 /* Driver already set */ #define msDevNotAvail 0x2380 /* the requested device is not available */ #define msDevSlotBusy 0x2381 /* requested slot is already in use */ #define msDevBusy 0x2382 /* the requested device is already in use */ #define msDevOverrun 0x2383 /* device overrun by incoming MIDI data */ #define msDevNoConnect 0x2384 /* no connection to MIDI */ #define msDevReadErr 0x2385 /* framing error in received MIDI data */ #define msDevVersion 0x2386 /* ROM version is incompatible with device driver */ #define msDevIntHndlr 0x2387 /* conflicting interrupt handler is installed */ /* structure definitions */ typedef struct { byte reserved1[0x0c]; word MpacketStat; word MpacketData1; word MpacketData2; byte SeqClockFrac; long SeqClockInt; byte reserved2[0x31-0x16]; byte SeqItemStat; byte SeqItemData1; byte SeqItemData2; byte reserved3[0x3f-0x33]; byte MetroVol; byte reserved4[0xe4-0x3f]; word MetroFreq; byte reserved5[0xea-0xe5]; byte SeqItemTrack; byte reserved6; byte PacketBytes; byte reserved7[0x100-0xec]; } msDirectPage, *msDirectPagePtr, **msDirectPageHndl; typedef struct { msDirectPagePtr directPage; long reserved; } GetMSDataOutputRec, *GetMSDataOutputRecPtr, **GetMSDataOutputRecHndl; typedef struct { word measureNumber; word beatNumber; word msRemainder; } MeasureRec, *MeasureRecPtr, **MeasureRecHndl; typedef struct { ProcPtr EndSeq; ProcPtr UserMeter; ProcPtr Mstart; ProcPtr Mstop; ProcPtr PacketIn; ProcPtr SeqEvent; ProcPtr SysEx; ProcPtr PacketOut; ProcPtr PgmChange; ProcPtr Mcontinue; ProcPtr SMarker; ProcPtr RecBufFull; ProcPtr Reserved1; ProcPtr Reserved2; } CallBackRec, *CallBackRecPtr, **CallBackRecHndl; typedef struct { pointer PbufStart; long Reserved; pointer RbufStart; pointer RbufEnd; word SeqFlags; long theClock; } SeqPlayRec, *SeqPlayRecPtr, **SeqPlayRecHndl; typedef struct { byte AttackLevel; byte AttackRate; byte Decay1Level; byte Decay1Rate; byte Decay2Level; byte Decay2Rate; byte SustainLevel; byte Decay3Rate; byte Release1Level; byte Release1Rate; byte Release2Level; byte Release2Rate; byte Release3Rate; byte DecayGain; byte VelocityGain; byte PitchBendRange; } EnvelopeRec, *EnvelopeRecPtr, **EnvelopeRecHndl; typedef struct { byte TopKey; byte OscConfig; byte Stereo; byte Detune; byte WaveAddrA; byte WaveSizeA; byte VolumeA; byte OctaveA; byte SemitoneA; byte FineTuneA; byte WaveAddrB; byte WaveSizeB; byte VolumeB; byte OctaveB; byte SemitoneB; byte FineTuneB; } WavelistRec, *WavelistRecPtr, **WavelistRecHndl; typedef struct { EnvelopeRec gen1EnvRec; WavelistRec gen1WaveRecs[8]; EnvelopeRec gen2EnvRec; WavelistRec gen2WaveRecs[8]; } InstrumentRec, *InstrumentRecPtr, **InstrumentRecHndl; typedef struct { byte TrackNum; byte TimeStampHigh; byte TimeStampLow; byte TimeStampMid; byte DataByteCount; byte MIDIStat; byte DataByte1; byte DataByte2; } SeqItemRec, *SeqItemRecPtr, **SeqItemRecHndl; /* available calls */ extern pascal void MSBootInit(void) inline(0x0123,dispatcher); extern pascal void MSStartUp(void) inline(0x0223,dispatcher); extern pascal void MSShutDown(void) inline(0x0323,dispatcher); extern pascal word MSVersion(void) inline(0x0423,dispatcher); extern pascal void MSReset(void) inline(0x0523,dispatcher); extern pascal word MSStatus(void) inline(0x0623,dispatcher); extern pascal MeasureRec ConvertToMeasure(Word, Word, Long); extern pascal long ConvertToTime(Word, Word, Word, Word) inline(0x2023,dispatcher); extern pascal void DeleteTrack(Word, Ptr) inline(0x1d23,dispatcher); extern void GetMSData(long *reserved, long *DP); extern pascal void GetTuningTable(Ptr) inline(0x2523,dispatcher); extern pascal void InitMIDIDriver(Word, Word, Word, ProcPtr) inline(0x2723,dispatcher); extern pascal void KillAllNotes(void) inline(0x0d23,dispatcher); extern pascal SeqItemRecPtr Locate(Long, Ptr) inline(0x1123,dispatcher); extern pascal pointer LocateEnd(Ptr) inline(0x1b23,dispatcher); extern pascal void Merge(Ptr, Ptr) inline(0x1c23,dispatcher); extern pascal void MIDIMessage(Word, Word, Word, Word, Word) inline(0x1a23,dispatcher); extern pascal void MSResume(void) inline(0x2323,dispatcher); extern pascal void MSSuspend(void) inline(0x2223,dispatcher); extern pascal void PlayNote(Word, Word, Word) inline(0x0b23,dispatcher); extern pascal void RemoveMIDIDriver(void) inline(0x2823,dispatcher); extern pascal void SeqPlayer(SeqPlayRecPtr) inline(0x1523,dispatcher); extern pascal void SetBasicChan(Word) inline(0x0923,dispatcher); extern pascal void SetBasicChannel(Word) inline(0x0923,dispatcher); extern pascal void SetBeat(Word) inline(0x1923,dispatcher); extern pascal void SetCallBack(CallBackRecPtr) inline(0x1723,dispatcher); extern pascal void SetInstrument(InstrumentRecPtr, Word) inline(0x1423,dispatcher); extern pascal void SetMetro(Word, Word, Ptr) inline(0x1e23,dispatcher); extern pascal void SetMIDIMode(Word) inline(0x0a23,dispatcher); extern pascal void SetMIDIPort(Boolean, Boolean) inline(0x1323,dispatcher); extern pascal void SetPlayTrack(Word, Boolean) inline(0x0f23,dispatcher); extern pascal void SetRecTrack(Word) inline(0x0e23,dispatcher); extern pascal void SetTempo(Word) inline(0x1623,dispatcher); extern pascal void SetTrackOut(Word, Word) inline(0x2623,dispatcher); extern pascal void SetTuningTable(Ptr) inline(0x2423,dispatcher); extern pascal void SetVelComp(Word) inline(0x1223,dispatcher); extern pascal void StopNote(Word, Word) inline(0x0c23,dispatcher); extern pascal void SysExOut(Ptr, Word, ProcPtr) inline(0x1823,dispatcher); extern pascal void TrackToChannel(Word, Word) inline(0x1023,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* MIDI Synth Tool Set +* +* Copyright Apple Computer, Inc. 1991 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __MIDISYNTH__ +#define __MIDISYNTH__ + +/* Error Codes */ +#define msAlreadyStarted 0x2301 /* MidiSynth already started */ +#define msNotStarted 0x2302 /* MidiSynth never started */ +#define msNoDPMem 0x2303 /* Can't get direct page memory */ +#define msNoMemBlock 0x2304 /* Can't get memory block */ +#define msNoMiscTool 0x2305 /* Misc Tools not started */ +#define msNoSoundTool 0x2306 /* Sound Tools not started */ +#define msGenInUse 0x2307 /* Ensoniq generator in use */ +#define msBadPortNum 0x2308 /* Illegal port number */ +#define msPortBusy 0x2309 /* Port is busy */ +#define msParamRangeErr 0x230a /* Parameter range error */ +#define msMsgQueueFull 0x230b /* Message queue full */ +#define msRecBufFull 0x230c /* Rec buffer is full */ +#define msOutputDisabled 0x230d /* MIDI output disabled */ +#define msMessageError 0x230e /* Message error */ +#define msOutputBufFull 0x230f /* MIDI output buffer is full */ +#define msDriverNotStarted 0x2310 /* Driver not started */ +#define msDriverAlreadySet 0x2311 /* Driver already set */ +#define msDevNotAvail 0x2380 /* the requested device is not available */ +#define msDevSlotBusy 0x2381 /* requested slot is already in use */ +#define msDevBusy 0x2382 /* the requested device is already in use */ +#define msDevOverrun 0x2383 /* device overrun by incoming MIDI data */ +#define msDevNoConnect 0x2384 /* no connection to MIDI */ +#define msDevReadErr 0x2385 /* framing error in received MIDI data */ +#define msDevVersion 0x2386 /* ROM version is incompatible with device driver */ +#define msDevIntHndlr 0x2387 /* conflicting interrupt handler is installed */ + +/* structure definitions */ +typedef struct { + byte reserved1[0x0c]; + word MpacketStat; + word MpacketData1; + word MpacketData2; + byte SeqClockFrac; + long SeqClockInt; + byte reserved2[0x31-0x16]; + byte SeqItemStat; + byte SeqItemData1; + byte SeqItemData2; + byte reserved3[0x3f-0x33]; + byte MetroVol; + byte reserved4[0xe4-0x3f]; + word MetroFreq; + byte reserved5[0xea-0xe5]; + byte SeqItemTrack; + byte reserved6; + byte PacketBytes; + byte reserved7[0x100-0xec]; + } msDirectPage, *msDirectPagePtr, **msDirectPageHndl; + +typedef struct { + msDirectPagePtr directPage; + long reserved; + } GetMSDataOutputRec, *GetMSDataOutputRecPtr, **GetMSDataOutputRecHndl; + +typedef struct { + word measureNumber; + word beatNumber; + word msRemainder; + } MeasureRec, *MeasureRecPtr, **MeasureRecHndl; + +typedef struct { + ProcPtr EndSeq; + ProcPtr UserMeter; + ProcPtr Mstart; + ProcPtr Mstop; + ProcPtr PacketIn; + ProcPtr SeqEvent; + ProcPtr SysEx; + ProcPtr PacketOut; + ProcPtr PgmChange; + ProcPtr Mcontinue; + ProcPtr SMarker; + ProcPtr RecBufFull; + ProcPtr Reserved1; + ProcPtr Reserved2; + } CallBackRec, *CallBackRecPtr, **CallBackRecHndl; + +typedef struct { + pointer PbufStart; + long Reserved; + pointer RbufStart; + pointer RbufEnd; + word SeqFlags; + long theClock; + } SeqPlayRec, *SeqPlayRecPtr, **SeqPlayRecHndl; + +typedef struct { + byte AttackLevel; + byte AttackRate; + byte Decay1Level; + byte Decay1Rate; + byte Decay2Level; + byte Decay2Rate; + byte SustainLevel; + byte Decay3Rate; + byte Release1Level; + byte Release1Rate; + byte Release2Level; + byte Release2Rate; + byte Release3Rate; + byte DecayGain; + byte VelocityGain; + byte PitchBendRange; + } EnvelopeRec, *EnvelopeRecPtr, **EnvelopeRecHndl; + +typedef struct { + byte TopKey; + byte OscConfig; + byte Stereo; + byte Detune; + byte WaveAddrA; + byte WaveSizeA; + byte VolumeA; + byte OctaveA; + byte SemitoneA; + byte FineTuneA; + byte WaveAddrB; + byte WaveSizeB; + byte VolumeB; + byte OctaveB; + byte SemitoneB; + byte FineTuneB; + } WavelistRec, *WavelistRecPtr, **WavelistRecHndl; + +typedef struct { + EnvelopeRec gen1EnvRec; + WavelistRec gen1WaveRecs[8]; + EnvelopeRec gen2EnvRec; + WavelistRec gen2WaveRecs[8]; + } InstrumentRec, *InstrumentRecPtr, **InstrumentRecHndl; + +typedef struct { + byte TrackNum; + byte TimeStampHigh; + byte TimeStampLow; + byte TimeStampMid; + byte DataByteCount; + byte MIDIStat; + byte DataByte1; + byte DataByte2; + } SeqItemRec, *SeqItemRecPtr, **SeqItemRecHndl; + +/* available calls */ +extern pascal void MSBootInit(void) inline(0x0123,dispatcher); +extern pascal void MSStartUp(void) inline(0x0223,dispatcher); +extern pascal void MSShutDown(void) inline(0x0323,dispatcher); +extern pascal word MSVersion(void) inline(0x0423,dispatcher); +extern pascal void MSReset(void) inline(0x0523,dispatcher); +extern pascal word MSStatus(void) inline(0x0623,dispatcher); +extern pascal MeasureRec ConvertToMeasure(Word, Word, Long); +extern pascal long ConvertToTime(Word, Word, Word, Word) inline(0x2023,dispatcher); +extern pascal void DeleteTrack(Word, Ptr) inline(0x1d23,dispatcher); +extern void GetMSData(long *reserved, long *DP); +extern pascal void GetTuningTable(Ptr) inline(0x2523,dispatcher); +extern pascal void InitMIDIDriver(Word, Word, Word, ProcPtr) inline(0x2723,dispatcher); +extern pascal void KillAllNotes(void) inline(0x0d23,dispatcher); +extern pascal SeqItemRecPtr Locate(Long, Ptr) inline(0x1123,dispatcher); +extern pascal pointer LocateEnd(Ptr) inline(0x1b23,dispatcher); +extern pascal void Merge(Ptr, Ptr) inline(0x1c23,dispatcher); +extern pascal void MIDIMessage(Word, Word, Word, Word, Word) inline(0x1a23,dispatcher); +extern pascal void MSResume(void) inline(0x2323,dispatcher); +extern pascal void MSSuspend(void) inline(0x2223,dispatcher); +extern pascal void PlayNote(Word, Word, Word) inline(0x0b23,dispatcher); +extern pascal void RemoveMIDIDriver(void) inline(0x2823,dispatcher); +extern pascal void SeqPlayer(SeqPlayRecPtr) inline(0x1523,dispatcher); +extern pascal void SetBasicChan(Word) inline(0x0923,dispatcher); +extern pascal void SetBasicChannel(Word) inline(0x0923,dispatcher); +extern pascal void SetBeat(Word) inline(0x1923,dispatcher); +extern pascal void SetCallBack(CallBackRecPtr) inline(0x1723,dispatcher); +extern pascal void SetInstrument(InstrumentRecPtr, Word) inline(0x1423,dispatcher); +extern pascal void SetMetro(Word, Word, Ptr) inline(0x1e23,dispatcher); +extern pascal void SetMIDIMode(Word) inline(0x0a23,dispatcher); +extern pascal void SetMIDIPort(Boolean, Boolean) inline(0x1323,dispatcher); +extern pascal void SetPlayTrack(Word, Boolean) inline(0x0f23,dispatcher); +extern pascal void SetRecTrack(Word) inline(0x0e23,dispatcher); +extern pascal void SetTempo(Word) inline(0x1623,dispatcher); +extern pascal void SetTrackOut(Word, Word) inline(0x2623,dispatcher); +extern pascal void SetTuningTable(Ptr) inline(0x2423,dispatcher); +extern pascal void SetVelComp(Word) inline(0x1223,dispatcher); +extern pascal void StopNote(Word, Word) inline(0x0c23,dispatcher); +extern pascal void SysExOut(Ptr, Word, ProcPtr) inline(0x1823,dispatcher); +extern pascal void TrackToChannel(Word, Word) inline(0x1023,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/misctool.h b/bin/Libraries/ORCACDefs/misctool.h index 1eaee35..98757fd 100644 --- a/bin/Libraries/ORCACDefs/misctool.h +++ b/bin/Libraries/ORCACDefs/misctool.h @@ -1 +1,412 @@ -/******************************************** * * Miscelaneous Tool Set * * Copyright Apple Computer, Inc.1986-92 * All Rights Reserved * * Copyright 1992, 1993, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __MISCTOOL__ #define __MISCTOOL__ /* Error codes */ #define badInputErr 0x0301 /* bad input parameter */ #define noDevParamErr 0x0302 /* no device for input parameter */ #define taskInstlErr 0x0303 /* task already installed error */ #define noSigTaskErr 0x0304 /* no signature in task header */ #define queueDmgdErr 0x0305 /* queue has been damaged error */ #define taskNtFdErr 0x0306 /* task was not found error */ #define firmTaskErr 0x0307 /* firmware task was unsuccessful */ #define hbQueueBadErr 0x0308 /* heartbeat queue damaged */ #define unCnctdDevErr 0x0309 /* attempted to dispatch to unconnected device */ #define idTagNtAvlErr 0x030B /* ID tag not available */ #define notInList 0x0380 #define invalidTag 0x0381 /* correct signature value not found in header */ #define alreadyInQueue 0x0382 #define badTimeVerb 0x0390 #define badTimeData 0x0391 /* System Fail Codes */ #define pdosUnClmdIntErr 0x0001 /* ProDOS unclaimed interrupt error */ #define divByZeroErr 0x0004 /* divide by zero error */ #define pdosVCBErr 0x000A /* ProDOS VCB unusable */ #define pdosFCBErr 0x000B /* ProDOS FCB unusable */ #define pdosBlk0Err 0x000C /* ProDOS block zero allocated illegally */ #define pdosIntShdwErr 0x000D /* ProDOS interrupt w/ shadowing off */ #define stupVolMntErr 0x0100 /* can't mount system startup volume */ /* Battery Ram Parameter Reference Numbers */ #define p1PrntModem 0x0000 #define p1LineLnth 0x0001 #define p1DelLine 0x0002 #define p1AddLine 0x0003 #define p1Echo 0x0004 #define p1Buffer 0x0005 #define p1Baud 0x0006 #define p1DtStpBits 0x0007 #define p1Parity 0x0008 #define p1DCDHndShk 0x0009 #define p1DSRHndShk 0x000A #define p1XnfHndShk 0x000B #define p2PrntModem 0x000C #define p2LineLnth 0x000D #define p2DelLine 0x000E #define p2AddLine 0x000F #define p2Echo 0x0010 #define p2Buffer 0x0011 #define p2Baud 0x0012 #define p2DtStpBits 0x0013 #define p2Parity 0x0014 #define p2DCDHndShk 0x0015 #define p2DSRHndShk 0x0016 #define p2XnfHndShk 0x0017 #define dspColMono 0x0018 #define dsp40or80 0x0019 #define dspTxtColor 0x001A #define dspBckColor 0x001B #define dspBrdColor 0x001C #define hrtz50or60 0x001D #define userVolume 0x001E #define bellVolume 0x001F #define sysSpeed 0x0020 #define slt1intExt 0x0021 #define slt2intExt 0x0022 #define slt3intExt 0x0023 #define slt4intExt 0x0024 #define slt5intExt 0x0025 #define slt6intExt 0x0026 #define slt7intExt 0x0027 #define startupSlt 0x0028 #define txtDspLang 0x0029 #define kyBdLang 0x002A #define kyBdBuffer 0x002B #define kyBdRepSpd 0x002C #define kyBdRepDel 0x002D #define dblClkTime 0x002E #define flashRate 0x002F #define shftCpsLCas 0x0030 #define fstSpDelKey 0x0031 #define dualSpeed 0x0032 #define hiMouseRes 0x0033 #define dateFormat 0x0034 #define clockFormat 0x0035 #define rdMinRam 0x0036 #define rdMaxRam 0x0037 #define langCount 0x0038 #define lang1 0x0039 #define lang2 0x003A #define lang3 0x003B #define lang4 0x003C #define lang5 0x003D #define lang6 0x003E #define lang7 0x003F #define lang8 0x0040 #define layoutCount 0x0041 #define layout1 0x0042 #define layout2 0x0043 #define layout3 0x0044 #define layout4 0x0045 #define layout5 0x0046 #define layout6 0x0047 #define layout7 0x0048 #define layout8 0x0049 #define layout9 0x004A #define layout10 0x004B #define layout11 0x004C #define layout12 0x004D #define layout13 0x004E #define layout14 0x004F #define layout15 0x0050 #define layout16 0x0051 #define aTalkNodeNo 0x0080 /* GetAddr Parameter Reference Numbers */ #define irqIntFlag 0x0000 #define irqDataReg 0x0001 #define irqSerial1 0x0002 #define irqSerial2 0x0003 #define irqAplTlkHi 0x0004 #define tickCnt 0x0005 #define irqVolume 0x0006 #define irqActive 0x0007 #define irqSndData 0x0008 #define brkVar 0x0009 #define evMgrData 0x000A #define mouseSlot 0x000B #define mouseClamps 0x000C #define absClamps 0x000D #define sccIntFlag 0x000E /* Hardware Interrupt Status Numbers; these are returned by GetIRQEnable */ #define extVGCInt 0x01 #define scanLineInt 0x02 #define adbDataInt 0x04 #define ADTBDataInt 0x04 /* maintained for compatiblity with old interfaces */ #define oneSecInt 0x10 #define quartSecInt 0x20 #define vbInt 0x40 #define kbdInt 0x80 /* Interrupt Reference Numbers; these are parameters to IntSource */ #define kybdEnable 0x0000 #define kybdDisable 0x0001 #define vblEnable 0x0002 #define vblDisable 0x0003 #define qSecEnable 0x0004 #define qSecDisable 0x0005 #define oSecEnable 0x0006 #define oSecDisable 0x0007 #define adbEnable 0x000A #define adbDisable 0x000B #define scLnEnable 0x000C #define scLnDisable 0x000D #define exVCGEnable 0x000E #define exVCGDisable 0x000F /* Mouse Mode Values */ #define mouseOff 0x0000 #define transparent 0x0001 #define transParnt 0x0001 /* (old name) */ #define moveIntrpt 0x0003 #define bttnIntrpt 0x0005 #define bttnOrMove 0x0007 #define mouseOffVI 0x0008 #define transParntVI 0x0009 /* (old name) */ #define transparentVI 0x0009 #define moveIntrptVI 0x000B #define bttnIntrptVI 0x000D #define bttnOrMoveVI 0x000F /* Vector Reference Numbers */ #define toolLoc1 0x0000 #define toolLoc2 0x0001 #define usrTLoc1 0x0002 #define usrTLoc2 0x0003 #define intrptMgr 0x0004 #define copMgr 0x0005 #define abortMgr 0x0006 #define _sysFailMgr 0x0007 #define aTalkIntHnd 0x0008 #define sccIntHnd 0x0009 #define scLnIntHnd 0x000A #define sndIntHnd 0x000B #define vblIntHnd 0x000C #define mouseIntHnd 0x000D #define qSecIntHnd 0x000E #define kybdIntHnd 0x000F #define adbRBIHnd 0x0010 #define adbSRQHnd 0x0011 #define deskAccHnd 0x0012 #define flshBufHnd 0x0013 #define kybdMicHnd 0x0014 #define oneSecHnd 0x0015 #define extVCGHnd 0x0016 #define otherIntHnd 0x0017 #define crsrUpdtHnd 0x0018 #define incBsyFlag 0x0019 #define decBsyFlag 0x001A #define bellVector 0x001B #define breakVector 0x001C #define traceVector 0x001D #define stepVector 0x001E #define ctlYVector 0x0028 #define proDOSVector 0x002A #define proDOSVctr 0x002A /* for backward compatibility */ #define osVector 0x002B #define msgPtrVector 0x002C #define msgPtrVctr 0x002C /* for backward compatibility */ #define memMoverVector 0x0080 #define sysSpeedVector 0x0081 #define slotArbiterVector 0x0082 #define hiInterruptVector 0x0086 #define midiInterruptVector 0x0087 /* ConvSeconds verbs */ #define secs2TimeRec 0 #define TimeRec2Secs 1 #define secs2Text 2 #define secs2ProDOS 4 #define ProDOS2Secs 5 #define getCurrTimeInSecs 6 #define setCurrTimeInSecs 7 #define ProDOS2TimeRec 8 #define TimeRec2ProDOS 9 #define secs2HCard 10 #define HCard2Secs 11 /* SysBeep2 constants */ #define sbSilence 0x8000 #define sbDefer 0x4000 #define sbAlertStage0 0x0000 #define sbAlertStage1 0x0001 #define sbAlertStage2 0x0002 #define sbAlertStage3 0x0003 #define sbOutsideWindow 0x0004 #define sbOperationComplete 0x0005 #define sbBadKeypress 0x0008 #define sbBadInputValue 0x0009 #define sbInputFieldFull 0x000A #define sbOperationImpossible 0x000B #define sbOperationFailed 0x000C #define sbGSOStoP8 0x0011 #define sbP8toGSOS 0x0012 #define sbDiskInserted 0x0013 #define sbDiskEjected 0x0014 #define sbSystemShutdown 0x0015 #define sbDiskRequest 0x0030 #define sbSystemStartup 0x0031 #define sbSystemRestart 0x0032 #define sbBadDisk 0x0033 #define sbKeyClick 0x0034 #define sbReturnKey 0x0035 #define sbSpaceKey 0x0036 #define sbWhooshOpen 0x0040 #define sbWhooshClosed 0x0041 #define sbFillTrash 0x0042 #define sbEmptyTrash 0x0043 #define sbAlertWindow 0x0050 #define sbAlertStop 0x0052 #define sbAlertNote 0x0053 #define sbAlertCaution 0x0054 #define sbScreenBlanking 0x0060 #define sbScreenUnblanking 0x0061 #define sbYouHaveMail 0x0100 #define sbErrorWindowBase 0x0E00 /* uses $0Exx */ #define sbErrorWindowOther 0x0EFF /* StringToText constants */ #define fAllowMouseText 0x8000 #define fAllowLongerSubs 0x4000 #define fForceLanguage 0x2000 #define fPassThru 0x1000 struct ClampRec { Word yMaxClamp; Word yMinClamp; Word xMaxClamp; Word xMinClamp; }; typedef struct ClampRec ClampRec, *ClampRecPtr, **ClampRecHndl; struct FWRec { Word yRegExit; Word xRegExit; Word aRegExit; Word status; }; typedef struct FWRec FWRec, *FWRecPtr, **FWRecHndl; struct MouseRec { Byte mouseMode; Byte mouseStatus; Word yPos; Word xPos; }; typedef struct MouseRec MouseRec, *MouseRecPtr, **MouseRecHndl; struct InterruptStateRec { Word irq_A; Word irq_X; Word irq_Y; Word irq_S; Word irq_D; Byte irq_P; Byte irq_DB; Byte irq_e; Byte irq_K; Word irq_PC; Byte irq_state; Word irq_shadow; Byte irq_mslot; }; typedef struct InterruptStateRec InterruptStateRec, *InterruptStateRecPtr, **InterruptStateRecHndl; struct QueueHeaderRec { struct QueueHeaderRec *qNext; Word reserved; Word signature; /* Validates header - must be $A55A */ }; typedef struct QueueHeaderRec QueueHeaderRec, *QueueHeaderRecPtr; struct HexTime { byte second; byte minute; byte hour; byte curYear; byte day; byte month; }; typedef struct HexTime HexTime; extern pascal void MTBootInit(void) inline(0x0103,dispatcher); extern pascal void MTStartUp(void) inline(0x0203,dispatcher); extern pascal void MTShutDown(void) inline(0x0303,dispatcher); extern pascal Word MTVersion(void) inline(0x0403,dispatcher); extern pascal void MTReset(void) inline(0x0503,dispatcher); extern pascal Boolean MTStatus(void) inline(0x0603,dispatcher); extern pascal void WriteBRam(Pointer) inline(0x0903,dispatcher); extern pascal void ReadBRam(Pointer) inline(0x0A03,dispatcher); extern pascal void WriteBParam(Word, Word) inline(0x0B03,dispatcher); extern pascal Word ReadBParam(Word) inline(0x0C03,dispatcher); extern TimeRec ReadTimeHex(void); extern pascal void WriteTimeHex(HexTime) inline(0x0E03,dispatcher); extern pascal void ReadAsciiTime(Pointer) inline(0x0F03,dispatcher); extern FWRec FWEntry(Word, Word, Word, Word); extern pascal Pointer GetAddr(Word) inline(0x1603,dispatcher); extern pascal LongWord GetTick(void) inline(0x2503,dispatcher); extern pascal Word GetIRQEnable(void) inline(0x2903,dispatcher); extern pascal void IntSource(Word) inline(0x2303,dispatcher); extern pascal void ClampMouse(Word, Word, Word, Word) inline(0x1C03,dispatcher); extern pascal void ClearMouse(void) inline(0x1B03,dispatcher); extern ClampRec GetMouseClamp(void); extern pascal void HomeMouse(void) inline(0x1A03,dispatcher); extern pascal void InitMouse(Word) inline(0x1803,dispatcher); extern pascal void PosMouse(Integer, Integer) inline(0x1E03,dispatcher); extern MouseRec ReadMouse(void); extern pascal Word ServeMouse(void) inline(0x1F03,dispatcher); extern pascal void SetMouse(Word) inline(0x1903,dispatcher); extern pascal void SetAbsClamp(Word, Word, Word, Word) inline (0x2A03,dispatcher); extern ClampRec GetAbsClamp(void); extern pascal Word PackBytes(Handle, Word *, Pointer, Word) inline(0x2603,dispatcher); extern pascal Word UnPackBytes(Pointer, Word, Handle, Word *) inline(0x2703,dispatcher); extern pascal Word Munger(Handle, Word *, Pointer, Word, Pointer, Word, Pointer) inline(0x2803,dispatcher); extern pascal void SetHeartBeat(Pointer) inline(0x1203,dispatcher); extern pascal void DelHeartBeat(Pointer) inline(0x1303,dispatcher); extern pascal void ClrHeartBeat(void) inline(0x1403,dispatcher); extern pascal void SysBeep(void) inline(0x2C03,dispatcher); extern pascal void SysFailMgr(Word, Pointer) inline(0x1503,dispatcher); extern pascal Word GetNewID(Word) inline(0x2003,dispatcher); extern pascal void DeleteID(Word) inline(0x2103,dispatcher); extern pascal void StatusID(Word) inline(0x2203,dispatcher); extern pascal void SetVector(Word, Pointer) inline(0x1003,dispatcher); extern pascal Pointer GetVector(Word) inline(0x1103,dispatcher); extern pascal void AddToQueue(Pointer, Pointer) inline(0x2E03,dispatcher); extern pascal void DeleteFromQueue(Pointer, Pointer) inline(0x2F03,dispatcher); extern pascal ProcPtr GetCodeResConverter(void) inline(0x3403,dispatcher); extern pascal void GetInterruptState(Pointer, Word) inline(0x3103,dispatcher); extern pascal Word GetIntStateRecSize(void) inline(0x3203,dispatcher); /* extern pascal Pointer GetRomResource() inline(0x3503,dispatcher); */ extern MouseRec ReadMouse2(void); /* extern pascal void ReleaseROMResource() inline(0x3603,dispatcher); */ extern pascal void SetInterruptState(Pointer, Word) inline(0x3003,dispatcher); extern pascal LongWord ConvSeconds(Word, Long, Pointer) inline(0x3703,dispatcher); extern pascal Word ScanDevices(void) inline(0x3D03,dispatcher); extern pascal void ShowBootInfo(Pointer, Pointer) inline(0x3C03,dispatcher); extern pascal LongWord StringToText(Word, Ptr, Word, Ptr) inline(0x3B03,dispatcher); extern pascal void SysBeep2(Word) inline(0x3803,dispatcher); extern pascal void VersionString(Word, Long, Ptr) inline(0x3903,dispatcher); extern pascal Word WaitUntil(Word, Word) inline(0x3A03,dispatcher); extern pascal Word AlertMessage(Ptr, Word, Ptr) inline(0x3E03,dispatcher); extern pascal Word DoSysPrefs(Word, Word) inline(0x3F03,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Miscelaneous Tool Set +* +* Copyright Apple Computer, Inc.1986-92 +* All Rights Reserved +* +* Copyright 1992, 1993, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __MISCTOOL__ +#define __MISCTOOL__ + +/* Error codes */ +#define badInputErr 0x0301 /* bad input parameter */ +#define noDevParamErr 0x0302 /* no device for input parameter */ +#define taskInstlErr 0x0303 /* task already installed error */ +#define noSigTaskErr 0x0304 /* no signature in task header */ +#define queueDmgdErr 0x0305 /* queue has been damaged error */ +#define taskNtFdErr 0x0306 /* task was not found error */ +#define firmTaskErr 0x0307 /* firmware task was unsuccessful */ +#define hbQueueBadErr 0x0308 /* heartbeat queue damaged */ +#define unCnctdDevErr 0x0309 /* attempted to dispatch to unconnected device */ +#define idTagNtAvlErr 0x030B /* ID tag not available */ +#define notInList 0x0380 +#define invalidTag 0x0381 /* correct signature value not found in header */ +#define alreadyInQueue 0x0382 +#define badTimeVerb 0x0390 +#define badTimeData 0x0391 + +/* System Fail Codes */ +#define pdosUnClmdIntErr 0x0001 /* ProDOS unclaimed interrupt error */ +#define divByZeroErr 0x0004 /* divide by zero error */ +#define pdosVCBErr 0x000A /* ProDOS VCB unusable */ +#define pdosFCBErr 0x000B /* ProDOS FCB unusable */ +#define pdosBlk0Err 0x000C /* ProDOS block zero allocated illegally */ +#define pdosIntShdwErr 0x000D /* ProDOS interrupt w/ shadowing off */ +#define stupVolMntErr 0x0100 /* can't mount system startup volume */ + +/* Battery Ram Parameter Reference Numbers */ +#define p1PrntModem 0x0000 +#define p1LineLnth 0x0001 +#define p1DelLine 0x0002 +#define p1AddLine 0x0003 +#define p1Echo 0x0004 +#define p1Buffer 0x0005 +#define p1Baud 0x0006 +#define p1DtStpBits 0x0007 +#define p1Parity 0x0008 +#define p1DCDHndShk 0x0009 +#define p1DSRHndShk 0x000A +#define p1XnfHndShk 0x000B +#define p2PrntModem 0x000C +#define p2LineLnth 0x000D +#define p2DelLine 0x000E +#define p2AddLine 0x000F +#define p2Echo 0x0010 +#define p2Buffer 0x0011 +#define p2Baud 0x0012 +#define p2DtStpBits 0x0013 +#define p2Parity 0x0014 +#define p2DCDHndShk 0x0015 +#define p2DSRHndShk 0x0016 +#define p2XnfHndShk 0x0017 +#define dspColMono 0x0018 +#define dsp40or80 0x0019 +#define dspTxtColor 0x001A +#define dspBckColor 0x001B +#define dspBrdColor 0x001C +#define hrtz50or60 0x001D +#define userVolume 0x001E +#define bellVolume 0x001F +#define sysSpeed 0x0020 +#define slt1intExt 0x0021 +#define slt2intExt 0x0022 +#define slt3intExt 0x0023 +#define slt4intExt 0x0024 +#define slt5intExt 0x0025 +#define slt6intExt 0x0026 +#define slt7intExt 0x0027 +#define startupSlt 0x0028 +#define txtDspLang 0x0029 +#define kyBdLang 0x002A +#define kyBdBuffer 0x002B +#define kyBdRepSpd 0x002C +#define kyBdRepDel 0x002D +#define dblClkTime 0x002E +#define flashRate 0x002F +#define shftCpsLCas 0x0030 +#define fstSpDelKey 0x0031 +#define dualSpeed 0x0032 +#define hiMouseRes 0x0033 +#define dateFormat 0x0034 +#define clockFormat 0x0035 +#define rdMinRam 0x0036 +#define rdMaxRam 0x0037 +#define langCount 0x0038 +#define lang1 0x0039 +#define lang2 0x003A +#define lang3 0x003B +#define lang4 0x003C +#define lang5 0x003D +#define lang6 0x003E +#define lang7 0x003F +#define lang8 0x0040 +#define layoutCount 0x0041 +#define layout1 0x0042 +#define layout2 0x0043 +#define layout3 0x0044 +#define layout4 0x0045 +#define layout5 0x0046 +#define layout6 0x0047 +#define layout7 0x0048 +#define layout8 0x0049 +#define layout9 0x004A +#define layout10 0x004B +#define layout11 0x004C +#define layout12 0x004D +#define layout13 0x004E +#define layout14 0x004F +#define layout15 0x0050 +#define layout16 0x0051 +#define aTalkNodeNo 0x0080 + +/* GetAddr Parameter Reference Numbers */ +#define irqIntFlag 0x0000 +#define irqDataReg 0x0001 +#define irqSerial1 0x0002 +#define irqSerial2 0x0003 +#define irqAplTlkHi 0x0004 +#define tickCnt 0x0005 +#define irqVolume 0x0006 +#define irqActive 0x0007 +#define irqSndData 0x0008 +#define brkVar 0x0009 +#define evMgrData 0x000A +#define mouseSlot 0x000B +#define mouseClamps 0x000C +#define absClamps 0x000D +#define sccIntFlag 0x000E + +/* Hardware Interrupt Status Numbers; these are returned by GetIRQEnable */ +#define extVGCInt 0x01 +#define scanLineInt 0x02 +#define adbDataInt 0x04 +#define ADTBDataInt 0x04 /* maintained for compatiblity with old interfaces */ +#define oneSecInt 0x10 +#define quartSecInt 0x20 +#define vbInt 0x40 +#define kbdInt 0x80 + +/* Interrupt Reference Numbers; these are parameters to IntSource */ +#define kybdEnable 0x0000 +#define kybdDisable 0x0001 +#define vblEnable 0x0002 +#define vblDisable 0x0003 +#define qSecEnable 0x0004 +#define qSecDisable 0x0005 +#define oSecEnable 0x0006 +#define oSecDisable 0x0007 +#define adbEnable 0x000A +#define adbDisable 0x000B +#define scLnEnable 0x000C +#define scLnDisable 0x000D +#define exVCGEnable 0x000E +#define exVCGDisable 0x000F + +/* Mouse Mode Values */ +#define mouseOff 0x0000 +#define transparent 0x0001 +#define transParnt 0x0001 /* (old name) */ +#define moveIntrpt 0x0003 +#define bttnIntrpt 0x0005 +#define bttnOrMove 0x0007 +#define mouseOffVI 0x0008 +#define transParntVI 0x0009 /* (old name) */ +#define transparentVI 0x0009 +#define moveIntrptVI 0x000B +#define bttnIntrptVI 0x000D +#define bttnOrMoveVI 0x000F + +/* Vector Reference Numbers */ +#define toolLoc1 0x0000 +#define toolLoc2 0x0001 +#define usrTLoc1 0x0002 +#define usrTLoc2 0x0003 +#define intrptMgr 0x0004 +#define copMgr 0x0005 +#define abortMgr 0x0006 +#define _sysFailMgr 0x0007 +#define aTalkIntHnd 0x0008 +#define sccIntHnd 0x0009 +#define scLnIntHnd 0x000A +#define sndIntHnd 0x000B +#define vblIntHnd 0x000C +#define mouseIntHnd 0x000D +#define qSecIntHnd 0x000E +#define kybdIntHnd 0x000F +#define adbRBIHnd 0x0010 +#define adbSRQHnd 0x0011 +#define deskAccHnd 0x0012 +#define flshBufHnd 0x0013 +#define kybdMicHnd 0x0014 +#define oneSecHnd 0x0015 +#define extVCGHnd 0x0016 +#define otherIntHnd 0x0017 +#define crsrUpdtHnd 0x0018 +#define incBsyFlag 0x0019 +#define decBsyFlag 0x001A +#define bellVector 0x001B +#define breakVector 0x001C +#define traceVector 0x001D +#define stepVector 0x001E +#define ctlYVector 0x0028 +#define proDOSVector 0x002A +#define proDOSVctr 0x002A /* for backward compatibility */ +#define osVector 0x002B +#define msgPtrVector 0x002C +#define msgPtrVctr 0x002C /* for backward compatibility */ +#define memMoverVector 0x0080 +#define sysSpeedVector 0x0081 +#define slotArbiterVector 0x0082 +#define hiInterruptVector 0x0086 +#define midiInterruptVector 0x0087 + +/* ConvSeconds verbs */ +#define secs2TimeRec 0 +#define TimeRec2Secs 1 +#define secs2Text 2 +#define secs2ProDOS 4 +#define ProDOS2Secs 5 +#define getCurrTimeInSecs 6 +#define setCurrTimeInSecs 7 +#define ProDOS2TimeRec 8 +#define TimeRec2ProDOS 9 +#define secs2HCard 10 +#define HCard2Secs 11 + +/* SysBeep2 constants */ +#define sbSilence 0x8000 +#define sbDefer 0x4000 +#define sbAlertStage0 0x0000 +#define sbAlertStage1 0x0001 +#define sbAlertStage2 0x0002 +#define sbAlertStage3 0x0003 +#define sbOutsideWindow 0x0004 +#define sbOperationComplete 0x0005 +#define sbBadKeypress 0x0008 +#define sbBadInputValue 0x0009 +#define sbInputFieldFull 0x000A +#define sbOperationImpossible 0x000B +#define sbOperationFailed 0x000C +#define sbGSOStoP8 0x0011 +#define sbP8toGSOS 0x0012 +#define sbDiskInserted 0x0013 +#define sbDiskEjected 0x0014 +#define sbSystemShutdown 0x0015 +#define sbDiskRequest 0x0030 +#define sbSystemStartup 0x0031 +#define sbSystemRestart 0x0032 +#define sbBadDisk 0x0033 +#define sbKeyClick 0x0034 +#define sbReturnKey 0x0035 +#define sbSpaceKey 0x0036 +#define sbWhooshOpen 0x0040 +#define sbWhooshClosed 0x0041 +#define sbFillTrash 0x0042 +#define sbEmptyTrash 0x0043 +#define sbAlertWindow 0x0050 +#define sbAlertStop 0x0052 +#define sbAlertNote 0x0053 +#define sbAlertCaution 0x0054 +#define sbScreenBlanking 0x0060 +#define sbScreenUnblanking 0x0061 +#define sbYouHaveMail 0x0100 +#define sbErrorWindowBase 0x0E00 /* uses $0Exx */ +#define sbErrorWindowOther 0x0EFF + +/* StringToText constants */ +#define fAllowMouseText 0x8000 +#define fAllowLongerSubs 0x4000 +#define fForceLanguage 0x2000 +#define fPassThru 0x1000 + +struct ClampRec { + Word yMaxClamp; + Word yMinClamp; + Word xMaxClamp; + Word xMinClamp; + }; +typedef struct ClampRec ClampRec, *ClampRecPtr, **ClampRecHndl; + +struct FWRec { + Word yRegExit; + Word xRegExit; + Word aRegExit; + Word status; + }; +typedef struct FWRec FWRec, *FWRecPtr, **FWRecHndl; + +struct MouseRec { + Byte mouseMode; + Byte mouseStatus; + Word yPos; + Word xPos; + }; +typedef struct MouseRec MouseRec, *MouseRecPtr, **MouseRecHndl; + +struct InterruptStateRec { + Word irq_A; + Word irq_X; + Word irq_Y; + Word irq_S; + Word irq_D; + Byte irq_P; + Byte irq_DB; + Byte irq_e; + Byte irq_K; + Word irq_PC; + Byte irq_state; + Word irq_shadow; + Byte irq_mslot; + }; +typedef struct InterruptStateRec InterruptStateRec, *InterruptStateRecPtr, **InterruptStateRecHndl; + +struct QueueHeaderRec { + struct QueueHeaderRec *qNext; + Word reserved; + Word signature; /* Validates header - must be $A55A */ + }; +typedef struct QueueHeaderRec QueueHeaderRec, *QueueHeaderRecPtr; + +struct HexTime { + byte second; + byte minute; + byte hour; + byte curYear; + byte day; + byte month; + }; +typedef struct HexTime HexTime; + +extern pascal void MTBootInit(void) inline(0x0103,dispatcher); +extern pascal void MTStartUp(void) inline(0x0203,dispatcher); +extern pascal void MTShutDown(void) inline(0x0303,dispatcher); +extern pascal Word MTVersion(void) inline(0x0403,dispatcher); +extern pascal void MTReset(void) inline(0x0503,dispatcher); +extern pascal Boolean MTStatus(void) inline(0x0603,dispatcher); +extern pascal void WriteBRam(Pointer) inline(0x0903,dispatcher); +extern pascal void ReadBRam(Pointer) inline(0x0A03,dispatcher); +extern pascal void WriteBParam(Word, Word) inline(0x0B03,dispatcher); +extern pascal Word ReadBParam(Word) inline(0x0C03,dispatcher); +extern TimeRec ReadTimeHex(void); +extern pascal void WriteTimeHex(HexTime) inline(0x0E03,dispatcher); +extern pascal void ReadAsciiTime(Pointer) inline(0x0F03,dispatcher); +extern FWRec FWEntry(Word, Word, Word, Word); +extern pascal Pointer GetAddr(Word) inline(0x1603,dispatcher); +extern pascal LongWord GetTick(void) inline(0x2503,dispatcher); +extern pascal Word GetIRQEnable(void) inline(0x2903,dispatcher); +extern pascal void IntSource(Word) inline(0x2303,dispatcher); +extern pascal void ClampMouse(Word, Word, Word, Word) inline(0x1C03,dispatcher); +extern pascal void ClearMouse(void) inline(0x1B03,dispatcher); +extern ClampRec GetMouseClamp(void); +extern pascal void HomeMouse(void) inline(0x1A03,dispatcher); +extern pascal void InitMouse(Word) inline(0x1803,dispatcher); +extern pascal void PosMouse(Integer, Integer) inline(0x1E03,dispatcher); +extern MouseRec ReadMouse(void); +extern pascal Word ServeMouse(void) inline(0x1F03,dispatcher); +extern pascal void SetMouse(Word) inline(0x1903,dispatcher); +extern pascal void SetAbsClamp(Word, Word, Word, Word) inline (0x2A03,dispatcher); +extern ClampRec GetAbsClamp(void); +extern pascal Word PackBytes(Handle, Word *, Pointer, Word) inline(0x2603,dispatcher); +extern pascal Word UnPackBytes(Pointer, Word, Handle, Word *) inline(0x2703,dispatcher); +extern pascal Word Munger(Handle, Word *, Pointer, Word, Pointer, Word, Pointer) inline(0x2803,dispatcher); +extern pascal void SetHeartBeat(Pointer) inline(0x1203,dispatcher); +extern pascal void DelHeartBeat(Pointer) inline(0x1303,dispatcher); +extern pascal void ClrHeartBeat(void) inline(0x1403,dispatcher); +extern pascal void SysBeep(void) inline(0x2C03,dispatcher); +extern pascal void SysFailMgr(Word, Pointer) inline(0x1503,dispatcher); +extern pascal Word GetNewID(Word) inline(0x2003,dispatcher); +extern pascal void DeleteID(Word) inline(0x2103,dispatcher); +extern pascal void StatusID(Word) inline(0x2203,dispatcher); +extern pascal void SetVector(Word, Pointer) inline(0x1003,dispatcher); +extern pascal Pointer GetVector(Word) inline(0x1103,dispatcher); + +extern pascal void AddToQueue(Pointer, Pointer) inline(0x2E03,dispatcher); +extern pascal void DeleteFromQueue(Pointer, Pointer) inline(0x2F03,dispatcher); +extern pascal ProcPtr GetCodeResConverter(void) inline(0x3403,dispatcher); +extern pascal void GetInterruptState(Pointer, Word) inline(0x3103,dispatcher); +extern pascal Word GetIntStateRecSize(void) inline(0x3203,dispatcher); +/* extern pascal Pointer GetRomResource() inline(0x3503,dispatcher); */ +extern MouseRec ReadMouse2(void); +/* extern pascal void ReleaseROMResource() inline(0x3603,dispatcher); */ +extern pascal void SetInterruptState(Pointer, Word) inline(0x3003,dispatcher); + +extern pascal LongWord ConvSeconds(Word, Long, Pointer) inline(0x3703,dispatcher); +extern pascal Word ScanDevices(void) inline(0x3D03,dispatcher); +extern pascal void ShowBootInfo(Pointer, Pointer) inline(0x3C03,dispatcher); +extern pascal LongWord StringToText(Word, Ptr, Word, Ptr) inline(0x3B03,dispatcher); +extern pascal void SysBeep2(Word) inline(0x3803,dispatcher); +extern pascal void VersionString(Word, Long, Ptr) inline(0x3903,dispatcher); +extern pascal Word WaitUntil(Word, Word) inline(0x3A03,dispatcher); + +extern pascal Word AlertMessage(Ptr, Word, Ptr) inline(0x3E03,dispatcher); +extern pascal Word DoSysPrefs(Word, Word) inline(0x3F03,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/noteseq.h b/bin/Libraries/ORCACDefs/noteseq.h index de56cd9..7943f92 100644 --- a/bin/Libraries/ORCACDefs/noteseq.h +++ b/bin/Libraries/ORCACDefs/noteseq.h @@ -1 +1,94 @@ -/******************************************** * * Note Sequencer * * Copyright Apple Computer, Inc.1986-90 * All Rights Reserved * * Copyright 1992, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __NOTESEQ__ #define __NOTESEQ__ /* Commands */ #define pitchBend 0x0L #define tempo 0x00000001L #define turnNotesOff 0x00000002L #define jump 0x00000003L #define setVibratoDepth 0x00000004L #define programChange 0x00000005L #define setRegister 0x00000006L #define ifGo 0x00000007L #define incRegister 0x00000008L #define decRegister 0x00000009L #define midiNoteOff 0x0000000AL #define midiNoteOn 0x0000000BL #define midiPolyKey 0x0000000CL #define midiCtlChange 0x0000000DL #define midiProgChange 0x0000000EL #define midiChnlPress 0x0000000FL #define midiPitchBend 0x00000010L #define midiSelChnlMode 0x00000011L #define midiSysExclusive 0x00000012L #define midiSysCommon 0x00000013L #define midiSysRealTime 0x00000014L #define midiSetSysExl 0x00000015L #define callRoutine 0x0000001EL /* Mask Values */ #define commandMask 0x0000007FL #define volumeMask 0x0000007FL #define chord 0x00000080L #define val1Mask 0x00007F00L #define toneMask 0x00007F00L #define noteMask 0x00008000L #define lByte 0x00FF0000L /* meaning depends on midi command */ #define durationMask 0x07FF0000L #define trackMask 0x78000000L #define delayMask 0x80000000L #define hByte 0xFF000000L /* Error Codes */ #define noRoomMidiErr 0x1A00 #define noCommandErr 0x1A01 /* can't understand the current SeqItem */ #define noRoomErr 0x1A02 /* sequence is more than twelve levels deep */ #define startedErr 0x1A03 /* Note Sequencer is already started */ #define noNoteErr 0x1A04 /* can't find the note to be turned off by the current SeqItem */ #define noStartErr 0x1A05 /* Note Sequencer not started yet */ #define instBndsErr 0x1A06 /* Instrument number out of Instrument boundary range */ #define nsWrongVer 0x1A07 /* incompatible versions of NoteSequencer and NoteSynthesizer */ struct LocRec { Word curPhraseItem; Word curPattItem; Word curLevel; }; typedef struct LocRec LocRec, *LocRecPtr, **LocRecHndl; extern pascal void SeqBootInit(void) inline(0x011A,dispatcher); extern pascal void SeqStartUp(Word, Word, Word, Word) inline(0x021A,dispatcher); extern pascal void SeqShutDown(void) inline(0x031A,dispatcher); extern pascal Word SeqVersion(void) inline(0x041A,dispatcher); extern pascal void SeqReset(void) inline(0x051A,dispatcher); extern pascal Boolean SeqStatus(void) inline(0x061A,dispatcher); extern pascal Word ClearIncr(void) inline(0x0A1A,dispatcher); extern LocRec GetLoc(void); extern pascal Word GetTimer(void) inline(0x0B1A,dispatcher); extern pascal void SeqAllNotesOff(void) inline(0x0D1A,dispatcher); extern pascal void SetIncr(Word) inline(0x091A,dispatcher); extern pascal void SetInstTable(Handle) inline(0x121A,dispatcher); extern pascal void SetTrkInfo(Word, Word, Word) inline(0x0E1A,dispatcher); extern pascal void StartInts(void) inline(0x131A,dispatcher); extern pascal void StartSeq(Pointer, Pointer, Handle) inline(0x0F1A,dispatcher); extern pascal void StartSeqRel(Pointer, Pointer, Handle) inline(0x151A,dispatcher); extern pascal void StepSeq(void) inline(0x101A,dispatcher); extern pascal void StopInts(void) inline(0x141A,dispatcher); extern pascal void StopSeq(Boolean) inline(0x111A,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Note Sequencer +* +* Copyright Apple Computer, Inc.1986-90 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __NOTESEQ__ +#define __NOTESEQ__ + +/* Commands */ +#define pitchBend 0x0L +#define tempo 0x00000001L +#define turnNotesOff 0x00000002L +#define jump 0x00000003L +#define setVibratoDepth 0x00000004L +#define programChange 0x00000005L +#define setRegister 0x00000006L +#define ifGo 0x00000007L +#define incRegister 0x00000008L +#define decRegister 0x00000009L +#define midiNoteOff 0x0000000AL +#define midiNoteOn 0x0000000BL +#define midiPolyKey 0x0000000CL +#define midiCtlChange 0x0000000DL +#define midiProgChange 0x0000000EL +#define midiChnlPress 0x0000000FL +#define midiPitchBend 0x00000010L +#define midiSelChnlMode 0x00000011L +#define midiSysExclusive 0x00000012L +#define midiSysCommon 0x00000013L +#define midiSysRealTime 0x00000014L +#define midiSetSysExl 0x00000015L +#define callRoutine 0x0000001EL + +/* Mask Values */ +#define commandMask 0x0000007FL +#define volumeMask 0x0000007FL +#define chord 0x00000080L +#define val1Mask 0x00007F00L +#define toneMask 0x00007F00L +#define noteMask 0x00008000L +#define lByte 0x00FF0000L /* meaning depends on midi command */ +#define durationMask 0x07FF0000L +#define trackMask 0x78000000L +#define delayMask 0x80000000L +#define hByte 0xFF000000L + +/* Error Codes */ +#define noRoomMidiErr 0x1A00 +#define noCommandErr 0x1A01 /* can't understand the current SeqItem */ +#define noRoomErr 0x1A02 /* sequence is more than twelve levels deep */ +#define startedErr 0x1A03 /* Note Sequencer is already started */ +#define noNoteErr 0x1A04 /* can't find the note to be turned off by the current SeqItem */ +#define noStartErr 0x1A05 /* Note Sequencer not started yet */ +#define instBndsErr 0x1A06 /* Instrument number out of Instrument boundary range */ +#define nsWrongVer 0x1A07 /* incompatible versions of NoteSequencer and NoteSynthesizer */ + +struct LocRec { + Word curPhraseItem; + Word curPattItem; + Word curLevel; + }; +typedef struct LocRec LocRec, *LocRecPtr, **LocRecHndl; + +extern pascal void SeqBootInit(void) inline(0x011A,dispatcher); +extern pascal void SeqStartUp(Word, Word, Word, Word) inline(0x021A,dispatcher); +extern pascal void SeqShutDown(void) inline(0x031A,dispatcher); +extern pascal Word SeqVersion(void) inline(0x041A,dispatcher); +extern pascal void SeqReset(void) inline(0x051A,dispatcher); +extern pascal Boolean SeqStatus(void) inline(0x061A,dispatcher); +extern pascal Word ClearIncr(void) inline(0x0A1A,dispatcher); +extern LocRec GetLoc(void); +extern pascal Word GetTimer(void) inline(0x0B1A,dispatcher); +extern pascal void SeqAllNotesOff(void) inline(0x0D1A,dispatcher); +extern pascal void SetIncr(Word) inline(0x091A,dispatcher); +extern pascal void SetInstTable(Handle) inline(0x121A,dispatcher); +extern pascal void SetTrkInfo(Word, Word, Word) inline(0x0E1A,dispatcher); +extern pascal void StartInts(void) inline(0x131A,dispatcher); +extern pascal void StartSeq(Pointer, Pointer, Handle) inline(0x0F1A,dispatcher); +extern pascal void StartSeqRel(Pointer, Pointer, Handle) inline(0x151A,dispatcher); +extern pascal void StepSeq(void) inline(0x101A,dispatcher); +extern pascal void StopInts(void) inline(0x141A,dispatcher); +extern pascal void StopSeq(Boolean) inline(0x111A,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/notesyn.h b/bin/Libraries/ORCACDefs/notesyn.h index 4c0c487..def533d 100644 --- a/bin/Libraries/ORCACDefs/notesyn.h +++ b/bin/Libraries/ORCACDefs/notesyn.h @@ -1 +1,85 @@ -/******************************************** * * Note Synthesizer * * Copyright Apple Computer, Inc.1986-90 * All Rights Reserved * * Copyright 1992, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __NOTESYN__ #define __NOTESYN__ /* Error Codes */ #define nsAlreadyInit 0x1901 /* Note Syn already initialized */ #define nsSndNotInit 0x1902 /* Sound Tools not initialized */ #define nsNotAvail 0x1921 /* generator not available */ #define nsBadGenNum 0x1922 /* bad generator number */ #define nsNotInit 0x1923 /* Note Syn not initialized */ #define nsGenAlreadyOn 0x1924 /* generator already on */ #define soundWrongVer 0x1925 /* incompatible versions of Sound and NoteSyn */ struct Envelope { Byte st1BkPt; Word st1Increment; Byte st2BkPt; Word st2Increment; Byte st3BkPt; Word st3Increment; Byte st4BkPt; Word st4Increment; Byte st5BkPt; Word st5Increment; Byte st6BkPt; Word st6Increment; Byte st7BkPt; Word st7Increment; Byte st8BkPt; Word st8Increment; }; typedef struct Envelope Envelope, *EnvelopePtr, **EnvelopeHndl; struct WaveForm { Byte wfTopKey; Byte wfWaveAddress; Byte wfWaveSize; Byte wfDocMode; Word wfRelPitch; }; typedef struct WaveForm WaveForm, *WaveFormPtr, **WaveFormHndl; struct Instrument { Envelope theEnvelope; Byte releaseSegment; Byte priorityIncrement; Byte pitchBendRange; Byte vibratoDepth; Byte vibratoSpeed; Byte inSpare; Byte aWaveCount; Byte bWaveCount; WaveForm aWaveList[1]; WaveForm bWaveList[1]; }; typedef struct Instrument Instrument, *InstrumentPtr, **InstrumentHndl; extern pascal void NSBootInit(void) inline(0x0119,dispatcher); extern pascal void NSStartUp(Word, Pointer) inline(0x0219,dispatcher); extern pascal void NSShutDown(void) inline(0x0319,dispatcher); extern pascal Word NSVersion(void) inline(0x0419,dispatcher); extern pascal void NSReset(void) inline(0x0519,dispatcher); extern pascal Boolean NSStatus(void) inline(0x0619,dispatcher); extern pascal void AllNotesOff(void) inline(0x0D19,dispatcher); extern pascal Word AllocGen(Word) inline(0x0919,dispatcher); extern pascal void DeallocGen(Word) inline(0x0A19,dispatcher); extern pascal void NoteOff(Word, Word) inline(0x0C19,dispatcher); extern pascal void NoteOn(Word, Word, Word, Pointer) inline(0x0B19,dispatcher); extern pascal Word NSSetUpdateRate(Word) inline(0x0E19,dispatcher); extern pascal VoidProcPtr NSSetUserUpdateRtn(Pointer) inline(0x0F19,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Note Synthesizer +* +* Copyright Apple Computer, Inc.1986-90 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __NOTESYN__ +#define __NOTESYN__ + +/* Error Codes */ +#define nsAlreadyInit 0x1901 /* Note Syn already initialized */ +#define nsSndNotInit 0x1902 /* Sound Tools not initialized */ +#define nsNotAvail 0x1921 /* generator not available */ +#define nsBadGenNum 0x1922 /* bad generator number */ +#define nsNotInit 0x1923 /* Note Syn not initialized */ +#define nsGenAlreadyOn 0x1924 /* generator already on */ +#define soundWrongVer 0x1925 /* incompatible versions of Sound and NoteSyn */ +struct Envelope { + Byte st1BkPt; + Word st1Increment; + Byte st2BkPt; + Word st2Increment; + Byte st3BkPt; + Word st3Increment; + Byte st4BkPt; + Word st4Increment; + Byte st5BkPt; + Word st5Increment; + Byte st6BkPt; + Word st6Increment; + Byte st7BkPt; + Word st7Increment; + Byte st8BkPt; + Word st8Increment; + }; +typedef struct Envelope Envelope, *EnvelopePtr, **EnvelopeHndl; + +struct WaveForm { + Byte wfTopKey; + Byte wfWaveAddress; + Byte wfWaveSize; + Byte wfDocMode; + Word wfRelPitch; + }; +typedef struct WaveForm WaveForm, *WaveFormPtr, **WaveFormHndl; + +struct Instrument { + Envelope theEnvelope; + Byte releaseSegment; + Byte priorityIncrement; + Byte pitchBendRange; + Byte vibratoDepth; + Byte vibratoSpeed; + Byte inSpare; + Byte aWaveCount; + Byte bWaveCount; + WaveForm aWaveList[1]; + WaveForm bWaveList[1]; + }; +typedef struct Instrument Instrument, *InstrumentPtr, **InstrumentHndl; + +extern pascal void NSBootInit(void) inline(0x0119,dispatcher); +extern pascal void NSStartUp(Word, Pointer) inline(0x0219,dispatcher); +extern pascal void NSShutDown(void) inline(0x0319,dispatcher); +extern pascal Word NSVersion(void) inline(0x0419,dispatcher); +extern pascal void NSReset(void) inline(0x0519,dispatcher); +extern pascal Boolean NSStatus(void) inline(0x0619,dispatcher); +extern pascal void AllNotesOff(void) inline(0x0D19,dispatcher); +extern pascal Word AllocGen(Word) inline(0x0919,dispatcher); +extern pascal void DeallocGen(Word) inline(0x0A19,dispatcher); +extern pascal void NoteOff(Word, Word) inline(0x0C19,dispatcher); +extern pascal void NoteOn(Word, Word, Word, Pointer) inline(0x0B19,dispatcher); +extern pascal Word NSSetUpdateRate(Word) inline(0x0E19,dispatcher); +extern pascal VoidProcPtr NSSetUserUpdateRtn(Pointer) inline(0x0F19,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/orca.h b/bin/Libraries/ORCACDefs/orca.h index 9454f3b..9eeb8d2 100644 --- a/bin/Libraries/ORCACDefs/orca.h +++ b/bin/Libraries/ORCACDefs/orca.h @@ -1 +1,26 @@ -/**************************************************************** * * orca.h - extra functions included in ORCA/C * * March 1989 * Mike Westerfield * * Copyright 1989, 1993 * Byte Works, Inc. * ****************************************************************/ #ifndef __orca__ #define __orca__ char *commandline(void); void enddesk(void); void endgraph(void); char *shellid(void); void startdesk(int); void startgraph(int); pascal void setfpeslot(int); int toolerror(void); int userid(void); #endif \ No newline at end of file +/**************************************************************** +* +* orca.h - extra functions included in ORCA/C +* +* March 1989 +* Mike Westerfield +* +* Copyright 1989, 1993 +* Byte Works, Inc. +* +****************************************************************/ + +#ifndef __orca__ +#define __orca__ + +char *commandline(void); +void enddesk(void); +void endgraph(void); +char *shellid(void); +void startdesk(int); +void startgraph(int); +pascal void setfpeslot(int); +int toolerror(void); +int userid(void); + +#endif diff --git a/bin/Libraries/ORCACDefs/print.h b/bin/Libraries/ORCACDefs/print.h index 0497636..20e15b1 100644 --- a/bin/Libraries/ORCACDefs/print.h +++ b/bin/Libraries/ORCACDefs/print.h @@ -1 +1,159 @@ -/******************************************** * * Print Manager * * Copyright Apple Computer, Inc.1986-90 * All Rights Reserved * * Copyright 1992, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __PRINT__ #define __PRINT__ /* Error Codes */ #define pntrConFailed 0x1308 /* connection to the printer failed */ #define memFullErr 0xFF80 #define ioAbort 0xFFE5 #define prAbort 0x0080 #define missingDriver 0x1301 /* specified driver not in system/drivers */ #define portNotOn 0x1302 /* specified port not selected in ctl panel */ #define noPrintRecord 0x1303 /* no print record was given */ #define badLaserPrep 0x1304 /* laser prep in laser writer incompatible */ #define badLPFile 0x1305 /* laser prep in system/drivers incompatible */ #define papConnNotOpen 0x1306 /* cannot connect to laser writer */ #define papReadWriteErr 0x1307 /* apple talk PAPRead or PAPWrite error */ #define ptrConnFailed 0x1308 /* cannot establish connection with imagewriter */ #define badLoadParam 0x1309 /* parameter for load/unload is invalid */ #define callNotSupported 0x130A /* toolcall made is not supported by this version */ #define startUpAlreadyMade 0x1321 /* low level startup already made */ #define invalidCtlVal 0x1322 /* invalid control value had been spec'd */ /* whichDriver Codes */ #define bothDrivers 0x0 /* input to PMLoadDriver and PMUnloadDriver */ #define printerDriver 0x0001 /* input to PMLoadDriver and PMUnloadDriver */ #define portDriver 0x0002 /* input to PMLoadDriver and PMUnloadDriver */ /* Other Constants */ #define prPortrait 0x0000 #define prLandscape 0x0001 #define prImageWriter 0x0001 #define prImageWriterLQ 0x0002 #define prLaserWriter 0x0003 #define prEpson 0x0004 #define prBlackWhite 0x0001 #define prColor 0x0002 #define bDraftLoop 0x0000 #define bSpoolLoop 0x0080 struct PrPrinterSpecRec { Word prPrinterType; Word prCharacteristics; }; typedef struct PrPrinterSpecRec PrPrinterSpecRec; struct PrInfoRec { Word iDev; /* reserved for internal use */ Word iVRes; /* vertical resolution of printer */ Word iHRes; /* horizontal resolution of printer */ Rect rPage; /* defining page rectangle */ }; typedef struct PrInfoRec PrInfoRec, *PrInfoRecPtr, **PrInfoRecHndl; struct PrJobRec { Word iFstPage; /* first page to print */ Word iLstPage; /* last page to print */ Word iCopies; /* number of copies */ Byte bJDocLoop; /* printing method */ Byte fFromUser; /* used internally */ WordProcPtr pIdleProc; /* background procedure */ Pointer pFileName; /* spool file name */ Word iFileVol; /* spool file volume reference number */ Byte bFileVers; /* spool file version number */ Byte bJobX; /* used internally */ }; typedef struct PrJobRec PrJobRec, *PrJobRecPtr; struct PrStyleRec { Word wDev; /* output quality information */ Word internA[3]; /* for internal use */ Word feed; /* paper feed type */ Word paperType; /* paper type */ Word crWidth; /* carriage Width for image writer or vertical sizing for lazer writer */ Word reduction; /* % reduction, laser writer only */ Word internB; /* for internal use */ }; typedef struct PrStyleRec PrStyleRec, *PrStyleRecPtr, **PrStyleRecHndl; #define vSizing crWidth /* PrStyleRec - alternate field name */ struct PrRec { Word prVersion; /* print manager version */ PrInfoRec prInfo; /* printer infomation subrecord */ Rect rPaper; /* Defining paper rectangle */ PrStyleRec prStl; /* style subrecord */ Byte prInfoPT[14]; /* reserved for internal use */ Byte prXInfo[24]; /* reserved for internal use */ PrJobRec prJob; /* job subrecord */ Byte printX[38]; /* reserved for future use */ Word iReserved; /* reserved for internal use */ }; typedef struct PrRec PrRec, *PrRecPtr, **PrRecHndl; struct PrStatusRec { Word iTotPages; /* number of pages in spool file */ Word iCurPage; /* page being printed */ Word iTotCopies; /* number of copies requested */ Word iCurCopy; /* copy being printed */ Word iTotBands; /* reserved for internal use */ Word iCurBand; /* reserved for internal use */ Boolean fPgDirty; /* TRUE if started printing page */ Word fImaging; /* reserved for internal use */ PrRecHndl hPrint; /* handle of print record */ GrafPortPtr pPrPort; /* pointer to grafport being use for printing */ LongWord hPic; /* reserved for internal use */ }; typedef struct PrStatusRec PrStatusRec, *PrStatusRecPtr, **PrStatusRecHndl; extern pascal void PMBootInit(void) inline(0x0113,dispatcher); extern pascal void PMStartUp(Word, Word) inline(0x0213,dispatcher); extern pascal void PMShutDown(void) inline(0x0313,dispatcher); extern pascal Word PMVersion(void) inline(0x0413,dispatcher); extern pascal void PMReset(void) inline(0x0513,dispatcher); extern pascal Boolean PMStatus(void) inline(0x0613,dispatcher); extern pascal Boolean PrChoosePrinter(void) inline(0x1613,dispatcher); extern pascal Boolean PrChooser(void) inline(0x1613,dispatcher); extern pascal void PrCloseDoc(GrafPortPtr) inline(0x0F13,dispatcher); extern pascal void PrClosePage(GrafPortPtr) inline(0x1113,dispatcher); extern pascal void PrDefault(PrRecHndl) inline(0x0913,dispatcher); extern pascal Word PrDriverVer(void) inline(0x2313,dispatcher); extern pascal Word PrError(void) inline(0x1413,dispatcher); extern pascal Boolean PrJobDialog(PrRecHndl) inline(0x0C13,dispatcher); extern pascal GrafPortPtr PrOpenDoc(PrRecHndl, GrafPortPtr) inline(0x0E13,dispatcher); extern pascal void PrOpenPage(GrafPortPtr, Rect *) inline(0x1013,dispatcher); extern pascal void PrPicFile(PrRecHndl, GrafPortPtr, PrStatusRecPtr) inline(0x1213,dispatcher); extern pascal void PrPixelMap(LocInfoPtr, RectPtr, Boolean) inline(0x0D13,dispatcher); extern pascal Word PrPortVer(void) inline(0x2413,dispatcher); extern pascal void PrSetError(Word) inline(0x1513,dispatcher); extern pascal Boolean PrStlDialog(PrRecHndl) inline(0x0B13,dispatcher); extern pascal Boolean PrValidate(PrRecHndl) inline(0x0A13,dispatcher); extern pascal void PMLoadDriver(Word) inline(0x3513,dispatcher); extern pascal void PMUnloadDriver(Word) inline(0x3413,dispatcher); extern pascal StringPtr PrGetDocName(void) inline(0x3613,dispatcher); extern pascal Word PrGetPgOrientation(PrRecHndl) inline(0x3813,dispatcher); extern pascal long PrGetPrinterSpecs(void) inline(0x1813,dispatcher); extern pascal void PrSetDocName(Pointer) inline(0x3713,dispatcher); extern pascal StringPtr PrGetNetworkName(void) inline(0x2B13,dispatcher); extern pascal StringPtr PrGetPortDvrName(void) inline(0x2913,dispatcher); extern pascal StringPtr PrGetPrinterDvrName(void) inline(0x2813,dispatcher); extern pascal StringPtr PrGetUserName(void) inline(0x2A13,dispatcher); extern pascal StringPtr PrGetZoneName(void) inline(0x2513,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Print Manager +* +* Copyright Apple Computer, Inc.1986-90 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __PRINT__ +#define __PRINT__ + +/* Error Codes */ +#define pntrConFailed 0x1308 /* connection to the printer failed */ +#define memFullErr 0xFF80 +#define ioAbort 0xFFE5 +#define prAbort 0x0080 +#define missingDriver 0x1301 /* specified driver not in system/drivers */ +#define portNotOn 0x1302 /* specified port not selected in ctl panel */ +#define noPrintRecord 0x1303 /* no print record was given */ +#define badLaserPrep 0x1304 /* laser prep in laser writer incompatible */ +#define badLPFile 0x1305 /* laser prep in system/drivers incompatible */ +#define papConnNotOpen 0x1306 /* cannot connect to laser writer */ +#define papReadWriteErr 0x1307 /* apple talk PAPRead or PAPWrite error */ +#define ptrConnFailed 0x1308 /* cannot establish connection with imagewriter */ +#define badLoadParam 0x1309 /* parameter for load/unload is invalid */ +#define callNotSupported 0x130A /* toolcall made is not supported by this version */ +#define startUpAlreadyMade 0x1321 /* low level startup already made */ +#define invalidCtlVal 0x1322 /* invalid control value had been spec'd */ + +/* whichDriver Codes */ +#define bothDrivers 0x0 /* input to PMLoadDriver and PMUnloadDriver */ +#define printerDriver 0x0001 /* input to PMLoadDriver and PMUnloadDriver */ +#define portDriver 0x0002 /* input to PMLoadDriver and PMUnloadDriver */ + +/* Other Constants */ +#define prPortrait 0x0000 +#define prLandscape 0x0001 +#define prImageWriter 0x0001 +#define prImageWriterLQ 0x0002 +#define prLaserWriter 0x0003 +#define prEpson 0x0004 +#define prBlackWhite 0x0001 +#define prColor 0x0002 +#define bDraftLoop 0x0000 +#define bSpoolLoop 0x0080 + +struct PrPrinterSpecRec { + Word prPrinterType; + Word prCharacteristics; + }; +typedef struct PrPrinterSpecRec PrPrinterSpecRec; + +struct PrInfoRec { + Word iDev; /* reserved for internal use */ + Word iVRes; /* vertical resolution of printer */ + Word iHRes; /* horizontal resolution of printer */ + Rect rPage; /* defining page rectangle */ + }; +typedef struct PrInfoRec PrInfoRec, *PrInfoRecPtr, **PrInfoRecHndl; + +struct PrJobRec { + Word iFstPage; /* first page to print */ + Word iLstPage; /* last page to print */ + Word iCopies; /* number of copies */ + Byte bJDocLoop; /* printing method */ + Byte fFromUser; /* used internally */ + WordProcPtr pIdleProc; /* background procedure */ + Pointer pFileName; /* spool file name */ + Word iFileVol; /* spool file volume reference number */ + Byte bFileVers; /* spool file version number */ + Byte bJobX; /* used internally */ + }; +typedef struct PrJobRec PrJobRec, *PrJobRecPtr; + +struct PrStyleRec { + Word wDev; /* output quality information */ + Word internA[3]; /* for internal use */ + Word feed; /* paper feed type */ + Word paperType; /* paper type */ + Word crWidth; /* carriage Width for image writer or vertical sizing for lazer writer */ + Word reduction; /* % reduction, laser writer only */ + Word internB; /* for internal use */ + }; +typedef struct PrStyleRec PrStyleRec, *PrStyleRecPtr, **PrStyleRecHndl; + +#define vSizing crWidth /* PrStyleRec - alternate field name */ + +struct PrRec { + Word prVersion; /* print manager version */ + PrInfoRec prInfo; /* printer infomation subrecord */ + Rect rPaper; /* Defining paper rectangle */ + PrStyleRec prStl; /* style subrecord */ + Byte prInfoPT[14]; /* reserved for internal use */ + Byte prXInfo[24]; /* reserved for internal use */ + PrJobRec prJob; /* job subrecord */ + Byte printX[38]; /* reserved for future use */ + Word iReserved; /* reserved for internal use */ + }; +typedef struct PrRec PrRec, *PrRecPtr, **PrRecHndl; + +struct PrStatusRec { + Word iTotPages; /* number of pages in spool file */ + Word iCurPage; /* page being printed */ + Word iTotCopies; /* number of copies requested */ + Word iCurCopy; /* copy being printed */ + Word iTotBands; /* reserved for internal use */ + Word iCurBand; /* reserved for internal use */ + Boolean fPgDirty; /* TRUE if started printing page */ + Word fImaging; /* reserved for internal use */ + PrRecHndl hPrint; /* handle of print record */ + GrafPortPtr pPrPort; /* pointer to grafport being use for printing */ + LongWord hPic; /* reserved for internal use */ + }; +typedef struct PrStatusRec PrStatusRec, *PrStatusRecPtr, **PrStatusRecHndl; + +extern pascal void PMBootInit(void) inline(0x0113,dispatcher); +extern pascal void PMStartUp(Word, Word) inline(0x0213,dispatcher); +extern pascal void PMShutDown(void) inline(0x0313,dispatcher); +extern pascal Word PMVersion(void) inline(0x0413,dispatcher); +extern pascal void PMReset(void) inline(0x0513,dispatcher); +extern pascal Boolean PMStatus(void) inline(0x0613,dispatcher); +extern pascal Boolean PrChoosePrinter(void) inline(0x1613,dispatcher); +extern pascal Boolean PrChooser(void) inline(0x1613,dispatcher); +extern pascal void PrCloseDoc(GrafPortPtr) inline(0x0F13,dispatcher); +extern pascal void PrClosePage(GrafPortPtr) inline(0x1113,dispatcher); +extern pascal void PrDefault(PrRecHndl) inline(0x0913,dispatcher); +extern pascal Word PrDriverVer(void) inline(0x2313,dispatcher); +extern pascal Word PrError(void) inline(0x1413,dispatcher); +extern pascal Boolean PrJobDialog(PrRecHndl) inline(0x0C13,dispatcher); +extern pascal GrafPortPtr PrOpenDoc(PrRecHndl, GrafPortPtr) inline(0x0E13,dispatcher); +extern pascal void PrOpenPage(GrafPortPtr, Rect *) inline(0x1013,dispatcher); +extern pascal void PrPicFile(PrRecHndl, GrafPortPtr, PrStatusRecPtr) inline(0x1213,dispatcher); +extern pascal void PrPixelMap(LocInfoPtr, RectPtr, Boolean) inline(0x0D13,dispatcher); +extern pascal Word PrPortVer(void) inline(0x2413,dispatcher); +extern pascal void PrSetError(Word) inline(0x1513,dispatcher); +extern pascal Boolean PrStlDialog(PrRecHndl) inline(0x0B13,dispatcher); +extern pascal Boolean PrValidate(PrRecHndl) inline(0x0A13,dispatcher); + +extern pascal void PMLoadDriver(Word) inline(0x3513,dispatcher); +extern pascal void PMUnloadDriver(Word) inline(0x3413,dispatcher); +extern pascal StringPtr PrGetDocName(void) inline(0x3613,dispatcher); +extern pascal Word PrGetPgOrientation(PrRecHndl) inline(0x3813,dispatcher); +extern pascal long PrGetPrinterSpecs(void) inline(0x1813,dispatcher); +extern pascal void PrSetDocName(Pointer) inline(0x3713,dispatcher); + +extern pascal StringPtr PrGetNetworkName(void) inline(0x2B13,dispatcher); +extern pascal StringPtr PrGetPortDvrName(void) inline(0x2913,dispatcher); +extern pascal StringPtr PrGetPrinterDvrName(void) inline(0x2813,dispatcher); +extern pascal StringPtr PrGetUserName(void) inline(0x2A13,dispatcher); +extern pascal StringPtr PrGetZoneName(void) inline(0x2513,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/prodos.h b/bin/Libraries/ORCACDefs/prodos.h index fafe5dc..f305f6c 100644 --- a/bin/Libraries/ORCACDefs/prodos.h +++ b/bin/Libraries/ORCACDefs/prodos.h @@ -1 +1,322 @@ -/******************************************** ; File: ProDOS.h ; ; ; Copyright Apple Computer, Inc.1986-90 ; All Rights Reserved ; ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __PRODOS__ #define __PRODOS__ #ifdef __GSOS__ #undef GetSysPrefs #undef BeginSession #undef EndSession #undef SessionStatus #undef ResetCache #undef ChangePath #undef ClearBackupBit #undef Close #undef Create #undef DControl #undef Destroy #undef DInfo #undef DRead #undef DStatus #undef DWrite #undef EraseDisk #undef Flush #undef Format #undef GetBootVol #undef GetDevNumber #undef GetDirEntry #undef GetEOF #undef GetFileInfo #undef GetFSTInfo #undef GetLevel #undef GetMark #undef GetName #undef GetPrefix #undef GetVersion #undef Newline #undef Null #undef Open #undef Quit #undef Read #undef SetEOF #undef SetFileInfo #undef SetLevel #undef SetMark #undef SetPrefix #undef UnbindInt #undef Volume #undef Write #undef BindInt #undef ChangePathRec #undef CreateRec #undef DAccessRec #undef DevNumRec #undef DInfoRec #undef DIORec #undef DirEntryRec #undef EOFRec #undef FileInfoRec #undef FormatRec #undef FSTInfoRec #undef InterruptRec #undef IORec #undef LevelRec #undef NameRec #undef GetNameRec #undef NewlineRec #undef OpenRec #undef PositionRec #undef PrefixRec #undef QuitRec #undef RefNumRec #undef SetPositionRec #undef SysPrefRec #undef VersionRec #undef VolumeRec #endif /* Error Codes */ #define invalidCallNum 0x0001 /* invalid call number */ #define unclaimedIntErr 0x01 /* fatal error - unclaimed interrupt */ #define badPBlockPtr 0x05 /* call pointer out of bounds */ #define pdosActiveErr 0x06 /* ProDOS is active */ #define pdosBusyErr 0x07 /* ProDOS is busy */ #define vcbUnusable 0x0A /* fatal error - VCB unusable */ #define fcbUnusable 0x0B /* fatal error - FCB unusable */ #define badBlockZero 0x0C /* fatal error - block zero allocated illegally */ #define shdwInterruptErr 0x0D /* fatal error - interrupt occured while I/O shadowing off */ #ifndef devNotFound /* device not found */ #define devNotFound 0x10 #endif #define badDevRefNum 0x11 /* invalid device reference number */ #define osVersionErr 0x11 /* Wrong OS version */ #define badReqCode 0x20 /* invalid request code */ #define intTableFull 0x25 /* interrupt table full */ #define invalidOperation 0x26 /* invalid operation */ #define ioError 0x27 /* I/O error */ #define noDevConnect 0x28 /* no device connected */ #define writeProtectErr 0x2B /* write protect error */ #define diskSwitchErr 0x2E /* disk switched error */ #define badPathname 0x40 /* invalid pathname syntax */ #define fcbFullErr 0x42 /* FCB full error */ #define badFileRefNum 0x43 /* invalid file reference number */ #ifndef pathNotFound /* path not found */ #define pathNotFound 0x44 #endif #define volumeNotFound 0x45 /* volume not found */ #ifndef fileNotFound /* file not found */ #define fileNotFound 0x46 #endif #define dupFileName 0x47 /* duplicate file name */ #define volumeFullErr 0x48 /* volume full error */ #define dirFullErr 0x49 /* directory full error */ #define versionErr 0x4A /* version error (incompatible file format) */ #ifndef badStoreType /* unsupported (or incorrect) storage type */ #define badStoreType 0x4B #endif #ifndef eofEncountered /* end-of-file encountered */ #define eofEncountered 0x4C #endif #define positionRangeErr 0x4D /* position out of range */ #define accessErr 0x4E /* access not allowed */ #define fileOpenErr 0x50 /* file is open */ #define dirDamaged 0x51 /* directory structure is damaged */ #define badVolType 0x52 /* unsupported volume type */ #ifndef paramRangeErr /* parameter out of range */ #define paramRangeErr 0x53 #endif #define memoryFullErr 0x54 /* out of memory */ #define vcbFullErr 0x55 /* VCB full error */ #define dupVolumeErr 0x57 /* duplicate volume error */ #define notBlkDevErr 0x58 /* not a blocked device */ #ifndef invalidLevel /* invalid level */ #define invalidLevel 0x59 #endif #define blkNumRangeErr 0x5A /* block number out of range */ #define notSameVolErr 0x5B /* different volumes found on ChangePath call */ #define notExecSysFile 0x5C /* not an executable system file */ #define osUnavailable 0x5D /* Operating System/file system not available */ #define deallocateRamErr 0x5E /* Cannot deallocate /RAM */ #ifndef stackOverflow /* Return stack overflow */ #define stackOverflow 0x5F #endif #define dataUnavailable 0x60 /* Data unavailable */ /* Other Constants */ #define endofDirectory 0x0061 #define P_READ_ENABLE 0x01 #define P_WRITE_ENABLE 0x02 #define P_DESTROY_ENABLE 0x80 #define P_RENAME_ENABLE 0x40 struct BlockRec { Word blockDevNum; /* */ Ptr blockDataBuffer; /* */ Longint blockNum; /* */ } ; typedef struct BlockRec BlockRec, *BlockRecPtr; struct DevNumRec { Ptr devName; /* */ Word devNum; /* */ } ; typedef struct DevNumRec DevNumRec, *DevNumRecPtr; struct DInfoRec { Word devNum; /* */ Ptr devName; /* */ } ; typedef struct DInfoRec DInfoRec, *DInfoRecPtr; struct DirEntryRec { Word refNum; Word flags; Word base; Word displacement; Pointer nameBuffer; Word entryNum; Word fileType; Longint endOfFile; LongWord blockCount; TimeRec createTime; TimeRec modTime; Word access; LongWord auxType; Word fileSysID; } ; typedef struct DirEntryRec DirEntryRec, *DirEntryRecPtr; struct EOFRec { Word eofRefNum; /* */ Longint eofPosition; /* */ } ; typedef struct EOFRec EOFRec, *EOFRecPtr; struct FileIORec { Word fileRefNum; /* */ Ptr dataBuffer; /* */ Longint requestCount; /* */ Longint transferCount; /* */ } ; typedef struct FileIORec FileIORec, *FileIORecPtr; struct FileRec { Ptr pathname; /* */ Word fAccess; /* */ Word fileType; /* */ Longint auxType; /* */ Word storageType; /* */ Word createDate; /* */ Word createTime; /* */ Word modDate; /* */ Word modTime; /* */ Longint blocksUsed; /* */ } ; typedef struct FileRec FileRec, *FileRecPtr; struct FormatRec { Ptr devName; /* device name pointer */ Ptr volName; /* device name pointer */ Word fileSysID; /* file system ID */ } ; typedef struct FormatRec FormatRec, *FormatRecPtr; struct EraseDiskRec { Ptr devName; /* device name pointer */ Ptr volName; /* device name pointer */ Word fileSysID; /* file system ID */ } ; typedef struct EraseDiskRec EraseDiskRec, *EraseDiskRecPtr; struct InterruptRec { Word intNum; /* */ Ptr intCode; /* */ } ; typedef struct InterruptRec InterruptRec, *InterruptRecPtr; struct MarkRec { Word markRefNum; /* */ LongWord position; /* */ } ; typedef struct MarkRec MarkRec, *MarkRecPtr; struct NewLineRec { Word newLRefNum; /* */ Word enableMask; /* */ Word newlineChar; /* */ } ; typedef struct NewLineRec NewLineRec, *NewLineRecPtr; struct OpenRec { Word openRefNum; /* */ Ptr openPathname; /* */ Handle ioBuffer; /* */ } ; typedef struct OpenRec OpenRec, *OpenRecPtr; struct PathNameRec { Ptr pathname; /* */ Ptr newPathname; /* */ } ; typedef struct PathNameRec PathNameRec, *PathNameRecPtr; struct PrefixRec { Word prefixNum; /* */ Ptr prefix; /* */ } ; typedef struct PrefixRec PrefixRec, *PrefixRecPtr; struct QuitRec { Ptr quitPathname; /* */ Word flags; /* */ } ; typedef struct QuitRec QuitRec, *QuitRecPtr; struct VolumeRec { Ptr deviceName; /* */ Ptr volName; /* */ LongWord totalBlocks; /* */ LongWord freeBlocks; /* */ Word fileSysID; /* */ } ; typedef struct VolumeRec VolumeRec, *VolumeRecPtr; #ifndef PDosInt extern pascal void PDosInt(unsigned, void *); #endif #define ALLOC_INTERRUPT(pBlockPtr) PDosInt(0x0031,pBlockPtr) #define CHANGE_PATH(pBlockPtr) PDosInt(0x0004,pBlockPtr) #define CLEAR_BACKUP_BIT(pBlockPtr) PDosInt(0x000B,pBlockPtr) #define CLOSE(pBlockPtr) PDosInt(0x0014,pBlockPtr) #define CREATE(pBlockPtr) PDosInt(0x0001,pBlockPtr) #define D_INFO(pBlockPtr) PDosInt(0x002C,pBlockPtr) #define DEALLOC_INTERRUPT(pBlockPtr) PDosInt(0x0032,pBlockPtr) #define DESTROY(pBlockPtr) PDosInt(0x0002,pBlockPtr) #define ERASE_DISK(pBlockPtr) PDosInt(0x0025,pBlockPtr) #define FLUSH(pBlockPtr) PDosInt(0x0015,pBlockPtr) #define FORMAT(pBlockPtr) PDosInt(0x0024,pBlockPtr) #define GET_BOOT_VOL(pBlockPtr) PDosInt(0x0028,pBlockPtr) #define GET_DEV_NUM(pBlockPtr) PDosInt(0x0020,pBlockPtr) #define GET_DIR_ENTRY(pBlockPtr) PDosInt(0x001C,pBlockPtr) #define GET_EOF(pBlockPtr) PDosInt(0x0019,pBlockPtr) #define GET_FILE_INFO(pBlockPtr) PDosInt(0x0006,pBlockPtr) #define GET_LAST_DEV(pBlockPtr) PDosInt(0x0021,pBlockPtr) #define GET_LEVEL(pBlockPtr) PDosInt(0x001B,pBlockPtr) #define GET_MARK(pBlockPtr) PDosInt(0x0017,pBlockPtr) #define GET_NAME(pBlockPtr) PDosInt(0x0027,pBlockPtr) #define GET_PREFIX(pBlockPtr) PDosInt(0x000A,pBlockPtr) #define GET_VERSION(pBlockPtr) PDosInt(0x002A,pBlockPtr) #define NEWLINE(pBlockPtr) PDosInt(0x0011,pBlockPtr) #define OPEN(pBlockPtr) PDosInt(0x0010,pBlockPtr) #define QUIT(pBlockPtr) PDosInt(0x0029,pBlockPtr) #define READ_BLOCK(pBlockPtr) PDosInt(0x0022,pBlockPtr) #define READ(pBlockPtr) PDosInt(0x0012,pBlockPtr) #define SET_EOF(pBlockPtr) PDosInt(0x0018,pBlockPtr) #define SET_FILE_INFO(pBlockPtr) PDosInt(0x0005,pBlockPtr) #define SET_LEVEL(pBlockPtr) PDosInt(0x001A,pBlockPtr) #define SET_MARK(pBlockPtr) PDosInt(0x0016,pBlockPtr) #define SET_PREFIX(pBlockPtr) PDosInt(0x0009,pBlockPtr) #define VOLUME(pBlockPtr) PDosInt(0x0008,pBlockPtr) #define WRITE_BLOCK(pBlockPtr) PDosInt(0x0023,pBlockPtr) #define WRITE(pBlockPtr) PDosInt(0x0013,pBlockPtr) #endif \ No newline at end of file +/******************************************** +; File: ProDOS.h +; +; +; Copyright Apple Computer, Inc.1986-90 +; All Rights Reserved +; +********************************************/ +#ifndef __TYPES__ +#include +#endif + +#ifndef __PRODOS__ +#define __PRODOS__ + +#ifdef __GSOS__ + +#undef GetSysPrefs +#undef BeginSession +#undef EndSession +#undef SessionStatus +#undef ResetCache +#undef ChangePath +#undef ClearBackupBit +#undef Close +#undef Create +#undef DControl +#undef Destroy +#undef DInfo +#undef DRead +#undef DStatus +#undef DWrite +#undef EraseDisk +#undef Flush +#undef Format +#undef GetBootVol +#undef GetDevNumber +#undef GetDirEntry +#undef GetEOF +#undef GetFileInfo +#undef GetFSTInfo +#undef GetLevel +#undef GetMark +#undef GetName +#undef GetPrefix +#undef GetVersion +#undef Newline +#undef Null +#undef Open +#undef Quit +#undef Read +#undef SetEOF +#undef SetFileInfo +#undef SetLevel +#undef SetMark +#undef SetPrefix +#undef UnbindInt +#undef Volume +#undef Write +#undef BindInt + +#undef ChangePathRec +#undef CreateRec +#undef DAccessRec +#undef DevNumRec +#undef DInfoRec +#undef DIORec +#undef DirEntryRec +#undef EOFRec +#undef FileInfoRec +#undef FormatRec +#undef FSTInfoRec +#undef InterruptRec +#undef IORec +#undef LevelRec +#undef NameRec +#undef GetNameRec +#undef NewlineRec +#undef OpenRec +#undef PositionRec +#undef PrefixRec +#undef QuitRec +#undef RefNumRec +#undef SetPositionRec +#undef SysPrefRec +#undef VersionRec +#undef VolumeRec + +#endif + + + + +/* Error Codes */ +#define invalidCallNum 0x0001 /* invalid call number */ +#define unclaimedIntErr 0x01 /* fatal error - unclaimed interrupt */ +#define badPBlockPtr 0x05 /* call pointer out of bounds */ +#define pdosActiveErr 0x06 /* ProDOS is active */ +#define pdosBusyErr 0x07 /* ProDOS is busy */ +#define vcbUnusable 0x0A /* fatal error - VCB unusable */ +#define fcbUnusable 0x0B /* fatal error - FCB unusable */ +#define badBlockZero 0x0C /* fatal error - block zero allocated illegally */ +#define shdwInterruptErr 0x0D /* fatal error - interrupt occured while I/O shadowing off */ +#ifndef devNotFound /* device not found */ +#define devNotFound 0x10 +#endif +#define badDevRefNum 0x11 /* invalid device reference number */ +#define osVersionErr 0x11 /* Wrong OS version */ +#define badReqCode 0x20 /* invalid request code */ +#define intTableFull 0x25 /* interrupt table full */ +#define invalidOperation 0x26 /* invalid operation */ +#define ioError 0x27 /* I/O error */ +#define noDevConnect 0x28 /* no device connected */ +#define writeProtectErr 0x2B /* write protect error */ +#define diskSwitchErr 0x2E /* disk switched error */ +#define badPathname 0x40 /* invalid pathname syntax */ +#define fcbFullErr 0x42 /* FCB full error */ +#define badFileRefNum 0x43 /* invalid file reference number */ +#ifndef pathNotFound /* path not found */ +#define pathNotFound 0x44 +#endif +#define volumeNotFound 0x45 /* volume not found */ +#ifndef fileNotFound /* file not found */ +#define fileNotFound 0x46 +#endif +#define dupFileName 0x47 /* duplicate file name */ +#define volumeFullErr 0x48 /* volume full error */ +#define dirFullErr 0x49 /* directory full error */ +#define versionErr 0x4A /* version error (incompatible file format) */ +#ifndef badStoreType /* unsupported (or incorrect) storage type */ +#define badStoreType 0x4B +#endif +#ifndef eofEncountered /* end-of-file encountered */ +#define eofEncountered 0x4C +#endif +#define positionRangeErr 0x4D /* position out of range */ +#define accessErr 0x4E /* access not allowed */ +#define fileOpenErr 0x50 /* file is open */ +#define dirDamaged 0x51 /* directory structure is damaged */ +#define badVolType 0x52 /* unsupported volume type */ +#ifndef paramRangeErr /* parameter out of range */ +#define paramRangeErr 0x53 +#endif +#define memoryFullErr 0x54 /* out of memory */ +#define vcbFullErr 0x55 /* VCB full error */ +#define dupVolumeErr 0x57 /* duplicate volume error */ +#define notBlkDevErr 0x58 /* not a blocked device */ +#ifndef invalidLevel /* invalid level */ +#define invalidLevel 0x59 +#endif +#define blkNumRangeErr 0x5A /* block number out of range */ +#define notSameVolErr 0x5B /* different volumes found on ChangePath call */ +#define notExecSysFile 0x5C /* not an executable system file */ +#define osUnavailable 0x5D /* Operating System/file system not available */ +#define deallocateRamErr 0x5E /* Cannot deallocate /RAM */ +#ifndef stackOverflow /* Return stack overflow */ +#define stackOverflow 0x5F +#endif +#define dataUnavailable 0x60 /* Data unavailable */ + +/* Other Constants */ +#define endofDirectory 0x0061 +#define P_READ_ENABLE 0x01 +#define P_WRITE_ENABLE 0x02 +#define P_DESTROY_ENABLE 0x80 +#define P_RENAME_ENABLE 0x40 +struct BlockRec { + Word blockDevNum; /* */ + Ptr blockDataBuffer; /* */ + Longint blockNum; /* */ +} ; +typedef struct BlockRec BlockRec, *BlockRecPtr; +struct DevNumRec { + Ptr devName; /* */ + Word devNum; /* */ +} ; +typedef struct DevNumRec DevNumRec, *DevNumRecPtr; +struct DInfoRec { + Word devNum; /* */ + Ptr devName; /* */ +} ; +typedef struct DInfoRec DInfoRec, *DInfoRecPtr; +struct DirEntryRec { + Word refNum; + Word flags; + Word base; + Word displacement; + Pointer nameBuffer; + Word entryNum; + Word fileType; + Longint endOfFile; + LongWord blockCount; + TimeRec createTime; + TimeRec modTime; + Word access; + LongWord auxType; + Word fileSysID; +} ; +typedef struct DirEntryRec DirEntryRec, *DirEntryRecPtr; +struct EOFRec { + Word eofRefNum; /* */ + Longint eofPosition; /* */ +} ; +typedef struct EOFRec EOFRec, *EOFRecPtr; +struct FileIORec { + Word fileRefNum; /* */ + Ptr dataBuffer; /* */ + Longint requestCount; /* */ + Longint transferCount; /* */ +} ; +typedef struct FileIORec FileIORec, *FileIORecPtr; +struct FileRec { + Ptr pathname; /* */ + Word fAccess; /* */ + Word fileType; /* */ + Longint auxType; /* */ + Word storageType; /* */ + Word createDate; /* */ + Word createTime; /* */ + Word modDate; /* */ + Word modTime; /* */ + Longint blocksUsed; /* */ +} ; +typedef struct FileRec FileRec, *FileRecPtr; +struct FormatRec { + Ptr devName; /* device name pointer */ + Ptr volName; /* device name pointer */ + Word fileSysID; /* file system ID */ +} ; +typedef struct FormatRec FormatRec, *FormatRecPtr; +struct EraseDiskRec { + Ptr devName; /* device name pointer */ + Ptr volName; /* device name pointer */ + Word fileSysID; /* file system ID */ +} ; +typedef struct EraseDiskRec EraseDiskRec, *EraseDiskRecPtr; +struct InterruptRec { + Word intNum; /* */ + Ptr intCode; /* */ +} ; +typedef struct InterruptRec InterruptRec, *InterruptRecPtr; +struct MarkRec { + Word markRefNum; /* */ + LongWord position; /* */ +} ; +typedef struct MarkRec MarkRec, *MarkRecPtr; +struct NewLineRec { + Word newLRefNum; /* */ + Word enableMask; /* */ + Word newlineChar; /* */ +} ; +typedef struct NewLineRec NewLineRec, *NewLineRecPtr; +struct OpenRec { + Word openRefNum; /* */ + Ptr openPathname; /* */ + Handle ioBuffer; /* */ +} ; +typedef struct OpenRec OpenRec, *OpenRecPtr; +struct PathNameRec { + Ptr pathname; /* */ + Ptr newPathname; /* */ +} ; +typedef struct PathNameRec PathNameRec, *PathNameRecPtr; +struct PrefixRec { + Word prefixNum; /* */ + Ptr prefix; /* */ +} ; +typedef struct PrefixRec PrefixRec, *PrefixRecPtr; +struct QuitRec { + Ptr quitPathname; /* */ + Word flags; /* */ +} ; +typedef struct QuitRec QuitRec, *QuitRecPtr; +struct VolumeRec { + Ptr deviceName; /* */ + Ptr volName; /* */ + LongWord totalBlocks; /* */ + LongWord freeBlocks; /* */ + Word fileSysID; /* */ +} ; +typedef struct VolumeRec VolumeRec, *VolumeRecPtr; + +#ifndef PDosInt +extern pascal void PDosInt(unsigned, void *); +#endif + +#define ALLOC_INTERRUPT(pBlockPtr) PDosInt(0x0031,pBlockPtr) +#define CHANGE_PATH(pBlockPtr) PDosInt(0x0004,pBlockPtr) +#define CLEAR_BACKUP_BIT(pBlockPtr) PDosInt(0x000B,pBlockPtr) +#define CLOSE(pBlockPtr) PDosInt(0x0014,pBlockPtr) +#define CREATE(pBlockPtr) PDosInt(0x0001,pBlockPtr) +#define D_INFO(pBlockPtr) PDosInt(0x002C,pBlockPtr) +#define DEALLOC_INTERRUPT(pBlockPtr) PDosInt(0x0032,pBlockPtr) +#define DESTROY(pBlockPtr) PDosInt(0x0002,pBlockPtr) +#define ERASE_DISK(pBlockPtr) PDosInt(0x0025,pBlockPtr) +#define FLUSH(pBlockPtr) PDosInt(0x0015,pBlockPtr) +#define FORMAT(pBlockPtr) PDosInt(0x0024,pBlockPtr) +#define GET_BOOT_VOL(pBlockPtr) PDosInt(0x0028,pBlockPtr) +#define GET_DEV_NUM(pBlockPtr) PDosInt(0x0020,pBlockPtr) +#define GET_DIR_ENTRY(pBlockPtr) PDosInt(0x001C,pBlockPtr) +#define GET_EOF(pBlockPtr) PDosInt(0x0019,pBlockPtr) +#define GET_FILE_INFO(pBlockPtr) PDosInt(0x0006,pBlockPtr) +#define GET_LAST_DEV(pBlockPtr) PDosInt(0x0021,pBlockPtr) +#define GET_LEVEL(pBlockPtr) PDosInt(0x001B,pBlockPtr) +#define GET_MARK(pBlockPtr) PDosInt(0x0017,pBlockPtr) +#define GET_NAME(pBlockPtr) PDosInt(0x0027,pBlockPtr) +#define GET_PREFIX(pBlockPtr) PDosInt(0x000A,pBlockPtr) +#define GET_VERSION(pBlockPtr) PDosInt(0x002A,pBlockPtr) +#define NEWLINE(pBlockPtr) PDosInt(0x0011,pBlockPtr) +#define OPEN(pBlockPtr) PDosInt(0x0010,pBlockPtr) +#define QUIT(pBlockPtr) PDosInt(0x0029,pBlockPtr) +#define READ_BLOCK(pBlockPtr) PDosInt(0x0022,pBlockPtr) +#define READ(pBlockPtr) PDosInt(0x0012,pBlockPtr) +#define SET_EOF(pBlockPtr) PDosInt(0x0018,pBlockPtr) +#define SET_FILE_INFO(pBlockPtr) PDosInt(0x0005,pBlockPtr) +#define SET_LEVEL(pBlockPtr) PDosInt(0x001A,pBlockPtr) +#define SET_MARK(pBlockPtr) PDosInt(0x0016,pBlockPtr) +#define SET_PREFIX(pBlockPtr) PDosInt(0x0009,pBlockPtr) +#define VOLUME(pBlockPtr) PDosInt(0x0008,pBlockPtr) +#define WRITE_BLOCK(pBlockPtr) PDosInt(0x0023,pBlockPtr) +#define WRITE(pBlockPtr) PDosInt(0x0013,pBlockPtr) +#endif diff --git a/bin/Libraries/ORCACDefs/qdaux.h b/bin/Libraries/ORCACDefs/qdaux.h index 3e3ff01..54f5cf9 100644 --- a/bin/Libraries/ORCACDefs/qdaux.h +++ b/bin/Libraries/ORCACDefs/qdaux.h @@ -1 +1,187 @@ -/******************************************** * * QuickDraw II Auxiliary * * Copyright Apple Computer, Inc.1986-91 * All Rights Reserved * * Copyright 1992, 1993, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __QDAUX__ #define __QDAUX__ /* PicInfo - The following picture opcodes are for reference only!! */ #define frameVerb 0x00 #define picNop 0x00 #define drawCharVerb 0x00 #define paintVerb 0x01 #define picClipRgn 0x01 #define drawTextVerb 0x01 #define eraseVerb 0x02 #define picBkPat 0x02 #define drawCStrVerb 0x02 #define invertVerb 0x03 #define picTxFont 0x03 #define fillVerb 0x04 #define picTxFace 0x04 #define picTxMode 0x05 #define picSpExtra 0x06 #define picPnSize 0x07 #define picPnMode 0x08 #define picPnPat 0x09 #define picThePat 0x0A #define picFillPat 0x0A /* 10 */ /* Please use picThePat */ #define picOvSize 0x0B #define picOrigin 0x0C #define picTxSize 0x0D #define picFGColor 0x0E #define picBGColor 0x0F #define picTxRatio 0x10 #define picVersion 0x11 #define picChExtra 0x12 /* 18 */ #define picPnMask 0x13 /* 19 */ #define picArcRot 0x14 /* 20 */ #define picFontFlags 0x15 /* 21 */ #define lineNoun 0x20 #define picLine 0x20 #define picLineFrom 0x21 #define picShortL 0x22 #define picShortLine 0x22 /* 34 */ #define picShortLFrom 0x23 #define picLongText 0x28 #define picDHText 0x29 #define picDVText 0x2A #define picDVDHText 0x2B #define rectNoun 0x30 #define rRectNoun 0x40 #define ovalNoun 0x50 #define arcNoun 0x60 #define polyNoun 0x70 #define rgnNoun 0x80 #define mapNoun 0x90 #define picBitsRect 0x90 #define picBitsRgn 0x91 #define picPBitsRect 0x98 #define picPBitsRgn 0x99 #define picShortComment 0xA0 #define picLongComment 0xA1 #define picEnd 0xFF /* SeedFill/CalcMask Masks */ #define resMode640PMask 0x00 #define resMode640DMask 0x01 #define resMode320Mask 0x02 #define destModeCopyMask 0x0000 #define destModeLeaveMask 0x1000 #define destModeOnesMask 0x2000 #define destModeClrToZeros 0x2000 /* 8192 */ #define destModeZerosMask 0x3000 #define destModeClrToOnes 0x3000 /* 12288 */ /* Error Codes */ #define badRectSize 0x1211 #define destModeError 0x1212 #define badPictureOpcode 0x121F #define badGetSysIconInput 0x1230 /* GetSysIcon constants */ #define fUseOpenFolders 0x0004 #define getFileIcon 0x0000 #define getDeviceIcon 0x0001 #define getMiscIcon 0x0002 #define desktopSysIcon 0x0000 #define padlockSysIcon 0x0001 #define upArrowSysIcon 0x0002 #define downArrowSysIcon 0x0003 #define boxDownArrowSysIcon 0x0004 /* WhooshRect constants */ #define whooshOut 0x80000000L #define whooshIn 0L #define fLocalCoordinates 0x40000000L #define fSilent 0x20000000L /* Other Constants */ #define fTextJust 0x0008 /* DrawStringWidth flag values */ #define dswNoCondense 0x8000 #define dswCondense 0x0000 #define dswNoTruncate 0x0000 #define dswTruncLeft 0x2000 #define dswTruncCenter 0x4000 #define dswTruncRight 0x6000 #define dswPString 0x0000 #define dswCString 0x0004 #define dswWString 0x0008 #define dswStrIsPtr 0x0000 #define dswStrIsHandle 0x0001 #define dswStrIsResource 0x0002 /* ColorTable flag values */ #define ctUse640Colors 0x8000 #define ctNoCtlNewRes 0x4000 #define ctIncludeMenuBar 0x2000 struct QDIconRecord { Word iconType; Word iconSize; Word iconHeight; Word iconWidth; Byte iconImage[1]; Byte iconMask[1]; }; typedef struct QDIconRecord QDIconRecord, *QDIconRecordPtr, **QDIconRecordHndl; struct Picture { Word picSCB; Rect picFrame; Word pVersion; /* Followed by picture opcodes */ }; typedef struct Picture Picture, *PicPtr, **PicHndl; struct LeakTable { Word leakCount; Word leakColors[16]; }; typedef struct LeakTable LeakTable, *LeakTablePtr; extern pascal void QDAuxBootInit(void) inline(0x0112,dispatcher); extern pascal void QDAuxStartUp(void) inline(0x0212,dispatcher); extern pascal void QDAuxShutDown(void) inline(0x0312,dispatcher); extern pascal Word QDAuxVersion(void) inline(0x0412,dispatcher); extern pascal void QDAuxReset(void) inline(0x0512,dispatcher); extern pascal Boolean QDAuxStatus(void) inline(0x0612,dispatcher); extern pascal void ClosePicture(void) inline(0xB904,dispatcher); extern pascal void CopyPixels(LocInfoPtr, LocInfoPtr, Rect *, Rect *, Word, RegionHndl) inline(0x0912,dispatcher); extern pascal void DrawIcon(Pointer, Word, Word, Word) inline(0x0B12,dispatcher); extern pascal void DrawPicture(Handle, Rect *) inline(0xBA04,dispatcher); extern pascal void KillPicture(Handle) inline(0xBB04,dispatcher); extern pascal PicHndl OpenPicture(Pointer) inline(0xB704,dispatcher); extern pascal void PicComment(Integer, Integer, Handle) inline(0xB804,dispatcher); extern pascal void WaitCursor(void) inline(0x0A12,dispatcher); extern pascal void CalcMask(LocInfoPtr, Rect *, LocInfoPtr, Rect *, Word, PatternPtr, Pointer) inline(0x0E12,dispatcher); extern pascal void SeedFill(LocInfoPtr, Rect *, LocInfoPtr, Rect *, Word, Word, Word, PatternPtr, Pointer) inline(0x0D12,dispatcher); extern pascal void SpecialRect(Rect *, Word, Word) inline(0x0C12,dispatcher); extern pascal QDIconRecordPtr GetSysIcon(Word, Word, Long) inline(0x0F12,dispatcher); extern pascal void IBeamCursor(void) inline(0x1312,dispatcher); extern pascal RegionHndl PixelMap2Rgn(LocInfoPtr, Word, Word) inline(0x1012,dispatcher); extern pascal void WhooshRect(Long, Rect *, Rect *) inline(0x1412,dispatcher); extern pascal void DrawStringWidth(Word, Ref, Word) inline(0x1512,dispatcher); extern pascal Handle UseColorTable(Word, ColorTablePtr, Word) inline(0x1612,dispatcher); extern pascal void RestoreColorTable(Handle, Word) inline(0x1712,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* QuickDraw II Auxiliary +* +* Copyright Apple Computer, Inc.1986-91 +* All Rights Reserved +* +* Copyright 1992, 1993, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __QDAUX__ +#define __QDAUX__ + +/* + PicInfo - The following picture + opcodes are for reference only!! +*/ + +#define frameVerb 0x00 +#define picNop 0x00 +#define drawCharVerb 0x00 +#define paintVerb 0x01 +#define picClipRgn 0x01 +#define drawTextVerb 0x01 +#define eraseVerb 0x02 +#define picBkPat 0x02 +#define drawCStrVerb 0x02 +#define invertVerb 0x03 +#define picTxFont 0x03 +#define fillVerb 0x04 +#define picTxFace 0x04 +#define picTxMode 0x05 +#define picSpExtra 0x06 +#define picPnSize 0x07 +#define picPnMode 0x08 +#define picPnPat 0x09 +#define picThePat 0x0A +#define picFillPat 0x0A /* 10 */ /* Please use picThePat */ +#define picOvSize 0x0B +#define picOrigin 0x0C +#define picTxSize 0x0D +#define picFGColor 0x0E +#define picBGColor 0x0F +#define picTxRatio 0x10 +#define picVersion 0x11 +#define picChExtra 0x12 /* 18 */ +#define picPnMask 0x13 /* 19 */ +#define picArcRot 0x14 /* 20 */ +#define picFontFlags 0x15 /* 21 */ +#define lineNoun 0x20 +#define picLine 0x20 +#define picLineFrom 0x21 +#define picShortL 0x22 +#define picShortLine 0x22 /* 34 */ +#define picShortLFrom 0x23 +#define picLongText 0x28 +#define picDHText 0x29 +#define picDVText 0x2A +#define picDVDHText 0x2B +#define rectNoun 0x30 +#define rRectNoun 0x40 +#define ovalNoun 0x50 +#define arcNoun 0x60 +#define polyNoun 0x70 +#define rgnNoun 0x80 +#define mapNoun 0x90 +#define picBitsRect 0x90 +#define picBitsRgn 0x91 +#define picPBitsRect 0x98 +#define picPBitsRgn 0x99 +#define picShortComment 0xA0 +#define picLongComment 0xA1 +#define picEnd 0xFF + +/* SeedFill/CalcMask Masks */ +#define resMode640PMask 0x00 +#define resMode640DMask 0x01 +#define resMode320Mask 0x02 +#define destModeCopyMask 0x0000 +#define destModeLeaveMask 0x1000 +#define destModeOnesMask 0x2000 +#define destModeClrToZeros 0x2000 /* 8192 */ +#define destModeZerosMask 0x3000 +#define destModeClrToOnes 0x3000 /* 12288 */ + +/* Error Codes */ +#define badRectSize 0x1211 +#define destModeError 0x1212 +#define badPictureOpcode 0x121F +#define badGetSysIconInput 0x1230 + +/* GetSysIcon constants */ +#define fUseOpenFolders 0x0004 +#define getFileIcon 0x0000 +#define getDeviceIcon 0x0001 +#define getMiscIcon 0x0002 +#define desktopSysIcon 0x0000 +#define padlockSysIcon 0x0001 +#define upArrowSysIcon 0x0002 +#define downArrowSysIcon 0x0003 +#define boxDownArrowSysIcon 0x0004 + +/* WhooshRect constants */ +#define whooshOut 0x80000000L +#define whooshIn 0L +#define fLocalCoordinates 0x40000000L +#define fSilent 0x20000000L + +/* Other Constants */ +#define fTextJust 0x0008 + +/* DrawStringWidth flag values */ +#define dswNoCondense 0x8000 +#define dswCondense 0x0000 +#define dswNoTruncate 0x0000 +#define dswTruncLeft 0x2000 +#define dswTruncCenter 0x4000 +#define dswTruncRight 0x6000 +#define dswPString 0x0000 +#define dswCString 0x0004 +#define dswWString 0x0008 +#define dswStrIsPtr 0x0000 +#define dswStrIsHandle 0x0001 +#define dswStrIsResource 0x0002 + +/* ColorTable flag values */ +#define ctUse640Colors 0x8000 +#define ctNoCtlNewRes 0x4000 +#define ctIncludeMenuBar 0x2000 + +struct QDIconRecord { + Word iconType; + Word iconSize; + Word iconHeight; + Word iconWidth; + Byte iconImage[1]; + Byte iconMask[1]; + }; +typedef struct QDIconRecord QDIconRecord, *QDIconRecordPtr, **QDIconRecordHndl; + +struct Picture { + Word picSCB; + Rect picFrame; + Word pVersion; /* Followed by picture opcodes */ + }; +typedef struct Picture Picture, *PicPtr, **PicHndl; + +struct LeakTable { + Word leakCount; + Word leakColors[16]; + }; +typedef struct LeakTable LeakTable, *LeakTablePtr; + +extern pascal void QDAuxBootInit(void) inline(0x0112,dispatcher); +extern pascal void QDAuxStartUp(void) inline(0x0212,dispatcher); +extern pascal void QDAuxShutDown(void) inline(0x0312,dispatcher); +extern pascal Word QDAuxVersion(void) inline(0x0412,dispatcher); +extern pascal void QDAuxReset(void) inline(0x0512,dispatcher); +extern pascal Boolean QDAuxStatus(void) inline(0x0612,dispatcher); +extern pascal void ClosePicture(void) inline(0xB904,dispatcher); +extern pascal void CopyPixels(LocInfoPtr, LocInfoPtr, Rect *, Rect *, Word, RegionHndl) inline(0x0912,dispatcher); +extern pascal void DrawIcon(Pointer, Word, Word, Word) inline(0x0B12,dispatcher); +extern pascal void DrawPicture(Handle, Rect *) inline(0xBA04,dispatcher); +extern pascal void KillPicture(Handle) inline(0xBB04,dispatcher); +extern pascal PicHndl OpenPicture(Pointer) inline(0xB704,dispatcher); +extern pascal void PicComment(Integer, Integer, Handle) inline(0xB804,dispatcher); +extern pascal void WaitCursor(void) inline(0x0A12,dispatcher); + +extern pascal void CalcMask(LocInfoPtr, Rect *, LocInfoPtr, Rect *, Word, PatternPtr, Pointer) inline(0x0E12,dispatcher); +extern pascal void SeedFill(LocInfoPtr, Rect *, LocInfoPtr, Rect *, Word, Word, Word, PatternPtr, Pointer) inline(0x0D12,dispatcher); +extern pascal void SpecialRect(Rect *, Word, Word) inline(0x0C12,dispatcher); + +extern pascal QDIconRecordPtr GetSysIcon(Word, Word, Long) inline(0x0F12,dispatcher); +extern pascal void IBeamCursor(void) inline(0x1312,dispatcher); +extern pascal RegionHndl PixelMap2Rgn(LocInfoPtr, Word, Word) inline(0x1012,dispatcher); +extern pascal void WhooshRect(Long, Rect *, Rect *) inline(0x1412,dispatcher); + +extern pascal void DrawStringWidth(Word, Ref, Word) inline(0x1512,dispatcher); +extern pascal Handle UseColorTable(Word, ColorTablePtr, Word) inline(0x1612,dispatcher); +extern pascal void RestoreColorTable(Handle, Word) inline(0x1712,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/quickdraw.h b/bin/Libraries/ORCACDefs/quickdraw.h index ba151fc..8d25aff 100644 --- a/bin/Libraries/ORCACDefs/quickdraw.h +++ b/bin/Libraries/ORCACDefs/quickdraw.h @@ -1 +1,390 @@ -/******************************************** * * QuickDraw II * * Copyright Apple Computer, Inc.1986-91 * All Rights Reserved * * Copyright 1992, 1993, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __QUICKDRAW__ #define __QUICKDRAW__ /* Error Codes */ #define alreadyInitialized 0x0401 /* Quickdraw already initialized */ #define cannotReset 0x0402 /* never used */ #define notInitialized 0x0403 /* Quickdraw not initialized */ #define screenReserved 0x0410 /* screen reserved */ #define badRect 0x0411 /* bad rectangle */ #define notEqualChunkiness 0x0420 /* Chunkiness is not equal */ #define rgnAlreadyOpen 0x0430 /* region is already open */ #define rgnNotOpen 0x0431 /* region is not open */ #define rgnScanOverflow 0x0432 /* region scan overflow */ #define rgnFull 0x0433 /* region is full */ #define polyAlreadyOpen 0x0440 /* poly is already open */ #define polyNotOpen 0x0441 /* poly is not open */ #define polyTooBig 0x0442 /* poly is too big */ #define badTableNum 0x0450 /* bad table number */ #define badColorNum 0x0451 /* bad color number */ #define badScanLine 0x0452 /* bad scan line */ #define notImplemented 0x04FF /* not implemented */ #define tsNumber 0x04 /* AnSCBByte Masks */ #define _colorTable 0x0F /* Mask for SCB color table */ #define scbReserved 0x10 /* Mask for SCB reserved bit */ #define scbFill 0x20 /* Mask for SCB fill bit */ #define scbInterrupt 0x40 /* Mask for SCB interrupt bit */ #define scbColorMode 0x80 /* Mask for SCB color mode bit */ /* ColorData */ #define table320 0x32 /* (val=size) */ #define table640 0x32 /* (val=size) */ /* ColorValue */ #define blueMask 0x000F /* Mask for Blue nibble */ #define greenMask 0x00F0 /* Mask for green nibble */ #define redMask 0x0F00 /* Mask for red nibble */ /* FontFlags */ #define widMaxSize 0x0001 #define zeroSize 0x0002 /* GrafPort Sizes */ #define maskSize 0x08 /* Mask Size (val=size) */ #define locSize 0x10 /* Loc Size (val=size) */ #define patsize 0x20 /* Pattern Size (val=size) */ #define pnStateSize 0x32 /* Pen State Size (Val=size) */ #define portSize 0xAA /* Size of GrafPort */ /* MasterColors */ #define black 0x000 /* These work in 320 and 640 mode */ #define blue 0x00F /* These work in 320 and 640 mode */ #define darkGreen320 0x080 /* These work in 320 mode */ #define green320 0x0E0 /* These work in 320 mode */ #define green640 0x0F0 /* These work in 640 mode */ #define lightBlue320 0x4DF /* These work in 320 mode */ #define purple320 0x72C /* These work in 320 mode */ #define darkGray320 0x777 /* These work in 320 mode */ #define periwinkleBlue320 0x78F /* These work in 320 mode */ #define brown320 0x841 /* These work in 320 mode */ #define lightGray320 0x0CCC /* These work in 320 mode */ #define red320 0x0D00 /* These work in 320 mode */ #define lilac320 0x0DAF /* These work in 320 mode */ #define red640 0x0F00 /* These work in 640 mode */ #define orange320 0x0F70 /* These work in 320 mode */ #define flesh320 0x0FA9 /* These work in 320 mode */ #define yellow 0x0FF0 /* These work in 320 and 640 mode */ #define white 0x0FFF /* These work in 320 and 640 mode */ /* PenMode Data */ #define modeCopy 0x0000 #define modeOR 0x0001 #define modeXOR 0x0002 #define modeBIC 0x0003 #define modeForeCopy 0x0004 #define modeForeOR 0x0005 #define modeForeXOR 0x0006 #define modeForeBIC 0x0007 #define modeNOT 0x8000 #define notCopy 0x8000 #define notOR 0x8001 #define notXOR 0x8002 #define notBIC 0x8003 #define notForeCOPY 0x8004 #define notForeOR 0x8005 #define notForeXOR 0x8006 #define notForeBIC 0x8007 /* QDStartup */ #define mode320 0x0000 /* Argument to QDStartup */ #define mode640 0x0080 /* Argument to QDStartup */ typedef Integer ColorValue; typedef Byte AnSCBByte; struct Cursor { Word cursorHeight; /* size in bytes */ Word cursorWidth; /* enclosing rectangle */ Word cursorData[1]; Word cursorMask[1]; Point cursorHotSpot; }; typedef struct Cursor Cursor, *CursorPtr, **CursorHndl; struct BufDimRec { Word maxWidth; Word textBufHeight; Word textBufferWords; Word fontWidth; }; typedef struct BufDimRec BufDimRec, *BufDimRecPtr, **BufDimRecHndl; struct FontGlobalsRecord { Word fgFontID; /* currently 12 bytes long, but may be expanded */ TextStyle fgStyle; Word fgSize; Word fgVersion; Word fgWidMax; Word fgFBRExtent; }; typedef struct FontGlobalsRecord FontGlobalsRecord, *FontGlobalsRecPtr, **FontGlobalsRecHndl; struct FontInfoRecord { Word ascent; Word descent; Word widMax; Word leading; }; typedef struct FontInfoRecord FontInfoRecord, *FontInfoRecPtr, **FontInfoRecHndl; struct PaintParam { LocInfoPtr ptrToSourceLocInfo; LocInfoPtr ptrToDestLocInfo; Rect *ptrToSourceRect; Point *ptrToDestPoint; Word mode; Handle maskHandle; /* clip region */ }; typedef struct PaintParam PaintParam, *PaintParamPtr, **PaintParamHndl; struct PenState { Point psPenLoc; Point psPenSize; Word psPenMode; Pattern psPenPat; Mask psPenMask; }; typedef struct PenState PenState, *PenStatePtr, **PenStateHndl; struct RomFontRec { Word rfFamNum; Word rfFamStyle; Word rfSize; FontHndl rfFontHandle; Pointer rfNamePtr; Word rfFBRExtent; }; typedef struct RomFontRec RomFontRec, *RomFontRecPtr, **RomFontRecHndl; extern pascal void QDBootInit(void) inline(0x0104,dispatcher); extern pascal void QDStartUp(Word, Word, Word, Word) inline(0x0204,dispatcher); extern pascal void QDShutDown(void) inline(0x0304,dispatcher); extern pascal Word QDVersion(void) inline(0x0404,dispatcher); extern pascal void QDReset(void) inline(0x0504,dispatcher); extern pascal Boolean QDStatus(void) inline(0x0604,dispatcher); extern pascal void AddPt(Point *, Point *) inline(0x8004,dispatcher); extern pascal void CharBounds(Word, Rect *) inline(0xAC04,dispatcher); extern pascal Word CharWidth(Word) inline(0xA804,dispatcher); extern pascal void ClearScreen(Word) inline(0x1504,dispatcher); extern pascal void ClipRect(Rect *) inline(0x2604,dispatcher); extern pascal void ClosePoly(void) inline(0xC204,dispatcher); extern pascal void ClosePort(GrafPortPtr) inline(0x1A04,dispatcher); extern pascal void CloseRgn(RegionHndl) inline(0x6E04,dispatcher); extern pascal void CopyRgn(RegionHndl, RegionHndl) inline(0x6904,dispatcher); extern pascal void CStringBounds(Pointer, Rect *) inline(0xAE04,dispatcher); extern pascal Word CStringWidth(Pointer) inline(0xAA04,dispatcher); extern pascal void DiffRgn(RegionHndl, RegionHndl, RegionHndl) inline(0x7304,dispatcher); extern pascal void DisposeRgn(RegionHndl) inline(0x6804,dispatcher); extern pascal void DrawChar(Word) inline(0xA404,dispatcher); extern pascal void DrawCString(Pointer) inline(0xA604,dispatcher); extern pascal void DrawString(Pointer) inline(0xA504,dispatcher); extern pascal void DrawText(Pointer, Word) inline(0xA704,dispatcher); extern pascal Boolean EmptyRgn(RegionHndl) inline(0x7804,dispatcher); extern pascal Boolean EqualPt(Point *, Point *) inline(0x8304,dispatcher); extern pascal Boolean EqualRect(Rect *, Rect *) inline(0x5104,dispatcher); extern pascal Boolean EqualRgn(RegionHndl, RegionHndl) inline(0x7704,dispatcher); extern pascal void EraseArc(Rect *, Integer, Integer) inline(0x6404,dispatcher); extern pascal void EraseOval(Rect *) inline(0x5A04,dispatcher); extern pascal void ErasePoly(Handle) inline(0xBE04,dispatcher); extern pascal void EraseRect(Rect *) inline(0x5504,dispatcher); extern pascal void EraseRgn(RegionHndl) inline(0x7B04,dispatcher); extern pascal void EraseRRect(Rect *, Word, Word) inline(0x5F04,dispatcher); extern pascal void FillArc(Rect *, Integer, Integer, Pattern) inline(0x6604,dispatcher); extern pascal void FillOval(Rect *, Pattern) inline(0x5C04,dispatcher); extern pascal void FillPoly(Handle, Pattern) inline(0xC004,dispatcher); extern pascal void FillRect(Rect *, Pattern) inline(0x5704,dispatcher); extern pascal void FillRgn(RegionHndl, Pattern) inline(0x7D04,dispatcher); extern pascal void FillRRect(Rect *, Word, Word, Pattern) inline(0x6104,dispatcher); extern pascal void ForceBufDims(Word, Word, Word) inline(0xCC04,dispatcher); extern pascal void FrameArc(Rect *, Integer, Integer) inline(0x6204,dispatcher); extern pascal void FrameOval(Rect *) inline(0x5804,dispatcher); extern pascal void FramePoly(Handle) inline(0xBC04,dispatcher); extern pascal void FrameRect(Rect *) inline(0x5304,dispatcher); extern pascal void FrameRgn(RegionHndl) inline(0x7904,dispatcher); extern pascal void FrameRRect(Rect *, Word, Word) inline(0x5D04,dispatcher); extern pascal Pointer GetAddress(Word) inline(0x0904,dispatcher); extern pascal Word GetArcRot(void) inline(0xB104,dispatcher); extern pascal Word GetBackColor(void) inline(0xA304,dispatcher); extern pascal void GetBackPat(Pattern) inline(0x3504,dispatcher); extern pascal Fixed GetCharExtra(void) inline(0xD504,dispatcher); extern pascal void GetClip(RegionHndl) inline(0x2504,dispatcher); extern pascal RegionHndl GetClipHandle(void) inline(0xC704,dispatcher); extern pascal Word GetColorEntry(Word, Word) inline(0x1104,dispatcher); extern pascal void GetColorTable(Word, ColorTable) inline(0x0F04,dispatcher); extern pascal Pointer GetCursorAdr(void) inline(0x8F04,dispatcher); extern pascal Word GetFGSize(void) inline(0xCF04,dispatcher); extern pascal FontHndl GetFont(void) inline(0x9504,dispatcher); extern pascal Word GetFontFlags(void) inline(0x9904,dispatcher); extern pascal void GetFontGlobals(FontGlobalsRecPtr) inline(0x9704,dispatcher); extern pascal Long GetFontID(void) inline(0xD104,dispatcher); extern pascal void GetFontInfo(FontInfoRecPtr) inline(0x9604,dispatcher); extern pascal Word GetFontLore(FontGlobalsRecPtr, Word) inline(0xD904,dispatcher); extern pascal Word GetForeColor(void) inline(0xA104,dispatcher); extern pascal QDProcsPtr GetGrafProcs(void) inline(0x4504,dispatcher); extern pascal Word GetMasterSCB(void) inline(0x1704,dispatcher); extern pascal void GetPen(Point *) inline(0x2904,dispatcher); extern pascal void GetPenMask(Mask) inline(0x3304,dispatcher); extern pascal Word GetPenMode(void) inline(0x2F04,dispatcher); extern pascal void GetPenPat(Pattern) inline(0x3104,dispatcher); extern pascal void GetPenSize(Point *) inline(0x2D04,dispatcher); extern pascal void GetPenState(PenStatePtr) inline(0x2B04,dispatcher); extern pascal Longint GetPicSave(void) inline(0x3F04,dispatcher); extern pascal Word GetPixel(Integer, Integer) inline(0x8804,dispatcher); extern pascal LongWord GetPolySave(void) inline(0x4304,dispatcher); extern pascal GrafPortPtr GetPort(void) inline(0x1C04,dispatcher); extern pascal void GetPortLoc(LocInfoPtr) inline(0x1E04,dispatcher); extern pascal void GetPortRect(Rect *) inline(0x2004,dispatcher); extern pascal LongWord GetRgnSave(void) inline(0x4104,dispatcher); extern pascal void GetROMFont(RomFontRecPtr) inline(0xD804,dispatcher); extern pascal void GetRomFont(RomFontRecPtr) inline(0xD804,dispatcher); extern pascal Word GetSCB(Word) inline(0x1304,dispatcher); extern pascal Fixed GetSpaceExtra(void) inline(0x9F04,dispatcher); extern pascal Word GetStandardSCB(void) inline(0x0C04,dispatcher); extern pascal Longint GetSysField(void) inline(0x4904,dispatcher); extern pascal FontHndl GetSysFont(void) inline(0xB304,dispatcher); extern pascal TextStyle GetTextFace(void) inline(0x9B04,dispatcher); extern pascal Word GetTextMode(void) inline(0x9D04,dispatcher); extern pascal Word GetTextSize(void) inline(0xD304,dispatcher); extern pascal Longint GetUserField(void) inline(0x4704,dispatcher); extern pascal RegionHndl GetVisHandle(void) inline(0xC904,dispatcher); extern pascal void GetVisRgn(RegionHndl) inline(0xB504,dispatcher); extern pascal void GlobalToLocal(Point *) inline(0x8504,dispatcher); extern pascal void GrafOff(void) inline(0x0B04,dispatcher); extern pascal void GrafOn(void) inline(0x0A04,dispatcher); extern pascal void HideCursor(void) inline(0x9004,dispatcher); extern pascal void HidePen(void) inline(0x2704,dispatcher); extern pascal void InflateTextBuffer(Word, Word) inline(0xD704,dispatcher); extern pascal void InitColorTable(ColorTable) inline(0x0D04,dispatcher); extern pascal void InitCursor(void) inline(0xCA04,dispatcher); extern pascal void InitPort(GrafPortPtr) inline(0x1904,dispatcher); extern pascal void InsetRect(Rect *, Integer, Integer) inline(0x4C04,dispatcher); extern pascal void InsetRgn(RegionHndl, Integer, Integer) inline(0x7004,dispatcher); extern pascal void InvertArc(Rect *, Integer, Integer) inline(0x6504,dispatcher); extern pascal void InvertOval(Rect *) inline(0x5B04,dispatcher); extern pascal void InvertPoly(Handle) inline(0xBF04,dispatcher); extern pascal void InvertRect(Rect *) inline(0x5604,dispatcher); extern pascal void InvertRgn(RegionHndl) inline(0x7C04,dispatcher); extern pascal void InvertRRect(Rect *, Word, Word) inline(0x6004,dispatcher); extern pascal void KillPoly(Handle) inline(0xC304,dispatcher); extern pascal void Line(Integer, Integer) inline(0x3D04,dispatcher); extern pascal void LineTo(Integer, Integer) inline(0x3C04,dispatcher); extern pascal void LocalToGlobal(Point *) inline(0x8404,dispatcher); extern pascal void MapPoly(Handle, Rect *, Rect *) inline(0xC504,dispatcher); extern pascal void MapPt(Point *, Rect *, Rect *) inline(0x8A04,dispatcher); extern pascal void MapRect(Rect *, Rect *, Rect *) inline(0x8B04,dispatcher); extern pascal void MapRgn(RegionHndl, Rect *, Rect *) inline(0x8C04,dispatcher); extern pascal void Move(Integer, Integer) inline(0x3B04,dispatcher); extern pascal void MovePortTo(Integer, Integer) inline(0x2204,dispatcher); extern pascal void MoveTo(Integer, Integer) inline(0x3A04,dispatcher); extern pascal RegionHndl NewRgn(void) inline(0x6704,dispatcher); extern pascal Boolean NotEmptyRect(Rect *) inline(0x5204,dispatcher); extern pascal void ObscureCursor(void) inline(0x9204,dispatcher); extern pascal void OffsetPoly(Handle, Integer, Integer) inline(0xC404,dispatcher); extern pascal void OffsetRect(Rect *, Integer, Integer) inline(0x4B04,dispatcher); extern pascal void OffsetRgn(RegionHndl, Integer, Integer) inline(0x6F04,dispatcher); extern pascal handle OpenPoly(void) inline(0xC104,dispatcher); extern pascal void OpenPort(GrafPortPtr) inline(0x1804,dispatcher); extern pascal void OpenRgn(void) inline(0x6D04,dispatcher); extern pascal void PaintArc(Rect *, Integer, Integer) inline(0x6304,dispatcher); extern pascal void PaintOval(Rect *) inline(0x5904,dispatcher); extern pascal void PaintPixels(PaintParamPtr) inline(0x7F04,dispatcher); extern pascal void PaintPoly(Handle) inline(0xBD04,dispatcher); extern pascal void PaintRect(Rect *) inline(0x5404,dispatcher); extern pascal void PaintRgn(RegionHndl) inline(0x7A04,dispatcher); extern pascal void PaintRRect(Rect *, Word, Word) inline(0x5E04,dispatcher); extern pascal void PenNormal(void) inline(0x3604,dispatcher); extern pascal void PPToPort(LocInfoPtr, Rect *, Integer, Integer, Word) inline(0xD604,dispatcher); extern pascal void Pt2Rect(Point *, Point *, Rect *) inline(0x5004,dispatcher); extern pascal Boolean PtInRect(Point *, Rect *) inline(0x4F04,dispatcher); extern pascal Boolean PtInRgn(Point *, RegionHndl) inline(0x7504,dispatcher); extern pascal Word Random(void) inline(0x8604,dispatcher); extern pascal Boolean RectInRgn(Rect *, RegionHndl) inline(0x7604,dispatcher); extern pascal void RectRgn(RegionHndl, Rect *) inline(0x6C04,dispatcher); extern pascal void RestoreBufDims(BufDimRecPtr) inline(0xCE04,dispatcher); extern pascal void SaveBufDims(BufDimRecPtr) inline(0xCD04,dispatcher); extern pascal void ScalePt(Point *, Rect *, Rect *) inline(0x8904,dispatcher); extern pascal void ScrollRect(Rect *, Integer, Integer, RegionHndl) inline(0x7E04,dispatcher); extern pascal Boolean SectRect(Rect *, Rect *, Rect *) inline(0x4D04,dispatcher); extern pascal void SectRgn(RegionHndl, RegionHndl, RegionHndl) inline(0x7104,dispatcher); extern pascal void SetAllSCBs(Word) inline(0x1404,dispatcher); extern pascal void SetArcRot(Integer) inline(0xB004,dispatcher); extern pascal void SetBackColor(Word) inline(0xA204,dispatcher); extern pascal void SetBackPat(Pattern) inline(0x3404,dispatcher); extern pascal void SetBufDims(Word, Word, Word) inline(0xCB04,dispatcher); extern pascal void SetCharExtra(Fixed) inline(0xD404,dispatcher); extern pascal void SetClip(RegionHndl) inline(0x2404,dispatcher); extern pascal void SetClipHandle(RegionHndl) inline(0xC604,dispatcher); extern pascal void SetColorEntry(Word, Word, ColorValue) inline(0x1004,dispatcher); extern pascal void SetColorTable(Word, ColorTable) inline(0x0E04,dispatcher); extern pascal void SetCursor(Pointer) inline(0x8E04,dispatcher); extern pascal void SetEmptyRgn(RegionHndl) inline(0x6A04,dispatcher); extern pascal void SetFont(FontHndl) inline(0x9404,dispatcher); extern pascal void SetFontFlags(Word) inline(0x9804,dispatcher); extern pascal void SetFontID(FontID) inline(0xD004,dispatcher); extern pascal void SetForeColor(Word) inline(0xA004,dispatcher); extern pascal void SetGrafProcs(QDProcsPtr) inline(0x4404,dispatcher); extern pascal void SetIntUse(Word) inline(0xB604,dispatcher); extern pascal void SetMasterSCB(Word) inline(0x1604,dispatcher); extern pascal void SetOrigin(Integer, Integer) inline(0x2304,dispatcher); extern pascal void SetPenMask(Mask) inline(0x3204,dispatcher); extern pascal void SetPenMode(Word) inline(0x2E04,dispatcher); extern pascal void SetPenPat(Pattern) inline(0x3004,dispatcher); extern pascal void SetPenSize(Word, Word) inline(0x2C04,dispatcher); extern pascal void SetPenState(PenStatePtr) inline(0x2A04,dispatcher); extern pascal void SetPicSave(Longint) inline(0x3E04,dispatcher); extern pascal void SetPolySave(Longint) inline(0x4204,dispatcher); extern pascal void SetPort(GrafPortPtr) inline(0x1B04,dispatcher); extern pascal void SetPortLoc(LocInfoPtr) inline(0x1D04,dispatcher); extern pascal void SetPortRect(Rect *) inline(0x1F04,dispatcher); extern pascal void SetPortSize(Word, Word) inline(0x2104,dispatcher); extern pascal void SetPt(Point *, Integer, Integer) inline(0x8204,dispatcher); extern pascal void SetRandSeed(Longint) inline(0x8704,dispatcher); extern pascal void SetRect(Rect *, Integer, Integer, Integer, Integer) inline(0x4A04,dispatcher); extern pascal void SetRectRgn(RegionHndl, Integer, Integer, Integer, Integer) inline(0x6B04,dispatcher); extern pascal void SetRgnSave(Handle) inline(0x4004,dispatcher); extern pascal void SetSCB(Word, Word) inline(0x1204,dispatcher); extern pascal void SetSolidBackPat(Word) inline(0x3804,dispatcher); extern pascal void SetSolidPenPat(Word) inline(0x3704,dispatcher); extern pascal void SetSpaceExtra(Fixed) inline(0x9E04,dispatcher); extern pascal void SetStdProcs(QDProcsPtr) inline(0x8D04,dispatcher); extern pascal void SetSysField(Longint) inline(0x4804,dispatcher); extern pascal void SetSysFont(FontHndl) inline(0xB204,dispatcher); extern pascal void SetTextFace(TextStyle) inline(0x9A04,dispatcher); extern pascal void SetTextMode(Word) inline(0x9C04,dispatcher); extern pascal void SetTextSize(Word) inline(0xD204,dispatcher); extern pascal void SetUserField(Longint) inline(0x4604,dispatcher); extern pascal void SetVisHandle(RegionHndl) inline(0xC804,dispatcher); extern pascal void SetVisRgn(RegionHndl) inline(0xB404,dispatcher); extern pascal void ShowCursor(void) inline(0x9104,dispatcher); extern pascal void ShowPen(void) inline(0x2804,dispatcher); extern pascal void SolidPattern(Word, Pattern) inline(0x3904,dispatcher); extern pascal void StringBounds(Pointer, Rect *) inline(0xAD04,dispatcher); extern pascal Word StringWidth(Pointer) inline(0xA904,dispatcher); extern pascal void SubPt(Point *, Point *) inline(0x8104,dispatcher); extern pascal void TextBounds(Pointer, Word, Rect *) inline(0xAF04,dispatcher); extern pascal Word TextWidth(Pointer, Word) inline(0xAB04,dispatcher); extern pascal void UnionRect(Rect *, Rect *, Rect *) inline(0x4E04,dispatcher); extern pascal void UnionRgn(RegionHndl, RegionHndl, RegionHndl) inline(0x7204,dispatcher); extern pascal void XorRgn(RegionHndl, RegionHndl, RegionHndl) inline(0x7404,dispatcher); extern pascal PatternPtr Get640Colors(void) inline(0xDA04,dispatcher); extern pascal void Set640Color(Word) inline(0xDB04,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* QuickDraw II +* +* Copyright Apple Computer, Inc.1986-91 +* All Rights Reserved +* +* Copyright 1992, 1993, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __QUICKDRAW__ +#define __QUICKDRAW__ + +/* Error Codes */ +#define alreadyInitialized 0x0401 /* Quickdraw already initialized */ +#define cannotReset 0x0402 /* never used */ +#define notInitialized 0x0403 /* Quickdraw not initialized */ +#define screenReserved 0x0410 /* screen reserved */ +#define badRect 0x0411 /* bad rectangle */ +#define notEqualChunkiness 0x0420 /* Chunkiness is not equal */ +#define rgnAlreadyOpen 0x0430 /* region is already open */ +#define rgnNotOpen 0x0431 /* region is not open */ +#define rgnScanOverflow 0x0432 /* region scan overflow */ +#define rgnFull 0x0433 /* region is full */ +#define polyAlreadyOpen 0x0440 /* poly is already open */ +#define polyNotOpen 0x0441 /* poly is not open */ +#define polyTooBig 0x0442 /* poly is too big */ +#define badTableNum 0x0450 /* bad table number */ +#define badColorNum 0x0451 /* bad color number */ +#define badScanLine 0x0452 /* bad scan line */ +#define notImplemented 0x04FF /* not implemented */ + +#define tsNumber 0x04 + +/* AnSCBByte Masks */ +#define _colorTable 0x0F /* Mask for SCB color table */ +#define scbReserved 0x10 /* Mask for SCB reserved bit */ +#define scbFill 0x20 /* Mask for SCB fill bit */ +#define scbInterrupt 0x40 /* Mask for SCB interrupt bit */ +#define scbColorMode 0x80 /* Mask for SCB color mode bit */ + +/* ColorData */ +#define table320 0x32 /* (val=size) */ +#define table640 0x32 /* (val=size) */ + +/* ColorValue */ +#define blueMask 0x000F /* Mask for Blue nibble */ +#define greenMask 0x00F0 /* Mask for green nibble */ +#define redMask 0x0F00 /* Mask for red nibble */ + +/* FontFlags */ +#define widMaxSize 0x0001 +#define zeroSize 0x0002 + +/* GrafPort Sizes */ +#define maskSize 0x08 /* Mask Size (val=size) */ +#define locSize 0x10 /* Loc Size (val=size) */ +#define patsize 0x20 /* Pattern Size (val=size) */ +#define pnStateSize 0x32 /* Pen State Size (Val=size) */ +#define portSize 0xAA /* Size of GrafPort */ + +/* MasterColors */ +#define black 0x000 /* These work in 320 and 640 mode */ +#define blue 0x00F /* These work in 320 and 640 mode */ +#define darkGreen320 0x080 /* These work in 320 mode */ +#define green320 0x0E0 /* These work in 320 mode */ +#define green640 0x0F0 /* These work in 640 mode */ +#define lightBlue320 0x4DF /* These work in 320 mode */ +#define purple320 0x72C /* These work in 320 mode */ +#define darkGray320 0x777 /* These work in 320 mode */ +#define periwinkleBlue320 0x78F /* These work in 320 mode */ +#define brown320 0x841 /* These work in 320 mode */ +#define lightGray320 0x0CCC /* These work in 320 mode */ +#define red320 0x0D00 /* These work in 320 mode */ +#define lilac320 0x0DAF /* These work in 320 mode */ +#define red640 0x0F00 /* These work in 640 mode */ +#define orange320 0x0F70 /* These work in 320 mode */ +#define flesh320 0x0FA9 /* These work in 320 mode */ +#define yellow 0x0FF0 /* These work in 320 and 640 mode */ +#define white 0x0FFF /* These work in 320 and 640 mode */ + +/* PenMode Data */ +#define modeCopy 0x0000 +#define modeOR 0x0001 +#define modeXOR 0x0002 +#define modeBIC 0x0003 +#define modeForeCopy 0x0004 +#define modeForeOR 0x0005 +#define modeForeXOR 0x0006 +#define modeForeBIC 0x0007 +#define modeNOT 0x8000 +#define notCopy 0x8000 +#define notOR 0x8001 +#define notXOR 0x8002 +#define notBIC 0x8003 +#define notForeCOPY 0x8004 +#define notForeOR 0x8005 +#define notForeXOR 0x8006 +#define notForeBIC 0x8007 + +/* QDStartup */ +#define mode320 0x0000 /* Argument to QDStartup */ +#define mode640 0x0080 /* Argument to QDStartup */ + +typedef Integer ColorValue; +typedef Byte AnSCBByte; +struct Cursor { + Word cursorHeight; /* size in bytes */ + Word cursorWidth; /* enclosing rectangle */ + Word cursorData[1]; + Word cursorMask[1]; + Point cursorHotSpot; + }; +typedef struct Cursor Cursor, *CursorPtr, **CursorHndl; + +struct BufDimRec { + Word maxWidth; + Word textBufHeight; + Word textBufferWords; + Word fontWidth; + }; +typedef struct BufDimRec BufDimRec, *BufDimRecPtr, **BufDimRecHndl; + +struct FontGlobalsRecord { + Word fgFontID; /* currently 12 bytes long, but may be expanded */ + TextStyle fgStyle; + Word fgSize; + Word fgVersion; + Word fgWidMax; + Word fgFBRExtent; + }; +typedef struct FontGlobalsRecord FontGlobalsRecord, *FontGlobalsRecPtr, **FontGlobalsRecHndl; + +struct FontInfoRecord { + Word ascent; + Word descent; + Word widMax; + Word leading; + }; +typedef struct FontInfoRecord FontInfoRecord, *FontInfoRecPtr, **FontInfoRecHndl; + +struct PaintParam { + LocInfoPtr ptrToSourceLocInfo; + LocInfoPtr ptrToDestLocInfo; + Rect *ptrToSourceRect; + Point *ptrToDestPoint; + Word mode; + Handle maskHandle; /* clip region */ + }; +typedef struct PaintParam PaintParam, *PaintParamPtr, **PaintParamHndl; + +struct PenState { + Point psPenLoc; + Point psPenSize; + Word psPenMode; + Pattern psPenPat; + Mask psPenMask; + }; +typedef struct PenState PenState, *PenStatePtr, **PenStateHndl; + +struct RomFontRec { + Word rfFamNum; + Word rfFamStyle; + Word rfSize; + FontHndl rfFontHandle; + Pointer rfNamePtr; + Word rfFBRExtent; + }; +typedef struct RomFontRec RomFontRec, *RomFontRecPtr, **RomFontRecHndl; + +extern pascal void QDBootInit(void) inline(0x0104,dispatcher); +extern pascal void QDStartUp(Word, Word, Word, Word) inline(0x0204,dispatcher); +extern pascal void QDShutDown(void) inline(0x0304,dispatcher); +extern pascal Word QDVersion(void) inline(0x0404,dispatcher); +extern pascal void QDReset(void) inline(0x0504,dispatcher); +extern pascal Boolean QDStatus(void) inline(0x0604,dispatcher); +extern pascal void AddPt(Point *, Point *) inline(0x8004,dispatcher); +extern pascal void CharBounds(Word, Rect *) inline(0xAC04,dispatcher); +extern pascal Word CharWidth(Word) inline(0xA804,dispatcher); +extern pascal void ClearScreen(Word) inline(0x1504,dispatcher); +extern pascal void ClipRect(Rect *) inline(0x2604,dispatcher); +extern pascal void ClosePoly(void) inline(0xC204,dispatcher); +extern pascal void ClosePort(GrafPortPtr) inline(0x1A04,dispatcher); +extern pascal void CloseRgn(RegionHndl) inline(0x6E04,dispatcher); +extern pascal void CopyRgn(RegionHndl, RegionHndl) inline(0x6904,dispatcher); +extern pascal void CStringBounds(Pointer, Rect *) inline(0xAE04,dispatcher); +extern pascal Word CStringWidth(Pointer) inline(0xAA04,dispatcher); +extern pascal void DiffRgn(RegionHndl, RegionHndl, RegionHndl) inline(0x7304,dispatcher); +extern pascal void DisposeRgn(RegionHndl) inline(0x6804,dispatcher); +extern pascal void DrawChar(Word) inline(0xA404,dispatcher); +extern pascal void DrawCString(Pointer) inline(0xA604,dispatcher); +extern pascal void DrawString(Pointer) inline(0xA504,dispatcher); +extern pascal void DrawText(Pointer, Word) inline(0xA704,dispatcher); +extern pascal Boolean EmptyRgn(RegionHndl) inline(0x7804,dispatcher); +extern pascal Boolean EqualPt(Point *, Point *) inline(0x8304,dispatcher); +extern pascal Boolean EqualRect(Rect *, Rect *) inline(0x5104,dispatcher); +extern pascal Boolean EqualRgn(RegionHndl, RegionHndl) inline(0x7704,dispatcher); +extern pascal void EraseArc(Rect *, Integer, Integer) inline(0x6404,dispatcher); +extern pascal void EraseOval(Rect *) inline(0x5A04,dispatcher); +extern pascal void ErasePoly(Handle) inline(0xBE04,dispatcher); +extern pascal void EraseRect(Rect *) inline(0x5504,dispatcher); +extern pascal void EraseRgn(RegionHndl) inline(0x7B04,dispatcher); +extern pascal void EraseRRect(Rect *, Word, Word) inline(0x5F04,dispatcher); +extern pascal void FillArc(Rect *, Integer, Integer, Pattern) inline(0x6604,dispatcher); +extern pascal void FillOval(Rect *, Pattern) inline(0x5C04,dispatcher); +extern pascal void FillPoly(Handle, Pattern) inline(0xC004,dispatcher); +extern pascal void FillRect(Rect *, Pattern) inline(0x5704,dispatcher); +extern pascal void FillRgn(RegionHndl, Pattern) inline(0x7D04,dispatcher); +extern pascal void FillRRect(Rect *, Word, Word, Pattern) inline(0x6104,dispatcher); +extern pascal void ForceBufDims(Word, Word, Word) inline(0xCC04,dispatcher); +extern pascal void FrameArc(Rect *, Integer, Integer) inline(0x6204,dispatcher); +extern pascal void FrameOval(Rect *) inline(0x5804,dispatcher); +extern pascal void FramePoly(Handle) inline(0xBC04,dispatcher); +extern pascal void FrameRect(Rect *) inline(0x5304,dispatcher); +extern pascal void FrameRgn(RegionHndl) inline(0x7904,dispatcher); +extern pascal void FrameRRect(Rect *, Word, Word) inline(0x5D04,dispatcher); +extern pascal Pointer GetAddress(Word) inline(0x0904,dispatcher); +extern pascal Word GetArcRot(void) inline(0xB104,dispatcher); +extern pascal Word GetBackColor(void) inline(0xA304,dispatcher); +extern pascal void GetBackPat(Pattern) inline(0x3504,dispatcher); +extern pascal Fixed GetCharExtra(void) inline(0xD504,dispatcher); +extern pascal void GetClip(RegionHndl) inline(0x2504,dispatcher); +extern pascal RegionHndl GetClipHandle(void) inline(0xC704,dispatcher); +extern pascal Word GetColorEntry(Word, Word) inline(0x1104,dispatcher); +extern pascal void GetColorTable(Word, ColorTable) inline(0x0F04,dispatcher); +extern pascal Pointer GetCursorAdr(void) inline(0x8F04,dispatcher); +extern pascal Word GetFGSize(void) inline(0xCF04,dispatcher); +extern pascal FontHndl GetFont(void) inline(0x9504,dispatcher); +extern pascal Word GetFontFlags(void) inline(0x9904,dispatcher); +extern pascal void GetFontGlobals(FontGlobalsRecPtr) inline(0x9704,dispatcher); +extern pascal Long GetFontID(void) inline(0xD104,dispatcher); +extern pascal void GetFontInfo(FontInfoRecPtr) inline(0x9604,dispatcher); +extern pascal Word GetFontLore(FontGlobalsRecPtr, Word) inline(0xD904,dispatcher); +extern pascal Word GetForeColor(void) inline(0xA104,dispatcher); +extern pascal QDProcsPtr GetGrafProcs(void) inline(0x4504,dispatcher); +extern pascal Word GetMasterSCB(void) inline(0x1704,dispatcher); +extern pascal void GetPen(Point *) inline(0x2904,dispatcher); +extern pascal void GetPenMask(Mask) inline(0x3304,dispatcher); +extern pascal Word GetPenMode(void) inline(0x2F04,dispatcher); +extern pascal void GetPenPat(Pattern) inline(0x3104,dispatcher); +extern pascal void GetPenSize(Point *) inline(0x2D04,dispatcher); +extern pascal void GetPenState(PenStatePtr) inline(0x2B04,dispatcher); +extern pascal Longint GetPicSave(void) inline(0x3F04,dispatcher); +extern pascal Word GetPixel(Integer, Integer) inline(0x8804,dispatcher); +extern pascal LongWord GetPolySave(void) inline(0x4304,dispatcher); +extern pascal GrafPortPtr GetPort(void) inline(0x1C04,dispatcher); +extern pascal void GetPortLoc(LocInfoPtr) inline(0x1E04,dispatcher); +extern pascal void GetPortRect(Rect *) inline(0x2004,dispatcher); +extern pascal LongWord GetRgnSave(void) inline(0x4104,dispatcher); +extern pascal void GetROMFont(RomFontRecPtr) inline(0xD804,dispatcher); +extern pascal void GetRomFont(RomFontRecPtr) inline(0xD804,dispatcher); +extern pascal Word GetSCB(Word) inline(0x1304,dispatcher); +extern pascal Fixed GetSpaceExtra(void) inline(0x9F04,dispatcher); +extern pascal Word GetStandardSCB(void) inline(0x0C04,dispatcher); +extern pascal Longint GetSysField(void) inline(0x4904,dispatcher); +extern pascal FontHndl GetSysFont(void) inline(0xB304,dispatcher); +extern pascal TextStyle GetTextFace(void) inline(0x9B04,dispatcher); +extern pascal Word GetTextMode(void) inline(0x9D04,dispatcher); +extern pascal Word GetTextSize(void) inline(0xD304,dispatcher); +extern pascal Longint GetUserField(void) inline(0x4704,dispatcher); +extern pascal RegionHndl GetVisHandle(void) inline(0xC904,dispatcher); +extern pascal void GetVisRgn(RegionHndl) inline(0xB504,dispatcher); +extern pascal void GlobalToLocal(Point *) inline(0x8504,dispatcher); +extern pascal void GrafOff(void) inline(0x0B04,dispatcher); +extern pascal void GrafOn(void) inline(0x0A04,dispatcher); +extern pascal void HideCursor(void) inline(0x9004,dispatcher); +extern pascal void HidePen(void) inline(0x2704,dispatcher); +extern pascal void InflateTextBuffer(Word, Word) inline(0xD704,dispatcher); +extern pascal void InitColorTable(ColorTable) inline(0x0D04,dispatcher); +extern pascal void InitCursor(void) inline(0xCA04,dispatcher); +extern pascal void InitPort(GrafPortPtr) inline(0x1904,dispatcher); +extern pascal void InsetRect(Rect *, Integer, Integer) inline(0x4C04,dispatcher); +extern pascal void InsetRgn(RegionHndl, Integer, Integer) inline(0x7004,dispatcher); +extern pascal void InvertArc(Rect *, Integer, Integer) inline(0x6504,dispatcher); +extern pascal void InvertOval(Rect *) inline(0x5B04,dispatcher); +extern pascal void InvertPoly(Handle) inline(0xBF04,dispatcher); +extern pascal void InvertRect(Rect *) inline(0x5604,dispatcher); +extern pascal void InvertRgn(RegionHndl) inline(0x7C04,dispatcher); +extern pascal void InvertRRect(Rect *, Word, Word) inline(0x6004,dispatcher); +extern pascal void KillPoly(Handle) inline(0xC304,dispatcher); +extern pascal void Line(Integer, Integer) inline(0x3D04,dispatcher); +extern pascal void LineTo(Integer, Integer) inline(0x3C04,dispatcher); +extern pascal void LocalToGlobal(Point *) inline(0x8404,dispatcher); +extern pascal void MapPoly(Handle, Rect *, Rect *) inline(0xC504,dispatcher); +extern pascal void MapPt(Point *, Rect *, Rect *) inline(0x8A04,dispatcher); +extern pascal void MapRect(Rect *, Rect *, Rect *) inline(0x8B04,dispatcher); +extern pascal void MapRgn(RegionHndl, Rect *, Rect *) inline(0x8C04,dispatcher); +extern pascal void Move(Integer, Integer) inline(0x3B04,dispatcher); +extern pascal void MovePortTo(Integer, Integer) inline(0x2204,dispatcher); +extern pascal void MoveTo(Integer, Integer) inline(0x3A04,dispatcher); +extern pascal RegionHndl NewRgn(void) inline(0x6704,dispatcher); +extern pascal Boolean NotEmptyRect(Rect *) inline(0x5204,dispatcher); +extern pascal void ObscureCursor(void) inline(0x9204,dispatcher); +extern pascal void OffsetPoly(Handle, Integer, Integer) inline(0xC404,dispatcher); +extern pascal void OffsetRect(Rect *, Integer, Integer) inline(0x4B04,dispatcher); +extern pascal void OffsetRgn(RegionHndl, Integer, Integer) inline(0x6F04,dispatcher); +extern pascal handle OpenPoly(void) inline(0xC104,dispatcher); +extern pascal void OpenPort(GrafPortPtr) inline(0x1804,dispatcher); +extern pascal void OpenRgn(void) inline(0x6D04,dispatcher); +extern pascal void PaintArc(Rect *, Integer, Integer) inline(0x6304,dispatcher); +extern pascal void PaintOval(Rect *) inline(0x5904,dispatcher); +extern pascal void PaintPixels(PaintParamPtr) inline(0x7F04,dispatcher); +extern pascal void PaintPoly(Handle) inline(0xBD04,dispatcher); +extern pascal void PaintRect(Rect *) inline(0x5404,dispatcher); +extern pascal void PaintRgn(RegionHndl) inline(0x7A04,dispatcher); +extern pascal void PaintRRect(Rect *, Word, Word) inline(0x5E04,dispatcher); +extern pascal void PenNormal(void) inline(0x3604,dispatcher); +extern pascal void PPToPort(LocInfoPtr, Rect *, Integer, Integer, Word) inline(0xD604,dispatcher); +extern pascal void Pt2Rect(Point *, Point *, Rect *) inline(0x5004,dispatcher); +extern pascal Boolean PtInRect(Point *, Rect *) inline(0x4F04,dispatcher); +extern pascal Boolean PtInRgn(Point *, RegionHndl) inline(0x7504,dispatcher); +extern pascal Word Random(void) inline(0x8604,dispatcher); +extern pascal Boolean RectInRgn(Rect *, RegionHndl) inline(0x7604,dispatcher); +extern pascal void RectRgn(RegionHndl, Rect *) inline(0x6C04,dispatcher); +extern pascal void RestoreBufDims(BufDimRecPtr) inline(0xCE04,dispatcher); +extern pascal void SaveBufDims(BufDimRecPtr) inline(0xCD04,dispatcher); +extern pascal void ScalePt(Point *, Rect *, Rect *) inline(0x8904,dispatcher); +extern pascal void ScrollRect(Rect *, Integer, Integer, RegionHndl) inline(0x7E04,dispatcher); +extern pascal Boolean SectRect(Rect *, Rect *, Rect *) inline(0x4D04,dispatcher); +extern pascal void SectRgn(RegionHndl, RegionHndl, RegionHndl) inline(0x7104,dispatcher); +extern pascal void SetAllSCBs(Word) inline(0x1404,dispatcher); +extern pascal void SetArcRot(Integer) inline(0xB004,dispatcher); +extern pascal void SetBackColor(Word) inline(0xA204,dispatcher); +extern pascal void SetBackPat(Pattern) inline(0x3404,dispatcher); +extern pascal void SetBufDims(Word, Word, Word) inline(0xCB04,dispatcher); +extern pascal void SetCharExtra(Fixed) inline(0xD404,dispatcher); +extern pascal void SetClip(RegionHndl) inline(0x2404,dispatcher); +extern pascal void SetClipHandle(RegionHndl) inline(0xC604,dispatcher); +extern pascal void SetColorEntry(Word, Word, ColorValue) inline(0x1004,dispatcher); +extern pascal void SetColorTable(Word, ColorTable) inline(0x0E04,dispatcher); +extern pascal void SetCursor(Pointer) inline(0x8E04,dispatcher); +extern pascal void SetEmptyRgn(RegionHndl) inline(0x6A04,dispatcher); +extern pascal void SetFont(FontHndl) inline(0x9404,dispatcher); +extern pascal void SetFontFlags(Word) inline(0x9804,dispatcher); +extern pascal void SetFontID(FontID) inline(0xD004,dispatcher); +extern pascal void SetForeColor(Word) inline(0xA004,dispatcher); +extern pascal void SetGrafProcs(QDProcsPtr) inline(0x4404,dispatcher); +extern pascal void SetIntUse(Word) inline(0xB604,dispatcher); +extern pascal void SetMasterSCB(Word) inline(0x1604,dispatcher); +extern pascal void SetOrigin(Integer, Integer) inline(0x2304,dispatcher); +extern pascal void SetPenMask(Mask) inline(0x3204,dispatcher); +extern pascal void SetPenMode(Word) inline(0x2E04,dispatcher); +extern pascal void SetPenPat(Pattern) inline(0x3004,dispatcher); +extern pascal void SetPenSize(Word, Word) inline(0x2C04,dispatcher); +extern pascal void SetPenState(PenStatePtr) inline(0x2A04,dispatcher); +extern pascal void SetPicSave(Longint) inline(0x3E04,dispatcher); +extern pascal void SetPolySave(Longint) inline(0x4204,dispatcher); +extern pascal void SetPort(GrafPortPtr) inline(0x1B04,dispatcher); +extern pascal void SetPortLoc(LocInfoPtr) inline(0x1D04,dispatcher); +extern pascal void SetPortRect(Rect *) inline(0x1F04,dispatcher); +extern pascal void SetPortSize(Word, Word) inline(0x2104,dispatcher); +extern pascal void SetPt(Point *, Integer, Integer) inline(0x8204,dispatcher); +extern pascal void SetRandSeed(Longint) inline(0x8704,dispatcher); +extern pascal void SetRect(Rect *, Integer, Integer, Integer, Integer) inline(0x4A04,dispatcher); +extern pascal void SetRectRgn(RegionHndl, Integer, Integer, Integer, Integer) inline(0x6B04,dispatcher); +extern pascal void SetRgnSave(Handle) inline(0x4004,dispatcher); +extern pascal void SetSCB(Word, Word) inline(0x1204,dispatcher); +extern pascal void SetSolidBackPat(Word) inline(0x3804,dispatcher); +extern pascal void SetSolidPenPat(Word) inline(0x3704,dispatcher); +extern pascal void SetSpaceExtra(Fixed) inline(0x9E04,dispatcher); +extern pascal void SetStdProcs(QDProcsPtr) inline(0x8D04,dispatcher); +extern pascal void SetSysField(Longint) inline(0x4804,dispatcher); +extern pascal void SetSysFont(FontHndl) inline(0xB204,dispatcher); +extern pascal void SetTextFace(TextStyle) inline(0x9A04,dispatcher); +extern pascal void SetTextMode(Word) inline(0x9C04,dispatcher); +extern pascal void SetTextSize(Word) inline(0xD204,dispatcher); +extern pascal void SetUserField(Longint) inline(0x4604,dispatcher); +extern pascal void SetVisHandle(RegionHndl) inline(0xC804,dispatcher); +extern pascal void SetVisRgn(RegionHndl) inline(0xB404,dispatcher); +extern pascal void ShowCursor(void) inline(0x9104,dispatcher); +extern pascal void ShowPen(void) inline(0x2804,dispatcher); +extern pascal void SolidPattern(Word, Pattern) inline(0x3904,dispatcher); +extern pascal void StringBounds(Pointer, Rect *) inline(0xAD04,dispatcher); +extern pascal Word StringWidth(Pointer) inline(0xA904,dispatcher); +extern pascal void SubPt(Point *, Point *) inline(0x8104,dispatcher); +extern pascal void TextBounds(Pointer, Word, Rect *) inline(0xAF04,dispatcher); +extern pascal Word TextWidth(Pointer, Word) inline(0xAB04,dispatcher); +extern pascal void UnionRect(Rect *, Rect *, Rect *) inline(0x4E04,dispatcher); +extern pascal void UnionRgn(RegionHndl, RegionHndl, RegionHndl) inline(0x7204,dispatcher); +extern pascal void XorRgn(RegionHndl, RegionHndl, RegionHndl) inline(0x7404,dispatcher); + +extern pascal PatternPtr Get640Colors(void) inline(0xDA04,dispatcher); +extern pascal void Set640Color(Word) inline(0xDB04,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/resources.h b/bin/Libraries/ORCACDefs/resources.h index 86fd745..aa78559 100644 --- a/bin/Libraries/ORCACDefs/resources.h +++ b/bin/Libraries/ORCACDefs/resources.h @@ -1 +1,227 @@ -/******************************************** * * Resource Manager * * Copyright Apple Computer, Inc.1986-92 * All Rights Reserved * * Copyright 1992, 1993, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __RESOURCES__ #define __RESOURCES__ /* ResourceConverter Codes */ #define resLogOut 0x0 #define resLogIn 0x1 #define resLogApp 0x0 #define resLogSys 0x2 /* Error Codes */ #define resForkUsed 0x1E01 /* Resource fork not empty */ #define resBadFormat 0x1E02 /* Format of resource fork is unknown */ #define resNoConverter 0x1E03 /* No converter routine available for resource type */ #define resNoCurFile 0x1E04 /* there are no current open resource files */ #define resDupID 0x1E05 /* ID is already used */ #define resNotFound 0x1E06 /* resource was not found */ #define resFileNotFound 0x1E07 /* resource file not found */ #define resBadAppID 0x1E08 /* User ID not found, please call ResourceStartup */ #define resNoUniqueID 0x1E09 /* a unique ID was not found */ #ifndef resIndexRange /* Index is out of range */ #define resIndexRange 0x1E0A #endif #define resSysIsOpen 0x1E0B /* System file is already open */ #define resHasChanged 0x1E0C /* Resource marked changed; specified operation not allowed */ #define resDiffConverter 0x1E0D /* Different converter already logged in for this resource type */ #define resDiskFull 0x1E0E /* Volume is full */ #define resInvalidShutDown 0x1E0F /* can't shut down ID 401E */ #define resNameNotFound 0x1E10 /* no resource with given name */ #define resBadNameVers 0x1E11 /* bad version in rResName resource */ #define resDupStartUp 0x1E12 /* already started with this ID */ #define resInvalidTypeOrID 0x1E13 /* type or ID is 0 */ /* Other Constants */ #define resChanged 0x0020 #define resPreLoad 0x0040 #define resProtected 0x0080 #define resAbsLoad 0x0400 #define resConverter 0x0800 #define resMemAttr 0xC31C /* Flags passed to the NewHandle Memory Manager call */ #define systemMap 0x0001 #define mapChanged 0x0002 #define romMap 0x0004 #define resNameOffset 0x10000 /* type holding names */ #define resNameVersion 0x0001 #define sysFileID 0x0001 /* Resource Type Numbers */ #define rIcon 0x8001 /* Icon type */ #define rPicture 0x8002 /* Picture type */ #define rControlList 0x8003 /* Control list type */ #define rControlTemplate 0x8004 /* Control template type */ #define rC1InputString 0x8005 /* GS/OS class 1 input string */ #define rPString 0x8006 /* Pascal string type */ #define rStringList 0x8007 /* String list type */ #define rMenuBar 0x8008 /* MenuBar type */ #define rMenu 0x8009 /* Menu template */ #define rMenuItem 0x800A /* Menu item definition */ #define rTextForLETextBox2 0x800B /* Data for LineEdit LETextBox2 call */ #define rCtlDefProc 0x800C /* Control definition procedure type */ #define rCtlColorTbl 0x800D /* Color table for control */ #define rWindParam1 0x800E /* Parameters for NewWindow2 call */ #define rWindParam2 0x800F /* Parameters for NewWindow2 call */ #define rWindColor 0x8010 /* Window Manager color table */ #define rTextBlock 0x8011 /* Text block */ #define rStyleBlock 0x8012 /* TextEdit style information */ #define rToolStartup 0x8013 /* Tool set startup record */ #define rResName 0x8014 /* Resource name */ #define rAlertString 0x8015 /* AlertWindow input data */ #define rText 0x8016 /* Unformatted text */ #define rCodeResource 0x8017 #define rCDEVCode 0x8018 #define rCDEVFlags 0x8019 #define rTwoRects 0x801A /* Two rectangles */ #define rFileType 0x801B /* Filetype descriptors--see File Type Note $42 */ #define rListRef 0x801C /* List member */ #define rCString 0x801D /* C string */ #define rXCMD 0x801E #define rXFCN 0x801F #define rErrorString 0x8020 /* ErrorWindow input data */ #define rKTransTable 0x8021 /* Keystroke translation table */ #define rWString 0x8022 /* not useful--duplicates $8005 */ #define rC1OutputString 0x8023 /* GS/OS class 1 output string */ #define rSoundSample 0x8024 #define rTERuler 0x8025 /* TextEdit ruler information */ #define rFSequence 0x8026 #define rCursor 0x8027 /* Cursor resource type */ #define rItemStruct 0x8028 /* for 6.0 Menu Manager */ #define rVersion 0x8029 #define rComment 0x802A #define rBundle 0x802B #define rFinderPath 0x802C #define rPaletteWindow 0x802D /* used by HyperCard IIgs 1.1 */ #define rTaggedStrings 0x802E #define rPatternList 0x802F #define rRectList 0xC001 #define rPrintRecord 0xC002 #define rFont 0xC003 typedef long ResID; typedef word ResType; typedef word ResAttr; struct ResHeaderRec { LongWord rFileVersion; /* Format version of resource fork */ LongWord rFileToMap; /* Offset from start to resource map record */ LongWord rFileMapSize; /* Number of bytes map occupies in file */ Byte rFileMemo[128]; /* Reserved space for application */ }; typedef struct ResHeaderRec ResHeaderRec; struct FreeBlockRec { LongWord blkOffset; LongWord blkSize; }; typedef struct FreeBlockRec FreeBlockRec; struct ResMap { struct ResMap **mapNext; /* Handle to next resource map */ Word mapFlag; /* Bit Flags */ LongWord mapOffset; /* Map's file position */ LongWord mapSize; /* Number of bytes map occupies in file */ Word mapToIndex; Word mapFileNum; Word mapID; LongWord mapIndexSize; LongWord mapIndexUsed; Word mapFreeListSize; Word mapFreeListUsed; FreeBlockRec mapFreeList[1]; /* n bytes (array of free block records) */ }; typedef struct ResMap ResMap, *ResMapPtr, **ResMapHndl; typedef struct ResMap MapRec, *MapRecPtr, **MapRecHndl; /* TBR3 definition */ struct ResRefRec { ResType resType; ResID resID; LongWord resOffset; ResAttr resAttr; LongWord resSize; Handle resHandle; }; typedef struct ResRefRec ResRefRec, *ResRefRecPtr; struct ResourceSpec { ResType resourceType; ResID resourceID; }; typedef struct ResourceSpec ResourceSpec; struct ResNameEntry { ResID namedResID; Str255 resName; }; typedef struct ResNameEntry ResNameEntry, *ResNameEntryPtr; struct ResNameRec { Word version; LongWord nameCount; ResNameEntry resNameEntries[1]; }; typedef struct ResNameRec ResNameRec, *ResNameRecPtr, **ResNameRecHndl; extern pascal void ResourceBootInit(void) inline(0x011E,dispatcher); extern pascal void ResourceStartUp(Word) inline(0x021E,dispatcher); extern pascal void ResourceShutDown(void) inline(0x031E,dispatcher); extern pascal Word ResourceVersion(void) inline(0x041E,dispatcher); extern pascal void ResourceReset(void) inline(0x051E,dispatcher); extern pascal Boolean ResourceStatus(void) inline(0x061E,dispatcher); extern pascal void AddResource(Handle, Word, Word, Long) inline(0x0C1E,dispatcher); extern pascal void CloseResourceFile(Word) inline(0x0B1E,dispatcher); extern pascal LongWord CountResources(Word) inline(0x221E,dispatcher); extern pascal Word CountTypes(void) inline(0x201E,dispatcher); extern pascal void CreateResourceFile(Long, Word, Word, Pointer) inline(0x091E,dispatcher); extern pascal void DetachResource(Word, Long) inline(0x181E,dispatcher); extern pascal Word GetCurResourceApp(void) inline(0x141E,dispatcher); extern pascal Word GetCurResourceFile(void) inline(0x121E,dispatcher); extern pascal ResID GetIndResource(Word, Long) inline(0x231E,dispatcher); extern pascal ResType GetIndType(Word) inline(0x211E,dispatcher); extern pascal ResMapHndl GetMapHandle(Word) inline(0x261E,dispatcher); extern pascal Word GetOpenFileRefNum(Word) inline(0x1F1E,dispatcher); extern pascal ResAttr GetResourceAttr(Word, Long) inline(0x1B1E,dispatcher); extern pascal LongWord GetResourceSize(Word, Long) inline(0x1D1E,dispatcher); extern pascal Word HomeResourceFile(Word, Long) inline(0x151E,dispatcher); extern pascal LongWord LoadAbsResource(Pointer, Long, Word, Long) inline(0x271E,dispatcher); extern pascal Handle LoadResource(Word, Long) inline(0x0E1E,dispatcher); extern pascal void MarkResourceChange(Word, Word, Long) inline(0x101E,dispatcher); extern pascal void MatchResourceHandle(Pointer, Handle) inline(0x1E1E,dispatcher); extern pascal Word OpenResourceFile(Word, Pointer, Pointer) inline(0x0A1E,dispatcher); extern pascal void ReleaseResource(Word, Word, Long) inline(0x171E,dispatcher); extern pascal void RemoveResource(Word, Long) inline(0x0F1E,dispatcher); extern pascal void ResourceConverter(Pointer, Word, Word) inline(0x281E,dispatcher); extern pascal void SetCurResourceApp(Word) inline(0x131E,dispatcher); extern pascal void SetCurResourceFile(Word) inline(0x111E,dispatcher); extern pascal void SetResourceAttr(Word, Word, Long) inline(0x1C1E,dispatcher); extern pascal Word SetResourceFileDepth(Word) inline(0x251E,dispatcher); extern pascal void SetResourceID(Long, Word, Long) inline(0x1A1E,dispatcher); extern pascal Word SetResourceLoad(Word) inline(0x241E,dispatcher); extern pascal ResID UniqueResourceID(Word, Word) inline(0x191E,dispatcher); extern pascal void UpdateResourceFile(Word) inline(0x0D1E,dispatcher); extern pascal void WriteResource(Word, Long) inline(0x161E,dispatcher); extern pascal Handle LoadResource2(Word, Ptr, Word, Long) inline(0x291E,dispatcher); extern pascal LongWord RMFindNamedResource(Word, Ptr, Word *) inline(0x2A1E,dispatcher); extern pascal void RMGetResourceName(Word, Long, Ptr) inline(0x2B1E,dispatcher); extern pascal Handle RMLoadNamedResource(Word, Ptr) inline(0x2C1E,dispatcher); extern pascal void RMSetResourceName(Word, Long, Ptr) inline(0x2D1E,dispatcher); extern pascal Word OpenResourceFileByID(Word, Word) inline(0x2E1E,dispatcher); extern pascal void CompactResourceFile(Word, Word) inline(0x2F1E,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Resource Manager +* +* Copyright Apple Computer, Inc.1986-92 +* All Rights Reserved +* +* Copyright 1992, 1993, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __RESOURCES__ +#define __RESOURCES__ + +/* ResourceConverter Codes */ +#define resLogOut 0x0 +#define resLogIn 0x1 +#define resLogApp 0x0 +#define resLogSys 0x2 + +/* Error Codes */ +#define resForkUsed 0x1E01 /* Resource fork not empty */ +#define resBadFormat 0x1E02 /* Format of resource fork is unknown */ +#define resNoConverter 0x1E03 /* No converter routine available for resource type */ +#define resNoCurFile 0x1E04 /* there are no current open resource files */ +#define resDupID 0x1E05 /* ID is already used */ +#define resNotFound 0x1E06 /* resource was not found */ +#define resFileNotFound 0x1E07 /* resource file not found */ +#define resBadAppID 0x1E08 /* User ID not found, please call ResourceStartup */ +#define resNoUniqueID 0x1E09 /* a unique ID was not found */ +#ifndef resIndexRange /* Index is out of range */ +#define resIndexRange 0x1E0A +#endif +#define resSysIsOpen 0x1E0B /* System file is already open */ +#define resHasChanged 0x1E0C /* Resource marked changed; specified operation not allowed */ +#define resDiffConverter 0x1E0D /* Different converter already logged in for this resource type */ +#define resDiskFull 0x1E0E /* Volume is full */ +#define resInvalidShutDown 0x1E0F /* can't shut down ID 401E */ +#define resNameNotFound 0x1E10 /* no resource with given name */ +#define resBadNameVers 0x1E11 /* bad version in rResName resource */ +#define resDupStartUp 0x1E12 /* already started with this ID */ +#define resInvalidTypeOrID 0x1E13 /* type or ID is 0 */ + +/* Other Constants */ +#define resChanged 0x0020 +#define resPreLoad 0x0040 +#define resProtected 0x0080 +#define resAbsLoad 0x0400 +#define resConverter 0x0800 +#define resMemAttr 0xC31C /* Flags passed to the NewHandle Memory Manager call */ +#define systemMap 0x0001 +#define mapChanged 0x0002 +#define romMap 0x0004 +#define resNameOffset 0x10000 /* type holding names */ +#define resNameVersion 0x0001 +#define sysFileID 0x0001 + +/* Resource Type Numbers */ +#define rIcon 0x8001 /* Icon type */ +#define rPicture 0x8002 /* Picture type */ +#define rControlList 0x8003 /* Control list type */ +#define rControlTemplate 0x8004 /* Control template type */ +#define rC1InputString 0x8005 /* GS/OS class 1 input string */ +#define rPString 0x8006 /* Pascal string type */ +#define rStringList 0x8007 /* String list type */ +#define rMenuBar 0x8008 /* MenuBar type */ +#define rMenu 0x8009 /* Menu template */ +#define rMenuItem 0x800A /* Menu item definition */ +#define rTextForLETextBox2 0x800B /* Data for LineEdit LETextBox2 call */ +#define rCtlDefProc 0x800C /* Control definition procedure type */ +#define rCtlColorTbl 0x800D /* Color table for control */ +#define rWindParam1 0x800E /* Parameters for NewWindow2 call */ +#define rWindParam2 0x800F /* Parameters for NewWindow2 call */ +#define rWindColor 0x8010 /* Window Manager color table */ +#define rTextBlock 0x8011 /* Text block */ +#define rStyleBlock 0x8012 /* TextEdit style information */ +#define rToolStartup 0x8013 /* Tool set startup record */ +#define rResName 0x8014 /* Resource name */ +#define rAlertString 0x8015 /* AlertWindow input data */ +#define rText 0x8016 /* Unformatted text */ +#define rCodeResource 0x8017 +#define rCDEVCode 0x8018 +#define rCDEVFlags 0x8019 +#define rTwoRects 0x801A /* Two rectangles */ +#define rFileType 0x801B /* Filetype descriptors--see File Type Note $42 */ +#define rListRef 0x801C /* List member */ +#define rCString 0x801D /* C string */ +#define rXCMD 0x801E +#define rXFCN 0x801F +#define rErrorString 0x8020 /* ErrorWindow input data */ +#define rKTransTable 0x8021 /* Keystroke translation table */ +#define rWString 0x8022 /* not useful--duplicates $8005 */ +#define rC1OutputString 0x8023 /* GS/OS class 1 output string */ +#define rSoundSample 0x8024 +#define rTERuler 0x8025 /* TextEdit ruler information */ +#define rFSequence 0x8026 +#define rCursor 0x8027 /* Cursor resource type */ +#define rItemStruct 0x8028 /* for 6.0 Menu Manager */ +#define rVersion 0x8029 +#define rComment 0x802A +#define rBundle 0x802B +#define rFinderPath 0x802C +#define rPaletteWindow 0x802D /* used by HyperCard IIgs 1.1 */ +#define rTaggedStrings 0x802E +#define rPatternList 0x802F +#define rRectList 0xC001 +#define rPrintRecord 0xC002 +#define rFont 0xC003 + +typedef long ResID; +typedef word ResType; +typedef word ResAttr; + +struct ResHeaderRec { + LongWord rFileVersion; /* Format version of resource fork */ + LongWord rFileToMap; /* Offset from start to resource map record */ + LongWord rFileMapSize; /* Number of bytes map occupies in file */ + Byte rFileMemo[128]; /* Reserved space for application */ + }; +typedef struct ResHeaderRec ResHeaderRec; + +struct FreeBlockRec { + LongWord blkOffset; + LongWord blkSize; + }; +typedef struct FreeBlockRec FreeBlockRec; + +struct ResMap { + struct ResMap **mapNext; /* Handle to next resource map */ + Word mapFlag; /* Bit Flags */ + LongWord mapOffset; /* Map's file position */ + LongWord mapSize; /* Number of bytes map occupies in file */ + Word mapToIndex; + Word mapFileNum; + Word mapID; + LongWord mapIndexSize; + LongWord mapIndexUsed; + Word mapFreeListSize; + Word mapFreeListUsed; + FreeBlockRec mapFreeList[1]; /* n bytes (array of free block records) */ + }; +typedef struct ResMap ResMap, *ResMapPtr, **ResMapHndl; + +typedef struct ResMap MapRec, *MapRecPtr, **MapRecHndl; /* TBR3 definition */ + +struct ResRefRec { + ResType resType; + ResID resID; + LongWord resOffset; + ResAttr resAttr; + LongWord resSize; + Handle resHandle; + }; +typedef struct ResRefRec ResRefRec, *ResRefRecPtr; + +struct ResourceSpec { + ResType resourceType; + ResID resourceID; + }; +typedef struct ResourceSpec ResourceSpec; + +struct ResNameEntry { + ResID namedResID; + Str255 resName; + }; +typedef struct ResNameEntry ResNameEntry, *ResNameEntryPtr; + +struct ResNameRec { + Word version; + LongWord nameCount; + ResNameEntry resNameEntries[1]; + }; +typedef struct ResNameRec ResNameRec, *ResNameRecPtr, **ResNameRecHndl; + +extern pascal void ResourceBootInit(void) inline(0x011E,dispatcher); +extern pascal void ResourceStartUp(Word) inline(0x021E,dispatcher); +extern pascal void ResourceShutDown(void) inline(0x031E,dispatcher); +extern pascal Word ResourceVersion(void) inline(0x041E,dispatcher); +extern pascal void ResourceReset(void) inline(0x051E,dispatcher); +extern pascal Boolean ResourceStatus(void) inline(0x061E,dispatcher); +extern pascal void AddResource(Handle, Word, Word, Long) inline(0x0C1E,dispatcher); +extern pascal void CloseResourceFile(Word) inline(0x0B1E,dispatcher); +extern pascal LongWord CountResources(Word) inline(0x221E,dispatcher); +extern pascal Word CountTypes(void) inline(0x201E,dispatcher); +extern pascal void CreateResourceFile(Long, Word, Word, Pointer) inline(0x091E,dispatcher); +extern pascal void DetachResource(Word, Long) inline(0x181E,dispatcher); +extern pascal Word GetCurResourceApp(void) inline(0x141E,dispatcher); +extern pascal Word GetCurResourceFile(void) inline(0x121E,dispatcher); +extern pascal ResID GetIndResource(Word, Long) inline(0x231E,dispatcher); +extern pascal ResType GetIndType(Word) inline(0x211E,dispatcher); +extern pascal ResMapHndl GetMapHandle(Word) inline(0x261E,dispatcher); +extern pascal Word GetOpenFileRefNum(Word) inline(0x1F1E,dispatcher); +extern pascal ResAttr GetResourceAttr(Word, Long) inline(0x1B1E,dispatcher); +extern pascal LongWord GetResourceSize(Word, Long) inline(0x1D1E,dispatcher); +extern pascal Word HomeResourceFile(Word, Long) inline(0x151E,dispatcher); +extern pascal LongWord LoadAbsResource(Pointer, Long, Word, Long) inline(0x271E,dispatcher); +extern pascal Handle LoadResource(Word, Long) inline(0x0E1E,dispatcher); +extern pascal void MarkResourceChange(Word, Word, Long) inline(0x101E,dispatcher); +extern pascal void MatchResourceHandle(Pointer, Handle) inline(0x1E1E,dispatcher); +extern pascal Word OpenResourceFile(Word, Pointer, Pointer) inline(0x0A1E,dispatcher); +extern pascal void ReleaseResource(Word, Word, Long) inline(0x171E,dispatcher); +extern pascal void RemoveResource(Word, Long) inline(0x0F1E,dispatcher); +extern pascal void ResourceConverter(Pointer, Word, Word) inline(0x281E,dispatcher); +extern pascal void SetCurResourceApp(Word) inline(0x131E,dispatcher); +extern pascal void SetCurResourceFile(Word) inline(0x111E,dispatcher); +extern pascal void SetResourceAttr(Word, Word, Long) inline(0x1C1E,dispatcher); +extern pascal Word SetResourceFileDepth(Word) inline(0x251E,dispatcher); +extern pascal void SetResourceID(Long, Word, Long) inline(0x1A1E,dispatcher); +extern pascal Word SetResourceLoad(Word) inline(0x241E,dispatcher); +extern pascal ResID UniqueResourceID(Word, Word) inline(0x191E,dispatcher); +extern pascal void UpdateResourceFile(Word) inline(0x0D1E,dispatcher); +extern pascal void WriteResource(Word, Long) inline(0x161E,dispatcher); + +extern pascal Handle LoadResource2(Word, Ptr, Word, Long) inline(0x291E,dispatcher); +extern pascal LongWord RMFindNamedResource(Word, Ptr, Word *) inline(0x2A1E,dispatcher); +extern pascal void RMGetResourceName(Word, Long, Ptr) inline(0x2B1E,dispatcher); +extern pascal Handle RMLoadNamedResource(Word, Ptr) inline(0x2C1E,dispatcher); +extern pascal void RMSetResourceName(Word, Long, Ptr) inline(0x2D1E,dispatcher); + +extern pascal Word OpenResourceFileByID(Word, Word) inline(0x2E1E,dispatcher); +extern pascal void CompactResourceFile(Word, Word) inline(0x2F1E,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/sane.h b/bin/Libraries/ORCACDefs/sane.h index d0c3b93..4eab6b1 100644 --- a/bin/Libraries/ORCACDefs/sane.h +++ b/bin/Libraries/ORCACDefs/sane.h @@ -1 +1,272 @@ -/******************************************** ; File: SANE.h ; ; ; Copyright Apple Computer, Inc.1986-90 ; All Rights Reserved ; ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __SANE__ #define __SANE__ /* Decimal Representation Constants */ #define SIGDIGLEN 0x001C #define DECSTROUTLEN 0x0050 /* IEEE defualt environment constant */ #define IEEEDEFAULTENV 0x0000 /* Decimal formatting styles */ #define FLOATDECIMAL 0x0000 #define FIXEDDECIMAL 0x0001 /* Exceptions */ #define INVALID 0x0001 #define UNDERFLOW 0x0002 #define OVERFLOW 0x0004 #define DIVBYZERO 0x0008 #define INEXACT 0x0010 /* Ordering relations */ #define GREATERTHAN 0 #define LESSTHAN 1 #define EQUALTO 2 #define UNORDERED 3 typedef short relop ; /* Inquiry classes */ #define SNAN 0 #define QNAN 1 #define INFINITE 2 #define ZERONUM 3 #define NORMALNUM 4 #define DENORMALNUM 5 typedef short numclass ; /* Environmental control */ /* Rounding directions */ #define TONEAREST 0 #define UPWARD 1 #define DOWNWARD 2 #define TOWARDZERO 3 typedef short rounddir ; /* Rounding precisions */ #define EXTPRECISION 0 #define DBLPRECISION 1 #define FLOATPRECISION 2 typedef short roundpre ; typedef short exception; typedef short environment; typedef struct decimal { short sgn; /* sign 0 for +, 1 for - */ short exp; /* decimal exponent */ struct { unsigned char length, text[SIGDIGLEN], unused; } sig; /* significant digits */ } decimal, Decimal; struct decform { short style; /* FLOATDECIMAL or FIXEDDECIMAL */ short digits; } ; typedef struct decform decform; typedef struct decform DecForm; typedef void (*haltvector)(void); Extended fabs (Extended x) ; /* Conversions between binary and decimal */ void num2dec (DecForm *f,extended x,Decimal *d) ; /* d <-- x according to format f */ Extended dec2num (Decimal *d) ; /* Dec2Num <-- d as Extended */ /* Conversions between decimal formats */ void str2dec (char *s,short *index,Decimal *d,short *validPrefix) ; /* On input Index is starting index into s. On output Index is one greater than index of last character of longest numeric substring. d <-- Decimal rep of longest numeric substring; validPrefix <-- s, beginning at Index, contains valid numeric string or valid prefix of some numeric string */ void dec2str (DecForm *f,Decimal *d,char *s) ; /* s <-- d according to format f */ /* Arithmetic, auxiliary and elementary functions */ Extended remainder (Extended x,Extended y,short *quo) ; /* Remainder <-- x rem y; */ /* quo <-- 7 low-order bits of integer quotient x/y */ /* where -127 < quo < 127 */ Extended sqrt (Extended x) ; /* square root */ Extended rint (Extended x) ; /* round to integral value */ Extended scalb (short n,Extended x) ; /* scale binary; scalb <-- x * 2^n */ Extended logb (Extended x) ; /* binary log: binary exponent of normalized x */ Extended copysign (Extended x,Extended y) ; /* CopySign <-- y with sign of x */ Extended nextfloat (Extended x,Extended y) ; /* next float rep after (float) x in direction of (float) y */ Extended nextdouble (Extended x,Extended y) ; /* next Double rep after (Double) x in direction of (Double) y */ Extended nextextended (Extended x,Extended y) ; /* next extended representation after x in direction of y */ Extended log2 (Extended x) ; /* base-2 logarithm */ Extended log (Extended x) ; /* base-e logarithm */ Extended log1 (Extended x) ; /* log(1 + x) */ Extended exp2 (Extended x) ; /* base-2 exponential */ Extended exp (Extended x) ; /* base-e exponential */ Extended exp1 (Extended x) ; /* exp(x) - 1 */ Extended power (Extended x,Extended y) ; /* general exponential: x ^ y */ Extended ipower (Extended x,short i) ; /* integer exponential: x ^ i */ Extended compound (Extended r,Extended n) ; /* compound: (1 + r) ^ n */ Extended annuity (Extended r,Extended n) ; /* Annuity <-- (1 - (1+r)^(-n)) / r */ Extended tan (Extended x) ; /* tangent */ Extended sin (Extended x) ; /* Sine */ Extended cos (Extended x) ; /* Cosine */ Extended atan (Extended x) ; /* Arctangent */ Extended randomx (Extended *x) ; /* returns next random number; updates x; */ /* x must be integral, 1 <= x <= 2^31 - 2 */ /* Inquiry Routines */ numclass classfloat (Extended x) ; /* class of (float) x */ numclass classdouble (Extended x) ; /* class of (Double) x */ numclass classcomp (Extended x) ; /* class of (Comp) x */ numclass classextended (Extended x) ; /* class of x */ LongWord signnum (Extended x) ; /* 0 if sign bit clear, 1 if sign bit set */ /* Environment access routines */ void setexception (exception e,long b) ; /* clears e flags if b is 0, sets e flags otherwise; may cause halt */ long testexception (exception e) ; /* return true if any e flag is set, return false otherwise */ void sethalt (exception e,long b) ; /* set e halt enables if b is true, clear e halt enables otherwise */ long testhalt (exception e) ; /* return true if any e halt is enabled, return false otherwise */ void setround (rounddir r) ; /* set rounding direction to r */ rounddir getround (void) ; /* return rounding direction */ void setprecision (roundpre p) ; /* sets rnd'n precision to p */ roundpre getprecision (void) ; void setenvironment (environment e) ; /* sets SANE environment to e */ void getenvironment (environment *e) ; /* e <-- SANE environment */ void procentry (environment *e) ; /* e <-- environment; environment <-- IEEE default env */ void procexit (environment e) ; /* temp <-- current exceptions; */ /* SANE environment <-- e; */ /* signals exceptions in temp */ haltvector gethaltvector (void) ; /* return SANE halt vector */ void sethaltvector (haltvector v) ; /* halt vector <-- v */ /* Comparison routine */ relop relation (Extended x,Extended y) ; /* return Relation such that "x Relation y" is true */ /* NaNs and Special Constants */ extended nan( unsigned char c ); /* returns NaN with code c */ Extended inf (void) ; /* returns infinity */ Extended pi (void) ; /* returns pi */ extern pascal void SANEBootInit() inline(0x010A,dispatcher); extern pascal void SANEStartUp() inline(0x020A,dispatcher); extern pascal void SANEShutDown() inline(0x030A,dispatcher); extern pascal Word SANEVersion() inline(0x040A,dispatcher); extern pascal void SANEReset() inline(0x050A,dispatcher); extern pascal Word SANEStatus() inline(0x060A,dispatcher); extern pascal void SANEFP816() inline(0x090A,dispatcher); extern pascal void SANEDecStr816() inline(0x0A0A,dispatcher); extern pascal void SANEElems816() inline(0x0B0A,dispatcher); #endif \ No newline at end of file +/******************************************** +; File: SANE.h +; +; +; Copyright Apple Computer, Inc.1986-90 +; All Rights Reserved +; +********************************************/ +#ifndef __TYPES__ +#include +#endif + +#ifndef __SANE__ +#define __SANE__ + + +/* Decimal Representation Constants */ +#define SIGDIGLEN 0x001C +#define DECSTROUTLEN 0x0050 + +/* IEEE defualt environment constant */ +#define IEEEDEFAULTENV 0x0000 + +/* Decimal formatting styles */ +#define FLOATDECIMAL 0x0000 +#define FIXEDDECIMAL 0x0001 + +/* Exceptions */ +#define INVALID 0x0001 +#define UNDERFLOW 0x0002 +#define OVERFLOW 0x0004 +#define DIVBYZERO 0x0008 +#define INEXACT 0x0010 + +/* Ordering relations */ +#define GREATERTHAN 0 +#define LESSTHAN 1 +#define EQUALTO 2 +#define UNORDERED 3 +typedef short relop ; + + +/* Inquiry classes */ +#define SNAN 0 +#define QNAN 1 +#define INFINITE 2 +#define ZERONUM 3 +#define NORMALNUM 4 +#define DENORMALNUM 5 +typedef short numclass ; + + +/* Environmental control */ + +/* Rounding directions */ +#define TONEAREST 0 +#define UPWARD 1 +#define DOWNWARD 2 +#define TOWARDZERO 3 +typedef short rounddir ; + + +/* Rounding precisions */ +#define EXTPRECISION 0 +#define DBLPRECISION 1 +#define FLOATPRECISION 2 +typedef short roundpre ; + +typedef short exception; +typedef short environment; +typedef struct decimal { + short sgn; /* sign 0 for +, 1 for - */ + short exp; /* decimal exponent */ + struct { + unsigned char length, text[SIGDIGLEN], unused; + } sig; /* significant digits */ +} decimal, Decimal; + +struct decform { + short style; /* FLOATDECIMAL or FIXEDDECIMAL */ + short digits; +} ; +typedef struct decform decform; +typedef struct decform DecForm; +typedef void (*haltvector)(void); + +Extended fabs (Extended x) ; + + + +/* Conversions between binary and decimal */ +void num2dec (DecForm *f,extended x,Decimal *d) ; +/* d <-- x according to format f */ + +Extended dec2num (Decimal *d) ; +/* Dec2Num <-- d as Extended */ + + +/* Conversions between decimal formats */ +void str2dec (char *s,short *index,Decimal *d,short *validPrefix) ; +/* On input Index is starting index into s. +On output Index is one greater than index of last character of longest numeric substring. +d <-- Decimal rep of longest numeric substring; +validPrefix <-- s, beginning at Index, contains valid numeric string or valid prefix of some numeric string */ +void dec2str (DecForm *f,Decimal *d,char *s) ; +/* s <-- d according to format f */ + + +/* Arithmetic, auxiliary and elementary functions */ +Extended remainder (Extended x,Extended y,short *quo) ; +/* Remainder <-- x rem y; */ +/* quo <-- 7 low-order bits of integer quotient x/y */ +/* where -127 < quo < 127 */ + +Extended sqrt (Extended x) ; +/* square root */ + +Extended rint (Extended x) ; +/* round to integral value */ + +Extended scalb (short n,Extended x) ; +/* scale binary; scalb <-- x * 2^n */ + +Extended logb (Extended x) ; +/* binary log: binary exponent of normalized x */ + +Extended copysign (Extended x,Extended y) ; +/* CopySign <-- y with sign of x */ + +Extended nextfloat (Extended x,Extended y) ; +/* next float rep after (float) x in direction of (float) y */ + +Extended nextdouble (Extended x,Extended y) ; +/* next Double rep after (Double) x in direction of (Double) y */ + +Extended nextextended (Extended x,Extended y) ; +/* next extended representation after x in direction of y */ + +Extended log2 (Extended x) ; +/* base-2 logarithm */ + +Extended log (Extended x) ; +/* base-e logarithm */ + +Extended log1 (Extended x) ; +/* log(1 + x) */ + +Extended exp2 (Extended x) ; +/* base-2 exponential */ + +Extended exp (Extended x) ; +/* base-e exponential */ + +Extended exp1 (Extended x) ; +/* exp(x) - 1 */ + +Extended power (Extended x,Extended y) ; +/* general exponential: x ^ y */ + +Extended ipower (Extended x,short i) ; +/* integer exponential: x ^ i */ + +Extended compound (Extended r,Extended n) ; +/* compound: (1 + r) ^ n */ + +Extended annuity (Extended r,Extended n) ; +/* Annuity <-- (1 - (1+r)^(-n)) / r */ + +Extended tan (Extended x) ; +/* tangent */ + +Extended sin (Extended x) ; +/* Sine */ + +Extended cos (Extended x) ; +/* Cosine */ + +Extended atan (Extended x) ; +/* Arctangent */ + +Extended randomx (Extended *x) ; +/* returns next random number; updates x; */ +/* x must be integral, 1 <= x <= 2^31 - 2 */ + + +/* Inquiry Routines */ +numclass classfloat (Extended x) ; +/* class of (float) x */ + +numclass classdouble (Extended x) ; +/* class of (Double) x */ + +numclass classcomp (Extended x) ; +/* class of (Comp) x */ + +numclass classextended (Extended x) ; +/* class of x */ + +LongWord signnum (Extended x) ; +/* 0 if sign bit clear, 1 if sign bit set */ + + +/* Environment access routines */ +void setexception (exception e,long b) ; +/* clears e flags if b is 0, sets e flags otherwise; may cause halt */ + +long testexception (exception e) ; +/* return true if any e flag is set, return false otherwise */ + +void sethalt (exception e,long b) ; +/* set e halt enables if b is true, clear e halt enables otherwise */ + +long testhalt (exception e) ; +/* return true if any e halt is enabled, return false otherwise */ + +void setround (rounddir r) ; +/* set rounding direction to r */ + +rounddir getround (void) ; +/* return rounding direction */ + +void setprecision (roundpre p) ; +/* sets rnd'n precision to p */ + +roundpre getprecision (void) ; + + +void setenvironment (environment e) ; +/* sets SANE environment to e */ + +void getenvironment (environment *e) ; +/* e <-- SANE environment */ + +void procentry (environment *e) ; +/* e <-- environment; environment <-- IEEE default env */ + +void procexit (environment e) ; +/* temp <-- current exceptions; */ +/* SANE environment <-- e; */ +/* signals exceptions in temp */ + +haltvector gethaltvector (void) ; +/* return SANE halt vector */ + +void sethaltvector (haltvector v) ; +/* halt vector <-- v */ + + +/* Comparison routine */ +relop relation (Extended x,Extended y) ; +/* return Relation such that "x Relation y" is true */ + + +/* NaNs and Special Constants */ +extended nan( unsigned char c ); /* returns NaN with code c */ + +Extended inf (void) ; +/* returns infinity */ + +Extended pi (void) ; +/* returns pi */ + +extern pascal void SANEBootInit() inline(0x010A,dispatcher); +extern pascal void SANEStartUp() inline(0x020A,dispatcher); +extern pascal void SANEShutDown() inline(0x030A,dispatcher); +extern pascal Word SANEVersion() inline(0x040A,dispatcher); +extern pascal void SANEReset() inline(0x050A,dispatcher); +extern pascal Word SANEStatus() inline(0x060A,dispatcher); +extern pascal void SANEFP816() inline(0x090A,dispatcher); +extern pascal void SANEDecStr816() inline(0x0A0A,dispatcher); +extern pascal void SANEElems816() inline(0x0B0A,dispatcher); +#endif diff --git a/bin/Libraries/ORCACDefs/scheduler.h b/bin/Libraries/ORCACDefs/scheduler.h index 3162af4..ff3df51 100644 --- a/bin/Libraries/ORCACDefs/scheduler.h +++ b/bin/Libraries/ORCACDefs/scheduler.h @@ -1 +1,30 @@ -/******************************************** * * Scheduler * * Copyright Apple Computer, Inc.1986-90 * All Rights Reserved * * Copyright 1992, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __SCHEDULER__ #define __SCHEDULER__ #define busyFlag 0x00E100FFL extern pascal void SchBootInit(void) inline(0x0107,dispatcher); extern pascal void SchStartUp(void) inline(0x0207,dispatcher); extern pascal void SchShutDown(void) inline(0x0307,dispatcher); extern pascal Word SchVersion(void) inline(0x0407,dispatcher); extern pascal void SchReset(void) inline(0x0507,dispatcher); extern pascal Boolean SchStatus(void) inline(0x0607,dispatcher); extern pascal Boolean SchAddTask(VoidProcPtr) inline(0x0907,dispatcher); extern pascal void SchFlush(void) inline(0x0A07,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Scheduler +* +* Copyright Apple Computer, Inc.1986-90 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __SCHEDULER__ +#define __SCHEDULER__ + +#define busyFlag 0x00E100FFL + +extern pascal void SchBootInit(void) inline(0x0107,dispatcher); +extern pascal void SchStartUp(void) inline(0x0207,dispatcher); +extern pascal void SchShutDown(void) inline(0x0307,dispatcher); +extern pascal Word SchVersion(void) inline(0x0407,dispatcher); +extern pascal void SchReset(void) inline(0x0507,dispatcher); +extern pascal Boolean SchStatus(void) inline(0x0607,dispatcher); +extern pascal Boolean SchAddTask(VoidProcPtr) inline(0x0907,dispatcher); +extern pascal void SchFlush(void) inline(0x0A07,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/scrap.h b/bin/Libraries/ORCACDefs/scrap.h index 9844c48..b7152b1 100644 --- a/bin/Libraries/ORCACDefs/scrap.h +++ b/bin/Libraries/ORCACDefs/scrap.h @@ -1 +1,65 @@ -/******************************************** * * Scrap Manager * * Copyright Apple Computer, Inc. 1986-91 * All Rights Reserved * * Copyright 1992, 1993, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __SCRAP__ #define __SCRAP__ /* Error Codes */ #define badScrapType 0x1610 /* No scrap of this type. */ /* Scrap Types */ #define textScrap 0x0000 #define picScrap 0x0001 #define sampledSoundScrap 0x0002 #define teStyleScrap 0x0064 #define iconScrap 0x4945 #define maskScrap 0x8001 #define colorTableScrap 0x8002 #define resourceRefScrap 0x8003 /* ShowClipboard flag values */ #define cpOpenWindow 0x8000 #define cpCloseWindow 0x4000 typedef struct scrapInfo { Word scrapType; LongWord scrapSize; Handle scrapHandle; }; typedef struct scrapInfo scrapInfo, *scrapInfoPtr, **scrapInfoHndl; extern pascal void ScrapBootInit(void) inline(0x0116,dispatcher); extern pascal void ScrapStartUp(void) inline(0x0216,dispatcher); extern pascal void ScrapShutDown(void) inline(0x0316,dispatcher); extern pascal Word ScrapVersion(void) inline(0x0416,dispatcher); extern pascal void ScrapReset(void) inline(0x0516,dispatcher); extern pascal Boolean ScrapStatus(void) inline(0x0616,dispatcher); extern pascal void GetScrap(Handle, Word) inline(0x0D16,dispatcher); extern pascal Word GetScrapCount(void) inline(0x1216,dispatcher); extern pascal handle GetScrapHandle(Word) inline(0x0E16,dispatcher); extern pascal Pointer GetScrapPath(void) inline(0x1016,dispatcher); extern pascal LongWord GetScrapSize(Word) inline(0x0F16,dispatcher); extern pascal Word GetScrapState(void) inline(0x1316,dispatcher); extern pascal void LoadScrap(void) inline(0x0A16,dispatcher); extern pascal void PutScrap(unsigned Longint, Word, Pointer) inline(0x0C16,dispatcher); extern pascal void SetScrapPath(Pointer) inline(0x1116,dispatcher); extern pascal void UnloadScrap(void) inline(0x0916,dispatcher); extern pascal void ZeroScrap(void) inline(0x0B16,dispatcher); extern pascal void GetIndScrap(Word, Ptr) inline(0x1416,dispatcher); extern pascal GrafPortPtr ShowClipboard(Word, Rect *) inline(0x1516,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Scrap Manager +* +* Copyright Apple Computer, Inc. 1986-91 +* All Rights Reserved +* +* Copyright 1992, 1993, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __SCRAP__ +#define __SCRAP__ + +/* Error Codes */ +#define badScrapType 0x1610 /* No scrap of this type. */ + +/* Scrap Types */ +#define textScrap 0x0000 +#define picScrap 0x0001 +#define sampledSoundScrap 0x0002 +#define teStyleScrap 0x0064 +#define iconScrap 0x4945 +#define maskScrap 0x8001 +#define colorTableScrap 0x8002 +#define resourceRefScrap 0x8003 + +/* ShowClipboard flag values */ +#define cpOpenWindow 0x8000 +#define cpCloseWindow 0x4000 + +typedef struct scrapInfo { + Word scrapType; + LongWord scrapSize; + Handle scrapHandle; + }; +typedef struct scrapInfo scrapInfo, *scrapInfoPtr, **scrapInfoHndl; + +extern pascal void ScrapBootInit(void) inline(0x0116,dispatcher); +extern pascal void ScrapStartUp(void) inline(0x0216,dispatcher); +extern pascal void ScrapShutDown(void) inline(0x0316,dispatcher); +extern pascal Word ScrapVersion(void) inline(0x0416,dispatcher); +extern pascal void ScrapReset(void) inline(0x0516,dispatcher); +extern pascal Boolean ScrapStatus(void) inline(0x0616,dispatcher); +extern pascal void GetScrap(Handle, Word) inline(0x0D16,dispatcher); +extern pascal Word GetScrapCount(void) inline(0x1216,dispatcher); +extern pascal handle GetScrapHandle(Word) inline(0x0E16,dispatcher); +extern pascal Pointer GetScrapPath(void) inline(0x1016,dispatcher); +extern pascal LongWord GetScrapSize(Word) inline(0x0F16,dispatcher); +extern pascal Word GetScrapState(void) inline(0x1316,dispatcher); +extern pascal void LoadScrap(void) inline(0x0A16,dispatcher); +extern pascal void PutScrap(unsigned Longint, Word, Pointer) inline(0x0C16,dispatcher); +extern pascal void SetScrapPath(Pointer) inline(0x1116,dispatcher); +extern pascal void UnloadScrap(void) inline(0x0916,dispatcher); +extern pascal void ZeroScrap(void) inline(0x0B16,dispatcher); + +extern pascal void GetIndScrap(Word, Ptr) inline(0x1416,dispatcher); + +extern pascal GrafPortPtr ShowClipboard(Word, Rect *) inline(0x1516,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/setjmp.h b/bin/Libraries/ORCACDefs/setjmp.h index c738ef9..33ea2ad 100644 --- a/bin/Libraries/ORCACDefs/setjmp.h +++ b/bin/Libraries/ORCACDefs/setjmp.h @@ -1 +1,21 @@ -/**************************************************************** * * setjmp.h - nonlocal jump library * * February 1989 * Mike Westerfield * * Copyright 1989 * Byte Works, Inc. * ****************************************************************/ #ifndef __setjmp__ #define __setjmp__ typedef int jmp_buf[4]; void longjmp(jmp_buf, int); int setjmp(jmp_buf); #endif \ No newline at end of file +/**************************************************************** +* +* setjmp.h - nonlocal jump library +* +* February 1989 +* Mike Westerfield +* +* Copyright 1989 +* Byte Works, Inc. +* +****************************************************************/ + +#ifndef __setjmp__ +#define __setjmp__ + +typedef int jmp_buf[4]; + +void longjmp(jmp_buf, int); +int setjmp(jmp_buf); + +#endif diff --git a/bin/Libraries/ORCACDefs/shell.h b/bin/Libraries/ORCACDefs/shell.h index f7699c8..d9ff78f 100644 --- a/bin/Libraries/ORCACDefs/shell.h +++ b/bin/Libraries/ORCACDefs/shell.h @@ -1 +1,406 @@ -/**************************************************************** * * shell.h - ORCA/M Shell Interface File * * Copyright Apple Computer and Megamax Inc. 1986, 1987 * All rights reserved * * Copyright 1989, 1990, 1992 Byte Works, Inc. * ****************************************************************/ #ifndef __shell__ #define __shell__ /* CHANGE_VECTOR parameter block */ typedef struct { int reserved; int vector; /* vector number */ void *procPtr; /* new vector handler */ void *oldprocPtr; /* old vector handler */ } Change_VectorPB; typedef struct { int pCount; /* parameter count */ int reserved; int vector; /* vector number */ void *procPtr; /* new vector handler */ void *oldprocPtr; /* old vector handler */ } ChangeVectorGSPB; /* WRITE_CONSOLE parameter block */ typedef struct { int ch; /* character to write */ } Write_ConsolePB; typedef struct { int pCount; /* parameter count */ int ch; /* character to write */ } ConsoleOutGSPB; /* DIRECTION parameter block */ typedef struct { int device; /* device number */ int direct; /* type of redirection */ } DirectionPB; typedef struct { int pCount; /* parameter count */ int device; /* device number */ int direct; /* type of redirection */ } DirectionGSPB; /* ERROR parameter block */ typedef struct { int error; /* error number */ } ErrorPB; typedef struct { int pCount; /* parameter count */ int error; /* error number */ } ErrorGSPB; /* EXECUTE parameter block */ typedef struct { int flag; /* options flags */ char *comm; /* command string */ } ExecutePB; typedef struct { int pCount; /* parameter count */ int flag; /* options flags */ char *comm; /* command string */ } ExecuteGSPB; /* EXPAND_DEVICES parameter block */ typedef struct { char *pathname; /* path name */ } Expand_DevicesPB; typedef struct { int pCount; /* parameter count */ void *inName; /* input path name */ void *outName; /* output path name */ } ExpandDevicesGSPB; /* EXPORT parameter block */ typedef struct { char *name; /* variable name */ int flags; /* export flag */ } ExportPB; typedef struct { int pCount; /* parameter count */ char *name; /* variable name */ int flags; /* export flag */ } ExportGSPB; /* FASTFILE parameter block */ typedef struct { int action; /* action to take */ int index; /* file index */ int flags; /* FastFile options flags */ void *file_handle; /* handle of RAM copy of file */ long file_length; /* length of the file */ char *pathname; /* file's pathname */ int access; /* access */ int file_type; /* file type */ long aux_type; /* auxiliary type */ int storage; /* storage flags */ int create_date; /* creation */ int create_time; int mod_date; /* last modification */ int mod_time; long blocks_used; /* blocks used on disk */ } FastFilePB; typedef struct { int pCount; /* parameter count */ int action; /* action to take */ int index; /* file index */ int flags; /* FastFile options flags */ void *fileHandle; /* handle of RAM copy of file */ void *pathName; /* file's pathname */ int access; /* access */ int fileType; /* file type */ long auxType; /* auxiliary type */ int storageType; /* storage flags */ char createDate[8]; /* creation */ char modDate[8]; /* last modification */ void *option; /* option list */ long fileLength; /* length of the file */ long blocksUsed; /* blocks used on disk */ } FastFileGSPB; /* GET_COMMAND parameter block */ typedef struct { int index; /* command number */ int restart; /* restartable? */ int reserved; int command; /* command number */ char name[16]; /* command name (p-string) */ } Get_CommandPB; typedef struct { int pCount; /* parameter count */ int index; /* command number */ int restart; /* restartable? */ int reserved; int command; /* command number */ char name[16]; /* command name (p-string) */ } GetCommandGSPB; /* GET_IODEVICES SET_IODEVICES parameter block */ typedef struct { int output_type; /* output device type */ long output_addr; /* output device slot/addr */ int error_type; /* error device type */ long error_addr; /* error device slot/addr */ int input_type; /* input device type */ long input_addr; /* input device slot/addr */ } Get_IODevicesPB, Set_IODevicesPB; /* GET_LANG SET_LANG parameter block */ typedef struct { int lang; /* language number */ } Get_LangPB, Set_LangPB; typedef struct { int pCount; /* parameter count */ int lang; /* language number */ } GetLangGSPB, SetLangGSPB; /* GET_LINFO SET_LINFO parameter block */ typedef struct { char *sfile; /* address of source file name */ char *dfile; /* address of output file name */ char *parms; /* address of paramter list */ char *istring; /* address of language specific input string */ char merr; /* max error level allowed */ char merrf; /* max error level found */ char lops; /* operations flag */ char kflag; /* KEEP flag */ unsigned long mflags; /* set of letters selected with '-' */ unsigned long pflags; /* set of letters selected with '+' */ unsigned long org; /* abs start address of non-relloc load file */ } GetLInfoPB, Get_LInfoPB, Set_LInfoPB; typedef struct { int pCount; /* parameter count */ void *sFile; /* address of source file name */ void *dFile; /* address of output file name */ void *parms; /* address of paramter list */ void *iString; /* address of language specific input string */ char merr; /* max error level allowed */ char merrf; /* max error level found */ char lops; /* operations flag */ char kflag; /* KEEP flag */ unsigned long mFlags; /* set of letters selected with '-' */ unsigned long pFlags; /* set of letters selected with '+' */ unsigned long org; /* abs start address of non-relloc load file */ } GetLInfoGSPB, SetLInfoGSPB; /* GET_VAR SET_VAR parameter block */ typedef struct { char *var_name; /* variable name */ char *value; /* variable value */ } Get_VarPB, Set_VarPB; typedef struct { int pCount; /* parameter count */ void *name; /* variable name */ void *value; /* variable value */ int export; /* export flag */ } ReadVariableGSPB, SetGSPB; /* KeyPress parameter block */ typedef struct { int key; /* key read */ int modifiers; /* key modifiers */ int available; /* key available flag */ } KeyPressPB; typedef struct { int pCount; /* parameter count */ int key; /* key read */ int modifiers; /* key modifiers */ int available; /* key available flag */ } KeyPressGSPB; /* INIT_WILDCARD parameter block */ typedef struct { char *w_file; /* file name */ int flags; /* options flags */ } Init_WildcardPB; typedef struct { int pCount; /* parameter count */ void *wFile; /* file name */ int flags; /* options flags */ } Init_WildcardGSPB; /* NEXT_WILDCARD parameter block */ typedef struct { char *nextfile; /* file name */ } Next_WildcardPB; typedef struct { int pCount; /* parameter count */ void *pathName; /* file's pathname */ int access; /* access */ int fileType; /* file type */ long auxType; /* auxiliary type */ int storageType; /* storage flags */ char createDate[8]; /* creation */ char modDate[8]; /* last modification */ void *option; /* option list */ long eof; /* end of file */ long blocksUsed; /* blocks used on disk */ long resourceeof; /* eof for resource fork */ long resourceBlocks; /* blocksUsed for resource fork */ } NextWildcardGSPB; /* POP_VARIABLES */ typedef struct { int pCount; /* parameter count */ } PopVariablesGSPB; /* PUSH_VARIABLES */ typedef struct { int pCount; /* parameter count */ } PushVariablesGSPB; /* READ_INDEXED parameter block */ typedef struct { char *var_name; /* variable name */ char *value; /* variable value */ int index; /* variable index */ } Read_IndexedPB; typedef struct { int pCount; /* parameter count */ void *name; /* variable name */ void *value; /* variable value */ int index; /* variable index */ int export; /* export flag */ } ReadIndexedGSPB; /* ReadKey parameter block */ typedef struct { int key; /* key read */ int modifiers; /* key modifiers */ } ReadKeyPB; typedef struct { int pCount; /* parameter count */ int key; /* key read */ int modifiers; /* key modifiers */ } ReadKeyGSPB; /* REDIRECT parameter block */ typedef struct { int device; /* device number */ int append; /* append? (or replace) */ char *file; /* file to redirect to */ } RedirectPB; typedef struct { int pCount; /* parameter count */ int device; /* device number */ int append; /* append? (or replace) */ void *file; /* file to redirect to */ } RedirectGSPB; /* SET_STOP_FLAG STOP parameter block */ typedef struct { int stop; /* stop flag */ } Set_Stop_FlagPB, StopPB; typedef struct { int pCount; /* parameter count */ int flag; /* stop flag */ } SetStopFlagGSPB, StopGSPB; /* UNSET_VARIABLE parameter block */ typedef struct { char *name; /* variable name */ } Unset_VariablePB; typedef struct { int pCount; /* parameter count */ void *name; /* variable name */ } UnsetVariableGSPB; /* VERSION parameter block */ typedef struct { char version[4]; /* shell version number */ } VersionPB; typedef struct { int pCount; /* parameter count */ char version[4]; /* shell version number */ } VersionGSPB; #ifndef PDosInt extern pascal void PDosInt(unsigned, void *); #endif #define CHANGE_VECTOR(parm) (PDosInt(0x010C,parm)) #define DIRECTION(parm) (PDosInt(0x010F,parm)) #define ERROR(parm) (PDosInt(0x0105,parm)) #define EXECUTE(parm) (PDosInt(0x010D,parm)) #define EXPAND_DEVICES(parm) (PDosInt(0x0114,parm)) #define EXPORT(parm) (PDosInt(0x0116,parm)) #define FASTFILE(parm) (PDosInt(0x010E,parm)) #define GET_COMMAND(parm) (PDosInt(0x011D,parm)) #define GET_IODEVICES(parm) (PDosInt(0x011C,parm)) #define GET_LANG(parm) (PDosInt(0x0103,parm)) #define GET_LINFO(parm) (PDosInt(0x0101,parm)) #define GET_VAR(parm) (PDosInt(0x010B,parm)) #define INIT_WILDCARD(parm) (PDosInt(0x0109,parm)) #define KEYPRESS(parm) (PDosInt(0x011E,parm)) #define NEXT_WILDCARD(parm) (PDosInt(0x010A,parm)) #define POP_VARIABLES(parm) (PDosInt(0x0117,parm)) #define PUSH_VARIABLES(parm) (PDosInt(0x0118,parm)) #define READ_INDEXED(parm) (PDosInt(0x0108,parm)) #define READKEY(parm) (PDosInt(0x011F,parm)) #define REDIRECT(parm) (PDosInt(0x0110,parm)) #define SET_IODEVICES(parm) (PDosInt(0x011B,parm)) #define SET_LANG(parm) (PDosInt(0x0104,parm)) #define SET_LINFO(parm) (PDosInt(0x0102,parm)) #define SET_STOP_FLAG(parm) (PDosInt(0x0119,parm)) #define SET_VAR(parm) (PDosInt(0x0106,parm)) #define STOP(parm) (PDosInt(0x0113,parm)) #define UNSET_VARIABLE(parm) (PDosInt(0x0115,parm)) #define VERSION(parm) (PDosInt(0x0107,parm)) #define WRITE_CONSOLE(parm) (PDosInt(0x011A,parm)) #define ChangeVectorGS(parm) (PDosInt(0x014C,parm)) #define ConsoleOutGS(parm) (PDosInt(0x015A,parm)) #define DirectionGS(parm) (PDosInt(0x014F,parm)) #define ErrorGS(parm) (PDosInt(0x0145,parm)) #define ExecuteGS(parm) (PDosInt(0x014D,parm)) #define ExpandDevicesGS(parm) (PDosInt(0x0154,parm)) #define ExportGS(parm) (PDosInt(0x0156,parm)) #define FastFileGS(parm) (PDosInt(0x014E,parm)) #define GetCommandGS(parm) (PDosInt(0x015D,parm)) #define GetLangGS(parm) (PDosInt(0x0143,parm)) #define GetLInfoGS(parm) (PDosInt(0x0141,parm)) #define InitWildcardGS(parm) (PDosInt(0x0149,parm)) #define KeyPressGS(parm) (PDosInt(0x015E,parm)) #define NextWildcardGS(parm) (PDosInt(0x014A,parm)) #define PopVariablesGS(parm) (PDosInt(0x0157,parm)) #define PushVariablesGS(parm) (PDosInt(0x0158,parm)) #define ReadIndexedGS(parm) (PDosInt(0x0148,parm)) #define ReadKeyGS(parm) (PDosInt(0x015F,parm)) #define ReadVariableGS(parm) (PDosInt(0x014B,parm)) #define RedirectGS(parm) (PDosInt(0x0150,parm)) #define SetGS(parm) (PDosInt(0x0146,parm)) #define SetLangGS(parm) (PDosInt(0x0144,parm)) #define SetLInfoGS(parm) (PDosInt(0x0142,parm)) #define SetStopFlagGS(parm) (PDosInt(0x0159,parm)) #define StopGS(parm) (PDosInt(0x0153,parm)) #define UnsetVariableGS(parm) (PDosInt(0x0155,parm)) #define VersionGS(parm) (PDosInt(0x0147,parm)) #endif \ No newline at end of file +/**************************************************************** +* +* shell.h - ORCA/M Shell Interface File +* +* Copyright Apple Computer and Megamax Inc. 1986, 1987 +* All rights reserved +* +* Copyright 1989, 1990, 1992 Byte Works, Inc. +* +****************************************************************/ + +#ifndef __shell__ +#define __shell__ + +/* CHANGE_VECTOR parameter block */ +typedef struct { + int reserved; + int vector; /* vector number */ + void *procPtr; /* new vector handler */ + void *oldprocPtr; /* old vector handler */ + } Change_VectorPB; + +typedef struct { + int pCount; /* parameter count */ + int reserved; + int vector; /* vector number */ + void *procPtr; /* new vector handler */ + void *oldprocPtr; /* old vector handler */ + } ChangeVectorGSPB; + +/* WRITE_CONSOLE parameter block */ +typedef struct { + int ch; /* character to write */ + } Write_ConsolePB; + +typedef struct { + int pCount; /* parameter count */ + int ch; /* character to write */ + } ConsoleOutGSPB; + +/* DIRECTION parameter block */ +typedef struct { + int device; /* device number */ + int direct; /* type of redirection */ + } DirectionPB; + +typedef struct { + int pCount; /* parameter count */ + int device; /* device number */ + int direct; /* type of redirection */ + } DirectionGSPB; + +/* ERROR parameter block */ +typedef struct { + int error; /* error number */ + } ErrorPB; + +typedef struct { + int pCount; /* parameter count */ + int error; /* error number */ + } ErrorGSPB; + +/* EXECUTE parameter block */ +typedef struct { + int flag; /* options flags */ + char *comm; /* command string */ + } ExecutePB; + +typedef struct { + int pCount; /* parameter count */ + int flag; /* options flags */ + char *comm; /* command string */ + } ExecuteGSPB; + +/* EXPAND_DEVICES parameter block */ +typedef struct { + char *pathname; /* path name */ + } Expand_DevicesPB; + +typedef struct { + int pCount; /* parameter count */ + void *inName; /* input path name */ + void *outName; /* output path name */ + } ExpandDevicesGSPB; + +/* EXPORT parameter block */ +typedef struct { + char *name; /* variable name */ + int flags; /* export flag */ + } ExportPB; + +typedef struct { + int pCount; /* parameter count */ + char *name; /* variable name */ + int flags; /* export flag */ + } ExportGSPB; + +/* FASTFILE parameter block */ +typedef struct { + int action; /* action to take */ + int index; /* file index */ + int flags; /* FastFile options flags */ + void *file_handle; /* handle of RAM copy of file */ + long file_length; /* length of the file */ + char *pathname; /* file's pathname */ + int access; /* access */ + int file_type; /* file type */ + long aux_type; /* auxiliary type */ + int storage; /* storage flags */ + int create_date; /* creation */ + int create_time; + int mod_date; /* last modification */ + int mod_time; + long blocks_used; /* blocks used on disk */ + } FastFilePB; + +typedef struct { + int pCount; /* parameter count */ + int action; /* action to take */ + int index; /* file index */ + int flags; /* FastFile options flags */ + void *fileHandle; /* handle of RAM copy of file */ + void *pathName; /* file's pathname */ + int access; /* access */ + int fileType; /* file type */ + long auxType; /* auxiliary type */ + int storageType; /* storage flags */ + char createDate[8]; /* creation */ + char modDate[8]; /* last modification */ + void *option; /* option list */ + long fileLength; /* length of the file */ + long blocksUsed; /* blocks used on disk */ + } FastFileGSPB; + +/* GET_COMMAND parameter block */ +typedef struct { + int index; /* command number */ + int restart; /* restartable? */ + int reserved; + int command; /* command number */ + char name[16]; /* command name (p-string) */ + } Get_CommandPB; + +typedef struct { + int pCount; /* parameter count */ + int index; /* command number */ + int restart; /* restartable? */ + int reserved; + int command; /* command number */ + char name[16]; /* command name (p-string) */ + } GetCommandGSPB; + +/* GET_IODEVICES SET_IODEVICES parameter block */ +typedef struct { + int output_type; /* output device type */ + long output_addr; /* output device slot/addr */ + int error_type; /* error device type */ + long error_addr; /* error device slot/addr */ + int input_type; /* input device type */ + long input_addr; /* input device slot/addr */ + } Get_IODevicesPB, Set_IODevicesPB; + +/* GET_LANG SET_LANG parameter block */ +typedef struct { + int lang; /* language number */ + } Get_LangPB, Set_LangPB; + +typedef struct { + int pCount; /* parameter count */ + int lang; /* language number */ + } GetLangGSPB, SetLangGSPB; + +/* GET_LINFO SET_LINFO parameter block */ +typedef struct { + char *sfile; /* address of source file name */ + char *dfile; /* address of output file name */ + char *parms; /* address of paramter list */ + char *istring; /* address of language specific input string */ + char merr; /* max error level allowed */ + char merrf; /* max error level found */ + char lops; /* operations flag */ + char kflag; /* KEEP flag */ + unsigned long mflags; /* set of letters selected with '-' */ + unsigned long pflags; /* set of letters selected with '+' */ + unsigned long org; /* abs start address of non-relloc load file */ +} GetLInfoPB, Get_LInfoPB, Set_LInfoPB; + +typedef struct { + int pCount; /* parameter count */ + void *sFile; /* address of source file name */ + void *dFile; /* address of output file name */ + void *parms; /* address of paramter list */ + void *iString; /* address of language specific input string */ + char merr; /* max error level allowed */ + char merrf; /* max error level found */ + char lops; /* operations flag */ + char kflag; /* KEEP flag */ + unsigned long mFlags; /* set of letters selected with '-' */ + unsigned long pFlags; /* set of letters selected with '+' */ + unsigned long org; /* abs start address of non-relloc load file */ +} GetLInfoGSPB, SetLInfoGSPB; + +/* GET_VAR SET_VAR parameter block */ +typedef struct { + char *var_name; /* variable name */ + char *value; /* variable value */ + } Get_VarPB, Set_VarPB; + +typedef struct { + int pCount; /* parameter count */ + void *name; /* variable name */ + void *value; /* variable value */ + int export; /* export flag */ + } ReadVariableGSPB, SetGSPB; + +/* KeyPress parameter block */ +typedef struct { + int key; /* key read */ + int modifiers; /* key modifiers */ + int available; /* key available flag */ + } KeyPressPB; + +typedef struct { + int pCount; /* parameter count */ + int key; /* key read */ + int modifiers; /* key modifiers */ + int available; /* key available flag */ + } KeyPressGSPB; + +/* INIT_WILDCARD parameter block */ +typedef struct { + char *w_file; /* file name */ + int flags; /* options flags */ + } Init_WildcardPB; + +typedef struct { + int pCount; /* parameter count */ + void *wFile; /* file name */ + int flags; /* options flags */ + } Init_WildcardGSPB; + +/* NEXT_WILDCARD parameter block */ +typedef struct { + char *nextfile; /* file name */ + } Next_WildcardPB; + +typedef struct { + int pCount; /* parameter count */ + void *pathName; /* file's pathname */ + int access; /* access */ + int fileType; /* file type */ + long auxType; /* auxiliary type */ + int storageType; /* storage flags */ + char createDate[8]; /* creation */ + char modDate[8]; /* last modification */ + void *option; /* option list */ + long eof; /* end of file */ + long blocksUsed; /* blocks used on disk */ + long resourceeof; /* eof for resource fork */ + long resourceBlocks; /* blocksUsed for resource fork */ + } NextWildcardGSPB; + +/* POP_VARIABLES */ +typedef struct { + int pCount; /* parameter count */ + } PopVariablesGSPB; + +/* PUSH_VARIABLES */ +typedef struct { + int pCount; /* parameter count */ + } PushVariablesGSPB; + +/* READ_INDEXED parameter block */ +typedef struct { + char *var_name; /* variable name */ + char *value; /* variable value */ + int index; /* variable index */ + } Read_IndexedPB; + +typedef struct { + int pCount; /* parameter count */ + void *name; /* variable name */ + void *value; /* variable value */ + int index; /* variable index */ + int export; /* export flag */ + } ReadIndexedGSPB; + +/* ReadKey parameter block */ +typedef struct { + int key; /* key read */ + int modifiers; /* key modifiers */ + } ReadKeyPB; + +typedef struct { + int pCount; /* parameter count */ + int key; /* key read */ + int modifiers; /* key modifiers */ + } ReadKeyGSPB; + +/* REDIRECT parameter block */ +typedef struct { + int device; /* device number */ + int append; /* append? (or replace) */ + char *file; /* file to redirect to */ + } RedirectPB; + +typedef struct { + int pCount; /* parameter count */ + int device; /* device number */ + int append; /* append? (or replace) */ + void *file; /* file to redirect to */ + } RedirectGSPB; + +/* SET_STOP_FLAG STOP parameter block */ +typedef struct { + int stop; /* stop flag */ + } Set_Stop_FlagPB, StopPB; + +typedef struct { + int pCount; /* parameter count */ + int flag; /* stop flag */ + } SetStopFlagGSPB, StopGSPB; + +/* UNSET_VARIABLE parameter block */ +typedef struct { + char *name; /* variable name */ + } Unset_VariablePB; + +typedef struct { + int pCount; /* parameter count */ + void *name; /* variable name */ + } UnsetVariableGSPB; + +/* VERSION parameter block */ +typedef struct { + char version[4]; /* shell version number */ + } VersionPB; + +typedef struct { + int pCount; /* parameter count */ + char version[4]; /* shell version number */ + } VersionGSPB; + +#ifndef PDosInt +extern pascal void PDosInt(unsigned, void *); +#endif + +#define CHANGE_VECTOR(parm) (PDosInt(0x010C,parm)) +#define DIRECTION(parm) (PDosInt(0x010F,parm)) +#define ERROR(parm) (PDosInt(0x0105,parm)) +#define EXECUTE(parm) (PDosInt(0x010D,parm)) +#define EXPAND_DEVICES(parm) (PDosInt(0x0114,parm)) +#define EXPORT(parm) (PDosInt(0x0116,parm)) +#define FASTFILE(parm) (PDosInt(0x010E,parm)) +#define GET_COMMAND(parm) (PDosInt(0x011D,parm)) +#define GET_IODEVICES(parm) (PDosInt(0x011C,parm)) +#define GET_LANG(parm) (PDosInt(0x0103,parm)) +#define GET_LINFO(parm) (PDosInt(0x0101,parm)) +#define GET_VAR(parm) (PDosInt(0x010B,parm)) +#define INIT_WILDCARD(parm) (PDosInt(0x0109,parm)) +#define KEYPRESS(parm) (PDosInt(0x011E,parm)) +#define NEXT_WILDCARD(parm) (PDosInt(0x010A,parm)) +#define POP_VARIABLES(parm) (PDosInt(0x0117,parm)) +#define PUSH_VARIABLES(parm) (PDosInt(0x0118,parm)) +#define READ_INDEXED(parm) (PDosInt(0x0108,parm)) +#define READKEY(parm) (PDosInt(0x011F,parm)) +#define REDIRECT(parm) (PDosInt(0x0110,parm)) +#define SET_IODEVICES(parm) (PDosInt(0x011B,parm)) +#define SET_LANG(parm) (PDosInt(0x0104,parm)) +#define SET_LINFO(parm) (PDosInt(0x0102,parm)) +#define SET_STOP_FLAG(parm) (PDosInt(0x0119,parm)) +#define SET_VAR(parm) (PDosInt(0x0106,parm)) +#define STOP(parm) (PDosInt(0x0113,parm)) +#define UNSET_VARIABLE(parm) (PDosInt(0x0115,parm)) +#define VERSION(parm) (PDosInt(0x0107,parm)) +#define WRITE_CONSOLE(parm) (PDosInt(0x011A,parm)) + +#define ChangeVectorGS(parm) (PDosInt(0x014C,parm)) +#define ConsoleOutGS(parm) (PDosInt(0x015A,parm)) +#define DirectionGS(parm) (PDosInt(0x014F,parm)) +#define ErrorGS(parm) (PDosInt(0x0145,parm)) +#define ExecuteGS(parm) (PDosInt(0x014D,parm)) +#define ExpandDevicesGS(parm) (PDosInt(0x0154,parm)) +#define ExportGS(parm) (PDosInt(0x0156,parm)) +#define FastFileGS(parm) (PDosInt(0x014E,parm)) +#define GetCommandGS(parm) (PDosInt(0x015D,parm)) +#define GetLangGS(parm) (PDosInt(0x0143,parm)) +#define GetLInfoGS(parm) (PDosInt(0x0141,parm)) +#define InitWildcardGS(parm) (PDosInt(0x0149,parm)) +#define KeyPressGS(parm) (PDosInt(0x015E,parm)) +#define NextWildcardGS(parm) (PDosInt(0x014A,parm)) +#define PopVariablesGS(parm) (PDosInt(0x0157,parm)) +#define PushVariablesGS(parm) (PDosInt(0x0158,parm)) +#define ReadIndexedGS(parm) (PDosInt(0x0148,parm)) +#define ReadKeyGS(parm) (PDosInt(0x015F,parm)) +#define ReadVariableGS(parm) (PDosInt(0x014B,parm)) +#define RedirectGS(parm) (PDosInt(0x0150,parm)) +#define SetGS(parm) (PDosInt(0x0146,parm)) +#define SetLangGS(parm) (PDosInt(0x0144,parm)) +#define SetLInfoGS(parm) (PDosInt(0x0142,parm)) +#define SetStopFlagGS(parm) (PDosInt(0x0159,parm)) +#define StopGS(parm) (PDosInt(0x0153,parm)) +#define UnsetVariableGS(parm) (PDosInt(0x0155,parm)) +#define VersionGS(parm) (PDosInt(0x0147,parm)) + +#endif diff --git a/bin/Libraries/ORCACDefs/signal.h b/bin/Libraries/ORCACDefs/signal.h index a73991c..9beea3a 100644 --- a/bin/Libraries/ORCACDefs/signal.h +++ b/bin/Libraries/ORCACDefs/signal.h @@ -1 +1,33 @@ -/**************************************************************** * * signal.h - signal handling * * April 1990 * Mike Westerfield * * Copyright 1990 * Byte Works, Inc. * ****************************************************************/ #ifndef __signal__ #define __signal__ typedef int sig_atomic_t; typedef void (*__SIG_FUNC__) (int); #define SIG_DFL ((__SIG_FUNC__) (-3)) #define SIG_IGN ((__SIG_FUNC__) (-2)) #define SIG_ERR ((__SIG_FUNC__) (-1)) #define SIGABRT 1 #define SIGFPE 2 #define SIGILL 3 #define SIGINT 4 #define SIGSEGV 5 #define SIGTERM 6 void (*signal(int, void (*__func) (int)))(int); int raise(int); #endif \ No newline at end of file +/**************************************************************** +* +* signal.h - signal handling +* +* April 1990 +* Mike Westerfield +* +* Copyright 1990 +* Byte Works, Inc. +* +****************************************************************/ + +#ifndef __signal__ +#define __signal__ + +typedef int sig_atomic_t; +typedef void (*__SIG_FUNC__) (int); + +#define SIG_DFL ((__SIG_FUNC__) (-3)) +#define SIG_IGN ((__SIG_FUNC__) (-2)) +#define SIG_ERR ((__SIG_FUNC__) (-1)) + +#define SIGABRT 1 +#define SIGFPE 2 +#define SIGILL 3 +#define SIGINT 4 +#define SIGSEGV 5 +#define SIGTERM 6 + +void (*signal(int, void (*__func) (int)))(int); +int raise(int); + +#endif diff --git a/bin/Libraries/ORCACDefs/sound.h b/bin/Libraries/ORCACDefs/sound.h index aa1fc49..69e1207 100644 --- a/bin/Libraries/ORCACDefs/sound.h +++ b/bin/Libraries/ORCACDefs/sound.h @@ -1 +1,121 @@ -/******************************************** * * Sound Tool Set * * Copyright Apple Computer, Inc.1986-90 * All Rights Reserved * * Copyright 1992, Byte Works, Inc * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __SOUND__ #define __SOUND__ /* Error Codes */ #define noDOCFndErr 0x0810 /* no DOC chip found */ #define docAddrRngErr 0x0811 /* DOC address range error */ #define noSAppInitErr 0x0812 /* no SAppInit call made */ #define invalGenNumErr 0x0813 /* invalid generator number */ #define synthModeErr 0x0814 /* synthesizer mode error */ #define genBusyErr 0x0815 /* generator busy error */ #define mstrIRQNotAssgnErr 0x0817 /* master IRQ not assigned */ #define sndAlreadyStrtErr 0x0818 /* sound tools already started */ #define unclaimedSndIntErr 0x08FF /* sound tools already started */ /* channelGenMode Codes */ #define ffSynthMode 0x0001 /* Free form synthesizer mode */ #define noteSynthMode 0x0002 /* Note synthesizer mode. */ /* genMask Codes; parameters tp FFStopSound */ #define gen0off 0x0001 #define gen1off 0x0002 #define gen2off 0x0004 #define gen3off 0x0008 #define gen4off 0x0010 #define gen5off 0x0020 #define gen6off 0x0040 #define gen7off 0x0080 #define gen8off 0x0100 #define gen9off 0x0200 #define gen10off 0x0400 #define gen11off 0x0800 #define gen12off 0x1000 #define gen13off 0x2000 #define gen14off 0x4000 /* genStatus Codes */ #define genAvail 0x0000 /* Generator available status */ #define ffSynth 0x0100 /* Free Form Synthesizer status */ #define noteSynth 0x0200 /* Note Synthesizer status */ #define lastBlock 0x8000 /* Last block of wave */ /* Jump Table Offsets */ #define smReadRegister 0x00 /* Read Register routine */ #define smWriteRegister 0x04 /* Write Register routine */ #define smReadRam 0x08 /* Read Ram routine */ #define smWriteRam 0x0C /* Write Ram routine */ #define smReadNext 0x10 /* Read Next routine */ #define smWriteNext 0x14 /* Write Next routine */ #define smOscTable 0x18 /* Pointer to Oscillator table */ #define smGenTable 0x1C /* Pointer to generator table */ #define smGcbAddrTable 0x20 /* Pointer to GCB address table */ #define smDisableInc 0x24 /* Disable Increment routine */ struct SoundParamBlock { Pointer waveStart; /* starting address of wave */ Word waveSize; /* waveform size in pages */ Word freqOffset; /* ? formula to be provided */ Word docBuffer; /* DOC buffer start address, low byte = 0 */ Word bufferSize; /* DOC buffer start address, low byte = 0 */ struct SoundParamBlock *nextWavePtr; /* Pointer to start of next wave's parameter block */ Word volSetting; /* DOC volume setting. High byte = 0 */ }; typedef struct SoundParamBlock SoundParamBlock, *SoundPBPtr, **SoundPBHndl; struct DocRegParamBlk { Word oscGenType; Byte freqLow1; Byte freqHigh1; Byte vol1; Byte tablePtr1; Byte control1; Byte tableSize1; Byte freqLow2; Byte freqHigh2; Byte vol2; Byte tablePtr2; Byte control2; Byte tableSize2; }; typedef struct DocRegParamBlk DocRegParamBlk, *DocRegParamBlkPtr; extern pascal void SoundBootInit(void) inline(0x0108,dispatcher); extern pascal void SoundStartUp(Word) inline(0x0208,dispatcher); extern pascal void SoundShutDown(void) inline(0x0308,dispatcher); extern pascal Word SoundVersion(void) inline(0x0408,dispatcher); extern pascal void SoundReset(void) inline(0x0508,dispatcher); extern pascal Boolean SoundToolStatus(void) inline(0x0608,dispatcher); extern pascal Word FFGeneratorStatus(Word) inline(0x1108,dispatcher); extern pascal Boolean FFSoundDoneStatus(Word) inline(0x1408,dispatcher); extern pascal Word FFSoundStatus(void) inline(0x1008,dispatcher); extern pascal void FFStartSound(Word, Pointer) inline(0x0E08,dispatcher); extern pascal void FFStopSound(Word) inline(0x0F08,dispatcher); extern pascal Word GetSoundVolume(Word) inline(0x0C08,dispatcher); extern pascal Pointer GetTableAddress(void) inline(0x0B08,dispatcher); extern pascal void ReadRamBlock(Pointer, Word, Word) inline(0x0A08,dispatcher); extern pascal void SetSoundMIRQV(VoidProcPtr) inline(0x1208,dispatcher); extern pascal void SetSoundVolume(Word, Word) inline(0x0D08,dispatcher); extern pascal ProcPtr SetUserSoundIRQV(VoidProcPtr) inline(0x1308,dispatcher); extern pascal void WriteRamBlock(Pointer, Word, Word) inline(0x0908,dispatcher); extern pascal void FFSetUpSound(Word, Pointer) inline(0x1508,dispatcher); extern pascal void FFStartPlaying(Word) inline(0x1608,dispatcher); extern pascal void ReadDOCReg(Pointer) inline(0x1808,dispatcher); extern pascal void SetDOCReg(Pointer) inline(0x1708,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Sound Tool Set +* +* Copyright Apple Computer, Inc.1986-90 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __SOUND__ +#define __SOUND__ + +/* Error Codes */ +#define noDOCFndErr 0x0810 /* no DOC chip found */ +#define docAddrRngErr 0x0811 /* DOC address range error */ +#define noSAppInitErr 0x0812 /* no SAppInit call made */ +#define invalGenNumErr 0x0813 /* invalid generator number */ +#define synthModeErr 0x0814 /* synthesizer mode error */ +#define genBusyErr 0x0815 /* generator busy error */ +#define mstrIRQNotAssgnErr 0x0817 /* master IRQ not assigned */ +#define sndAlreadyStrtErr 0x0818 /* sound tools already started */ +#define unclaimedSndIntErr 0x08FF /* sound tools already started */ + +/* channelGenMode Codes */ +#define ffSynthMode 0x0001 /* Free form synthesizer mode */ +#define noteSynthMode 0x0002 /* Note synthesizer mode. */ + +/* genMask Codes; parameters tp FFStopSound */ +#define gen0off 0x0001 +#define gen1off 0x0002 +#define gen2off 0x0004 +#define gen3off 0x0008 +#define gen4off 0x0010 +#define gen5off 0x0020 +#define gen6off 0x0040 +#define gen7off 0x0080 +#define gen8off 0x0100 +#define gen9off 0x0200 +#define gen10off 0x0400 +#define gen11off 0x0800 +#define gen12off 0x1000 +#define gen13off 0x2000 +#define gen14off 0x4000 + +/* genStatus Codes */ +#define genAvail 0x0000 /* Generator available status */ +#define ffSynth 0x0100 /* Free Form Synthesizer status */ +#define noteSynth 0x0200 /* Note Synthesizer status */ +#define lastBlock 0x8000 /* Last block of wave */ + +/* Jump Table Offsets */ +#define smReadRegister 0x00 /* Read Register routine */ +#define smWriteRegister 0x04 /* Write Register routine */ +#define smReadRam 0x08 /* Read Ram routine */ +#define smWriteRam 0x0C /* Write Ram routine */ +#define smReadNext 0x10 /* Read Next routine */ +#define smWriteNext 0x14 /* Write Next routine */ +#define smOscTable 0x18 /* Pointer to Oscillator table */ +#define smGenTable 0x1C /* Pointer to generator table */ +#define smGcbAddrTable 0x20 /* Pointer to GCB address table */ +#define smDisableInc 0x24 /* Disable Increment routine */ + +struct SoundParamBlock { + Pointer waveStart; /* starting address of wave */ + Word waveSize; /* waveform size in pages */ + Word freqOffset; /* ? formula to be provided */ + Word docBuffer; /* DOC buffer start address, low byte = 0 */ + Word bufferSize; /* DOC buffer start address, low byte = 0 */ + struct SoundParamBlock *nextWavePtr; /* Pointer to start of next wave's parameter block */ + Word volSetting; /* DOC volume setting. High byte = 0 */ + }; +typedef struct SoundParamBlock SoundParamBlock, *SoundPBPtr, **SoundPBHndl; + +struct DocRegParamBlk { + Word oscGenType; + Byte freqLow1; + Byte freqHigh1; + Byte vol1; + Byte tablePtr1; + Byte control1; + Byte tableSize1; + Byte freqLow2; + Byte freqHigh2; + Byte vol2; + Byte tablePtr2; + Byte control2; + Byte tableSize2; + }; +typedef struct DocRegParamBlk DocRegParamBlk, *DocRegParamBlkPtr; + +extern pascal void SoundBootInit(void) inline(0x0108,dispatcher); +extern pascal void SoundStartUp(Word) inline(0x0208,dispatcher); +extern pascal void SoundShutDown(void) inline(0x0308,dispatcher); +extern pascal Word SoundVersion(void) inline(0x0408,dispatcher); +extern pascal void SoundReset(void) inline(0x0508,dispatcher); +extern pascal Boolean SoundToolStatus(void) inline(0x0608,dispatcher); +extern pascal Word FFGeneratorStatus(Word) inline(0x1108,dispatcher); +extern pascal Boolean FFSoundDoneStatus(Word) inline(0x1408,dispatcher); +extern pascal Word FFSoundStatus(void) inline(0x1008,dispatcher); +extern pascal void FFStartSound(Word, Pointer) inline(0x0E08,dispatcher); +extern pascal void FFStopSound(Word) inline(0x0F08,dispatcher); +extern pascal Word GetSoundVolume(Word) inline(0x0C08,dispatcher); +extern pascal Pointer GetTableAddress(void) inline(0x0B08,dispatcher); +extern pascal void ReadRamBlock(Pointer, Word, Word) inline(0x0A08,dispatcher); +extern pascal void SetSoundMIRQV(VoidProcPtr) inline(0x1208,dispatcher); +extern pascal void SetSoundVolume(Word, Word) inline(0x0D08,dispatcher); +extern pascal ProcPtr SetUserSoundIRQV(VoidProcPtr) inline(0x1308,dispatcher); +extern pascal void WriteRamBlock(Pointer, Word, Word) inline(0x0908,dispatcher); + +extern pascal void FFSetUpSound(Word, Pointer) inline(0x1508,dispatcher); +extern pascal void FFStartPlaying(Word) inline(0x1608,dispatcher); +extern pascal void ReadDOCReg(Pointer) inline(0x1808,dispatcher); +extern pascal void SetDOCReg(Pointer) inline(0x1708,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/stdarg.h b/bin/Libraries/ORCACDefs/stdarg.h index b4e1933..c32c394 100644 --- a/bin/Libraries/ORCACDefs/stdarg.h +++ b/bin/Libraries/ORCACDefs/stdarg.h @@ -1 +1,34 @@ -/**************************************************************** * * stdarg.h - variable length parameter list handling * * February 1989 * Mike Westerfield * * Copyright 1989 * Byte Works, Inc. * ***************************************************************** * * Modified July 1994 * * Thanks to Doug Gwyn for the new va_start & va_arg declarations. * ****************************************************************/ #ifndef __stdarg__ #define __stdarg__ #ifndef __va_list__ #define __va_list__ typedef char *__va_list[2]; #endif #define va_list __va_list #define va_end(a) __va_end(a) #define va_start(ap,LastFixedParm) ((void) ((ap)[0] = (ap)[1] = (char *) (&LastFixedParm + 1))); #define va_arg(ap,type) ((type *)((ap)[0] += sizeof(type)))[-1] void __va_end(va_list); #endif \ No newline at end of file +/**************************************************************** +* +* stdarg.h - variable length parameter list handling +* +* February 1989 +* Mike Westerfield +* +* Copyright 1989 +* Byte Works, Inc. +* +***************************************************************** +* +* Modified July 1994 +* +* Thanks to Doug Gwyn for the new va_start & va_arg declarations. +* +****************************************************************/ + +#ifndef __stdarg__ +#define __stdarg__ + +#ifndef __va_list__ +#define __va_list__ +typedef char *__va_list[2]; +#endif + +#define va_list __va_list +#define va_end(a) __va_end(a) +#define va_start(ap,LastFixedParm) ((void) ((ap)[0] = (ap)[1] = (char *) (&LastFixedParm + 1))); +#define va_arg(ap,type) ((type *)((ap)[0] += sizeof(type)))[-1] + +void __va_end(va_list); + +#endif diff --git a/bin/Libraries/ORCACDefs/stddef.h b/bin/Libraries/ORCACDefs/stddef.h index 9dbdc06..9159207 100644 --- a/bin/Libraries/ORCACDefs/stddef.h +++ b/bin/Libraries/ORCACDefs/stddef.h @@ -1 +1,31 @@ -/**************************************************************** * * stddef.h - Standard Language Additions * * February 1989 * Mike Westerfield * * Copyright 1989, 1993 * Byte Works, Inc. * ****************************************************************/ #ifndef __stddef__ #define __stddef__ #ifndef NULL #define NULL (void *) 0L #endif typedef long ptrdiff_t; #ifndef __size_t__ #define __size_t__ 1 typedef unsigned long size_t; #endif typedef unsigned short wchar_t; #define offsetof(type,member) ((size_t) (&(((type *)0L)->member))) #endif \ No newline at end of file +/**************************************************************** +* +* stddef.h - Standard Language Additions +* +* February 1989 +* Mike Westerfield +* +* Copyright 1989, 1993 +* Byte Works, Inc. +* +****************************************************************/ + +#ifndef __stddef__ +#define __stddef__ + +#ifndef NULL +#define NULL (void *) 0L +#endif + +typedef long ptrdiff_t; + +#ifndef __size_t__ +#define __size_t__ 1 +typedef unsigned long size_t; +#endif + +typedef unsigned short wchar_t; + +#define offsetof(type,member) ((size_t) (&(((type *)0L)->member))) + +#endif diff --git a/bin/Libraries/ORCACDefs/stdfile.h b/bin/Libraries/ORCACDefs/stdfile.h index b194659..aa64c6a 100644 --- a/bin/Libraries/ORCACDefs/stdfile.h +++ b/bin/Libraries/ORCACDefs/stdfile.h @@ -1 +1,124 @@ -/******************************************** * * Standard File Operations Tool Set * * Copyright Apple Computer, Inc.1986-92 * All Rights Reserved * * Copyright 1992, Byte Works, Inc * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __STDFILE__ #define __STDFILE__ /* Error Codes */ #define badPromptDesc 0x1701 #define badOrigNameDesc 0x1702 #define badReplyNameDesc 0x1704 #define badReplyPathDesc 0x1705 #define badCall 0x1706 #define sfNotStarted 0x17FF /* filterProc Result Codes */ #define noDisplay 0x0000 /* file not to be displayed */ #define noSelect 0x0001 /* file displayed, but not selectable */ #define displaySelect 0x0002 /* file displayed and selectable */ /* Other Constants */ #define sfWildAuxType 0x8000 #define sfMatchFileType 0x8000 #define sfWildFileType 0x4000 #define sfMatchAuxType 0x4000 #define sfDisplayGrey 0x2000 #ifndef sfFileTypeEntriesLength /* SFTypeList - default number of FileTypeEntries */ #define sfFileTypeEntriesLength 0x0005 #endif typedef struct SFReplyRec { Boolean good; Word fileType; Word auxFileType; char filename[16]; char fullPathname[129]; } SFReplyRec, *SFReplyRecPtr, **SFReplyRecHndl; struct SFReplyRec2 { Boolean good; Word fileType; LongWord auxType; RefDescriptor nameRefDesc; Ref nameRef; RefDescriptor pathRefDesc; Ref pathRef; }; typedef struct SFReplyRec2 SFReplyRec2, *SFReplyRec2Ptr, **SFReplyRec2Hndl; struct fileEntryRec { Word fileType; unsigned long auxType; Byte nameLength; Byte prefix1; Byte prefix2; char name[253]; }; typedef struct fileEntryRec fileEntryRec, *fileEntryRecPtr; struct namesHandleRec { Word bufferLength; fileEntryRec fileEntryArray[1]; }; typedef struct namesHandleRec namesHandleRec, *namesHandleRecPtr, **namesHandleRecHndl; struct MultiReplyRecord { Word good; namesHandleRecHndl namesHandle; }; typedef struct MultiReplyRecord MultiReplyRecord, *MultiReplyPtr; struct SFTypeList { Byte numEntries; Byte fileTypeEntries[sfFileTypeEntriesLength]; }; typedef struct SFTypeList SFTypeList, *SFTypeListPtr, **SFTypeListHndl; struct TypeSelector2 { Word flags; Word fileType; LongWord auxType; }; typedef struct TypeSelector2 TypeSelector2; struct SFTypeList2 { Word numEntries; TypeSelector2 fileTypeEntries[sfFileTypeEntriesLength]; }; typedef struct SFTypeList2 SFTypeList2, *SFTypeList2Ptr, **SFTypeList2Hndl; extern pascal void SFBootInit(void) inline(0x0117,dispatcher); extern pascal void SFStartUp(Word, Word) inline(0x0217,dispatcher); extern pascal void SFShutDown(void) inline(0x0317,dispatcher); extern pascal Word SFVersion(void) inline(0x0417,dispatcher); extern pascal void SFReset(void) inline(0x0517,dispatcher); extern pascal Boolean SFStatus(void) inline(0x0617,dispatcher); extern pascal void SFAllCaps(Boolean) inline(0x0D17,dispatcher); extern pascal void SFGetFile(Integer, Integer, Pointer, WordProcPtr, Pointer, SFReplyRecPtr) inline(0x0917,dispatcher); extern pascal void SFPGetFile(Integer, Integer, Pointer, WordProcPtr, Pointer, Pointer, VoidProcPtr, SFReplyRecPtr) inline(0x0B17,dispatcher); extern pascal void SFPPutFile(Integer, Integer, Pointer, Pointer, Word, Pointer, VoidProcPtr, SFReplyRecPtr) inline(0x0C17,dispatcher); extern pascal void SFPutFile(Integer, Integer, Pointer, Pointer, Word, SFReplyRecPtr) inline(0x0A17,dispatcher); extern pascal void SFGetFile2(Integer, Integer, Word, Ref, WordProcPtr, SFTypeList2Ptr, SFReplyRec2Ptr) inline(0x0E17,dispatcher); extern pascal void SFMultiGet2(Integer, Integer, Word, Ref, WordProcPtr, SFTypeList2Ptr, MultiReplyPtr) inline(0x1417,dispatcher); extern pascal void SFPGetFile2(Integer, Integer, VoidProcPtr, Word, Ref, WordProcPtr, SFTypeList2Ptr, Pointer, VoidProcPtr, SFReplyRec2Ptr) inline(0x1017,dispatcher); extern pascal void SFPMultiGet2(Integer, Integer, VoidProcPtr, Word, Ref, WordProcPtr, SFTypeList2Ptr, Pointer, VoidProcPtr, MultiReplyPtr) inline(0x1517,dispatcher); extern pascal void SFPPutFile2(Integer, Integer, VoidProcPtr, Word, Ref, Word, Ref, Pointer, VoidProcPtr, SFReplyRec2Ptr) inline(0x1117,dispatcher); extern pascal void SFPutFile2(Integer, Integer, Word, Ref, Word, Ref, SFReplyRec2Ptr) inline(0x0F17,dispatcher); extern pascal void SFReScan(WordProcPtr, SFTypeList2Ptr) inline(0x1317,dispatcher); extern pascal Boolean SFShowInvisible(Word) inline(0x1217,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Standard File Operations Tool Set +* +* Copyright Apple Computer, Inc.1986-92 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __STDFILE__ +#define __STDFILE__ + +/* Error Codes */ +#define badPromptDesc 0x1701 +#define badOrigNameDesc 0x1702 +#define badReplyNameDesc 0x1704 +#define badReplyPathDesc 0x1705 +#define badCall 0x1706 +#define sfNotStarted 0x17FF + +/* filterProc Result Codes */ +#define noDisplay 0x0000 /* file not to be displayed */ +#define noSelect 0x0001 /* file displayed, but not selectable */ +#define displaySelect 0x0002 /* file displayed and selectable */ + +/* Other Constants */ +#define sfWildAuxType 0x8000 +#define sfMatchFileType 0x8000 +#define sfWildFileType 0x4000 +#define sfMatchAuxType 0x4000 +#define sfDisplayGrey 0x2000 + +#ifndef sfFileTypeEntriesLength /* SFTypeList - default number of FileTypeEntries */ +#define sfFileTypeEntriesLength 0x0005 +#endif + +typedef struct SFReplyRec { + Boolean good; + Word fileType; + Word auxFileType; + char filename[16]; + char fullPathname[129]; + } SFReplyRec, *SFReplyRecPtr, **SFReplyRecHndl; + +struct SFReplyRec2 { + Boolean good; + Word fileType; + LongWord auxType; + RefDescriptor nameRefDesc; + Ref nameRef; + RefDescriptor pathRefDesc; + Ref pathRef; + }; +typedef struct SFReplyRec2 SFReplyRec2, *SFReplyRec2Ptr, **SFReplyRec2Hndl; + +struct fileEntryRec { + Word fileType; + unsigned long auxType; + Byte nameLength; + Byte prefix1; + Byte prefix2; + char name[253]; + }; +typedef struct fileEntryRec fileEntryRec, *fileEntryRecPtr; + +struct namesHandleRec { + Word bufferLength; + fileEntryRec fileEntryArray[1]; + }; +typedef struct namesHandleRec namesHandleRec, *namesHandleRecPtr, **namesHandleRecHndl; + +struct MultiReplyRecord { + Word good; + namesHandleRecHndl namesHandle; + }; +typedef struct MultiReplyRecord MultiReplyRecord, *MultiReplyPtr; + +struct SFTypeList { + Byte numEntries; + Byte fileTypeEntries[sfFileTypeEntriesLength]; + }; +typedef struct SFTypeList SFTypeList, *SFTypeListPtr, **SFTypeListHndl; + +struct TypeSelector2 { + Word flags; + Word fileType; + LongWord auxType; + }; +typedef struct TypeSelector2 TypeSelector2; + +struct SFTypeList2 { + Word numEntries; + TypeSelector2 fileTypeEntries[sfFileTypeEntriesLength]; + }; +typedef struct SFTypeList2 SFTypeList2, *SFTypeList2Ptr, **SFTypeList2Hndl; + +extern pascal void SFBootInit(void) inline(0x0117,dispatcher); +extern pascal void SFStartUp(Word, Word) inline(0x0217,dispatcher); +extern pascal void SFShutDown(void) inline(0x0317,dispatcher); +extern pascal Word SFVersion(void) inline(0x0417,dispatcher); +extern pascal void SFReset(void) inline(0x0517,dispatcher); +extern pascal Boolean SFStatus(void) inline(0x0617,dispatcher); +extern pascal void SFAllCaps(Boolean) inline(0x0D17,dispatcher); +extern pascal void SFGetFile(Integer, Integer, Pointer, WordProcPtr, Pointer, SFReplyRecPtr) inline(0x0917,dispatcher); +extern pascal void SFPGetFile(Integer, Integer, Pointer, WordProcPtr, Pointer, Pointer, VoidProcPtr, SFReplyRecPtr) inline(0x0B17,dispatcher); +extern pascal void SFPPutFile(Integer, Integer, Pointer, Pointer, Word, Pointer, VoidProcPtr, SFReplyRecPtr) inline(0x0C17,dispatcher); +extern pascal void SFPutFile(Integer, Integer, Pointer, Pointer, Word, SFReplyRecPtr) inline(0x0A17,dispatcher); + +extern pascal void SFGetFile2(Integer, Integer, Word, Ref, WordProcPtr, SFTypeList2Ptr, SFReplyRec2Ptr) inline(0x0E17,dispatcher); +extern pascal void SFMultiGet2(Integer, Integer, Word, Ref, WordProcPtr, SFTypeList2Ptr, MultiReplyPtr) inline(0x1417,dispatcher); +extern pascal void SFPGetFile2(Integer, Integer, VoidProcPtr, Word, Ref, WordProcPtr, SFTypeList2Ptr, Pointer, VoidProcPtr, SFReplyRec2Ptr) inline(0x1017,dispatcher); +extern pascal void SFPMultiGet2(Integer, Integer, VoidProcPtr, Word, Ref, WordProcPtr, SFTypeList2Ptr, Pointer, VoidProcPtr, MultiReplyPtr) inline(0x1517,dispatcher); +extern pascal void SFPPutFile2(Integer, Integer, VoidProcPtr, Word, Ref, Word, Ref, Pointer, VoidProcPtr, SFReplyRec2Ptr) inline(0x1117,dispatcher); +extern pascal void SFPutFile2(Integer, Integer, Word, Ref, Word, Ref, SFReplyRec2Ptr) inline(0x0F17,dispatcher); +extern pascal void SFReScan(WordProcPtr, SFTypeList2Ptr) inline(0x1317,dispatcher); +extern pascal Boolean SFShowInvisible(Word) inline(0x1217,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/stdio.h b/bin/Libraries/ORCACDefs/stdio.h old mode 100755 new mode 100644 index 2eab168..6305aac --- a/bin/Libraries/ORCACDefs/stdio.h +++ b/bin/Libraries/ORCACDefs/stdio.h @@ -1 +1,153 @@ -/**************************************************************** * * stdio.h - input/output facilities * * February 1989 * Mike Westerfield * * Copyright 1989, 1993, 1996 * Byte Works, Inc. * ****************************************************************/ #ifndef __stdio__ #define __stdio__ /* * Misc. */ #ifndef __va_list__ #define __va_list__ typedef char *__va_list[2]; #endif #ifndef EOF #define EOF (-1) #endif #ifndef NULL #define NULL (void *) 0L #endif #ifndef __size_t__ #define __size_t__ 1 typedef unsigned long size_t; #endif /* seek codes */ #define SEEK_SET 0 #define SEEK_CUR 1 #define SEEK_END 2 /* * Error handling */ #ifndef __KeepNamespacePure__ extern int sys_nerr; /* largest index for sys_errlist */ extern char *sys_errlist[]; /* error messages */ #endif /* * files */ typedef struct __file { struct __file *next; /* next file in linked list */ unsigned char *_ptr, /* next location to write to */ *_base, /* first byte of the buffer */ *_end; /* end of the file buffer */ unsigned long _size, /* size of the file buffer */ _cnt; /* # chars that can be read/written to buffer */ int _pbk[2]; /* put back buffer */ unsigned int _flag, /* buffer flags */ _file; /* GS/OS file ID */ } FILE; #define BUFSIZ 1024 /* default buffer size */ #define _LBUFSIZ 255 /* line buffer size */ #define _IOFBF 0x0001 /* full buffering */ #define _IONBF 0x0002 /* no buffering */ #define _IOLBF 0x0004 /* flush when a \n is written */ #define _IOREAD 0x0008 /* currently reading */ #define _IOWRT 0x0010 /* currently writing */ #define _IORW 0x0020 /* read/write enabled */ #define _IOMYBUF 0x0040 /* buffer was allocated by stdio */ #define _IOEOF 0x0080 /* has an EOF been found? */ #define _IOERR 0x0100 /* has an error occurred? */ #define _IOTEXT 0x0200 /* is this file a text file? */ #define _IOTEMPFILE 0x0400 /* was this file created by tmpfile()? */ extern FILE *stderr; /* standard I/O files */ extern FILE *stdin; extern FILE *stdout; #define L_tmpnam 26 /* size of a temp name */ #define TMP_MAX 10000 /* # of unique temp names */ #ifndef __KeepNamespacePure__ #define SYS_OPEN 32767 /* max # open files */ #endif #define FOPEN_MAX 32767 /* max # open files */ #define FILENAME_MAX 1024 /* recommended file name length */ /* * Other types */ typedef long fpos_t; /* * Functions declared as macros */ #define setbuf(stream,buf) ((buf==NULL) ? (void) __setvbuf(stream,NULL,_IONBF,0l) : (void) __setvbuf(stream,buf,_IOFBF,(size_t) BUFSIZ)) #define rewind(stream) (__fseek((stream),0L,SEEK_SET)) /* * Function declarations */ void clearerr(FILE *); int fclose(FILE *); int feof(FILE *); int ferror(FILE *); int fflush(FILE *); int fgetc(FILE *); int fgetpos(FILE *, fpos_t *); char *fgets(char *, int, FILE *); FILE *fopen(const char *, const char *); int fprintf(FILE *, const char *, ...); int fputc(int, FILE *); int fputs(const char *, FILE *); size_t fread(void *, size_t, size_t, FILE *); FILE *freopen(const char *, const char *, FILE *); int fscanf(FILE *, const char *, ...); int fseek(FILE *, long, int); int fsetpos(FILE *, const fpos_t *); long int ftell(FILE *); size_t fwrite(const void *, size_t, size_t, FILE *); int getc(FILE *); int getchar(void); char *gets(char *); void perror(const char *); int printf(const char *, ...); int putc(int, FILE *); int putchar(int); int puts(const char *); int remove(const char *); int rename(const char *, const char *); int scanf(const char *, ...); int setvbuf(FILE *, char *, int, size_t); int sprintf(char *, const char *, ...); int sscanf(const char *, const char *, ...); FILE *tmpfile(void); char *tmpnam(char *); int ungetc(int c, FILE *); int vfprintf(FILE *, const char *, __va_list); int vprintf(const char *, __va_list); int vsprintf(char *, const char *, __va_list); #endif \ No newline at end of file +/**************************************************************** +* +* stdio.h - input/output facilities +* +* February 1989 +* Mike Westerfield +* +* Copyright 1989, 1993, 1996 +* Byte Works, Inc. +* +****************************************************************/ + +#ifndef __stdio__ +#define __stdio__ + +/* + * Misc. + */ + +#ifndef __va_list__ +#define __va_list__ +typedef char *__va_list[2]; +#endif + +#ifndef EOF +#define EOF (-1) +#endif + +#ifndef NULL +#define NULL (void *) 0L +#endif + +#ifndef __size_t__ +#define __size_t__ 1 +typedef unsigned long size_t; +#endif + +/* seek codes */ + +#define SEEK_SET 0 +#define SEEK_CUR 1 +#define SEEK_END 2 + +/* + * Error handling + */ + +#ifndef __KeepNamespacePure__ + extern int sys_nerr; /* largest index for sys_errlist */ + extern char *sys_errlist[]; /* error messages */ +#endif + +/* + * files + */ + +typedef struct __file { + struct __file *next; /* next file in linked list */ + unsigned char *_ptr, /* next location to write to */ + *_base, /* first byte of the buffer */ + *_end; /* end of the file buffer */ + unsigned long _size, /* size of the file buffer */ + _cnt; /* # chars that can be read/written to buffer */ + int _pbk[2]; /* put back buffer */ + unsigned int _flag, /* buffer flags */ + _file; /* GS/OS file ID */ + } FILE; + +#define BUFSIZ 1024 /* default buffer size */ +#define _LBUFSIZ 255 /* line buffer size */ + +#define _IOFBF 0x0001 /* full buffering */ +#define _IONBF 0x0002 /* no buffering */ +#define _IOLBF 0x0004 /* flush when a \n is written */ +#define _IOREAD 0x0008 /* currently reading */ +#define _IOWRT 0x0010 /* currently writing */ +#define _IORW 0x0020 /* read/write enabled */ +#define _IOMYBUF 0x0040 /* buffer was allocated by stdio */ +#define _IOEOF 0x0080 /* has an EOF been found? */ +#define _IOERR 0x0100 /* has an error occurred? */ +#define _IOTEXT 0x0200 /* is this file a text file? */ +#define _IOTEMPFILE 0x0400 /* was this file created by tmpfile()? */ + +extern FILE *stderr; /* standard I/O files */ +extern FILE *stdin; +extern FILE *stdout; + +#define L_tmpnam 26 /* size of a temp name */ +#define TMP_MAX 10000 /* # of unique temp names */ +#ifndef __KeepNamespacePure__ + #define SYS_OPEN 32767 /* max # open files */ +#endif +#define FOPEN_MAX 32767 /* max # open files */ +#define FILENAME_MAX 1024 /* recommended file name length */ + +/* + * Other types + */ + +typedef long fpos_t; + +/* + * Functions declared as macros + */ + +#define setbuf(stream,buf) ((buf==NULL) ? (void) __setvbuf(stream,NULL,_IONBF,0l) : (void) __setvbuf(stream,buf,_IOFBF,(size_t) BUFSIZ)) +#define rewind(stream) (__fseek((stream),0L,SEEK_SET)) + +/* + * Function declarations + */ + +void clearerr(FILE *); +int fclose(FILE *); +int feof(FILE *); +int ferror(FILE *); +int fflush(FILE *); +int fgetc(FILE *); +int fgetpos(FILE *, fpos_t *); +char *fgets(char *, int, FILE *); +FILE *fopen(const char *, const char *); +int fprintf(FILE *, const char *, ...); +int fputc(int, FILE *); +int fputs(const char *, FILE *); +size_t fread(void *, size_t, size_t, FILE *); +FILE *freopen(const char *, const char *, FILE *); +int fscanf(FILE *, const char *, ...); +int fseek(FILE *, long, int); +int fsetpos(FILE *, const fpos_t *); +long int ftell(FILE *); +size_t fwrite(const void *, size_t, size_t, FILE *); +int getc(FILE *); +int getchar(void); +char *gets(char *); +void perror(const char *); +int printf(const char *, ...); +int putc(int, FILE *); +int putchar(int); +int puts(const char *); +int remove(const char *); +int rename(const char *, const char *); +int scanf(const char *, ...); +int setvbuf(FILE *, char *, int, size_t); +int sprintf(char *, const char *, ...); +int sscanf(const char *, const char *, ...); +FILE *tmpfile(void); +char *tmpnam(char *); +int ungetc(int c, FILE *); +int vfprintf(FILE *, const char *, __va_list); +int vprintf(const char *, __va_list); +int vsprintf(char *, const char *, __va_list); + +#endif diff --git a/bin/Libraries/ORCACDefs/stdlib.h b/bin/Libraries/ORCACDefs/stdlib.h index adc233c..47957b5 100644 --- a/bin/Libraries/ORCACDefs/stdlib.h +++ b/bin/Libraries/ORCACDefs/stdlib.h @@ -1 +1,65 @@ -/**************************************************************** * * stdlib.h - standard library functions * * February 1989 * Mike Westerfield * * Copyright 1989 * Byte Works, Inc. * ****************************************************************/ #ifndef __stdlib__ #define __stdlib__ #ifndef NULL #define NULL (void *) 0L #endif #ifndef __size_t__ #define __size_t__ 1 typedef unsigned long size_t; #endif #define RAND_MAX 32767 #define EXIT_FAILURE (-1) #define EXIT_SUCCESS 0 #define MB_CUR_MAX 1 typedef struct {int quot,rem;} div_t; typedef struct {long quot,rem;} ldiv_t; #ifndef __KeepNamespacePure__ #define clalloc(x,y) calloc((x),(y)) #define cfree(x) free(x) #define mlalloc(x) malloc(x) #define relalloc(x,y) realloc((x),(y)) #endif int abs(int); void abort(void); int atexit(void (*__func)(void)); double atof(const char *); int atoi(const char *); long atol(const char *); void *bsearch(const void *, const void *, size_t, size_t, int (*__compar)(const void *, const void *)); void *calloc(size_t, size_t); div_t div(int, int); void exit(int); void _exit(int); void free(void *); char *getenv(const char *); long labs(long); ldiv_t ldiv(long, long); void *malloc(size_t); void qsort(void *, size_t, size_t, int (*__compar)(const void *, const void *)); int rand(void); void *realloc(void *, size_t); void srand(unsigned); double strtod(const char *, char **); long strtol(const char *, char **, int); unsigned long strtoul(const char *, char **, int); int system(const char *); #endif \ No newline at end of file +/**************************************************************** +* +* stdlib.h - standard library functions +* +* February 1989 +* Mike Westerfield +* +* Copyright 1989 +* Byte Works, Inc. +* +****************************************************************/ + +#ifndef __stdlib__ +#define __stdlib__ + +#ifndef NULL +#define NULL (void *) 0L +#endif + +#ifndef __size_t__ +#define __size_t__ 1 +typedef unsigned long size_t; +#endif + +#define RAND_MAX 32767 +#define EXIT_FAILURE (-1) +#define EXIT_SUCCESS 0 +#define MB_CUR_MAX 1 + +typedef struct {int quot,rem;} div_t; +typedef struct {long quot,rem;} ldiv_t; + +#ifndef __KeepNamespacePure__ + #define clalloc(x,y) calloc((x),(y)) + #define cfree(x) free(x) + #define mlalloc(x) malloc(x) + #define relalloc(x,y) realloc((x),(y)) +#endif + +int abs(int); +void abort(void); +int atexit(void (*__func)(void)); +double atof(const char *); +int atoi(const char *); +long atol(const char *); +void *bsearch(const void *, const void *, size_t, size_t, int (*__compar)(const void *, const void *)); +void *calloc(size_t, size_t); +div_t div(int, int); +void exit(int); +void _exit(int); +void free(void *); +char *getenv(const char *); +long labs(long); +ldiv_t ldiv(long, long); +void *malloc(size_t); +void qsort(void *, size_t, size_t, int (*__compar)(const void *, const void *)); +int rand(void); +void *realloc(void *, size_t); +void srand(unsigned); +double strtod(const char *, char **); +long strtol(const char *, char **, int); +unsigned long strtoul(const char *, char **, int); +int system(const char *); + +#endif diff --git a/bin/Libraries/ORCACDefs/string.h b/bin/Libraries/ORCACDefs/string.h index 816dbf1..ec77a95 100644 --- a/bin/Libraries/ORCACDefs/string.h +++ b/bin/Libraries/ORCACDefs/string.h @@ -1 +1,51 @@ -/**************************************************************** * * string.h - string processing * * February 1989 * Mike Westerfield * * Copyright 1989 * Byte Works, Inc. * ****************************************************************/ #ifndef __string__ #define __string__ #ifndef __size_t__ #define __size_t__ 1 typedef unsigned long size_t; #endif #ifndef NULL #define NULL (void *) 0L #endif char *c2pstr(char *); void *memchr(const void *, int, size_t); int memcmp(const void *, const void *, size_t); void *memcpy(void *, const void *, size_t); void *memmove(void *, const void *, size_t); void *memset(void *, int, size_t); char *p2cstr(char *); char *strcat(char *, const char *); char *strchr(const char *, int); int strcmp(const char *, const char *); char *strcpy(char *, const char *); size_t strcspn(const char *, const char *); char *strerror(int); size_t strlen(const char *); char *strncat(char *, const char *, size_t); int strncmp(const char *, const char *, size_t); char *strncpy(char *, const char *, size_t); char *strpbrk(const char *, const char *); int strpos(char *, char); char *strrchr(const char *, int); char *strrpbrk(char *, char *); int strrpos(char *, char); size_t strspn(const char *, const char *); char *strstr(const char *, const char *); char *strtok(char *, const char *); #endif \ No newline at end of file +/**************************************************************** +* +* string.h - string processing +* +* February 1989 +* Mike Westerfield +* +* Copyright 1989 +* Byte Works, Inc. +* +****************************************************************/ + +#ifndef __string__ +#define __string__ + +#ifndef __size_t__ +#define __size_t__ 1 +typedef unsigned long size_t; +#endif + +#ifndef NULL +#define NULL (void *) 0L +#endif + +char *c2pstr(char *); +void *memchr(const void *, int, size_t); +int memcmp(const void *, const void *, size_t); +void *memcpy(void *, const void *, size_t); +void *memmove(void *, const void *, size_t); +void *memset(void *, int, size_t); +char *p2cstr(char *); +char *strcat(char *, const char *); +char *strchr(const char *, int); +int strcmp(const char *, const char *); +char *strcpy(char *, const char *); +size_t strcspn(const char *, const char *); +char *strerror(int); +size_t strlen(const char *); +char *strncat(char *, const char *, size_t); +int strncmp(const char *, const char *, size_t); +char *strncpy(char *, const char *, size_t); +char *strpbrk(const char *, const char *); +int strpos(char *, char); +char *strrchr(const char *, int); +char *strrpbrk(char *, char *); +int strrpos(char *, char); +size_t strspn(const char *, const char *); +char *strstr(const char *, const char *); +char *strtok(char *, const char *); + +#endif diff --git a/bin/Libraries/ORCACDefs/textedit.h b/bin/Libraries/ORCACDefs/textedit.h index 8af3826..99f9aa5 100644 --- a/bin/Libraries/ORCACDefs/textedit.h +++ b/bin/Libraries/ORCACDefs/textedit.h @@ -1 +1,443 @@ -/******************************************** * * TextEdit Tool Set * * Copyright Apple Computer, Inc.1986-90 * All Rights Reserved * * Copyright 1992, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __TEXTEDIT__ #define __TEXTEDIT__ /* Error Codes */ #define teAlreadyStarted 0x2201 #define teNotStarted 0x2202 #define teInvalidHandle 0x2203 #define teInvalidVerb 0x2204 #define teInvalidFlag 0x2205 #define teInvalidPCount 0x2206 #define teInvalidRect 0x2207 #define teBufferOverflow 0x2208 #define teInvalidLine 0x2209 #define teInvalidCall 0x220A /* TE Verbs */ #define NullVerb 0x0000 #define PStringVerb 0x0001 #define CStringVerb 0x0002 #define C1InputVerb 0x0003 #define C1OutputVerb 0x0004 #define HandleVerb 0x0005 #define PointerVerb 0x0006 #define NewPStringVerb 0x0007 #define fEqualLineSpacing 0x8000 #define fShowInvisibles 0x4000 #define teInvalidDescriptor 0x2204 #define teInvalidParameter 0x220B #define teInvalidTextBox2 0x220C #define teNeedsTools 0x220D /* 8717 */ #define teEqualLineSpacing 0x8000 #define teShowInvisibles 0x4000 /* Justification Values */ #define leftJust 0x0000 #define rightJust 0xFFFF #define centerJust 0x0001 #define fullJust 0x0002 /* TERuler.tabType Codes */ #define noTabs 0x0000 #define stdTabs 0x0001 /* Tabs every tabTerminator pixels */ #define absTabs 0x0002 /* Tabs at absolute location specified by theTabs array */ /* TEParamBlock.flags Codes */ #define fCtlInvis 0x0080 #define fRecordDirty 0x0040 /* TE Tab Codes */ #define teLeftTab 0x0000 #define teCenterTab 0x0001 #define teRightTab 0x0002 #define teDecimalTab 0x0003 /* TEParamBlock.textFlags Codes */ #define fNotControl 0x80000000L /* TextEdit record is not a control */ #define fSingleFormat 0x40000000L /* Only one ruler is allowed for record */ #define fSingleStyle 0x20000000L /* Only one style is allowed for record */ #define fNoWordWrap 0x10000000L /* No word wrap is performed */ #define fNoScroll 0x08000000L /* The text cannot scroll */ #define fReadOnly 0x04000000L /* The text cannot be edited */ #define fSmartCutPaste 0x02000000L /* Record supports intelligent cut and paste */ #define fTabSwitch 0x01000000L /* Tab key switches user to next TextEdit record on the screen */ #define fDrawBounds 0x00800000L /* TextEdit draw a box around text */ #define fColorHilight 0x00400000L /* Use color table for highlighting */ #define fGrowRuler 0x00200000L /* Adjust right margin whenever window size changes */ #define fDisableSelection 0x00100000L /* User cannot select or edit text */ #define fDrawInactiveSelection 0x00080000L /* TextEdit displays a box around an inactive selection */ /* Descriptor Codes */ #define teCtlColorIsPtr 0x0000 #define teCtlColorIsHandle 0x0004 #define teCtlColorIsResource 0x0008 #define teCtlStyleIsPtr 0x0000 #define teCtlStyleIsHandle 0x0001 #define teCtlStyleIsResource 0x0002 #define teRefIsPtr 0x0000 #define teRefIsHandle 0x0001 #define teRefIsResource 0x0002 #define teRefIsNewHandle 0x0003 #define teDataIsPString 0x0000 #define teDataIsCString 0x0001 #define teDataIsC1Input 0x0002 #define teDataIsC1Output 0x0003 #define teDataIsTextBox2 0x0004 #define teDataIsTextBlock 0x0005 #define teTextIsPtr 0x0000 #define teTextIsHandle 0x0008 #define teTextIsResource 0x0010 #define teTextIsNewHandle 0x0018 /* TEGetLastError clearFlag Codes */ #define fLeaveError 0x0000 /* Leave the last error code intact */ #define fClearError 0xFFFF /* Clear the last error code */ /* Other Constants */ #define teInvis 0x4000 #define tePartialLines 0x8000L #define teDontDraw 0x4000 #define teUseFont 0x0020 #define teUseSize 0x0010 #define teUseForeColor 0x0008 #define teUseBackColor 0x0004 #define teUseUserData 0x0002 #define teUseAttributes 0x0001 #define teReplaceFont 0x0040 #define teReplaceSize 0x0020 #define teReplaceForeColor 0x0010 #define teReplaceBackColor 0x0008 #define teReplaceUserField 0x0004 #define teReplaceAttributes 0x0002 #define teSwitchAttributes 0x0001 /* Filter Procedure Commands */ #define doEraseRect 0x0001 #define doEraseBuffer 0x0002 #define doRectChanged 0x0003 #define doKeyStroke 0x0004 /* TEScroll descriptors */ #define teScrollAbsTop 0x0000 /* 0 */ #define teScrollAbsCenter 0x0001 /* 1 */ #define teScrollLineTop 0x0002 /* 2 */ #define teScrollLineCenter 0x0003 /* 3 */ #define teScrollAbsUnit 0x0004 /* 4 */ #define teScrollRelUnit 0x0005 /* 5 */ struct TETextBlock { struct TETextBlock **nextHandle; /* Handle to next TextBlock in list */ struct TETextBlock **prevHandle; /* Handle to previous TextBlock in list */ LongWord textLength; /* Number of bytes of theText */ Word flags; Word reserved; /* Reserved */ Byte theText[1]; /* textLength bytes of text */ }; typedef struct TETextBlock TETextBlock, *TETextBlockPtr, **TETextBlockHndl; struct TETextList { TETextBlockHndl cachedHandle; /* Handle to current TextBlock */ LongWord cachedOffset; /* Text offset of the start of the current TextBlock */ }; typedef struct TETextList TETextList, *TETextListPtr, **TETextListHndl; struct TEColorTable { Word contentColor; Word outlineColor; Word hiliteForeColor; Word hiliteBackColor; Word vertColorDescriptor; LongWord vertColorRef; Word horzColorDescriptor; LongWord horzColorRef; Word growColorDescriptor; LongWord growColorRef; }; typedef struct TEColorTable TEColorTable, *TEColorTablePtr, **TEColorTableHndl; struct TEBlockEntry { Handle text; Handle length; Word flags; }; typedef struct TEBlockEntry TEBlockEntry; struct TEBlocksRecord { LongWord start; Word index; TEBlockEntry blocks[1]; }; typedef struct TEBlocksRecord TEBlocksRecord, *TEBlocksPtr, **TEBlocksHndl; struct TabItem { Word tabKind; Word tabData; }; typedef struct TabItem TabItem; struct TESuperItem { LongWord itemLength; LongWord itemData; }; typedef struct TESuperItem TESuperItem, *TESuperItemPtr, **TESuperItemHndl; struct TESuperBlock { struct TESuperBlock **nextHandle; struct TESuperBlock **prevHandle; LongWord textLength; LongWord reserved; TESuperItem theItems[1]; }; typedef struct TESuperBlock TESuperBlock, *TESuperBlockPtr, **TESuperBlockHndl; struct TESuperHandle { TESuperBlockHndl cachedHandle; LongWord cachedOffset; Word cachedIndex; Word itemsPerBlock; }; typedef struct TESuperHandle TESuperHandle, *TESuperHandlePtr, **TESuperHandleHndl; struct TERuler { Word leftMargin; Word leftIndent; Word rightMargin; Word just; Word extraLS; Word flags; LongWord userData; Word tabType; TabItem theTabs[1]; Word tabTerminator; }; typedef struct TERuler TERuler, *TERulerPtr, **TERulerHndl; struct TEStyle { FontID styleFontID; Word foreColor; Word backColor; LongWord userData; }; typedef struct TEStyle TEStyle, *TEStylePtr, **TEStyleHndl; struct TEStyleGroup { Word count; TEStyle styles[1]; }; typedef struct TEStyleGroup TEStyleGroup, *TEStyleGroupPtr, **TEStyleGroupHndl; struct StyleItem { LongWord dataLength; /* Number of text characters using the style */ LongWord dataOffset; /* Byte offset into theStyleList entry */ }; typedef struct StyleItem StyleItem, *StyleItemPtr, **StyleItemHndl; typedef long TERulerRef; /* The following data structure (TEFormat) is for reference only! It contains embedded variable length fields. */ struct TEFormat { Word version; LongWord rulerListLength; TERuler theRulerList[1]; LongWord styleListLength; TEStyle theStyleList[1]; LongWord numberOfStyles; StyleItem theStyles[1]; }; typedef struct TEFormat TEFormat, *TEFormatPtr, **TEFormatHndl; typedef struct TETextRef { Ptr TETextDesc; } TETextRef,*TETextRefPtr, **TETextRefHndl; typedef struct TEStyleRef { Ptr TEStyleDesc; } TEStyleRef,*TEStyleRefPtr,**TEStyleRefHndl; typedef long TEColorRef; struct TEParamBlock { Word pCount; LongWord controlID; Rect boundsRect; LongWord procRef; Word flags; Word moreflags; LongWord refCon; LongWord textFlags; Rect indentRect; CtlRecHndl vertBar; Word vertAmount; CtlRecHndl horzBar; Word horzAmount; TEStyleRef styleRef; Word textDescriptor; TETextRef textRef; LongWord textLength; LongWord maxChars; LongWord maxLines; Word maxCharsPerLine; Word maxHeight; TEColorRef colorRef; Word drawMode; ProcPtr filterProcPtr; }; typedef struct TEParamBlock TEParamBlock, *TEParamBlockPtr, **TEParamBlockHndl; struct TEInfoRec { LongWord charCount; LongWord lineCount; LongWord formatMemory; LongWord totalMemory; LongWord styleCount; LongWord rulerCount; }; typedef struct TEInfoRec TEInfoRec; struct TEHooks { ProcPtr charFilter; ProcPtr wordWrap; ProcPtr wordBreak; ProcPtr drawText; ProcPtr eraseText; }; typedef struct TEHooks TEHooks; struct TEKeyRecord { Word theChar; Word theModifiers; Handle theInputHandle; LongWord cursorOffset; Word theOpCode; }; typedef struct TEKeyRecord TEKeyRecord, *TEKeyRecordPtr, **TEKeyRecordHndl; struct TERecord { CtlRecHndl ctrlNext; WindowPtr inPort; Rect boundsRect; Byte ctrlFlag; Byte ctrlHilite; Word lastErrorCode; ProcPtr ctrlProc; ProcPtr ctrlAction; ProcPtr filterProc; LongWord ctrlRefCon; TEColorTablePtr colorRef; LongWord textFlags; LongWord textLength; TETextList blockList; LongWord ctrlID; Word ctrlMoreFlags; Word ctrlVersion; Rect viewRect; LongWord totalHeight; TESuperHandle lineSuper; TESuperHandle styleSuper; Handle styleList; Handle rulerList; Boolean lineAtEndFlag; LongWord selectionStart; LongWord selectionEnd; Word selectionActive; Word selectionState; LongWord caretTime; Boolean nullStyleActive; TEStyle nullStyle; LongWord topTextOffset; Word topTextVPos; CtlRecHndl vertScrollBar; LongWord vertScrollPos; LongWord vertScrollMax; Word vertScrollAmount; CtlRecHndl horzScrollBar; LongWord horzScrollPos; LongWord horzScrollMax; Word horzScrollAmount; CtlRecHndl growBoxHandle; LongWord maximumChars; LongWord maximumLines; Word maxCharsPerLine; Word maximumHeight; Word textDrawMode; ProcPtr wordBreakHook; ProcPtr wordWrapHook; ProcPtr keyFilter; Rect theFilterRect; Word theBufferVPos; Word theBufferHPos; TEKeyRecord theKeyRecord; LongWord cachedSelcOffset; Word cachedSelcVPos; Word cachedSelcHPos; Rect mouseRect; LongWord mouseTime; Word mouseKind; Point lastClick; Word savedHPos; LongWord anchorPoint; }; typedef struct TERecord TERecord, *TERecordPtr, **TERecordHndl; extern pascal void TEBootInit(void) inline(0x0122,dispatcher); extern pascal void TEStartUp(Word, Word) inline(0x0222,dispatcher); extern pascal void TEShutDown(void) inline(0x0322,dispatcher); extern pascal Word TEVersion(void) inline(0x0422,dispatcher); extern pascal void TEReset(void) inline(0x0522,dispatcher); extern pascal Word TEStatus(void) inline(0x0622,dispatcher); extern pascal void TEActivate(Handle) inline(0x0F22,dispatcher); extern pascal void TEClear(Handle) inline(0x1922,dispatcher); extern pascal void TEClick(EventRecordPtr, Handle) inline(0x1122,dispatcher); extern pascal void TECompactRecord(Handle) inline(0x2822,dispatcher); extern pascal void TECopy(Handle) inline(0x1722,dispatcher); extern pascal void TECut(Handle) inline(0x1622,dispatcher); extern pascal void TEDeactivate(Handle) inline(0x1022,dispatcher); extern pascal ProcPtr TEGetDefProc(void) inline(0x2222,dispatcher); extern pascal ProcPtr TEGetInternalProc(void) inline(0x2622,dispatcher); extern pascal Word TEGetLastError(Word, Handle) inline(0x2722,dispatcher); extern pascal void TEGetRuler(Word, Ref, Handle) inline(0x2322,dispatcher); extern pascal void TEGetSelection(Pointer, Pointer, Handle) inline(0x1C22,dispatcher); extern pascal Word TEGetSelectionStyle(TEStylePtr, Handle, Handle) inline(0x1E22,dispatcher); extern pascal LongWord TEGetText(Word, Ref, Long, Word, Ref, Handle) inline(0x0C22,dispatcher); extern pascal void TEGetTextInfo(Pointer, Word, Handle) inline(0x0D22,dispatcher); extern pascal void TEIdle(Handle) inline(0x0E22,dispatcher); extern pascal void TEInsert(Word, Ref, Long, Word, Ref, Handle) inline(0x1A22,dispatcher); extern pascal void TEKey(EventRecordPtr, Handle) inline(0x1422,dispatcher); extern pascal void TEKill(Handle) inline(0x0A22,dispatcher); extern pascal TERecordHndl TENew(TEParamBlockPtr) inline(0x0922,dispatcher); extern pascal void TEOffsetToPoint(Long, Long *, Long *, Handle) inline(0x2022,dispatcher); extern pascal LongWord TEPaintText(GrafPortPtr, Long, Rect *, Word, Handle) inline(0x1322,dispatcher); extern pascal void TEPaste(Handle) inline(0x1822,dispatcher); extern pascal LongWord TEPointToOffset(Long, Long, Handle) inline(0x2122,dispatcher); extern pascal void TEReplace(Word, Ref, Long, Word, Ref, Handle) inline(0x1B22,dispatcher); extern pascal void TEScroll(Word, Long, Long, Handle) inline(0x2522,dispatcher); extern pascal void TESetRuler(Word, Ref, Handle) inline(0x2422,dispatcher); extern pascal void TESetSelection(Pointer, Pointer, Handle) inline(0x1D22,dispatcher); extern pascal void TESetText(Word, Ref, Long, Word, Ref, Handle) inline(0x0B22,dispatcher); extern pascal void TEStyleChange(Word, TEStylePtr, Handle) inline(0x1F22,dispatcher); extern pascal void TEUpdate(Handle) inline(0x1222,dispatcher); /* This call appeared in Apple's interfaces, but is not documented. extern pascal void TEInsertPageBreak() inline(0x1522,dispatcher); */ #endif \ No newline at end of file +/******************************************** +* +* TextEdit Tool Set +* +* Copyright Apple Computer, Inc.1986-90 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __TEXTEDIT__ +#define __TEXTEDIT__ + +/* Error Codes */ +#define teAlreadyStarted 0x2201 +#define teNotStarted 0x2202 +#define teInvalidHandle 0x2203 +#define teInvalidVerb 0x2204 +#define teInvalidFlag 0x2205 +#define teInvalidPCount 0x2206 +#define teInvalidRect 0x2207 +#define teBufferOverflow 0x2208 +#define teInvalidLine 0x2209 +#define teInvalidCall 0x220A + +/* TE Verbs */ +#define NullVerb 0x0000 +#define PStringVerb 0x0001 +#define CStringVerb 0x0002 +#define C1InputVerb 0x0003 +#define C1OutputVerb 0x0004 +#define HandleVerb 0x0005 +#define PointerVerb 0x0006 +#define NewPStringVerb 0x0007 +#define fEqualLineSpacing 0x8000 +#define fShowInvisibles 0x4000 +#define teInvalidDescriptor 0x2204 +#define teInvalidParameter 0x220B +#define teInvalidTextBox2 0x220C +#define teNeedsTools 0x220D /* 8717 */ +#define teEqualLineSpacing 0x8000 +#define teShowInvisibles 0x4000 + +/* Justification Values */ +#define leftJust 0x0000 +#define rightJust 0xFFFF +#define centerJust 0x0001 +#define fullJust 0x0002 + +/* TERuler.tabType Codes */ +#define noTabs 0x0000 +#define stdTabs 0x0001 /* Tabs every tabTerminator pixels */ +#define absTabs 0x0002 /* Tabs at absolute location specified by theTabs array */ + +/* TEParamBlock.flags Codes */ +#define fCtlInvis 0x0080 +#define fRecordDirty 0x0040 + +/* TE Tab Codes */ +#define teLeftTab 0x0000 +#define teCenterTab 0x0001 +#define teRightTab 0x0002 +#define teDecimalTab 0x0003 + +/* TEParamBlock.textFlags Codes */ +#define fNotControl 0x80000000L /* TextEdit record is not a control */ +#define fSingleFormat 0x40000000L /* Only one ruler is allowed for record */ +#define fSingleStyle 0x20000000L /* Only one style is allowed for record */ +#define fNoWordWrap 0x10000000L /* No word wrap is performed */ +#define fNoScroll 0x08000000L /* The text cannot scroll */ +#define fReadOnly 0x04000000L /* The text cannot be edited */ +#define fSmartCutPaste 0x02000000L /* Record supports intelligent cut and paste */ +#define fTabSwitch 0x01000000L /* Tab key switches user to next TextEdit record on the screen */ +#define fDrawBounds 0x00800000L /* TextEdit draw a box around text */ +#define fColorHilight 0x00400000L /* Use color table for highlighting */ +#define fGrowRuler 0x00200000L /* Adjust right margin whenever window size changes */ +#define fDisableSelection 0x00100000L /* User cannot select or edit text */ +#define fDrawInactiveSelection 0x00080000L /* TextEdit displays a box around an inactive selection */ + +/* Descriptor Codes */ +#define teCtlColorIsPtr 0x0000 +#define teCtlColorIsHandle 0x0004 +#define teCtlColorIsResource 0x0008 +#define teCtlStyleIsPtr 0x0000 +#define teCtlStyleIsHandle 0x0001 +#define teCtlStyleIsResource 0x0002 +#define teRefIsPtr 0x0000 +#define teRefIsHandle 0x0001 +#define teRefIsResource 0x0002 +#define teRefIsNewHandle 0x0003 +#define teDataIsPString 0x0000 +#define teDataIsCString 0x0001 +#define teDataIsC1Input 0x0002 +#define teDataIsC1Output 0x0003 +#define teDataIsTextBox2 0x0004 +#define teDataIsTextBlock 0x0005 +#define teTextIsPtr 0x0000 +#define teTextIsHandle 0x0008 +#define teTextIsResource 0x0010 +#define teTextIsNewHandle 0x0018 + +/* TEGetLastError clearFlag Codes */ +#define fLeaveError 0x0000 /* Leave the last error code intact */ +#define fClearError 0xFFFF /* Clear the last error code */ + +/* Other Constants */ +#define teInvis 0x4000 +#define tePartialLines 0x8000L +#define teDontDraw 0x4000 +#define teUseFont 0x0020 +#define teUseSize 0x0010 +#define teUseForeColor 0x0008 +#define teUseBackColor 0x0004 +#define teUseUserData 0x0002 +#define teUseAttributes 0x0001 +#define teReplaceFont 0x0040 +#define teReplaceSize 0x0020 +#define teReplaceForeColor 0x0010 +#define teReplaceBackColor 0x0008 +#define teReplaceUserField 0x0004 +#define teReplaceAttributes 0x0002 +#define teSwitchAttributes 0x0001 + +/* Filter Procedure Commands */ +#define doEraseRect 0x0001 +#define doEraseBuffer 0x0002 +#define doRectChanged 0x0003 +#define doKeyStroke 0x0004 + +/* TEScroll descriptors */ +#define teScrollAbsTop 0x0000 /* 0 */ +#define teScrollAbsCenter 0x0001 /* 1 */ +#define teScrollLineTop 0x0002 /* 2 */ +#define teScrollLineCenter 0x0003 /* 3 */ +#define teScrollAbsUnit 0x0004 /* 4 */ +#define teScrollRelUnit 0x0005 /* 5 */ + +struct TETextBlock { + struct TETextBlock **nextHandle; /* Handle to next TextBlock in list */ + struct TETextBlock **prevHandle; /* Handle to previous TextBlock in list */ + LongWord textLength; /* Number of bytes of theText */ + Word flags; + Word reserved; /* Reserved */ + Byte theText[1]; /* textLength bytes of text */ + }; +typedef struct TETextBlock TETextBlock, *TETextBlockPtr, **TETextBlockHndl; + +struct TETextList { + TETextBlockHndl cachedHandle; /* Handle to current TextBlock */ + LongWord cachedOffset; /* Text offset of the start of the current TextBlock */ + }; +typedef struct TETextList TETextList, *TETextListPtr, **TETextListHndl; + +struct TEColorTable { + Word contentColor; + Word outlineColor; + Word hiliteForeColor; + Word hiliteBackColor; + Word vertColorDescriptor; + LongWord vertColorRef; + Word horzColorDescriptor; + LongWord horzColorRef; + Word growColorDescriptor; + LongWord growColorRef; + }; +typedef struct TEColorTable TEColorTable, *TEColorTablePtr, **TEColorTableHndl; + +struct TEBlockEntry { + Handle text; + Handle length; + Word flags; + }; +typedef struct TEBlockEntry TEBlockEntry; + +struct TEBlocksRecord { + LongWord start; + Word index; + TEBlockEntry blocks[1]; + }; +typedef struct TEBlocksRecord TEBlocksRecord, *TEBlocksPtr, **TEBlocksHndl; + +struct TabItem { + Word tabKind; + Word tabData; + }; +typedef struct TabItem TabItem; + +struct TESuperItem { + LongWord itemLength; + LongWord itemData; + }; +typedef struct TESuperItem TESuperItem, *TESuperItemPtr, **TESuperItemHndl; + +struct TESuperBlock { + struct TESuperBlock **nextHandle; + struct TESuperBlock **prevHandle; + LongWord textLength; + LongWord reserved; + TESuperItem theItems[1]; + }; +typedef struct TESuperBlock TESuperBlock, *TESuperBlockPtr, **TESuperBlockHndl; + +struct TESuperHandle { + TESuperBlockHndl cachedHandle; + LongWord cachedOffset; + Word cachedIndex; + Word itemsPerBlock; + }; +typedef struct TESuperHandle TESuperHandle, *TESuperHandlePtr, **TESuperHandleHndl; + +struct TERuler { + Word leftMargin; + Word leftIndent; + Word rightMargin; + Word just; + Word extraLS; + Word flags; + LongWord userData; + Word tabType; + TabItem theTabs[1]; + Word tabTerminator; + }; +typedef struct TERuler TERuler, *TERulerPtr, **TERulerHndl; + +struct TEStyle { + FontID styleFontID; + Word foreColor; + Word backColor; + LongWord userData; + }; +typedef struct TEStyle TEStyle, *TEStylePtr, **TEStyleHndl; + +struct TEStyleGroup { + Word count; + TEStyle styles[1]; + }; +typedef struct TEStyleGroup TEStyleGroup, *TEStyleGroupPtr, **TEStyleGroupHndl; + +struct StyleItem { + LongWord dataLength; /* Number of text characters using the style */ + LongWord dataOffset; /* Byte offset into theStyleList entry */ + }; +typedef struct StyleItem StyleItem, *StyleItemPtr, **StyleItemHndl; + +typedef long TERulerRef; + +/* + The following data structure (TEFormat) is for reference only! + It contains embedded variable length fields. +*/ + +struct TEFormat { + Word version; + LongWord rulerListLength; + TERuler theRulerList[1]; + LongWord styleListLength; + TEStyle theStyleList[1]; + LongWord numberOfStyles; + StyleItem theStyles[1]; + }; +typedef struct TEFormat TEFormat, *TEFormatPtr, **TEFormatHndl; + +typedef struct TETextRef { + Ptr TETextDesc; + } TETextRef,*TETextRefPtr, **TETextRefHndl; + +typedef struct TEStyleRef { + Ptr TEStyleDesc; + } TEStyleRef,*TEStyleRefPtr,**TEStyleRefHndl; + +typedef long TEColorRef; + +struct TEParamBlock { + Word pCount; + LongWord controlID; + Rect boundsRect; + LongWord procRef; + Word flags; + Word moreflags; + LongWord refCon; + LongWord textFlags; + Rect indentRect; + CtlRecHndl vertBar; + Word vertAmount; + CtlRecHndl horzBar; + Word horzAmount; + TEStyleRef styleRef; + Word textDescriptor; + TETextRef textRef; + LongWord textLength; + LongWord maxChars; + LongWord maxLines; + Word maxCharsPerLine; + Word maxHeight; + TEColorRef colorRef; + Word drawMode; + ProcPtr filterProcPtr; + }; +typedef struct TEParamBlock TEParamBlock, *TEParamBlockPtr, **TEParamBlockHndl; + +struct TEInfoRec { + LongWord charCount; + LongWord lineCount; + LongWord formatMemory; + LongWord totalMemory; + LongWord styleCount; + LongWord rulerCount; + }; +typedef struct TEInfoRec TEInfoRec; + +struct TEHooks { + ProcPtr charFilter; + ProcPtr wordWrap; + ProcPtr wordBreak; + ProcPtr drawText; + ProcPtr eraseText; + }; +typedef struct TEHooks TEHooks; + +struct TEKeyRecord { + Word theChar; + Word theModifiers; + Handle theInputHandle; + LongWord cursorOffset; + Word theOpCode; + }; +typedef struct TEKeyRecord TEKeyRecord, *TEKeyRecordPtr, **TEKeyRecordHndl; + +struct TERecord { + CtlRecHndl ctrlNext; + WindowPtr inPort; + Rect boundsRect; + Byte ctrlFlag; + Byte ctrlHilite; + Word lastErrorCode; + ProcPtr ctrlProc; + ProcPtr ctrlAction; + ProcPtr filterProc; + LongWord ctrlRefCon; + TEColorTablePtr colorRef; + LongWord textFlags; + LongWord textLength; + TETextList blockList; + LongWord ctrlID; + Word ctrlMoreFlags; + Word ctrlVersion; + Rect viewRect; + LongWord totalHeight; + TESuperHandle lineSuper; + TESuperHandle styleSuper; + Handle styleList; + Handle rulerList; + Boolean lineAtEndFlag; + LongWord selectionStart; + LongWord selectionEnd; + Word selectionActive; + Word selectionState; + LongWord caretTime; + Boolean nullStyleActive; + TEStyle nullStyle; + LongWord topTextOffset; + Word topTextVPos; + CtlRecHndl vertScrollBar; + LongWord vertScrollPos; + LongWord vertScrollMax; + Word vertScrollAmount; + CtlRecHndl horzScrollBar; + LongWord horzScrollPos; + LongWord horzScrollMax; + Word horzScrollAmount; + CtlRecHndl growBoxHandle; + LongWord maximumChars; + LongWord maximumLines; + Word maxCharsPerLine; + Word maximumHeight; + Word textDrawMode; + ProcPtr wordBreakHook; + ProcPtr wordWrapHook; + ProcPtr keyFilter; + Rect theFilterRect; + Word theBufferVPos; + Word theBufferHPos; + TEKeyRecord theKeyRecord; + LongWord cachedSelcOffset; + Word cachedSelcVPos; + Word cachedSelcHPos; + Rect mouseRect; + LongWord mouseTime; + Word mouseKind; + Point lastClick; + Word savedHPos; + LongWord anchorPoint; + }; +typedef struct TERecord TERecord, *TERecordPtr, **TERecordHndl; + +extern pascal void TEBootInit(void) inline(0x0122,dispatcher); +extern pascal void TEStartUp(Word, Word) inline(0x0222,dispatcher); +extern pascal void TEShutDown(void) inline(0x0322,dispatcher); +extern pascal Word TEVersion(void) inline(0x0422,dispatcher); +extern pascal void TEReset(void) inline(0x0522,dispatcher); +extern pascal Word TEStatus(void) inline(0x0622,dispatcher); +extern pascal void TEActivate(Handle) inline(0x0F22,dispatcher); +extern pascal void TEClear(Handle) inline(0x1922,dispatcher); +extern pascal void TEClick(EventRecordPtr, Handle) inline(0x1122,dispatcher); +extern pascal void TECompactRecord(Handle) inline(0x2822,dispatcher); +extern pascal void TECopy(Handle) inline(0x1722,dispatcher); +extern pascal void TECut(Handle) inline(0x1622,dispatcher); +extern pascal void TEDeactivate(Handle) inline(0x1022,dispatcher); +extern pascal ProcPtr TEGetDefProc(void) inline(0x2222,dispatcher); +extern pascal ProcPtr TEGetInternalProc(void) inline(0x2622,dispatcher); +extern pascal Word TEGetLastError(Word, Handle) inline(0x2722,dispatcher); +extern pascal void TEGetRuler(Word, Ref, Handle) inline(0x2322,dispatcher); +extern pascal void TEGetSelection(Pointer, Pointer, Handle) inline(0x1C22,dispatcher); +extern pascal Word TEGetSelectionStyle(TEStylePtr, Handle, Handle) inline(0x1E22,dispatcher); +extern pascal LongWord TEGetText(Word, Ref, Long, Word, Ref, Handle) inline(0x0C22,dispatcher); +extern pascal void TEGetTextInfo(Pointer, Word, Handle) inline(0x0D22,dispatcher); +extern pascal void TEIdle(Handle) inline(0x0E22,dispatcher); +extern pascal void TEInsert(Word, Ref, Long, Word, Ref, Handle) inline(0x1A22,dispatcher); +extern pascal void TEKey(EventRecordPtr, Handle) inline(0x1422,dispatcher); +extern pascal void TEKill(Handle) inline(0x0A22,dispatcher); +extern pascal TERecordHndl TENew(TEParamBlockPtr) inline(0x0922,dispatcher); +extern pascal void TEOffsetToPoint(Long, Long *, Long *, Handle) inline(0x2022,dispatcher); +extern pascal LongWord TEPaintText(GrafPortPtr, Long, Rect *, Word, Handle) inline(0x1322,dispatcher); +extern pascal void TEPaste(Handle) inline(0x1822,dispatcher); +extern pascal LongWord TEPointToOffset(Long, Long, Handle) inline(0x2122,dispatcher); +extern pascal void TEReplace(Word, Ref, Long, Word, Ref, Handle) inline(0x1B22,dispatcher); +extern pascal void TEScroll(Word, Long, Long, Handle) inline(0x2522,dispatcher); +extern pascal void TESetRuler(Word, Ref, Handle) inline(0x2422,dispatcher); +extern pascal void TESetSelection(Pointer, Pointer, Handle) inline(0x1D22,dispatcher); +extern pascal void TESetText(Word, Ref, Long, Word, Ref, Handle) inline(0x0B22,dispatcher); +extern pascal void TEStyleChange(Word, TEStylePtr, Handle) inline(0x1F22,dispatcher); +extern pascal void TEUpdate(Handle) inline(0x1222,dispatcher); + +/* This call appeared in Apple's interfaces, but is not documented. +extern pascal void TEInsertPageBreak() inline(0x1522,dispatcher); +*/ + +#endif diff --git a/bin/Libraries/ORCACDefs/texttool.h b/bin/Libraries/ORCACDefs/texttool.h index 5bee94b..d18c713 100644 --- a/bin/Libraries/ORCACDefs/texttool.h +++ b/bin/Libraries/ORCACDefs/texttool.h @@ -1 +1,99 @@ -/******************************************** * * Text Tool Set * * Copyright Apple Computer, Inc.1986-90 * All Rights Reserved * * Copyright 1992, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __TEXTTOOL__ #define __TEXTTOOL__ /* Error Codes */ #define badDevType 0x0C01 /* not implemented */ #define badDevNum 0x0C02 /* Illegal device number. */ #define badMode 0x0C03 /* Bad mode: illegal operation. */ #define unDefHW 0x0C04 /* Undefined hardware error */ #define lostDev 0x0C05 /* Lost device: Device no longer on line */ #define lostFile 0x0C06 /* File no longer in diskette directory */ #define badTitle 0x0C07 /* Illegal Filename */ #define noRoom 0x0C08 /* Insufficient space on specified diskette */ #define noDevice 0x0C09 /* Volume not online */ #define noFile 0x0C0A /* File not in specifiled directory */ #define dupFile 0x0C0B /* Filename already exists */ #define notClosed 0x0C0C /* Attempt to open an open file */ #define notOpen 0x0C0D /* Attempt to close closed file */ #define badFormat 0x0C0E /* error reading real or integer */ #define ringBuffOFlo 0x0C0F /* Chars arriving too fast */ #define writeProtected 0x0C10 #define devErr 0x0C40 /* Read or Write failed */ /* deviceNum Codes */ #define input 0x0000 #define output 0x0001 #define errorOutput 0x0002 /* deviceType Codes */ #define basicType 0x0000 #define pascalType 0x0001 #define ramBased 0x0002 /* echoFlag Codes */ #define noEcho 0x0000 #define echo 0x0001 struct DeviceRec { LongWord ptrOrSlot; /* slot number or jump table ptr */ Word deviceType; /* type of input device */ }; typedef struct DeviceRec DeviceRec, *DeviceRecPtr, **DeviceRecHndl; struct TxtMaskRec { Word orMask; Word andMask; }; typedef struct TxtMaskRec TxtMaskRec, *TxtMaskRecPtr, **TxtMaskRecHndl; extern pascal void TextBootInit(void) inline(0x010C,dispatcher); extern pascal void TextStartUp(void) inline(0x020C,dispatcher); extern pascal void TextShutDown(void) inline(0x030C,dispatcher); extern pascal Word TextVersion(void) inline(0x040C,dispatcher); extern pascal void TextReset(void) inline(0x050C,dispatcher); extern pascal Boolean TextStatus(void) inline(0x060C,dispatcher); extern pascal void CtlTextDev(Word, Word) inline(0x160C,dispatcher); extern pascal void ErrWriteBlock(Pointer, Word, Word) inline(0x1F0C,dispatcher); extern pascal void ErrWriteChar(Word) inline(0x190C,dispatcher); extern pascal void ErrWriteCString(Pointer) inline(0x210C,dispatcher); extern pascal void ErrWriteLine(Pointer) inline(0x1B0C,dispatcher); extern pascal void ErrWriteString(Pointer) inline(0x1D0C,dispatcher); extern pascal Long GetErrGlobals(void) inline(0x0E0C,dispatcher); extern DeviceRec GetErrorDevice(void); extern pascal Long GetInGlobals(void) inline(0x0C0C,dispatcher); extern DeviceRec GetInputDevice(void); extern pascal Long GetOutGlobals (void) inline(0x0D0C,dispatcher); extern DeviceRec GetOutputDevice(void); extern pascal void InitTextDev(Word) inline(0x150C,dispatcher); extern pascal Word ReadChar(Word) inline(0x220C,dispatcher); extern pascal Word ReadLine(Pointer, Word, Word, Word) inline(0x240C,dispatcher); extern pascal void SetErrGlobals(Word, Word) inline(0x0B0C,dispatcher); extern pascal void SetErrorDevice(Word, LongWord) inline(0x110C,dispatcher); extern pascal void SetInGlobals(Word, Word) inline(0x090C,dispatcher); extern pascal void SetInputDevice(Word, LongWord) inline(0x0F0C,dispatcher); extern pascal void SetOutGlobals(Word, Word) inline(0x0A0C,dispatcher); extern pascal void SetOutputDevice(Word, LongWord) inline(0x100C,dispatcher); extern pascal void StatusTextDev(Word, Word) inline(0x170C,dispatcher); extern pascal void TextReadBlock(Pointer, Word, Word, Word) inline(0x230C,dispatcher); extern pascal void TextWriteBlock(Pointer, Word, Word) inline(0x1E0C,dispatcher); extern pascal void WriteChar(Word) inline(0x180C,dispatcher); extern pascal void WriteCString(Pointer) inline(0x200C,dispatcher); extern pascal void WriteLine(Pointer) inline(0x1A0C,dispatcher); extern pascal void WriteString(Pointer) inline(0x1C0C,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Text Tool Set +* +* Copyright Apple Computer, Inc.1986-90 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __TEXTTOOL__ +#define __TEXTTOOL__ + +/* Error Codes */ +#define badDevType 0x0C01 /* not implemented */ +#define badDevNum 0x0C02 /* Illegal device number. */ +#define badMode 0x0C03 /* Bad mode: illegal operation. */ +#define unDefHW 0x0C04 /* Undefined hardware error */ +#define lostDev 0x0C05 /* Lost device: Device no longer on line */ +#define lostFile 0x0C06 /* File no longer in diskette directory */ +#define badTitle 0x0C07 /* Illegal Filename */ +#define noRoom 0x0C08 /* Insufficient space on specified diskette */ +#define noDevice 0x0C09 /* Volume not online */ +#define noFile 0x0C0A /* File not in specifiled directory */ +#define dupFile 0x0C0B /* Filename already exists */ +#define notClosed 0x0C0C /* Attempt to open an open file */ +#define notOpen 0x0C0D /* Attempt to close closed file */ +#define badFormat 0x0C0E /* error reading real or integer */ +#define ringBuffOFlo 0x0C0F /* Chars arriving too fast */ +#define writeProtected 0x0C10 +#define devErr 0x0C40 /* Read or Write failed */ + +/* deviceNum Codes */ +#define input 0x0000 +#define output 0x0001 +#define errorOutput 0x0002 + +/* deviceType Codes */ +#define basicType 0x0000 +#define pascalType 0x0001 +#define ramBased 0x0002 + +/* echoFlag Codes */ +#define noEcho 0x0000 +#define echo 0x0001 + +struct DeviceRec { + LongWord ptrOrSlot; /* slot number or jump table ptr */ + Word deviceType; /* type of input device */ + }; +typedef struct DeviceRec DeviceRec, *DeviceRecPtr, **DeviceRecHndl; + +struct TxtMaskRec { + Word orMask; + Word andMask; + }; +typedef struct TxtMaskRec TxtMaskRec, *TxtMaskRecPtr, **TxtMaskRecHndl; + +extern pascal void TextBootInit(void) inline(0x010C,dispatcher); +extern pascal void TextStartUp(void) inline(0x020C,dispatcher); +extern pascal void TextShutDown(void) inline(0x030C,dispatcher); +extern pascal Word TextVersion(void) inline(0x040C,dispatcher); +extern pascal void TextReset(void) inline(0x050C,dispatcher); +extern pascal Boolean TextStatus(void) inline(0x060C,dispatcher); +extern pascal void CtlTextDev(Word, Word) inline(0x160C,dispatcher); +extern pascal void ErrWriteBlock(Pointer, Word, Word) inline(0x1F0C,dispatcher); +extern pascal void ErrWriteChar(Word) inline(0x190C,dispatcher); +extern pascal void ErrWriteCString(Pointer) inline(0x210C,dispatcher); +extern pascal void ErrWriteLine(Pointer) inline(0x1B0C,dispatcher); +extern pascal void ErrWriteString(Pointer) inline(0x1D0C,dispatcher); +extern pascal Long GetErrGlobals(void) inline(0x0E0C,dispatcher); +extern DeviceRec GetErrorDevice(void); +extern pascal Long GetInGlobals(void) inline(0x0C0C,dispatcher); +extern DeviceRec GetInputDevice(void); +extern pascal Long GetOutGlobals (void) inline(0x0D0C,dispatcher); +extern DeviceRec GetOutputDevice(void); +extern pascal void InitTextDev(Word) inline(0x150C,dispatcher); +extern pascal Word ReadChar(Word) inline(0x220C,dispatcher); +extern pascal Word ReadLine(Pointer, Word, Word, Word) inline(0x240C,dispatcher); +extern pascal void SetErrGlobals(Word, Word) inline(0x0B0C,dispatcher); +extern pascal void SetErrorDevice(Word, LongWord) inline(0x110C,dispatcher); +extern pascal void SetInGlobals(Word, Word) inline(0x090C,dispatcher); +extern pascal void SetInputDevice(Word, LongWord) inline(0x0F0C,dispatcher); +extern pascal void SetOutGlobals(Word, Word) inline(0x0A0C,dispatcher); +extern pascal void SetOutputDevice(Word, LongWord) inline(0x100C,dispatcher); +extern pascal void StatusTextDev(Word, Word) inline(0x170C,dispatcher); +extern pascal void TextReadBlock(Pointer, Word, Word, Word) inline(0x230C,dispatcher); +extern pascal void TextWriteBlock(Pointer, Word, Word) inline(0x1E0C,dispatcher); +extern pascal void WriteChar(Word) inline(0x180C,dispatcher); +extern pascal void WriteCString(Pointer) inline(0x200C,dispatcher); +extern pascal void WriteLine(Pointer) inline(0x1A0C,dispatcher); +extern pascal void WriteString(Pointer) inline(0x1C0C,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/time.h b/bin/Libraries/ORCACDefs/time.h index b701d81..88a1c52 100644 --- a/bin/Libraries/ORCACDefs/time.h +++ b/bin/Libraries/ORCACDefs/time.h @@ -1 +1,54 @@ -/**************************************************************** * * time.h - time and date functions * * February 1989 * Mike Westerfield * * Copyright 1989 * Byte Works, Inc. * ****************************************************************/ #ifndef __time__ #define __time__ typedef unsigned long clock_t; typedef unsigned long time_t; struct tm { int tm_sec; int tm_min; int tm_hour; int tm_mday; int tm_mon; int tm_year; int tm_wday; int tm_yday; int tm_isdst; }; #ifndef __KeepNamespacePure__ #define CLK_TCK 60 #endif #define CLOCKS_PER_SEC 60 #ifndef NULL #define NULL (void *) 0L #endif #ifndef __size_t__ #define __size_t__ 1 typedef unsigned long size_t; #endif char *asctime(const struct tm *); clock_t clock(void); char *ctime(const time_t *); double difftime(time_t, time_t); struct tm *gmtime(const time_t *); struct tm *localtime(const time_t *); time_t mktime(struct tm *); time_t time(time_t *); #endif \ No newline at end of file +/**************************************************************** +* +* time.h - time and date functions +* +* February 1989 +* Mike Westerfield +* +* Copyright 1989 +* Byte Works, Inc. +* +****************************************************************/ + +#ifndef __time__ +#define __time__ + +typedef unsigned long clock_t; +typedef unsigned long time_t; + +struct tm { + int tm_sec; + int tm_min; + int tm_hour; + int tm_mday; + int tm_mon; + int tm_year; + int tm_wday; + int tm_yday; + int tm_isdst; + }; + +#ifndef __KeepNamespacePure__ + #define CLK_TCK 60 +#endif +#define CLOCKS_PER_SEC 60 + +#ifndef NULL +#define NULL (void *) 0L +#endif + +#ifndef __size_t__ +#define __size_t__ 1 +typedef unsigned long size_t; +#endif + +char *asctime(const struct tm *); +clock_t clock(void); +char *ctime(const time_t *); +double difftime(time_t, time_t); +struct tm *gmtime(const time_t *); +struct tm *localtime(const time_t *); +time_t mktime(struct tm *); +time_t time(time_t *); + +#endif diff --git a/bin/Libraries/ORCACDefs/toollib.h b/bin/Libraries/ORCACDefs/toollib.h index 12b1349..1b5d68c 100644 --- a/bin/Libraries/ORCACDefs/toollib.h +++ b/bin/Libraries/ORCACDefs/toollib.h @@ -1 +1,193 @@ -/* * * ToolLib.h - Interface file for functions contained in * ToolLib library. These functions can be used by * programs that are to be operated as tools under the * APW shell on the Apple IIgs. * * Copyright Apple Computer, Inc. 1989 * All rights reserved * * Author: Greg Branche * */ #ifndef __ToolLib__ #define __ToolLib__ /************************************************************ <<< CursorCtl - Cursor Control Routines >>> This file contains: InitCursorCtl(delaycount) - Init CursorCtl to set the spin delay RotateCursor(counter) - Sequence through cursor frames for counter mod delay SpinCursor(increment) - Sequence mod delay incrementing internal counter Hide_Cursor() - Hide the current cursor Show_Cursor() - Show the cursor ************************************************************/ extern pascal void InitCursorCtl(/* delaycount */);/* unsigned long delaycount; Initialize the CursorCtl unit. This should be called once prior to calling any of the other CursorCtl routines. If delaycount = 0, then the default delay value of 32 will be used. Ensure that the value being passed as delaycount is 32-bits in size (long) */ extern pascal void Show_Cursor();/* This function removes the default inverse space cursor from the screen and replaces it with the first frame of the animated cursor. It then outputs a backspace so that any subsequent characters will automatically overwrite the cursor character. */ extern pascal void RotateCursor(/* counter */);/* unsigned long counter; RotateCursor is called to rotate the "I am active" "spinning wheel" cursor. The next cursor ("frame") is used when (counter MOD delaycount) (as specified in the InitCursorCtl call) = 0 (counter is some kind of incrementing or decrementing index maintained by the caller). A positive counter sequences forward through the cursors (e.g., it rotates the cursor "clockwise"), and a negative cursor sequences through the cursors backwards (e.g., it rotates the cursor counterclockwise). */ extern pascal void SpinCursor(/* increment */);/* unsigned short increment; SpinCursor is similar in function to RotateCursor, except that instead of passing a counter, an increment is passed and added to a counter maintained here. SpinCursor is provided for those users who do not happen to have a convenient counter handy but still want to use the spinning cursor. A positive increment sequences forward through the cursors (rotating the cursor clockwise), and a negative increment sequences backward through the cursors (rotating the cursor counterclockwise). A zero value for the increment resets the counter to zero. Note, it is the increment, and not the value of the counter that determines the sequencing direction of the cursor (and hence the spin direction of the cursor). */ extern pascal void Hide_Cursor();/* Hides the current character of the spinning cursor. Use this routine when you wish to revert to the standard inverse space cursor. */ /************************************************************ ErrMgr.h - //GS equivalent of the MPW Error Manager ************************************************************/ extern void InitErrMgr(/* toolErrFilename, sysErrFilename, showToolErrNbrs */); /* char *toolErrFilename; char *sysErrFilename; boolean showToolErrNbrs; Initializes the error manager. If toolErrFilename is not null, this will open the resource fork of that file to allow access to tool-specific error messages. If sysErrFilename is not null, this will open the resource fork of that file instead of the standard APW error message file. If showToolErrNbrs is TRUE, then any call to GetSysErrText will show the decimal and hexadecimal error number in parentheses after the text of the error message. If this is false, all that GetSysErrText will provide is the text of the message. To use the error manager, your tool must start up the Resource Manager prior to calling InitErrMgr. This function will NOT do it for you. */ extern void CloseErrMgr(); /* This simply closes any resources files opened by InitErrMgr. It is not absolutely required that you call this function prior to exiting your tool, but it is available. If it is not called, the Resource Manager will automatically close any files opened. You must shutdown the Resource Manager yourself. */ extern char *GetSysErrText(/* errNbr,errMsg */); /* unsigned errNbr; StringPtr errMsg; GetSysErrText performs a resource lookup for the supplied errNbr. It does this by calculating which resource number to use from the system resource file or the tool-specific error file. The function places the error message text in the buffer pointed to by errMsg, and also returns a pointer to a standard C string representing the error message associated with the given error number. If there is message text available for the given error number, the string will have the following format: ### {tool name}: {message text} If no specific message is available, the string will have the following format: ### {tool name}: Error {decimal error number} ($xxxx) where $xxxx is the hexadecimal error code. */ /************************************************************ gsString.h - header file for GS/OS string support functions ************************************************************/ #ifdef __GSOS__ extern GSString255 *c2gsstr(/* str, pathGS */); /* char *str; GSString255 *pathGS; This function accepts a null terminated C string and copies it to a GS/OS-style string (length word followed by the characters of the string). On return, the function returns the pointer to the pathname structure */ extern char *gs2cstr(/* pathGS, str */); /* GSString255 pathGS; char *str; This function converts a GS/OS-style string (word length followed by the characters of the string) to a normal, null terminated C string. On exit it returns a pointer to the string (which is the same as that specified on entry). */ extern void colonize(/* fileName */); /* char *fileName; normalizes a filename string so that it contains only colons as pathname separators. If there are no separators in the filename, the name is left unchanged. If the filename contains no slashes, the filename is left unchanged. */ #endif /************************************************************ pause.h - header file for APW-compatible pause function ************************************************************/ extern int pause(); /* This function should be called periodically by an APW tool to check for a pending keypress and/or command-. (abort signal). If the command-. keypress is pending, the function will return a non-zero value (signifying TRUE). If any other keypress is pending, the function will display an hourglass character on the screen and pause until another key is pressed. The value returned is either non-zero (TRUE), indicating that command-. has been pressed and the tool should abort, or 0 (false), indicating that processing should proceed. */ extern int wait(); /* This function operates similarly to the pause() function, except that it forces a keypress prior to returning to the caller. That is, it waits in a loop until a keypress occurs. The values returned are the same as described for the pause() function. */ #endif \ No newline at end of file +/* + * + * ToolLib.h - Interface file for functions contained in + * ToolLib library. These functions can be used by + * programs that are to be operated as tools under the + * APW shell on the Apple IIgs. + * + * Copyright Apple Computer, Inc. 1989 + * All rights reserved + * + * Author: Greg Branche + * + */ + +#ifndef __ToolLib__ +#define __ToolLib__ + +/************************************************************ + + <<< CursorCtl - Cursor Control Routines >>> + + This file contains: + + InitCursorCtl(delaycount) - Init CursorCtl to set the spin delay + RotateCursor(counter) - Sequence through cursor frames for counter mod delay + SpinCursor(increment) - Sequence mod delay incrementing internal counter + Hide_Cursor() - Hide the current cursor + Show_Cursor() - Show the cursor + +************************************************************/ + +extern pascal void InitCursorCtl(/* delaycount */);/* +unsigned long delaycount; + + Initialize the CursorCtl unit. This should be called once prior to calling + any of the other CursorCtl routines. If delaycount = 0, then the default delay + value of 32 will be used. Ensure that the value being passed as delaycount is + 32-bits in size (long) +*/ + +extern pascal void Show_Cursor();/* + + This function removes the default inverse space cursor from the screen and replaces it + with the first frame of the animated cursor. It then outputs a backspace so that any + subsequent characters will automatically overwrite the cursor character. +*/ + +extern pascal void RotateCursor(/* counter */);/* +unsigned long counter; + + RotateCursor is called to rotate the "I am active" "spinning wheel" cursor. The next cursor + ("frame") is used when (counter MOD delaycount) (as specified in the InitCursorCtl call) = 0 + (counter is some kind of incrementing or decrementing index maintained by the caller). A + positive counter sequences forward through the cursors (e.g., it rotates the cursor + "clockwise"), and a negative cursor sequences through the cursors backwards (e.g., it + rotates the cursor counterclockwise). +*/ + +extern pascal void SpinCursor(/* increment */);/* +unsigned short increment; + + SpinCursor is similar in function to RotateCursor, except that instead of passing a counter, + an increment is passed and added to a counter maintained here. SpinCursor is provided for + those users who do not happen to have a convenient counter handy but still want to use the + spinning cursor. A positive increment sequences forward through the cursors (rotating the + cursor clockwise), and a negative increment sequences backward through the cursors (rotating + the cursor counterclockwise). A zero value for the increment resets the counter to zero. + Note, it is the increment, and not the value of the counter that determines the sequencing + direction of the cursor (and hence the spin direction of the cursor). +*/ + +extern pascal void Hide_Cursor();/* + + Hides the current character of the spinning cursor. Use this routine when you wish to + revert to the standard inverse space cursor. +*/ + +/************************************************************ + + ErrMgr.h - //GS equivalent of the MPW Error Manager + +************************************************************/ + +extern void InitErrMgr(/* toolErrFilename, sysErrFilename, showToolErrNbrs */); +/* char *toolErrFilename; + char *sysErrFilename; + boolean showToolErrNbrs; + + Initializes the error manager. If toolErrFilename is not null, this will open the resource fork + of that file to allow access to tool-specific error messages. If sysErrFilename is not null, + this will open the resource fork of that file instead of the standard APW error message file. + If showToolErrNbrs is TRUE, then any call to GetSysErrText will show the decimal and hexadecimal + error number in parentheses after the text of the error message. If this is false, all that + GetSysErrText will provide is the text of the message. + + To use the error manager, your tool must start up the Resource Manager prior to calling + InitErrMgr. This function will NOT do it for you. +*/ + +extern void CloseErrMgr(); +/* + This simply closes any resources files opened by InitErrMgr. It is not absolutely required that + you call this function prior to exiting your tool, but it is available. If it is not called, the + Resource Manager will automatically close any files opened. You must shutdown the Resource + Manager yourself. +*/ + +extern char *GetSysErrText(/* errNbr,errMsg */); +/* unsigned errNbr; + StringPtr errMsg; + + GetSysErrText performs a resource lookup for the supplied errNbr. It does this by calculating + which resource number to use from the system resource file or the tool-specific error file. + + The function places the error message text in the buffer pointed to by errMsg, and also returns + a pointer to a standard C string representing the error message associated with the given error + number. If there is message text available for the given error number, the string will have + the following format: + + ### {tool name}: {message text} + + If no specific message is available, the string will have the following format: + + ### {tool name}: Error {decimal error number} ($xxxx) + + where $xxxx is the hexadecimal error code. +*/ + +/************************************************************ + + gsString.h - header file for GS/OS string support functions + +************************************************************/ + +#ifdef __GSOS__ + +extern GSString255 *c2gsstr(/* str, pathGS */); +/* char *str; + GSString255 *pathGS; + + This function accepts a null terminated C string and copies it to a + GS/OS-style string (length word followed by the characters of the string). + On return, the function returns the pointer to the pathname structure +*/ + +extern char *gs2cstr(/* pathGS, str */); +/* GSString255 pathGS; + char *str; + + This function converts a GS/OS-style string (word length followed by the + characters of the string) to a normal, null terminated C string. On exit + it returns a pointer to the string (which is the same as that specified + on entry). +*/ + +extern void colonize(/* fileName */); +/* char *fileName; + + normalizes a filename string so that it contains only colons as pathname + separators. If there are no separators in the filename, the name is left + unchanged. If the filename contains no slashes, the filename is left + unchanged. +*/ +#endif + +/************************************************************ + + pause.h - header file for APW-compatible pause function + +************************************************************/ + +extern int pause(); +/* + This function should be called periodically by an APW tool to check for + a pending keypress and/or command-. (abort signal). If the command-. + keypress is pending, the function will return a non-zero value + (signifying TRUE). If any other keypress is pending, the function + will display an hourglass character on the screen and pause until + another key is pressed. + + The value returned is either non-zero (TRUE), indicating that command-. + has been pressed and the tool should abort, or 0 (false), indicating + that processing should proceed. +*/ + +extern int wait(); +/* + This function operates similarly to the pause() function, except that + it forces a keypress prior to returning to the caller. That is, it + waits in a loop until a keypress occurs. The values returned are the + same as described for the pause() function. +*/ +#endif diff --git a/bin/Libraries/ORCACDefs/types.h b/bin/Libraries/ORCACDefs/types.h index 568377e..727f14f 100644 --- a/bin/Libraries/ORCACDefs/types.h +++ b/bin/Libraries/ORCACDefs/types.h @@ -1 +1,291 @@ -/******************************************** * * Types, defines used in more that one header file. * * Copyright Apple Computer, Inc.1986-90 * All Rights Reserved * * Copyright 1992, 1993, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #define __TYPES__ #ifndef noError #define noError 0x0000 #endif #ifndef nil #define nil 0x0L #endif #ifndef NULL #define NULL 0x0L #endif #ifndef NIL #define NIL 0x0L #endif #define dispatcher 0xE10000L /* tool locator dispatch address */ #define TRUE 1 #define true TRUE #define FALSE 0 #define false FALSE /* RefDescriptors */ #define refIsPointer 0x0000 #define refIsHandle 0x0001 #define refIsResource 0x0002 #define refIsNewHandle 0x0003 typedef unsigned char byte, Byte; typedef unsigned int word, Word; typedef int integer, Integer; typedef long longint, Longint; typedef long Long; typedef unsigned long longword, Longword, LongWord; typedef unsigned long Dblword, DblWord; /* retained for back compatibility */ typedef long Fixed; typedef long Frac; typedef extended Extended; typedef extended *ExtendedPtr; typedef char *ptr, *Ptr, *pointer, *Pointer; typedef ptr *handle, *Handle; typedef Handle *HandlePtr; typedef char *CStringPtr, **CStringHndl, ***CStringHndlPtr; typedef long (*ProcPtr)(void); /* retained for back compatibility */ typedef pascal void (*VoidProcPtr)(void); typedef pascal Word (*WordProcPtr)(void); typedef pascal LongWord (*LongProcPtr)(void); typedef unsigned int boolean, Boolean, BOOLEAN; typedef short OSErr; typedef int *IntPtr ; typedef Ptr FPTPtr; #define String(size) struct {unsigned char textLength; unsigned char text[size];} typedef String(255) Str255, *StringPtr, **StringHandle; typedef String(32) Str32, *String32Ptr, **String32Handle; struct Point { short v; short h; }; typedef struct Point Point, *PointPtr; struct Rect { short v1; short h1; short v2; short h2; }; typedef struct Rect Rect, *RectPtr, **RectHndl; struct TimeRec { Byte second; Byte minute; Byte hour; Byte year; Byte day; Byte month; Byte extra; Byte weekDay; }; typedef struct TimeRec TimeRec, *TimeRecPtr, **TimeRecHndl; typedef Word RefDescriptor; extern unsigned _ownerid; extern int _toolErr; #ifndef Ref #define Ref Long #endif /* Formerly in GSOS.h */ typedef struct GSString255 { Word length; /* Number of Chars in text field */ char text[255]; } GSString255, *GSString255Ptr, **GSString255Hndl; typedef GSString255Hndl *GSString255HndlPtr; typedef struct GSString32 { Word length; /* Number of characters in text field */ char text[32]; } GSString32, *GSString32Ptr, **GSString32Hndl; typedef struct ResultBuf255 { Word bufSize; GSString255 bufString; } ResultBuf255, *ResultBuf255Ptr, **ResultBuf255Hndl; typedef ResultBuf255Hndl *ResultBuf255HndlPtr ; typedef struct ResultBuf32 { Word bufSize; GSString32 bufString; } ResultBuf32, *ResultBuf32Ptr, **ResultBuf32Hndl; /* Formerly in QuickDraw.h */ typedef unsigned char Pattern[32], *PatternPtr; typedef unsigned char Mask[8]; typedef Word ColorTable[16], *ColorTablePtr, **ColorTableHndl; /* TextStyle */ #define plainMask 0x0000 /* Mask for plain text bit */ #define boldMask 0x0001 /* Mask for bold bit */ #define italicMask 0x0002 /* Mask for italic bit */ #define underlineMask 0x0004 /* Mask for underline bit */ #define outlineMask 0x0008 /* Mask for outline bit */ #define shadowMask 0x0010 /* Mask for shadow bit */ #define fUseShadowing 0x8000 /* corrected 26-May-92 DAL */ #define fFastPortAware 0x4000 typedef Integer TextStyle; struct LocInfo { Word portSCB; /* SCBByte in low byte */ Pointer ptrToPixImage; /* ImageRef */ Word width; /* Width */ Rect boundsRect; /* BoundsRect */ }; typedef struct LocInfo LocInfo, *LocInfoPtr, **LocInfoHndl; struct Region { Word rgnSize; /* size in bytes */ Rect rgnBBox; /* enclosing rectangle */ }; typedef struct Region Region, *RegionPtr, **RegionHndl; struct Font { Word offseToMF; /* fully defined front of the Font record. */ Word family; TextStyle style; Word size; Word version; Word fbrExtent; Word highowTLoc; }; typedef struct Font Font, *FontPtr, **FontHndl; union FontID { struct { Word famNum; Byte fontStyle; Byte fontSize; } fidRec; Long fidLong; }; typedef union FontID FontID, *FontIDPtr, **FontIDHndl; struct QDProcs { VoidProcPtr stdText; VoidProcPtr stdLine; VoidProcPtr stdRect; VoidProcPtr stdRRect; VoidProcPtr stdOval; VoidProcPtr stdArc; VoidProcPtr stdPoly; VoidProcPtr stdRgn; VoidProcPtr stdPixels; VoidProcPtr stdComment; VoidProcPtr stdTxMeas; VoidProcPtr stdTxBnds; VoidProcPtr stdGetPic; VoidProcPtr stdPutPic; }; typedef struct QDProcs QDProcs, *QDProcsPtr, **QDProcsHndl; struct GrafPort { LocInfo portInfo; Rect portRect; /* PortRect */ RegionHndl clipRgn; /* Clip Rgn. Pointer */ RegionHndl visRgn; /* Vis. Rgn. Pointer */ Pattern bkPat; /* BackGround Pattern */ Point pnLoc; /* Pen Location */ Point pnSize; /* Pen Size */ Word pnMode; /* Pen Mode */ Pattern pnPat; /* Pen Pattern */ Mask pnMask; /* Pen Mask */ Word pnVis; /* Pen Visable */ FontHndl fontHandle; FontID fontID; /* Font ID */ Word fontFlags; /* FontFlags */ Word txSize; /* Text Size */ TextStyle txFace; /* Text Face */ Word txMode; /* Text Mode */ Fixed spExtra; /* Fixed Point Value */ Fixed chExtra; /* Fixed Point Value */ Word fgColor; /* ForeGround Color */ Word bgColor; /* BackGround Color */ Handle picSave; /* PicSave */ Handle rgnSave; /* RgnSave */ Handle polySave; /* PolySave */ QDProcsPtr grafProcs; Word arcRot; /* ArcRot */ Longint userField; /* UserField */ Longint sysField; /* SysField */ }; typedef struct GrafPort GrafPort, *GrafPortPtr, **GrafPortHndl; /* Formerly in Control.h */ typedef GrafPortPtr WindowPtr; struct CtlRec { struct CtlRec **ctlNext; /* Handle of next control. */ WindowPtr ctlOwner; /* Pointer to control's window. */ Rect ctlRect; /* Enclosing rectangle. */ Byte ctlFlag; /* Bit flags. */ Byte ctlHilite; /* Highlighted part. */ Word ctlValue; /* Control's value. */ LongProcPtr ctlProc; /* Control's definition procedure. */ LongProcPtr ctlAction; /* Control's action procedure. */ Longint ctlData; /* Reserved for CtrlProc's use. */ Longint ctlRefCon; /* Reserved for application's use. */ Pointer ctlColor; /* Pointer to appropriate color table. */ Byte ctlReserved[16]; /* Reserved for future expansion */ LongWord ctlID; Word ctlMoreFlags; Word ctlVersion; }; typedef struct CtlRec CtlRec, *CtlRecPtr, **CtlRecHndl, ***CtlRecHndlPtr; struct BarColors { Word barOutline; /* color for outlining bar, arrows, and thumb */ Word barNorArrow; /* color of arrows when not highlighted */ Word barSelArrow; /* color of arrows when highlighted */ Word barArrowBack; /* color of arrow box's background */ Word barNorThumb; /* color of thumb's background when not highlighted */ Word barSelThumb; /* color of thumb's background when highlighted */ Word barPageRgn; /* color and pattern page region: high byte - 1= dither, 0 = solid */ Word barInactive; /* color of scroll bar's interior when inactive */ }; typedef struct BarColors BarColors, *BarColorsPtr, **BarColorsHndl; /* Formerly in Event.h */ struct EventRecord { Word what; /* event code */ LongWord message; /* event message */ LongWord when; /* ticks since startup */ Point where; /* mouse location */ Word modifiers; /* modifier flags */ LongWord wmTaskData; LongWord wmTaskMask; LongWord wmLastClickTick; Word wmClickCount; LongWord wmTaskData2; LongWord wmTaskData3; LongWord wmTaskData4; Point wmLastClickPt; }; typedef struct EventRecord EventRecord, *EventRecordPtr, **EventRecordHndl; /* Formerly in Window.h */ typedef EventRecord WmTaskRec; typedef EventRecordPtr WmTaskRecPtr; #endif \ No newline at end of file +/******************************************** +* +* Types, defines used in more that one header file. +* +* Copyright Apple Computer, Inc.1986-90 +* All Rights Reserved +* +* Copyright 1992, 1993, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#define __TYPES__ + +#ifndef noError +#define noError 0x0000 +#endif +#ifndef nil +#define nil 0x0L +#endif +#ifndef NULL +#define NULL 0x0L +#endif +#ifndef NIL +#define NIL 0x0L +#endif + +#define dispatcher 0xE10000L /* tool locator dispatch address */ + +#define TRUE 1 +#define true TRUE +#define FALSE 0 +#define false FALSE + +/* RefDescriptors */ +#define refIsPointer 0x0000 +#define refIsHandle 0x0001 +#define refIsResource 0x0002 +#define refIsNewHandle 0x0003 + +typedef unsigned char byte, Byte; +typedef unsigned int word, Word; +typedef int integer, Integer; +typedef long longint, Longint; +typedef long Long; +typedef unsigned long longword, Longword, LongWord; +typedef unsigned long Dblword, DblWord; /* retained for back compatibility */ +typedef long Fixed; +typedef long Frac; +typedef extended Extended; +typedef extended *ExtendedPtr; +typedef char *ptr, *Ptr, *pointer, *Pointer; +typedef ptr *handle, *Handle; +typedef Handle *HandlePtr; +typedef char *CStringPtr, **CStringHndl, ***CStringHndlPtr; +typedef long (*ProcPtr)(void); /* retained for back compatibility */ +typedef pascal void (*VoidProcPtr)(void); +typedef pascal Word (*WordProcPtr)(void); +typedef pascal LongWord (*LongProcPtr)(void); + +typedef unsigned int boolean, Boolean, BOOLEAN; +typedef short OSErr; +typedef int *IntPtr ; +typedef Ptr FPTPtr; + +#define String(size) struct {unsigned char textLength; unsigned char text[size];} +typedef String(255) Str255, *StringPtr, **StringHandle; +typedef String(32) Str32, *String32Ptr, **String32Handle; + +struct Point { + short v; + short h; + }; +typedef struct Point Point, *PointPtr; + +struct Rect { + short v1; + short h1; + short v2; + short h2; + }; +typedef struct Rect Rect, *RectPtr, **RectHndl; + +struct TimeRec { + Byte second; + Byte minute; + Byte hour; + Byte year; + Byte day; + Byte month; + Byte extra; + Byte weekDay; + }; +typedef struct TimeRec TimeRec, *TimeRecPtr, **TimeRecHndl; + +typedef Word RefDescriptor; + +extern unsigned _ownerid; +extern int _toolErr; + +#ifndef Ref +#define Ref Long +#endif + +/* Formerly in GSOS.h */ + +typedef struct GSString255 { + Word length; /* Number of Chars in text field */ + char text[255]; + } GSString255, *GSString255Ptr, **GSString255Hndl; +typedef GSString255Hndl *GSString255HndlPtr; + +typedef struct GSString32 { + Word length; /* Number of characters in text field */ + char text[32]; + } GSString32, *GSString32Ptr, **GSString32Hndl; + +typedef struct ResultBuf255 { + Word bufSize; + GSString255 bufString; + } ResultBuf255, *ResultBuf255Ptr, **ResultBuf255Hndl; +typedef ResultBuf255Hndl *ResultBuf255HndlPtr ; + +typedef struct ResultBuf32 { + Word bufSize; + GSString32 bufString; + } ResultBuf32, *ResultBuf32Ptr, **ResultBuf32Hndl; + +/* Formerly in QuickDraw.h */ + +typedef unsigned char Pattern[32], *PatternPtr; +typedef unsigned char Mask[8]; +typedef Word ColorTable[16], *ColorTablePtr, **ColorTableHndl; + +/* TextStyle */ +#define plainMask 0x0000 /* Mask for plain text bit */ +#define boldMask 0x0001 /* Mask for bold bit */ +#define italicMask 0x0002 /* Mask for italic bit */ +#define underlineMask 0x0004 /* Mask for underline bit */ +#define outlineMask 0x0008 /* Mask for outline bit */ +#define shadowMask 0x0010 /* Mask for shadow bit */ +#define fUseShadowing 0x8000 /* corrected 26-May-92 DAL */ +#define fFastPortAware 0x4000 + +typedef Integer TextStyle; + +struct LocInfo { + Word portSCB; /* SCBByte in low byte */ + Pointer ptrToPixImage; /* ImageRef */ + Word width; /* Width */ + Rect boundsRect; /* BoundsRect */ + }; +typedef struct LocInfo LocInfo, *LocInfoPtr, **LocInfoHndl; + +struct Region { + Word rgnSize; /* size in bytes */ + Rect rgnBBox; /* enclosing rectangle */ + }; +typedef struct Region Region, *RegionPtr, **RegionHndl; + +struct Font { + Word offseToMF; /* fully defined front of the Font record. */ + Word family; + TextStyle style; + Word size; + Word version; + Word fbrExtent; + Word highowTLoc; + }; +typedef struct Font Font, *FontPtr, **FontHndl; + +union FontID { + struct { + Word famNum; + Byte fontStyle; + Byte fontSize; + } fidRec; + Long fidLong; + }; +typedef union FontID FontID, *FontIDPtr, **FontIDHndl; + +struct QDProcs { + VoidProcPtr stdText; + VoidProcPtr stdLine; + VoidProcPtr stdRect; + VoidProcPtr stdRRect; + VoidProcPtr stdOval; + VoidProcPtr stdArc; + VoidProcPtr stdPoly; + VoidProcPtr stdRgn; + VoidProcPtr stdPixels; + VoidProcPtr stdComment; + VoidProcPtr stdTxMeas; + VoidProcPtr stdTxBnds; + VoidProcPtr stdGetPic; + VoidProcPtr stdPutPic; + }; +typedef struct QDProcs QDProcs, *QDProcsPtr, **QDProcsHndl; + +struct GrafPort { + LocInfo portInfo; + Rect portRect; /* PortRect */ + RegionHndl clipRgn; /* Clip Rgn. Pointer */ + RegionHndl visRgn; /* Vis. Rgn. Pointer */ + Pattern bkPat; /* BackGround Pattern */ + Point pnLoc; /* Pen Location */ + Point pnSize; /* Pen Size */ + Word pnMode; /* Pen Mode */ + Pattern pnPat; /* Pen Pattern */ + Mask pnMask; /* Pen Mask */ + Word pnVis; /* Pen Visable */ + FontHndl fontHandle; + FontID fontID; /* Font ID */ + Word fontFlags; /* FontFlags */ + Word txSize; /* Text Size */ + TextStyle txFace; /* Text Face */ + Word txMode; /* Text Mode */ + Fixed spExtra; /* Fixed Point Value */ + Fixed chExtra; /* Fixed Point Value */ + Word fgColor; /* ForeGround Color */ + Word bgColor; /* BackGround Color */ + Handle picSave; /* PicSave */ + Handle rgnSave; /* RgnSave */ + Handle polySave; /* PolySave */ + QDProcsPtr grafProcs; + Word arcRot; /* ArcRot */ + Longint userField; /* UserField */ + Longint sysField; /* SysField */ + }; +typedef struct GrafPort GrafPort, *GrafPortPtr, **GrafPortHndl; + +/* Formerly in Control.h */ + +typedef GrafPortPtr WindowPtr; + +struct CtlRec { + struct CtlRec **ctlNext; /* Handle of next control. */ + WindowPtr ctlOwner; /* Pointer to control's window. */ + Rect ctlRect; /* Enclosing rectangle. */ + Byte ctlFlag; /* Bit flags. */ + Byte ctlHilite; /* Highlighted part. */ + Word ctlValue; /* Control's value. */ + LongProcPtr ctlProc; /* Control's definition procedure. */ + LongProcPtr ctlAction; /* Control's action procedure. */ + Longint ctlData; /* Reserved for CtrlProc's use. */ + Longint ctlRefCon; /* Reserved for application's use. */ + Pointer ctlColor; /* Pointer to appropriate color table. */ + Byte ctlReserved[16]; /* Reserved for future expansion */ + LongWord ctlID; + Word ctlMoreFlags; + Word ctlVersion; + }; +typedef struct CtlRec CtlRec, *CtlRecPtr, **CtlRecHndl, ***CtlRecHndlPtr; + +struct BarColors { + Word barOutline; /* color for outlining bar, arrows, and thumb */ + Word barNorArrow; /* color of arrows when not highlighted */ + Word barSelArrow; /* color of arrows when highlighted */ + Word barArrowBack; /* color of arrow box's background */ + Word barNorThumb; /* color of thumb's background when not highlighted */ + Word barSelThumb; /* color of thumb's background when highlighted */ + Word barPageRgn; /* color and pattern page region: high byte - 1= dither, 0 = solid */ + Word barInactive; /* color of scroll bar's interior when inactive */ + }; +typedef struct BarColors BarColors, *BarColorsPtr, **BarColorsHndl; + +/* Formerly in Event.h */ + +struct EventRecord { + Word what; /* event code */ + LongWord message; /* event message */ + LongWord when; /* ticks since startup */ + Point where; /* mouse location */ + Word modifiers; /* modifier flags */ + LongWord wmTaskData; + LongWord wmTaskMask; + LongWord wmLastClickTick; + Word wmClickCount; + LongWord wmTaskData2; + LongWord wmTaskData3; + LongWord wmTaskData4; + Point wmLastClickPt; + }; +typedef struct EventRecord EventRecord, *EventRecordPtr, **EventRecordHndl; + +/* Formerly in Window.h */ + +typedef EventRecord WmTaskRec; +typedef EventRecordPtr WmTaskRecPtr; + +#endif diff --git a/bin/Libraries/ORCACDefs/video.h b/bin/Libraries/ORCACDefs/video.h index 8d98640..32fcf66 100644 --- a/bin/Libraries/ORCACDefs/video.h +++ b/bin/Libraries/ORCACDefs/video.h @@ -1 +1,122 @@ -/******************************************** * * Video Overlay Tool Set * * Copyright Apple Computer, Inc.1986-90 * All Rights Reserved * * Copyright 1992, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __VIDEO__ #define __VIDEO__ #define vdVideoOverlay 0x01 #define vdFrameGrabber 0x02 #define vdInVStandards 0x03 #define vdOutVStandards 0x04 #define vdKeyDissLevels 0x05 #define vdNKeyDissLevels 0x06 #define vdAdjSideEffect 0x07 #define vdKeyColorBits 0x08 #define vdInHueAdj 0x09 #define vdInSatAdj 0x0A #define vdInContrastAdj 0x0B #define vdInBrightAdj 0x0C #define vdOutSetup 0x0D #define vdOutChromaFltr 0x0E #define vdOutExtBlank 0x0F #define vdKeyEnhDiss 0x10 #define vdLineInterrupt 0x11 #define vdGGBus 0x12 #define vdDualOut 0x13 #define vdTextMonoOver 0x14 #define vdGenlock 0x32 #define vdVideoDetect 0x33 #define vdGenlocked 0x34 #define vdAdjInc 0x50 #define vdAdjDec 0x51 #define vdAdjSave 0x52 #define vdAvail 0x01 #define vdNotAvail 0x00 #define vdYes 0x01 #define vdNo 0x00 #define vdOn 0x01 #define vdOff 0x00 #define vdNil 0x00 #define vdFalse 0x00 #define vdTrue 0x01 #define vdKColorEnable 0x64 #define vdVerticalBlank 0x82 #define vdMainPageLin 0xC8 #define vdRAMPageSel 0xC9 #define vdVBLInterrupt 0xCA #define vdInterlaceMode 0xCB #define vdClearVBLInt 0xCC #define vdClearLineInt 0xCD #define vdDisplayField 0xCE #define vdVBLIntRequest 0xCF #define vdLineIntRequest 0xD0 #define vdNone 0x00 #define vdNTSC 0x01 #define vdPAL 0x02 #define vdSECAM 0x04 #define vdSNTSC 0x08 #define vdSPAL 0x10 #define vdSSECAM 0x20 #define vdRGB60 0x40 #define vdRGB50 0x80 #define vdAux 0x00 #define vdMain 0x10 #define vdInterlace 0x30 #define vdField1 0x01 #define vdField0 0x00 #define vdEnable 0x01 #define vdDisable 0x00 #define vdExternal 0x00 #define vdGraphics 0x01 #define vdVBlank 0x01 #define vdActiveVideo 0x00 /* Error Codes */ #define vdNoVideoDevice 0x2110 /* no video device was found */ #define vdAlreadyStarted 0x2111 /* Video tool set already started */ #define vdInvalidSelector 0x2112 /* an invalid selector was specified */ #define vdInvalidParam 0x2113 /* an invalid parameter was specified */ #define vdUnImplemented 0x21FF /* an unimplemented tool set routine was called */ extern pascal void VDBootInit(void) inline(0x0121,dispatcher); extern pascal void VDStartUp(void) inline(0x0221,dispatcher); extern pascal void VDShutDown(void) inline(0x0321,dispatcher); extern pascal Word VDVersion(void) inline(0x0421,dispatcher); extern pascal void VDReset(void) inline(0x0521,dispatcher); extern pascal Boolean VDStatus(void) inline(0x0621,dispatcher); extern pascal Word VDGetFeatures(Word) inline(0x1B21,dispatcher); extern pascal void VDGGControl(Word, Word) inline(0x1D21,dispatcher); extern pascal Word VDGGStatus(Word) inline(0x1E21,dispatcher); extern pascal void VDInControl(Word, Word) inline(0x1C21,dispatcher); extern pascal void VDInConvAdj(Word, Word) inline(0x0C21,dispatcher); extern pascal Word VDInGetStd(void) inline(0x0B21,dispatcher); extern pascal void VDInSetStd(Word) inline(0x0A21,dispatcher); extern pascal Word VDInStatus(Word) inline(0x0921,dispatcher); extern pascal void VDKeyControl(Word, Word) inline(0x0D21,dispatcher); extern pascal Word VDKeyGetKBCol(void) inline(0x1221,dispatcher); extern pascal Word VDKeyGetKDiss(void) inline(0x1421,dispatcher); extern pascal Word VDKeyGetKGCol(void) inline(0x1121,dispatcher); extern pascal Word VDKeyGetKRCol(void) inline(0x1021,dispatcher); extern pascal Word VDKeyGetNKDiss(void) inline(0x1621,dispatcher); extern pascal void VDKeySetKCol(Word, Word, Word) inline(0x0F21,dispatcher); extern pascal void VDKeySetKDiss(Word) inline(0x1321,dispatcher); extern pascal void VDKeySetNKDiss(Word) inline(0x1521,dispatcher); extern pascal Word VDKeyStatus(Word) inline(0x0E21,dispatcher); extern pascal void VDOutControl(Word, Word) inline(0x1921,dispatcher); extern pascal Word VDOutGetStd(void) inline(0x1821,dispatcher); extern pascal void VDOutSetStd(Word) inline(0x1721,dispatcher); extern pascal Word VDOutStatus(Word) inline(0x1A21,dispatcher); #endif \ No newline at end of file +/******************************************** +* +* Video Overlay Tool Set +* +* Copyright Apple Computer, Inc.1986-90 +* All Rights Reserved +* +* Copyright 1992, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __VIDEO__ +#define __VIDEO__ + +#define vdVideoOverlay 0x01 +#define vdFrameGrabber 0x02 +#define vdInVStandards 0x03 +#define vdOutVStandards 0x04 +#define vdKeyDissLevels 0x05 +#define vdNKeyDissLevels 0x06 +#define vdAdjSideEffect 0x07 +#define vdKeyColorBits 0x08 +#define vdInHueAdj 0x09 +#define vdInSatAdj 0x0A +#define vdInContrastAdj 0x0B +#define vdInBrightAdj 0x0C +#define vdOutSetup 0x0D +#define vdOutChromaFltr 0x0E +#define vdOutExtBlank 0x0F +#define vdKeyEnhDiss 0x10 +#define vdLineInterrupt 0x11 +#define vdGGBus 0x12 +#define vdDualOut 0x13 +#define vdTextMonoOver 0x14 +#define vdGenlock 0x32 +#define vdVideoDetect 0x33 +#define vdGenlocked 0x34 +#define vdAdjInc 0x50 +#define vdAdjDec 0x51 +#define vdAdjSave 0x52 +#define vdAvail 0x01 +#define vdNotAvail 0x00 +#define vdYes 0x01 +#define vdNo 0x00 +#define vdOn 0x01 +#define vdOff 0x00 +#define vdNil 0x00 +#define vdFalse 0x00 +#define vdTrue 0x01 +#define vdKColorEnable 0x64 +#define vdVerticalBlank 0x82 +#define vdMainPageLin 0xC8 +#define vdRAMPageSel 0xC9 +#define vdVBLInterrupt 0xCA +#define vdInterlaceMode 0xCB +#define vdClearVBLInt 0xCC +#define vdClearLineInt 0xCD +#define vdDisplayField 0xCE +#define vdVBLIntRequest 0xCF +#define vdLineIntRequest 0xD0 +#define vdNone 0x00 +#define vdNTSC 0x01 +#define vdPAL 0x02 +#define vdSECAM 0x04 +#define vdSNTSC 0x08 +#define vdSPAL 0x10 +#define vdSSECAM 0x20 +#define vdRGB60 0x40 +#define vdRGB50 0x80 +#define vdAux 0x00 +#define vdMain 0x10 +#define vdInterlace 0x30 +#define vdField1 0x01 +#define vdField0 0x00 +#define vdEnable 0x01 +#define vdDisable 0x00 +#define vdExternal 0x00 +#define vdGraphics 0x01 +#define vdVBlank 0x01 +#define vdActiveVideo 0x00 + +/* Error Codes */ +#define vdNoVideoDevice 0x2110 /* no video device was found */ +#define vdAlreadyStarted 0x2111 /* Video tool set already started */ +#define vdInvalidSelector 0x2112 /* an invalid selector was specified */ +#define vdInvalidParam 0x2113 /* an invalid parameter was specified */ +#define vdUnImplemented 0x21FF /* an unimplemented tool set routine was called */ + +extern pascal void VDBootInit(void) inline(0x0121,dispatcher); +extern pascal void VDStartUp(void) inline(0x0221,dispatcher); +extern pascal void VDShutDown(void) inline(0x0321,dispatcher); +extern pascal Word VDVersion(void) inline(0x0421,dispatcher); +extern pascal void VDReset(void) inline(0x0521,dispatcher); +extern pascal Boolean VDStatus(void) inline(0x0621,dispatcher); +extern pascal Word VDGetFeatures(Word) inline(0x1B21,dispatcher); +extern pascal void VDGGControl(Word, Word) inline(0x1D21,dispatcher); +extern pascal Word VDGGStatus(Word) inline(0x1E21,dispatcher); +extern pascal void VDInControl(Word, Word) inline(0x1C21,dispatcher); +extern pascal void VDInConvAdj(Word, Word) inline(0x0C21,dispatcher); +extern pascal Word VDInGetStd(void) inline(0x0B21,dispatcher); +extern pascal void VDInSetStd(Word) inline(0x0A21,dispatcher); +extern pascal Word VDInStatus(Word) inline(0x0921,dispatcher); +extern pascal void VDKeyControl(Word, Word) inline(0x0D21,dispatcher); +extern pascal Word VDKeyGetKBCol(void) inline(0x1221,dispatcher); +extern pascal Word VDKeyGetKDiss(void) inline(0x1421,dispatcher); +extern pascal Word VDKeyGetKGCol(void) inline(0x1121,dispatcher); +extern pascal Word VDKeyGetKRCol(void) inline(0x1021,dispatcher); +extern pascal Word VDKeyGetNKDiss(void) inline(0x1621,dispatcher); +extern pascal void VDKeySetKCol(Word, Word, Word) inline(0x0F21,dispatcher); +extern pascal void VDKeySetKDiss(Word) inline(0x1321,dispatcher); +extern pascal void VDKeySetNKDiss(Word) inline(0x1521,dispatcher); +extern pascal Word VDKeyStatus(Word) inline(0x0E21,dispatcher); +extern pascal void VDOutControl(Word, Word) inline(0x1921,dispatcher); +extern pascal Word VDOutGetStd(void) inline(0x1821,dispatcher); +extern pascal void VDOutSetStd(Word) inline(0x1721,dispatcher); +extern pascal Word VDOutStatus(Word) inline(0x1A21,dispatcher); + +#endif diff --git a/bin/Libraries/ORCACDefs/window.h b/bin/Libraries/ORCACDefs/window.h index c6aea6f..9cf0aa3 100644 --- a/bin/Libraries/ORCACDefs/window.h +++ b/bin/Libraries/ORCACDefs/window.h @@ -1 +1,440 @@ -/******************************************** * * Window Manager * * Copyright Apple Computer, Inc. 1986-92 * All Rights Reserved * * Copyright 1992, 1993, Byte Works, Inc. * ********************************************/ #ifndef __TYPES__ #include #endif #ifndef __WINDOW__ #define __WINDOW__ /* Error Codes */ #define paramLenErr 0x0E01 /* first word of parameter list is the wrong size */ #define allocateErr 0x0E02 /* unable to allocate window record */ #define taskMaskErr 0x0E03 /* reserved bits are not clear in wmTaskMask */ #define compileTooLarge 0x0E04 /* Compiled text is larger than 64 KB */ #define cantUpdateErr 0x0E05 /* window couldn't be updated */ /* Axis Parameters */ #define wNoConstraint 0x0000 /* No constraint on movement */ #define wHAxisOnly 0x0001 /* Horizontal axis only */ #define wVAxisOnly 0x0002 /* Vertical axis only */ /* Desktop Command Codes */ #define FromDesk 0x00 /* Subtract region from desktop */ #define ToDesk 0x1 /* Add region to desktop */ #define GetDesktop 0x2 /* Get Handle of Desktop region */ #define SetDesktop 0x3 /* Set Handle of Desktop region */ #define GetDeskPat 0x4 /* Address of pattern or drawing routine */ #define SetDeskPat 0x5 /* Change Address of pattern or drawing routine */ #define GetVisDesktop 0x6 /* Get destop region less visible windows */ #define BackGroundRgn 0x7 /* For drawing directly on desktop */ #define CheckForNewDeskMsg 0x8 /* Force rechecking message #2 */ /* SendBehind Values */ #define toBottom 0xFFFFFFFEL /* To send window to bottom */ #define topMost 0xFFFFFFFFL /* To make window top */ #define bottomMost 0x0000L /* To make window bottom */ /* Task Masks */ #define tmMenuKey 0x00000001L #define tmUpdate 0x00000002L #define tmFindW 0x00000004L #define tmMenuSel 0x0008L #define tmOpenNDA 0x0010L #define tmSysClick 0x0020L #define tmDragW 0x0040L #define tmContent 0x0080L #define tmClose 0x0100L #define tmZoom 0x0200L #define tmGrow 0x0400L #define tmScroll 0x0800L #define tmSpecial 0x1000L #define tmCRedraw 0x2000L #define tmInactive 0x4000L #define tmInfo 0x8000L #define tmContentControls 0x00010000L #define tmControlKey 0x00020000L #define tmControlMenu 0x00040000L #define tmMultiClick 0x00080000L #define tmIdleEvents 0x00100000L /* TaskMaster Codes */ #define wNoHit 0x0000 /* retained for back compatibility */ #define inNull 0x0000 /* retained for back compatibility */ #define inKey 0x0003 /* retained for back compatibility */ #define inButtDwn 0x0001 /* retained for back compatibility */ #define inUpdate 0x0006 /* retained for back compatibility */ #define wInDesk 0x0010 /* On Desktop */ #define wInMenuBar 0x0011 /* On system menu bar */ #define wClickCalled 0x0012 /* system click called */ #define wInContent 0x0013 /* In content region */ #define wInDrag 0x0014 /* In drag region */ #define wInGrow 0x0015 /* In grow region, active window only */ #define wInGoAway 0x0016 /* In go-away region, active window only */ #define wInZoom 0x0017 /* In zoom region, active window only */ #define wInInfo 0x0018 /* In information bar */ #define wInSpecial 0x0019 /* Item ID selected was 250 - 255 */ #define wInDeskItem 0x001A /* Item ID selected was 1 - 249 */ #define wInFrame 0x1B /* in Frame, but not on anything else */ #define wInactMenu 0x1C /* 'selection' of inactive menu item */ #define wClosedNDA 0x001D /* desk accessory closed */ #define wCalledSysEdit 0x001E /* inactive menu item selected */ #define wInSysWindow 0x8000 /* hi bit set for system windows */ /* VarCode */ #define wDraw 0x00 /* Draw window frame command */ #define wHit 0x01 /* Hit test command */ #define wCalcRgns 0x02 /* Compute regions command */ #define wNew 0x03 /* Initialization command */ #define wDispose 0x04 /* Dispose command */ #define wGetDrag 5 /* Return address of outline drawing handler */ #define wGrowFrame 6 /* Draw outline of window being resized */ #define wRecSize 7 /* Return size of additional space neeed in the windrec */ #define wPos 8 /* Return RECT that is the window's portRect */ #define wBehind 9 /* Return where the window should be placed in the list */ #define wCallDefProc 10 /* Generic call to the defproc */ /* WFrame */ #define fHilited 0x0001 /* Window is highlighted */ #define fZoomed 0x0002 /* Window is zoomed */ #define fAllocated 0x0004 /* Window record was allocated */ #define fCtlTie 0x0008 /* Window state tied to controls */ #define fInfo 0x0010 /* Window has an information bar */ #define fVis 0x0020 /* Window is visible */ #define fQContent 0x0040 #define fMove 0x0080 /* Window is movable */ #define fZoom 0x0100 /* Window is zoomable */ #define fFlex 0x0200 #define fGrow 0x0400 /* Window has grow box */ #define fBScroll 0x0800 /* Window has horizontal scroll bar */ #define fRScroll 0x1000 /* Window has vertical scroll bar */ #define fAlert 0x2000 #define fClose 0x4000 /* Window has a close box */ #define fTitle 0x8000 /* Window has a title bar */ /* DoModalWindow flag values */ #define mwMovable 0x8000 #define mwUpdateAll 0x4000 #define mwDeskAcc 0x0010 #define mwIBeam 0x0008 #define mwMenuKey 0x0004 #define mwMenuSelect 0x0002 #define mwNoScrapForLE 0x0001 /* HandleDiskInsert flag values (bit flags) */ #define hdiScan 0x8000 #define hdiHandle 0x4000 #define hdiUpdate 0x2000 #define hdiReportEjects 0x1000 #define hdiNoDelay 0x0800 #define hdiDupDisk 0x0400 #define hdiCheckTapeDrives 0x0200 #define hdiUnreadable 0x0100 #define hdiMarkOffline 0x0001 /* HandleDiskInsert result flag values (bit flags) */ #define hdiFormatted 0x0002 #define hdiEjection 0x0001 /* constants for AlertWindow alertFlags */ #define awCString 0x0000 #define awPString 0x0001 #define awPointer 0x0000 #define awHandle 0x0002 #define awResource 0x0004 #define awTextFullWidth 0x0008 #define awForceBeep 0x0010 #define awButtonLayout 0x0020 #define awNoDevScan 0x0040 #define awNoDisposeRes 0x0080 #define awWatchForDisk 0x0100 #define awIconIsResource 0x0200 #define awFullColor 0x0400 /* UpdateWindow flag values */ #define uwBackground 0x8000 #define uwGSOSnotAvail 0x4000 /* Other Constants */ #define windSize 0x00D4 /* Size of WindRec */ #define wmTaskRecSize 0x002E /* Size of WmTaskRec */ #define wTrackZoom 0x001F #define wHitFrame 0x0020 #define wInControl 0x0021 #define wInControlMenu 0x0022 /* custom defproc dRequest codes (from TN #42) */ #define wSetOrgMask 0 #define wSetMaxGrow 1 #define wSetScroll 2 #define wSetPage 3 #define wSetInfoRefCon 4 #define wSetInfoDraw 5 #define wSetOrigin 6 #define wSetDataSize 7 #define wSetZoomRect 8 #define wSetTitle 9 #define wSetColorTable 10 #define wSetFrameFlag 11 #define wGetOrgMask 12 #define wGetMaxGrow 13 #define wGetScroll 14 #define wGetPage 15 #define wGetInfoRefCon 16 #define wGetInfoDraw 17 #define wGetOrigin 18 #define wGetDataSize 19 #define wGetZoomRect 20 #define wGetTitle 21 #define wGetColorTable 22 #define wGetFrameFlag 23 #define wGetInfoRect 24 #define wGetDrawInfo 25 #define wGetStartInfoDraw 26 #define wGetEndInfoDraw 27 #define wZoomWindow 28 #define wStartDrawing 29 #define wStartMove 30 #define wStartGrow 31 #define wNewSize 32 #define wTask 33 typedef struct WindColor { Word frameColor; /* Color of window frame */ Word titleColor; /* Color of title and bar */ Word tBarColor; /* Color/pattern of title bar */ Word growColor; /* Color of grow box */ Word infoColor; /* Color of information bar */ } WindColor, *WindColorPtr, **WindColorHndl; typedef struct WindRec { /* struct WindRec *wNext; not included in record returned by ToolBox calls */ GrafPort port; /* Window's port */ ProcPtr wDefProc; LongWord wRefCon; ProcPtr wContDraw; LongWord wReserved; /* Space for future expansion */ RegionHndl wStrucRgn; /* Region of frame plus content */ RegionHndl wContRgn; /* Content region */ RegionHndl wUpdateRgn; /* Update region */ CtlRecHndl wControls; /* Window's control list */ CtlRecHndl wFrameCtrls; /* Window frame's control list */ Word wFrame; } WindRec, *WindRecPtr; typedef struct ParamList { Word paramLength; Word wFrameBits; Pointer wTitle; LongWord wRefCon; Rect wZoom; WindColorPtr wColor; Word wYOrigin; Word wXOrigin; Word wDataH; Word wDataW; Word wMaxH; Word wMaxW; Word wScrollVer; Word wScrollHor; Word wPageVer; Word wPageHor; LongWord wInfoRefCon; Word wInfoHeight; /* height of information bar */ LongProcPtr wFrameDefProc; VoidProcPtr wInfoDefProc; VoidProcPtr wContDefProc; Rect wPosition; WindowPtr wPlane; WindRecPtr wStorage; } ParamList, *ParamListPtr, **ParamListHndl; typedef struct WindParam1 { Word p1Length; Word p1Frame; Pointer p1Title; LongWord p1RefCon; Rect p1ZoomRect; WindColorPtr p1ColorTable; Word p1YOrigin; Word p1XOrigin; Word p1DataHeight; Word p1DataWidth; Word p1MaxHeight; Word p1MaxWidth; Word p1VerScroll; Word p1HorScroll; Word p1VerPage; Word p1HorPage; LongWord p1InfoText; Word p1InfoHeight; LongProcPtr p1DefProc; VoidProcPtr p1InfoDraw; VoidProcPtr p1ContentDraw; Rect p1Position; WindowPtr p1Plane; Long p1ControlList; Word p1InDesc; } WindParam1, *WindParam1Ptr, **WindParam1Hndl; typedef struct DeskMessageRecord { LongWord reserved; Word messageType; Word drawType; } DeskMessageRecord, *DeskMessageRecordPtr; typedef struct AuxWindInfoRecord { Word recordSize; Word reservedForBank; Word reservedForDP; Word reservedForResApp; LongWord reservedForUpdateHandle; LongWord reservedForEndUpdatePort; LongWord reservedForWindoidLayer; Word sysWindMinHeight; Word sysWindMinWidth; Ptr NDASysWindPtr; } AuxWindInfoRecord, *AuxWindInfoPtr; typedef struct WindGlobalsRec { Word lineW; Word titleHeight; Word titleYPos; Word closeHeight; Word closeWidth; LongWord defWindClr; LongWord windIconFont; Word screenMode; Byte pattern[32]; Word callerDPage; Word callerDataB; } WindGlobalsRec, *WindGlobalsRecPtr, **WindGlobalsRecHndl; extern pascal void WindBootInit(void) inline(0x010E,dispatcher); extern pascal void WindStartUp(Word) inline(0x020E,dispatcher); extern pascal void WindShutDown(void) inline(0x030E,dispatcher); extern pascal Word WindVersion(void) inline(0x040E,dispatcher); extern pascal void WindReset(void) inline(0x050E,dispatcher); extern pascal Boolean WindStatus(void) inline(0x060E,dispatcher); extern pascal void BeginUpdate(GrafPortPtr) inline(0x1E0E,dispatcher); extern pascal void BringToFront(GrafPortPtr) inline(0x240E,dispatcher); extern pascal Boolean CheckUpdate(EventRecordPtr) inline(0x0A0E,dispatcher); extern pascal void CloseWindow(GrafPortPtr) inline(0x0B0E,dispatcher); extern pascal Pointer Desktop(Word, LongWord) inline(0x0C0E,dispatcher); extern pascal void DragWindow(Word, Integer, Integer, Word, Rect *, GrafPortPtr) inline(0x1A0E,dispatcher); extern pascal void EndInfoDrawing(void) inline(0x510E,dispatcher); extern pascal void EndUpdate(GrafPortPtr) inline(0x1F0E,dispatcher); extern pascal Word FindWindow(GrafPortPtr *, Integer, Integer) inline(0x170E,dispatcher); extern pascal WindowPtr FrontWindow(void) inline(0x150E,dispatcher); extern pascal VoidProcPtr GetContentDraw(GrafPortPtr) inline(0x480E,dispatcher); extern pascal Long GetContentOrigin (GrafPortPtr) inline(0x3E0E,dispatcher); extern pascal RegionHndl GetContentRgn(GrafPortPtr) inline(0x2F0E,dispatcher); extern pascal LongWord GetDataSize(GrafPortPtr) inline(0x400E,dispatcher); extern pascal LongProcPtr GetDefProc(GrafPortPtr) inline(0x310E,dispatcher); extern pascal WindowPtr GetFirstWindow(void) inline(0x520E,dispatcher); extern pascal void GetFrameColor(WindColorPtr, GrafPortPtr) inline(0x100E,dispatcher); extern pascal VoidProcPtr GetInfoDraw(GrafPortPtr) inline(0x4A0E,dispatcher); extern pascal LongWord GetInfoRefCon(GrafPortPtr) inline(0x350E,dispatcher); extern pascal LongWord GetMaxGrow(GrafPortPtr) inline(0x420E,dispatcher); extern pascal WindowPtr GetNextWindow(GrafPortPtr) inline(0x2A0E,dispatcher); extern pascal LongWord GetPage(GrafPortPtr) inline(0x460E,dispatcher); extern pascal void GetRectInfo(Rect *, GrafPortPtr) inline(0x4F0E,dispatcher); extern pascal LongWord GetScroll(GrafPortPtr) inline(0x440E,dispatcher); extern pascal RegionHndl GetStructRgn(GrafPortPtr) inline(0x2E0E,dispatcher); extern pascal Boolean GetSysWFlag(GrafPortPtr) inline(0x4C0E,dispatcher); extern pascal RegionHndl GetUpdateRgn(GrafPortPtr) inline(0x300E,dispatcher); extern pascal CtlRecHndl GetWControls(GrafPortPtr) inline(0x330E,dispatcher); extern pascal Word GetWFrame(GrafPortPtr) inline(0x2C0E,dispatcher); extern pascal Word GetWKind(GrafPortPtr) inline(0x2B0E,dispatcher); extern pascal WindowPtr GetWMgrPort(void) inline(0x200E,dispatcher); extern pascal LongWord GetWRefCon(GrafPortPtr) inline(0x290E,dispatcher); extern pascal Pointer GetWTitle(GrafPortPtr) inline(0x0E0E,dispatcher); extern pascal Rect *GetZoomRect(GrafPortPtr) inline(0x370E,dispatcher); extern pascal LongWord GrowWindow(Word, Word, Integer, Integer, GrafPortPtr) inline(0x1B0E,dispatcher); extern pascal void HideWindow(GrafPortPtr) inline(0x120E,dispatcher); extern pascal void HiliteWindow(Boolean, GrafPortPtr) inline(0x220E,dispatcher); extern pascal void InvalRect(Rect *) inline(0x3A0E,dispatcher); extern pascal void InvalRgn(Handle) inline(0x3B0E,dispatcher); extern pascal void MoveWindow(Integer, Integer, GrafPortPtr) inline(0x190E,dispatcher); extern pascal WindowPtr NewWindow(ParamListPtr) inline(0x090E,dispatcher); extern pascal Point PinRect(Integer, Integer, Rect *) inline(0x210E,dispatcher); extern pascal void RefreshDesktop(Rect *) inline(0x390E,dispatcher); extern pascal void SelectWindow(GrafPortPtr) inline(0x110E,dispatcher); extern pascal void SendBehind(GrafPortPtr, GrafPortPtr) inline(0x140E,dispatcher); extern pascal void SetContentDraw(VoidProcPtr, GrafPortPtr) inline(0x490E,dispatcher); extern pascal void SetContentOrigin(Word, Word, GrafPortPtr) inline(0x3F0E,dispatcher); extern pascal void SetDataSize(Word, Word, GrafPortPtr) inline(0x410E,dispatcher); extern pascal void SetDefProc(LongProcPtr, GrafPortPtr) inline(0x320E,dispatcher); extern pascal void SetFrameColor(WindColorPtr, GrafPortPtr) inline(0x0F0E,dispatcher); extern pascal void SetInfoDraw(VoidProcPtr, GrafPortPtr) inline(0x160E,dispatcher); extern pascal void SetInfoRefCon(LongWord, GrafPortPtr) inline(0x360E,dispatcher); extern pascal void SetMaxGrow(Word, Word, GrafPortPtr) inline(0x430E,dispatcher); extern pascal void SetOriginMask(Word, GrafPortPtr) inline(0x340E,dispatcher); extern pascal void SetPage(Word, Word, GrafPortPtr) inline(0x470E,dispatcher); extern pascal void SetScroll(Word, Word, GrafPortPtr) inline(0x450E,dispatcher); extern pascal void SetSysWindow(GrafPortPtr) inline(0x4B0E,dispatcher); extern pascal void SetWFrame(Word, GrafPortPtr) inline(0x2D0E,dispatcher); extern pascal FontHndl SetWindowIcons(FontHndl) inline(0x4E0E,dispatcher); extern pascal void SetWRefCon(Longint, GrafPortPtr) inline(0x280E,dispatcher); extern pascal void SetWTitle(Pointer, GrafPortPtr) inline(0x0D0E,dispatcher); extern pascal void SetZoomRect(Rect *, GrafPortPtr) inline(0x380E,dispatcher); extern pascal void ShowHide(Boolean, GrafPortPtr) inline(0x230E,dispatcher); extern pascal void ShowWindow(GrafPortPtr) inline(0x130E,dispatcher); extern pascal void SizeWindow(Word, Word, GrafPortPtr) inline(0x1C0E,dispatcher); extern pascal void StartDrawing(GrafPortPtr) inline(0x4D0E,dispatcher); extern pascal void StartInfoDrawing(Rect *, GrafPortPtr) inline(0x500E,dispatcher); extern pascal Word TaskMaster(Word, WmTaskRecPtr) inline(0x1D0E,dispatcher); extern pascal Boolean TrackGoAway(Integer, Integer, GrafPortPtr) inline(0x180E,dispatcher); extern pascal Boolean TrackZoom(Integer, Integer, GrafPortPtr) inline(0x260E,dispatcher); extern pascal void ValidRect(Rect *) inline(0x3C0E,dispatcher); extern pascal void ValidRgn(Handle) inline(0x3D0E,dispatcher); extern pascal LongWord WindDragRect(VoidProcPtr, Pattern, Integer, Integer, Rect *, Rect *, Rect *, Word) inline(0x530E,dispatcher); extern pascal void WindNewRes(void) inline(0x250E,dispatcher); extern pascal Word WindowGlobal(Word) inline(0x560E,dispatcher); extern pascal void ZoomWindow(GrafPortPtr) inline(0x270E,dispatcher); extern pascal Word AlertWindow(Word, Pointer, Ref) inline(0x590E,dispatcher); extern pascal Handle CompileText(Word, Pointer, Pointer, Word) inline(0x600E,dispatcher); extern pascal void DrawInfoBar(GrafPortPtr) inline(0x550E,dispatcher); extern pascal void EndFrameDrawing(void) inline(0x5B0E,dispatcher); extern pascal Word ErrorWindow(Word, Pointer, Word) inline(0x620E,dispatcher); extern pascal Ptr GetWindowMgrGlobals(void) inline(0x580E,dispatcher); extern pascal WindowPtr NewWindow2(Pointer, Long, VoidProcPtr, LongProcPtr, Word, Ref, Word) inline(0x610E,dispatcher); extern pascal void ResizeWindow(Boolean, Rect *, GrafPortPtr) inline(0x5C0E,dispatcher); extern pascal void StartFrameDrawing(GrafPortPtr) inline(0x5A0E,dispatcher); extern pascal Word TaskMasterDA(Word, WmTaskRecPtr) inline(0x5F0E,dispatcher); extern pascal LongWord DoModalWindow(EventRecordPtr, VoidProcPtr, VoidProcPtr, VoidProcPtr, Word) inline(0x640E,dispatcher); extern pascal Word FindCursorCtl(CtlRecHndlPtr, Integer, Integer, GrafPortPtr) inline(0x690E,dispatcher); extern pascal AuxWindInfoPtr GetAuxWindInfo(GrafPortPtr) inline(0x630E,dispatcher); extern pascal LongWord HandleDiskInsert(Word, Word) inline(0x6B0E,dispatcher); extern pascal Word MWGetCtlPart(void) inline(0x650E,dispatcher); extern pascal VoidProcPtr MWSetMenuProc(VoidProcPtr) inline(0x660E,dispatcher); /* old spelling of MWSetMenuProc */ extern pascal VoidProcPtr SetMenuProc(VoidProcPtr) inline(0x660E,dispatcher); extern pascal void MWSetUpEditMenu(void) inline(0x680E,dispatcher); extern pascal void MWStdDrawProc(void) inline(0x670E,dispatcher); extern pascal void ResizeInfoBar(Word, Word, GrafPortPtr) inline(0x6A0E,dispatcher); extern pascal void UpdateWindow(Word, GrafPortPtr) inline(0x6C0E,dispatcher); /* The parameters for these calls are not documented. extern pascal void GDRPrivate() inline(0x540E,dispatcher); extern pascal void TaskMasterContent() inline(0x5D0E,dispatcher); extern pascal void TaskMasterKey() inline(0x5E0E,dispatcher); */ /* This call appears in the Apple header file, but is not documented. extern pascal void SetContentOrigin2() inline(0x570E,dispatcher); */ #endif \ No newline at end of file +/******************************************** +* +* Window Manager +* +* Copyright Apple Computer, Inc. 1986-92 +* All Rights Reserved +* +* Copyright 1992, 1993, Byte Works, Inc. +* +********************************************/ + +#ifndef __TYPES__ +#include +#endif + +#ifndef __WINDOW__ +#define __WINDOW__ + +/* Error Codes */ +#define paramLenErr 0x0E01 /* first word of parameter list is the wrong size */ +#define allocateErr 0x0E02 /* unable to allocate window record */ +#define taskMaskErr 0x0E03 /* reserved bits are not clear in wmTaskMask */ +#define compileTooLarge 0x0E04 /* Compiled text is larger than 64 KB */ +#define cantUpdateErr 0x0E05 /* window couldn't be updated */ + +/* Axis Parameters */ +#define wNoConstraint 0x0000 /* No constraint on movement */ +#define wHAxisOnly 0x0001 /* Horizontal axis only */ +#define wVAxisOnly 0x0002 /* Vertical axis only */ + +/* Desktop Command Codes */ +#define FromDesk 0x00 /* Subtract region from desktop */ +#define ToDesk 0x1 /* Add region to desktop */ +#define GetDesktop 0x2 /* Get Handle of Desktop region */ +#define SetDesktop 0x3 /* Set Handle of Desktop region */ +#define GetDeskPat 0x4 /* Address of pattern or drawing routine */ +#define SetDeskPat 0x5 /* Change Address of pattern or drawing routine */ +#define GetVisDesktop 0x6 /* Get destop region less visible windows */ +#define BackGroundRgn 0x7 /* For drawing directly on desktop */ +#define CheckForNewDeskMsg 0x8 /* Force rechecking message #2 */ + +/* SendBehind Values */ +#define toBottom 0xFFFFFFFEL /* To send window to bottom */ +#define topMost 0xFFFFFFFFL /* To make window top */ +#define bottomMost 0x0000L /* To make window bottom */ + +/* Task Masks */ +#define tmMenuKey 0x00000001L +#define tmUpdate 0x00000002L +#define tmFindW 0x00000004L +#define tmMenuSel 0x0008L +#define tmOpenNDA 0x0010L +#define tmSysClick 0x0020L +#define tmDragW 0x0040L +#define tmContent 0x0080L +#define tmClose 0x0100L +#define tmZoom 0x0200L +#define tmGrow 0x0400L +#define tmScroll 0x0800L +#define tmSpecial 0x1000L +#define tmCRedraw 0x2000L +#define tmInactive 0x4000L +#define tmInfo 0x8000L +#define tmContentControls 0x00010000L +#define tmControlKey 0x00020000L +#define tmControlMenu 0x00040000L +#define tmMultiClick 0x00080000L +#define tmIdleEvents 0x00100000L + +/* TaskMaster Codes */ +#define wNoHit 0x0000 /* retained for back compatibility */ +#define inNull 0x0000 /* retained for back compatibility */ +#define inKey 0x0003 /* retained for back compatibility */ +#define inButtDwn 0x0001 /* retained for back compatibility */ +#define inUpdate 0x0006 /* retained for back compatibility */ +#define wInDesk 0x0010 /* On Desktop */ +#define wInMenuBar 0x0011 /* On system menu bar */ +#define wClickCalled 0x0012 /* system click called */ +#define wInContent 0x0013 /* In content region */ +#define wInDrag 0x0014 /* In drag region */ +#define wInGrow 0x0015 /* In grow region, active window only */ +#define wInGoAway 0x0016 /* In go-away region, active window only */ +#define wInZoom 0x0017 /* In zoom region, active window only */ +#define wInInfo 0x0018 /* In information bar */ +#define wInSpecial 0x0019 /* Item ID selected was 250 - 255 */ +#define wInDeskItem 0x001A /* Item ID selected was 1 - 249 */ +#define wInFrame 0x1B /* in Frame, but not on anything else */ +#define wInactMenu 0x1C /* 'selection' of inactive menu item */ +#define wClosedNDA 0x001D /* desk accessory closed */ +#define wCalledSysEdit 0x001E /* inactive menu item selected */ +#define wInSysWindow 0x8000 /* hi bit set for system windows */ + +/* VarCode */ +#define wDraw 0x00 /* Draw window frame command */ +#define wHit 0x01 /* Hit test command */ +#define wCalcRgns 0x02 /* Compute regions command */ +#define wNew 0x03 /* Initialization command */ +#define wDispose 0x04 /* Dispose command */ +#define wGetDrag 5 /* Return address of outline drawing handler */ +#define wGrowFrame 6 /* Draw outline of window being resized */ +#define wRecSize 7 /* Return size of additional space neeed in the windrec */ +#define wPos 8 /* Return RECT that is the window's portRect */ +#define wBehind 9 /* Return where the window should be placed in the list */ +#define wCallDefProc 10 /* Generic call to the defproc */ + +/* WFrame */ +#define fHilited 0x0001 /* Window is highlighted */ +#define fZoomed 0x0002 /* Window is zoomed */ +#define fAllocated 0x0004 /* Window record was allocated */ +#define fCtlTie 0x0008 /* Window state tied to controls */ +#define fInfo 0x0010 /* Window has an information bar */ +#define fVis 0x0020 /* Window is visible */ +#define fQContent 0x0040 +#define fMove 0x0080 /* Window is movable */ +#define fZoom 0x0100 /* Window is zoomable */ +#define fFlex 0x0200 +#define fGrow 0x0400 /* Window has grow box */ +#define fBScroll 0x0800 /* Window has horizontal scroll bar */ +#define fRScroll 0x1000 /* Window has vertical scroll bar */ +#define fAlert 0x2000 +#define fClose 0x4000 /* Window has a close box */ +#define fTitle 0x8000 /* Window has a title bar */ + +/* DoModalWindow flag values */ +#define mwMovable 0x8000 +#define mwUpdateAll 0x4000 +#define mwDeskAcc 0x0010 +#define mwIBeam 0x0008 +#define mwMenuKey 0x0004 +#define mwMenuSelect 0x0002 +#define mwNoScrapForLE 0x0001 + +/* HandleDiskInsert flag values (bit flags) */ +#define hdiScan 0x8000 +#define hdiHandle 0x4000 +#define hdiUpdate 0x2000 +#define hdiReportEjects 0x1000 +#define hdiNoDelay 0x0800 +#define hdiDupDisk 0x0400 +#define hdiCheckTapeDrives 0x0200 +#define hdiUnreadable 0x0100 +#define hdiMarkOffline 0x0001 + +/* HandleDiskInsert result flag values (bit flags) */ +#define hdiFormatted 0x0002 +#define hdiEjection 0x0001 + +/* constants for AlertWindow alertFlags */ +#define awCString 0x0000 +#define awPString 0x0001 +#define awPointer 0x0000 +#define awHandle 0x0002 +#define awResource 0x0004 +#define awTextFullWidth 0x0008 +#define awForceBeep 0x0010 +#define awButtonLayout 0x0020 +#define awNoDevScan 0x0040 +#define awNoDisposeRes 0x0080 +#define awWatchForDisk 0x0100 +#define awIconIsResource 0x0200 +#define awFullColor 0x0400 + +/* UpdateWindow flag values */ +#define uwBackground 0x8000 +#define uwGSOSnotAvail 0x4000 + +/* Other Constants */ +#define windSize 0x00D4 /* Size of WindRec */ +#define wmTaskRecSize 0x002E /* Size of WmTaskRec */ +#define wTrackZoom 0x001F +#define wHitFrame 0x0020 +#define wInControl 0x0021 +#define wInControlMenu 0x0022 + +/* custom defproc dRequest codes (from TN #42) */ +#define wSetOrgMask 0 +#define wSetMaxGrow 1 +#define wSetScroll 2 +#define wSetPage 3 +#define wSetInfoRefCon 4 +#define wSetInfoDraw 5 +#define wSetOrigin 6 +#define wSetDataSize 7 +#define wSetZoomRect 8 +#define wSetTitle 9 +#define wSetColorTable 10 +#define wSetFrameFlag 11 +#define wGetOrgMask 12 +#define wGetMaxGrow 13 +#define wGetScroll 14 +#define wGetPage 15 +#define wGetInfoRefCon 16 +#define wGetInfoDraw 17 +#define wGetOrigin 18 +#define wGetDataSize 19 +#define wGetZoomRect 20 +#define wGetTitle 21 +#define wGetColorTable 22 +#define wGetFrameFlag 23 +#define wGetInfoRect 24 +#define wGetDrawInfo 25 +#define wGetStartInfoDraw 26 +#define wGetEndInfoDraw 27 +#define wZoomWindow 28 +#define wStartDrawing 29 +#define wStartMove 30 +#define wStartGrow 31 +#define wNewSize 32 +#define wTask 33 + +typedef struct WindColor { + Word frameColor; /* Color of window frame */ + Word titleColor; /* Color of title and bar */ + Word tBarColor; /* Color/pattern of title bar */ + Word growColor; /* Color of grow box */ + Word infoColor; /* Color of information bar */ + } WindColor, *WindColorPtr, **WindColorHndl; + +typedef struct WindRec { + /* struct WindRec *wNext; not included in record returned by ToolBox calls */ + GrafPort port; /* Window's port */ + ProcPtr wDefProc; + LongWord wRefCon; + ProcPtr wContDraw; + LongWord wReserved; /* Space for future expansion */ + RegionHndl wStrucRgn; /* Region of frame plus content */ + RegionHndl wContRgn; /* Content region */ + RegionHndl wUpdateRgn; /* Update region */ + CtlRecHndl wControls; /* Window's control list */ + CtlRecHndl wFrameCtrls; /* Window frame's control list */ + Word wFrame; + } WindRec, *WindRecPtr; + +typedef struct ParamList { + Word paramLength; + Word wFrameBits; + Pointer wTitle; + LongWord wRefCon; + Rect wZoom; + WindColorPtr wColor; + Word wYOrigin; + Word wXOrigin; + Word wDataH; + Word wDataW; + Word wMaxH; + Word wMaxW; + Word wScrollVer; + Word wScrollHor; + Word wPageVer; + Word wPageHor; + LongWord wInfoRefCon; + Word wInfoHeight; /* height of information bar */ + LongProcPtr wFrameDefProc; + VoidProcPtr wInfoDefProc; + VoidProcPtr wContDefProc; + Rect wPosition; + WindowPtr wPlane; + WindRecPtr wStorage; + } ParamList, *ParamListPtr, **ParamListHndl; + +typedef struct WindParam1 { + Word p1Length; + Word p1Frame; + Pointer p1Title; + LongWord p1RefCon; + Rect p1ZoomRect; + WindColorPtr p1ColorTable; + Word p1YOrigin; + Word p1XOrigin; + Word p1DataHeight; + Word p1DataWidth; + Word p1MaxHeight; + Word p1MaxWidth; + Word p1VerScroll; + Word p1HorScroll; + Word p1VerPage; + Word p1HorPage; + LongWord p1InfoText; + Word p1InfoHeight; + LongProcPtr p1DefProc; + VoidProcPtr p1InfoDraw; + VoidProcPtr p1ContentDraw; + Rect p1Position; + WindowPtr p1Plane; + Long p1ControlList; + Word p1InDesc; + } WindParam1, *WindParam1Ptr, **WindParam1Hndl; + +typedef struct DeskMessageRecord { + LongWord reserved; + Word messageType; + Word drawType; + } DeskMessageRecord, *DeskMessageRecordPtr; + +typedef struct AuxWindInfoRecord { + Word recordSize; + Word reservedForBank; + Word reservedForDP; + Word reservedForResApp; + LongWord reservedForUpdateHandle; + LongWord reservedForEndUpdatePort; + LongWord reservedForWindoidLayer; + Word sysWindMinHeight; + Word sysWindMinWidth; + Ptr NDASysWindPtr; + } AuxWindInfoRecord, *AuxWindInfoPtr; + +typedef struct WindGlobalsRec { + Word lineW; + Word titleHeight; + Word titleYPos; + Word closeHeight; + Word closeWidth; + LongWord defWindClr; + LongWord windIconFont; + Word screenMode; + Byte pattern[32]; + Word callerDPage; + Word callerDataB; + } WindGlobalsRec, *WindGlobalsRecPtr, **WindGlobalsRecHndl; + +extern pascal void WindBootInit(void) inline(0x010E,dispatcher); +extern pascal void WindStartUp(Word) inline(0x020E,dispatcher); +extern pascal void WindShutDown(void) inline(0x030E,dispatcher); +extern pascal Word WindVersion(void) inline(0x040E,dispatcher); +extern pascal void WindReset(void) inline(0x050E,dispatcher); +extern pascal Boolean WindStatus(void) inline(0x060E,dispatcher); +extern pascal void BeginUpdate(GrafPortPtr) inline(0x1E0E,dispatcher); +extern pascal void BringToFront(GrafPortPtr) inline(0x240E,dispatcher); +extern pascal Boolean CheckUpdate(EventRecordPtr) inline(0x0A0E,dispatcher); +extern pascal void CloseWindow(GrafPortPtr) inline(0x0B0E,dispatcher); +extern pascal Pointer Desktop(Word, LongWord) inline(0x0C0E,dispatcher); +extern pascal void DragWindow(Word, Integer, Integer, Word, Rect *, GrafPortPtr) inline(0x1A0E,dispatcher); +extern pascal void EndInfoDrawing(void) inline(0x510E,dispatcher); +extern pascal void EndUpdate(GrafPortPtr) inline(0x1F0E,dispatcher); +extern pascal Word FindWindow(GrafPortPtr *, Integer, Integer) inline(0x170E,dispatcher); +extern pascal WindowPtr FrontWindow(void) inline(0x150E,dispatcher); +extern pascal VoidProcPtr GetContentDraw(GrafPortPtr) inline(0x480E,dispatcher); +extern pascal Long GetContentOrigin (GrafPortPtr) inline(0x3E0E,dispatcher); +extern pascal RegionHndl GetContentRgn(GrafPortPtr) inline(0x2F0E,dispatcher); +extern pascal LongWord GetDataSize(GrafPortPtr) inline(0x400E,dispatcher); +extern pascal LongProcPtr GetDefProc(GrafPortPtr) inline(0x310E,dispatcher); +extern pascal WindowPtr GetFirstWindow(void) inline(0x520E,dispatcher); +extern pascal void GetFrameColor(WindColorPtr, GrafPortPtr) inline(0x100E,dispatcher); +extern pascal VoidProcPtr GetInfoDraw(GrafPortPtr) inline(0x4A0E,dispatcher); +extern pascal LongWord GetInfoRefCon(GrafPortPtr) inline(0x350E,dispatcher); +extern pascal LongWord GetMaxGrow(GrafPortPtr) inline(0x420E,dispatcher); +extern pascal WindowPtr GetNextWindow(GrafPortPtr) inline(0x2A0E,dispatcher); +extern pascal LongWord GetPage(GrafPortPtr) inline(0x460E,dispatcher); +extern pascal void GetRectInfo(Rect *, GrafPortPtr) inline(0x4F0E,dispatcher); +extern pascal LongWord GetScroll(GrafPortPtr) inline(0x440E,dispatcher); +extern pascal RegionHndl GetStructRgn(GrafPortPtr) inline(0x2E0E,dispatcher); +extern pascal Boolean GetSysWFlag(GrafPortPtr) inline(0x4C0E,dispatcher); +extern pascal RegionHndl GetUpdateRgn(GrafPortPtr) inline(0x300E,dispatcher); +extern pascal CtlRecHndl GetWControls(GrafPortPtr) inline(0x330E,dispatcher); +extern pascal Word GetWFrame(GrafPortPtr) inline(0x2C0E,dispatcher); +extern pascal Word GetWKind(GrafPortPtr) inline(0x2B0E,dispatcher); +extern pascal WindowPtr GetWMgrPort(void) inline(0x200E,dispatcher); +extern pascal LongWord GetWRefCon(GrafPortPtr) inline(0x290E,dispatcher); +extern pascal Pointer GetWTitle(GrafPortPtr) inline(0x0E0E,dispatcher); +extern pascal Rect *GetZoomRect(GrafPortPtr) inline(0x370E,dispatcher); +extern pascal LongWord GrowWindow(Word, Word, Integer, Integer, GrafPortPtr) inline(0x1B0E,dispatcher); +extern pascal void HideWindow(GrafPortPtr) inline(0x120E,dispatcher); +extern pascal void HiliteWindow(Boolean, GrafPortPtr) inline(0x220E,dispatcher); +extern pascal void InvalRect(Rect *) inline(0x3A0E,dispatcher); +extern pascal void InvalRgn(Handle) inline(0x3B0E,dispatcher); +extern pascal void MoveWindow(Integer, Integer, GrafPortPtr) inline(0x190E,dispatcher); +extern pascal WindowPtr NewWindow(ParamListPtr) inline(0x090E,dispatcher); +extern pascal Point PinRect(Integer, Integer, Rect *) inline(0x210E,dispatcher); +extern pascal void RefreshDesktop(Rect *) inline(0x390E,dispatcher); +extern pascal void SelectWindow(GrafPortPtr) inline(0x110E,dispatcher); +extern pascal void SendBehind(GrafPortPtr, GrafPortPtr) inline(0x140E,dispatcher); +extern pascal void SetContentDraw(VoidProcPtr, GrafPortPtr) inline(0x490E,dispatcher); +extern pascal void SetContentOrigin(Word, Word, GrafPortPtr) inline(0x3F0E,dispatcher); +extern pascal void SetDataSize(Word, Word, GrafPortPtr) inline(0x410E,dispatcher); +extern pascal void SetDefProc(LongProcPtr, GrafPortPtr) inline(0x320E,dispatcher); +extern pascal void SetFrameColor(WindColorPtr, GrafPortPtr) inline(0x0F0E,dispatcher); +extern pascal void SetInfoDraw(VoidProcPtr, GrafPortPtr) inline(0x160E,dispatcher); +extern pascal void SetInfoRefCon(LongWord, GrafPortPtr) inline(0x360E,dispatcher); +extern pascal void SetMaxGrow(Word, Word, GrafPortPtr) inline(0x430E,dispatcher); +extern pascal void SetOriginMask(Word, GrafPortPtr) inline(0x340E,dispatcher); +extern pascal void SetPage(Word, Word, GrafPortPtr) inline(0x470E,dispatcher); +extern pascal void SetScroll(Word, Word, GrafPortPtr) inline(0x450E,dispatcher); +extern pascal void SetSysWindow(GrafPortPtr) inline(0x4B0E,dispatcher); +extern pascal void SetWFrame(Word, GrafPortPtr) inline(0x2D0E,dispatcher); +extern pascal FontHndl SetWindowIcons(FontHndl) inline(0x4E0E,dispatcher); +extern pascal void SetWRefCon(Longint, GrafPortPtr) inline(0x280E,dispatcher); +extern pascal void SetWTitle(Pointer, GrafPortPtr) inline(0x0D0E,dispatcher); +extern pascal void SetZoomRect(Rect *, GrafPortPtr) inline(0x380E,dispatcher); +extern pascal void ShowHide(Boolean, GrafPortPtr) inline(0x230E,dispatcher); +extern pascal void ShowWindow(GrafPortPtr) inline(0x130E,dispatcher); +extern pascal void SizeWindow(Word, Word, GrafPortPtr) inline(0x1C0E,dispatcher); +extern pascal void StartDrawing(GrafPortPtr) inline(0x4D0E,dispatcher); +extern pascal void StartInfoDrawing(Rect *, GrafPortPtr) inline(0x500E,dispatcher); +extern pascal Word TaskMaster(Word, WmTaskRecPtr) inline(0x1D0E,dispatcher); +extern pascal Boolean TrackGoAway(Integer, Integer, GrafPortPtr) inline(0x180E,dispatcher); +extern pascal Boolean TrackZoom(Integer, Integer, GrafPortPtr) inline(0x260E,dispatcher); +extern pascal void ValidRect(Rect *) inline(0x3C0E,dispatcher); +extern pascal void ValidRgn(Handle) inline(0x3D0E,dispatcher); +extern pascal LongWord WindDragRect(VoidProcPtr, Pattern, Integer, Integer, Rect *, Rect *, Rect *, Word) inline(0x530E,dispatcher); +extern pascal void WindNewRes(void) inline(0x250E,dispatcher); +extern pascal Word WindowGlobal(Word) inline(0x560E,dispatcher); +extern pascal void ZoomWindow(GrafPortPtr) inline(0x270E,dispatcher); + +extern pascal Word AlertWindow(Word, Pointer, Ref) inline(0x590E,dispatcher); +extern pascal Handle CompileText(Word, Pointer, Pointer, Word) inline(0x600E,dispatcher); +extern pascal void DrawInfoBar(GrafPortPtr) inline(0x550E,dispatcher); +extern pascal void EndFrameDrawing(void) inline(0x5B0E,dispatcher); +extern pascal Word ErrorWindow(Word, Pointer, Word) inline(0x620E,dispatcher); +extern pascal Ptr GetWindowMgrGlobals(void) inline(0x580E,dispatcher); +extern pascal WindowPtr NewWindow2(Pointer, Long, VoidProcPtr, LongProcPtr, Word, Ref, Word) inline(0x610E,dispatcher); +extern pascal void ResizeWindow(Boolean, Rect *, GrafPortPtr) inline(0x5C0E,dispatcher); +extern pascal void StartFrameDrawing(GrafPortPtr) inline(0x5A0E,dispatcher); +extern pascal Word TaskMasterDA(Word, WmTaskRecPtr) inline(0x5F0E,dispatcher); + +extern pascal LongWord DoModalWindow(EventRecordPtr, VoidProcPtr, VoidProcPtr, VoidProcPtr, Word) inline(0x640E,dispatcher); +extern pascal Word FindCursorCtl(CtlRecHndlPtr, Integer, Integer, GrafPortPtr) inline(0x690E,dispatcher); +extern pascal AuxWindInfoPtr GetAuxWindInfo(GrafPortPtr) inline(0x630E,dispatcher); +extern pascal LongWord HandleDiskInsert(Word, Word) inline(0x6B0E,dispatcher); +extern pascal Word MWGetCtlPart(void) inline(0x650E,dispatcher); +extern pascal VoidProcPtr MWSetMenuProc(VoidProcPtr) inline(0x660E,dispatcher); +/* old spelling of MWSetMenuProc */ +extern pascal VoidProcPtr SetMenuProc(VoidProcPtr) inline(0x660E,dispatcher); +extern pascal void MWSetUpEditMenu(void) inline(0x680E,dispatcher); +extern pascal void MWStdDrawProc(void) inline(0x670E,dispatcher); +extern pascal void ResizeInfoBar(Word, Word, GrafPortPtr) inline(0x6A0E,dispatcher); + +extern pascal void UpdateWindow(Word, GrafPortPtr) inline(0x6C0E,dispatcher); + +/* The parameters for these calls are not documented. +extern pascal void GDRPrivate() inline(0x540E,dispatcher); +extern pascal void TaskMasterContent() inline(0x5D0E,dispatcher); +extern pascal void TaskMasterKey() inline(0x5E0E,dispatcher); +*/ + +/* This call appears in the Apple header file, but is not documented. +extern pascal void SetContentOrigin2() inline(0x570E,dispatcher); +*/ + +#endif diff --git a/bin/OSSource/ORCALib/equates.asm b/bin/OSSource/ORCALib/equates.asm old mode 100755 new mode 100644 index 8b012bc..0659d15 --- a/bin/OSSource/ORCALib/equates.asm +++ b/bin/OSSource/ORCALib/equates.asm @@ -1 +1,113 @@ -**************************************************************** * * This file contains constant values defined in the C interfaces * that are also used in the assembly language portion of the * libraries. * **************************************************************** ; ; error numbers ; EDOM gequ 1 domain error ERANGE gequ 2 # too large, too small, or illegal ENOMEM gequ 3 Not enough memory ENOENT gequ 4 No such file or directory EIO gequ 5 I/O error EINVAL gequ 6 Invalid argument EBADF gequ 7 bad file descriptor EMFILE gequ 8 too many files are open EACCES gequ 9 access bits prevent the operation EEXIST gequ 10 the file exists ENOSPC gequ 11 the file is too large ; ; masks for the __ctype array ; _digit gequ $01 ['0'..'9'] _upper gequ $02 ['A'..'Z'] _lower gequ $04 ['a'..'z'] _control gequ $08 [chr(0)..chr(31),chr(127)] _punctuation gequ $10 [' ','!'..'/',':'..'@','['..'`','{'..'~'] _space gequ $20 [chr(9)..chr(13),' '] _hex gequ $40 ['0'..'9','a'..'f','A'..'F'] _print gequ $80 [' '..'~'] ; ; masks for the __ctype2 array ; _csym gequ $01 ['0'..'9','A'..'Z','a'..'z','_'] _csymf gequ $02 ['A'..'Z','a'..'z'.'_'] _octal gequ $04 ['0'..'7'] ; ; signal numbers ; SIGABRT gequ 1 SIGFPE gequ 2 SIGILL gequ 3 SIGINT gequ 4 SIGSEGV gequ 5 SIGTERM gequ 6 ; ; The FILE record ; ! flags ! ----- _IOFBF gequ $0001 full buffering _IONBF gequ $0002 no buffering _IOLBF gequ $0004 flush when a \n is written _IOREAD gequ $0008 currently reading _IOWRT gequ $0010 currently writing _IORW gequ $0020 read/write enabled _IOMYBUF gequ $0040 buffer was allocated by stdio _IOEOF gequ $0080 has an EOF been found? _IOERR gequ $0100 has an error occurred? _IOTEXT gequ $0200 is this file a text file? _IOTEMPFILE gequ $0400 was this file created by tmpfile()? ! record structure ! ---------------- FILE_next gequ 0 disp to next pointer (must stay 0!) FILE_ptr gequ FILE_next+4 next location to write to FILE_base gequ FILE_ptr+4 first byte of the buffer FILE_end gequ FILE_base+4 end of the file buffer FILE_size gequ FILE_end+4 size of the file buffer FILE_cnt gequ FILE_size+4 # chars that can be read/writen to buffer FILE_pbk gequ FILE_cnt+4 put back character FILE_flag gequ FILE_pbk+4 buffer flags FILE_file gequ FILE_flag+2 GS/OS file ID sizeofFILE gequ FILE_file+2 size of the record BUFSIZ gequ 1024 default file buffer size _LBUFSIZ gequ 255 line buffer size L_tmpnam gequ 9 size of a temp name TMP_MAX gequ 10000 # of uniq temp names ; ; Seek codes for fseek ; SEEK_SET gequ 0 seek from start of file SEEK_CUR gequ 1 seek from current position SEEK_END gequ 2 seek from end of file ; ; Values for fcntl.h ; OPEN_MAX gequ 30 files in the file array F_DUPFD gequ 1 dup file flag (fcntl) O_RDONLY gequ $0001 file is read only O_WRONLY gequ $0002 file is write only O_RDWR gequ $0004 file is read/write O_NDELAY gequ $0008 not used O_APPEND gequ $0010 append to file on all writes O_CREAT gequ $0020 create a new file if needed O_TRUNC gequ $0040 erase old file O_EXCL gequ $0080 don't create a new file O_BINARY gequ $0100 file is binary ; ; Misc. ; EOF gequ -1 end of file character stdinID gequ -1 standard in file ID stdoutID gequ -2 standard out file ID stderrID gequ -3 error out file ID \ No newline at end of file +**************************************************************** +* +* This file contains constant values defined in the C interfaces +* that are also used in the assembly language portion of the +* libraries. +* +**************************************************************** +; +; error numbers +; +EDOM gequ 1 domain error +ERANGE gequ 2 # too large, too small, or illegal +ENOMEM gequ 3 Not enough memory +ENOENT gequ 4 No such file or directory +EIO gequ 5 I/O error +EINVAL gequ 6 Invalid argument +EBADF gequ 7 bad file descriptor +EMFILE gequ 8 too many files are open +EACCES gequ 9 access bits prevent the operation +EEXIST gequ 10 the file exists +ENOSPC gequ 11 the file is too large +; +; masks for the __ctype array +; +_digit gequ $01 ['0'..'9'] +_upper gequ $02 ['A'..'Z'] +_lower gequ $04 ['a'..'z'] +_control gequ $08 [chr(0)..chr(31),chr(127)] +_punctuation gequ $10 [' ','!'..'/',':'..'@','['..'`','{'..'~'] +_space gequ $20 [chr(9)..chr(13),' '] +_hex gequ $40 ['0'..'9','a'..'f','A'..'F'] +_print gequ $80 [' '..'~'] +; +; masks for the __ctype2 array +; +_csym gequ $01 ['0'..'9','A'..'Z','a'..'z','_'] +_csymf gequ $02 ['A'..'Z','a'..'z'.'_'] +_octal gequ $04 ['0'..'7'] +; +; signal numbers +; +SIGABRT gequ 1 +SIGFPE gequ 2 +SIGILL gequ 3 +SIGINT gequ 4 +SIGSEGV gequ 5 +SIGTERM gequ 6 +; +; The FILE record +; +! flags +! ----- +_IOFBF gequ $0001 full buffering +_IONBF gequ $0002 no buffering +_IOLBF gequ $0004 flush when a \n is written +_IOREAD gequ $0008 currently reading +_IOWRT gequ $0010 currently writing +_IORW gequ $0020 read/write enabled +_IOMYBUF gequ $0040 buffer was allocated by stdio +_IOEOF gequ $0080 has an EOF been found? +_IOERR gequ $0100 has an error occurred? +_IOTEXT gequ $0200 is this file a text file? +_IOTEMPFILE gequ $0400 was this file created by tmpfile()? + +! record structure +! ---------------- +FILE_next gequ 0 disp to next pointer (must stay 0!) +FILE_ptr gequ FILE_next+4 next location to write to +FILE_base gequ FILE_ptr+4 first byte of the buffer +FILE_end gequ FILE_base+4 end of the file buffer +FILE_size gequ FILE_end+4 size of the file buffer +FILE_cnt gequ FILE_size+4 # chars that can be read/writen to buffer +FILE_pbk gequ FILE_cnt+4 put back character +FILE_flag gequ FILE_pbk+4 buffer flags +FILE_file gequ FILE_flag+2 GS/OS file ID + +sizeofFILE gequ FILE_file+2 size of the record + +BUFSIZ gequ 1024 default file buffer size +_LBUFSIZ gequ 255 line buffer size + +L_tmpnam gequ 9 size of a temp name +TMP_MAX gequ 10000 # of uniq temp names +; +; Seek codes for fseek +; +SEEK_SET gequ 0 seek from start of file +SEEK_CUR gequ 1 seek from current position +SEEK_END gequ 2 seek from end of file +; +; Values for fcntl.h +; +OPEN_MAX gequ 30 files in the file array + +F_DUPFD gequ 1 dup file flag (fcntl) + +O_RDONLY gequ $0001 file is read only +O_WRONLY gequ $0002 file is write only +O_RDWR gequ $0004 file is read/write +O_NDELAY gequ $0008 not used +O_APPEND gequ $0010 append to file on all writes +O_CREAT gequ $0020 create a new file if needed +O_TRUNC gequ $0040 erase old file +O_EXCL gequ $0080 don't create a new file +O_BINARY gequ $0100 file is binary +; +; Misc. +; +EOF gequ -1 end of file character + +stdinID gequ -1 standard in file ID +stdoutID gequ -2 standard out file ID +stderrID gequ -3 error out file ID diff --git a/bin/OSSource/ORCALib/stdio.asm b/bin/OSSource/ORCALib/stdio.asm old mode 100755 new mode 100644 index d897cb6..bb75c9d --- a/bin/OSSource/ORCALib/stdio.asm +++ b/bin/OSSource/ORCALib/stdio.asm @@ -1 +1,5237 @@ - keep stdio mcopy stdio.macros case on **************************************************************** * * StdIO - Standard I/O Library * * This code implements the tables and subroutines needed to * support the standard C library STDIO. * * November 1988 * Mike Westerfield * * Copyright 1988 * Byte Works, Inc. * * Note: Portions of this library appear in SysFloat. * **************************************************************** * StdIO start dummy segment copy equates.asm end **************************************************************** * * void clearerr(stream) * FILE *stream; * * Clears the error flag for the givin stream. * * Inputs: * stream - file to clear * **************************************************************** * clearerr start stream equ 4 input stream tsc phd tcd ph4 stream verify that stream exists jsl ~VerifyStream bcs lb1 ldy #FILE_flag clear the error flag lda [stream],Y and #$FFFF-_IOERR-_IOEOF sta [stream],Y lb1 pld lda 2,S sta 6,S pla sta 3,S pla rtl end **************************************************************** * * int fclose(stream) * FILE *stream; * * Inputs: * stream - pointer to the file buffer to close * * Outputs: * A - EOF for an error; 0 if there was no error * **************************************************************** * fclose start nameBuffSize equ 8*1024 pathname buffer size err equ 1 return value p equ 3 work pointer stdfile equ 7 is this a standard file? csubroutine (4:stream),8 phb phk plb lda #EOF assume we will get an error sta err ph4 stream verify that stream exists jsl ~VerifyStream jcs rts ph4 stream do any pending I/O jsl fflush tax jne rts stz stdfile not a standard file lda stream+2 bypass file disposal if the file is cmp #^stdin+4 one of the standard ones bne cl0 lda stream cmp #stdin+4 beq lb1 cmp #stdout+4 beq lb1 cmp #stderr+4 bne cl0 lb1 inc stdfile bra cl3a cl0 lla p,stderr+4 find the file record that points to this ldy #2 one cl1 lda [p] ora [p],Y jeq rts lda [p],Y tax lda [p] cmp stream bne cl2 cpx stream+2 beq cl3 cl2 stx p+2 sta p bra cl1 cl3 lda [stream] remove stream from the file list sta [p] lda [stream],Y sta [p],Y cl3a ldy #FILE_flag if the file was opened by tmpfile then lda [stream],Y and #_IOTEMPFILE beq cl3d ph4 #nameBuffSize p = malloc(nameBuffSize) jsl malloc grPathname = p sta p dsPathname = p+2 stx p+2 sta grPathname stx grPathname+2 clc adc #2 bcc cl3b inx cl3b sta dsPathname stx dsPathname+2 lda #nameBuffSize p->size = nameBuffSize sta [p] ldy #FILE_file clRefnum = grRefnum = stream->_file lda [stream],Y beq cl3e sta grRefnum GetRefInfoGS gr GetRefInfoGS(gr) bcs cl3c lda grRefnum OSClose(cl) sta clRefNum OSClose cl DestroyGS ds DestroyGS(ds) cl3c ph4 p free(p) jsl free bra cl3e else cl3d ldy #FILE_file close the file lda [stream],Y beq cl3e sta clRefNum OSClose cl cl3e ldy #FILE_flag if the buffer was allocated by fopen then lda [stream],Y and #_IOMYBUF beq cl4 ldy #FILE_base+2 dispose of the file buffer lda [stream],Y pha dey dey lda [stream],Y pha jsl free cl4 lda stdfile if this is not a standard file then bne cl5 ph4 stream dispose of the file buffer jsl free bra cl7 else cl5 add4 stream,#sizeofFILE-4,p reset the standard out stuff ldy #sizeofFILE-2 cl6 lda [p],Y sta [stream],Y dey dey cpy #2 bne cl6 cl7 stz err no error found rts plb creturn 2:err cl dc i'1' parameter block for OSclose clRefNum ds 2 gr dc i'3' parameter block for GetRefInfoGS grRefnum ds 2 ds 2 grPathname ds 4 ds dc i'1' parameter block for DestroyGS dsPathname ds 4 end **************************************************************** * * int feof(stream) * FILE *stream; * * Inputs: * stream - file to check * * Outputs: * Returns _IOEOF if an end of file has been reached; else * 0. * **************************************************************** * feof start stream equ 4 input stream tsc phd tcd ph4 stream verify that stream exists jsl ~VerifyStream ldx #_IOEOF bcs lb1 ldy #FILE_flag check for eof lda [stream],Y and #_IOEOF tax lb1 pld lda 2,S sta 6,S pla sta 3,S pla txa rtl end **************************************************************** * * int ferror(stream) * FILE *stream; * * Inputs: * stream - file to check * * Outputs: * Returns _IOERR if an end of file has been reached; else * 0. * **************************************************************** * ferror start stream equ 4 input stream tsc phd tcd ph4 stream verify that stream exists jsl ~VerifyStream ldx #_IOERR bcs lb1 ldy #FILE_flag return the error status lda [stream],Y and #_IOERR tax lb1 pld lda 2,S sta 6,S pla sta 3,S pla txa rtl end **************************************************************** * * int fflush(steam) * FILE *stream; * * Write any pending characters to the output file * * Inputs: * stream - file buffer * * Outputs: * A - EOF for an error; 0 if there was no error * **************************************************************** * fflush start err equ 1 return value sp equ 3 stream work pointer csubroutine (4:stream),6 phb phk plb lda stream if stream = nil then ora stream+2 bne fa3 lda stderr+4 sp = stderr.next sta sp lda stderr+6 sta sp+2 stz err err = 0 fa1 lda sp while sp <> nil ora sp+2 jeq rts ph4 sp fflush(sp); jsl fflush tax if returned value <> 0 then beq fa2 sta err err = returned value fa2 ldy #2 sp = sp^.next lda [sp],Y tax lda [sp] sta sp stx sp+2 bra fa1 endwhile fa3 lda #EOF assume there is an error sta err ph4 stream verify that stream exists jsl ~VerifyStream jcs rts ldy #FILE_flag if the mode is not writting, quit lda [stream],Y and #_IOWRT beq fl1 ldy #FILE_file set the reference number lda [stream],Y sta wrRefNum ldy #FILE_base set the starting location lda [stream],Y sta wrDataBuffer iny iny lda [stream],Y sta wrDataBuffer+2 sec set the # of bytes to write ldy #FILE_ptr lda [stream],Y sbc wrDataBuffer sta wrRequestCount iny iny lda [stream],Y sbc wrDataBuffer+2 sta wrRequestCount+2 ora wrRequestCount skip the write if there are no beq fl1 characters OSwrite wr write the info bcc fl1 ph4 stream jsr ~ioerror bra rts fl1 ldy #FILE_flag if the file is open for read/write then lda [stream],Y bit #_IORW beq fl3 bit #_IOREAD if the file is being read then beq fl2 ph4 stream use ftell to set the mark jsl ftell ldy #FILE_flag lda [stream],Y fl2 and #$FFFF-_IOWRT-_IOREAD turn off the reading and writing flags sta [stream],Y fl3 ph4 stream prepare file for output jsl ~InitBuffer stz err no error found rts plb creturn 2:err wr dc i'5' parameter block for OSwrite wrRefNum ds 2 wrDataBuffer ds 4 wrRequestCount ds 4 ds 4 dc i'1' end **************************************************************** * * int fgetc(stream) * FILE *stream; * * Read a character from a file * * Inputs: * stream - file to read from * * Outputs: * A - character read; EOF for an error * **************************************************************** * fgetc start getc entry c equ 1 character read p equ 3 work pointer csubroutine (4:stream),6 phb phk plb ph4 stream verify that stream exists jsl ~VerifyStream bcs lb0 ldy #FILE_flag quit with error if the end of file lda [stream],Y has been reached or an error has been and #_IOEOF+_IOERR encountered beq lb1 lb0 lda #EOF sta c brl gc9 lb1 ldy #FILE_pbk if there is a char in the putback buffer lda [stream],Y bmi lb2 and #$00FF return it sta c ldy #FILE_pbk+2 pop the putback buffer lda [stream],Y tax lda #$FFFF sta [stream],Y ldy #FILE_pbk txa sta [stream],Y brl gc9 lb2 ldy #FILE_file branch if this is a disk file lda [stream],Y bpl gc2 cmp #stdinID if stream = stdin then bne gc1 jsl SYSKEYIN get a character tax branch if not eof bne st1 lda #_IOEOF set EOF flag ora >stdin+4+FILE_flag sta >stdin+4+FILE_flag jsl SYSKEYIN read the closing cr lda #EOF return EOF st1 sta c brl gc9 gc1 ph4 stream else flag the error jsr ~ioerror lda #EOF sta c brl gc9 gc2 ldy #FILE_flag if the file is not read enabled then lda [stream],Y bit #_IOREAD bne gc2a bit #_IOWRT it is an error if it is write enabled bne gc1 bra gc2b gc2a ldy #FILE_cnt we're ready if there are characters lda [stream],Y left iny iny ora [stream],Y jne gc8 gc2b ldy #FILE_flag if input is unbuffered then lda [stream],Y bit #_IONBF beq gc3 stz rdDataBuffer+2 set up to read one char to c tdc clc adc #c sta rdDataBuffer lla rdRequestCount,1 bra gc4 gc3 ldy #FILE_base else set up to read a buffer full lda [stream],Y sta rdDataBuffer iny iny lda [stream],Y sta rdDataBuffer+2 ldy #FILE_size lda [stream],Y sta rdRequestCount iny iny lda [stream],Y sta rdRequestCount+2 gc4 ldy #FILE_file set the file reference number lda [stream],Y sta rdRefNum OSRead rd read the data bcc gc7 if there was a read error then ldy #FILE_flag cmp #$4C if it was eof then bne gc5 lda #_IOEOF set the EOF flag bra gc6 else gc5 lda #_IOERR set the error flag gc6 ora [stream],Y sta [stream],Y lda #EOF return EOF sta c brl gc9 gc7 ldy #FILE_flag we're done if the read is unbuffered lda [stream],Y and #_IONBF jne gc9 clc set the end of the file buffer ldy #FILE_end lda rdDataBuffer adc rdTransferCount sta [stream],Y iny iny lda rdDataBuffer+2 adc rdTransferCount+2 sta [stream],Y ldy #FILE_base reset the file pointer lda [stream],Y tax iny iny lda [stream],Y ldy #FILE_ptr+2 sta [stream],Y dey dey txa sta [stream],Y ldy #FILE_cnt set the # chars in the buffer lda rdTransferCount sta [stream],Y iny iny lda rdTransferCount+2 sta [stream],Y ldy #FILE_flag note that the file is read enabled lda [stream],Y ora #_IOREAD sta [stream],Y gc8 ldy #FILE_ptr get the next character lda [stream],Y sta p clc adc #1 sta [stream],Y iny iny lda [stream],Y sta p+2 adc #0 sta [stream],Y lda [p] and #$00FF sta c ldy #FILE_cnt dec the # chars in the buffer sec lda [stream],Y sbc #1 sta [stream],Y bcs gc8a iny iny lda [stream],Y dec A sta [stream],Y gc8a ldy #FILE_flag if the file is read/write lda [stream],Y and #_IORW beq gc9 ldy #FILE_cnt and the buffer is empty then lda [stream],Y iny iny ora [stream],Y bne gc9 ldy #FILE_flag note that no chars are left lda [stream],Y eor #_IOREAD sta [stream],Y gc9 lda c if c = \r then cmp #13 bne gc10 ldy #FILE_flag if this is a text file then lda [stream],Y and #_IOTEXT beq gc10 lda #10 sta c gc10 plb creturn 2:c ; ; Local data ; rd dc i'4' parameter block for OSRead rdRefNum ds 2 rdDataBuffer ds 4 rdRequestCount ds 4 rdTransferCount ds 4 end **************************************************************** * * char *fgets(s, n, stream) * char *s; * int n; * FILE *stream; * * Reads a line into the string s. * * Inputs: * s - location to put the string read. * n - size of the string * stream - file to read from * * Outputs: * Returns NULL if an EOF is encountered, placing any * characters read before the EOF into s. Returns S if * a line or part of a line is read. * **************************************************************** * fgets start RETURN equ 13 RETURN key code LF equ 10 newline disp equ 1 disp in s csubroutine (4:s,2:n,4:stream),2 ph4 stream verify that stream exists jsl ~VerifyStream bcs err1 ph4 stream quit with NULL if at EOF jsl feof tax beq lb0 err1 stz s stz s+2 bra rts lb0 stz disp no characters processed so far lda #0 sta [s] dec n leave room for the null terminator bmi err beq err lb1 ph4 stream get a character jsl fgetc tax quit with error if it is an EOF bpl lb2 err stz s stz s+2 bra rts lb2 cmp #RETURN if the char is a return, switch to lf bne lb3 lda #LF lb3 ldy disp place the char in the string sta [s],Y (null terminates automatically) inc disp cmp #LF quit if it was an LF beq rts dec n next character bne lb1 rts creturn 4:s end **************************************************************** * * int fgetpos(FILE *stream, fpos_t *pos); * * Inputs: * stream - pointer to stream to get position of * pos - pointer to location to place position * * Outputs: * A - 0 if successful; else -1 if not * errno - if unsuccessful, errno is set to EIO * **************************************************************** * fgetpos start err equ 1 error code csubroutine (4:stream,4:pos),2 ph4 stream get the position jsl ftell cmp #-1 if the position = -1 then bne lb1 cpx #-1 bne lb1 sta err err = -1 bra lb2 return lb1 sta [pos] else txa *pos = position ldy #2 sta [pos],Y stz err err = 0 lb2 anop endif creturn 2:err end **************************************************************** * * FILE *fopen(filename, type) * char *filename, *type; * * Inputs: * filename - pointer to the file name * type - pointer to the type string * * Outputs: * X-A - pointer to the file variable; NULL for an error * **************************************************************** * fopen start BIN equ 6 file type for BIN files TXT equ 4 file type for TXT files fileType equ 1 file type letter fileBuff equ 3 pointer to the file buffer buffStart equ 7 start of the file buffer OSname equ 11 pointer to the GS/OS file name ; ; initialization ; csubroutine (4:filename,4:type),14 phb use our data bank phk plb stz fileBuff no file so far stz fileBuff+2 lda [type] make sure the file type is in ['a','r','w'] and #$00FF sta fileType ldx #$0003 cmp #'a' beq cn1 ldx #$0002 cmp #'w' beq cn1 ldx #$0001 cmp #'r' beq cn1 lda #EINVAL sta >errno brl rt2 ; ; create a GS/OS file name ; cn1 stx opAccess set the access flags ph4 filename get the length of the name buffer jsl ~osname sta OSname stx OSname+2 ora OSname+2 jeq rt2 ; ; check for file modifier characters + and b ; lda #TXT we must open a new file - determine it's sta crFileType type by looking for the 'b' designator ldy #1 lda [type],Y jsr Modifier bcc cm1 iny lda [type],Y jsr Modifier cm1 anop ; ; open the file ; move4 OSname,opName try to open an existing file OSopen op bcc of2 lda fileType if the type is 'r', flag an error cmp #'r' bne of1 lda #ENOENT sta >errno brl rt1 of1 move4 OSname,crPathName create the file OScreate cr bcs errEIO OSopen op open the file bcc of2 errEIO lda #EIO sta >errno brl rt1 of2 lda fileType if the file type is 'w' then cmp #'w' bne of3 lda opRefNum reset it sta efRefNum OSSet_EOF ef bcc ar1 allow "not a block device error" cmp #$0058 beq ar1 bra errEIO flag the error of3 cmp #'a' else if the file type is 'a' then bne ar1 lda opRefNum sta gfRefNum sta smRefNum OSGet_EOF gf append to it bcs errEIO move4 gfEOF,smDisplacement OSSet_Mark sm bcs errEIO ; ; allocate and fill in the file record ; ar1 ph4 #sizeofFILE get space for the file record jsl malloc sta fileBuff stx fileBuff+2 ora fileBuff+2 beq ar2 ph4 #BUFSIZ get space for the file buffer jsl malloc sta buffStart stx buffStart+2 ora buffStart+2 bne ar3 ph4 fileBuff memory error jsl free ar2 lda #ENOMEM sta >errno brl rt1 ar3 ldy #2 insert the record right after stderr lda >stderr+4 sta [fileBuff] lda >stderr+6 sta [fileBuff],Y lda fileBuff sta >stderr+4 lda fileBuff+2 sta >stderr+6 lda buffStart set the start of the buffer ldy #FILE_base sta [fileBuff],Y iny iny lda buffStart+2 sta [fileBuff],Y ldy #FILE_ptr+2 sta [fileBuff],Y dey dey lda buffStart sta [fileBuff],Y ldy #FILE_size set the buffer size lda #BUFSIZ sta [fileBuff],Y iny iny lda #^BUFSIZ sta [fileBuff],Y ldy #1 set the flags lda [type],Y and #$00FF cmp #'+' beq ar3a cmp #'b' bne ar4 iny lda [type],Y and #$00FF cmp #'+' bne ar4 ar3a lda #_IOFBF+_IORW+_IOMYBUF bra ar6 ar4 lda fileType cmp #'r' beq ar5 lda #_IOFBF+_IOWRT+_IOMYBUF bra ar6 ar5 lda #_IOFBF+_IOREAD+_IOMYBUF ar6 ldy #FILE_flag ldx crFileType cpx #BIN beq ar6a ora #_IOTEXT ar6a sta [fileBuff],Y ldy #FILE_cnt no chars in buffer lda #0 sta [fileBuff],Y iny iny sta [fileBuff],Y ldy #FILE_pbk nothing in the putback buffer lda #$FFFF sta [fileBuff],Y ldy #FILE_pbk+2 sta [fileBuff],Y ldy #FILE_file set the file ID lda opRefNum sta [fileBuff],Y ; ; return the result ; rt1 ph4 OSname dispose of the file name buffer jsl free rt2 plb restore caller's data bank creturn 4:fileBuff return ; ; Modifier - local subroutine to check modifier character ; ; Returns: C=0 if no modifier found, else C=1 ; Modifier and #$00FF beq md3 cmp #'+' bne md1 lda #$0003 sta opAccess sec rts md1 cmp #'b' bne md2 lda #BIN sta crFileType md2 sec rts md3 clc rts ; ; local data areas ; op dc i'3' parameter block for OSopen opRefNum ds 2 opName ds 4 opAccess ds 2 gf dc i'2' GetEOF record gfRefNum ds 2 gfEOF ds 4 sm dc i'3' SetMark record smRefNum ds 2 smBase dc i'0' smDisplacement ds 4 ef dc i'3' parameter block for OSSet_EOF efRefNum ds 2 dc i'0' dc i4'0' cr dc i'7' parameter block for OScreate crPathName ds 4 dc i'$C3' crFileType ds 2 dc i4'0' dc i'1' dc i4'0' dc i4'0' dc r'fgetc' dc r'fputc' dc r'fclose' end **************************************************************** * * FILE *freopen(filename, type, stream) * char *filename, *type; * FILE *stream; * * Inputs: * filename - pointer to the file name * type - pointer to the type string * stream - file buffer to use * * Outputs: * X-A - pointer to the file variable; NULL for an error * **************************************************************** * freopen start BIN equ 6 file type for BIN files TXT equ 4 file type for TXT files fileType equ 1 file type letter buffStart equ 3 start of the file buffer OSname equ 7 pointer to the GS/OS file name fileBuff equ 11 file buffer to return ; ; initialization ; csubroutine (4:filename,4:type,4:stream),14 phb use our data bank phk plb stz fileBuff the open is not legal, yet stz fileBuff+2 ph4 stream verify that stream exists jsl ~VerifyStream jcs rt2 lda [type] make sure the file type is in ['a','r','w'] and #$00FF sta fileType cmp #'a' beq cl1 cmp #'w' beq cl1 cmp #'r' beq cl1 lda #EINVAL sta >errno brl rt2 ; ; close the old file ; cl1 ldy #FILE_file branch if the file is not a disk file lda [stream],Y bmi cn1 ph4 stream do any pending I/O jsl fflush ldy #FILE_file close the file lda [stream],Y sta clRefNum OSclose cl ldy #FILE_flag if the buffer was allocated by fopen then lda [stream],Y and #_IOMYBUF beq cn1 ldy #FILE_base+2 dispose of the file buffer lda [stream],Y pha dey dey lda [stream],Y pha jsl free ; ; create a GS/OS file name ; cn1 ph4 filename get the length of the name buffer jsl ~osname sta OSname stx OSname+2 ora OSname+2 jeq rt2 ; ; open the file ; lda #TXT we must open a new file - determine it's sta crFileType type by looking for the 'b' designator ldy #1 lda [type],Y and #$00FF cmp #'+' bne nl1 iny lda [type],Y and #$00FF nl1 cmp #'b' bne nl2 lda #BIN sta crFileType nl2 move4 OSname,opName try to open an existing file OSopen op bcc of2 lda fileType if the type is 'r', flag an error cmp #'r' bne of1 errEIO ph4 stream jsr ~ioerror brl rt1 of1 move4 OSname,crPathName create the file OScreate cr bcs errEIO OSopen op open the file bcs errEIO of2 lda fileType if the file type is 'w', reset it cmp #'w' bne ar1 lda opRefNum sta efRefNum OSSet_EOF ef bcs errEIO ; ; fill in the file record ; ar1 ph4 #BUFSIZ get space for the file buffer jsl malloc sta buffStart stx buffStart+2 ora buffStart+2 bne ar3 lda #ENOMEM memory error sta >errno brl rt1 ar3 move4 stream,fileBuff set the file buffer address lda buffStart set the start of the buffer ldy #FILE_base sta [fileBuff],Y iny iny lda buffStart+2 sta [fileBuff],Y ldy #FILE_ptr+2 sta [fileBuff],Y dey dey lda buffStart sta [fileBuff],Y ldy #FILE_size set the buffer size lda #BUFSIZ sta [fileBuff],Y iny iny lda #^BUFSIZ sta [fileBuff],Y ldy #1 set the flags lda [type],Y and #$00FF cmp #'+' bne ar4 lda #_IOFBF+_IORW+_IOMYBUF bra ar6 ar4 lda fileType cmp #'r' beq ar5 lda #_IOFBF+_IOWRT+_IOMYBUF bra ar6 ar5 lda #_IOFBF+_IOREAD+_IOMYBUF ar6 ldy #FILE_flag ldx crFileType cpx #BIN beq ar6a ora #_IOTEXT ar6a sta [fileBuff],Y ldy #FILE_cnt no chars in buffer lda #0 sta [fileBuff],Y iny iny sta [fileBuff],Y ldy #FILE_pbk nothing in the putback buffer lda #$FFFF sta [fileBuff],Y ldy #FILE_pbk+2 sta [fileBuff],Y ldy #FILE_file set the file ID lda opRefNum sta [fileBuff],Y ; ; return the result ; rt1 ph4 OSname dispose of the file name buffer jsl free rt2 plb restore caller's data bank creturn 4:fileBuff return ; ; local data areas ; op dc i'2' parameter block for OSopen opRefNum ds 2 opName ds 4 ef dc i'3' parameter block for OSSet_EOF efRefNum ds 2 dc i'0' dc i4'0' cr dc i'7' parameter block for OScreate crPathName ds 4 dc i'$C3' crFileType ds 2 dc i4'0' dc i'1' dc i4'0' dc i4'0' cl dc i'1' parameter block for OSclose clRefNum ds 2 ; ; Patch for standard out ; stdoutFile jmp stdoutPatch stdoutPatch phb plx ply pla pha pha pha phy phx plb lda >stdout sta 6,S lda >stdout+2 sta 8,S brl fputc ; ; Patch for standard in ; stdinFile jmp stdinPatch stdinPatch ph4 #stdin+4 jsl fgetc rtl end **************************************************************** * * int fprintf(stream, char *format, additional arguments) * * Print the format string to standard out. * **************************************************************** * fprintf start using ~printfCommon phb use local addressing phk plb plx remove the return address ply pla save the stream sta stream pla sta stream+2 phy restore return address/data bank phx plb lda >stream+2 verify that stream exists pha lda >stream pha jsl ~VerifyStream bcc lb1 lda #EIO sta >errno lda #EOF bra rts lb1 lda #put set up output routine sta >~putchar+4 lda #>put sta >~putchar+5 tsc find the argument list address clc adc #8 sta >args pea 0 pha jsl ~printf call the formatter sec compute the space to pull from the stack pla sbc >args clc adc #4 sta >args pla phb remove the return address plx ply tsc update the stack pointer clc adc >args tcs phy restore the return address phx plb lda >~numChars return the value rtl return put phb remove the char from the stack phk plb plx pla ply pha phx plb lda stream+2 write to a file pha lda stream pha phy jsl fputc rts rtl args ds 2 original argument address stream ds 4 stream address end **************************************************************** * * int fputc(c, stream) * char c; * FILE *stream; * * Write a character to a file * * Inputs: * c - character to write * stream - file to write to * * Outputs: * A - character written; EOF for an error * **************************************************************** * fputc start putc entry c2 equ 5 output char p equ 1 work pointer csubroutine (2:c,4:stream),6 ph4 stream verify that stream exists jsl ~VerifyStream bcs lb0 ldy #FILE_flag quit with error if the end of file lda [stream],Y has been reached or an error has been and #_IOEOF+_IOERR encountered beq lb1 lb0 lda #EOF sta c brl pc8 lb1 ldy #FILE_flag if the file is not prepared for lda [stream],Y writing then bit #_IOWRT bne lb2 bit #_IOREAD if it is being read then bne pc2 flag the error ora #_IOWRT set the writting flag sta [stream],Y lb2 ldy #FILE_file branch if this is a disk file lda [stream],Y bpl pc3 cmp #stdoutID if stream = stdout then bne pc1 ph2 c write the character jsl ~stdout brl pc8 pc1 cmp #stderrID else if stream = stderr then bne pc2 lda c (for \n, write \r) cmp #10 bne pc1a lda #13 pc1a pha write to error out jsl SYSCHARERROUT brl pc8 pc2 ph4 stream else stream = stdin; flag the error jsr ~ioerror lda #EOF sta c brl pc8 pc3 lda c set the output char sta c2 ldy #FILE_flag if this is a text file then lda [stream],Y and #_IOTEXT beq pc3a lda c if the char is lf then cmp #10 bne pc3a lda #13 substitute a cr sta c2 pc3a ldy #FILE_cnt if the buffer is full then lda [stream],Y iny iny ora [stream],Y bne pc4 pc3b ldy #FILE_flag purge it lda [stream],Y pha ph4 stream jsl fflush ldy #FILE_flag pla sta [stream],Y pc4 ldy #FILE_ptr deposit the character in the buffer, lda [stream],Y incrementing the buffer pointer sta p clc adc #1 sta [stream],Y iny iny lda [stream],Y sta p+2 adc #0 sta [stream],Y short M lda c2 sta [p] long M ldy #FILE_cnt dec the buffer counter sec lda [stream],Y sbc #1 sta [stream],Y bcs pc5 iny iny lda [stream],Y dec A sta [stream],Y pc5 ldy #FILE_cnt if the buffer is full lda [stream],Y iny iny ora [stream],Y beq pc7 lda c2 or if (c = '\n') and (flag & _IOLBF) cmp #13 beq pc5a cmp #10 bne pc6 pc5a ldy #FILE_flag lda [stream],Y and #_IOLBF bne pc7 pc6 ldy #FILE_flag or is flag & _IONBF then lda [stream],Y and #_IONBF beq pc8 pc7 ldy #FILE_flag flush the stream lda [stream],Y pha ph4 stream jsl fflush ldy #FILE_flag pla sta [stream],Y pc8 creturn 2:c end **************************************************************** * * int fputs(s,stream) * char *s; * * Print the string to standard out. * **************************************************************** * fputs start err equ 1 return code csubroutine (4:s,4:stream),2 ph4 stream verify that stream exists jsl ~VerifyStream lda #EOF sta err bcs lb4 stz err no error so far bra lb2 skip initial increment lb1 inc4 s next char lb2 ph4 stream push the stream, just in case... lda [s] exit loop if at end of string and #$00FF beq lb3 pha push char to write jsl fputc write the character cmp #EOF loop if no error bne lb1 sta err set the error code bra lb4 lb3 pla remove stream from the stack pla lb4 creturn 2:err end **************************************************************** * * size_t fread(ptr, element_size, count, stream) * void *ptr; * size_t element_size; * size_t count; * FILE *stream; * * Reads element*count bytes to stream, putting the bytes in * ptr. * * Inputs: * ptr - location to store the bytes read * element_size - size of each element * count - number of elements * stream - file to read from * * Outputs: * Returns the number of elements actually read. * **************************************************************** * fread start temp equ 1 csubroutine (4:ptr,4:element_size,4:count,4:stream),4 phb phk plb stz rdTransferCount set the # of elements read stz rdTransferCount+2 ph4 stream verify that stream exists jsl ~VerifyStream jcs lb6 ph4 stream reset file pointer jsl ~SetFilePointer mul4 element_size,count,rdRequestCount set the # of bytes lda rdRequestCount quit if the request count is 0 ora rdRequestCount+2 jeq lb6 ldy #FILE_file set the file ID number lda [stream],Y bpl lb2 branch if it is a file cmp #stdinID if the file is stdin then jne lb6 stz rdTransferCount stz rdTransferCount+2 lda >stdin+4+FILE_flag and #_IOEOF jne lb6 lb1 jsl SYSKEYIN read the bytes tax branch if not eof bne lb1a lda #_IOEOF set EOF flag ora >stdin+4+FILE_flag sta >stdin+4+FILE_flag jsl SYSKEYIN read the closing cr brl lb6 lb1a short M set character sta [ptr] long M inc4 rdTransferCount inc4 ptr dec4 rdRequestCount lda rdRequestCount ora rdRequestCount+2 bne lb1 bra lb6 lb2 sta rdRefNum set the reference number move4 ptr,rdDataBuffer set the start address OSRead rd read the bytes bcc lb5 cmp #$4C if the error was $4C then bne lb3 jsr SetEOF set the EOF flag bra lb5 lb3 ph4 stream I/O error jsr ~ioerror ! set the # records read lb5 div4 rdTransferCount,element_size lda count if there were too few elements read then cmp rdTransferCount bne lb5a lda count+2 cmp rdTransferCount+2 beq lb6 lb5a jsr SetEOF set the EOF flag lb6 move4 rdTransferCount,temp plb creturn 4:temp ; ; Local data ; rd dc i'5' parameter block for OSRead rdRefNum ds 2 rdDataBuffer ds 4 rdRequestCount ds 4 rdTransferCount ds 4 dc i'1' ; ; Set the EOF flag ; SetEOF ldy #FILE_flag set the eof flag lda [stream],Y ora #_IOEOF sta [stream],Y rts end **************************************************************** * * int fscanf(stream, format, additional arguments) * char *format; * FILE *stream; * * Read a string from a string. * **************************************************************** * fscanf start using ~scanfCommon phb use local addressing phk plb plx remove the return address ply pla save the stream sta stream pla sta stream+2 phy restore return address/data bank phx plb ph4 >stream verify that stream exists jsl ~VerifyStream bcc lb1 lda #EOF rtl lb1 lda #get set up our routines sta >~getchar+10 lda #>get sta >~getchar+11 lda #unget sta >~putback+12 lda #>unget sta >~putback+13 brl ~scanf get ph4 stream get a character jsl fgetc rtl unget ldx stream+2 put a character back phx ldx stream phx pha jsl ungetc rtl stream ds 4 end **************************************************************** * * int fseek(stream,offset,wherefrom) * FILE *stream; * long int offset; * int wherefrom; * * Change the read/write location for the stream. * * Inputs: * stream - file to change * offset - position to move to * wherefrom - move relative to this location * * Outputs: * Returns non-zero for error * **************************************************************** * fseek start jmp __fseek end __fseek start err equ 1 return value csubroutine (4:stream,4:offset,2:wherefrom),2 phb phk plb lda #-1 assume we will get an error sta err ph4 stream verify that stream exists jsl ~VerifyStream jcs rts ph4 stream purge the file jsl fflush ldy #FILE_file set the file reference lda [stream],Y jmi lb6 sta gpRefNum sta spRefNum lda wherefrom if position is relative to the end then cmp #SEEK_END bne lb2 OSGet_EOF gp get the eof jcs erEIO add4 offset,gpPosition add it to the offset bra lb3 lb2 cmp #SEEK_CUR else if relative to current position then bne lb3 ph4 stream get the current position jsl ftell clc add it to the offset adc offset sta offset txa adc offset+2 sta offset+2 lb3 OSGet_EOF gp get the end of the file jcs erEIO lda offset+2 if the offset is >= EOF then cmp gpPosition+2 bne lb4 lda offset cmp gpPosition lb4 ble lb5 move4 offset,spPosition extend the file OSSet_EOF sp bcs erEIO lb5 move4 offset,spPosition OSSet_Mark sp bcs erEIO lb6 ldy #FILE_flag clear the EOF , READ, WRITE flags lda #$FFFF-_IOEOF-_IOREAD-_IOWRT and [stream],Y sta [stream],Y ldy #FILE_cnt clear the character count lda #0 sta [stream],Y iny iny sta [stream],Y ldy #FILE_base+2 reset the file pointer lda [stream],Y tax dey dey lda [stream],Y ldy #FILE_ptr sta [stream],Y iny iny txa sta [stream],Y ldy #FILE_pbk nothing in the putback buffer lda #$FFFF sta [stream],Y ldy #FILE_pbk+2 sta [stream],Y stz err rts plb creturn 2:err erEIO ph4 stream flag an IO error jsr ~ioerror bra rts gp dc i'2' parameter block for OSGet_EOF gpRefNum ds 2 gpPosition ds 4 sp dc i'3' parameter block for OSSet_EOF spRefNum ds 2 and OSSet_Mark dc i'0' spPosition ds 4 end **************************************************************** * * int fsetpos(FILE *stream, fpos_t *pos); * * Inputs: * stream - pointer to stream to set position of * pos - pointer to location to set position * * Outputs: * A - 0 if successful; else -1 if not * errno - if unsuccessful, errno is set to EIO * **************************************************************** * fsetpos start err equ 1 error code csubroutine (4:stream,4:pos),2 ph2 #SEEK_SET ldy #2 lda [pos],Y pha lda [pos] pha ph4 stream jsl fseek sta err creturn 2:err end **************************************************************** * * long int ftell(stream) * FILE *stream; * * Find the number of characters already passed in the file. * * Inputs: * stream - strem to find the location in * * Outputs: * Returns the position, or -1L for an error. * **************************************************************** * ftell start pos equ 1 position in the file csubroutine (4:stream),4 phb phk plb lda #-1 assume an error sta pos sta pos+2 ph4 stream verify that stream exists jsl ~VerifyStream jcs rts ldy #FILE_flag if the file is being written then lda [stream],Y bit #_IOWRT beq lb0 ph4 stream do any pending writes jsl fflush tax bne rts lb0 ldy #FILE_file get the file's mark lda [stream],Y sta gmRefNum OSGet_Mark gm bcc lb1 ph4 stream jsr ~ioerror bra rts lb1 move4 gmPosition,pos set the position ldy #FILE_flag if the file is being read then lda [stream],Y bit #_IOREAD beq rts sec subtract off characters left to be ldy #FILE_cnt read lda pos sbc [stream],Y sta pos iny iny lda pos+2 sbc [stream],Y sta pos+2 ldy #FILE_pbk dec pos by 1 for each char in the lda [stream],Y putback buffer then bmi lb2 dec4 pos ldy #FILE_pbk+2 lda [stream],Y bmi lb2 dec4 pos lb2 ldy #FILE_file set the file's mark lda [stream],Y sta spRefNum move4 pos,spPosition OSSet_Mark sp rts plb creturn 4:pos sp dc i'3' parameter block for OSSet_Mark spRefNum ds 2 dc i'0' spPosition ds 4 gm dc i'2' parameter block for OSGetMark gmRefNum ds 2 gmPosition ds 4 end **************************************************************** * * size_t fwrite(ptr, element_size, count, stream) * void *ptr; * size_t element_size; * size_t count; * FILE *stream; * * Writes element*count bytes to stream, taking the bytes from * ptr. * * Inputs: * ptr - pointer to the bytes to write * element_size - size of each element * count - number of elements * stream - file to write to * * Outputs: * Returns the number of elements actually written. * **************************************************************** * fwrite start csubroutine (4:ptr,4:element_size,4:count,4:stream),0 phb phk plb stz wrTransferCount set the # of elements written stz wrTransferCount+2 ph4 stream verify that stream exists jsl ~VerifyStream jcs lb6 mul4 element_size,count,wrRequestCount set the # of bytes lda wrRequestCount quit if the request count is 0 ora wrRequestCount+2 jeq lb6 ldy #FILE_file set the file ID number lda [stream],Y bpl lb4 branch if it is a file cmp #stdoutID if the file is stdout then bne lb2 lb1 lda [ptr] write the bytes pha jsl ~stdout inc4 ptr dec4 wrRequestCount lda wrRequestCount ora wrRequestCount+2 bne lb1 move4 count,wrTransferCount set the # of elements written bra lb6 lb2 cmp #stderrID if the file is stderr then bne lb6 lb3 lda [ptr] write the bytes pha jsl SYSCHARERROUT inc4 ptr dec4 wrRequestCount lda wrRequestCount ora wrRequestCount+2 bne lb3 move4 count,wrTransferCount set the # of elements written bra lb6 lb4 sta wrRefNum set the reference number ph4 stream purge the file jsl fflush move4 ptr,wrDataBuffer set the start address OSWrite wr write the bytes bcc lb5 ph4 stream I/O error jsr ~ioerror ! set the # records written lb5 div4 wrTransferCount,element_size,count lb6 plb creturn 4:count return wr dc i'4' parameter block for OSWrite wrRefNum ds 2 wrDataBuffer ds 4 wrRequestCount ds 4 wrTransferCount ds 4 end **************************************************************** * * int getchar() * * Read a character from standard in. No errors are possible. * * The character read is returned in A. The null character * is mapped into EOF. * **************************************************************** * getchar start ; ; Determine which method to use ; lda >stdin use fgetc if stdin has changed cmp #stdin+4 bne fl1 lda >stdin+2 cmp #^stdin+4 bne fl1 lda >stdin+4+FILE_file use fgetc if stdio has a bogus file ID cmp #stdinID bne fl1 ; ; get the char from the keyboard ; lda >stdin+4+FILE_pbk if there is a char in the putback bmi lb1 buffer then and #$00FF save it in X tax lda >stdin+4+FILE_pbk+2 pop the buffer sta >stdin+4+FILE_pbk lda #$FFFF sta >stdin+4+FILE_pbk+2 txa restore the char bra lb2 lb1 jsl SYSKEYIN else get a char from the keyboard tax branch if not eof bne lb2 lda #_IOEOF set EOF flag ora >stdin+4+FILE_flag sta >stdin+4+FILE_flag jsl SYSKEYIN read the closing cr lda #EOF return EOF lb2 cmp #13 if the char is \r then bne lb3 lda #10 return \n lb3 rtl ; ; Call fgetc ; fl1 ph4 >stdin dc i1'$22',s3'fgetc' jsl fgetc rtl end **************************************************************** * * char *gets(s) * char s; * * Read a line from standard in. * * Inputs: * s - string to read to. * * Outputs: * Returns a pointer to the string * **************************************************************** * gets start LF equ 10 \n key code disp equ 1 disp in s csubroutine (4:s),2 stz disp no characters processed so far lb1 jsl getchar get a character tax quit with error if it is an EOF bpl lb2 stz s stz s+2 bra rts lb2 cmp #LF quit if it was a \n beq lb3 ldy disp place the char in the string sta [s],Y inc disp bra lb1 next character lb3 ldy disp null terminate short M lda #0 sta [s],Y long M rts creturn 4:s end **************************************************************** * * void perror(s); * char *s; * * Prints the string s and the error in errno to standard out. * **************************************************************** * perror start maxErr equ ENOSPC max error in sys_errlist s equ 4 string address tsc set up DP addressing phd tcd ph4 >stderr write the error string ph4 s jsl fputs ph4 >stderr write ': ' pea ':' jsl fputc ph4 >stderr pea ' ' jsl fputc ph4 >stderr write the error message lda >errno cmp #maxErr+1 blt lb1 lda #0 lb1 asl A asl A tax lda >sys_errlist+2,X pha lda >sys_errlist,X pha jsl fputs ph4 >stderr write lf, cr pea 10 jsl fputc ph4 >stderr pea 13 jsl fputc pld remove parm and return lda 2,S sta 6,S pla sta 3,S pla rtl end **************************************************************** * * int printf(format, additional arguments) * char *format; * * Print the format string to standard out. * **************************************************************** * printf start using ~printfCommon lda #putchar sta >~putchar+4 lda #>putchar sta >~putchar+5 tsc find the argument list address clc adc #8 sta >args pea 0 pha jsl ~printf call the formatter sec compute the space to pull from the stack pla sbc >args clc adc #4 sta >args pla phb remove the return address plx ply tsc update the stack pointer clc adc >args tcs phy restore the return address phx plb lda >~numChars return the value rtl return args ds 2 original argument address end **************************************************************** * * int putchar(c) * char c; * * Print the character to standard out. The character is * returned. No errors are possible. * * The character \n is automatically followed by a $0D, which * causes the IIGS to respond the way \n works on other machines. * **************************************************************** * putchar start using ~printfCommon _n equ 10 linefeed character _r equ 13 RETURN key code ; ; Determine which method to use ; lda >stdout use fgetc if stdin has changed cmp #stdout+4 bne fl1 lda >stdout+1 cmp #>stdout+4 bne fl1 lda >stdout+4+FILE_file use fgetc if stdio has a bogus file ID cmp #stdoutID bne fl1 ; ; Write to the CRT ; ~stdout entry php remove the parameter from the stack plx ply pla phy phx plp pha save the parameter cmp #_n if this is a line feed, do a bne lb1 carriage return, instead. lda #_r lb1 pha write the character jsl SYSCHAROUT pla return the input character rtl ; ; Use fputc ; fl1 ph4 >stdout lda 8,S pha dc i1'$22' jsl fputc dc s3'fputc' phb plx ply pla phy phx plb rtl end **************************************************************** * * int puts(s) * char *s; * * Print the string to standard out. A zero is returned; no * error is possible. * **************************************************************** * puts start LINEFEED equ 10 linefeed character err equ 1 erro code csubroutine (4:s),2 stz err no error lb1 lda [s] print the string and #$00FF beq lb2 pha jsl putchar inc4 s bra lb1 lb2 pea LINEFEED print the linefeed jsl putchar creturn 2:err end **************************************************************** * * int remove(filename) * char *filename; * * Inputs: * filename - name of the file to delete * * Outputs: * Returns zero if successful, GS/OS error code if not. * **************************************************************** * remove start err equ 1 return code csubroutine (4:filename),2 phb phk plb ph4 filename convert to a GS/OS file name jsl ~osname sta dsPathName stx dsPathName+2 ora dsPathName+2 bne lb1 lda #$FFFF sta err bra lb2 lb1 OSDestroy ds delete the file sta err set the error code bcc lb1a lda #ENOENT sta >errno lb1a ph4 dsPathName dispose of the name buffer jsl free lb2 plb creturn 2:err ds dc i'1' parameter block for OSDestroy dsPathName ds 4 end **************************************************************** * * int rename(oldname,newname) * char *filename; * * Inputs: * filename - name of the file to delete * * Outputs: * Returns zero if successful, GS/OS error code if not. * **************************************************************** * rename start err equ 1 return code csubroutine (4:oldname,4:newname),2 phb phk plb ph4 oldname convert oldname to a GS/OS file name jsl ~osname sta cpPathName stx cpPathName+2 ora cpPathName+2 bne lb1 lda #$FFFF sta err bra lb4 lb1 ph4 newname convert newname to a GS/OS file name jsl ~osname sta cpNewPathName stx cpNewPathName+2 ora cpNewPathName+2 bne lb2 lda #$FFFF sta err bra lb3 lb2 OSChange_Path cp rename the file sta err set the error code ph4 cpNewPathName dispose of the new name buffer jsl free lb3 ph4 cpPathName dispose of the old name buffer jsl free lb4 plb creturn 2:err cp dc i'2' parameter block for OSChange_Path cpPathName ds 4 cpNewPathName ds 4 end **************************************************************** * * int rewind(stream) * FILE *stream; * * Change the read/write location for the stream. * * Inputs: * stream - file to change * * Outputs: * Returns non-zero for error * **************************************************************** * rewind start err equ 1 return code csubroutine (4:stream),2 ph2 #SEEK_SET ph4 #0 ph4 stream jsl __fseek sta err creturn 2:err end **************************************************************** * * int scanf(format, additional arguments) * char *format; * * Read a string from standard in. * **************************************************************** * scanf start using ~scanfCommon lda #getchar sta >~getchar+10 lda #>getchar sta >~getchar+11 lda #unget sta >~putback+12 lda #>unget sta >~putback+13 brl ~scanf unget tax lda >stdin+2 pha lda >stdin pha phx jsl ungetc rtl end **************************************************************** * * int setbuf (FILE *stream, char *) * * Set the buffer type and size. * * Inputs: * stream - file to set the buffer for * buf - buffer to use, or NULL for automatic buffer * * Outputs: * Returns zero if successful, -1 for an error * **************************************************************** * setbuf start err equ 1 return code csubroutine (4:stream,4:buf),2 lda buf ora buf+2 bne lb1 ph4 #0 ph2 #_IONBF bra lb2 lb1 ph4 #BUFSIZ ph2 #_IOFBF lb2 ph4 buf ph4 stream jsl __setvbuf sta err creturn 2:err end **************************************************************** * * int setvbuf(stream,buf,type,size) * FILE *stream; * char *buf; * int type,size; * * Set the buffer type and size. * * Inputs: * stream - file to set the buffer for * buf - buffer to use, or NULL for automatic buffer * type - buffer type; _IOFBF, _IOLBF or _IONBF * size - size of the buffer * * Outputs: * Returns zero if successful, -1 for an error * **************************************************************** * setvbuf start jmp __setvbuf end __setvbuf start err equ 1 return code csubroutine (4:stream,4:buf,2:type,4:size),2 phb phk plb lda #-1 assume we will get an error sta err ph4 stream verify that stream exists jsl ~VerifyStream jcs rts ldy #FILE_ptr make sure the buffer is not in use lda [stream],Y ldy #FILE_base cmp [stream],Y jne rts ldy #FILE_ptr+2 lda [stream],Y ldy #FILE_base+2 cmp [stream],Y jne rts cb1 lda size if size is zero then ora size+2 bne lb1 lda type if ~(type & _IONBF) then and #_IONBF jeq rts flag the error inc size else size = 1 lb1 lda type error if type is not one of these cmp #_IOFBF beq lb2 cmp #_IOLBF beq lb2 cmp #_IONBF bne rts lb2 lda buf if the buffer is not supplied by the ora buf+2 caller then bne sb1 ph4 size allocate a buffer jsl malloc sta buf stx buf+2 ora buf+2 quit if there was no memory beq rts lda type set the buffer flag ora #_IOMYBUF sta type sb1 ldy #FILE_flag if the buffer was allocated by fopen then lda [stream],Y bit #_IOMYBUF beq sb2 ldy #FILE_base+2 dispose of the old buffer lda [stream],Y pha dey dey lda [stream],Y pha jsl free sb2 ldy #FILE_flag clear the old buffering flags lda #$FFFF-_IOFBF-_IOLBF-_IONBF-_IOMYBUF and [stream],Y ora type set the new buffer flag sta [stream],Y lda buf set the start of the buffer ldy #FILE_base sta [stream],Y iny iny lda buf+2 sta [stream],Y ldy #FILE_ptr+2 sta [stream],Y dey dey lda buf sta [stream],Y ldy #FILE_size set the buffer size lda size sta [stream],Y iny iny lda size+2 sta [stream],Y ldy #FILE_cnt no chars in buffer lda #0 sta [stream],Y iny iny sta [stream],Y stz err no error rts plb creturn 2:err end **************************************************************** * * int sprintf(s, format, additional arguments) * char *format; * * Print the format string to a string. * **************************************************************** * sprintf start using ~printfCommon phb use local addressing phk plb plx remove the return address ply pla save the stream sta string pla sta string+2 phy restore return address/data bank phx plb lda #put set up output routine sta >~putchar+4 lda #>put sta >~putchar+5 tsc find the argument list address clc adc #8 sta >args pea 0 pha jsl ~printf call the formatter sec compute the space to pull from the stack pla sbc >args clc adc #4 sta >args pla phb remove the return address plx ply tsc update the stack pointer clc adc >args tcs phy restore the return address phx plb lda >~numChars return the value rtl return put phb remove the char from the stack plx pla ply pha phx plb ldx string+2 write to a file phx ldx string phx phd tsc tcd tya and #$00FF sta [3] pld pla pla phb phk plb inc4 string plb rtl args ds 2 original argument address string ds 4 string address end **************************************************************** * * int sscanf(s, format, additional arguments) * char *s, *format; * * Read a string from a string. * **************************************************************** * sscanf start using ~scanfCommon phb use local addressing phk plb plx remove the return address ply pla save the stream sta string pla sta string+2 phy restore return address/data bank phx plb lda #get set up our routines sta >~getchar+10 lda #>get sta >~getchar+11 lda #unget sta >~putback+12 lda #>unget sta >~putback+13 brl ~scanf get ph4 string get a character phd tsc tcd lda [3] and #$00FF bne gt1 dec4 string lda #EOF gt1 pld ply ply inc4 string rtl unget cmp #EOF put a character back beq ug1 dec4 string ug1 rtl string ds 4 end **************************************************************** * * sys_errlist - array of pointers to messages * **************************************************************** * sys_errlist start dc a4'EUNDEF' 0th message is undefined dc a4'EDOM' (if the size of this list changes, dc a4'ERANGE' change sys_nerr in VARS.ASM) dc a4'ENOMEM' dc a4'ENOENT' dc a4'EIO' dc a4'EINVAL' dc a4'EBADF' dc a4'EMFILE' dc a4'EACCESS' dc a4'EEXISTS' dc a4'ENOSPC' ! Note: if more errors are added, change maxErr in perror(). EUNDEF cstr 'invalid error number' EDOM cstr 'domain error' ERANGE cstr '# too large, too small, or illegal' ENOMEM cstr 'not enough memory' ENOENT cstr 'no such file or directory' EIO cstr 'I/O error' EINVAL cstr 'invalid argument' EBADF cstr 'bad file descriptor' EMFILE cstr 'too many files are open' EACCESS cstr 'access bits prevent the operation' EEXISTS cstr 'the file exists' ENOSPC cstr 'the file is too large' end **************************************************************** * * char *tmpnam(buf) * char *buf; * * Inputs: * buf - Buffer to write the name to. Buf is assumed to * be at least L_tmpnam characters long. It may be * NULL, in which case the name is not written to * a buffer. * * Outputs: * Returns a pointer to the name, which is changed on the * next call to tmpnam or tmpfile. * * Notes: * If the work prefix is set, and is less than or equal * to 15 characters in length, the file name returned is * in the work prefix (3); otherwise, it is a partial path * name. * **************************************************************** * tmpnam start csubroutine (4:buf),0 phb phk plb lb1 OSGet_Prefix pr get the prefix bcc lb2 stz name+2 lb2 short M ldx name+2 stz cname,X ldx #7 update the file number lb3 inc syscxxxx,X lda syscxxxx,X cmp #'9'+1 bne lb4 lda #'0' sta syscxxxx,X dex cpx #3 bne lb3 lb4 long M append the two strings ph4 #syscxxxx ph4 #cname jsl strcat ph4 #cname if the file exists then jsl strlen sta name+2 OSGet_File_Info GIParm bcc lb1 get a different name lda buf if buf != NULL then ora buf+2 beq lb5 ph4 #cname move the string ph4 buf jsl strcpy lb5 lla buf,cname return the string pointer plb creturn 4:buf pr dc i'2' parameter block for OSGet_Prefix dc i'3' dc a4'name' name dc i'16,0' GS/OS name buffer cname ds 26 part of name; also C buffer GS_OSname dc i'8' used for OSGet_File_Info syscxxxx dc c'SYSC0000',i1'0' for creating unique names GIParm dc i'2' used to see if the file exists dc a4'name+2' dc i'0' end **************************************************************** * * FILE *tmpfile() * * Outputs: * Returns a pointer to a temp file; NULL for error. * **************************************************************** * tmpfile start f equ 1 file pointer csubroutine ,4 ph4 #type open a file with a temp name ph4 #0 jsl tmpnam phx pha jsl fopen sta f stx f+2 ora f+2 if sucessful then beq lb1 ldy #FILE_flag f->_flag |= _IOTEMPFILE lda [f],Y ora #_IOTEMPFILE sta [f],Y lb1 creturn 4:f type cstr 'w+b' end **************************************************************** * * int ungetc(c, stream) * char c; * FILE *stream; * * Return a character to the input stream. * * Inputs: * c - character to return * stream - stream to put it back in * * Outputs: * Returns EOF if the attempt was unsuccessful; c if the * attempt succeeded. * **************************************************************** * ungetc start char equ 1 characater to return csubroutine (2:c,4:stream),2 lda #EOF assume we will fail sta char ldy #FILE_flag error if the file is open for output lda [stream],Y bit #_IOWRT bne rts lda c error if EOF is pushed cmp #EOF beq rts ldy #FILE_pbk+2 error if the buffer is full lda [stream],Y bpl rts ldy #FILE_pbk push the old character (if any) lda [stream],Y ldy #FILE_pbk+2 sta [stream],Y ldy #FILE_pbk put back the character lda c and #$00FF sta [stream],Y sta char rts long M creturn 2:char end **************************************************************** * * int vfprintf(stream, char *format, va_list arg) * * Print the format string to standard out. * **************************************************************** * vfprintf start using ~printfCommon phb use local addressing phk plb plx remove the return address ply pla save the stream sta stream pla sta stream+2 phy restore return address/data bank phx plb lda >stream+2 verify that stream exists pha lda >stream pha jsl ~VerifyStream bcc lb1 lda #EIO sta >errno lda #EOF bra rts lb1 lda #put set up output routine sta >~putchar+4 lda #>put sta >~putchar+5 phd find the argument list address tsc tcd lda [10] pld pea 0 pha jsl ~printf call the formatter ply update the argument list pointer plx phd tsc tcd tya sta [10] pld phb remove the return address plx ply tsc update the stack pointer clc adc #8 tcs phy restore the return address phx plb lda >~numChars return the value rtl return put phb remove the char from the stack phk plb plx pla ply pha phx plb lda stream+2 write to a file pha lda stream pha phy jsl fputc rts rtl stream ds 4 stream address end **************************************************************** * * int vprintf (const char *format, va_list arg) * * Print the format string to standard out. * **************************************************************** * vprintf start using ~printfCommon lda #putchar set up the output hooks sta >~putchar+4 lda #>putchar sta >~putchar+5 phd find the argument list address tsc tcd lda [10] pld pea 0 pha jsl ~printf call the formatter ply update the argument list pointer plx phd tsc tcd tya sta [10] pld phb remove the return address plx ply tsc update the stack pointer clc adc #8 tcs phy restore the return address phx plb lda >~numChars return the value rtl return end **************************************************************** * * int vsprintf(char *s, char *format, va_list arg) * * Print the format string to a string. * **************************************************************** * vsprintf start using ~printfCommon phb use local addressing phk plb plx remove the return address ply pla save the stream sta string pla sta string+2 phy restore return address/data bank phx plb lda #put set up output routine sta >~putchar+4 lda #>put sta >~putchar+5 phd find the argument list address tsc tcd lda [10] pld pea 0 pha jsl ~printf call the formatter ply update the argument list pointer plx phd tsc tcd tya sta [10] pld phb remove the return address plx ply tsc update the stack pointer clc adc #8 tcs phy restore the return address phx plb lda >~numChars return the value rtl return put phb remove the char from the stack plx pla ply pha phx plb ldx string+2 write to a file phx ldx string phx phd tsc tcd tya and #$00FF sta [3] pld pla pla phb phk plb inc4 string plb rtl string ds 4 string address end **************************************************************** * * ~Format_c - format a '%' character * * Inputs: * ~fieldWidth - output field width * ~paddChar - padd character * ~leftJustify - left justify the output? * **************************************************************** * ~Format_c private using ~printfCommon argp equ 7 argument pointer dec ~fieldWidth account for the width of the value jsr ~RightJustify handle right justification lda [argp] print the character pha jsl ~putchar inc argp remove the parameter from the stack inc argp brl ~LeftJustify handle left justification end **************************************************************** * * ~Format_d - format a signed decimal number * ~Format_u - format an unsigned decimal number * * Inputs: * ~fieldWidth - output field width * ~paddChar - padd character * ~leftJustify - left justify the output? * ~isLong - is the operand long? * ~precision - precision of output * ~precisionSpecified - was the precision specified? * ~sign - char to use for positive sign * * Note: The ~Format_IntOut entry point is used by other number * formatting routines to write their number strings. * **************************************************************** * ~Format_d private using ~printfCommon argp equ 7 argument pointer ; ; For signed numbers, if the value is negative, use the sign flag ; lda ~isLong handle long values beq sn1 ldy #2 lda [argp],Y bpl cn0 sec lda #0 sbc [argp] sta [argp] lda #0 sbc [argp],Y sta [argp],Y bra sn2 sn1 lda [argp] handle int values bpl cn0 eor #$FFFF inc a sta [argp] sn2 lda #'-' sta ~sign ~Format_u entry ; ; Convert the number to an ASCII string ; cn0 stz ~hexPrefix don't lead with 0x lda ~isLong if the value is long then beq cn1 ldy #2 push a long value lda [argp],Y pha ! lda [argp] ! pha ! bra cn2 else cn1 lda [argp] push an int value pha cn2 ph4 #~str push the string addr ph2 #l:~str push the string buffer length ph2 #0 do an unsigned conversion lda ~isLong do the proper conversion beq cn3 _Long2Dec bra pd1 cn3 _Int2Dec ; ; Padd with the proper number of zeros ; ~Format_IntOut entry pd1 lda ~precisionSpecified if the precision was not specified then bne pd2 lda #1 use a precision of 1 sta ~precision pd2 ldx ~precision if the precision is zero then bne pd2a lda ~str+l:~str-2 if the result is ' 0' then cmp #'0 ' bne dp0 lda #' ' set the result to the null string sta ~str+l:~str-2 stz ~hexPrefix erase any hex prefix bra dp0 pd2a ldy #0 skip leading blanks short M lda #' ' pd3 cmp ~str,Y bne pd4 iny cpy #l:~str bne pd3 bra pd6 pd4 cmp ~str,Y deduct any characters from the precision beq pd5 dex beq pd5 iny cpy #l:~str bne pd4 pd5 stx ~precision pd6 long M ; ; Determine the padding and do left padding ; dp0 sub2 ~fieldWidth,~precision subtract off any remaining 0 padds lda ~sign if the sign is non-zero, allow for it beq dp1 dec ~fieldWidth dp1 lda ~hexPrefix if there is a hex prefix, allow for it beq dp1a dec ~fieldWidth dec ~fieldWidth dp1a ldx #0 determine the length of the buffer ldy #l:~str-1 short M lda #' ' dp2 cmp ~str,Y beq dp3 inx dey bpl dp2 dp3 long M sec subtract it from ~fieldWidth txa sbc ~fieldWidth eor #$FFFF inc a sta ~fieldWidth lda ~paddChar skip justification if we are padding cmp #'0' beq pn0 jsr ~RightJustify handle right justification ; ; Print the number ; pn0 lda ~sign if there is a sign character then beq pn1 pha print it jsl ~putchar pn1 lda ~hexPrefix if there is a hex prefix then beq pn1a pha print it jsl ~putchar ph2 ~hexPrefix+1 jsl ~putchar pn1a lda ~paddChar if the number needs 0 padding then cmp #'0' bne pn1c lda ~fieldWidth bmi pn1c beq pn1c pn1b ph2 ~paddChar print padd zeros jsl ~putchar dec ~fieldWidth bne pn1b pn1c lda ~precision if the number needs more padding then beq pn3 pn2 ph2 #'0' print padd characters jsl ~putchar dec ~precision bne pn2 pn3 ldy #-1 skip leading blanks in the number pn4 iny lda ~str,Y and #$00FF cmp #' ' beq pn4 pn5 cpy #l:~str quit if we're at the end of the ~str beq rn1 phy save Y lda ~str,Y print the character and #$00FF pha jsl ~putchar ply next character iny bra pn5 ; ; remove the number from the argument list ; rn1 lda ~isLong beq rn2 inc argp inc argp rn2 inc argp inc argp ; ; Handle left justification ; brl ~LeftJustify handle left justification end **************************************************************** * * ~Format_n - return the number of characters printed * * Inputs: * ~numChars - characters written * ~isLong - is the operand long? * **************************************************************** * ~Format_n private using ~printfCommon argp equ 7 argument pointer ph4 argp save the original argp ldy #2 dereference argp lda [argp],Y tax lda [argp] sta argp stx argp+2 lda ~numChars return the value sta [argp] lda ~isLong if long, set the high word beq lb1 ldy #2 lda #0 sta [argp],Y lb1 clc restore the original argp+4 pla adc #4 sta argp pla sta argp+2 rts end **************************************************************** * * ~Format_o - format an octal number * * Inputs: * ~altForm - use a leading '0'? * ~fieldWidth - output field width * ~paddChar - padd character * ~leftJustify - left justify the output? * ~isLong - is the operand long? * ~precision - precision of output * ~precisionSpecified - was the precision specified? * **************************************************************** * ~Format_o private using ~printfCommon argp equ 7 argument pointer ; ; Initialization ; stz ~sign ignore the sign flag lda #' ' initialize the string to blanks sta ~str move ~str,~str+1,#l:~str-1 stz ~num+2 get the value to convert lda ~isLong beq cn2 ldy #2 lda [argp],Y sta ~num+2 cn2 lda [argp] sta ~num ; ; Convert the number to an ASCII string ; short I,M ldy #l:~str-1 set up the character index cn3 lda ~num+3 quit if the number is zero ora ~num+2 ora ~num+1 ora ~num beq al1 lda #0 roll off 3 bits ldx #3 cn4 lsr ~num+3 ror ~num+2 ror ~num+1 ror ~num ror A dex bne cn4 lsr A form a character lsr A lsr A lsr A lsr A ora #'0' sta ~str,Y save the character dey bra cn3 ; ; If a leading zero is required, be sure we include one ; al1 cpy #l:~str-1 include a zero if no characters have beq al2 been placed in the string lda ~altForm branch if no leading zero is required beq al3 al2 lda #'0' sta ~str,Y al3 long I,M ; ; Piggy back off of ~Format_d for output ; stz ~hexPrefix don't lead with 0x brl ~Format_IntOut end **************************************************************** * * ~Format_s - format a c-string * ~Format_b - format a p-string * * Inputs: * ~fieldWidth - output field width * ~paddChar - padd character * ~leftJustify - left justify the output? * **************************************************************** * ~Format_s private using ~printfCommon argp equ 7 argument pointer ph4 argp save the original argp ldy #2 dereference argp lda [argp],Y tax lda [argp] sta argp stx argp+2 short M determine the length of the string ldy #-1 lb1 iny lda [argp],Y bne lb1 long M tya bra lb1a ~Format_b entry ph4 argp save the original argp ldy #2 dereference argp lda [argp],Y tax lda [argp] sta argp stx argp+2 lda [argp] get the length of the string and #$00FF inc4 argp lb1a ldx ~precisionSpecified if the precision is specified then beq lb2 cmp ~precision if the precision is smaller then blt lb2 lda ~precision process only precision characters lb2 sta ~num save the length in the temp variable area sub2 ~fieldWidth,~num account for the width of the value jsr ~RightJustify handle right justification ldx ~num skip printing if the length is 0 beq lb4 ldy #0 print the characters lb3 phy lda [argp],Y and #$00FF pha jsl ~putchar ply iny dec ~num bne lb3 lb4 clc restore and increment argp pla adc #4 sta argp pla sta argp+2 brl ~LeftJustify handle left justification end **************************************************************** * * ~Format_x - format a hexadecimal number (lowercase output) * ~Format_X - format a hexadecimal number (uppercase output) * ~Format_p - format a pointer * * Inputs: * ~altForm - use a leading '0x'? * ~fieldWidth - output field width * ~paddChar - padd character * ~leftJustify - left justify the output? * ~isLong - is the operand long? * ~precision - precision of output * ~precisionSpecified - was the precision specified? * **************************************************************** * ~Format_x private using ~printfCommon argp equ 7 argument pointer ; ; Set the "or" value; this is used to set the case of character results ; lda #$20 sta orVal bra cn0 ~Format_p entry lda #1 sta ~isLong ~Format_X entry stz orVal ; ; Initialization ; cn0 stz ~sign ignore the sign flag lda #' ' initialize the string to blanks sta ~str move ~str,~str+1,#l:~str-1 stz ~num+2 get the value to convert lda ~isLong beq cn2 ldy #2 lda [argp],Y sta ~num+2 cn2 lda [argp] sta ~num stz ~hexPrefix assume we won't lead with 0x ; ; Convert the number to an ASCII string ; short I,M ldy #l:~str-1 set up the character index cn3 lda #0 roll off 4 bits ldx #4 cn4 lsr ~num+3 ror ~num+2 ror ~num+1 ror ~num ror A dex bne cn4 lsr A form a character lsr A lsr A lsr A ora #'0' cmp #'9'+1 if the character should be alpha, blt cn5 adjust it adc #6 ora orVal cn5 sta ~str,Y save the character dey lda ~num+3 loop if the number is not zero ora ~num+2 ora ~num+1 ora ~num bne cn3 ; ; If a leading '0x' is required, be sure we include one ; lda ~altForm branch if no leading '0x' is required beq al3 al2 lda #'X' insert leading '0x' ora orVal sta ~hexPrefix+1 lda #'0' sta ~hexPrefix al3 long I,M ; ; Piggy back off of ~Format_d for output ; brl ~Format_IntOut ; ; Local data ; orVal ds 2 for setting the case of characters end **************************************************************** * * ~Format_Percent - format the '%' character * * Inputs: * ~fieldWidth - output field width * ~paddChar - padd character * ~leftJustify - left justify the output? * **************************************************************** * ~Format_Percent private using ~printfCommon dec ~fieldWidth account for the width of the value jsr ~RightJustify handle right justification pea '%' print the character jsl ~putchar brl ~LeftJustify handle left justification end **************************************************************** * * ~InitBuffer - prepare a file buffer for output * * Inputs: * stream - buffer to prepare * **************************************************************** * ~InitBuffer start csubroutine (4:stream),0 ldy #FILE_base+2 set the next buffer location lda [stream],Y tax dey dey lda [stream],Y ldy #FILE_ptr sta [stream],Y iny iny txa sta [stream],Y ldy #FILE_base set the end of buffer mark lda [stream],Y ldy #FILE_size clc adc [stream],Y pha txa iny iny adc [stream],Y ldy #FILE_end+2 sta [stream],Y pla dey dey sta [stream],Y ldy #FILE_size set the number of chars the buffer lda [stream],Y can hold tax iny iny lda [stream],Y ldy #FILE_cnt+2 sta [stream],Y dey dey txa sta [stream],Y creturn end **************************************************************** * * ~ioerror - flag an I/O error * * Inputs: * stream - file to clear * * Outputs: * errno - set to EIO * stream->flag - error flag set * **************************************************************** * ~ioerror start stream equ 3 input stream tsc phd tcd ldy #FILE_flag lda [stream],Y ora #_IOERR sta [stream],Y lda #EIO sta >errno pld pla ply ply pha rts end **************************************************************** * * ~LeftJustify - print padd characters for left justification * ~RightJustify - print padd characters for right justification * * Inputs: * ~fieldWidth - # chars to print ( <= 0 prints none) * ~leftJustify - left justify the output? * **************************************************************** * ~LeftJustify start using ~printfCommon lda ~leftJustify padd if we are to left justify the field bne padd rts rts ~RightJustify entry lda ~leftJustify quit if we are to left justify the field bne rts padd lda ~fieldWidth quit if the field width is <= 0 bmi rts beq rts lb1 ph2 #' ' write the proper # of padd characters jsl ~putchar dec ~fieldWidth bne lb1 rts end **************************************************************** * * ~osname - convert a c string to a GS/OS file name * * Inputs: * filename - ptr to the c string * * Outputs: * X-A - ptr to GS/OS file name * * Notes: * 1. Returns nil for error. * 2. Caller must dispose of the name with a free call. * **************************************************************** * ~osname private namelen equ 1 length of the string ptr equ 3 pointer to return csubroutine (4:filename),6 ph4 filename get the length of the name buffer jsl strlen sta namelen inc A inc A pea 0 reserve some memory pha jsl malloc sta ptr stx ptr+2 ora ptr+2 bne lb1 lda #ENOMEM sta >errno brl lb3 lb1 lda namelen set the name length sta [ptr] pea 0 copy the file name to the OS name buffer pha ph4 filename clc lda ptr ldx ptr+2 adc #2 bcc lb2 inx lb2 phx pha jsl memcpy lb3 creturn 4:ptr end **************************************************************** * * int ~printf(char *format, additional arguments) * * Print the format string by calling ~putchar indirectly. If a * '%' is found, it is interpreted as follows: * * Optional Flag Characters * ------------------------ * * '-' Left justify the output. * '0' Use '0' for the pad character rather than ' '. This * flag is ignored if the '-' flag is also used. * '+' Only used for conversion operations 'd' 'e' 'E' 'f' 'g' 'G'. * Specifies that a leading sign is to be printed for * positive values. * ' ' Only used for conversion operations 'd' 'e' 'E' 'f' 'g' 'G'. * Ignored if '+' is specified. For positive values, this * causes a padd space to be written where the sign would * appear. * '#' Modify the conversion operation. * * Optional Min Field Width * ------------------------ * * This field is either a number or *. If it is *, an integer * argument is consumed from the stack and used as the field * width. In either case, the output value is printed in a field * that is NUMBER characters wide. By default, the value is * right justified and blank padded. * * Optional Precision * ------------------ * * This field is a number, *, or is ommitted. If it is an integer, * an argument is removed from the stack and used as the precision. * The precision is used to describe how many digits to print. * * Long Size Specification * ----------------------- * * An 'l' indicates that the 'd', 'o', 'u', 'x' or 'X' argument is * long. 'L' and 'u' are also accepted for compliance with ANSI C, * but have no effect in this implementation. * * Conversion Specifier * -------------------- * * d,i Signed decimal conversion from type int or long. * u Signed decmal conversion from type unsigned or unsigned long. * o Octal conversion. * x,X Hexadecomal conversion. 'x' generates lowercase hex digits, * while 'X' generates uppercase hex digits. * c Character. * s String. * p Pascal string. * n The argument is (int *); the number of characters written so * far is written to the location. * f Signed decimal floating point. * e,E Exponential format floating point. * g,G Use f,e or E, as appropriate. * % Write a '%' character. * **************************************************************** * ~printf private using ~printfCommon argp equ 7 pointer to first argument format equ 14 pointer to format code ; ; Set up the stack frame ; phb save the caller's B phk use local addressing plb phd save the caller's DP tsc set up a DP tcd ; ; Process the format string ; stz ~numChars initialize the character counter ps1 lda [format] get a character and #$00FF beq rt1 branch if at the end of the format string cmp #'%' branch if this is a conversion beq fm1 specification pha write the character jsl ~putchar inc4 format bra ps1 ; ; Remove the format parameter and return ; rt1 lda format-2 move the return address sta format+2 lda format-3 sta format+1 pld restore DP plb restore B rtl return to top level formatter ; ; Handle a format specification ; fm1 inc4 format skip the '%' stz ~removeZeros not a G specifier stz ~fieldWidth use only the space required stz ~precision use the default precision stz ~precisionSpecified stz ~isLong assume short operands lda #' ' use a blank for padding sta ~paddChar stz ~leftJustify right justify the output stz ~sign don't print the sign unless arg < 0 stz ~altForm use the primary output format fm2 jsr Flag read and interpret flag characters bcs fm2 jsr GetSize get the field width (if any) sta ~fieldWidth lda [format] if format == '.' then and #$00FF cmp #'.' bne fm3 inc4 format skip the '.' inc ~precisionSpecified note that the precision is specified jsr GetSize get the precision sta ~precision lda [format] if *format == 'l' then and #$00FF fm3 cmp #'l' bne fm4 inc ~isLong ~isLong = true bra fm5 ++format fm4 cmp #'L' else if *format in ['L','h'] then beq fm5 cmp #'h' bne fm6 fm5 inc4 format ++format lda [format] find the proper format character and #$00FF fm6 inc4 format ldx #fListEnd-fList-4 fm7 cmp fList,X beq fm8 dex dex dex dex bpl fm7 brl ps1 none found - continue fm8 pea ps1-1 push the return address inx call the subroutine inx jmp (fList,X) ; ; Flag - Read and process a flag character ; ; If a flag character was found, the carry flag is set. ; Flag lda [format] get the character and #$00FF cmp #'-' if it is a '-' then bne fl1 lda #1 left justify the output sta ~leftJustify bra fl5 fl1 cmp #'0' if it is a '0' then bne fl2 sta ~paddChar padd with '0' characters bra fl5 fl2 cmp #'+' if it is a '+' or ' ' then beq fl3 cmp #' ' bne fl4 ldx ~sign cpx #'+' beq fl5 fl3 sta ~sign set the sign flag bra fl5 fl4 cmp #'#' if it is a '#' then bne fl6 lda #1 use the alternate output form sta ~altForm fl5 inc4 format skip the format character sec rts fl6 clc no flag was found rts ; ; GetSize - get a numeric value ; ; The value is returned in A ; GetSize stz val assume a value of 0 lda [format] if the format character is '*' then and #$00FF cmp #'*' bne gs1 inc4 format skip the '*' char lda [argp] fetch the value sta val inc argp remove it from the argument list inc argp gs0 lda val rts gs1 lda [format] while the character stream had digits do and #$00FF cmp #'0' blt gs0 cmp #'9'+1 bge gs0 gs2 and #$000F save the ordinal value pha asl val A := val*10 lda val asl a asl a adc val adc 1,S A := A+ord([format]) plx sta val val := A inc4 format skip the character bra gs1 val ds 2 value ; ; List of format specifiers and the equivalent subroutines ; fList dc c'%',i1'0',a'~Format_Percent' % dc c'n',i1'0',a'~Format_n' n dc c's',i1'0',a'~Format_s' s dc c'b',i1'0',a'~Format_b' b dc c'p',i1'0',a'~Format_p' p dc c'c',i1'0',a'~Format_c' c dc c'X',i1'0',a'~Format_X' X dc c'x',i1'0',a'~Format_x' x dc c'o',i1'0',a'~Format_o' o dc c'u',i1'0',a'~Format_u' u dc c'd',i1'0',a'~Format_d' d dc c'i',i1'0',a'~Format_d' i dc c'f',i1'0',a'~Format_f' f dc c'e',i1'0',a'~Format_e' e dc c'E',i1'0',a'~Format_E' E dc c'g',i1'0',a'~Format_g' g dc c'G',i1'0',a'~Format_G' G fListEnd anop end **************************************************************** * * ~printfCommon - common data for formatted output * **************************************************************** * ~printfCommon data ; ; ~putchar is a vector to the proper output routine. ; ~putchar dc h'EE',i'~numChars' inc ~numChars dc h'5C 00 00 00' ; ; Format options ; ~altForm ds 2 use alternate output format? ~fieldWidth ds 2 output field width ~hexPrefix ds 2 hex 0x prefix characters (if present) ~isLong ds 2 is the operand long? ~leftJustify ds 2 left justify the output? ~paddChar ds 2 output padd character ~precision ds 2 precision of output ~precisionSpecified ds 2 was the precision specified? ~removeZeros ds 2 remove insignificant zeros? (g specifier) ~sign ds 2 char to use for positive sign ; ; Work buffers ; ~num ds 4 long integer ~numChars ds 2 number of characters printed with this printf ~str ds 83 string buffer ; ; Real formatting ; ~decForm anop controls SANE's formatting styles ~style ds 2 0 -> exponential; 1 -> fixed ~digits ds 2 sig. digits; decimal digits ~decRec anop decimal record ~sgn ds 2 sign ~exp ds 2 exponent ~sig ds 29 significant digits end **************************************************************** * * ~RemoveWord - remove Y words from the stack for printf * * Inputs: * Y - number of words to remove (must be >0) * **************************************************************** * ~RemoveWord start lb1 lda 13,S move the critical values sta 15,S lda 11,S sta 13,S lda 9,S sta 11,S lda 7,S sta 9,S lda 5,S sta 7,S lda 3,S sta 5,S pla sta 1,S tdc update the direct page location inc a inc a tcd dey next word bne lb1 rts end **************************************************************** * * ~Scan_c - read a character or multiple characters * * Inputs: * ~scanWidth - # of characters to read (0 implies one) * ~suppress - suppress save? * **************************************************************** * ~Scan_c private using ~scanfCommon arg equ 11 argument lda ~scanWidth if ~scanWidth == 0 then bne lb1 inc ~scanWidth ~scanWidth = 1 lb1 jsl ~getchar get the character cmp #EOF if at EOF then bne lb1a sta ~eofFound ~eofFound = EOF lda ~suppress if input is not suppressed then bne lb3 dec ~assignments no assignment made bra lb3 bail out lb1a ldx ~suppress if input is not suppressed then bne lb2 short M save the value sta [arg] long M inc4 arg update the pointer lb2 dec ~scanWidth next character bne lb1 lb3 lda ~suppress if input is not suppressed then bne lb4 ldy #2 jsr ~RemoveWord remove the parameter from the stack lb4 rts end **************************************************************** * * ~Scan_d - read an integer * ~Scan_i - read a based integer * * Inputs: * ~scanError - has a scan error occurred? * ~scanWidth - max input length * ~suppress - suppress save? * ~size - size specifier * **************************************************************** * ~Scan_d private using ~scanfCommon arg equ 11 argument stz based always use base 10 bra bs1 ~Scan_i entry lda #1 allow base 8, 10, 16 sta based bs1 stz read no chars read lda #10 assume base 10 sta base stz val initialize the value to 0 stz val+2 lb1 jsl ~getchar skip leading whitespace... cmp #EOF if EOF then bne ef1 sta ~eofFound ~eofFound = EOF lda ~suppress if input is not suppressed then bne lb6l dec ~assignments no assignment made lb6l brl lb6 bail out ef1 tax {...back to skipping whitespace} lda __ctype+1,X and #_space bne lb1 inc read txa stz minus assume positive number cmp #'+' skip leading + beq sg1 cmp #'-' if - then set minus flag bne sg2 inc minus sg1 jsl ~getchar inc read sg2 ldx based if base 8, 16 are allowed then beq lb2 cmp #'0' if the digit is '0' then bne lb2 lda #8 assume base 8 sta base dec ~scanWidth get the next character jeq lb4a bpl lb1a stz ~scanWidth lb1a jsl ~getchar inc read cmp #'X' if it is X then beq lb1b cmp #'x' bne lb2 lb1b asl base use base 16 dec ~scanWidth get the next character beq lb4a bpl lb1c stz ~scanWidth lb1c jsl ~getchar inc read lb2 cmp #'0' if the char is a digit then blt lb4 cmp #'7'+1 blt lb2a ldx base cpx #8 beq lb4 cmp #'9'+1 blt lb2a cpx #16 bne lb4 and #$00DF cmp #'A' blt lb4 cmp #'F'+1 bge lb4 sbc #6 lb2a and #$000F convert it to a value pha save the value ph4 val update the old value lda base ldx #0 jsl ~UMUL4 pl4 val pla add in the new digit clc adc val sta val bcc lb3 inc val+2 lb3 dec ~scanWidth quit if the max # chars have been beq lb4a scanned bpl lb3a make sure 0 stays a 0 stz ~scanWidth lb3a jsl ~getchar next char inc read bra lb2 lb4 jsl ~putback put the last character back dec read lb4a lda read if no chars read then bne lb4b inc ~scanError ~scanError = true lda ~suppress if input is not suppressed then bne lb6 dec ~assignments no assignment made bra lb6 skip the save lb4b lda ~suppress if input is not suppressed then bne lb7 lda minus if minus then beq lb4c sub4 #0,val,val negate the value lb4c lda val save the value sta [arg] dec ~size bmi lb6 ldy #2 lda val+2 sta [arg],Y lb6 lda ~suppress if input is not suppressed then bne lb7 ldy #2 remove the parameter from the stack jsr ~RemoveWord lb7 rts val ds 4 value base dc i4'10' constant for mul4 based ds 2 based conversion? minus ds 2 is the value negative? read ds 2 # chars read end **************************************************************** * * ~Scan_lbrack - read character in a set * * Inputs: * ~scanWidth - max input length * ~suppress - suppress save? * ~size - size specifier * **************************************************************** * ~Scan_lbrack private using ~scanfCommon using ~printfCommon arg equ 11 argument format equ 7 pointer to format code stz read no characters read into the set stz didOne no characters scanned from the stream move #0,~str,#32 clear the set stz negate don't negate the set lda [format] if the first char is '^' then and #$00FF cmp #'^' bne lb2 dec negate negate the set lb1 inc4 format skip the ^ lb2 lda [format] while *format != ']' do and #$00FF ldx read but wait: ']' as the first char is beq lb2a allowed! cmp #']' beq lb3 lb2a inc read jsr Set set the char's bit ora ~str,X sta ~str,X bra lb1 next char lb3 inc4 format skip the ']' ldy #30 negate the set (if needed) lb4 lda ~str,Y eor negate sta ~str,Y dey dey bpl lb4 lb5 jsl ~getchar get a character cmp #EOF quit if at EOF beq lb8 pha quit if not in the set jsr Set ply and ~str,X beq lb7 sty didOne note that we scanned a character ldx ~suppress if output is not suppressed then bne lb6 tya short M save the character sta [arg] long M inc4 arg update the argument lb6 dec ~scanWidth note that we processed one beq lb8 bpl lb5 stz ~scanWidth bra lb5 next char lb7 tya put back the last char scanned jsl ~putback lb8 lda didOne if no chars read then bne lb8a inc ~scanError ~scanError = true lda ~suppress if input is not suppressed then bne lb9 dec ~assignments no assignment made bra lb8b skip the save lb8a lda ~suppress if output is not suppressed then bne lb9 short M set the terminating null lda #0 sta [arg] long M lb8b ldy #2 remove the parameter from the stack jsr ~RemoveWord lb9 rts ; ; Set - form a set disp/bit pattern from a character value ; Set ldx #1 stx disp st1 bit #$0007 beq st2 asl disp dec A bra st1 st2 lsr A lsr A lsr A tax lda disp rts negate ds 2 negate the set? disp ds 2 used to form the set disp read ds 2 number of characters in the scan set didOne ds 2 non-zero if we have scanned a character end **************************************************************** * * ~Scan_n - return the # of characters scanned so far * * Inputs: * ~suppress - suppress save? * * Notes: * Decrements ~assignments so the increment in scanf will * leave the assignment count unaffected by this call. * **************************************************************** * ~Scan_n private using ~scanfCommon arg equ 11 argument ldx ~suppress if output is not suppressed then bne lb1 lda ~scanCount save the count sta [arg] dec ~assignments fix assignment count lb1 ldy #2 remove the parameter from the stack jsr ~RemoveWord rts end **************************************************************** * * ~Scan_b - read a pascal string * ~Scan_s - read a c string * * Inputs: * ~scanError - has a scan error occurred? * ~scanWidth - max input length * ~suppress - suppress save? * ~size - size specifier * **************************************************************** * ~Scan_b private using ~scanfCommon arg equ 11 argument move4 arg,length save the location to store the length inc4 arg increment to the first char position lda #1 sta pString set the p-string flag bra lb1 ~Scan_s entry stz pString clear the p-string flag lb1 jsl ~getchar skip leading whitespace cmp #EOF bne lb2 inc ~scanError lda ~suppress (no assignment made) bne lb6 dec ~assignments bra lb6 lb2 tax lda __ctype+1,X and #_space bne lb1 lb2a txa ldx ~suppress if output is not suppressed then bne lb3 short M save the character sta [arg] long M inc4 arg update the argument lb3 dec ~scanWidth note that we processed one beq lb5 bpl lb4 stz ~scanWidth lb4 jsl ~getchar next char cmp #EOF quit if at EOF beq lb5 and #$00FF loop if not whitespace tax lda __ctype+1,X and #_space beq lb2a txa whitespace: put it back jsl ~putback lb5 lda ~suppress if output is not suppressed then bne lb6 short M set the terminating null lda #0 sta [arg] long M lda pString if this is a p-string then beq lb6 sec compute the length lda arg sbc length dec A ldx length set up the address stx arg ldx length+2 stx arg+2 short M save the length sta [arg] long M lb6 lda ~suppress if output is not suppressed then bne lb7 ldy #2 remove the parameter from the stack jsr ~RemoveWord lb7 rts length ds 4 ptr to the length byte (p string only) pString ds 2 is this a p string? end **************************************************************** * * ~Scan_percent - read a % character * * Inputs: * ~scanWidth - max input length * ~suppress - suppress save? * ~size - size specifier * **************************************************************** * ~Scan_percent private using ~scanfCommon arg equ 11 argument jsl ~getchar get the character cmp #'%' if it is not a percent then beq lb1 jsl ~putback put it back inc ~scanError note the error lda ~suppress if input is not suppressed then bne lb1 dec ~assignments no assignment done lb1 rts end **************************************************************** * * ~Scan_u - read an unsigned integer * ~Scan_o - read an unsigned octal integer * ~Scan_x - read an unsigned hexadecimal integer * ~Scan_p - read a pointer * * Inputs: * ~scanWidth - max input length * ~suppress - suppress save? * ~size - size specifier * **************************************************************** * ~Scan_u private using ~scanfCommon arg equ 11 argument jsr Init lda #10 base 10 bra bs1 ~Scan_o entry jsr Init lda #8 base 8 bra bs1 ~Scan_p entry lda #1 sta ~size ~Scan_x entry jsr Init jsl ~getchar if the initial char is a '0' then inc read sta ch cmp #'0' bne hx2 dec ~scanWidth get the next character jeq lb4a bpl hx1 stz ~scanWidth hx1 jsl ~getchar inc read sta ch cmp #'x' if it is an 'x' or 'X' then beq hx1a cmp #'X' bne hx2 hx1a dec ~scanWidth accept the character jeq lb4a bpl hx3 stz ~scanWidth bra hx3 hx2 jsl ~putback put back the character dec read hx3 lda #16 base 16 bs1 sta base set the base lb2 jsl ~getchar if the char is a digit then inc read sta ch cmp #'0' blt lb4 cmp #'7'+1 blt lb2a ldx base cpx #8 beq lb4 cmp #'9'+1 blt lb2a cpx #16 bne lb4 and #$00DF cmp #'A' blt lb4 cmp #'F'+1 bge lb4 sbc #6 lb2a and #$000F convert it to a value pha save the value ph4 val update the old value lda base ldx base+2 jsl ~UMUL4 pl4 val pla add in the new digit clc adc val sta val bcc lb3 inc val+2 lb3 dec ~scanWidth quit if the max # chars have been beq lb4a scanned bpl lb2 make sure 0 stays a 0 stz ~scanWidth bra lb2 lb4 lda ch put the last character back jsl ~putback dec read lb4a lda read if no chars read then bne lb4b inc ~scanError ~scanError = true lda ~suppress if input is not suppressed then bne lb6 dec ~assignments no assignment made bra lb6 remove the parameter lb4b lda ~suppress if input is not suppressed then bne lb7 lda val save the value sta [arg] dec ~size bmi lb6 ldy #2 lda val+2 sta [arg],Y lb6 lda ~suppress if input is not suppressed then bne lb7 ldy #2 remove the parameter from the stack jsr ~RemoveWord lb7 rts ; ; Initialization ; Init stz read no chars read stz val initialize the value to 0 stz val+2 in1 jsl ~getchar skip leading whitespace... cmp #EOF if at EOF then bne in2 lda ~suppress if input is not suppressed then bne in1a dec ~assignments no assignment made in1a sta ~eofFound eofFound = EOF pla pop stack bra lb6 bail out in2 tax ...back to slipping whitespace lda __ctype+1,X and #_space bne in1 txa jsl ~putback rts ch ds 2 char buffer val ds 4 value base dc i4'10' constant for mul4 based ds 2 based conversion? read ds 2 # chars read end **************************************************************** * * int ~scanf(format, additional arguments) * char *format; * * Scan by calling ~getchar indirectly. If a '%' is found, it * is interpreted as follows: * * Assignment Suppression Flag * --------------------------- * * '*' Do everyting but save the result and remove a pointer from * the stack. * * Max Field Width * --------------- * * No more than this number of characters are removed from the * input stream. * * Size Specification * ------------------ * * 'h' Used with 'd', 'u', 'o' or 'x' to indicate a short store. * 'l' Used with 'd', 'u', 'o' or 'x' to indicate a four-byte store. * Also used with 'e', 'f' or 'g' to indicate double reals. * * Conversion Specifier * -------------------- * * d,i Signed decimal conversion to type int or long. * u Signed decmal conversion to type unsigned short, unsigned or * unsigned long. * o Octal conversion. * x,X Hexadecomal conversion. * c Character. * s String. * p Pascal string. * n The argument is (int *); the number of characters written so * far is written to the location. * f,e,E,g,G Signed floating point conversion. * % Read a '%' character. * [ Scan and included characters and place them in a string. * **************************************************************** * ~scanf private using ~scanfCommon arg equ format+4 first argument format equ 7 pointer to format code ; ; Set up the stack frame ; phb save the caller's B phk use local addressing plb phd save the caller's DP tsc set up a DP tcd ; ; Process the format string ; stz ~assignments no assignments yet stz ~scanCount no characters scanned stz ~scanError no scan error so far stz ~eofFound eof was not the first char jsl ~getchar test for eof cmp #EOF bne ps0 sta ~eofFound ps0 jsl ~putback ps1 lda ~scanError quit if a scan error has occurred bne rm1 lda [format] get a character and #$00FF jeq rt1 branch if at the end of the format string tax if this is a whitespace char then lda __ctype+1,X and #_space beq ps4 ps2 inc4 format skip whitespace in the format string lda [format] and #$00FF tax lda __ctype+1,X and #_space bne ps2 ps3 jsl ~getchar skip whitespace in the input stream tax cpx #EOF beq ps3a lda __ctype+1,X and #_space bne ps3 ps3a txa jsl ~putback bra ps1 ps4 cpx #'%' branch if this is a conversion beq fm1 specification stx ch make sure the char matches the format inc4 format specifier jsl ~getchar cmp ch beq ps1 jsl ~putback put the character back ; ; Remove the parameters for remaining conversion specifications ; rm1 lda [format] if this is a format specifier then and #$00FF beq rt1 cmp #'%' bne rm4 inc4 format if it is not a '%' or '*' then lda [format] and #$00FF beq rt1 cmp #'%' beq rm4 cmp #'*' beq rm4 cmp #'[' if it is a '[' then bne rm3 rm2 inc4 format skip up to the closing ']' lda [format] and #$00FF beq rt1 cmp #']' bne rm2 rm3 ldy #2 remove an addr from the stack jsr ~RemoveWord rm4 inc4 format next format character bra rm1 ; ; Remove the format parameter and return ; rt1 lda format-2 move the return address sta format+2 lda format-3 sta format+1 pld restore DP plb restore B pla remove the extra 4 bytes from the stack pla lda >~assignments return the number of assignments bne rt2 lda >~eofFound return EOF if no characters scanned rt2 rtl ; ; Handle a format specification ; fm1 inc4 format skip the '%' inc ~assignments another one made... stz ~suppress assignment is not suppressed stz ~size default operand size lda [format] if the char is an '*' then and #$00FF cmp #'*' bne fm2 inc ~suppress suppress the output dec ~assignments no assignment made inc4 format skip the '*' fm2 jsr GetSize get the field width specifier sta ~scanWidth lda [format] if the character is an 'l' then and #$00FF cmp #'l' bne fm3 inc ~size long specifier bra fm4 fm3 cmp #'h' else if it is an 'h' then bne fm5 fm4 inc4 format ignore the character fm5 lda [format] find the proper format character and #$00FF inc4 format ldx #fListEnd-fList-4 fm7 cmp fList,X beq fm8 dex dex dex dex bpl fm7 brl ps1 none found - continue fm8 pea ps1-1 push the return address inx call the subroutine inx jmp (fList,X) ; ; GetSize - get a numeric value ; ; The value is returned in A ; GetSize stz val assume a value of 0 gs1 lda [format] while the character stream had digits do and #$00FF cmp #'0' blt gs3 cmp #'9'+1 bge gs3 gs2 and #$000F save the ordinal value pha asl val A := val*10 lda val asl a asl a adc val adc 1,S A := A+ord([format]) plx sta val val := A inc4 format skip the character bra gs1 gs3 lda val rts val ds 2 value ; ; List of format specifiers and the equivalent subroutines ; fList dc c'd',i1'0',a'~Scan_d' d dc c'i',i1'0',a'~Scan_i' i dc c'u',i1'0',a'~Scan_u' u dc c'o',i1'0',a'~Scan_o' o dc c'x',i1'0',a'~Scan_x' x dc c'X',i1'0',a'~Scan_x' X dc c'p',i1'0',a'~Scan_p' p dc c'c',i1'0',a'~Scan_c' c dc c's',i1'0',a'~Scan_s' s dc c'b',i1'0',a'~Scan_b' b dc c'n',i1'0',a'~Scan_n' n dc c'f',i1'0',a'~Scan_f' f dc c'e',i1'0',a'~Scan_f' e dc c'E',i1'0',a'~Scan_f' E dc c'g',i1'0',a'~Scan_f' g dc c'G',i1'0',a'~Scan_f' G dc c'%',i1'0',a'~Scan_percent' % dc c'[',i1'0',a'~Scan_lbrack' [ fListEnd anop ; ; Other local data ; ch ds 2 temp storage end **************************************************************** * * ~scanfCommon - common data for formatted input * **************************************************************** * ~scanfCommon data ; ; ~getchar is a vector to the proper input routine. ; ~getchar dc h'AF',a3'~scanCount' lda >~scanCount dc h'1A' inc A dc h'8F',a3'~scanCount' sta >~scanCount dc h'5C 00 00 00' ; ; ~putback is a vector to the proper putback routine. ; ~putback dc h'48' pha dc h'AF',a3'~scanCount' lda >~scanCount dc h'3A' dec A dc h'8F',a3'~scanCount' sta >~scanCount dc h'68' pla dc h'5C 00 00 00' ; ; global variables ; ~assignments ds 2 # of assignments made ~eofFound ds 2 was EOF found during the scan? ~suppress ds 2 suppress assignment? ~scanCount ds 2 # of characters scanned ~scanError ds 2 set to 1 by scaners if an error occurs ~scanWidth ds 2 max # characters to scan ~size ds 2 size specifier; -1 -> short, 1 -> long, ! 0 -> default end **************************************************************** * * ~SetFilePointer - makes sure nothing is in the input buffer * * Inputs: * stream - stream to check * **************************************************************** * ~SetFilePointer private csubroutine (4:stream),0 ldy #FILE_pbk if stream->FILE_pbk != -1 lda [stream],Y inc A ldy #FILE_cnt or stream->FILE_cnt != 0 then ora [stream],Y iny iny ora [stream],Y beq lb1 ph2 #SEEK_CUR fseek(stream, 0L, SEEK_CUR) ph4 #0 ph4 stream jsl fseek lb1 anop creturn end **************************************************************** * * ~VerifyStream - insures that a stream actually exists * * Inputs: * stream - stream to check * * Outputs: * C - set for error; clear if the stream exists * **************************************************************** * ~VerifyStream private stream equ 9 stream to check ptr equ 1 stream pointer phb set up the stack frame phk plb ph4 #stdin+4 tsc phd tcd lb1 lda ptr error if the list is exhausted ora ptr+2 beq err lda ptr OK if the steams match cmp stream bne lb2 lda ptr+2 cmp stream+2 beq OK lb2 ldy #2 next pointer lda [ptr],Y tax lda [ptr] sta ptr stx ptr+2 bra lb1 err lda #EIO set the error code sta >errno sec return with error bra OK2 OK clc return with no error OK2 pld pla pla plx ply pla pla phy phx plb rtl end \ No newline at end of file + keep stdio + mcopy stdio.macros + case on + +**************************************************************** +* +* StdIO - Standard I/O Library +* +* This code implements the tables and subroutines needed to +* support the standard C library STDIO. +* +* November 1988 +* Mike Westerfield +* +* Copyright 1988 +* Byte Works, Inc. +* +* Note: Portions of this library appear in SysFloat. +* +**************************************************************** +* +StdIO start dummy segment + copy equates.asm + + end + +**************************************************************** +* +* void clearerr(stream) +* FILE *stream; +* +* Clears the error flag for the givin stream. +* +* Inputs: +* stream - file to clear +* +**************************************************************** +* +clearerr start +stream equ 4 input stream + + tsc + phd + tcd + ph4 stream verify that stream exists + jsl ~VerifyStream + bcs lb1 + ldy #FILE_flag clear the error flag + lda [stream],Y + and #$FFFF-_IOERR-_IOEOF + sta [stream],Y +lb1 pld + lda 2,S + sta 6,S + pla + sta 3,S + pla + rtl + end + +**************************************************************** +* +* int fclose(stream) +* FILE *stream; +* +* Inputs: +* stream - pointer to the file buffer to close +* +* Outputs: +* A - EOF for an error; 0 if there was no error +* +**************************************************************** +* +fclose start +nameBuffSize equ 8*1024 pathname buffer size + +err equ 1 return value +p equ 3 work pointer +stdfile equ 7 is this a standard file? + + csubroutine (4:stream),8 + phb + phk + plb + + lda #EOF assume we will get an error + sta err + ph4 stream verify that stream exists + jsl ~VerifyStream + jcs rts + + ph4 stream do any pending I/O + jsl fflush + tax + jne rts + + stz stdfile not a standard file + lda stream+2 bypass file disposal if the file is + cmp #^stdin+4 one of the standard ones + bne cl0 + lda stream + cmp #stdin+4 + beq lb1 + cmp #stdout+4 + beq lb1 + cmp #stderr+4 + bne cl0 +lb1 inc stdfile + bra cl3a + +cl0 lla p,stderr+4 find the file record that points to this + ldy #2 one +cl1 lda [p] + ora [p],Y + jeq rts + lda [p],Y + tax + lda [p] + cmp stream + bne cl2 + cpx stream+2 + beq cl3 +cl2 stx p+2 + sta p + bra cl1 + +cl3 lda [stream] remove stream from the file list + sta [p] + lda [stream],Y + sta [p],Y +cl3a ldy #FILE_flag if the file was opened by tmpfile then + lda [stream],Y + and #_IOTEMPFILE + beq cl3d + ph4 #nameBuffSize p = malloc(nameBuffSize) + jsl malloc grPathname = p + sta p dsPathname = p+2 + stx p+2 + sta grPathname + stx grPathname+2 + clc + adc #2 + bcc cl3b + inx +cl3b sta dsPathname + stx dsPathname+2 + lda #nameBuffSize p->size = nameBuffSize + sta [p] + ldy #FILE_file clRefnum = grRefnum = stream->_file + lda [stream],Y + beq cl3e + sta grRefnum + GetRefInfoGS gr GetRefInfoGS(gr) + bcs cl3c + lda grRefnum OSClose(cl) + sta clRefNum + OSClose cl + DestroyGS ds DestroyGS(ds) +cl3c ph4 p free(p) + jsl free + bra cl3e else +cl3d ldy #FILE_file close the file + lda [stream],Y + beq cl3e + sta clRefNum + OSClose cl +cl3e ldy #FILE_flag if the buffer was allocated by fopen then + lda [stream],Y + and #_IOMYBUF + beq cl4 + ldy #FILE_base+2 dispose of the file buffer + lda [stream],Y + pha + dey + dey + lda [stream],Y + pha + jsl free +cl4 lda stdfile if this is not a standard file then + bne cl5 + ph4 stream dispose of the file buffer + jsl free + bra cl7 else +cl5 add4 stream,#sizeofFILE-4,p reset the standard out stuff + ldy #sizeofFILE-2 +cl6 lda [p],Y + sta [stream],Y + dey + dey + cpy #2 + bne cl6 +cl7 stz err no error found +rts plb + creturn 2:err + +cl dc i'1' parameter block for OSclose +clRefNum ds 2 + +gr dc i'3' parameter block for GetRefInfoGS +grRefnum ds 2 + ds 2 +grPathname ds 4 + +ds dc i'1' parameter block for DestroyGS +dsPathname ds 4 + end + +**************************************************************** +* +* int feof(stream) +* FILE *stream; +* +* Inputs: +* stream - file to check +* +* Outputs: +* Returns _IOEOF if an end of file has been reached; else +* 0. +* +**************************************************************** +* +feof start +stream equ 4 input stream + + tsc + phd + tcd + ph4 stream verify that stream exists + jsl ~VerifyStream + ldx #_IOEOF + bcs lb1 + ldy #FILE_flag check for eof + lda [stream],Y + and #_IOEOF + tax +lb1 pld + lda 2,S + sta 6,S + pla + sta 3,S + pla + txa + rtl + end + +**************************************************************** +* +* int ferror(stream) +* FILE *stream; +* +* Inputs: +* stream - file to check +* +* Outputs: +* Returns _IOERR if an end of file has been reached; else +* 0. +* +**************************************************************** +* +ferror start +stream equ 4 input stream + + tsc + phd + tcd + ph4 stream verify that stream exists + jsl ~VerifyStream + ldx #_IOERR + bcs lb1 + ldy #FILE_flag return the error status + lda [stream],Y + and #_IOERR + tax +lb1 pld + lda 2,S + sta 6,S + pla + sta 3,S + pla + txa + rtl + end + +**************************************************************** +* +* int fflush(steam) +* FILE *stream; +* +* Write any pending characters to the output file +* +* Inputs: +* stream - file buffer +* +* Outputs: +* A - EOF for an error; 0 if there was no error +* +**************************************************************** +* +fflush start +err equ 1 return value +sp equ 3 stream work pointer + + csubroutine (4:stream),6 + phb + phk + plb + + lda stream if stream = nil then + ora stream+2 + bne fa3 + lda stderr+4 sp = stderr.next + sta sp + lda stderr+6 + sta sp+2 + stz err err = 0 +fa1 lda sp while sp <> nil + ora sp+2 + jeq rts + ph4 sp fflush(sp); + jsl fflush + tax if returned value <> 0 then + beq fa2 + sta err err = returned value +fa2 ldy #2 sp = sp^.next + lda [sp],Y + tax + lda [sp] + sta sp + stx sp+2 + bra fa1 endwhile + +fa3 lda #EOF assume there is an error + sta err + ph4 stream verify that stream exists + jsl ~VerifyStream + jcs rts + ldy #FILE_flag if the mode is not writting, quit + lda [stream],Y + and #_IOWRT + beq fl1 + ldy #FILE_file set the reference number + lda [stream],Y + sta wrRefNum + ldy #FILE_base set the starting location + lda [stream],Y + sta wrDataBuffer + iny + iny + lda [stream],Y + sta wrDataBuffer+2 + sec set the # of bytes to write + ldy #FILE_ptr + lda [stream],Y + sbc wrDataBuffer + sta wrRequestCount + iny + iny + lda [stream],Y + sbc wrDataBuffer+2 + sta wrRequestCount+2 + ora wrRequestCount skip the write if there are no + beq fl1 characters + OSwrite wr write the info + bcc fl1 + ph4 stream + jsr ~ioerror + bra rts + +fl1 ldy #FILE_flag if the file is open for read/write then + lda [stream],Y + bit #_IORW + beq fl3 + bit #_IOREAD if the file is being read then + beq fl2 + ph4 stream use ftell to set the mark + jsl ftell + ldy #FILE_flag + lda [stream],Y +fl2 and #$FFFF-_IOWRT-_IOREAD turn off the reading and writing flags + sta [stream],Y +fl3 ph4 stream prepare file for output + jsl ~InitBuffer + stz err no error found +rts plb + creturn 2:err + +wr dc i'5' parameter block for OSwrite +wrRefNum ds 2 +wrDataBuffer ds 4 +wrRequestCount ds 4 + ds 4 + dc i'1' + end + +**************************************************************** +* +* int fgetc(stream) +* FILE *stream; +* +* Read a character from a file +* +* Inputs: +* stream - file to read from +* +* Outputs: +* A - character read; EOF for an error +* +**************************************************************** +* +fgetc start +getc entry + +c equ 1 character read +p equ 3 work pointer + + csubroutine (4:stream),6 + phb + phk + plb + + ph4 stream verify that stream exists + jsl ~VerifyStream + bcs lb0 + ldy #FILE_flag quit with error if the end of file + lda [stream],Y has been reached or an error has been + and #_IOEOF+_IOERR encountered + beq lb1 +lb0 lda #EOF + sta c + brl gc9 + +lb1 ldy #FILE_pbk if there is a char in the putback buffer + lda [stream],Y + bmi lb2 + and #$00FF return it + sta c + ldy #FILE_pbk+2 pop the putback buffer + lda [stream],Y + tax + lda #$FFFF + sta [stream],Y + ldy #FILE_pbk + txa + sta [stream],Y + brl gc9 + +lb2 ldy #FILE_file branch if this is a disk file + lda [stream],Y + bpl gc2 + + cmp #stdinID if stream = stdin then + bne gc1 + jsl SYSKEYIN get a character + tax branch if not eof + bne st1 + lda #_IOEOF set EOF flag + ora >stdin+4+FILE_flag + sta >stdin+4+FILE_flag + jsl SYSKEYIN read the closing cr + lda #EOF return EOF +st1 sta c + brl gc9 + +gc1 ph4 stream else flag the error + jsr ~ioerror + lda #EOF + sta c + brl gc9 + +gc2 ldy #FILE_flag if the file is not read enabled then + lda [stream],Y + bit #_IOREAD + bne gc2a + bit #_IOWRT it is an error if it is write enabled + bne gc1 + bra gc2b +gc2a ldy #FILE_cnt we're ready if there are characters + lda [stream],Y left + iny + iny + ora [stream],Y + jne gc8 + +gc2b ldy #FILE_flag if input is unbuffered then + lda [stream],Y + bit #_IONBF + beq gc3 + stz rdDataBuffer+2 set up to read one char to c + tdc + clc + adc #c + sta rdDataBuffer + lla rdRequestCount,1 + bra gc4 +gc3 ldy #FILE_base else set up to read a buffer full + lda [stream],Y + sta rdDataBuffer + iny + iny + lda [stream],Y + sta rdDataBuffer+2 + ldy #FILE_size + lda [stream],Y + sta rdRequestCount + iny + iny + lda [stream],Y + sta rdRequestCount+2 +gc4 ldy #FILE_file set the file reference number + lda [stream],Y + sta rdRefNum + OSRead rd read the data + bcc gc7 if there was a read error then + ldy #FILE_flag + cmp #$4C if it was eof then + bne gc5 + lda #_IOEOF set the EOF flag + bra gc6 else +gc5 lda #_IOERR set the error flag +gc6 ora [stream],Y + sta [stream],Y + lda #EOF return EOF + sta c + brl gc9 + +gc7 ldy #FILE_flag we're done if the read is unbuffered + lda [stream],Y + and #_IONBF + jne gc9 + clc set the end of the file buffer + ldy #FILE_end + lda rdDataBuffer + adc rdTransferCount + sta [stream],Y + iny + iny + lda rdDataBuffer+2 + adc rdTransferCount+2 + sta [stream],Y + ldy #FILE_base reset the file pointer + lda [stream],Y + tax + iny + iny + lda [stream],Y + ldy #FILE_ptr+2 + sta [stream],Y + dey + dey + txa + sta [stream],Y + ldy #FILE_cnt set the # chars in the buffer + lda rdTransferCount + sta [stream],Y + iny + iny + lda rdTransferCount+2 + sta [stream],Y + ldy #FILE_flag note that the file is read enabled + lda [stream],Y + ora #_IOREAD + sta [stream],Y + +gc8 ldy #FILE_ptr get the next character + lda [stream],Y + sta p + clc + adc #1 + sta [stream],Y + iny + iny + lda [stream],Y + sta p+2 + adc #0 + sta [stream],Y + lda [p] + and #$00FF + sta c + ldy #FILE_cnt dec the # chars in the buffer + sec + lda [stream],Y + sbc #1 + sta [stream],Y + bcs gc8a + iny + iny + lda [stream],Y + dec A + sta [stream],Y + +gc8a ldy #FILE_flag if the file is read/write + lda [stream],Y + and #_IORW + beq gc9 + ldy #FILE_cnt and the buffer is empty then + lda [stream],Y + iny + iny + ora [stream],Y + bne gc9 + ldy #FILE_flag note that no chars are left + lda [stream],Y + eor #_IOREAD + sta [stream],Y + +gc9 lda c if c = \r then + cmp #13 + bne gc10 + ldy #FILE_flag if this is a text file then + lda [stream],Y + and #_IOTEXT + beq gc10 + lda #10 + sta c + +gc10 plb + creturn 2:c +; +; Local data +; +rd dc i'4' parameter block for OSRead +rdRefNum ds 2 +rdDataBuffer ds 4 +rdRequestCount ds 4 +rdTransferCount ds 4 + end + +**************************************************************** +* +* char *fgets(s, n, stream) +* char *s; +* int n; +* FILE *stream; +* +* Reads a line into the string s. +* +* Inputs: +* s - location to put the string read. +* n - size of the string +* stream - file to read from +* +* Outputs: +* Returns NULL if an EOF is encountered, placing any +* characters read before the EOF into s. Returns S if +* a line or part of a line is read. +* +**************************************************************** +* +fgets start +RETURN equ 13 RETURN key code +LF equ 10 newline + +disp equ 1 disp in s + + csubroutine (4:s,2:n,4:stream),2 + + ph4 stream verify that stream exists + jsl ~VerifyStream + bcs err1 + ph4 stream quit with NULL if at EOF + jsl feof + tax + beq lb0 +err1 stz s + stz s+2 + bra rts +lb0 stz disp no characters processed so far + lda #0 + sta [s] + dec n leave room for the null terminator + bmi err + beq err +lb1 ph4 stream get a character + jsl fgetc + tax quit with error if it is an EOF + bpl lb2 +err stz s + stz s+2 + bra rts +lb2 cmp #RETURN if the char is a return, switch to lf + bne lb3 + lda #LF +lb3 ldy disp place the char in the string + sta [s],Y (null terminates automatically) + inc disp + cmp #LF quit if it was an LF + beq rts + dec n next character + bne lb1 +rts creturn 4:s + end + +**************************************************************** +* +* int fgetpos(FILE *stream, fpos_t *pos); +* +* Inputs: +* stream - pointer to stream to get position of +* pos - pointer to location to place position +* +* Outputs: +* A - 0 if successful; else -1 if not +* errno - if unsuccessful, errno is set to EIO +* +**************************************************************** +* +fgetpos start +err equ 1 error code + + csubroutine (4:stream,4:pos),2 + + ph4 stream get the position + jsl ftell + cmp #-1 if the position = -1 then + bne lb1 + cpx #-1 + bne lb1 + sta err err = -1 + bra lb2 return +lb1 sta [pos] else + txa *pos = position + ldy #2 + sta [pos],Y + stz err err = 0 +lb2 anop endif + + creturn 2:err + end + +**************************************************************** +* +* FILE *fopen(filename, type) +* char *filename, *type; +* +* Inputs: +* filename - pointer to the file name +* type - pointer to the type string +* +* Outputs: +* X-A - pointer to the file variable; NULL for an error +* +**************************************************************** +* +fopen start +BIN equ 6 file type for BIN files +TXT equ 4 file type for TXT files + +fileType equ 1 file type letter +fileBuff equ 3 pointer to the file buffer +buffStart equ 7 start of the file buffer +OSname equ 11 pointer to the GS/OS file name +; +; initialization +; + csubroutine (4:filename,4:type),14 + + phb use our data bank + phk + plb + + stz fileBuff no file so far + stz fileBuff+2 + + lda [type] make sure the file type is in ['a','r','w'] + and #$00FF + sta fileType + ldx #$0003 + cmp #'a' + beq cn1 + ldx #$0002 + cmp #'w' + beq cn1 + ldx #$0001 + cmp #'r' + beq cn1 + lda #EINVAL + sta >errno + brl rt2 +; +; create a GS/OS file name +; +cn1 stx opAccess set the access flags + ph4 filename get the length of the name buffer + jsl ~osname + sta OSname + stx OSname+2 + ora OSname+2 + jeq rt2 +; +; check for file modifier characters + and b +; + lda #TXT we must open a new file - determine it's + sta crFileType type by looking for the 'b' designator + ldy #1 + lda [type],Y + jsr Modifier + bcc cm1 + iny + lda [type],Y + jsr Modifier +cm1 anop +; +; open the file +; + move4 OSname,opName try to open an existing file + OSopen op + bcc of2 + + lda fileType if the type is 'r', flag an error + cmp #'r' + bne of1 + lda #ENOENT + sta >errno + brl rt1 + +of1 move4 OSname,crPathName create the file + OScreate cr + bcs errEIO + OSopen op open the file + bcc of2 +errEIO lda #EIO + sta >errno + brl rt1 + +of2 lda fileType if the file type is 'w' then + cmp #'w' + bne of3 + lda opRefNum reset it + sta efRefNum + OSSet_EOF ef + bcc ar1 allow "not a block device error" + cmp #$0058 + beq ar1 + bra errEIO flag the error +of3 cmp #'a' else if the file type is 'a' then + bne ar1 + lda opRefNum + sta gfRefNum + sta smRefNum + OSGet_EOF gf append to it + bcs errEIO + move4 gfEOF,smDisplacement + OSSet_Mark sm + bcs errEIO +; +; allocate and fill in the file record +; +ar1 ph4 #sizeofFILE get space for the file record + jsl malloc + sta fileBuff + stx fileBuff+2 + ora fileBuff+2 + beq ar2 + ph4 #BUFSIZ get space for the file buffer + jsl malloc + sta buffStart + stx buffStart+2 + ora buffStart+2 + bne ar3 + ph4 fileBuff memory error + jsl free +ar2 lda #ENOMEM + sta >errno + brl rt1 + +ar3 ldy #2 insert the record right after stderr + lda >stderr+4 + sta [fileBuff] + lda >stderr+6 + sta [fileBuff],Y + lda fileBuff + sta >stderr+4 + lda fileBuff+2 + sta >stderr+6 + lda buffStart set the start of the buffer + ldy #FILE_base + sta [fileBuff],Y + iny + iny + lda buffStart+2 + sta [fileBuff],Y + ldy #FILE_ptr+2 + sta [fileBuff],Y + dey + dey + lda buffStart + sta [fileBuff],Y + ldy #FILE_size set the buffer size + lda #BUFSIZ + sta [fileBuff],Y + iny + iny + lda #^BUFSIZ + sta [fileBuff],Y + ldy #1 set the flags + lda [type],Y + and #$00FF + cmp #'+' + beq ar3a + cmp #'b' + bne ar4 + iny + lda [type],Y + and #$00FF + cmp #'+' + bne ar4 +ar3a lda #_IOFBF+_IORW+_IOMYBUF + bra ar6 +ar4 lda fileType + cmp #'r' + beq ar5 + lda #_IOFBF+_IOWRT+_IOMYBUF + bra ar6 +ar5 lda #_IOFBF+_IOREAD+_IOMYBUF +ar6 ldy #FILE_flag + ldx crFileType + cpx #BIN + beq ar6a + ora #_IOTEXT +ar6a sta [fileBuff],Y + ldy #FILE_cnt no chars in buffer + lda #0 + sta [fileBuff],Y + iny + iny + sta [fileBuff],Y + ldy #FILE_pbk nothing in the putback buffer + lda #$FFFF + sta [fileBuff],Y + ldy #FILE_pbk+2 + sta [fileBuff],Y + ldy #FILE_file set the file ID + lda opRefNum + sta [fileBuff],Y +; +; return the result +; +rt1 ph4 OSname dispose of the file name buffer + jsl free +rt2 plb restore caller's data bank + creturn 4:fileBuff return +; +; Modifier - local subroutine to check modifier character +; +; Returns: C=0 if no modifier found, else C=1 +; +Modifier and #$00FF + beq md3 + cmp #'+' + bne md1 + lda #$0003 + sta opAccess + sec + rts +md1 cmp #'b' + bne md2 + lda #BIN + sta crFileType +md2 sec + rts + +md3 clc + rts +; +; local data areas +; +op dc i'3' parameter block for OSopen +opRefNum ds 2 +opName ds 4 +opAccess ds 2 + +gf dc i'2' GetEOF record +gfRefNum ds 2 +gfEOF ds 4 + +sm dc i'3' SetMark record +smRefNum ds 2 +smBase dc i'0' +smDisplacement ds 4 + +ef dc i'3' parameter block for OSSet_EOF +efRefNum ds 2 + dc i'0' + dc i4'0' + +cr dc i'7' parameter block for OScreate +crPathName ds 4 + dc i'$C3' +crFileType ds 2 + dc i4'0' + dc i'1' + dc i4'0' + dc i4'0' + dc r'fgetc' + dc r'fputc' + dc r'fclose' + end + +**************************************************************** +* +* FILE *freopen(filename, type, stream) +* char *filename, *type; +* FILE *stream; +* +* Inputs: +* filename - pointer to the file name +* type - pointer to the type string +* stream - file buffer to use +* +* Outputs: +* X-A - pointer to the file variable; NULL for an error +* +**************************************************************** +* +freopen start +BIN equ 6 file type for BIN files +TXT equ 4 file type for TXT files + +fileType equ 1 file type letter +buffStart equ 3 start of the file buffer +OSname equ 7 pointer to the GS/OS file name +fileBuff equ 11 file buffer to return +; +; initialization +; + csubroutine (4:filename,4:type,4:stream),14 + + phb use our data bank + phk + plb + + stz fileBuff the open is not legal, yet + stz fileBuff+2 + + ph4 stream verify that stream exists + jsl ~VerifyStream + jcs rt2 + lda [type] make sure the file type is in ['a','r','w'] + and #$00FF + sta fileType + cmp #'a' + beq cl1 + cmp #'w' + beq cl1 + cmp #'r' + beq cl1 + lda #EINVAL + sta >errno + brl rt2 +; +; close the old file +; +cl1 ldy #FILE_file branch if the file is not a disk file + lda [stream],Y + bmi cn1 + + ph4 stream do any pending I/O + jsl fflush + ldy #FILE_file close the file + lda [stream],Y + sta clRefNum + OSclose cl + ldy #FILE_flag if the buffer was allocated by fopen then + lda [stream],Y + and #_IOMYBUF + beq cn1 + ldy #FILE_base+2 dispose of the file buffer + lda [stream],Y + pha + dey + dey + lda [stream],Y + pha + jsl free +; +; create a GS/OS file name +; +cn1 ph4 filename get the length of the name buffer + jsl ~osname + sta OSname + stx OSname+2 + ora OSname+2 + jeq rt2 +; +; open the file +; + lda #TXT we must open a new file - determine it's + sta crFileType type by looking for the 'b' designator + ldy #1 + lda [type],Y + and #$00FF + cmp #'+' + bne nl1 + iny + lda [type],Y + and #$00FF +nl1 cmp #'b' + bne nl2 + lda #BIN + sta crFileType + +nl2 move4 OSname,opName try to open an existing file + OSopen op + bcc of2 + + lda fileType if the type is 'r', flag an error + cmp #'r' + bne of1 +errEIO ph4 stream + jsr ~ioerror + brl rt1 + +of1 move4 OSname,crPathName create the file + OScreate cr + bcs errEIO + OSopen op open the file + bcs errEIO + +of2 lda fileType if the file type is 'w', reset it + cmp #'w' + bne ar1 + lda opRefNum + sta efRefNum + OSSet_EOF ef + bcs errEIO +; +; fill in the file record +; +ar1 ph4 #BUFSIZ get space for the file buffer + jsl malloc + sta buffStart + stx buffStart+2 + ora buffStart+2 + bne ar3 + lda #ENOMEM memory error + sta >errno + brl rt1 + +ar3 move4 stream,fileBuff set the file buffer address + lda buffStart set the start of the buffer + ldy #FILE_base + sta [fileBuff],Y + iny + iny + lda buffStart+2 + sta [fileBuff],Y + ldy #FILE_ptr+2 + sta [fileBuff],Y + dey + dey + lda buffStart + sta [fileBuff],Y + ldy #FILE_size set the buffer size + lda #BUFSIZ + sta [fileBuff],Y + iny + iny + lda #^BUFSIZ + sta [fileBuff],Y + ldy #1 set the flags + lda [type],Y + and #$00FF + cmp #'+' + bne ar4 + lda #_IOFBF+_IORW+_IOMYBUF + bra ar6 +ar4 lda fileType + cmp #'r' + beq ar5 + lda #_IOFBF+_IOWRT+_IOMYBUF + bra ar6 +ar5 lda #_IOFBF+_IOREAD+_IOMYBUF +ar6 ldy #FILE_flag + ldx crFileType + cpx #BIN + beq ar6a + ora #_IOTEXT +ar6a sta [fileBuff],Y + ldy #FILE_cnt no chars in buffer + lda #0 + sta [fileBuff],Y + iny + iny + sta [fileBuff],Y + ldy #FILE_pbk nothing in the putback buffer + lda #$FFFF + sta [fileBuff],Y + ldy #FILE_pbk+2 + sta [fileBuff],Y + ldy #FILE_file set the file ID + lda opRefNum + sta [fileBuff],Y +; +; return the result +; +rt1 ph4 OSname dispose of the file name buffer + jsl free +rt2 plb restore caller's data bank + creturn 4:fileBuff return +; +; local data areas +; +op dc i'2' parameter block for OSopen +opRefNum ds 2 +opName ds 4 + +ef dc i'3' parameter block for OSSet_EOF +efRefNum ds 2 + dc i'0' + dc i4'0' + +cr dc i'7' parameter block for OScreate +crPathName ds 4 + dc i'$C3' +crFileType ds 2 + dc i4'0' + dc i'1' + dc i4'0' + dc i4'0' + +cl dc i'1' parameter block for OSclose +clRefNum ds 2 +; +; Patch for standard out +; +stdoutFile jmp stdoutPatch + +stdoutPatch phb + plx + ply + pla + pha + pha + pha + phy + phx + plb + lda >stdout + sta 6,S + lda >stdout+2 + sta 8,S + brl fputc +; +; Patch for standard in +; +stdinFile jmp stdinPatch + +stdinPatch ph4 #stdin+4 + jsl fgetc + rtl + end + +**************************************************************** +* +* int fprintf(stream, char *format, additional arguments) +* +* Print the format string to standard out. +* +**************************************************************** +* +fprintf start + using ~printfCommon + + phb use local addressing + phk + plb + plx remove the return address + ply + pla save the stream + sta stream + pla + sta stream+2 + phy restore return address/data bank + phx + plb + lda >stream+2 verify that stream exists + pha + lda >stream + pha + jsl ~VerifyStream + bcc lb1 + lda #EIO + sta >errno + lda #EOF + bra rts +lb1 lda #put set up output routine + sta >~putchar+4 + lda #>put + sta >~putchar+5 + tsc find the argument list address + clc + adc #8 + sta >args + pea 0 + pha + jsl ~printf call the formatter + sec compute the space to pull from the stack + pla + sbc >args + clc + adc #4 + sta >args + pla + phb remove the return address + plx + ply + tsc update the stack pointer + clc + adc >args + tcs + phy restore the return address + phx + plb + lda >~numChars return the value + rtl return + +put phb remove the char from the stack + phk + plb + plx + pla + ply + pha + phx + plb + lda stream+2 write to a file + pha + lda stream + pha + phy + jsl fputc +rts rtl + +args ds 2 original argument address +stream ds 4 stream address + end + +**************************************************************** +* +* int fputc(c, stream) +* char c; +* FILE *stream; +* +* Write a character to a file +* +* Inputs: +* c - character to write +* stream - file to write to +* +* Outputs: +* A - character written; EOF for an error +* +**************************************************************** +* +fputc start +putc entry + +c2 equ 5 output char +p equ 1 work pointer + + csubroutine (2:c,4:stream),6 + + ph4 stream verify that stream exists + jsl ~VerifyStream + bcs lb0 + ldy #FILE_flag quit with error if the end of file + lda [stream],Y has been reached or an error has been + and #_IOEOF+_IOERR encountered + beq lb1 +lb0 lda #EOF + sta c + brl pc8 + +lb1 ldy #FILE_flag if the file is not prepared for + lda [stream],Y writing then + bit #_IOWRT + bne lb2 + bit #_IOREAD if it is being read then + bne pc2 flag the error + ora #_IOWRT set the writting flag + sta [stream],Y +lb2 ldy #FILE_file branch if this is a disk file + lda [stream],Y + bpl pc3 + + cmp #stdoutID if stream = stdout then + bne pc1 + ph2 c write the character + jsl ~stdout + brl pc8 +pc1 cmp #stderrID else if stream = stderr then + bne pc2 + lda c (for \n, write \r) + cmp #10 + bne pc1a + lda #13 +pc1a pha write to error out + jsl SYSCHARERROUT + brl pc8 +pc2 ph4 stream else stream = stdin; flag the error + jsr ~ioerror + lda #EOF + sta c + brl pc8 + +pc3 lda c set the output char + sta c2 + ldy #FILE_flag if this is a text file then + lda [stream],Y + and #_IOTEXT + beq pc3a + lda c if the char is lf then + cmp #10 + bne pc3a + lda #13 substitute a cr + sta c2 +pc3a ldy #FILE_cnt if the buffer is full then + lda [stream],Y + iny + iny + ora [stream],Y + bne pc4 +pc3b ldy #FILE_flag purge it + lda [stream],Y + pha + ph4 stream + jsl fflush + ldy #FILE_flag + pla + sta [stream],Y + +pc4 ldy #FILE_ptr deposit the character in the buffer, + lda [stream],Y incrementing the buffer pointer + sta p + clc + adc #1 + sta [stream],Y + iny + iny + lda [stream],Y + sta p+2 + adc #0 + sta [stream],Y + short M + lda c2 + sta [p] + long M + ldy #FILE_cnt dec the buffer counter + sec + lda [stream],Y + sbc #1 + sta [stream],Y + bcs pc5 + iny + iny + lda [stream],Y + dec A + sta [stream],Y + +pc5 ldy #FILE_cnt if the buffer is full + lda [stream],Y + iny + iny + ora [stream],Y + beq pc7 + lda c2 or if (c = '\n') and (flag & _IOLBF) + cmp #13 + beq pc5a + cmp #10 + bne pc6 +pc5a ldy #FILE_flag + lda [stream],Y + and #_IOLBF + bne pc7 +pc6 ldy #FILE_flag or is flag & _IONBF then + lda [stream],Y + and #_IONBF + beq pc8 +pc7 ldy #FILE_flag flush the stream + lda [stream],Y + pha + ph4 stream + jsl fflush + ldy #FILE_flag + pla + sta [stream],Y + +pc8 creturn 2:c + end + +**************************************************************** +* +* int fputs(s,stream) +* char *s; +* +* Print the string to standard out. +* +**************************************************************** +* +fputs start +err equ 1 return code + + csubroutine (4:s,4:stream),2 + + ph4 stream verify that stream exists + jsl ~VerifyStream + lda #EOF + sta err + bcs lb4 + stz err no error so far + bra lb2 skip initial increment +lb1 inc4 s next char +lb2 ph4 stream push the stream, just in case... + lda [s] exit loop if at end of string + and #$00FF + beq lb3 + pha push char to write + jsl fputc write the character + cmp #EOF loop if no error + bne lb1 + + sta err set the error code + bra lb4 + +lb3 pla remove stream from the stack + pla +lb4 creturn 2:err + end + +**************************************************************** +* +* size_t fread(ptr, element_size, count, stream) +* void *ptr; +* size_t element_size; +* size_t count; +* FILE *stream; +* +* Reads element*count bytes to stream, putting the bytes in +* ptr. +* +* Inputs: +* ptr - location to store the bytes read +* element_size - size of each element +* count - number of elements +* stream - file to read from +* +* Outputs: +* Returns the number of elements actually read. +* +**************************************************************** +* +fread start +temp equ 1 + + csubroutine (4:ptr,4:element_size,4:count,4:stream),4 + phb + phk + plb + + stz rdTransferCount set the # of elements read + stz rdTransferCount+2 + ph4 stream verify that stream exists + jsl ~VerifyStream + jcs lb6 + ph4 stream reset file pointer + jsl ~SetFilePointer + mul4 element_size,count,rdRequestCount set the # of bytes + lda rdRequestCount quit if the request count is 0 + ora rdRequestCount+2 + jeq lb6 + ldy #FILE_file set the file ID number + lda [stream],Y + bpl lb2 branch if it is a file + + cmp #stdinID if the file is stdin then + jne lb6 + stz rdTransferCount + stz rdTransferCount+2 + lda >stdin+4+FILE_flag + and #_IOEOF + jne lb6 +lb1 jsl SYSKEYIN read the bytes + tax branch if not eof + bne lb1a + lda #_IOEOF set EOF flag + ora >stdin+4+FILE_flag + sta >stdin+4+FILE_flag + jsl SYSKEYIN read the closing cr + brl lb6 +lb1a short M set character + sta [ptr] + long M + inc4 rdTransferCount + inc4 ptr + dec4 rdRequestCount + lda rdRequestCount + ora rdRequestCount+2 + bne lb1 + bra lb6 + +lb2 sta rdRefNum set the reference number + move4 ptr,rdDataBuffer set the start address + OSRead rd read the bytes + bcc lb5 + cmp #$4C if the error was $4C then + bne lb3 + jsr SetEOF set the EOF flag + bra lb5 +lb3 ph4 stream I/O error + jsr ~ioerror +! set the # records read +lb5 div4 rdTransferCount,element_size + lda count if there were too few elements read then + cmp rdTransferCount + bne lb5a + lda count+2 + cmp rdTransferCount+2 + beq lb6 +lb5a jsr SetEOF set the EOF flag +lb6 move4 rdTransferCount,temp + plb + + creturn 4:temp +; +; Local data +; +rd dc i'5' parameter block for OSRead +rdRefNum ds 2 +rdDataBuffer ds 4 +rdRequestCount ds 4 +rdTransferCount ds 4 + dc i'1' +; +; Set the EOF flag +; +SetEOF ldy #FILE_flag set the eof flag + lda [stream],Y + ora #_IOEOF + sta [stream],Y + rts + end + +**************************************************************** +* +* int fscanf(stream, format, additional arguments) +* char *format; +* FILE *stream; +* +* Read a string from a string. +* +**************************************************************** +* +fscanf start + using ~scanfCommon + + phb use local addressing + phk + plb + plx remove the return address + ply + pla save the stream + sta stream + pla + sta stream+2 + phy restore return address/data bank + phx + plb + + ph4 >stream verify that stream exists + jsl ~VerifyStream + bcc lb1 + lda #EOF + rtl +lb1 lda #get set up our routines + sta >~getchar+10 + lda #>get + sta >~getchar+11 + + lda #unget + sta >~putback+12 + lda #>unget + sta >~putback+13 + + brl ~scanf + +get ph4 stream get a character + jsl fgetc + rtl + +unget ldx stream+2 put a character back + phx + ldx stream + phx + pha + jsl ungetc + rtl + +stream ds 4 + end + +**************************************************************** +* +* int fseek(stream,offset,wherefrom) +* FILE *stream; +* long int offset; +* int wherefrom; +* +* Change the read/write location for the stream. +* +* Inputs: +* stream - file to change +* offset - position to move to +* wherefrom - move relative to this location +* +* Outputs: +* Returns non-zero for error +* +**************************************************************** +* +fseek start + jmp __fseek + end + +__fseek start + +err equ 1 return value + + csubroutine (4:stream,4:offset,2:wherefrom),2 + phb + phk + plb + + lda #-1 assume we will get an error + sta err + ph4 stream verify that stream exists + jsl ~VerifyStream + jcs rts + ph4 stream purge the file + jsl fflush + ldy #FILE_file set the file reference + lda [stream],Y + jmi lb6 + sta gpRefNum + sta spRefNum + lda wherefrom if position is relative to the end then + cmp #SEEK_END + bne lb2 + OSGet_EOF gp get the eof + jcs erEIO + add4 offset,gpPosition add it to the offset + bra lb3 +lb2 cmp #SEEK_CUR else if relative to current position then + bne lb3 + ph4 stream get the current position + jsl ftell + clc add it to the offset + adc offset + sta offset + txa + adc offset+2 + sta offset+2 +lb3 OSGet_EOF gp get the end of the file + jcs erEIO + lda offset+2 if the offset is >= EOF then + cmp gpPosition+2 + bne lb4 + lda offset + cmp gpPosition +lb4 ble lb5 + move4 offset,spPosition extend the file + OSSet_EOF sp + bcs erEIO +lb5 move4 offset,spPosition + OSSet_Mark sp + bcs erEIO + +lb6 ldy #FILE_flag clear the EOF , READ, WRITE flags + lda #$FFFF-_IOEOF-_IOREAD-_IOWRT + and [stream],Y + sta [stream],Y + ldy #FILE_cnt clear the character count + lda #0 + sta [stream],Y + iny + iny + sta [stream],Y + ldy #FILE_base+2 reset the file pointer + lda [stream],Y + tax + dey + dey + lda [stream],Y + ldy #FILE_ptr + sta [stream],Y + iny + iny + txa + sta [stream],Y + ldy #FILE_pbk nothing in the putback buffer + lda #$FFFF + sta [stream],Y + ldy #FILE_pbk+2 + sta [stream],Y + + stz err +rts plb + creturn 2:err + +erEIO ph4 stream flag an IO error + jsr ~ioerror + bra rts + +gp dc i'2' parameter block for OSGet_EOF +gpRefNum ds 2 +gpPosition ds 4 + +sp dc i'3' parameter block for OSSet_EOF +spRefNum ds 2 and OSSet_Mark + dc i'0' +spPosition ds 4 + end + +**************************************************************** +* +* int fsetpos(FILE *stream, fpos_t *pos); +* +* Inputs: +* stream - pointer to stream to set position of +* pos - pointer to location to set position +* +* Outputs: +* A - 0 if successful; else -1 if not +* errno - if unsuccessful, errno is set to EIO +* +**************************************************************** +* +fsetpos start +err equ 1 error code + + csubroutine (4:stream,4:pos),2 + + ph2 #SEEK_SET + ldy #2 + lda [pos],Y + pha + lda [pos] + pha + ph4 stream + jsl fseek + sta err + + creturn 2:err + end + +**************************************************************** +* +* long int ftell(stream) +* FILE *stream; +* +* Find the number of characters already passed in the file. +* +* Inputs: +* stream - strem to find the location in +* +* Outputs: +* Returns the position, or -1L for an error. +* +**************************************************************** +* +ftell start + +pos equ 1 position in the file + + csubroutine (4:stream),4 + phb + phk + plb + + lda #-1 assume an error + sta pos + sta pos+2 + ph4 stream verify that stream exists + jsl ~VerifyStream + jcs rts + ldy #FILE_flag if the file is being written then + lda [stream],Y + bit #_IOWRT + beq lb0 + ph4 stream do any pending writes + jsl fflush + tax + bne rts +lb0 ldy #FILE_file get the file's mark + lda [stream],Y + sta gmRefNum + OSGet_Mark gm + bcc lb1 + ph4 stream + jsr ~ioerror + bra rts + +lb1 move4 gmPosition,pos set the position + ldy #FILE_flag if the file is being read then + lda [stream],Y + bit #_IOREAD + beq rts + sec subtract off characters left to be + ldy #FILE_cnt read + lda pos + sbc [stream],Y + sta pos + iny + iny + lda pos+2 + sbc [stream],Y + sta pos+2 + ldy #FILE_pbk dec pos by 1 for each char in the + lda [stream],Y putback buffer then + bmi lb2 + dec4 pos + ldy #FILE_pbk+2 + lda [stream],Y + bmi lb2 + dec4 pos +lb2 ldy #FILE_file set the file's mark + lda [stream],Y + sta spRefNum + move4 pos,spPosition + OSSet_Mark sp + +rts plb + creturn 4:pos + +sp dc i'3' parameter block for OSSet_Mark +spRefNum ds 2 + dc i'0' +spPosition ds 4 + +gm dc i'2' parameter block for OSGetMark +gmRefNum ds 2 +gmPosition ds 4 + end + +**************************************************************** +* +* size_t fwrite(ptr, element_size, count, stream) +* void *ptr; +* size_t element_size; +* size_t count; +* FILE *stream; +* +* Writes element*count bytes to stream, taking the bytes from +* ptr. +* +* Inputs: +* ptr - pointer to the bytes to write +* element_size - size of each element +* count - number of elements +* stream - file to write to +* +* Outputs: +* Returns the number of elements actually written. +* +**************************************************************** +* +fwrite start + + csubroutine (4:ptr,4:element_size,4:count,4:stream),0 + phb + phk + plb + + stz wrTransferCount set the # of elements written + stz wrTransferCount+2 + ph4 stream verify that stream exists + jsl ~VerifyStream + jcs lb6 + mul4 element_size,count,wrRequestCount set the # of bytes + lda wrRequestCount quit if the request count is 0 + ora wrRequestCount+2 + jeq lb6 + ldy #FILE_file set the file ID number + lda [stream],Y + bpl lb4 branch if it is a file + + cmp #stdoutID if the file is stdout then + bne lb2 +lb1 lda [ptr] write the bytes + pha + jsl ~stdout + inc4 ptr + dec4 wrRequestCount + lda wrRequestCount + ora wrRequestCount+2 + bne lb1 + move4 count,wrTransferCount set the # of elements written + bra lb6 + +lb2 cmp #stderrID if the file is stderr then + bne lb6 +lb3 lda [ptr] write the bytes + pha + jsl SYSCHARERROUT + inc4 ptr + dec4 wrRequestCount + lda wrRequestCount + ora wrRequestCount+2 + bne lb3 + move4 count,wrTransferCount set the # of elements written + bra lb6 + +lb4 sta wrRefNum set the reference number + ph4 stream purge the file + jsl fflush + move4 ptr,wrDataBuffer set the start address + OSWrite wr write the bytes + bcc lb5 + ph4 stream I/O error + jsr ~ioerror +! set the # records written +lb5 div4 wrTransferCount,element_size,count +lb6 plb + creturn 4:count return + +wr dc i'4' parameter block for OSWrite +wrRefNum ds 2 +wrDataBuffer ds 4 +wrRequestCount ds 4 +wrTransferCount ds 4 + end + +**************************************************************** +* +* int getchar() +* +* Read a character from standard in. No errors are possible. +* +* The character read is returned in A. The null character +* is mapped into EOF. +* +**************************************************************** +* +getchar start +; +; Determine which method to use +; + lda >stdin use fgetc if stdin has changed + cmp #stdin+4 + bne fl1 + lda >stdin+2 + cmp #^stdin+4 + bne fl1 + lda >stdin+4+FILE_file use fgetc if stdio has a bogus file ID + cmp #stdinID + bne fl1 +; +; get the char from the keyboard +; + lda >stdin+4+FILE_pbk if there is a char in the putback + bmi lb1 buffer then + and #$00FF save it in X + tax + lda >stdin+4+FILE_pbk+2 pop the buffer + sta >stdin+4+FILE_pbk + lda #$FFFF + sta >stdin+4+FILE_pbk+2 + txa restore the char + bra lb2 + +lb1 jsl SYSKEYIN else get a char from the keyboard + tax branch if not eof + bne lb2 + lda #_IOEOF set EOF flag + ora >stdin+4+FILE_flag + sta >stdin+4+FILE_flag + jsl SYSKEYIN read the closing cr + lda #EOF return EOF +lb2 cmp #13 if the char is \r then + bne lb3 + lda #10 return \n +lb3 rtl +; +; Call fgetc +; +fl1 ph4 >stdin + dc i1'$22',s3'fgetc' jsl fgetc + rtl + end + +**************************************************************** +* +* char *gets(s) +* char s; +* +* Read a line from standard in. +* +* Inputs: +* s - string to read to. +* +* Outputs: +* Returns a pointer to the string +* +**************************************************************** +* +gets start +LF equ 10 \n key code + +disp equ 1 disp in s + + csubroutine (4:s),2 + + stz disp no characters processed so far +lb1 jsl getchar get a character + tax quit with error if it is an EOF + bpl lb2 + stz s + stz s+2 + bra rts +lb2 cmp #LF quit if it was a \n + beq lb3 + ldy disp place the char in the string + sta [s],Y + inc disp + bra lb1 next character +lb3 ldy disp null terminate + short M + lda #0 + sta [s],Y + long M + +rts creturn 4:s + end + +**************************************************************** +* +* void perror(s); +* char *s; +* +* Prints the string s and the error in errno to standard out. +* +**************************************************************** +* +perror start +maxErr equ ENOSPC max error in sys_errlist + +s equ 4 string address + + tsc set up DP addressing + phd + tcd + + ph4 >stderr write the error string + ph4 s + jsl fputs + ph4 >stderr write ': ' + pea ':' + jsl fputc + ph4 >stderr + pea ' ' + jsl fputc + ph4 >stderr write the error message + lda >errno + cmp #maxErr+1 + blt lb1 + lda #0 +lb1 asl A + asl A + tax + lda >sys_errlist+2,X + pha + lda >sys_errlist,X + pha + jsl fputs + ph4 >stderr write lf, cr + pea 10 + jsl fputc + ph4 >stderr + pea 13 + jsl fputc + + pld remove parm and return + lda 2,S + sta 6,S + pla + sta 3,S + pla + rtl + end + +**************************************************************** +* +* int printf(format, additional arguments) +* char *format; +* +* Print the format string to standard out. +* +**************************************************************** +* +printf start + using ~printfCommon + + lda #putchar + sta >~putchar+4 + lda #>putchar + sta >~putchar+5 + tsc find the argument list address + clc + adc #8 + sta >args + pea 0 + pha + jsl ~printf call the formatter + sec compute the space to pull from the stack + pla + sbc >args + clc + adc #4 + sta >args + pla + phb remove the return address + plx + ply + tsc update the stack pointer + clc + adc >args + tcs + phy restore the return address + phx + plb + lda >~numChars return the value + rtl return + +args ds 2 original argument address + end + +**************************************************************** +* +* int putchar(c) +* char c; +* +* Print the character to standard out. The character is +* returned. No errors are possible. +* +* The character \n is automatically followed by a $0D, which +* causes the IIGS to respond the way \n works on other machines. +* +**************************************************************** +* +putchar start + using ~printfCommon +_n equ 10 linefeed character +_r equ 13 RETURN key code +; +; Determine which method to use +; + lda >stdout use fgetc if stdin has changed + cmp #stdout+4 + bne fl1 + lda >stdout+1 + cmp #>stdout+4 + bne fl1 + lda >stdout+4+FILE_file use fgetc if stdio has a bogus file ID + cmp #stdoutID + bne fl1 +; +; Write to the CRT +; +~stdout entry + php remove the parameter from the stack + plx + ply + pla + phy + phx + plp + pha save the parameter + cmp #_n if this is a line feed, do a + bne lb1 carriage return, instead. + lda #_r +lb1 pha write the character + jsl SYSCHAROUT + pla return the input character + rtl +; +; Use fputc +; +fl1 ph4 >stdout + lda 8,S + pha + dc i1'$22' jsl fputc + dc s3'fputc' + phb + plx + ply + pla + phy + phx + plb + rtl + end + +**************************************************************** +* +* int puts(s) +* char *s; +* +* Print the string to standard out. A zero is returned; no +* error is possible. +* +**************************************************************** +* +puts start +LINEFEED equ 10 linefeed character + +err equ 1 erro code + + csubroutine (4:s),2 + + stz err no error +lb1 lda [s] print the string + and #$00FF + beq lb2 + pha + jsl putchar + inc4 s + bra lb1 +lb2 pea LINEFEED print the linefeed + jsl putchar + + creturn 2:err + end + +**************************************************************** +* +* int remove(filename) +* char *filename; +* +* Inputs: +* filename - name of the file to delete +* +* Outputs: +* Returns zero if successful, GS/OS error code if not. +* +**************************************************************** +* +remove start +err equ 1 return code + + csubroutine (4:filename),2 + phb + phk + plb + + ph4 filename convert to a GS/OS file name + jsl ~osname + sta dsPathName + stx dsPathName+2 + ora dsPathName+2 + bne lb1 + lda #$FFFF + sta err + bra lb2 +lb1 OSDestroy ds delete the file + sta err set the error code + bcc lb1a + lda #ENOENT + sta >errno +lb1a ph4 dsPathName dispose of the name buffer + jsl free + +lb2 plb + creturn 2:err + +ds dc i'1' parameter block for OSDestroy +dsPathName ds 4 + end + +**************************************************************** +* +* int rename(oldname,newname) +* char *filename; +* +* Inputs: +* filename - name of the file to delete +* +* Outputs: +* Returns zero if successful, GS/OS error code if not. +* +**************************************************************** +* +rename start +err equ 1 return code + + csubroutine (4:oldname,4:newname),2 + phb + phk + plb + + ph4 oldname convert oldname to a GS/OS file name + jsl ~osname + sta cpPathName + stx cpPathName+2 + ora cpPathName+2 + bne lb1 + lda #$FFFF + sta err + bra lb4 +lb1 ph4 newname convert newname to a GS/OS file name + jsl ~osname + sta cpNewPathName + stx cpNewPathName+2 + ora cpNewPathName+2 + bne lb2 + lda #$FFFF + sta err + bra lb3 +lb2 OSChange_Path cp rename the file + sta err set the error code + ph4 cpNewPathName dispose of the new name buffer + jsl free +lb3 ph4 cpPathName dispose of the old name buffer + jsl free + +lb4 plb + creturn 2:err + +cp dc i'2' parameter block for OSChange_Path +cpPathName ds 4 +cpNewPathName ds 4 + end + +**************************************************************** +* +* int rewind(stream) +* FILE *stream; +* +* Change the read/write location for the stream. +* +* Inputs: +* stream - file to change +* +* Outputs: +* Returns non-zero for error +* +**************************************************************** +* +rewind start +err equ 1 return code + + csubroutine (4:stream),2 + + ph2 #SEEK_SET + ph4 #0 + ph4 stream + jsl __fseek + sta err + + creturn 2:err + end + +**************************************************************** +* +* int scanf(format, additional arguments) +* char *format; +* +* Read a string from standard in. +* +**************************************************************** +* +scanf start + using ~scanfCommon + + lda #getchar + sta >~getchar+10 + lda #>getchar + sta >~getchar+11 + + lda #unget + sta >~putback+12 + lda #>unget + sta >~putback+13 + + brl ~scanf + +unget tax + lda >stdin+2 + pha + lda >stdin + pha + phx + jsl ungetc + rtl + end + +**************************************************************** +* +* int setbuf (FILE *stream, char *) +* +* Set the buffer type and size. +* +* Inputs: +* stream - file to set the buffer for +* buf - buffer to use, or NULL for automatic buffer +* +* Outputs: +* Returns zero if successful, -1 for an error +* +**************************************************************** +* +setbuf start +err equ 1 return code + + csubroutine (4:stream,4:buf),2 + + lda buf + ora buf+2 + bne lb1 + ph4 #0 + ph2 #_IONBF + bra lb2 +lb1 ph4 #BUFSIZ + ph2 #_IOFBF +lb2 ph4 buf + ph4 stream + jsl __setvbuf + sta err + + creturn 2:err + end + +**************************************************************** +* +* int setvbuf(stream,buf,type,size) +* FILE *stream; +* char *buf; +* int type,size; +* +* Set the buffer type and size. +* +* Inputs: +* stream - file to set the buffer for +* buf - buffer to use, or NULL for automatic buffer +* type - buffer type; _IOFBF, _IOLBF or _IONBF +* size - size of the buffer +* +* Outputs: +* Returns zero if successful, -1 for an error +* +**************************************************************** +* +setvbuf start + jmp __setvbuf + end + +__setvbuf start +err equ 1 return code + + csubroutine (4:stream,4:buf,2:type,4:size),2 + + phb + phk + plb + lda #-1 assume we will get an error + sta err + ph4 stream verify that stream exists + jsl ~VerifyStream + jcs rts + ldy #FILE_ptr make sure the buffer is not in use + lda [stream],Y + ldy #FILE_base + cmp [stream],Y + jne rts + ldy #FILE_ptr+2 + lda [stream],Y + ldy #FILE_base+2 + cmp [stream],Y + jne rts +cb1 lda size if size is zero then + ora size+2 + bne lb1 + lda type if ~(type & _IONBF) then + and #_IONBF + jeq rts flag the error + inc size else size = 1 +lb1 lda type error if type is not one of these + cmp #_IOFBF + beq lb2 + cmp #_IOLBF + beq lb2 + cmp #_IONBF + bne rts +lb2 lda buf if the buffer is not supplied by the + ora buf+2 caller then + bne sb1 + ph4 size allocate a buffer + jsl malloc + sta buf + stx buf+2 + ora buf+2 quit if there was no memory + beq rts + lda type set the buffer flag + ora #_IOMYBUF + sta type + +sb1 ldy #FILE_flag if the buffer was allocated by fopen then + lda [stream],Y + bit #_IOMYBUF + beq sb2 + ldy #FILE_base+2 dispose of the old buffer + lda [stream],Y + pha + dey + dey + lda [stream],Y + pha + jsl free +sb2 ldy #FILE_flag clear the old buffering flags + lda #$FFFF-_IOFBF-_IOLBF-_IONBF-_IOMYBUF + and [stream],Y + ora type set the new buffer flag + sta [stream],Y + + lda buf set the start of the buffer + ldy #FILE_base + sta [stream],Y + iny + iny + lda buf+2 + sta [stream],Y + ldy #FILE_ptr+2 + sta [stream],Y + dey + dey + lda buf + sta [stream],Y + ldy #FILE_size set the buffer size + lda size + sta [stream],Y + iny + iny + lda size+2 + sta [stream],Y + ldy #FILE_cnt no chars in buffer + lda #0 + sta [stream],Y + iny + iny + sta [stream],Y + stz err no error + +rts plb + creturn 2:err + end + +**************************************************************** +* +* int sprintf(s, format, additional arguments) +* char *format; +* +* Print the format string to a string. +* +**************************************************************** +* +sprintf start + using ~printfCommon + + phb use local addressing + phk + plb + plx remove the return address + ply + pla save the stream + sta string + pla + sta string+2 + phy restore return address/data bank + phx + plb + lda #put set up output routine + sta >~putchar+4 + lda #>put + sta >~putchar+5 + + tsc find the argument list address + clc + adc #8 + sta >args + pea 0 + pha + jsl ~printf call the formatter + sec compute the space to pull from the stack + pla + sbc >args + clc + adc #4 + sta >args + pla + phb remove the return address + plx + ply + tsc update the stack pointer + clc + adc >args + tcs + phy restore the return address + phx + plb + lda >~numChars return the value + rtl return + +put phb remove the char from the stack + plx + pla + ply + pha + phx + plb + ldx string+2 write to a file + phx + ldx string + phx + phd + tsc + tcd + tya + and #$00FF + sta [3] + pld + pla + pla + phb + phk + plb + inc4 string + plb + rtl + +args ds 2 original argument address +string ds 4 string address + end + +**************************************************************** +* +* int sscanf(s, format, additional arguments) +* char *s, *format; +* +* Read a string from a string. +* +**************************************************************** +* +sscanf start + using ~scanfCommon + + phb use local addressing + phk + plb + plx remove the return address + ply + pla save the stream + sta string + pla + sta string+2 + phy restore return address/data bank + phx + plb + + lda #get set up our routines + sta >~getchar+10 + lda #>get + sta >~getchar+11 + + lda #unget + sta >~putback+12 + lda #>unget + sta >~putback+13 + + brl ~scanf + +get ph4 string get a character + phd + tsc + tcd + lda [3] + and #$00FF + bne gt1 + dec4 string + lda #EOF +gt1 pld + ply + ply + inc4 string + rtl + +unget cmp #EOF put a character back + beq ug1 + dec4 string +ug1 rtl + +string ds 4 + end + +**************************************************************** +* +* sys_errlist - array of pointers to messages +* +**************************************************************** +* +sys_errlist start + dc a4'EUNDEF' 0th message is undefined + dc a4'EDOM' (if the size of this list changes, + dc a4'ERANGE' change sys_nerr in VARS.ASM) + dc a4'ENOMEM' + dc a4'ENOENT' + dc a4'EIO' + dc a4'EINVAL' + dc a4'EBADF' + dc a4'EMFILE' + dc a4'EACCESS' + dc a4'EEXISTS' + dc a4'ENOSPC' + +! Note: if more errors are added, change maxErr in perror(). + +EUNDEF cstr 'invalid error number' +EDOM cstr 'domain error' +ERANGE cstr '# too large, too small, or illegal' +ENOMEM cstr 'not enough memory' +ENOENT cstr 'no such file or directory' +EIO cstr 'I/O error' +EINVAL cstr 'invalid argument' +EBADF cstr 'bad file descriptor' +EMFILE cstr 'too many files are open' +EACCESS cstr 'access bits prevent the operation' +EEXISTS cstr 'the file exists' +ENOSPC cstr 'the file is too large' + end + +**************************************************************** +* +* char *tmpnam(buf) +* char *buf; +* +* Inputs: +* buf - Buffer to write the name to. Buf is assumed to +* be at least L_tmpnam characters long. It may be +* NULL, in which case the name is not written to +* a buffer. +* +* Outputs: +* Returns a pointer to the name, which is changed on the +* next call to tmpnam or tmpfile. +* +* Notes: +* If the work prefix is set, and is less than or equal +* to 15 characters in length, the file name returned is +* in the work prefix (3); otherwise, it is a partial path +* name. +* +**************************************************************** +* +tmpnam start + + csubroutine (4:buf),0 + phb + phk + plb + +lb1 OSGet_Prefix pr get the prefix + bcc lb2 + stz name+2 +lb2 short M + ldx name+2 + stz cname,X + ldx #7 update the file number +lb3 inc syscxxxx,X + lda syscxxxx,X + cmp #'9'+1 + bne lb4 + lda #'0' + sta syscxxxx,X + dex + cpx #3 + bne lb3 +lb4 long M append the two strings + ph4 #syscxxxx + ph4 #cname + jsl strcat + + ph4 #cname if the file exists then + jsl strlen + sta name+2 + OSGet_File_Info GIParm + bcc lb1 get a different name + + lda buf if buf != NULL then + ora buf+2 + beq lb5 + ph4 #cname move the string + ph4 buf + jsl strcpy + +lb5 lla buf,cname return the string pointer + plb + creturn 4:buf + +pr dc i'2' parameter block for OSGet_Prefix + dc i'3' + dc a4'name' + +name dc i'16,0' GS/OS name buffer +cname ds 26 part of name; also C buffer +GS_OSname dc i'8' used for OSGet_File_Info +syscxxxx dc c'SYSC0000',i1'0' for creating unique names + +GIParm dc i'2' used to see if the file exists + dc a4'name+2' + dc i'0' + end + +**************************************************************** +* +* FILE *tmpfile() +* +* Outputs: +* Returns a pointer to a temp file; NULL for error. +* +**************************************************************** +* +tmpfile start +f equ 1 file pointer + + csubroutine ,4 + + ph4 #type open a file with a temp name + ph4 #0 + jsl tmpnam + phx + pha + jsl fopen + sta f + stx f+2 + ora f+2 if sucessful then + beq lb1 + ldy #FILE_flag f->_flag |= _IOTEMPFILE + lda [f],Y + ora #_IOTEMPFILE + sta [f],Y + +lb1 creturn 4:f + +type cstr 'w+b' + end + +**************************************************************** +* +* int ungetc(c, stream) +* char c; +* FILE *stream; +* +* Return a character to the input stream. +* +* Inputs: +* c - character to return +* stream - stream to put it back in +* +* Outputs: +* Returns EOF if the attempt was unsuccessful; c if the +* attempt succeeded. +* +**************************************************************** +* +ungetc start + +char equ 1 characater to return + + csubroutine (2:c,4:stream),2 + + lda #EOF assume we will fail + sta char + ldy #FILE_flag error if the file is open for output + lda [stream],Y + bit #_IOWRT + bne rts + lda c error if EOF is pushed + cmp #EOF + beq rts + ldy #FILE_pbk+2 error if the buffer is full + lda [stream],Y + bpl rts + ldy #FILE_pbk push the old character (if any) + lda [stream],Y + ldy #FILE_pbk+2 + sta [stream],Y + ldy #FILE_pbk put back the character + lda c + and #$00FF + sta [stream],Y + sta char +rts long M + creturn 2:char + end + +**************************************************************** +* +* int vfprintf(stream, char *format, va_list arg) +* +* Print the format string to standard out. +* +**************************************************************** +* +vfprintf start + using ~printfCommon + + phb use local addressing + phk + plb + plx remove the return address + ply + pla save the stream + sta stream + pla + sta stream+2 + phy restore return address/data bank + phx + plb + lda >stream+2 verify that stream exists + pha + lda >stream + pha + jsl ~VerifyStream + bcc lb1 + lda #EIO + sta >errno + lda #EOF + bra rts +lb1 lda #put set up output routine + sta >~putchar+4 + lda #>put + sta >~putchar+5 + phd find the argument list address + tsc + tcd + lda [10] + pld + pea 0 + pha + jsl ~printf call the formatter + ply update the argument list pointer + plx + phd + tsc + tcd + tya + sta [10] + pld + phb remove the return address + plx + ply + tsc update the stack pointer + clc + adc #8 + tcs + phy restore the return address + phx + plb + lda >~numChars return the value + rtl return + +put phb remove the char from the stack + phk + plb + plx + pla + ply + pha + phx + plb + lda stream+2 write to a file + pha + lda stream + pha + phy + jsl fputc +rts rtl + +stream ds 4 stream address + end + +**************************************************************** +* +* int vprintf (const char *format, va_list arg) +* +* Print the format string to standard out. +* +**************************************************************** +* +vprintf start + using ~printfCommon + + lda #putchar set up the output hooks + sta >~putchar+4 + lda #>putchar + sta >~putchar+5 + phd find the argument list address + tsc + tcd + lda [10] + pld + pea 0 + pha + jsl ~printf call the formatter + ply update the argument list pointer + plx + phd + tsc + tcd + tya + sta [10] + pld + phb remove the return address + plx + ply + tsc update the stack pointer + clc + adc #8 + tcs + phy restore the return address + phx + plb + lda >~numChars return the value + rtl return + end + +**************************************************************** +* +* int vsprintf(char *s, char *format, va_list arg) +* +* Print the format string to a string. +* +**************************************************************** +* +vsprintf start + using ~printfCommon + + phb use local addressing + phk + plb + plx remove the return address + ply + pla save the stream + sta string + pla + sta string+2 + phy restore return address/data bank + phx + plb + lda #put set up output routine + sta >~putchar+4 + lda #>put + sta >~putchar+5 + + phd find the argument list address + tsc + tcd + lda [10] + pld + pea 0 + pha + jsl ~printf call the formatter + ply update the argument list pointer + plx + phd + tsc + tcd + tya + sta [10] + pld + phb remove the return address + plx + ply + tsc update the stack pointer + clc + adc #8 + tcs + phy restore the return address + phx + plb + lda >~numChars return the value + rtl return + +put phb remove the char from the stack + plx + pla + ply + pha + phx + plb + ldx string+2 write to a file + phx + ldx string + phx + phd + tsc + tcd + tya + and #$00FF + sta [3] + pld + pla + pla + phb + phk + plb + inc4 string + plb + rtl + +string ds 4 string address + end + +**************************************************************** +* +* ~Format_c - format a '%' character +* +* Inputs: +* ~fieldWidth - output field width +* ~paddChar - padd character +* ~leftJustify - left justify the output? +* +**************************************************************** +* +~Format_c private + using ~printfCommon +argp equ 7 argument pointer + + dec ~fieldWidth account for the width of the value + jsr ~RightJustify handle right justification + lda [argp] print the character + pha + jsl ~putchar + inc argp remove the parameter from the stack + inc argp + brl ~LeftJustify handle left justification + end + +**************************************************************** +* +* ~Format_d - format a signed decimal number +* ~Format_u - format an unsigned decimal number +* +* Inputs: +* ~fieldWidth - output field width +* ~paddChar - padd character +* ~leftJustify - left justify the output? +* ~isLong - is the operand long? +* ~precision - precision of output +* ~precisionSpecified - was the precision specified? +* ~sign - char to use for positive sign +* +* Note: The ~Format_IntOut entry point is used by other number +* formatting routines to write their number strings. +* +**************************************************************** +* +~Format_d private + using ~printfCommon +argp equ 7 argument pointer +; +; For signed numbers, if the value is negative, use the sign flag +; + lda ~isLong handle long values + beq sn1 + ldy #2 + lda [argp],Y + bpl cn0 + sec + lda #0 + sbc [argp] + sta [argp] + lda #0 + sbc [argp],Y + sta [argp],Y + bra sn2 +sn1 lda [argp] handle int values + bpl cn0 + eor #$FFFF + inc a + sta [argp] +sn2 lda #'-' + sta ~sign + +~Format_u entry +; +; Convert the number to an ASCII string +; +cn0 stz ~hexPrefix don't lead with 0x + lda ~isLong if the value is long then + beq cn1 + ldy #2 push a long value + lda [argp],Y + pha +! lda [argp] +! pha +! bra cn2 else +cn1 lda [argp] push an int value + pha +cn2 ph4 #~str push the string addr + ph2 #l:~str push the string buffer length + ph2 #0 do an unsigned conversion + lda ~isLong do the proper conversion + beq cn3 + _Long2Dec + bra pd1 +cn3 _Int2Dec +; +; Padd with the proper number of zeros +; +~Format_IntOut entry +pd1 lda ~precisionSpecified if the precision was not specified then + bne pd2 + lda #1 use a precision of 1 + sta ~precision +pd2 ldx ~precision if the precision is zero then + bne pd2a + lda ~str+l:~str-2 if the result is ' 0' then + cmp #'0 ' + bne dp0 + lda #' ' set the result to the null string + sta ~str+l:~str-2 + stz ~hexPrefix erase any hex prefix + bra dp0 +pd2a ldy #0 skip leading blanks + short M + lda #' ' +pd3 cmp ~str,Y + bne pd4 + iny + cpy #l:~str + bne pd3 + bra pd6 +pd4 cmp ~str,Y deduct any characters from the precision + beq pd5 + dex + beq pd5 + iny + cpy #l:~str + bne pd4 +pd5 stx ~precision +pd6 long M +; +; Determine the padding and do left padding +; +dp0 sub2 ~fieldWidth,~precision subtract off any remaining 0 padds + lda ~sign if the sign is non-zero, allow for it + beq dp1 + dec ~fieldWidth +dp1 lda ~hexPrefix if there is a hex prefix, allow for it + beq dp1a + dec ~fieldWidth + dec ~fieldWidth +dp1a ldx #0 determine the length of the buffer + ldy #l:~str-1 + short M + lda #' ' +dp2 cmp ~str,Y + beq dp3 + inx + dey + bpl dp2 +dp3 long M + sec subtract it from ~fieldWidth + txa + sbc ~fieldWidth + eor #$FFFF + inc a + sta ~fieldWidth + lda ~paddChar skip justification if we are padding + cmp #'0' + beq pn0 + jsr ~RightJustify handle right justification +; +; Print the number +; +pn0 lda ~sign if there is a sign character then + beq pn1 + pha print it + jsl ~putchar +pn1 lda ~hexPrefix if there is a hex prefix then + beq pn1a + pha print it + jsl ~putchar + ph2 ~hexPrefix+1 + jsl ~putchar +pn1a lda ~paddChar if the number needs 0 padding then + cmp #'0' + bne pn1c + lda ~fieldWidth + bmi pn1c + beq pn1c +pn1b ph2 ~paddChar print padd zeros + jsl ~putchar + dec ~fieldWidth + bne pn1b +pn1c lda ~precision if the number needs more padding then + beq pn3 +pn2 ph2 #'0' print padd characters + jsl ~putchar + dec ~precision + bne pn2 +pn3 ldy #-1 skip leading blanks in the number +pn4 iny + lda ~str,Y + and #$00FF + cmp #' ' + beq pn4 + +pn5 cpy #l:~str quit if we're at the end of the ~str + beq rn1 + phy save Y + lda ~str,Y print the character + and #$00FF + pha + jsl ~putchar + ply next character + iny + bra pn5 +; +; remove the number from the argument list +; +rn1 lda ~isLong + beq rn2 + inc argp + inc argp +rn2 inc argp + inc argp +; +; Handle left justification +; + brl ~LeftJustify handle left justification + end + +**************************************************************** +* +* ~Format_n - return the number of characters printed +* +* Inputs: +* ~numChars - characters written +* ~isLong - is the operand long? +* +**************************************************************** +* +~Format_n private + using ~printfCommon +argp equ 7 argument pointer + + ph4 argp save the original argp + ldy #2 dereference argp + lda [argp],Y + tax + lda [argp] + sta argp + stx argp+2 + lda ~numChars return the value + sta [argp] + lda ~isLong if long, set the high word + beq lb1 + ldy #2 + lda #0 + sta [argp],Y +lb1 clc restore the original argp+4 + pla + adc #4 + sta argp + pla + sta argp+2 + rts + end + +**************************************************************** +* +* ~Format_o - format an octal number +* +* Inputs: +* ~altForm - use a leading '0'? +* ~fieldWidth - output field width +* ~paddChar - padd character +* ~leftJustify - left justify the output? +* ~isLong - is the operand long? +* ~precision - precision of output +* ~precisionSpecified - was the precision specified? +* +**************************************************************** +* +~Format_o private + using ~printfCommon +argp equ 7 argument pointer +; +; Initialization +; + stz ~sign ignore the sign flag + lda #' ' initialize the string to blanks + sta ~str + move ~str,~str+1,#l:~str-1 + stz ~num+2 get the value to convert + lda ~isLong + beq cn2 + ldy #2 + lda [argp],Y + sta ~num+2 +cn2 lda [argp] + sta ~num +; +; Convert the number to an ASCII string +; + short I,M + ldy #l:~str-1 set up the character index +cn3 lda ~num+3 quit if the number is zero + ora ~num+2 + ora ~num+1 + ora ~num + beq al1 + lda #0 roll off 3 bits + ldx #3 +cn4 lsr ~num+3 + ror ~num+2 + ror ~num+1 + ror ~num + ror A + dex + bne cn4 + lsr A form a character + lsr A + lsr A + lsr A + lsr A + ora #'0' + sta ~str,Y save the character + dey + bra cn3 +; +; If a leading zero is required, be sure we include one +; +al1 cpy #l:~str-1 include a zero if no characters have + beq al2 been placed in the string + lda ~altForm branch if no leading zero is required + beq al3 +al2 lda #'0' + sta ~str,Y +al3 long I,M +; +; Piggy back off of ~Format_d for output +; + stz ~hexPrefix don't lead with 0x + brl ~Format_IntOut + end + +**************************************************************** +* +* ~Format_s - format a c-string +* ~Format_b - format a p-string +* +* Inputs: +* ~fieldWidth - output field width +* ~paddChar - padd character +* ~leftJustify - left justify the output? +* +**************************************************************** +* +~Format_s private + using ~printfCommon +argp equ 7 argument pointer + + ph4 argp save the original argp + ldy #2 dereference argp + lda [argp],Y + tax + lda [argp] + sta argp + stx argp+2 + short M determine the length of the string + ldy #-1 +lb1 iny + lda [argp],Y + bne lb1 + long M + tya + bra lb1a + +~Format_b entry + ph4 argp save the original argp + ldy #2 dereference argp + lda [argp],Y + tax + lda [argp] + sta argp + stx argp+2 + lda [argp] get the length of the string + and #$00FF + inc4 argp + +lb1a ldx ~precisionSpecified if the precision is specified then + beq lb2 + cmp ~precision if the precision is smaller then + blt lb2 + lda ~precision process only precision characters +lb2 sta ~num save the length in the temp variable area + sub2 ~fieldWidth,~num account for the width of the value + jsr ~RightJustify handle right justification + ldx ~num skip printing if the length is 0 + beq lb4 + ldy #0 print the characters +lb3 phy + lda [argp],Y + and #$00FF + pha + jsl ~putchar + ply + iny + dec ~num + bne lb3 +lb4 clc restore and increment argp + pla + adc #4 + sta argp + pla + sta argp+2 + brl ~LeftJustify handle left justification + end + +**************************************************************** +* +* ~Format_x - format a hexadecimal number (lowercase output) +* ~Format_X - format a hexadecimal number (uppercase output) +* ~Format_p - format a pointer +* +* Inputs: +* ~altForm - use a leading '0x'? +* ~fieldWidth - output field width +* ~paddChar - padd character +* ~leftJustify - left justify the output? +* ~isLong - is the operand long? +* ~precision - precision of output +* ~precisionSpecified - was the precision specified? +* +**************************************************************** +* +~Format_x private + using ~printfCommon +argp equ 7 argument pointer +; +; Set the "or" value; this is used to set the case of character results +; + lda #$20 + sta orVal + bra cn0 + +~Format_p entry + lda #1 + sta ~isLong +~Format_X entry + stz orVal +; +; Initialization +; +cn0 stz ~sign ignore the sign flag + lda #' ' initialize the string to blanks + sta ~str + move ~str,~str+1,#l:~str-1 + stz ~num+2 get the value to convert + lda ~isLong + beq cn2 + ldy #2 + lda [argp],Y + sta ~num+2 +cn2 lda [argp] + sta ~num + stz ~hexPrefix assume we won't lead with 0x +; +; Convert the number to an ASCII string +; + short I,M + ldy #l:~str-1 set up the character index +cn3 lda #0 roll off 4 bits + ldx #4 +cn4 lsr ~num+3 + ror ~num+2 + ror ~num+1 + ror ~num + ror A + dex + bne cn4 + lsr A form a character + lsr A + lsr A + lsr A + ora #'0' + cmp #'9'+1 if the character should be alpha, + blt cn5 adjust it + adc #6 + ora orVal +cn5 sta ~str,Y save the character + dey + lda ~num+3 loop if the number is not zero + ora ~num+2 + ora ~num+1 + ora ~num + bne cn3 +; +; If a leading '0x' is required, be sure we include one +; + lda ~altForm branch if no leading '0x' is required + beq al3 +al2 lda #'X' insert leading '0x' + ora orVal + sta ~hexPrefix+1 + lda #'0' + sta ~hexPrefix +al3 long I,M +; +; Piggy back off of ~Format_d for output +; + brl ~Format_IntOut +; +; Local data +; +orVal ds 2 for setting the case of characters + end + +**************************************************************** +* +* ~Format_Percent - format the '%' character +* +* Inputs: +* ~fieldWidth - output field width +* ~paddChar - padd character +* ~leftJustify - left justify the output? +* +**************************************************************** +* +~Format_Percent private + using ~printfCommon + + dec ~fieldWidth account for the width of the value + jsr ~RightJustify handle right justification + pea '%' print the character + jsl ~putchar + brl ~LeftJustify handle left justification + end + +**************************************************************** +* +* ~InitBuffer - prepare a file buffer for output +* +* Inputs: +* stream - buffer to prepare +* +**************************************************************** +* +~InitBuffer start + + csubroutine (4:stream),0 + + ldy #FILE_base+2 set the next buffer location + lda [stream],Y + tax + dey + dey + lda [stream],Y + ldy #FILE_ptr + sta [stream],Y + iny + iny + txa + sta [stream],Y + ldy #FILE_base set the end of buffer mark + lda [stream],Y + ldy #FILE_size + clc + adc [stream],Y + pha + txa + iny + iny + adc [stream],Y + ldy #FILE_end+2 + sta [stream],Y + pla + dey + dey + sta [stream],Y + ldy #FILE_size set the number of chars the buffer + lda [stream],Y can hold + tax + iny + iny + lda [stream],Y + ldy #FILE_cnt+2 + sta [stream],Y + dey + dey + txa + sta [stream],Y + + creturn + end + +**************************************************************** +* +* ~ioerror - flag an I/O error +* +* Inputs: +* stream - file to clear +* +* Outputs: +* errno - set to EIO +* stream->flag - error flag set +* +**************************************************************** +* +~ioerror start +stream equ 3 input stream + + tsc + phd + tcd + ldy #FILE_flag + lda [stream],Y + ora #_IOERR + sta [stream],Y + lda #EIO + sta >errno + pld + pla + ply + ply + pha + rts + end + +**************************************************************** +* +* ~LeftJustify - print padd characters for left justification +* ~RightJustify - print padd characters for right justification +* +* Inputs: +* ~fieldWidth - # chars to print ( <= 0 prints none) +* ~leftJustify - left justify the output? +* +**************************************************************** +* +~LeftJustify start + using ~printfCommon + + lda ~leftJustify padd if we are to left justify the field + bne padd +rts rts + +~RightJustify entry + + lda ~leftJustify quit if we are to left justify the field + bne rts +padd lda ~fieldWidth quit if the field width is <= 0 + bmi rts + beq rts +lb1 ph2 #' ' write the proper # of padd characters + jsl ~putchar + dec ~fieldWidth + bne lb1 + rts + end + +**************************************************************** +* +* ~osname - convert a c string to a GS/OS file name +* +* Inputs: +* filename - ptr to the c string +* +* Outputs: +* X-A - ptr to GS/OS file name +* +* Notes: +* 1. Returns nil for error. +* 2. Caller must dispose of the name with a free call. +* +**************************************************************** +* +~osname private +namelen equ 1 length of the string +ptr equ 3 pointer to return + + csubroutine (4:filename),6 + + ph4 filename get the length of the name buffer + jsl strlen + sta namelen + inc A + inc A + pea 0 reserve some memory + pha + jsl malloc + sta ptr + stx ptr+2 + ora ptr+2 + bne lb1 + lda #ENOMEM + sta >errno + brl lb3 +lb1 lda namelen set the name length + sta [ptr] + pea 0 copy the file name to the OS name buffer + pha + ph4 filename + clc + lda ptr + ldx ptr+2 + adc #2 + bcc lb2 + inx +lb2 phx + pha + jsl memcpy +lb3 creturn 4:ptr + end + +**************************************************************** +* +* int ~printf(char *format, additional arguments) +* +* Print the format string by calling ~putchar indirectly. If a +* '%' is found, it is interpreted as follows: +* +* Optional Flag Characters +* ------------------------ +* +* '-' Left justify the output. +* '0' Use '0' for the pad character rather than ' '. This +* flag is ignored if the '-' flag is also used. +* '+' Only used for conversion operations 'd' 'e' 'E' 'f' 'g' 'G'. +* Specifies that a leading sign is to be printed for +* positive values. +* ' ' Only used for conversion operations 'd' 'e' 'E' 'f' 'g' 'G'. +* Ignored if '+' is specified. For positive values, this +* causes a padd space to be written where the sign would +* appear. +* '#' Modify the conversion operation. +* +* Optional Min Field Width +* ------------------------ +* +* This field is either a number or *. If it is *, an integer +* argument is consumed from the stack and used as the field +* width. In either case, the output value is printed in a field +* that is NUMBER characters wide. By default, the value is +* right justified and blank padded. +* +* Optional Precision +* ------------------ +* +* This field is a number, *, or is ommitted. If it is an integer, +* an argument is removed from the stack and used as the precision. +* The precision is used to describe how many digits to print. +* +* Long Size Specification +* ----------------------- +* +* An 'l' indicates that the 'd', 'o', 'u', 'x' or 'X' argument is +* long. 'L' and 'u' are also accepted for compliance with ANSI C, +* but have no effect in this implementation. +* +* Conversion Specifier +* -------------------- +* +* d,i Signed decimal conversion from type int or long. +* u Signed decmal conversion from type unsigned or unsigned long. +* o Octal conversion. +* x,X Hexadecomal conversion. 'x' generates lowercase hex digits, +* while 'X' generates uppercase hex digits. +* c Character. +* s String. +* p Pascal string. +* n The argument is (int *); the number of characters written so +* far is written to the location. +* f Signed decimal floating point. +* e,E Exponential format floating point. +* g,G Use f,e or E, as appropriate. +* % Write a '%' character. +* +**************************************************************** +* +~printf private + using ~printfCommon + +argp equ 7 pointer to first argument +format equ 14 pointer to format code +; +; Set up the stack frame +; + phb save the caller's B + phk use local addressing + plb + phd save the caller's DP + tsc set up a DP + tcd +; +; Process the format string +; + stz ~numChars initialize the character counter +ps1 lda [format] get a character + and #$00FF + beq rt1 branch if at the end of the format string + cmp #'%' branch if this is a conversion + beq fm1 specification + pha write the character + jsl ~putchar + inc4 format + bra ps1 +; +; Remove the format parameter and return +; +rt1 lda format-2 move the return address + sta format+2 + lda format-3 + sta format+1 + pld restore DP + plb restore B + rtl return to top level formatter +; +; Handle a format specification +; +fm1 inc4 format skip the '%' + + stz ~removeZeros not a G specifier + stz ~fieldWidth use only the space required + stz ~precision use the default precision + stz ~precisionSpecified + stz ~isLong assume short operands + lda #' ' use a blank for padding + sta ~paddChar + stz ~leftJustify right justify the output + stz ~sign don't print the sign unless arg < 0 + stz ~altForm use the primary output format + +fm2 jsr Flag read and interpret flag characters + bcs fm2 + jsr GetSize get the field width (if any) + sta ~fieldWidth + lda [format] if format == '.' then + and #$00FF + cmp #'.' + bne fm3 + inc4 format skip the '.' + inc ~precisionSpecified note that the precision is specified + jsr GetSize get the precision + sta ~precision + lda [format] if *format == 'l' then + and #$00FF +fm3 cmp #'l' + bne fm4 + inc ~isLong ~isLong = true + bra fm5 ++format +fm4 cmp #'L' else if *format in ['L','h'] then + beq fm5 + cmp #'h' + bne fm6 +fm5 inc4 format ++format + lda [format] find the proper format character + and #$00FF +fm6 inc4 format + ldx #fListEnd-fList-4 +fm7 cmp fList,X + beq fm8 + dex + dex + dex + dex + bpl fm7 + brl ps1 none found - continue +fm8 pea ps1-1 push the return address + inx call the subroutine + inx + jmp (fList,X) +; +; Flag - Read and process a flag character +; +; If a flag character was found, the carry flag is set. +; +Flag lda [format] get the character + and #$00FF + cmp #'-' if it is a '-' then + bne fl1 + lda #1 left justify the output + sta ~leftJustify + bra fl5 + +fl1 cmp #'0' if it is a '0' then + bne fl2 + sta ~paddChar padd with '0' characters + bra fl5 + +fl2 cmp #'+' if it is a '+' or ' ' then + beq fl3 + cmp #' ' + bne fl4 + ldx ~sign + cpx #'+' + beq fl5 +fl3 sta ~sign set the sign flag + bra fl5 + +fl4 cmp #'#' if it is a '#' then + bne fl6 + lda #1 use the alternate output form + sta ~altForm +fl5 inc4 format skip the format character + sec + rts + +fl6 clc no flag was found + rts +; +; GetSize - get a numeric value +; +; The value is returned in A +; +GetSize stz val assume a value of 0 + lda [format] if the format character is '*' then + and #$00FF + cmp #'*' + bne gs1 + inc4 format skip the '*' char + lda [argp] fetch the value + sta val + inc argp remove it from the argument list + inc argp +gs0 lda val + rts + +gs1 lda [format] while the character stream had digits do + and #$00FF + cmp #'0' + blt gs0 + cmp #'9'+1 + bge gs0 +gs2 and #$000F save the ordinal value + pha + asl val A := val*10 + lda val + asl a + asl a + adc val + adc 1,S A := A+ord([format]) + plx + sta val val := A + inc4 format skip the character + bra gs1 + +val ds 2 value +; +; List of format specifiers and the equivalent subroutines +; +fList dc c'%',i1'0',a'~Format_Percent' % + dc c'n',i1'0',a'~Format_n' n + dc c's',i1'0',a'~Format_s' s + dc c'b',i1'0',a'~Format_b' b + dc c'p',i1'0',a'~Format_p' p + dc c'c',i1'0',a'~Format_c' c + dc c'X',i1'0',a'~Format_X' X + dc c'x',i1'0',a'~Format_x' x + dc c'o',i1'0',a'~Format_o' o + dc c'u',i1'0',a'~Format_u' u + dc c'd',i1'0',a'~Format_d' d + dc c'i',i1'0',a'~Format_d' i + dc c'f',i1'0',a'~Format_f' f + dc c'e',i1'0',a'~Format_e' e + dc c'E',i1'0',a'~Format_E' E + dc c'g',i1'0',a'~Format_g' g + dc c'G',i1'0',a'~Format_G' G +fListEnd anop + end + +**************************************************************** +* +* ~printfCommon - common data for formatted output +* +**************************************************************** +* +~printfCommon data +; +; ~putchar is a vector to the proper output routine. +; +~putchar dc h'EE',i'~numChars' inc ~numChars + dc h'5C 00 00 00' +; +; Format options +; +~altForm ds 2 use alternate output format? +~fieldWidth ds 2 output field width +~hexPrefix ds 2 hex 0x prefix characters (if present) +~isLong ds 2 is the operand long? +~leftJustify ds 2 left justify the output? +~paddChar ds 2 output padd character +~precision ds 2 precision of output +~precisionSpecified ds 2 was the precision specified? +~removeZeros ds 2 remove insignificant zeros? (g specifier) +~sign ds 2 char to use for positive sign +; +; Work buffers +; +~num ds 4 long integer +~numChars ds 2 number of characters printed with this printf +~str ds 83 string buffer +; +; Real formatting +; +~decForm anop controls SANE's formatting styles +~style ds 2 0 -> exponential; 1 -> fixed +~digits ds 2 sig. digits; decimal digits + +~decRec anop decimal record +~sgn ds 2 sign +~exp ds 2 exponent +~sig ds 29 significant digits + end + +**************************************************************** +* +* ~RemoveWord - remove Y words from the stack for printf +* +* Inputs: +* Y - number of words to remove (must be >0) +* +**************************************************************** +* +~RemoveWord start + +lb1 lda 13,S move the critical values + sta 15,S + lda 11,S + sta 13,S + lda 9,S + sta 11,S + lda 7,S + sta 9,S + lda 5,S + sta 7,S + lda 3,S + sta 5,S + pla + sta 1,S + + tdc update the direct page location + inc a + inc a + tcd + + dey next word + bne lb1 + rts + end + +**************************************************************** +* +* ~Scan_c - read a character or multiple characters +* +* Inputs: +* ~scanWidth - # of characters to read (0 implies one) +* ~suppress - suppress save? +* +**************************************************************** +* +~Scan_c private + using ~scanfCommon +arg equ 11 argument + + lda ~scanWidth if ~scanWidth == 0 then + bne lb1 + inc ~scanWidth ~scanWidth = 1 + +lb1 jsl ~getchar get the character + cmp #EOF if at EOF then + bne lb1a + sta ~eofFound ~eofFound = EOF + lda ~suppress if input is not suppressed then + bne lb3 + dec ~assignments no assignment made + bra lb3 bail out + +lb1a ldx ~suppress if input is not suppressed then + bne lb2 + short M save the value + sta [arg] + long M + inc4 arg update the pointer +lb2 dec ~scanWidth next character + bne lb1 +lb3 lda ~suppress if input is not suppressed then + bne lb4 + ldy #2 + jsr ~RemoveWord remove the parameter from the stack +lb4 rts + end + +**************************************************************** +* +* ~Scan_d - read an integer +* ~Scan_i - read a based integer +* +* Inputs: +* ~scanError - has a scan error occurred? +* ~scanWidth - max input length +* ~suppress - suppress save? +* ~size - size specifier +* +**************************************************************** +* +~Scan_d private + using ~scanfCommon +arg equ 11 argument + + stz based always use base 10 + bra bs1 +~Scan_i entry + lda #1 allow base 8, 10, 16 + sta based + +bs1 stz read no chars read + lda #10 assume base 10 + sta base + stz val initialize the value to 0 + stz val+2 +lb1 jsl ~getchar skip leading whitespace... + cmp #EOF if EOF then + bne ef1 + sta ~eofFound ~eofFound = EOF + lda ~suppress if input is not suppressed then + bne lb6l + dec ~assignments no assignment made +lb6l brl lb6 bail out +ef1 tax {...back to skipping whitespace} + lda __ctype+1,X + and #_space + bne lb1 + inc read + txa + stz minus assume positive number + cmp #'+' skip leading + + beq sg1 + cmp #'-' if - then set minus flag + bne sg2 + inc minus +sg1 jsl ~getchar + inc read +sg2 ldx based if base 8, 16 are allowed then + beq lb2 + cmp #'0' if the digit is '0' then + bne lb2 + lda #8 assume base 8 + sta base + dec ~scanWidth get the next character + jeq lb4a + bpl lb1a + stz ~scanWidth +lb1a jsl ~getchar + inc read + cmp #'X' if it is X then + beq lb1b + cmp #'x' + bne lb2 +lb1b asl base use base 16 + dec ~scanWidth get the next character + beq lb4a + bpl lb1c + stz ~scanWidth +lb1c jsl ~getchar + inc read + +lb2 cmp #'0' if the char is a digit then + blt lb4 + cmp #'7'+1 + blt lb2a + ldx base + cpx #8 + beq lb4 + cmp #'9'+1 + blt lb2a + cpx #16 + bne lb4 + and #$00DF + cmp #'A' + blt lb4 + cmp #'F'+1 + bge lb4 + sbc #6 +lb2a and #$000F convert it to a value + pha save the value + ph4 val update the old value + lda base + ldx #0 + jsl ~UMUL4 + pl4 val + pla add in the new digit + clc + adc val + sta val + bcc lb3 + inc val+2 +lb3 dec ~scanWidth quit if the max # chars have been + beq lb4a scanned + bpl lb3a make sure 0 stays a 0 + stz ~scanWidth +lb3a jsl ~getchar next char + inc read + bra lb2 + +lb4 jsl ~putback put the last character back + dec read +lb4a lda read if no chars read then + bne lb4b + inc ~scanError ~scanError = true + lda ~suppress if input is not suppressed then + bne lb6 + dec ~assignments no assignment made + bra lb6 skip the save +lb4b lda ~suppress if input is not suppressed then + bne lb7 + lda minus if minus then + beq lb4c + sub4 #0,val,val negate the value +lb4c lda val save the value + sta [arg] + dec ~size + bmi lb6 + ldy #2 + lda val+2 + sta [arg],Y +lb6 lda ~suppress if input is not suppressed then + bne lb7 + ldy #2 remove the parameter from the stack + jsr ~RemoveWord +lb7 rts + +val ds 4 value +base dc i4'10' constant for mul4 +based ds 2 based conversion? +minus ds 2 is the value negative? +read ds 2 # chars read + end + +**************************************************************** +* +* ~Scan_lbrack - read character in a set +* +* Inputs: +* ~scanWidth - max input length +* ~suppress - suppress save? +* ~size - size specifier +* +**************************************************************** +* +~Scan_lbrack private + using ~scanfCommon + using ~printfCommon +arg equ 11 argument +format equ 7 pointer to format code + + stz read no characters read into the set + stz didOne no characters scanned from the stream + move #0,~str,#32 clear the set + stz negate don't negate the set + lda [format] if the first char is '^' then + and #$00FF + cmp #'^' + bne lb2 + dec negate negate the set +lb1 inc4 format skip the ^ +lb2 lda [format] while *format != ']' do + and #$00FF + ldx read but wait: ']' as the first char is + beq lb2a allowed! + cmp #']' + beq lb3 +lb2a inc read + jsr Set set the char's bit + ora ~str,X + sta ~str,X + bra lb1 next char +lb3 inc4 format skip the ']' + ldy #30 negate the set (if needed) +lb4 lda ~str,Y + eor negate + sta ~str,Y + dey + dey + bpl lb4 + +lb5 jsl ~getchar get a character + cmp #EOF quit if at EOF + beq lb8 + pha quit if not in the set + jsr Set + ply + and ~str,X + beq lb7 + sty didOne note that we scanned a character + ldx ~suppress if output is not suppressed then + bne lb6 + tya + short M save the character + sta [arg] + long M + inc4 arg update the argument +lb6 dec ~scanWidth note that we processed one + beq lb8 + bpl lb5 + stz ~scanWidth + bra lb5 next char + +lb7 tya put back the last char scanned + jsl ~putback + +lb8 lda didOne if no chars read then + bne lb8a + inc ~scanError ~scanError = true + lda ~suppress if input is not suppressed then + bne lb9 + dec ~assignments no assignment made + bra lb8b skip the save +lb8a lda ~suppress if output is not suppressed then + bne lb9 + short M set the terminating null + lda #0 + sta [arg] + long M + +lb8b ldy #2 remove the parameter from the stack + jsr ~RemoveWord +lb9 rts +; +; Set - form a set disp/bit pattern from a character value +; +Set ldx #1 + stx disp +st1 bit #$0007 + beq st2 + asl disp + dec A + bra st1 +st2 lsr A + lsr A + lsr A + tax + lda disp + rts + +negate ds 2 negate the set? +disp ds 2 used to form the set disp +read ds 2 number of characters in the scan set +didOne ds 2 non-zero if we have scanned a character + end + +**************************************************************** +* +* ~Scan_n - return the # of characters scanned so far +* +* Inputs: +* ~suppress - suppress save? +* +* Notes: +* Decrements ~assignments so the increment in scanf will +* leave the assignment count unaffected by this call. +* +**************************************************************** +* +~Scan_n private + using ~scanfCommon +arg equ 11 argument + + ldx ~suppress if output is not suppressed then + bne lb1 + lda ~scanCount save the count + sta [arg] + dec ~assignments fix assignment count +lb1 ldy #2 remove the parameter from the stack + jsr ~RemoveWord + rts + end + +**************************************************************** +* +* ~Scan_b - read a pascal string +* ~Scan_s - read a c string +* +* Inputs: +* ~scanError - has a scan error occurred? +* ~scanWidth - max input length +* ~suppress - suppress save? +* ~size - size specifier +* +**************************************************************** +* +~Scan_b private + using ~scanfCommon +arg equ 11 argument + + move4 arg,length save the location to store the length + inc4 arg increment to the first char position + lda #1 + sta pString set the p-string flag + bra lb1 +~Scan_s entry + stz pString clear the p-string flag + +lb1 jsl ~getchar skip leading whitespace + cmp #EOF + bne lb2 + inc ~scanError + lda ~suppress (no assignment made) + bne lb6 + dec ~assignments + bra lb6 +lb2 tax + lda __ctype+1,X + and #_space + bne lb1 + +lb2a txa + ldx ~suppress if output is not suppressed then + bne lb3 + short M save the character + sta [arg] + long M + inc4 arg update the argument +lb3 dec ~scanWidth note that we processed one + beq lb5 + bpl lb4 + stz ~scanWidth +lb4 jsl ~getchar next char + cmp #EOF quit if at EOF + beq lb5 + and #$00FF loop if not whitespace + tax + lda __ctype+1,X + and #_space + beq lb2a + txa whitespace: put it back + jsl ~putback + +lb5 lda ~suppress if output is not suppressed then + bne lb6 + short M set the terminating null + lda #0 + sta [arg] + long M + lda pString if this is a p-string then + beq lb6 + sec compute the length + lda arg + sbc length + dec A + ldx length set up the address + stx arg + ldx length+2 + stx arg+2 + short M save the length + sta [arg] + long M + +lb6 lda ~suppress if output is not suppressed then + bne lb7 + ldy #2 remove the parameter from the stack + jsr ~RemoveWord +lb7 rts + +length ds 4 ptr to the length byte (p string only) +pString ds 2 is this a p string? + end + +**************************************************************** +* +* ~Scan_percent - read a % character +* +* Inputs: +* ~scanWidth - max input length +* ~suppress - suppress save? +* ~size - size specifier +* +**************************************************************** +* +~Scan_percent private + using ~scanfCommon +arg equ 11 argument + + jsl ~getchar get the character + cmp #'%' if it is not a percent then + beq lb1 + jsl ~putback put it back + inc ~scanError note the error + lda ~suppress if input is not suppressed then + bne lb1 + dec ~assignments no assignment done +lb1 rts + end + +**************************************************************** +* +* ~Scan_u - read an unsigned integer +* ~Scan_o - read an unsigned octal integer +* ~Scan_x - read an unsigned hexadecimal integer +* ~Scan_p - read a pointer +* +* Inputs: +* ~scanWidth - max input length +* ~suppress - suppress save? +* ~size - size specifier +* +**************************************************************** +* +~Scan_u private + using ~scanfCommon +arg equ 11 argument + + jsr Init + lda #10 base 10 + bra bs1 + +~Scan_o entry + jsr Init + lda #8 base 8 + bra bs1 + +~Scan_p entry + lda #1 + sta ~size +~Scan_x entry + jsr Init + jsl ~getchar if the initial char is a '0' then + inc read + sta ch + cmp #'0' + bne hx2 + dec ~scanWidth get the next character + jeq lb4a + bpl hx1 + stz ~scanWidth +hx1 jsl ~getchar + inc read + sta ch + cmp #'x' if it is an 'x' or 'X' then + beq hx1a + cmp #'X' + bne hx2 +hx1a dec ~scanWidth accept the character + jeq lb4a + bpl hx3 + stz ~scanWidth + bra hx3 +hx2 jsl ~putback put back the character + dec read +hx3 lda #16 base 16 + +bs1 sta base set the base + +lb2 jsl ~getchar if the char is a digit then + inc read + sta ch + cmp #'0' + blt lb4 + cmp #'7'+1 + blt lb2a + ldx base + cpx #8 + beq lb4 + cmp #'9'+1 + blt lb2a + cpx #16 + bne lb4 + and #$00DF + cmp #'A' + blt lb4 + cmp #'F'+1 + bge lb4 + sbc #6 +lb2a and #$000F convert it to a value + pha save the value + ph4 val update the old value + lda base + ldx base+2 + jsl ~UMUL4 + pl4 val + pla add in the new digit + clc + adc val + sta val + bcc lb3 + inc val+2 +lb3 dec ~scanWidth quit if the max # chars have been + beq lb4a scanned + bpl lb2 make sure 0 stays a 0 + stz ~scanWidth + bra lb2 + +lb4 lda ch put the last character back + jsl ~putback + dec read +lb4a lda read if no chars read then + bne lb4b + inc ~scanError ~scanError = true + lda ~suppress if input is not suppressed then + bne lb6 + dec ~assignments no assignment made + bra lb6 remove the parameter +lb4b lda ~suppress if input is not suppressed then + bne lb7 + lda val save the value + sta [arg] + dec ~size + bmi lb6 + ldy #2 + lda val+2 + sta [arg],Y +lb6 lda ~suppress if input is not suppressed then + bne lb7 + ldy #2 remove the parameter from the stack + jsr ~RemoveWord +lb7 rts +; +; Initialization +; +Init stz read no chars read + stz val initialize the value to 0 + stz val+2 +in1 jsl ~getchar skip leading whitespace... + cmp #EOF if at EOF then + bne in2 + lda ~suppress if input is not suppressed then + bne in1a + dec ~assignments no assignment made +in1a sta ~eofFound eofFound = EOF + pla pop stack + bra lb6 bail out +in2 tax ...back to slipping whitespace + lda __ctype+1,X + and #_space + bne in1 + txa + jsl ~putback + rts + +ch ds 2 char buffer +val ds 4 value +base dc i4'10' constant for mul4 +based ds 2 based conversion? +read ds 2 # chars read + end + +**************************************************************** +* +* int ~scanf(format, additional arguments) +* char *format; +* +* Scan by calling ~getchar indirectly. If a '%' is found, it +* is interpreted as follows: +* +* Assignment Suppression Flag +* --------------------------- +* +* '*' Do everyting but save the result and remove a pointer from +* the stack. +* +* Max Field Width +* --------------- +* +* No more than this number of characters are removed from the +* input stream. +* +* Size Specification +* ------------------ +* +* 'h' Used with 'd', 'u', 'o' or 'x' to indicate a short store. +* 'l' Used with 'd', 'u', 'o' or 'x' to indicate a four-byte store. +* Also used with 'e', 'f' or 'g' to indicate double reals. +* +* Conversion Specifier +* -------------------- +* +* d,i Signed decimal conversion to type int or long. +* u Signed decmal conversion to type unsigned short, unsigned or +* unsigned long. +* o Octal conversion. +* x,X Hexadecomal conversion. +* c Character. +* s String. +* p Pascal string. +* n The argument is (int *); the number of characters written so +* far is written to the location. +* f,e,E,g,G Signed floating point conversion. +* % Read a '%' character. +* [ Scan and included characters and place them in a string. +* +**************************************************************** +* +~scanf private + using ~scanfCommon + +arg equ format+4 first argument +format equ 7 pointer to format code +; +; Set up the stack frame +; + phb save the caller's B + phk use local addressing + plb + phd save the caller's DP + tsc set up a DP + tcd +; +; Process the format string +; + stz ~assignments no assignments yet + stz ~scanCount no characters scanned + stz ~scanError no scan error so far + stz ~eofFound eof was not the first char + jsl ~getchar test for eof + cmp #EOF + bne ps0 + sta ~eofFound +ps0 jsl ~putback + +ps1 lda ~scanError quit if a scan error has occurred + bne rm1 + lda [format] get a character + and #$00FF + jeq rt1 branch if at the end of the format string + + tax if this is a whitespace char then + lda __ctype+1,X + and #_space + beq ps4 +ps2 inc4 format skip whitespace in the format string + lda [format] + and #$00FF + tax + lda __ctype+1,X + and #_space + bne ps2 +ps3 jsl ~getchar skip whitespace in the input stream + tax + cpx #EOF + beq ps3a + lda __ctype+1,X + and #_space + bne ps3 +ps3a txa + jsl ~putback + bra ps1 + +ps4 cpx #'%' branch if this is a conversion + beq fm1 specification + + stx ch make sure the char matches the format + inc4 format specifier + jsl ~getchar + cmp ch + beq ps1 + jsl ~putback put the character back +; +; Remove the parameters for remaining conversion specifications +; +rm1 lda [format] if this is a format specifier then + and #$00FF + beq rt1 + cmp #'%' + bne rm4 + inc4 format if it is not a '%' or '*' then + lda [format] + and #$00FF + beq rt1 + cmp #'%' + beq rm4 + cmp #'*' + beq rm4 + cmp #'[' if it is a '[' then + bne rm3 +rm2 inc4 format skip up to the closing ']' + lda [format] + and #$00FF + beq rt1 + cmp #']' + bne rm2 +rm3 ldy #2 remove an addr from the stack + jsr ~RemoveWord +rm4 inc4 format next format character + bra rm1 +; +; Remove the format parameter and return +; +rt1 lda format-2 move the return address + sta format+2 + lda format-3 + sta format+1 + pld restore DP + plb restore B + pla remove the extra 4 bytes from the stack + pla + lda >~assignments return the number of assignments + bne rt2 + lda >~eofFound return EOF if no characters scanned +rt2 rtl +; +; Handle a format specification +; +fm1 inc4 format skip the '%' + inc ~assignments another one made... + + stz ~suppress assignment is not suppressed + stz ~size default operand size + + lda [format] if the char is an '*' then + and #$00FF + cmp #'*' + bne fm2 + inc ~suppress suppress the output + dec ~assignments no assignment made + inc4 format skip the '*' + +fm2 jsr GetSize get the field width specifier + sta ~scanWidth + + lda [format] if the character is an 'l' then + and #$00FF + cmp #'l' + bne fm3 + inc ~size long specifier + bra fm4 +fm3 cmp #'h' else if it is an 'h' then + bne fm5 +fm4 inc4 format ignore the character + +fm5 lda [format] find the proper format character + and #$00FF + inc4 format + ldx #fListEnd-fList-4 +fm7 cmp fList,X + beq fm8 + dex + dex + dex + dex + bpl fm7 + brl ps1 none found - continue +fm8 pea ps1-1 push the return address + inx call the subroutine + inx + jmp (fList,X) +; +; GetSize - get a numeric value +; +; The value is returned in A +; +GetSize stz val assume a value of 0 +gs1 lda [format] while the character stream had digits do + and #$00FF + cmp #'0' + blt gs3 + cmp #'9'+1 + bge gs3 +gs2 and #$000F save the ordinal value + pha + asl val A := val*10 + lda val + asl a + asl a + adc val + adc 1,S A := A+ord([format]) + plx + sta val val := A + inc4 format skip the character + bra gs1 +gs3 lda val + rts + +val ds 2 value +; +; List of format specifiers and the equivalent subroutines +; +fList dc c'd',i1'0',a'~Scan_d' d + dc c'i',i1'0',a'~Scan_i' i + dc c'u',i1'0',a'~Scan_u' u + dc c'o',i1'0',a'~Scan_o' o + dc c'x',i1'0',a'~Scan_x' x + dc c'X',i1'0',a'~Scan_x' X + dc c'p',i1'0',a'~Scan_p' p + dc c'c',i1'0',a'~Scan_c' c + dc c's',i1'0',a'~Scan_s' s + dc c'b',i1'0',a'~Scan_b' b + dc c'n',i1'0',a'~Scan_n' n + dc c'f',i1'0',a'~Scan_f' f + dc c'e',i1'0',a'~Scan_f' e + dc c'E',i1'0',a'~Scan_f' E + dc c'g',i1'0',a'~Scan_f' g + dc c'G',i1'0',a'~Scan_f' G + dc c'%',i1'0',a'~Scan_percent' % + dc c'[',i1'0',a'~Scan_lbrack' [ +fListEnd anop +; +; Other local data +; +ch ds 2 temp storage + end + +**************************************************************** +* +* ~scanfCommon - common data for formatted input +* +**************************************************************** +* +~scanfCommon data +; +; ~getchar is a vector to the proper input routine. +; +~getchar dc h'AF',a3'~scanCount' lda >~scanCount + dc h'1A' inc A + dc h'8F',a3'~scanCount' sta >~scanCount + dc h'5C 00 00 00' +; +; ~putback is a vector to the proper putback routine. +; +~putback dc h'48' pha + dc h'AF',a3'~scanCount' lda >~scanCount + dc h'3A' dec A + dc h'8F',a3'~scanCount' sta >~scanCount + dc h'68' pla + dc h'5C 00 00 00' +; +; global variables +; +~assignments ds 2 # of assignments made +~eofFound ds 2 was EOF found during the scan? +~suppress ds 2 suppress assignment? +~scanCount ds 2 # of characters scanned +~scanError ds 2 set to 1 by scaners if an error occurs +~scanWidth ds 2 max # characters to scan +~size ds 2 size specifier; -1 -> short, 1 -> long, +! 0 -> default + end + +**************************************************************** +* +* ~SetFilePointer - makes sure nothing is in the input buffer +* +* Inputs: +* stream - stream to check +* +**************************************************************** +* +~SetFilePointer private + + csubroutine (4:stream),0 + + ldy #FILE_pbk if stream->FILE_pbk != -1 + lda [stream],Y + inc A + ldy #FILE_cnt or stream->FILE_cnt != 0 then + ora [stream],Y + iny + iny + ora [stream],Y + beq lb1 + ph2 #SEEK_CUR fseek(stream, 0L, SEEK_CUR) + ph4 #0 + ph4 stream + jsl fseek + +lb1 anop + creturn + end + +**************************************************************** +* +* ~VerifyStream - insures that a stream actually exists +* +* Inputs: +* stream - stream to check +* +* Outputs: +* C - set for error; clear if the stream exists +* +**************************************************************** +* +~VerifyStream private +stream equ 9 stream to check +ptr equ 1 stream pointer + + phb set up the stack frame + phk + plb + ph4 #stdin+4 + tsc + phd + tcd + +lb1 lda ptr error if the list is exhausted + ora ptr+2 + beq err + lda ptr OK if the steams match + cmp stream + bne lb2 + lda ptr+2 + cmp stream+2 + beq OK +lb2 ldy #2 next pointer + lda [ptr],Y + tax + lda [ptr] + sta ptr + stx ptr+2 + bra lb1 + +err lda #EIO set the error code + sta >errno + sec return with error + bra OK2 + +OK clc return with no error +OK2 pld + pla + pla + plx + ply + pla + pla + phy + phx + plb + rtl + end diff --git a/bin/cc.notes b/bin/cc.notes old mode 100755 new mode 100644 index eb69b2f..e9b3e4a --- a/bin/cc.notes +++ b/bin/cc.notes @@ -1 +1,905 @@ -ORCA/C 2.1.1 Copyright 1997, Byte Works Inc. -- Change List -------------------------------------------------------------- 2.1.1 1. Bugs squashed. See bug notes, below. 2.1.0 1. Bugs squashed. See bug notes, below. 2. New bit added for vararg stack repair removal. See #pragma optimize, below. 3. There have been several changes to assert(). See the Manual Erratta for page 343 for details. 4. C supports the extended character set. See "Extended Characters." 5. You can create defaults that are used in all of your C programs using the new defaults.h file. See "The Default .h File." 6. ORCA/C supports // comments. See "// Comments." 2.0.3 1. Bugs squashed. See bug notes, below. 2.0.2 1. Bugs squashed. See bug notes, below. 2.0.1 1. Bugs squashed. See bug notes, below. -- Bugs from C 2.1.1 B1 that have been fixed -------------------------------- These bugs appeared in a beta release. They did not appear in any commercial release, but we introduced during bug corrections. These notes will be removed in the commercial release notes. 1. Reserved words appearing in macros were not correctly scanned. (Mike Westerfield) -- Manual Erratta ----------------------------------------------------------- p. 40 The description of the action function says it takes a single integer parameter. Actually, it takes two parameters, as shown in the example on page 41. Both the description and the sample on page 41 indicate that the action procedure for an NDA should return void. Actually, the action routine should return int, returning 0 if it handled the action and 1 if it did not. The correct function looks like this: int Action (long param, int code) { int handledEvent = 0; <<>> return handledEvent; } The description of the init function doesn't point out some important limitations. When this call is made at shutdown time, your NDA has already been placed in a dormant state, and all RAM has been deallocated. (This happened when the close function was called.) If you need dynamic memory for any purpose, be sure you obtain a valid user ID, and that you dispose of the memory after you are finished with it. Do not rely on C memory management functions at shutdown time. Static variables are safe, though, and can be used to pass information to the init function for use at shutdown time. p. 67 Delete the paragraph starting "One important point is that you should never reinitialize the Text Tool Set. ..." ORCA/C no longer uses the Text Tool Set for routine input and output, and definitely does not use it for I/O redirection. p. 100 The text does not mention the sixth default character. It is not used by PRIZM, though. For details on the 6th default character (as well as the 5th) see page 193, where their use by the text based editor is described. p. 101 The sample SYSTABS line at the top of the page should start 8 100110 p. 107 The table shows the language number for C as 7. It should be 8. p. 240 The discussion of escape sequences states that numeric escape sequences can contain from one to three digits. This was true until ORCA/C 2.1, when the compiler was changed to respect the ANSI C standard. The compiler will now scan an octal numeric escape sequence until no more octal characters are found, and it will scan a hexadecimal numeric escape sequence until no more hexadecimal characters are found. In both cases, the result is then anded with 0x00FF to yield a single character. The discussion concerning floating-point constants is misleading. While constants are indeed handled as extended values in the executable program, the compiler itself uses double values for the constants internally, so you need to adhere to the valid exponent range for double values, and you should expect to see accuracy in constants that is in line with double values. p. 241 ORCA/C now supports // comments. See "// Comments," below. p. 250 Several things are listed that will cause a .sym file to stop or not be built at all. Add to this list a #append, which does not work like a #include. It's worth keeping in mind that #append in included in ORCA/C solely for the purpose of appending files of a different language. There are several advantages to using #append to tack assembly language source to the end of a C source file, but there is no other place in ORCA/C where a #append is more useful than a #include. p.258 The #pragma ignore directive supports a new bit. Bit 3 controls whether // comments are allowed. If bit 3 is set, as in #pragma ignore 0x0008 ORCA/C supports // comments. If bit 3 is clear, ORCA/C does not support // comments, which are not actually allowed in ANSI C programs. See "// Comments," below, for a complete description of // comments. p. 263 1. The discussion of NDAs is on page 40, not page 58. 2. There is a new optimization bit for #pragma optimize. See #pragma optimize, below. p. 337 The ORCA/C compiler is intended as a faithful implementation of ANSI C with some extensions, but there have always been some library functions from ANSI C that were missing in ORCA/C. Chapter 19 should start with a summary of these omissions. They are: locale.h This header file is missing completely, along with all of its functions. stdlib.h The functions mblen(), mbstowcs(), mbtowc(), wcstombs() and wctomb() are missing. These are related to locale.h. string.h strcoll() and strxfrm() are missing. These are related to locale.h. time.h The function strftime() is missing. p. 343 The documentation states that assert() uses exit(-1) to exit a program. Actually, it uses abort(). Beginning with ORCA/C 2.1, assert() prints a string that includes the assertion itself, not just the line number and file name. The assertion has the form Assertion failed: file :hd:foo.cc, line 47; assertion: bar==1 The documentaion states assert() writes to stdout. Beginning with ORCA/C 2.1, it writes to stderr. p. 353 The discussion of _exit() should note that the _exit() function is an extension to ANSI C. p. 375 The discussion of isascii() should note that isascii() is an extension to ANSI C. p. 376 The discussions of iscsym() and iscsymf() should note that these functions are extensions to ANSI C. p. 377 The discussion of isodigit() should note that isodigit() is an extension to ANSI C. p. 396 The discussion of strpos() and strrpos() should note that the these functions are an extension to ANSI C. p. 398 The discussion of strrpbrk() should note that the strrpbrk() function is an extension to ANSI C. p. 404 The discussions of toascii() and _tolower should note that they are extensions to ANSI C. p. 405 The discussion of _toupper should note that _toupper is an extension to ANSI C. p. 444,445 The control codes to turn the cursor on and off are no longer used in the .CONSOLE driver, which is what the current version of ORCA/C uses for all text output. In the .CONSOLE driver, the cursor is always off unless it is waiting for a character. -- Compiler changes introduced in C 2.1.0 ----------------------------------- The Default .h File ------------------- The default .h file is a new way for you to set up compiler options that you want to use on every C source file you compile. Here's how it works: When ORCA/C starts, it begins by processing any command line parameters. Next, it looks for a file called defaults.h in the library folder. Finally, it compiles your source file. When ORCA/C looks for the defaults.h file, it behaves almost as if your program had started with the line #include The only differences are that the file doesn't have to exist (and if it doesn't no error is generated), the line is never shown in your source file, and the line number counter is not incremented. You can put absolutely anything you like in this file. The intent is to use it for pragmas or other preprocessor directives that you would like to become defaults for all of your programs, but there is no restruction that prevents you from putting other things in the file. WARNING: If you add a defaults.h file, be sure and delete all .sym files. .sym files are created by the compiler to make recompiling programs faster. They need to be recreated with the new information from the defaults.h file, but the compiler will not notice the presense of the defaults.h file if it is compiling a .sym file created with a previous version of the compiler. // Comments ----------- ORCA/C supports // comments. These comments begin with the characters //, and continue to the end of the physical line. // comments are a flagrant violation of the ANSI C standard. This is legal ANSI C, and it should print 4: a = 8//* yep, this is legal */ 2 ; printf("All ANSI C compilers should now print 4! %d\n", a); To restore ANSI conformance, use the #pragma ignore directive. Setting bit 3 (a value of 8) tells ORCA/C to allow // comments. This is the default. Clearing bit 3 tells ORCA/C not to look for // comments. To restore ANSI conformance for all programs, use this directive in the defaults.h file. (see "The Default .h File," above.) Extended Characters ------------------- Bear with me. This is an ASCII file, and it describes non-ASCII material. Beginning with version 2.1, the PRIZM desktop editor supports the full Apple extended character set. A file called FontTest on the samples disk shows the complete character set, and also contains a table that shows how to type each character from a U.S. English keyboard. C supports the use of extended characters in strings, comments, identifiers, and for a few mathematical operations. Any character you can type from PRIZM (or for that matter, any character with an ordinal value in [1..12, 14..255]) can appear in a string or comment. The ordinal value of the character matches the values shown in FontTest, as well as several official Apple publications. Keep in mind that many output devices, including Apple's text console driver, do not support all of these characters. ORCA/C will properly send extended characters to whatever output device you choose, but what happens when the output device tries to handle the character varies from device to device. Many of the characters in the extended character set are used in languages oter than English, and are now allowed in identifiers. There are two ways to think about which characters will work in an identifier. The simple way is to remember that all characters that look like a graphically modified ASCII alphabetic character or a Greek alphabetic character are allowed in identifiers. For example, an a with two dots above it is now legal in an identifier. The more exact, and naturally more complicated way to think about which characters are allowed in an identifier is to list all of them. Since this is an ASCII file, I'll list the ordinal values--you can cross reference the values in FontTest. The ordinal values of the extended characters that are allowed in identifiers are [$80..$9F, $A7, $AE, $AF, $B4..$B9, $BB..$BF, $C4, $C6, $CB..$CF, $D8, $DE, $DF]. In addition, ORCA/C supports several extended characters as shortcuts for multi-character mathematical operations. These are: ordinal value description substitutes for ------------- ----------- --------------- $C7 two < << $C8 two > >> $AD not equal != $B2 less than or equal <= $B3 greater than or equal >= $D6 division (- with dots) / Finally, the non-breaking space, sometimes called the sticky space (ordinal value $CA), is treated exactly like a standard space character. #pragma optimize ---------------- In brief, there is a new optimization bit. Setting bit 6 (a value of 64) turns off stack repair code around variable argument function calls. The rest of this section describes when the stack repair code is generated, why, and the side effects of using this optimization--or not using it. In variable argument functions (functions with ... as the last "parameter") it is illegal to pass fewer parameters than the function expects, or to pass parameters of a type different than the function expects. For example, both of these statements are illegal in ANSI C, even though few if any compilers can detect the error (and those that do are blocking some legal--albeit stupid--C code.): printf("%d %d", 4); printf("%d", 4.5); ORCA/C has always taken advantage of this fact to generate code that is more efficient and compatible with the other ORCA languages. With all optimizations on, programs containing the above statements will corrupt the stack, generally leading to a crash. On the other hand, ORCA/C did not allow this statement: printf("%d", 4, 5); Contrary to all common sense, the ANSI standard says this statement is legal IF THE APPROPRIATE HEADER FILE IS INCLUDED, even though the first two are not. Beginning with ORCA/C 2.1, this statement will work. Note that in keeping with the ANSI standard, this call and others like it only work if the function is properly defined with a prototyped variable argument parameter list. There are two undesireable side effects, though. First, all function calls to a variable argument function are surrounded by extra stack repair code, even if you set optimization bit 3. (This bit turns off stack repair code.) This increases code size and slows a program down. Sometimes these changes are noticeable, or even dramatic. Second, native code peephole optimization is always disabled when stack repair code is in use, so you loose another optimization if you do not use this one. Turning this optimization on means ORCA/C is no longer strictly in compliance with the ANSI standard. For strict compliance, you should leave stack repair code on for variable argument functions. You also need to disable stack repair code in any user-defined function that uses the va_arg() function, since this function is not compatible with stack repair code. For strict compliance, then, use at least #pragma optimize 0x0008 You can also add all of the other optimizations except removal of stack repair code around variable argument function calls and remain ANSI compliant, so this pragma will also work with all ANSI C programs: #pragma optimize 0x003F If you use #pragma debug 0x0010 to enable stack check debug code, the compiler will still flag variable argument functions that do not consume all arguments as a run-time error, even though ANSI C does allow them. -- Bugs from C 2.1.0 that have been fixed ----------------------------------- 1. In some situations, fread() reread the first 1K or so of the file. (Devin Reade) 2. Typedef names used as macro parameters were not treated properly. (Devin Reade) 3. In the error message "pascal qualifier is only allowed on functions", qualifier was spelled qualtifier. (Kelvin Sherlock) -- Bugs from C 2.0.3 that have been fixed ----------------------------------- 1. Corrected a very rare bug that caused an unreliable value to be used in determining the type of an assignment statement. 2. Converting a value larger than 2147483647.0 from a real representation to an unsigned long integer representation did not generally work correctly. (Soenke Behrens) 3. Variables declared as "unsigned" were treated as "int" rather than "unsigned int". (Soenke Behrens, Philipp Vandry) 4. isgraph(' ') was true; it now correctly returns 0. (Soenke Behrens) 5. When asked to scan 65536 or more bytes, memchr actually scanned an extra 65536 bytes, often returning an incorrect result. (Soenke Behrens) 6. scanf("%d", &i) did not return EOF if it was used twice in succession, once with a numeric line followed by a return, and then pressing Control-@ o signal and end of file. (Sharon Barbaccia) 7. A switch statement with a default label but no case labels now generates the correct code to jump to the default label. (Animasia, Soenke Behrens, Michael Hackett) 8. In textedit.h, the last parameter to TEInsert was a Long; it has been changed to Handle. (Norm Dodge) 9. In time.h, NULL and size_t are now declared. (Soenke Behrens) 10. In time.h, string.h, stdio.h and stdlib.h, several functions that should have had const arguments do, now. (Soenke Behrens) 11. 0x8000 * 1 and 0x80000000 * 1 are now evaluated correctly. (Note: This actually showed up as a pointer offset bug, where *ptr = (char *)0x00C000; int offset = -32768; gave an incorrect result for ptr + offset). (Soenke Behrens, David Empson) 12. In expressions that could be evaluated at compile time, results that overflowed an integer frequently resulted in the constant being improperly promoted from an integer or unsigned to a long or unsigned long. Examples of expressions that would cause this kind of error are (65533U + 1U) / 2 and 0x8000|1. (Soenke Behrens, David Empson, Jay Krell) 13. In expressions that could be evaluated at compile time, binary operations involving an unsigned and integer were treated as an integer, when they should be treated as unsigned. This applies both to short and long operands. (Soenke Behrens, David Empson, Jay Krell) 14. The first and last parameter to FWEntry were reversed by the tool glue code. (Soenke Behrens, David Empson) 15. Storing multiple long values through a pointer stored in a global or static variable, as in a->b = a->c = 0L; where b and c are long and a is a global pointer, did not store the correct value in any but the rightmost operand. (Soenke Behrens, Derek Taubert) 16. Code generation has been improved for optimized code when a value is stored through a global or static pointer. 17. A linefeed between a macro name and the ( before the macro arguments caused a spurious compiler error. (Soenke Behrens, Jay Krell) 18. When skipping tokens due to a preprocessor command, ORCA/C was flagging # tokens from assembly language code as an error. Frankly, I can read the standard either way here. It's clear that skipped code must be tokenized. It is not clear whether # is allowed as a token in skipped code. Since I've gotten close to a bazilion complaints about this, though, I'm streatching things to allow # in skipped code, even without using the ignore pragma. (Soenke Behrens, Matt Ackeret) 19. In misctool.h, the fields in the HexTime struct were reversed, causing problems with the WriteTimeHex call. (Soenke Behrens, David Empson) 20. In stdio.h, fputc(), putchar() and ungetc() were declared with char parameters that should have been declared as int. In ctype.h, the same is true for tolower() and toupper(). (Soenke Behrens) 21. signal.h did not define sig_atomic_t; (Soenke Behrens) 22. Loads of double values were not performed correctly by the FPE version of the SysFloat library, resulting in a large loss of precision. (Soenke Behrens, Dirk Froehling, Frank Gizinski, Doug Gwyn) 23. Function parameters of type (const void *) generated an error when a pointer type was passed, rather than treating all pointer types as compatible. (Animasia) 24. There are several technical violations of the ANSI C namespace for header files. Basically, ANSI C says a compiler can't declare names in headers other than those documented in the standard unless they follow some very specific rules. Identifiers that start with an underscore and are followed by another underscore or an uppercase letter are reserved for use by the implementation. If you avoid these and all names explicitly defined by ANSI C, you should not have problems. Because ORCA/C defines some names other than those declared in the standard, and also because these names do not start with an underscore followed by an underscore or uppercase letter, there is the very slight potential that a program that should compile correctly won't. This bug can be corrected with the new libraries by defining a macro __KeepNamespacePure__ before including any header files. At some point I plan to define a header file that is always included, and you could define this macro there for 100% ANSI namespace compatibility. Until that time, though, the bug technically will continue to exist, but you have an easy workaround: just define the macro like this: #define __KeepNamespacePure__ 0 before the #include's in any file that should compile under ANSI C, but has namespace problems. (Soenke Behrens) 25. The various arguments and return types in math.h were declared as extended; they have been changed to double. (This actually doesn't make any difference, since all arguments and return types are promoted to extended anyway.) (Soenke Behrens) 26. The second parameter of the modf() function was of type (int *); this has been changed to (double *). (Soenke Behrens, Jay Krell) 27. In starg.h, va_end was declared as a function, when it must be a macro. It is now a macro. (Soenke Behrens) 28. localtime() now sets tm_isdst based on the BRAM setting. You can change the BRAM setting using the Clock CDev. (Soenke Behrens, Marlin Allred) 29. Mixing an integer 0 with a pointer in a conditional expression, as in void *p, *q = 0xdeadbeef; p = (1) ? 0 : q; generated incorrect code. (Soenke Behrens, Devin Reade) 30. If all of the following contitions are met, the 2.0.3 compiler crashes: a. Debug code is turned on (as in #pragma debug -1). b. A struct type is defined, and one of the elements of the struct type is a pointer back to the same struct type. (Think linked lists.) c. A function is defined containing a variable of this struct type, and that variable is the first variable processed when the compiler builds the debug symbol table. (Soenke Behrens) 31. Initlializers did not work for types defined like "static const struct foo bar[] = " Leaving out const worked fine. (Soenke Behrens) 32. Using const after a struct or union typedef name and before the variable name, as in struct charname { const char *symbol; const char *crypted; }; static struct charname const charname[3]; caused a spurious compiler error. (Soenke Behrens) 33. Casting an unsigned long value to double did not work correctly when the value being cast could not be evaluated until run-time, and when the value exceeded 0x7FFFFFFFul. (Soenke Behrens, Philipp Vandry) 34. Ignoring a long value returned by a tool call by casting the result to void, as in (void) ConvSeconds (TimeRec2ProDOS, 0L, (Pointer) &time); left the results on the stack, which generally resulted in a crash. The value is correctly removed, now. (Soenke Behrens, David Empson) 35. In some cases, nesting an increment or decriment operator around another increment or decrement operator, as in foo[*sp++]++ generated incorrect code. (Soenke Behrens) 36. Declaring a function using prototyped parameters, then defining it with K&R parameters, as in extern void foo (int *, int *); void foo (bar, gorp) int *bar, *gorp; {} generated incorrect code for accessing the parameters. (Soenke Behrens) 37. The compiler did not flag an error when an old-style struct parameter was used in a prototyped function declatation, as in: void foo (int x) struct bar = {1,2}; { return; } (Peter Watson, Soenke Behrens) 38. The predefined macros __LINE__, __STDC__ and __ORCAC__ did not work correctly when used with the ## operator. (Soenke Behrens, Jay Krell) 39. The __VERSION__ macro was not corrently updated in several earlier versions. It is now in lock-step with the version number printed when ORCA/C compiles a program, making it much more likely that it will stay correct. (Michael Hackett) 40. scanf() and its cousins incremented the number of items scanned when a %d or %i specifier encountered an input stream with no matching number. For example, sscanf("foo","%d",&bar) returned 1, when it should return 0, indicating that no number was found in the input stream. (Soenke Behrens) 41. When handling character set specifiers, scanf() and its cousins are supposed to allow ] as the first character in a set. For example, "%[]]" should scan ']', while "%[^]]" should scan all but ']'. This works correctly, now. (Jay Krell, Soenke Behrens) 42. With a file opened as "rb+", writing a single character and then closing the file did not always write the character to the output file. Multiple character writes would succeed. (Peter Watson, Soenke Behrens) 43. When a file is opened for reading and writing (as with "r+"), then a read is done, followed by an fflush(), the file should be available for output. In ORCA/C 2.0.3, it was not reset so output could occur. Note that this is generally no big deal, since the behavior of fflush() is undefined if the most recent operation on the file was input. In other words, the file position is not reliable. In general, you should use fseek(), fsetpos() or rewind() to change a file from input to output mode, not fflush(). (Soenke Behrens) 44. fflush(NULL) should flush all open streams. Starting with this version, it does. 45. With output redirected to a file and input comming from the keyboard, pressing the return key echoed the return that should have shown up on the screen to the output file. (Soenke Behrens, David Empson) 46. ORCA/C was allowing prototyped parameter lists with types but no identifier, as in foo (int, float) in both function declarations and function definitions. They should only be allowed in function declarations, and now cause an error if the identifier is missing in a function definition. (Soenke Behrens) 47. Variable argument functions that pass too many parameters are legal, and should not cause the compiler to behave in an unexpected way. ORCA/C now allows such function calls. See #pragma optimize for some details. (Soenke Behrens) 48. Assignments of structs or unions were sometimes removed from a loop by the loop invariant removal optimization when they should not have been removed. (Animasia) 49. A unary + operator was not allowed at the start of an expression. (Soenke Behrens) 50. When calling a pascal function from the C compiler's inline assembler, the compiler did not capitolize the identifier, resulting in link errors. (Jay Krell, Soenke Behrens) 51. ORCA/C 2.0.3 did not accept -1 as a value for period in #pragma nda, although documentation said it would. It now accepts a leading + or -. (Peter Watson, Soenke Behrens) 52. The compiler complained with "identifier expected" when doing something like: typedef char *ptr; typedef void *vptr; #define ptr vptr It should not care, since the preprocessor is a simple text substitution system. (Jay Krell, Soenke Behrens) 53. Multiple ## operators, as in #define cat(a,b,c) a##b##c were not handled correctly. (Soenke Behrens) 54. #append was not resetting the line counter used by the __LINE__ macro. It does, now. (Soenke Behrens) 55. When handling numeric escape sequences like '\x0077', ORCA/C has always limited the number of numeric characters actually scanned. In this specific example, the result would have been two characters, one with a value of 0x07 and another with the value '7'. According to the ANSI standard, all characters that can be included in a numeric sequence should be accepted. This, the above example should give a single character with a value of 0x77; it does now. (Dave Huang, Soenke Behrens) 56. printf("%#.0x", 0) should not print anything; it was printing 0x. (Soenke Behrens) 57. scanf with the '[' format specifier treated an input string with no matching characters as a valid match, returning a null string. It should have treated an input sequence with no matching characters as an error. (Soenke Behrens) 58. In several places, if output was suppressed and a scanf input failed, scanf returned one less than the correct number of inputs scanned. 59. Several functions were defined as macro overrides, and the macro overrides called other standard C functions. This could cause a problem in obscure cases where the function defined as a macro was used, but the user replaced the standar function it calls with one of their own. All of these cases have been corrected in some way so this cannot happen. The affected functions are: stdio.h: getc(), putc(), rewind(), setbuf() (Soenke Behrens) 60. Several functions were defined as macro overrides. This works fine unless the function is used form a program that does not include the header file. These functions have all been recreated as true library functions that will link into a program whether or not the header file is included. In cases where is more efficient to use the macro than to make a function call, the macro definition has been left in place. This is not a violation of the standard, but if if bothers you, you can eliminate the macro and replace it with the header file form shown in the ANSI standard or any correct C reference manual. If you do this, your program may end up a little larger or slower, but it will still work, since the functions do exist in ORCALib. The affected functions are: stdio.h: getc(), putc(), rewind(), setbuf() ctype.h: isalnum(), isalpha(), iscntrl(), isdigit(), isgraph(), islower(), isprint(), ispunct(), isspace(), isupper(), isxdigit() (Soenke Behrens) 61. Definitions like extern int foo = 0; are now legal. Once you wade through the technical language of the standard, it turns out that this declaration works exactly as if the extern is left off. Note that this definition is illegal in virtually all dialects of C except ANSI C. In particular, it is not legal in either K&R C or C++. Since there is no real reason to ever use it, I recomment you don't. (Soenke Behrens) 62. When the compiler found a single error, it ended with the message "1 errors found." It now ends with "1 error found." 63. ORCA/C now supports tenative definitions. Basically, this means that variables declared at the program level can be declared as many times as you like, with or without the extern qualifier. The only restrictions are: 1. The types must match on all of the declarations and definitions. 2. A variable can only get an initializer in one place, even if the same initializer is used in all places. That place does NOT have to be the last place the variable appears, though. 3. If a variable is declared without the static qualifier, it cannot be declared in any other source file without the static qualifier. This isn't really a change, but the restriction still applies. Note that you can use extern and an initializer at the same time, now. (See bug 61.) The result is a declaration, though, not a definition. In other words, if extern int foo = 4; appears in one source file, it is an error if int foo; appears in some other source file; you will get i duplicate symbol error in the linker. If the first instance is changed to extern int foo; then this is a definition, and references to the variable actually use the one declared in the other source file. (Soenke Behrens) 64. Making a function call though a variable that is declared but not a function, as in int foo; foo(4); did not generate an error, and caused various problems, like incorrect code generation or compile time hangs. This will now generate an error. (David Empson, Soenke Behrens) 65. If the last include in a source file was followed immediately by a #endif, the compiler generated a spurious error whenever a .sym file was available. (Jay Krell, Soenke Behrens, JoeV16@AOL.COM, Michael Hackett) 66. assert() now prints the argument as a string, in addition to the file and line number. (Soenke Behrens) 67. asert() now writes to stderr, not stdout. (Soenke Behrens) 68. In some situations where a number is referenced indirectly, and added to itself, and when intermediate code optimization was used, the compiler could fail with a terminal compiler error. One example that caused this problem is: #pragma optimize 1 ... x = ptr->field + 1 + (ptr->field + 1); (Guy Umbright, Michael Hackett) 69. The midiSynth tool call GetMSData needed a tool glue routine; it has one, now. (Dave Tribby, Michael Hackett) 70. String constants formed using the macro stringization operator (#) were always disposed of at the end of a subroutine. This caused problems if the resulting string was used to initialize a static variable, since ORCA/C creates the static variable strings long after the subroutine is complete. (Philippe Manet, Michael Hackett) 71. strstr("abc", "") took an excessive amount of time to return an incorrect result. It now returns "abc", as required when the search string is the null string. (Doug Gwyn, Michael Hackett) 72. fwrite() now returns a correct element count when a disk full error occurs during a write. (Todd Whitesel, Michael Hackett) 73. The Gamm.cc benchmark gave incorrect results. This was due to a coding error in the benchmark itself. It has been corrected on the latest samples disk. 74. Pointers to functions were not entered in the debug table properly, causing debuggers to have a variety of problems. Debuggers generally show what a pointer points to, and there's no realistic way to do that for a pointer to a function, so the compiler now enters pointers to functions in the debug symbol table as if they are pointers to integers. (Michael Hackett) -- Bugs from C 2.0.2 that have been fixed ----------------------------------- 1. Debug code was inadvertantly left in the 2.0.2 compiler release. This could cause crashes or entry into a debugger, as well as extraneous text output during a compile. (Joe Wankerl) 2. The comments in stdarg.h were ended too early, so stdarg.h did not compile. -- Bugs from C 2.0.1 that have been fixed ----------------------------------- 1. The #line directive does not set the source file in a way that causes the debugger to use a different source file. (Gary Desrochers) 2. The #line directive now allows a line number of 0. 3. The results of the #line directive are now saved in the .sym file, so file names and line numbers are preserved when the .sym file is read. 4. stdarg.h has been modified to work with the stricter error checking for type casts implemented in C 2.0.1. (Doug Gwynn) -- Bugs from C 2.0 that have been fixed ------------------------------------- 1. In desk.h, added CloseNDAbyWinPtr to match TBR #1. Apple's original spelling (CloseNDAByWinPtr) has been retained for compatibility with existing source. (Dave Tribby) 2. In locator.h, an extraneous ; has been removed. (Dave Tribby, John Mills) 3. In sane.h, the spellings DecForm and Decimal have been added so Apple's naming scheme in the remainder of the file will work. (Dave Tribby) 4. In MidiSynth.h, the following spelling corrections were made: from to ---- -- WavAddrB WaveAddrB FindTuneA TineTuneA (Dave Tribby) 5. In MidiSynth.h, added SetBasicChan to match TBR. Apple's original spelling (SetBasicChannel) has been retained for compatibility with existing source. (Dave Tribby) 6. With static or global integers, multiple assignments of zero (e.g. a=b=0) stored random values in all but the last value. (Doug Gwyn, D.Leffler, AFAAndyW, et. al.) 7. strtod() and related functions fail when the input is a single digit number. (James C.Smith) 8. SaveTextState() in Locator.h did not have an inline directive. (GSPlusDiz) 9. In some cases, successive stores of a long constant with common subexpression elimination turned on would damage the stack. (GNOTim2) 10. Assigning the same constant to both a single-byte value and a word, as in unsigned char foo; unsigned int bar; bar = foo = 1; did not correctly set the most significant byte of the word value. (GNOTim2) 11. In some conditional branches involcing comples integer expressions, the condition code was not properly evaluated. (GNOTim2) 12. Optimization of arithmetic shifts by a constant in the range 9..15 has been improved. (GNOTim2) 13. Closing carriage return added to ToolLib.h. (Doug Gwyn) 14. Some comparisons of pointers to pointers, such as *p1 == *p2, caused the code generator to generate a spurious error. (Soenke Behrens) 15. strtoul() would fail when a string address at the start of a bank was passed. (AFA AndyW) 16. fread() and fwrite() now return results of size_t. (John Joganic) 17. Text programs didn't work when launched from the Finder. (JamesG7858) 18. Run-time error checks for two-byte add and subtract operations flagged legal operations as illegal. Run-time error checks for two-byte adds and subtracts have been removed. (D.Tribby) 19. fclose() did not properly close temp files before trying to destroy them. (Jawaid Bazyar) 20. Decrementing a global or static long by 1 generated incorrect code. This was fixed in an earlier version, but I don't remember which one. (Jawaid Bazyar) 21. The type for ptrdiff_t in stddef.h should be a signed type, not unsigned long. (Doug Gwyn) 22. Using the large memory model, some two-byte load operations used absolute addressing when they should have used long absoule addressing. (AFAAndyW) 23. IBeamCursor() (in QDAux.h) is prototyped with a Word parameter; it should be void. (J.Mills11) 24. TEInsert() (in TextEdit.h) has one too few parameters prototyped. (J.Mills11) 25. Improperly set optionList parameters on GetFileInfo calls were causing compiler crashes, generally in a pseudo-random way, but most often while creating .sym files. (Walker Archer) 26. With optimize 1, adding 1 to a global long and saving the result to the same location generated incorrect code. (e.g. v := v+1 or ++v where v is a global 4-byte value.) 27. The purge call to remove an included file from memory was not working correctly. (Jawaid Bazyar) 28. Casting an l-value is not legal, but the compiler did not flag an error. (Marc Wolfgram, Doug Gwyn) 29. Macro stringization of a string produced a garbage result. (D.Kopper) 30. A conditional jump based on a load of a signed character could be evaluated incorrectly. 31. In several places, particularly in the .CONSOLE standard I/O routines, the libraries used absolute addressing when long addressing should have been used, or when the databank register should have been set to K. These problems could cause loads and stores or loss of character output with the large memory model. (Marsha J, John Joganic, et. al.) 32. The library routine that sets bank zero memory to zero trashes the data register. (GSPlusDiz) 33. gets() does not write a terminating null character if the return key is pressed right away. (Jawaid Bazyar) 34. C programs hang when input is read through standard in and standard in is redirected from a file using a shell command. (Jawaid Bazyar) 35. sys_nerr is 6; it should be 11. (Doug Gwynn, Joe Walters) 36. When a single code segment exceeds 32K, the compiler could loose track of the correct length for an object file. 37. In some cases, a conditional branch based on the result of a divide or add could fail. \ No newline at end of file +ORCA/C 2.1.1 +Copyright 1997, Byte Works Inc. + +-- Change List -------------------------------------------------------------- + +2.1.1 1. Bugs squashed. See bug notes, below. + +2.1.0 1. Bugs squashed. See bug notes, below. + + 2. New bit added for vararg stack repair removal. See #pragma + optimize, below. + + 3. There have been several changes to assert(). See the Manual + Erratta for page 343 for details. + + 4. C supports the extended character set. See "Extended + Characters." + + 5. You can create defaults that are used in all of your C programs + using the new defaults.h file. See "The Default .h File." + + 6. ORCA/C supports // comments. See "// Comments." + +2.0.3 1. Bugs squashed. See bug notes, below. + +2.0.2 1. Bugs squashed. See bug notes, below. + +2.0.1 1. Bugs squashed. See bug notes, below. + +-- Bugs from C 2.1.1 B1 that have been fixed -------------------------------- + +These bugs appeared in a beta release. They did not appear in any commercial release, but we introduced during bug corrections. These notes will be removed in the commercial release notes. + +1. Reserved words appearing in macros were not correctly scanned. + +(Mike Westerfield) + +-- Manual Erratta ----------------------------------------------------------- + +p. 40 + +The description of the action function says it takes a single integer parameter. Actually, it takes two parameters, as shown in the example on page 41. + +Both the description and the sample on page 41 indicate that the action procedure for an NDA should return void. Actually, the action routine should return int, returning 0 if it handled the action and 1 if it did not. The correct function looks like this: + +int Action (long param, int code) + +{ +int handledEvent = 0; + +<<>> + +return handledEvent; +} + +The description of the init function doesn't point out some important limitations. When this call is made at shutdown time, your NDA has already been placed in a dormant state, and all RAM has been deallocated. (This happened when the close function was called.) If you need dynamic memory for any purpose, be sure you obtain a valid user ID, and that you dispose of the memory after you are finished with it. Do not rely on C memory management functions at shutdown time. Static variables are safe, though, and can be used to pass information to the init function for use at shutdown time. + +p. 67 + +Delete the paragraph starting "One important point is that you should never reinitialize the Text Tool Set. ..." ORCA/C no longer uses the Text Tool Set for routine input and output, and definitely does not use it for I/O redirection. + +p. 100 + +The text does not mention the sixth default character. It is not used by PRIZM, though. For details on the 6th default character (as well as the 5th) see page 193, where their use by the text based editor is described. + +p. 101 + +The sample SYSTABS line at the top of the page should start + + 8 + 100110 + +p. 107 + +The table shows the language number for C as 7. It should be 8. + +p. 240 + +The discussion of escape sequences states that numeric escape sequences can contain from one to three digits. This was true until ORCA/C 2.1, when the compiler was changed to respect the ANSI C standard. The compiler will now scan an octal numeric escape sequence until no more octal characters are found, and it will scan a hexadecimal numeric escape sequence until no more hexadecimal characters are found. In both cases, the result is then anded with 0x00FF to yield a single character. + +The discussion concerning floating-point constants is misleading. While constants are indeed handled as extended values in the executable program, the compiler itself uses double values for the constants internally, so you need to adhere to the valid exponent range for double values, and you should expect to see accuracy in constants that is in line with double values. + +p. 241 + +ORCA/C now supports // comments. See "// Comments," below. + +p. 250 + +Several things are listed that will cause a .sym file to stop or not be built at all. Add to this list a #append, which does not work like a #include. + +It's worth keeping in mind that #append in included in ORCA/C solely for the purpose of appending files of a different language. There are several advantages to using #append to tack assembly language source to the end of a C source file, but there is no other place in ORCA/C where a #append is more useful than a #include. + +p.258 + +The #pragma ignore directive supports a new bit. Bit 3 controls whether // comments are allowed. If bit 3 is set, as in + + #pragma ignore 0x0008 + +ORCA/C supports // comments. If bit 3 is clear, ORCA/C does not support // comments, which are not actually allowed in ANSI C programs. + +See "// Comments," below, for a complete description of // comments. + +p. 263 + +1. The discussion of NDAs is on page 40, not page 58. + +2. There is a new optimization bit for #pragma optimize. See #pragma optimize, below. + +p. 337 + +The ORCA/C compiler is intended as a faithful implementation of ANSI C with some extensions, but there have always been some library functions from ANSI C that were missing in ORCA/C. Chapter 19 should start with a summary of these omissions. They are: + + locale.h + + This header file is missing completely, along with all of its functions. + + stdlib.h + + The functions mblen(), mbstowcs(), mbtowc(), wcstombs() and wctomb() are + missing. These are related to locale.h. + + string.h + + strcoll() and strxfrm() are missing. These are related to locale.h. + + time.h + + The function strftime() is missing. + +p. 343 + +The documentation states that assert() uses exit(-1) to exit a program. Actually, it uses abort(). + +Beginning with ORCA/C 2.1, assert() prints a string that includes the assertion itself, not just the line number and file name. The assertion has the form + + Assertion failed: file :hd:foo.cc, line 47; assertion: bar==1 + +The documentaion states assert() writes to stdout. Beginning with ORCA/C 2.1, it writes to stderr. + +p. 353 + +The discussion of _exit() should note that the _exit() function is an extension to ANSI C. + +p. 375 + +The discussion of isascii() should note that isascii() is an extension to ANSI C. + +p. 376 + +The discussions of iscsym() and iscsymf() should note that these functions are extensions to ANSI C. + +p. 377 + +The discussion of isodigit() should note that isodigit() is an extension to ANSI C. + +p. 396 + +The discussion of strpos() and strrpos() should note that the these functions are an extension to ANSI C. + +p. 398 + +The discussion of strrpbrk() should note that the strrpbrk() function is an extension to ANSI C. + +p. 404 + +The discussions of toascii() and _tolower should note that they are extensions to ANSI C. + +p. 405 + +The discussion of _toupper should note that _toupper is an extension to ANSI C. + +p. 444,445 + +The control codes to turn the cursor on and off are no longer used in the .CONSOLE driver, which is what the current version of ORCA/C uses for all text output. In the .CONSOLE driver, the cursor is always off unless it is waiting for a character. + +-- Compiler changes introduced in C 2.1.0 ----------------------------------- + +The Default .h File +------------------- + +The default .h file is a new way for you to set up compiler options that you want to use on every C source file you compile. Here's how it works: + +When ORCA/C starts, it begins by processing any command line parameters. Next, it looks for a file called defaults.h in the library folder. Finally, it compiles your source file. + +When ORCA/C looks for the defaults.h file, it behaves almost as if your program had started with the line + + #include + +The only differences are that the file doesn't have to exist (and if it doesn't no error is generated), the line is never shown in your source file, and the line number counter is not incremented. + +You can put absolutely anything you like in this file. The intent is to use it for pragmas or other preprocessor directives that you would like to become defaults for all of your programs, but there is no restruction that prevents you from putting other things in the file. + +WARNING: If you add a defaults.h file, be sure and delete all .sym files. .sym files are created by the compiler to make recompiling programs faster. They need to be recreated with the new information from the defaults.h file, but the compiler will not notice the presense of the defaults.h file if it is compiling a .sym file created with a previous version of the compiler. + + +// Comments +----------- + +ORCA/C supports // comments. These comments begin with the characters //, and continue to the end of the physical line. + +// comments are a flagrant violation of the ANSI C standard. This is legal ANSI C, and it should print 4: + + a = 8//* yep, this is legal */ 2 + ; + printf("All ANSI C compilers should now print 4! %d\n", a); + +To restore ANSI conformance, use the #pragma ignore directive. Setting bit 3 (a value of 8) tells ORCA/C to allow // comments. This is the default. Clearing bit 3 tells ORCA/C not to look for // comments. To restore ANSI conformance for all programs, use this directive in the defaults.h file. (see "The Default .h File," above.) + + +Extended Characters +------------------- + +Bear with me. This is an ASCII file, and it describes non-ASCII material. + +Beginning with version 2.1, the PRIZM desktop editor supports the full Apple extended character set. A file called FontTest on the samples disk shows the complete character set, and also contains a table that shows how to type each character from a U.S. English keyboard. + +C supports the use of extended characters in strings, comments, identifiers, and for a few mathematical operations. + +Any character you can type from PRIZM (or for that matter, any character with an ordinal value in [1..12, 14..255]) can appear in a string or comment. The ordinal value of the character matches the values shown in FontTest, as well as several official Apple publications. Keep in mind that many output devices, including Apple's text console driver, do not support all of these characters. ORCA/C will properly send extended characters to whatever output device you choose, but what happens when the output device tries to handle the character varies from device to device. + +Many of the characters in the extended character set are used in languages oter than English, and are now allowed in identifiers. There are two ways to think about which characters will work in an identifier. + +The simple way is to remember that all characters that look like a graphically modified ASCII alphabetic character or a Greek alphabetic character are allowed in identifiers. For example, an a with two dots above it is now legal in an identifier. + +The more exact, and naturally more complicated way to think about which characters are allowed in an identifier is to list all of them. Since this is an ASCII file, I'll list the ordinal values--you can cross reference the values in FontTest. The ordinal values of the extended characters that are allowed in identifiers are [$80..$9F, $A7, $AE, $AF, $B4..$B9, $BB..$BF, $C4, $C6, $CB..$CF, $D8, $DE, $DF]. + +In addition, ORCA/C supports several extended characters as shortcuts for multi-character mathematical operations. These are: + + ordinal value description substitutes for + ------------- ----------- --------------- + $C7 two < << + $C8 two > >> + $AD not equal != + $B2 less than or equal <= + $B3 greater than or equal >= + $D6 division (- with dots) / + +Finally, the non-breaking space, sometimes called the sticky space (ordinal value $CA), is treated exactly like a standard space character. + + +#pragma optimize +---------------- + +In brief, there is a new optimization bit. Setting bit 6 (a value of 64) turns off stack repair code around variable argument function calls. + +The rest of this section describes when the stack repair code is generated, why, and the side effects of using this optimization--or not using it. + +In variable argument functions (functions with ... as the last "parameter") it is illegal to pass fewer parameters than the function expects, or to pass parameters of a type different than the function expects. For example, both of these statements are illegal in ANSI C, even though few if any compilers can detect the error (and those that do are blocking some legal--albeit stupid--C code.): + + printf("%d %d", 4); + printf("%d", 4.5); + +ORCA/C has always taken advantage of this fact to generate code that is more efficient and compatible with the other ORCA languages. With all optimizations on, programs containing the above statements will corrupt the stack, generally leading to a crash. + +On the other hand, ORCA/C did not allow this statement: + + printf("%d", 4, 5); + +Contrary to all common sense, the ANSI standard says this statement is legal IF THE APPROPRIATE HEADER FILE IS INCLUDED, even though the first two are not. + +Beginning with ORCA/C 2.1, this statement will work. Note that in keeping with the ANSI standard, this call and others like it only work if the function is properly defined with a prototyped variable argument parameter list. + +There are two undesireable side effects, though. First, all function calls to a variable argument function are surrounded by extra stack repair code, even if you set optimization bit 3. (This bit turns off stack repair code.) This increases code size and slows a program down. Sometimes these changes are noticeable, or even dramatic. Second, native code peephole optimization is always disabled when stack repair code is in use, so you loose another optimization if you do not use this one. + +Turning this optimization on means ORCA/C is no longer strictly in compliance with the ANSI standard. For strict compliance, you should leave stack repair code on for variable argument functions. You also need to disable stack repair code in any user-defined function that uses the va_arg() function, since this function is not compatible with stack repair code. For strict compliance, then, use at least + + #pragma optimize 0x0008 + +You can also add all of the other optimizations except removal of stack repair code around variable argument function calls and remain ANSI compliant, so this pragma will also work with all ANSI C programs: + + #pragma optimize 0x003F + +If you use #pragma debug 0x0010 to enable stack check debug code, the compiler will still flag variable argument functions that do not consume all arguments as a run-time error, even though ANSI C does allow them. + +-- Bugs from C 2.1.0 that have been fixed ----------------------------------- + +1. In some situations, fread() reread the first 1K or so of the file. + +(Devin Reade) + +2. Typedef names used as macro parameters were not treated properly. + +(Devin Reade) + +3. In the error message "pascal qualifier is only allowed on functions", +qualifier was spelled qualtifier. + +(Kelvin Sherlock) + +-- Bugs from C 2.0.3 that have been fixed ----------------------------------- + +1. Corrected a very rare bug that caused an unreliable value to be used in determining the type of an assignment statement. + +2. Converting a value larger than 2147483647.0 from a real representation to an unsigned long integer representation did not generally work correctly. + +(Soenke Behrens) + +3. Variables declared as "unsigned" were treated as "int" rather than "unsigned int". + +(Soenke Behrens, Philipp Vandry) + +4. isgraph(' ') was true; it now correctly returns 0. + +(Soenke Behrens) + +5. When asked to scan 65536 or more bytes, memchr actually scanned an extra 65536 bytes, often returning an incorrect result. + +(Soenke Behrens) + +6. scanf("%d", &i) did not return EOF if it was used twice in succession, once with a numeric line followed by a return, and then pressing Control-@ o signal and end of file. + +(Sharon Barbaccia) + +7. A switch statement with a default label but no case labels now generates the correct code to jump to the default label. + +(Animasia, Soenke Behrens, Michael Hackett) + +8. In textedit.h, the last parameter to TEInsert was a Long; it has been changed to Handle. + +(Norm Dodge) + +9. In time.h, NULL and size_t are now declared. + +(Soenke Behrens) + +10. In time.h, string.h, stdio.h and stdlib.h, several functions that should have had const arguments do, now. + +(Soenke Behrens) + +11. 0x8000 * 1 and 0x80000000 * 1 are now evaluated correctly. (Note: This actually showed up as a pointer offset bug, where + + *ptr = (char *)0x00C000; + int offset = -32768; + +gave an incorrect result for ptr + offset). + +(Soenke Behrens, David Empson) + +12. In expressions that could be evaluated at compile time, results that overflowed an integer frequently resulted in the constant being improperly promoted from an integer or unsigned to a long or unsigned long. Examples of expressions that would cause this kind of error are (65533U + 1U) / 2 and 0x8000|1. + +(Soenke Behrens, David Empson, Jay Krell) + +13. In expressions that could be evaluated at compile time, binary operations involving an unsigned and integer were treated as an integer, when they should be treated as unsigned. This applies both to short and long operands. + +(Soenke Behrens, David Empson, Jay Krell) + +14. The first and last parameter to FWEntry were reversed by the tool glue code. + +(Soenke Behrens, David Empson) + +15. Storing multiple long values through a pointer stored in a global or static variable, as in + + a->b = a->c = 0L; + +where b and c are long and a is a global pointer, did not store the correct value in any but the rightmost operand. + +(Soenke Behrens, Derek Taubert) + +16. Code generation has been improved for optimized code when a value is stored through a global or static pointer. + +17. A linefeed between a macro name and the ( before the macro arguments caused a spurious compiler error. + +(Soenke Behrens, Jay Krell) + +18. When skipping tokens due to a preprocessor command, ORCA/C was flagging # tokens from assembly language code as an error. + +Frankly, I can read the standard either way here. It's clear that skipped code must be tokenized. It is not clear whether # is allowed as a token in skipped code. Since I've gotten close to a bazilion complaints about this, though, I'm streatching things to allow # in skipped code, even without using the ignore pragma. + +(Soenke Behrens, Matt Ackeret) + +19. In misctool.h, the fields in the HexTime struct were reversed, causing problems with the WriteTimeHex call. + +(Soenke Behrens, David Empson) + +20. In stdio.h, fputc(), putchar() and ungetc() were declared with char parameters that should have been declared as int. In ctype.h, the same is true for tolower() and toupper(). + +(Soenke Behrens) + +21. signal.h did not define sig_atomic_t; + +(Soenke Behrens) + +22. Loads of double values were not performed correctly by the FPE version of the SysFloat library, resulting in a large loss of precision. + +(Soenke Behrens, Dirk Froehling, Frank Gizinski, Doug Gwyn) + +23. Function parameters of type (const void *) generated an error when a pointer type was passed, rather than treating all pointer types as compatible. + +(Animasia) + +24. There are several technical violations of the ANSI C namespace for header files. Basically, ANSI C says a compiler can't declare names in headers other than those documented in the standard unless they follow some very specific rules. Identifiers that start with an underscore and are followed by another underscore or an uppercase letter are reserved for use by the implementation. If you avoid these and all names explicitly defined by ANSI C, you should not have problems. + +Because ORCA/C defines some names other than those declared in the standard, and also because these names do not start with an underscore followed by an underscore or uppercase letter, there is the very slight potential that a program that should compile correctly won't. + +This bug can be corrected with the new libraries by defining a macro __KeepNamespacePure__ before including any header files. At some point I plan to define a header file that is always included, and you could define this macro there for 100% ANSI namespace compatibility. Until that time, though, the bug technically will continue to exist, but you have an easy workaround: just define the macro like this: + + #define __KeepNamespacePure__ 0 + +before the #include's in any file that should compile under ANSI C, but has namespace problems. + +(Soenke Behrens) + +25. The various arguments and return types in math.h were declared as extended; they have been changed to double. (This actually doesn't make any difference, since all arguments and return types are promoted to extended anyway.) + +(Soenke Behrens) + +26. The second parameter of the modf() function was of type (int *); this has been changed to (double *). + +(Soenke Behrens, Jay Krell) + +27. In starg.h, va_end was declared as a function, when it must be a macro. It is now a macro. + +(Soenke Behrens) + +28. localtime() now sets tm_isdst based on the BRAM setting. You can change the BRAM setting using the Clock CDev. + +(Soenke Behrens, Marlin Allred) + +29. Mixing an integer 0 with a pointer in a conditional expression, as in + + void *p, *q = 0xdeadbeef; + p = (1) ? 0 : q; + +generated incorrect code. + +(Soenke Behrens, Devin Reade) + +30. If all of the following contitions are met, the 2.0.3 compiler crashes: + + a. Debug code is turned on (as in #pragma debug -1). + b. A struct type is defined, and one of the elements of the struct type is a pointer back to the same struct type. (Think linked lists.) + c. A function is defined containing a variable of this struct type, and that variable is the first variable processed when the compiler builds the debug symbol table. + +(Soenke Behrens) + +31. Initlializers did not work for types defined like "static const struct foo bar[] = " Leaving out const worked fine. + +(Soenke Behrens) + +32. Using const after a struct or union typedef name and before the variable name, as in + + struct charname + { + const char *symbol; + const char *crypted; + }; + + static struct charname const charname[3]; + +caused a spurious compiler error. + +(Soenke Behrens) + +33. Casting an unsigned long value to double did not work correctly when the value being cast could not be evaluated until run-time, and when the value exceeded 0x7FFFFFFFul. + +(Soenke Behrens, Philipp Vandry) + +34. Ignoring a long value returned by a tool call by casting the result to void, as in + + (void) ConvSeconds (TimeRec2ProDOS, 0L, (Pointer) &time); + +left the results on the stack, which generally resulted in a crash. The value is correctly removed, now. + +(Soenke Behrens, David Empson) + +35. In some cases, nesting an increment or decriment operator around another increment or decrement operator, as in + + foo[*sp++]++ + +generated incorrect code. + +(Soenke Behrens) + +36. Declaring a function using prototyped parameters, then defining it with K&R parameters, as in + + extern void foo (int *, int *); + void foo (bar, gorp) + int *bar, *gorp; + {} + +generated incorrect code for accessing the parameters. + +(Soenke Behrens) + +37. The compiler did not flag an error when an old-style struct parameter was used in a prototyped function declatation, as in: + + void foo (int x) + struct bar = {1,2}; + { return; } + +(Peter Watson, Soenke Behrens) + +38. The predefined macros __LINE__, __STDC__ and __ORCAC__ did not work correctly when used with the ## operator. + +(Soenke Behrens, Jay Krell) + +39. The __VERSION__ macro was not corrently updated in several earlier versions. It is now in lock-step with the version number printed when ORCA/C compiles a program, making it much more likely that it will stay correct. + +(Michael Hackett) + +40. scanf() and its cousins incremented the number of items scanned when a %d or %i specifier encountered an input stream with no matching number. For example, + + sscanf("foo","%d",&bar) + +returned 1, when it should return 0, indicating that no number was found in the input stream. + +(Soenke Behrens) + +41. When handling character set specifiers, scanf() and its cousins are supposed to allow ] as the first character in a set. For example, "%[]]" should scan ']', while "%[^]]" should scan all but ']'. This works correctly, now. + +(Jay Krell, Soenke Behrens) + +42. With a file opened as "rb+", writing a single character and then closing the file did not always write the character to the output file. Multiple character writes would succeed. + +(Peter Watson, Soenke Behrens) + +43. When a file is opened for reading and writing (as with "r+"), then a read is done, followed by an fflush(), the file should be available for output. In ORCA/C 2.0.3, it was not reset so output could occur. + +Note that this is generally no big deal, since the behavior of fflush() is undefined if the most recent operation on the file was input. In other words, the file position is not reliable. In general, you should use fseek(), fsetpos() or rewind() to change a file from input to output mode, not fflush(). + +(Soenke Behrens) + +44. fflush(NULL) should flush all open streams. Starting with this version, it does. + +45. With output redirected to a file and input comming from the keyboard, pressing the return key echoed the return that should have shown up on the screen to the output file. + +(Soenke Behrens, David Empson) + +46. ORCA/C was allowing prototyped parameter lists with types but no identifier, as in + + foo (int, float) + +in both function declarations and function definitions. They should only be allowed in function declarations, and now cause an error if the identifier is missing in a function definition. + +(Soenke Behrens) + +47. Variable argument functions that pass too many parameters are legal, and should not cause the compiler to behave in an unexpected way. ORCA/C now allows such function calls. See #pragma optimize for some details. + +(Soenke Behrens) + +48. Assignments of structs or unions were sometimes removed from a loop by the loop invariant removal optimization when they should not have been removed. + +(Animasia) + +49. A unary + operator was not allowed at the start of an expression. + +(Soenke Behrens) + +50. When calling a pascal function from the C compiler's inline assembler, the compiler did not capitolize the identifier, resulting in link errors. + +(Jay Krell, Soenke Behrens) + +51. ORCA/C 2.0.3 did not accept -1 as a value for period in #pragma nda, although documentation said it would. It now accepts a leading + or -. + +(Peter Watson, Soenke Behrens) + +52. The compiler complained with "identifier expected" when doing something like: + + typedef char *ptr; typedef void *vptr; + #define ptr vptr + +It should not care, since the preprocessor is a simple text substitution system. + +(Jay Krell, Soenke Behrens) + +53. Multiple ## operators, as in + + #define cat(a,b,c) a##b##c + +were not handled correctly. + +(Soenke Behrens) + +54. #append was not resetting the line counter used by the __LINE__ macro. It does, now. + +(Soenke Behrens) + +55. When handling numeric escape sequences like '\x0077', ORCA/C has always limited the number of numeric characters actually scanned. In this specific example, the result would have been two characters, one with a value of 0x07 and another with the value '7'. According to the ANSI standard, all characters that can be included in a numeric sequence should be accepted. This, the above example should give a single character with a value of 0x77; it does now. + +(Dave Huang, Soenke Behrens) + +56. printf("%#.0x", 0) should not print anything; it was printing 0x. + +(Soenke Behrens) + +57. scanf with the '[' format specifier treated an input string with no matching characters as a valid match, returning a null string. It should have treated an input sequence with no matching characters as an error. + +(Soenke Behrens) + +58. In several places, if output was suppressed and a scanf input failed, scanf returned one less than the correct number of inputs scanned. + +59. Several functions were defined as macro overrides, and the macro overrides called other standard C functions. This could cause a problem in obscure cases where the function defined as a macro was used, but the user replaced the standar function it calls with one of their own. All of these cases have been corrected in some way so this cannot happen. + +The affected functions are: + + stdio.h: getc(), putc(), rewind(), setbuf() + +(Soenke Behrens) + +60. Several functions were defined as macro overrides. This works fine unless the function is used form a program that does not include the header file. + +These functions have all been recreated as true library functions that will link into a program whether or not the header file is included. In cases where is more efficient to use the macro than to make a function call, the macro definition has been left in place. This is not a violation of the standard, but if if bothers you, you can eliminate the macro and replace it with the header file form shown in the ANSI standard or any correct C reference manual. If you do this, your program may end up a little larger or slower, but it will still work, since the functions do exist in ORCALib. + +The affected functions are: + + stdio.h: getc(), putc(), rewind(), setbuf() + ctype.h: isalnum(), isalpha(), iscntrl(), isdigit(), isgraph(), islower(), + isprint(), ispunct(), isspace(), isupper(), isxdigit() + +(Soenke Behrens) + +61. Definitions like + + extern int foo = 0; + +are now legal. Once you wade through the technical language of the standard, it turns out that this declaration works exactly as if the extern is left off. + +Note that this definition is illegal in virtually all dialects of C except ANSI C. In particular, it is not legal in either K&R C or C++. Since there is no real reason to ever use it, I recomment you don't. + +(Soenke Behrens) + +62. When the compiler found a single error, it ended with the message "1 errors found." It now ends with "1 error found." + +63. ORCA/C now supports tenative definitions. Basically, this means that variables declared at the program level can be declared as many times as you like, with or without the extern qualifier. The only restrictions are: + + 1. The types must match on all of the declarations and definitions. + 2. A variable can only get an initializer in one place, even if the same initializer is used in all places. That place does NOT have to be the last place the variable appears, though. + 3. If a variable is declared without the static qualifier, it cannot be declared in any other source file without the static qualifier. This isn't really a change, but the restriction still applies. + +Note that you can use extern and an initializer at the same time, now. (See bug 61.) The result is a declaration, though, not a definition. In other words, if + + extern int foo = 4; + +appears in one source file, it is an error if + + int foo; + +appears in some other source file; you will get i duplicate symbol error in the linker. If the first instance is changed to + + extern int foo; + +then this is a definition, and references to the variable actually use the one declared in the other source file. + +(Soenke Behrens) + +64. Making a function call though a variable that is declared but not a function, as in + + int foo; + + foo(4); + +did not generate an error, and caused various problems, like incorrect code generation or compile time hangs. This will now generate an error. + +(David Empson, Soenke Behrens) + +65. If the last include in a source file was followed immediately by a #endif, the compiler generated a spurious error whenever a .sym file was available. + +(Jay Krell, Soenke Behrens, JoeV16@AOL.COM, Michael Hackett) + +66. assert() now prints the argument as a string, in addition to the file and line number. + +(Soenke Behrens) + +67. asert() now writes to stderr, not stdout. + +(Soenke Behrens) + +68. In some situations where a number is referenced indirectly, and added to itself, and when intermediate code optimization was used, the compiler could fail with a terminal compiler error. + +One example that caused this problem is: + + #pragma optimize 1 + ... + x = ptr->field + 1 + (ptr->field + 1); + +(Guy Umbright, Michael Hackett) + +69. The midiSynth tool call GetMSData needed a tool glue routine; it has one, now. + +(Dave Tribby, Michael Hackett) + +70. String constants formed using the macro stringization operator (#) were always disposed of at the end of a subroutine. This caused problems if the resulting string was used to initialize a static variable, since ORCA/C creates the static variable strings long after the subroutine is complete. + +(Philippe Manet, Michael Hackett) + +71. strstr("abc", "") took an excessive amount of time to return an incorrect result. It now returns "abc", as required when the search string is the null string. + +(Doug Gwyn, Michael Hackett) + +72. fwrite() now returns a correct element count when a disk full error occurs during a write. + +(Todd Whitesel, Michael Hackett) + +73. The Gamm.cc benchmark gave incorrect results. This was due to a coding error in the benchmark itself. It has been corrected on the latest samples disk. + +74. Pointers to functions were not entered in the debug table properly, causing debuggers to have a variety of problems. Debuggers generally show what a pointer points to, and there's no realistic way to do that for a pointer to a function, so the compiler now enters pointers to functions in the debug symbol table as if they are pointers to integers. + +(Michael Hackett) + +-- Bugs from C 2.0.2 that have been fixed ----------------------------------- + +1. Debug code was inadvertantly left in the 2.0.2 compiler release. This could cause crashes or entry into a debugger, as well as extraneous text output during a compile. + +(Joe Wankerl) + +2. The comments in stdarg.h were ended too early, so stdarg.h did not compile. + +-- Bugs from C 2.0.1 that have been fixed ----------------------------------- + +1. The #line directive does not set the source file in a way that causes the debugger to use a different source file. + +(Gary Desrochers) + +2. The #line directive now allows a line number of 0. + +3. The results of the #line directive are now saved in the .sym file, so file names and line numbers are preserved when the .sym file is read. + +4. stdarg.h has been modified to work with the stricter error checking for type casts implemented in C 2.0.1. + +(Doug Gwynn) + +-- Bugs from C 2.0 that have been fixed ------------------------------------- + +1. In desk.h, added CloseNDAbyWinPtr to match TBR #1. Apple's original +spelling (CloseNDAByWinPtr) has been retained for compatibility with existing +source. + +(Dave Tribby) + +2. In locator.h, an extraneous ; has been removed. + +(Dave Tribby, John Mills) + +3. In sane.h, the spellings DecForm and Decimal have been added so Apple's +naming scheme in the remainder of the file will work. + +(Dave Tribby) + +4. In MidiSynth.h, the following spelling corrections were made: + + from to + ---- -- + WavAddrB WaveAddrB + FindTuneA TineTuneA + +(Dave Tribby) + +5. In MidiSynth.h, added SetBasicChan to match TBR. Apple's original +spelling (SetBasicChannel) has been retained for compatibility with existing +source. + +(Dave Tribby) + +6. With static or global integers, multiple assignments of zero (e.g. a=b=0) +stored random values in all but the last value. + +(Doug Gwyn, D.Leffler, AFAAndyW, et. al.) + +7. strtod() and related functions fail when the input is a single digit number. + +(James C.Smith) + +8. SaveTextState() in Locator.h did not have an inline directive. + +(GSPlusDiz) + +9. In some cases, successive stores of a long constant with common +subexpression elimination turned on would damage the stack. + +(GNOTim2) + +10. Assigning the same constant to both a single-byte value and a word, as in + + unsigned char foo; + unsigned int bar; + + bar = foo = 1; + +did not correctly set the most significant byte of the word value. + +(GNOTim2) + +11. In some conditional branches involcing comples integer expressions, the +condition code was not properly evaluated. + +(GNOTim2) + +12. Optimization of arithmetic shifts by a constant in the range 9..15 has been +improved. + +(GNOTim2) + +13. Closing carriage return added to ToolLib.h. + +(Doug Gwyn) + +14. Some comparisons of pointers to pointers, such as *p1 == *p2, caused the +code generator to generate a spurious error. + +(Soenke Behrens) + +15. strtoul() would fail when a string address at the start of a bank was +passed. + +(AFA AndyW) + +16. fread() and fwrite() now return results of size_t. + +(John Joganic) + +17. Text programs didn't work when launched from the Finder. + +(JamesG7858) + +18. Run-time error checks for two-byte add and subtract operations flagged +legal operations as illegal. Run-time error checks for two-byte adds and +subtracts have been removed. + +(D.Tribby) + +19. fclose() did not properly close temp files before trying to destroy them. + +(Jawaid Bazyar) + +20. Decrementing a global or static long by 1 generated incorrect code. This +was fixed in an earlier version, but I don't remember which one. + +(Jawaid Bazyar) + +21. The type for ptrdiff_t in stddef.h should be a signed type, not unsigned +long. + +(Doug Gwyn) + +22. Using the large memory model, some two-byte load operations used absolute +addressing when they should have used long absoule addressing. + +(AFAAndyW) + +23. IBeamCursor() (in QDAux.h) is prototyped with a Word parameter; it should +be void. + +(J.Mills11) + +24. TEInsert() (in TextEdit.h) has one too few parameters prototyped. + +(J.Mills11) + +25. Improperly set optionList parameters on GetFileInfo calls were causing +compiler crashes, generally in a pseudo-random way, but most often while +creating .sym files. + +(Walker Archer) + +26. With optimize 1, adding 1 to a global long and saving the result to the +same location generated incorrect code. (e.g. v := v+1 or ++v where v is a +global 4-byte value.) + +27. The purge call to remove an included file from memory was not working +correctly. + +(Jawaid Bazyar) + +28. Casting an l-value is not legal, but the compiler did not flag an error. + +(Marc Wolfgram, Doug Gwyn) + +29. Macro stringization of a string produced a garbage result. + +(D.Kopper) + +30. A conditional jump based on a load of a signed character could be evaluated +incorrectly. + +31. In several places, particularly in the .CONSOLE standard I/O routines, the +libraries used absolute addressing when long addressing should have been used, +or when the databank register should have been set to K. These problems could +cause loads and stores or loss of character output with the large memory model. + +(Marsha J, John Joganic, et. al.) + +32. The library routine that sets bank zero memory to zero trashes the data +register. + +(GSPlusDiz) + +33. gets() does not write a terminating null character if the return key is +pressed right away. + +(Jawaid Bazyar) + +34. C programs hang when input is read through standard in and standard in +is redirected from a file using a shell command. + +(Jawaid Bazyar) + +35. sys_nerr is 6; it should be 11. + +(Doug Gwynn, Joe Walters) + +36. When a single code segment exceeds 32K, the compiler could loose track of +the correct length for an object file. + +37. In some cases, a conditional branch based on the result of a divide or add +could fail. diff --git a/cc.notes b/cc.notes old mode 100755 new mode 100644 index 13b4fbd..eadd5df --- a/cc.notes +++ b/cc.notes @@ -1 +1,913 @@ -ORCA/C 2.1.1 Copyright 1997, Byte Works Inc. -- Change List -------------------------------------------------------------- 2.1.1 1. Bugs squashed. See bug notes, below. 2.1.0 1. Bugs squashed. See bug notes, below. 2. New bit added for vararg stack repair removal. See #pragma optimize, below. 3. There have been several changes to assert(). See the Manual Erratta for page 343 for details. 4. C supports the extended character set. See "Extended Characters." 5. You can create defaults that are used in all of your C programs using the new defaults.h file. See "The Default .h File." 6. ORCA/C supports // comments. See "// Comments." 2.0.3 1. Bugs squashed. See bug notes, below. 2.0.2 1. Bugs squashed. See bug notes, below. 2.0.1 1. Bugs squashed. See bug notes, below. -- Bugs from C 2.1.1 B1 that have been fixed -------------------------------- These bugs appeared in a beta release. They did not appear in any commercial release, but we introduced during bug corrections. These notes will be removed in the commercial release notes. 1. Reserved words appearing in macros were not correctly scanned. (Mike Westerfield) 2. The rewind() function failed when #pragma lint -1 was used. (Marsha Jackson) -- Manual Erratta ----------------------------------------------------------- p. 40 The description of the action function says it takes a single integer parameter. Actually, it takes two parameters, as shown in the example on page 41. Both the description and the sample on page 41 indicate that the action procedure for an NDA should return void. Actually, the action routine should return int, returning 0 if it handled the action and 1 if it did not. The correct function looks like this: int Action (long param, int code) { int handledEvent = 0; <<>> return handledEvent; } The description of the init function doesn't point out some important limitations. When this call is made at shutdown time, your NDA has already been placed in a dormant state, and all RAM has been deallocated. (This happened when the close function was called.) If you need dynamic memory for any purpose, be sure you obtain a valid user ID, and that you dispose of the memory after you are finished with it. Do not rely on C memory management functions at shutdown time. Static variables are safe, though, and can be used to pass information to the init function for use at shutdown time. p. 67 Delete the paragraph starting "One important point is that you should never reinitialize the Text Tool Set. ..." ORCA/C no longer uses the Text Tool Set for routine input and output, and definitely does not use it for I/O redirection. p. 100 The text does not mention the sixth default character. It is not used by PRIZM, though. For details on the 6th default character (as well as the 5th) see page 193, where their use by the text based editor is described. p. 101 The sample SYSTABS line at the top of the page should start 8 100110 p. 107 The table shows the language number for C as 7. It should be 8. p. 240 The discussion of escape sequences states that numeric escape sequences can contain from one to three digits. This was true until ORCA/C 2.1, when the compiler was changed to respect the ANSI C standard. The compiler will now scan an octal numeric escape sequence until no more octal characters are found, and it will scan a hexadecimal numeric escape sequence until no more hexadecimal characters are found. In both cases, the result is then anded with 0x00FF to yield a single character. The discussion concerning floating-point constants is misleading. While constants are indeed handled as extended values in the executable program, the compiler itself uses double values for the constants internally, so you need to adhere to the valid exponent range for double values, and you should expect to see accuracy in constants that is in line with double values. p. 241 ORCA/C now supports // comments. See "// Comments," below. p. 250 Several things are listed that will cause a .sym file to stop or not be built at all. Add to this list a #append, which does not work like a #include. It's worth keeping in mind that #append in included in ORCA/C solely for the purpose of appending files of a different language. There are several advantages to using #append to tack assembly language source to the end of a C source file, but there is no other place in ORCA/C where a #append is more useful than a #include. p.258 The #pragma ignore directive supports a new bit. Bit 3 controls whether // comments are allowed. If bit 3 is set, as in #pragma ignore 0x0008 ORCA/C supports // comments. If bit 3 is clear, ORCA/C does not support // comments, which are not actually allowed in ANSI C programs. See "// Comments," below, for a complete description of // comments. p. 263 1. The discussion of NDAs is on page 40, not page 58. 2. There is a new optimization bit for #pragma optimize. See #pragma optimize, below. p. 337 The ORCA/C compiler is intended as a faithful implementation of ANSI C with some extensions, but there have always been some library functions from ANSI C that were missing in ORCA/C. Chapter 19 should start with a summary of these omissions. They are: locale.h This header file is missing completely, along with all of its functions. stdlib.h The functions mblen(), mbstowcs(), mbtowc(), wcstombs() and wctomb() are missing. These are related to locale.h. string.h strcoll() and strxfrm() are missing. These are related to locale.h. time.h The function strftime() is missing. p. 343 The documentation states that assert() uses exit(-1) to exit a program. Actually, it uses abort(). Beginning with ORCA/C 2.1, assert() prints a string that includes the assertion itself, not just the line number and file name. The assertion has the form Assertion failed: file :hd:foo.cc, line 47; assertion: bar==1 The documentaion states assert() writes to stdout. Beginning with ORCA/C 2.1, it writes to stderr. p. 353 The discussion of _exit() should note that the _exit() function is an extension to ANSI C. p. 375 The discussion of isascii() should note that isascii() is an extension to ANSI C. p. 376 The discussions of iscsym() and iscsymf() should note that these functions are extensions to ANSI C. p. 377 The discussion of isodigit() should note that isodigit() is an extension to ANSI C. p. 396 The discussion of strpos() and strrpos() should note that the these functions are an extension to ANSI C. p. 398 The discussion of strrpbrk() should note that the strrpbrk() function is an extension to ANSI C. p. 404 The discussions of toascii() and _tolower should note that they are extensions to ANSI C. p. 405 The discussion of _toupper should note that _toupper is an extension to ANSI C. p. 444,445 The control codes to turn the cursor on and off are no longer used in the .CONSOLE driver, which is what the current version of ORCA/C uses for all text output. In the .CONSOLE driver, the cursor is always off unless it is waiting for a character. -- Compiler changes introduced in C 2.1.0 ----------------------------------- The Default .h File ------------------- The default .h file is a new way for you to set up compiler options that you want to use on every C source file you compile. Here's how it works: When ORCA/C starts, it begins by processing any command line parameters. Next, it looks for a file called defaults.h in the library folder. Finally, it compiles your source file. When ORCA/C looks for the defaults.h file, it behaves almost as if your program had started with the line #include The only differences are that the file doesn't have to exist (and if it doesn't no error is generated), the line is never shown in your source file, and the line number counter is not incremented. You can put absolutely anything you like in this file. The intent is to use it for pragmas or other preprocessor directives that you would like to become defaults for all of your programs, but there is no restruction that prevents you from putting other things in the file. WARNING: If you add a defaults.h file, be sure and delete all .sym files. .sym files are created by the compiler to make recompiling programs faster. They need to be recreated with the new information from the defaults.h file, but the compiler will not notice the presense of the defaults.h file if it is compiling a .sym file created with a previous version of the compiler. // Comments ----------- ORCA/C supports // comments. These comments begin with the characters //, and continue to the end of the physical line. // comments are a flagrant violation of the ANSI C standard. This is legal ANSI C, and it should print 4: a = 8//* yep, this is legal */ 2 ; printf("All ANSI C compilers should now print 4! %d\n", a); To restore ANSI conformance, use the #pragma ignore directive. Setting bit 3 (a value of 8) tells ORCA/C to allow // comments. This is the default. Clearing bit 3 tells ORCA/C not to look for // comments. To restore ANSI conformance for all programs, use this directive in the defaults.h file. (see "The Default .h File," above.) Extended Characters ------------------- Bear with me. This is an ASCII file, and it describes non-ASCII material. Beginning with version 2.1, the PRIZM desktop editor supports the full Apple extended character set. A file called FontTest on the samples disk shows the complete character set, and also contains a table that shows how to type each character from a U.S. English keyboard. C supports the use of extended characters in strings, comments, identifiers, and for a few mathematical operations. Any character you can type from PRIZM (or for that matter, any character with an ordinal value in [1..12, 14..255]) can appear in a string or comment. The ordinal value of the character matches the values shown in FontTest, as well as several official Apple publications. Keep in mind that many output devices, including Apple's text console driver, do not support all of these characters. ORCA/C will properly send extended characters to whatever output device you choose, but what happens when the output device tries to handle the character varies from device to device. Many of the characters in the extended character set are used in languages oter than English, and are now allowed in identifiers. There are two ways to think about which characters will work in an identifier. The simple way is to remember that all characters that look like a graphically modified ASCII alphabetic character or a Greek alphabetic character are allowed in identifiers. For example, an a with two dots above it is now legal in an identifier. The more exact, and naturally more complicated way to think about which characters are allowed in an identifier is to list all of them. Since this is an ASCII file, I'll list the ordinal values--you can cross reference the values in FontTest. The ordinal values of the extended characters that are allowed in identifiers are [$80..$9F, $A7, $AE, $AF, $B4..$B9, $BB..$BF, $C4, $C6, $CB..$CF, $D8, $DE, $DF]. In addition, ORCA/C supports several extended characters as shortcuts for multi-character mathematical operations. These are: ordinal value description substitutes for ------------- ----------- --------------- $C7 two < << $C8 two > >> $AD not equal != $B2 less than or equal <= $B3 greater than or equal >= $D6 division (- with dots) / Finally, the non-breaking space, sometimes called the sticky space (ordinal value $CA), is treated exactly like a standard space character. #pragma optimize ---------------- In brief, there is a new optimization bit. Setting bit 6 (a value of 64) turns off stack repair code around variable argument function calls. The rest of this section describes when the stack repair code is generated, why, and the side effects of using this optimization--or not using it. In variable argument functions (functions with ... as the last "parameter") it is illegal to pass fewer parameters than the function expects, or to pass parameters of a type different than the function expects. For example, both of these statements are illegal in ANSI C, even though few if any compilers can detect the error (and those that do are blocking some legal--albeit stupid--C code.): printf("%d %d", 4); printf("%d", 4.5); ORCA/C has always taken advantage of this fact to generate code that is more efficient and compatible with the other ORCA languages. With all optimizations on, programs containing the above statements will corrupt the stack, generally leading to a crash. On the other hand, ORCA/C did not allow this statement: printf("%d", 4, 5); Contrary to all common sense, the ANSI standard says this statement is legal IF THE APPROPRIATE HEADER FILE IS INCLUDED, even though the first two are not. Beginning with ORCA/C 2.1, this statement will work. Note that in keeping with the ANSI standard, this call and others like it only work if the function is properly defined with a prototyped variable argument parameter list. There are two undesireable side effects, though. First, all function calls to a variable argument function are surrounded by extra stack repair code, even if you set optimization bit 3. (This bit turns off stack repair code.) This increases code size and slows a program down. Sometimes these changes are noticeable, or even dramatic. Second, native code peephole optimization is always disabled when stack repair code is in use, so you loose another optimization if you do not use this one. Turning this optimization on means ORCA/C is no longer strictly in compliance with the ANSI standard. For strict compliance, you should leave stack repair code on for variable argument functions. You also need to disable stack repair code in any user-defined function that uses the va_arg() function, since this function is not compatible with stack repair code. For strict compliance, then, use at least #pragma optimize 0x0008 You can also add all of the other optimizations except removal of stack repair code around variable argument function calls and remain ANSI compliant, so this pragma will also work with all ANSI C programs: #pragma optimize 0x003F If you use #pragma debug 0x0010 to enable stack check debug code, the compiler will still flag variable argument functions that do not consume all arguments as a run-time error, even though ANSI C does allow them. -- Bugs from C 2.1.0 that have been fixed ----------------------------------- 1. In some situations, fread() reread the first 1K or so of the file. (Devin Reade) 2. Typedef names used as macro parameters were not treated properly. (Devin Reade) 3. In the error message "pascal qualifier is only allowed on functions", qualifier was spelled qualtifier. (Kelvin Sherlock) 4. strtod() and atof() did not handle errors correctly when the input string contained leading whitespace and no valid numeric characters, or when the input string was the NULL pointer. (Dave Tribby) -- Bugs from C 2.0.3 that have been fixed ----------------------------------- 1. Corrected a very rare bug that caused an unreliable value to be used in determining the type of an assignment statement. 2. Converting a value larger than 2147483647.0 from a real representation to an unsigned long integer representation did not generally work correctly. (Soenke Behrens) 3. Variables declared as "unsigned" were treated as "int" rather than "unsigned int". (Soenke Behrens, Philipp Vandry) 4. isgraph(' ') was true; it now correctly returns 0. (Soenke Behrens) 5. When asked to scan 65536 or more bytes, memchr actually scanned an extra 65536 bytes, often returning an incorrect result. (Soenke Behrens) 6. scanf("%d", &i) did not return EOF if it was used twice in succession, once with a numeric line followed by a return, and then pressing Control-@ o signal and end of file. (Sharon Barbaccia) 7. A switch statement with a default label but no case labels now generates the correct code to jump to the default label. (Animasia, Soenke Behrens, Michael Hackett) 8. In textedit.h, the last parameter to TEInsert was a Long; it has been changed to Handle. (Norm Dodge) 9. In time.h, NULL and size_t are now declared. (Soenke Behrens) 10. In time.h, string.h, stdio.h and stdlib.h, several functions that should have had const arguments do, now. (Soenke Behrens) 11. 0x8000 * 1 and 0x80000000 * 1 are now evaluated correctly. (Note: This actually showed up as a pointer offset bug, where *ptr = (char *)0x00C000; int offset = -32768; gave an incorrect result for ptr + offset). (Soenke Behrens, David Empson) 12. In expressions that could be evaluated at compile time, results that overflowed an integer frequently resulted in the constant being improperly promoted from an integer or unsigned to a long or unsigned long. Examples of expressions that would cause this kind of error are (65533U + 1U) / 2 and 0x8000|1. (Soenke Behrens, David Empson, Jay Krell) 13. In expressions that could be evaluated at compile time, binary operations involving an unsigned and integer were treated as an integer, when they should be treated as unsigned. This applies both to short and long operands. (Soenke Behrens, David Empson, Jay Krell) 14. The first and last parameter to FWEntry were reversed by the tool glue code. (Soenke Behrens, David Empson) 15. Storing multiple long values through a pointer stored in a global or static variable, as in a->b = a->c = 0L; where b and c are long and a is a global pointer, did not store the correct value in any but the rightmost operand. (Soenke Behrens, Derek Taubert) 16. Code generation has been improved for optimized code when a value is stored through a global or static pointer. 17. A linefeed between a macro name and the ( before the macro arguments caused a spurious compiler error. (Soenke Behrens, Jay Krell) 18. When skipping tokens due to a preprocessor command, ORCA/C was flagging # tokens from assembly language code as an error. Frankly, I can read the standard either way here. It's clear that skipped code must be tokenized. It is not clear whether # is allowed as a token in skipped code. Since I've gotten close to a bazilion complaints about this, though, I'm streatching things to allow # in skipped code, even without using the ignore pragma. (Soenke Behrens, Matt Ackeret) 19. In misctool.h, the fields in the HexTime struct were reversed, causing problems with the WriteTimeHex call. (Soenke Behrens, David Empson) 20. In stdio.h, fputc(), putchar() and ungetc() were declared with char parameters that should have been declared as int. In ctype.h, the same is true for tolower() and toupper(). (Soenke Behrens) 21. signal.h did not define sig_atomic_t; (Soenke Behrens) 22. Loads of double values were not performed correctly by the FPE version of the SysFloat library, resulting in a large loss of precision. (Soenke Behrens, Dirk Froehling, Frank Gizinski, Doug Gwyn) 23. Function parameters of type (const void *) generated an error when a pointer type was passed, rather than treating all pointer types as compatible. (Animasia) 24. There are several technical violations of the ANSI C namespace for header files. Basically, ANSI C says a compiler can't declare names in headers other than those documented in the standard unless they follow some very specific rules. Identifiers that start with an underscore and are followed by another underscore or an uppercase letter are reserved for use by the implementation. If you avoid these and all names explicitly defined by ANSI C, you should not have problems. Because ORCA/C defines some names other than those declared in the standard, and also because these names do not start with an underscore followed by an underscore or uppercase letter, there is the very slight potential that a program that should compile correctly won't. This bug can be corrected with the new libraries by defining a macro __KeepNamespacePure__ before including any header files. At some point I plan to define a header file that is always included, and you could define this macro there for 100% ANSI namespace compatibility. Until that time, though, the bug technically will continue to exist, but you have an easy workaround: just define the macro like this: #define __KeepNamespacePure__ 0 before the #include's in any file that should compile under ANSI C, but has namespace problems. (Soenke Behrens) 25. The various arguments and return types in math.h were declared as extended; they have been changed to double. (This actually doesn't make any difference, since all arguments and return types are promoted to extended anyway.) (Soenke Behrens) 26. The second parameter of the modf() function was of type (int *); this has been changed to (double *). (Soenke Behrens, Jay Krell) 27. In starg.h, va_end was declared as a function, when it must be a macro. It is now a macro. (Soenke Behrens) 28. localtime() now sets tm_isdst based on the BRAM setting. You can change the BRAM setting using the Clock CDev. (Soenke Behrens, Marlin Allred) 29. Mixing an integer 0 with a pointer in a conditional expression, as in void *p, *q = 0xdeadbeef; p = (1) ? 0 : q; generated incorrect code. (Soenke Behrens, Devin Reade) 30. If all of the following contitions are met, the 2.0.3 compiler crashes: a. Debug code is turned on (as in #pragma debug -1). b. A struct type is defined, and one of the elements of the struct type is a pointer back to the same struct type. (Think linked lists.) c. A function is defined containing a variable of this struct type, and that variable is the first variable processed when the compiler builds the debug symbol table. (Soenke Behrens) 31. Initlializers did not work for types defined like "static const struct foo bar[] = " Leaving out const worked fine. (Soenke Behrens) 32. Using const after a struct or union typedef name and before the variable name, as in struct charname { const char *symbol; const char *crypted; }; static struct charname const charname[3]; caused a spurious compiler error. (Soenke Behrens) 33. Casting an unsigned long value to double did not work correctly when the value being cast could not be evaluated until run-time, and when the value exceeded 0x7FFFFFFFul. (Soenke Behrens, Philipp Vandry) 34. Ignoring a long value returned by a tool call by casting the result to void, as in (void) ConvSeconds (TimeRec2ProDOS, 0L, (Pointer) &time); left the results on the stack, which generally resulted in a crash. The value is correctly removed, now. (Soenke Behrens, David Empson) 35. In some cases, nesting an increment or decriment operator around another increment or decrement operator, as in foo[*sp++]++ generated incorrect code. (Soenke Behrens) 36. Declaring a function using prototyped parameters, then defining it with K&R parameters, as in extern void foo (int *, int *); void foo (bar, gorp) int *bar, *gorp; {} generated incorrect code for accessing the parameters. (Soenke Behrens) 37. The compiler did not flag an error when an old-style struct parameter was used in a prototyped function declatation, as in: void foo (int x) struct bar = {1,2}; { return; } (Peter Watson, Soenke Behrens) 38. The predefined macros __LINE__, __STDC__ and __ORCAC__ did not work correctly when used with the ## operator. (Soenke Behrens, Jay Krell) 39. The __VERSION__ macro was not corrently updated in several earlier versions. It is now in lock-step with the version number printed when ORCA/C compiles a program, making it much more likely that it will stay correct. (Michael Hackett) 40. scanf() and its cousins incremented the number of items scanned when a %d or %i specifier encountered an input stream with no matching number. For example, sscanf("foo","%d",&bar) returned 1, when it should return 0, indicating that no number was found in the input stream. (Soenke Behrens) 41. When handling character set specifiers, scanf() and its cousins are supposed to allow ] as the first character in a set. For example, "%[]]" should scan ']', while "%[^]]" should scan all but ']'. This works correctly, now. (Jay Krell, Soenke Behrens) 42. With a file opened as "rb+", writing a single character and then closing the file did not always write the character to the output file. Multiple character writes would succeed. (Peter Watson, Soenke Behrens) 43. When a file is opened for reading and writing (as with "r+"), then a read is done, followed by an fflush(), the file should be available for output. In ORCA/C 2.0.3, it was not reset so output could occur. Note that this is generally no big deal, since the behavior of fflush() is undefined if the most recent operation on the file was input. In other words, the file position is not reliable. In general, you should use fseek(), fsetpos() or rewind() to change a file from input to output mode, not fflush(). (Soenke Behrens) 44. fflush(NULL) should flush all open streams. Starting with this version, it does. 45. With output redirected to a file and input comming from the keyboard, pressing the return key echoed the return that should have shown up on the screen to the output file. (Soenke Behrens, David Empson) 46. ORCA/C was allowing prototyped parameter lists with types but no identifier, as in foo (int, float) in both function declarations and function definitions. They should only be allowed in function declarations, and now cause an error if the identifier is missing in a function definition. (Soenke Behrens) 47. Variable argument functions that pass too many parameters are legal, and should not cause the compiler to behave in an unexpected way. ORCA/C now allows such function calls. See #pragma optimize for some details. (Soenke Behrens) 48. Assignments of structs or unions were sometimes removed from a loop by the loop invariant removal optimization when they should not have been removed. (Animasia) 49. A unary + operator was not allowed at the start of an expression. (Soenke Behrens) 50. When calling a pascal function from the C compiler's inline assembler, the compiler did not capitolize the identifier, resulting in link errors. (Jay Krell, Soenke Behrens) 51. ORCA/C 2.0.3 did not accept -1 as a value for period in #pragma nda, although documentation said it would. It now accepts a leading + or -. (Peter Watson, Soenke Behrens) 52. The compiler complained with "identifier expected" when doing something like: typedef char *ptr; typedef void *vptr; #define ptr vptr It should not care, since the preprocessor is a simple text substitution system. (Jay Krell, Soenke Behrens) 53. Multiple ## operators, as in #define cat(a,b,c) a##b##c were not handled correctly. (Soenke Behrens) 54. #append was not resetting the line counter used by the __LINE__ macro. It does, now. (Soenke Behrens) 55. When handling numeric escape sequences like '\x0077', ORCA/C has always limited the number of numeric characters actually scanned. In this specific example, the result would have been two characters, one with a value of 0x07 and another with the value '7'. According to the ANSI standard, all characters that can be included in a numeric sequence should be accepted. This, the above example should give a single character with a value of 0x77; it does now. (Dave Huang, Soenke Behrens) 56. printf("%#.0x", 0) should not print anything; it was printing 0x. (Soenke Behrens) 57. scanf with the '[' format specifier treated an input string with no matching characters as a valid match, returning a null string. It should have treated an input sequence with no matching characters as an error. (Soenke Behrens) 58. In several places, if output was suppressed and a scanf input failed, scanf returned one less than the correct number of inputs scanned. 59. Several functions were defined as macro overrides, and the macro overrides called other standard C functions. This could cause a problem in obscure cases where the function defined as a macro was used, but the user replaced the standar function it calls with one of their own. All of these cases have been corrected in some way so this cannot happen. The affected functions are: stdio.h: getc(), putc(), rewind(), setbuf() (Soenke Behrens) 60. Several functions were defined as macro overrides. This works fine unless the function is used form a program that does not include the header file. These functions have all been recreated as true library functions that will link into a program whether or not the header file is included. In cases where is more efficient to use the macro than to make a function call, the macro definition has been left in place. This is not a violation of the standard, but if if bothers you, you can eliminate the macro and replace it with the header file form shown in the ANSI standard or any correct C reference manual. If you do this, your program may end up a little larger or slower, but it will still work, since the functions do exist in ORCALib. The affected functions are: stdio.h: getc(), putc(), rewind(), setbuf() ctype.h: isalnum(), isalpha(), iscntrl(), isdigit(), isgraph(), islower(), isprint(), ispunct(), isspace(), isupper(), isxdigit() (Soenke Behrens) 61. Definitions like extern int foo = 0; are now legal. Once you wade through the technical language of the standard, it turns out that this declaration works exactly as if the extern is left off. Note that this definition is illegal in virtually all dialects of C except ANSI C. In particular, it is not legal in either K&R C or C++. Since there is no real reason to ever use it, I recomment you don't. (Soenke Behrens) 62. When the compiler found a single error, it ended with the message "1 errors found." It now ends with "1 error found." 63. ORCA/C now supports tenative definitions. Basically, this means that variables declared at the program level can be declared as many times as you like, with or without the extern qualifier. The only restrictions are: 1. The types must match on all of the declarations and definitions. 2. A variable can only get an initializer in one place, even if the same initializer is used in all places. That place does NOT have to be the last place the variable appears, though. 3. If a variable is declared without the static qualifier, it cannot be declared in any other source file without the static qualifier. This isn't really a change, but the restriction still applies. Note that you can use extern and an initializer at the same time, now. (See bug 61.) The result is a declaration, though, not a definition. In other words, if extern int foo = 4; appears in one source file, it is an error if int foo; appears in some other source file; you will get i duplicate symbol error in the linker. If the first instance is changed to extern int foo; then this is a definition, and references to the variable actually use the one declared in the other source file. (Soenke Behrens) 64. Making a function call though a variable that is declared but not a function, as in int foo; foo(4); did not generate an error, and caused various problems, like incorrect code generation or compile time hangs. This will now generate an error. (David Empson, Soenke Behrens) 65. If the last include in a source file was followed immediately by a #endif, the compiler generated a spurious error whenever a .sym file was available. (Jay Krell, Soenke Behrens, JoeV16@AOL.COM, Michael Hackett) 66. assert() now prints the argument as a string, in addition to the file and line number. (Soenke Behrens) 67. asert() now writes to stderr, not stdout. (Soenke Behrens) 68. In some situations where a number is referenced indirectly, and added to itself, and when intermediate code optimization was used, the compiler could fail with a terminal compiler error. One example that caused this problem is: #pragma optimize 1 ... x = ptr->field + 1 + (ptr->field + 1); (Guy Umbright, Michael Hackett) 69. The midiSynth tool call GetMSData needed a tool glue routine; it has one, now. (Dave Tribby, Michael Hackett) 70. String constants formed using the macro stringization operator (#) were always disposed of at the end of a subroutine. This caused problems if the resulting string was used to initialize a static variable, since ORCA/C creates the static variable strings long after the subroutine is complete. (Philippe Manet, Michael Hackett) 71. strstr("abc", "") took an excessive amount of time to return an incorrect result. It now returns "abc", as required when the search string is the null string. (Doug Gwyn, Michael Hackett) 72. fwrite() now returns a correct element count when a disk full error occurs during a write. (Todd Whitesel, Michael Hackett) 73. The Gamm.cc benchmark gave incorrect results. This was due to a coding error in the benchmark itself. It has been corrected on the latest samples disk. 74. Pointers to functions were not entered in the debug table properly, causing debuggers to have a variety of problems. Debuggers generally show what a pointer points to, and there's no realistic way to do that for a pointer to a function, so the compiler now enters pointers to functions in the debug symbol table as if they are pointers to integers. (Michael Hackett) -- Bugs from C 2.0.2 that have been fixed ----------------------------------- 1. Debug code was inadvertantly left in the 2.0.2 compiler release. This could cause crashes or entry into a debugger, as well as extraneous text output during a compile. (Joe Wankerl) 2. The comments in stdarg.h were ended too early, so stdarg.h did not compile. -- Bugs from C 2.0.1 that have been fixed ----------------------------------- 1. The #line directive does not set the source file in a way that causes the debugger to use a different source file. (Gary Desrochers) 2. The #line directive now allows a line number of 0. 3. The results of the #line directive are now saved in the .sym file, so file names and line numbers are preserved when the .sym file is read. 4. stdarg.h has been modified to work with the stricter error checking for type casts implemented in C 2.0.1. (Doug Gwynn) -- Bugs from C 2.0 that have been fixed ------------------------------------- 1. In desk.h, added CloseNDAbyWinPtr to match TBR #1. Apple's original spelling (CloseNDAByWinPtr) has been retained for compatibility with existing source. (Dave Tribby) 2. In locator.h, an extraneous ; has been removed. (Dave Tribby, John Mills) 3. In sane.h, the spellings DecForm and Decimal have been added so Apple's naming scheme in the remainder of the file will work. (Dave Tribby) 4. In MidiSynth.h, the following spelling corrections were made: from to ---- -- WavAddrB WaveAddrB FindTuneA TineTuneA (Dave Tribby) 5. In MidiSynth.h, added SetBasicChan to match TBR. Apple's original spelling (SetBasicChannel) has been retained for compatibility with existing source. (Dave Tribby) 6. With static or global integers, multiple assignments of zero (e.g. a=b=0) stored random values in all but the last value. (Doug Gwyn, D.Leffler, AFAAndyW, et. al.) 7. strtod() and related functions fail when the input is a single digit number. (James C.Smith) 8. SaveTextState() in Locator.h did not have an inline directive. (GSPlusDiz) 9. In some cases, successive stores of a long constant with common subexpression elimination turned on would damage the stack. (GNOTim2) 10. Assigning the same constant to both a single-byte value and a word, as in unsigned char foo; unsigned int bar; bar = foo = 1; did not correctly set the most significant byte of the word value. (GNOTim2) 11. In some conditional branches involcing comples integer expressions, the condition code was not properly evaluated. (GNOTim2) 12. Optimization of arithmetic shifts by a constant in the range 9..15 has been improved. (GNOTim2) 13. Closing carriage return added to ToolLib.h. (Doug Gwyn) 14. Some comparisons of pointers to pointers, such as *p1 == *p2, caused the code generator to generate a spurious error. (Soenke Behrens) 15. strtoul() would fail when a string address at the start of a bank was passed. (AFA AndyW) 16. fread() and fwrite() now return results of size_t. (John Joganic) 17. Text programs didn't work when launched from the Finder. (JamesG7858) 18. Run-time error checks for two-byte add and subtract operations flagged legal operations as illegal. Run-time error checks for two-byte adds and subtracts have been removed. (D.Tribby) 19. fclose() did not properly close temp files before trying to destroy them. (Jawaid Bazyar) 20. Decrementing a global or static long by 1 generated incorrect code. This was fixed in an earlier version, but I don't remember which one. (Jawaid Bazyar) 21. The type for ptrdiff_t in stddef.h should be a signed type, not unsigned long. (Doug Gwyn) 22. Using the large memory model, some two-byte load operations used absolute addressing when they should have used long absoule addressing. (AFAAndyW) 23. IBeamCursor() (in QDAux.h) is prototyped with a Word parameter; it should be void. (J.Mills11) 24. TEInsert() (in TextEdit.h) has one too few parameters prototyped. (J.Mills11) 25. Improperly set optionList parameters on GetFileInfo calls were causing compiler crashes, generally in a pseudo-random way, but most often while creating .sym files. (Walker Archer) 26. With optimize 1, adding 1 to a global long and saving the result to the same location generated incorrect code. (e.g. v := v+1 or ++v where v is a global 4-byte value.) 27. The purge call to remove an included file from memory was not working correctly. (Jawaid Bazyar) 28. Casting an l-value is not legal, but the compiler did not flag an error. (Marc Wolfgram, Doug Gwyn) 29. Macro stringization of a string produced a garbage result. (D.Kopper) 30. A conditional jump based on a load of a signed character could be evaluated incorrectly. 31. In several places, particularly in the .CONSOLE standard I/O routines, the libraries used absolute addressing when long addressing should have been used, or when the databank register should have been set to K. These problems could cause loads and stores or loss of character output with the large memory model. (Marsha J, John Joganic, et. al.) 32. The library routine that sets bank zero memory to zero trashes the data register. (GSPlusDiz) 33. gets() does not write a terminating null character if the return key is pressed right away. (Jawaid Bazyar) 34. C programs hang when input is read through standard in and standard in is redirected from a file using a shell command. (Jawaid Bazyar) 35. sys_nerr is 6; it should be 11. (Doug Gwynn, Joe Walters) 36. When a single code segment exceeds 32K, the compiler could loose track of the correct length for an object file. 37. In some cases, a conditional branch based on the result of a divide or add could fail. \ No newline at end of file +ORCA/C 2.1.1 +Copyright 1997, Byte Works Inc. + +-- Change List -------------------------------------------------------------- + +2.1.1 1. Bugs squashed. See bug notes, below. + +2.1.0 1. Bugs squashed. See bug notes, below. + + 2. New bit added for vararg stack repair removal. See #pragma + optimize, below. + + 3. There have been several changes to assert(). See the Manual + Erratta for page 343 for details. + + 4. C supports the extended character set. See "Extended + Characters." + + 5. You can create defaults that are used in all of your C programs + using the new defaults.h file. See "The Default .h File." + + 6. ORCA/C supports // comments. See "// Comments." + +2.0.3 1. Bugs squashed. See bug notes, below. + +2.0.2 1. Bugs squashed. See bug notes, below. + +2.0.1 1. Bugs squashed. See bug notes, below. + +-- Bugs from C 2.1.1 B1 that have been fixed -------------------------------- + +These bugs appeared in a beta release. They did not appear in any commercial release, but we introduced during bug corrections. These notes will be removed in the commercial release notes. + +1. Reserved words appearing in macros were not correctly scanned. + +(Mike Westerfield) + +2. The rewind() function failed when #pragma lint -1 was used. + +(Marsha Jackson) + +-- Manual Erratta ----------------------------------------------------------- + +p. 40 + +The description of the action function says it takes a single integer parameter. Actually, it takes two parameters, as shown in the example on page 41. + +Both the description and the sample on page 41 indicate that the action procedure for an NDA should return void. Actually, the action routine should return int, returning 0 if it handled the action and 1 if it did not. The correct function looks like this: + +int Action (long param, int code) + +{ +int handledEvent = 0; + +<<>> + +return handledEvent; +} + +The description of the init function doesn't point out some important limitations. When this call is made at shutdown time, your NDA has already been placed in a dormant state, and all RAM has been deallocated. (This happened when the close function was called.) If you need dynamic memory for any purpose, be sure you obtain a valid user ID, and that you dispose of the memory after you are finished with it. Do not rely on C memory management functions at shutdown time. Static variables are safe, though, and can be used to pass information to the init function for use at shutdown time. + +p. 67 + +Delete the paragraph starting "One important point is that you should never reinitialize the Text Tool Set. ..." ORCA/C no longer uses the Text Tool Set for routine input and output, and definitely does not use it for I/O redirection. + +p. 100 + +The text does not mention the sixth default character. It is not used by PRIZM, though. For details on the 6th default character (as well as the 5th) see page 193, where their use by the text based editor is described. + +p. 101 + +The sample SYSTABS line at the top of the page should start + + 8 + 100110 + +p. 107 + +The table shows the language number for C as 7. It should be 8. + +p. 240 + +The discussion of escape sequences states that numeric escape sequences can contain from one to three digits. This was true until ORCA/C 2.1, when the compiler was changed to respect the ANSI C standard. The compiler will now scan an octal numeric escape sequence until no more octal characters are found, and it will scan a hexadecimal numeric escape sequence until no more hexadecimal characters are found. In both cases, the result is then anded with 0x00FF to yield a single character. + +The discussion concerning floating-point constants is misleading. While constants are indeed handled as extended values in the executable program, the compiler itself uses double values for the constants internally, so you need to adhere to the valid exponent range for double values, and you should expect to see accuracy in constants that is in line with double values. + +p. 241 + +ORCA/C now supports // comments. See "// Comments," below. + +p. 250 + +Several things are listed that will cause a .sym file to stop or not be built at all. Add to this list a #append, which does not work like a #include. + +It's worth keeping in mind that #append in included in ORCA/C solely for the purpose of appending files of a different language. There are several advantages to using #append to tack assembly language source to the end of a C source file, but there is no other place in ORCA/C where a #append is more useful than a #include. + +p.258 + +The #pragma ignore directive supports a new bit. Bit 3 controls whether // comments are allowed. If bit 3 is set, as in + + #pragma ignore 0x0008 + +ORCA/C supports // comments. If bit 3 is clear, ORCA/C does not support // comments, which are not actually allowed in ANSI C programs. + +See "// Comments," below, for a complete description of // comments. + +p. 263 + +1. The discussion of NDAs is on page 40, not page 58. + +2. There is a new optimization bit for #pragma optimize. See #pragma optimize, below. + +p. 337 + +The ORCA/C compiler is intended as a faithful implementation of ANSI C with some extensions, but there have always been some library functions from ANSI C that were missing in ORCA/C. Chapter 19 should start with a summary of these omissions. They are: + + locale.h + + This header file is missing completely, along with all of its functions. + + stdlib.h + + The functions mblen(), mbstowcs(), mbtowc(), wcstombs() and wctomb() are + missing. These are related to locale.h. + + string.h + + strcoll() and strxfrm() are missing. These are related to locale.h. + + time.h + + The function strftime() is missing. + +p. 343 + +The documentation states that assert() uses exit(-1) to exit a program. Actually, it uses abort(). + +Beginning with ORCA/C 2.1, assert() prints a string that includes the assertion itself, not just the line number and file name. The assertion has the form + + Assertion failed: file :hd:foo.cc, line 47; assertion: bar==1 + +The documentaion states assert() writes to stdout. Beginning with ORCA/C 2.1, it writes to stderr. + +p. 353 + +The discussion of _exit() should note that the _exit() function is an extension to ANSI C. + +p. 375 + +The discussion of isascii() should note that isascii() is an extension to ANSI C. + +p. 376 + +The discussions of iscsym() and iscsymf() should note that these functions are extensions to ANSI C. + +p. 377 + +The discussion of isodigit() should note that isodigit() is an extension to ANSI C. + +p. 396 + +The discussion of strpos() and strrpos() should note that the these functions are an extension to ANSI C. + +p. 398 + +The discussion of strrpbrk() should note that the strrpbrk() function is an extension to ANSI C. + +p. 404 + +The discussions of toascii() and _tolower should note that they are extensions to ANSI C. + +p. 405 + +The discussion of _toupper should note that _toupper is an extension to ANSI C. + +p. 444,445 + +The control codes to turn the cursor on and off are no longer used in the .CONSOLE driver, which is what the current version of ORCA/C uses for all text output. In the .CONSOLE driver, the cursor is always off unless it is waiting for a character. + +-- Compiler changes introduced in C 2.1.0 ----------------------------------- + +The Default .h File +------------------- + +The default .h file is a new way for you to set up compiler options that you want to use on every C source file you compile. Here's how it works: + +When ORCA/C starts, it begins by processing any command line parameters. Next, it looks for a file called defaults.h in the library folder. Finally, it compiles your source file. + +When ORCA/C looks for the defaults.h file, it behaves almost as if your program had started with the line + + #include + +The only differences are that the file doesn't have to exist (and if it doesn't no error is generated), the line is never shown in your source file, and the line number counter is not incremented. + +You can put absolutely anything you like in this file. The intent is to use it for pragmas or other preprocessor directives that you would like to become defaults for all of your programs, but there is no restruction that prevents you from putting other things in the file. + +WARNING: If you add a defaults.h file, be sure and delete all .sym files. .sym files are created by the compiler to make recompiling programs faster. They need to be recreated with the new information from the defaults.h file, but the compiler will not notice the presense of the defaults.h file if it is compiling a .sym file created with a previous version of the compiler. + + +// Comments +----------- + +ORCA/C supports // comments. These comments begin with the characters //, and continue to the end of the physical line. + +// comments are a flagrant violation of the ANSI C standard. This is legal ANSI C, and it should print 4: + + a = 8//* yep, this is legal */ 2 + ; + printf("All ANSI C compilers should now print 4! %d\n", a); + +To restore ANSI conformance, use the #pragma ignore directive. Setting bit 3 (a value of 8) tells ORCA/C to allow // comments. This is the default. Clearing bit 3 tells ORCA/C not to look for // comments. To restore ANSI conformance for all programs, use this directive in the defaults.h file. (see "The Default .h File," above.) + + +Extended Characters +------------------- + +Bear with me. This is an ASCII file, and it describes non-ASCII material. + +Beginning with version 2.1, the PRIZM desktop editor supports the full Apple extended character set. A file called FontTest on the samples disk shows the complete character set, and also contains a table that shows how to type each character from a U.S. English keyboard. + +C supports the use of extended characters in strings, comments, identifiers, and for a few mathematical operations. + +Any character you can type from PRIZM (or for that matter, any character with an ordinal value in [1..12, 14..255]) can appear in a string or comment. The ordinal value of the character matches the values shown in FontTest, as well as several official Apple publications. Keep in mind that many output devices, including Apple's text console driver, do not support all of these characters. ORCA/C will properly send extended characters to whatever output device you choose, but what happens when the output device tries to handle the character varies from device to device. + +Many of the characters in the extended character set are used in languages oter than English, and are now allowed in identifiers. There are two ways to think about which characters will work in an identifier. + +The simple way is to remember that all characters that look like a graphically modified ASCII alphabetic character or a Greek alphabetic character are allowed in identifiers. For example, an a with two dots above it is now legal in an identifier. + +The more exact, and naturally more complicated way to think about which characters are allowed in an identifier is to list all of them. Since this is an ASCII file, I'll list the ordinal values--you can cross reference the values in FontTest. The ordinal values of the extended characters that are allowed in identifiers are [$80..$9F, $A7, $AE, $AF, $B4..$B9, $BB..$BF, $C4, $C6, $CB..$CF, $D8, $DE, $DF]. + +In addition, ORCA/C supports several extended characters as shortcuts for multi-character mathematical operations. These are: + + ordinal value description substitutes for + ------------- ----------- --------------- + $C7 two < << + $C8 two > >> + $AD not equal != + $B2 less than or equal <= + $B3 greater than or equal >= + $D6 division (- with dots) / + +Finally, the non-breaking space, sometimes called the sticky space (ordinal value $CA), is treated exactly like a standard space character. + + +#pragma optimize +---------------- + +In brief, there is a new optimization bit. Setting bit 6 (a value of 64) turns off stack repair code around variable argument function calls. + +The rest of this section describes when the stack repair code is generated, why, and the side effects of using this optimization--or not using it. + +In variable argument functions (functions with ... as the last "parameter") it is illegal to pass fewer parameters than the function expects, or to pass parameters of a type different than the function expects. For example, both of these statements are illegal in ANSI C, even though few if any compilers can detect the error (and those that do are blocking some legal--albeit stupid--C code.): + + printf("%d %d", 4); + printf("%d", 4.5); + +ORCA/C has always taken advantage of this fact to generate code that is more efficient and compatible with the other ORCA languages. With all optimizations on, programs containing the above statements will corrupt the stack, generally leading to a crash. + +On the other hand, ORCA/C did not allow this statement: + + printf("%d", 4, 5); + +Contrary to all common sense, the ANSI standard says this statement is legal IF THE APPROPRIATE HEADER FILE IS INCLUDED, even though the first two are not. + +Beginning with ORCA/C 2.1, this statement will work. Note that in keeping with the ANSI standard, this call and others like it only work if the function is properly defined with a prototyped variable argument parameter list. + +There are two undesireable side effects, though. First, all function calls to a variable argument function are surrounded by extra stack repair code, even if you set optimization bit 3. (This bit turns off stack repair code.) This increases code size and slows a program down. Sometimes these changes are noticeable, or even dramatic. Second, native code peephole optimization is always disabled when stack repair code is in use, so you loose another optimization if you do not use this one. + +Turning this optimization on means ORCA/C is no longer strictly in compliance with the ANSI standard. For strict compliance, you should leave stack repair code on for variable argument functions. You also need to disable stack repair code in any user-defined function that uses the va_arg() function, since this function is not compatible with stack repair code. For strict compliance, then, use at least + + #pragma optimize 0x0008 + +You can also add all of the other optimizations except removal of stack repair code around variable argument function calls and remain ANSI compliant, so this pragma will also work with all ANSI C programs: + + #pragma optimize 0x003F + +If you use #pragma debug 0x0010 to enable stack check debug code, the compiler will still flag variable argument functions that do not consume all arguments as a run-time error, even though ANSI C does allow them. + +-- Bugs from C 2.1.0 that have been fixed ----------------------------------- + +1. In some situations, fread() reread the first 1K or so of the file. + +(Devin Reade) + +2. Typedef names used as macro parameters were not treated properly. + +(Devin Reade) + +3. In the error message "pascal qualifier is only allowed on functions", +qualifier was spelled qualtifier. + +(Kelvin Sherlock) + +4. strtod() and atof() did not handle errors correctly when the input string contained leading whitespace and no valid numeric characters, or when the input string was the NULL pointer. + +(Dave Tribby) + +-- Bugs from C 2.0.3 that have been fixed ----------------------------------- + +1. Corrected a very rare bug that caused an unreliable value to be used in determining the type of an assignment statement. + +2. Converting a value larger than 2147483647.0 from a real representation to an unsigned long integer representation did not generally work correctly. + +(Soenke Behrens) + +3. Variables declared as "unsigned" were treated as "int" rather than "unsigned int". + +(Soenke Behrens, Philipp Vandry) + +4. isgraph(' ') was true; it now correctly returns 0. + +(Soenke Behrens) + +5. When asked to scan 65536 or more bytes, memchr actually scanned an extra 65536 bytes, often returning an incorrect result. + +(Soenke Behrens) + +6. scanf("%d", &i) did not return EOF if it was used twice in succession, once with a numeric line followed by a return, and then pressing Control-@ o signal and end of file. + +(Sharon Barbaccia) + +7. A switch statement with a default label but no case labels now generates the correct code to jump to the default label. + +(Animasia, Soenke Behrens, Michael Hackett) + +8. In textedit.h, the last parameter to TEInsert was a Long; it has been changed to Handle. + +(Norm Dodge) + +9. In time.h, NULL and size_t are now declared. + +(Soenke Behrens) + +10. In time.h, string.h, stdio.h and stdlib.h, several functions that should have had const arguments do, now. + +(Soenke Behrens) + +11. 0x8000 * 1 and 0x80000000 * 1 are now evaluated correctly. (Note: This actually showed up as a pointer offset bug, where + + *ptr = (char *)0x00C000; + int offset = -32768; + +gave an incorrect result for ptr + offset). + +(Soenke Behrens, David Empson) + +12. In expressions that could be evaluated at compile time, results that overflowed an integer frequently resulted in the constant being improperly promoted from an integer or unsigned to a long or unsigned long. Examples of expressions that would cause this kind of error are (65533U + 1U) / 2 and 0x8000|1. + +(Soenke Behrens, David Empson, Jay Krell) + +13. In expressions that could be evaluated at compile time, binary operations involving an unsigned and integer were treated as an integer, when they should be treated as unsigned. This applies both to short and long operands. + +(Soenke Behrens, David Empson, Jay Krell) + +14. The first and last parameter to FWEntry were reversed by the tool glue code. + +(Soenke Behrens, David Empson) + +15. Storing multiple long values through a pointer stored in a global or static variable, as in + + a->b = a->c = 0L; + +where b and c are long and a is a global pointer, did not store the correct value in any but the rightmost operand. + +(Soenke Behrens, Derek Taubert) + +16. Code generation has been improved for optimized code when a value is stored through a global or static pointer. + +17. A linefeed between a macro name and the ( before the macro arguments caused a spurious compiler error. + +(Soenke Behrens, Jay Krell) + +18. When skipping tokens due to a preprocessor command, ORCA/C was flagging # tokens from assembly language code as an error. + +Frankly, I can read the standard either way here. It's clear that skipped code must be tokenized. It is not clear whether # is allowed as a token in skipped code. Since I've gotten close to a bazilion complaints about this, though, I'm streatching things to allow # in skipped code, even without using the ignore pragma. + +(Soenke Behrens, Matt Ackeret) + +19. In misctool.h, the fields in the HexTime struct were reversed, causing problems with the WriteTimeHex call. + +(Soenke Behrens, David Empson) + +20. In stdio.h, fputc(), putchar() and ungetc() were declared with char parameters that should have been declared as int. In ctype.h, the same is true for tolower() and toupper(). + +(Soenke Behrens) + +21. signal.h did not define sig_atomic_t; + +(Soenke Behrens) + +22. Loads of double values were not performed correctly by the FPE version of the SysFloat library, resulting in a large loss of precision. + +(Soenke Behrens, Dirk Froehling, Frank Gizinski, Doug Gwyn) + +23. Function parameters of type (const void *) generated an error when a pointer type was passed, rather than treating all pointer types as compatible. + +(Animasia) + +24. There are several technical violations of the ANSI C namespace for header files. Basically, ANSI C says a compiler can't declare names in headers other than those documented in the standard unless they follow some very specific rules. Identifiers that start with an underscore and are followed by another underscore or an uppercase letter are reserved for use by the implementation. If you avoid these and all names explicitly defined by ANSI C, you should not have problems. + +Because ORCA/C defines some names other than those declared in the standard, and also because these names do not start with an underscore followed by an underscore or uppercase letter, there is the very slight potential that a program that should compile correctly won't. + +This bug can be corrected with the new libraries by defining a macro __KeepNamespacePure__ before including any header files. At some point I plan to define a header file that is always included, and you could define this macro there for 100% ANSI namespace compatibility. Until that time, though, the bug technically will continue to exist, but you have an easy workaround: just define the macro like this: + + #define __KeepNamespacePure__ 0 + +before the #include's in any file that should compile under ANSI C, but has namespace problems. + +(Soenke Behrens) + +25. The various arguments and return types in math.h were declared as extended; they have been changed to double. (This actually doesn't make any difference, since all arguments and return types are promoted to extended anyway.) + +(Soenke Behrens) + +26. The second parameter of the modf() function was of type (int *); this has been changed to (double *). + +(Soenke Behrens, Jay Krell) + +27. In starg.h, va_end was declared as a function, when it must be a macro. It is now a macro. + +(Soenke Behrens) + +28. localtime() now sets tm_isdst based on the BRAM setting. You can change the BRAM setting using the Clock CDev. + +(Soenke Behrens, Marlin Allred) + +29. Mixing an integer 0 with a pointer in a conditional expression, as in + + void *p, *q = 0xdeadbeef; + p = (1) ? 0 : q; + +generated incorrect code. + +(Soenke Behrens, Devin Reade) + +30. If all of the following contitions are met, the 2.0.3 compiler crashes: + + a. Debug code is turned on (as in #pragma debug -1). + b. A struct type is defined, and one of the elements of the struct type is a pointer back to the same struct type. (Think linked lists.) + c. A function is defined containing a variable of this struct type, and that variable is the first variable processed when the compiler builds the debug symbol table. + +(Soenke Behrens) + +31. Initlializers did not work for types defined like "static const struct foo bar[] = " Leaving out const worked fine. + +(Soenke Behrens) + +32. Using const after a struct or union typedef name and before the variable name, as in + + struct charname + { + const char *symbol; + const char *crypted; + }; + + static struct charname const charname[3]; + +caused a spurious compiler error. + +(Soenke Behrens) + +33. Casting an unsigned long value to double did not work correctly when the value being cast could not be evaluated until run-time, and when the value exceeded 0x7FFFFFFFul. + +(Soenke Behrens, Philipp Vandry) + +34. Ignoring a long value returned by a tool call by casting the result to void, as in + + (void) ConvSeconds (TimeRec2ProDOS, 0L, (Pointer) &time); + +left the results on the stack, which generally resulted in a crash. The value is correctly removed, now. + +(Soenke Behrens, David Empson) + +35. In some cases, nesting an increment or decriment operator around another increment or decrement operator, as in + + foo[*sp++]++ + +generated incorrect code. + +(Soenke Behrens) + +36. Declaring a function using prototyped parameters, then defining it with K&R parameters, as in + + extern void foo (int *, int *); + void foo (bar, gorp) + int *bar, *gorp; + {} + +generated incorrect code for accessing the parameters. + +(Soenke Behrens) + +37. The compiler did not flag an error when an old-style struct parameter was used in a prototyped function declatation, as in: + + void foo (int x) + struct bar = {1,2}; + { return; } + +(Peter Watson, Soenke Behrens) + +38. The predefined macros __LINE__, __STDC__ and __ORCAC__ did not work correctly when used with the ## operator. + +(Soenke Behrens, Jay Krell) + +39. The __VERSION__ macro was not corrently updated in several earlier versions. It is now in lock-step with the version number printed when ORCA/C compiles a program, making it much more likely that it will stay correct. + +(Michael Hackett) + +40. scanf() and its cousins incremented the number of items scanned when a %d or %i specifier encountered an input stream with no matching number. For example, + + sscanf("foo","%d",&bar) + +returned 1, when it should return 0, indicating that no number was found in the input stream. + +(Soenke Behrens) + +41. When handling character set specifiers, scanf() and its cousins are supposed to allow ] as the first character in a set. For example, "%[]]" should scan ']', while "%[^]]" should scan all but ']'. This works correctly, now. + +(Jay Krell, Soenke Behrens) + +42. With a file opened as "rb+", writing a single character and then closing the file did not always write the character to the output file. Multiple character writes would succeed. + +(Peter Watson, Soenke Behrens) + +43. When a file is opened for reading and writing (as with "r+"), then a read is done, followed by an fflush(), the file should be available for output. In ORCA/C 2.0.3, it was not reset so output could occur. + +Note that this is generally no big deal, since the behavior of fflush() is undefined if the most recent operation on the file was input. In other words, the file position is not reliable. In general, you should use fseek(), fsetpos() or rewind() to change a file from input to output mode, not fflush(). + +(Soenke Behrens) + +44. fflush(NULL) should flush all open streams. Starting with this version, it does. + +45. With output redirected to a file and input comming from the keyboard, pressing the return key echoed the return that should have shown up on the screen to the output file. + +(Soenke Behrens, David Empson) + +46. ORCA/C was allowing prototyped parameter lists with types but no identifier, as in + + foo (int, float) + +in both function declarations and function definitions. They should only be allowed in function declarations, and now cause an error if the identifier is missing in a function definition. + +(Soenke Behrens) + +47. Variable argument functions that pass too many parameters are legal, and should not cause the compiler to behave in an unexpected way. ORCA/C now allows such function calls. See #pragma optimize for some details. + +(Soenke Behrens) + +48. Assignments of structs or unions were sometimes removed from a loop by the loop invariant removal optimization when they should not have been removed. + +(Animasia) + +49. A unary + operator was not allowed at the start of an expression. + +(Soenke Behrens) + +50. When calling a pascal function from the C compiler's inline assembler, the compiler did not capitolize the identifier, resulting in link errors. + +(Jay Krell, Soenke Behrens) + +51. ORCA/C 2.0.3 did not accept -1 as a value for period in #pragma nda, although documentation said it would. It now accepts a leading + or -. + +(Peter Watson, Soenke Behrens) + +52. The compiler complained with "identifier expected" when doing something like: + + typedef char *ptr; typedef void *vptr; + #define ptr vptr + +It should not care, since the preprocessor is a simple text substitution system. + +(Jay Krell, Soenke Behrens) + +53. Multiple ## operators, as in + + #define cat(a,b,c) a##b##c + +were not handled correctly. + +(Soenke Behrens) + +54. #append was not resetting the line counter used by the __LINE__ macro. It does, now. + +(Soenke Behrens) + +55. When handling numeric escape sequences like '\x0077', ORCA/C has always limited the number of numeric characters actually scanned. In this specific example, the result would have been two characters, one with a value of 0x07 and another with the value '7'. According to the ANSI standard, all characters that can be included in a numeric sequence should be accepted. This, the above example should give a single character with a value of 0x77; it does now. + +(Dave Huang, Soenke Behrens) + +56. printf("%#.0x", 0) should not print anything; it was printing 0x. + +(Soenke Behrens) + +57. scanf with the '[' format specifier treated an input string with no matching characters as a valid match, returning a null string. It should have treated an input sequence with no matching characters as an error. + +(Soenke Behrens) + +58. In several places, if output was suppressed and a scanf input failed, scanf returned one less than the correct number of inputs scanned. + +59. Several functions were defined as macro overrides, and the macro overrides called other standard C functions. This could cause a problem in obscure cases where the function defined as a macro was used, but the user replaced the standar function it calls with one of their own. All of these cases have been corrected in some way so this cannot happen. + +The affected functions are: + + stdio.h: getc(), putc(), rewind(), setbuf() + +(Soenke Behrens) + +60. Several functions were defined as macro overrides. This works fine unless the function is used form a program that does not include the header file. + +These functions have all been recreated as true library functions that will link into a program whether or not the header file is included. In cases where is more efficient to use the macro than to make a function call, the macro definition has been left in place. This is not a violation of the standard, but if if bothers you, you can eliminate the macro and replace it with the header file form shown in the ANSI standard or any correct C reference manual. If you do this, your program may end up a little larger or slower, but it will still work, since the functions do exist in ORCALib. + +The affected functions are: + + stdio.h: getc(), putc(), rewind(), setbuf() + ctype.h: isalnum(), isalpha(), iscntrl(), isdigit(), isgraph(), islower(), + isprint(), ispunct(), isspace(), isupper(), isxdigit() + +(Soenke Behrens) + +61. Definitions like + + extern int foo = 0; + +are now legal. Once you wade through the technical language of the standard, it turns out that this declaration works exactly as if the extern is left off. + +Note that this definition is illegal in virtually all dialects of C except ANSI C. In particular, it is not legal in either K&R C or C++. Since there is no real reason to ever use it, I recomment you don't. + +(Soenke Behrens) + +62. When the compiler found a single error, it ended with the message "1 errors found." It now ends with "1 error found." + +63. ORCA/C now supports tenative definitions. Basically, this means that variables declared at the program level can be declared as many times as you like, with or without the extern qualifier. The only restrictions are: + + 1. The types must match on all of the declarations and definitions. + 2. A variable can only get an initializer in one place, even if the same initializer is used in all places. That place does NOT have to be the last place the variable appears, though. + 3. If a variable is declared without the static qualifier, it cannot be declared in any other source file without the static qualifier. This isn't really a change, but the restriction still applies. + +Note that you can use extern and an initializer at the same time, now. (See bug 61.) The result is a declaration, though, not a definition. In other words, if + + extern int foo = 4; + +appears in one source file, it is an error if + + int foo; + +appears in some other source file; you will get i duplicate symbol error in the linker. If the first instance is changed to + + extern int foo; + +then this is a definition, and references to the variable actually use the one declared in the other source file. + +(Soenke Behrens) + +64. Making a function call though a variable that is declared but not a function, as in + + int foo; + + foo(4); + +did not generate an error, and caused various problems, like incorrect code generation or compile time hangs. This will now generate an error. + +(David Empson, Soenke Behrens) + +65. If the last include in a source file was followed immediately by a #endif, the compiler generated a spurious error whenever a .sym file was available. + +(Jay Krell, Soenke Behrens, JoeV16@AOL.COM, Michael Hackett) + +66. assert() now prints the argument as a string, in addition to the file and line number. + +(Soenke Behrens) + +67. asert() now writes to stderr, not stdout. + +(Soenke Behrens) + +68. In some situations where a number is referenced indirectly, and added to itself, and when intermediate code optimization was used, the compiler could fail with a terminal compiler error. + +One example that caused this problem is: + + #pragma optimize 1 + ... + x = ptr->field + 1 + (ptr->field + 1); + +(Guy Umbright, Michael Hackett) + +69. The midiSynth tool call GetMSData needed a tool glue routine; it has one, now. + +(Dave Tribby, Michael Hackett) + +70. String constants formed using the macro stringization operator (#) were always disposed of at the end of a subroutine. This caused problems if the resulting string was used to initialize a static variable, since ORCA/C creates the static variable strings long after the subroutine is complete. + +(Philippe Manet, Michael Hackett) + +71. strstr("abc", "") took an excessive amount of time to return an incorrect result. It now returns "abc", as required when the search string is the null string. + +(Doug Gwyn, Michael Hackett) + +72. fwrite() now returns a correct element count when a disk full error occurs during a write. + +(Todd Whitesel, Michael Hackett) + +73. The Gamm.cc benchmark gave incorrect results. This was due to a coding error in the benchmark itself. It has been corrected on the latest samples disk. + +74. Pointers to functions were not entered in the debug table properly, causing debuggers to have a variety of problems. Debuggers generally show what a pointer points to, and there's no realistic way to do that for a pointer to a function, so the compiler now enters pointers to functions in the debug symbol table as if they are pointers to integers. + +(Michael Hackett) + +-- Bugs from C 2.0.2 that have been fixed ----------------------------------- + +1. Debug code was inadvertantly left in the 2.0.2 compiler release. This could cause crashes or entry into a debugger, as well as extraneous text output during a compile. + +(Joe Wankerl) + +2. The comments in stdarg.h were ended too early, so stdarg.h did not compile. + +-- Bugs from C 2.0.1 that have been fixed ----------------------------------- + +1. The #line directive does not set the source file in a way that causes the debugger to use a different source file. + +(Gary Desrochers) + +2. The #line directive now allows a line number of 0. + +3. The results of the #line directive are now saved in the .sym file, so file names and line numbers are preserved when the .sym file is read. + +4. stdarg.h has been modified to work with the stricter error checking for type casts implemented in C 2.0.1. + +(Doug Gwynn) + +-- Bugs from C 2.0 that have been fixed ------------------------------------- + +1. In desk.h, added CloseNDAbyWinPtr to match TBR #1. Apple's original +spelling (CloseNDAByWinPtr) has been retained for compatibility with existing +source. + +(Dave Tribby) + +2. In locator.h, an extraneous ; has been removed. + +(Dave Tribby, John Mills) + +3. In sane.h, the spellings DecForm and Decimal have been added so Apple's +naming scheme in the remainder of the file will work. + +(Dave Tribby) + +4. In MidiSynth.h, the following spelling corrections were made: + + from to + ---- -- + WavAddrB WaveAddrB + FindTuneA TineTuneA + +(Dave Tribby) + +5. In MidiSynth.h, added SetBasicChan to match TBR. Apple's original +spelling (SetBasicChannel) has been retained for compatibility with existing +source. + +(Dave Tribby) + +6. With static or global integers, multiple assignments of zero (e.g. a=b=0) +stored random values in all but the last value. + +(Doug Gwyn, D.Leffler, AFAAndyW, et. al.) + +7. strtod() and related functions fail when the input is a single digit number. + +(James C.Smith) + +8. SaveTextState() in Locator.h did not have an inline directive. + +(GSPlusDiz) + +9. In some cases, successive stores of a long constant with common +subexpression elimination turned on would damage the stack. + +(GNOTim2) + +10. Assigning the same constant to both a single-byte value and a word, as in + + unsigned char foo; + unsigned int bar; + + bar = foo = 1; + +did not correctly set the most significant byte of the word value. + +(GNOTim2) + +11. In some conditional branches involcing comples integer expressions, the +condition code was not properly evaluated. + +(GNOTim2) + +12. Optimization of arithmetic shifts by a constant in the range 9..15 has been +improved. + +(GNOTim2) + +13. Closing carriage return added to ToolLib.h. + +(Doug Gwyn) + +14. Some comparisons of pointers to pointers, such as *p1 == *p2, caused the +code generator to generate a spurious error. + +(Soenke Behrens) + +15. strtoul() would fail when a string address at the start of a bank was +passed. + +(AFA AndyW) + +16. fread() and fwrite() now return results of size_t. + +(John Joganic) + +17. Text programs didn't work when launched from the Finder. + +(JamesG7858) + +18. Run-time error checks for two-byte add and subtract operations flagged +legal operations as illegal. Run-time error checks for two-byte adds and +subtracts have been removed. + +(D.Tribby) + +19. fclose() did not properly close temp files before trying to destroy them. + +(Jawaid Bazyar) + +20. Decrementing a global or static long by 1 generated incorrect code. This +was fixed in an earlier version, but I don't remember which one. + +(Jawaid Bazyar) + +21. The type for ptrdiff_t in stddef.h should be a signed type, not unsigned +long. + +(Doug Gwyn) + +22. Using the large memory model, some two-byte load operations used absolute +addressing when they should have used long absoule addressing. + +(AFAAndyW) + +23. IBeamCursor() (in QDAux.h) is prototyped with a Word parameter; it should +be void. + +(J.Mills11) + +24. TEInsert() (in TextEdit.h) has one too few parameters prototyped. + +(J.Mills11) + +25. Improperly set optionList parameters on GetFileInfo calls were causing +compiler crashes, generally in a pseudo-random way, but most often while +creating .sym files. + +(Walker Archer) + +26. With optimize 1, adding 1 to a global long and saving the result to the +same location generated incorrect code. (e.g. v := v+1 or ++v where v is a +global 4-byte value.) + +27. The purge call to remove an included file from memory was not working +correctly. + +(Jawaid Bazyar) + +28. Casting an l-value is not legal, but the compiler did not flag an error. + +(Marc Wolfgram, Doug Gwyn) + +29. Macro stringization of a string produced a garbage result. + +(D.Kopper) + +30. A conditional jump based on a load of a signed character could be evaluated +incorrectly. + +31. In several places, particularly in the .CONSOLE standard I/O routines, the +libraries used absolute addressing when long addressing should have been used, +or when the databank register should have been set to K. These problems could +cause loads and stores or loss of character output with the large memory model. + +(Marsha J, John Joganic, et. al.) + +32. The library routine that sets bank zero memory to zero trashes the data +register. + +(GSPlusDiz) + +33. gets() does not write a terminating null character if the return key is +pressed right away. + +(Jawaid Bazyar) + +34. C programs hang when input is read through standard in and standard in +is redirected from a file using a shell command. + +(Jawaid Bazyar) + +35. sys_nerr is 6; it should be 11. + +(Doug Gwynn, Joe Walters) + +36. When a single code segment exceeds 32K, the compiler could loose track of +the correct length for an object file. + +37. In some cases, a conditional branch based on the result of a divide or add +could fail. diff --git a/count b/count old mode 100755 new mode 100644 index 355aff6..9860f03 --- a/count +++ b/count @@ -1 +1,37 @@ -set list CC.pas set list {list} CCommon.pas set list {list} MM.pas set list {list} Table.pas set list {list} Symbol.pas Symbol.Print set list {list} Scanner.pas Scanner.debug set list {list} Asm.pas set list {list} Expression.pas set list {list} Parser.pas set list {list} CGC.pas set list {list} CGI.pas CGI.Comments CGI.Debug set list {list} ObjOut.pas set list {list} Native.pas set list {list} DAG.pas set list {list} Gen.pas set list {list} Header.pas echo -n "Pascal: " wc -l {list} set list CCommon.asm set list {list} MM.asm set list {list} Table.asm set list {list} Symbol.asm set list {list} Scanner.asm set list {list} Expression.asm set list {list} CGC.asm set list {list} ObjOut.asm set list {list} Native.asm echo -n "Asm: " wc -l {list} set list cc.rez echo -n "Rez: " wc -l {list} \ No newline at end of file +set list CC.pas +set list {list} CCommon.pas +set list {list} MM.pas +set list {list} Table.pas +set list {list} Symbol.pas Symbol.Print +set list {list} Scanner.pas Scanner.debug +set list {list} Asm.pas +set list {list} Expression.pas +set list {list} Parser.pas +set list {list} CGC.pas +set list {list} CGI.pas CGI.Comments CGI.Debug +set list {list} ObjOut.pas +set list {list} Native.pas +set list {list} DAG.pas +set list {list} Gen.pas +set list {list} Header.pas + +echo -n "Pascal: " +wc -l {list} + +set list CCommon.asm +set list {list} MM.asm +set list {list} Table.asm +set list {list} Symbol.asm +set list {list} Scanner.asm +set list {list} Expression.asm +set list {list} CGC.asm +set list {list} ObjOut.asm +set list {list} Native.asm + +echo -n "Asm: " +wc -l {list} + +set list cc.rez + +echo -n "Rez: " +wc -l {list} diff --git a/linkit b/linkit old mode 100755 new mode 100644 index 5e833f6..6ec9456 --- a/linkit +++ b/linkit @@ -1 +1,18 @@ -obj/cc obj/symbol obj/parser obj/expression obj/scanner obj/mm obj/ccommon obj/cgi obj/cgc obj/asm obj/table obj/objout obj/native obj/dag obj/gen obj/header keep=16/cc \ No newline at end of file +obj/cc +obj/symbol +obj/parser +obj/expression +obj/scanner +obj/mm +obj/ccommon +obj/cgi +obj/cgc +obj/asm +obj/table +obj/objout +obj/native +obj/dag +obj/gen +obj/header + +keep=16/cc diff --git a/linkit2 b/linkit2 old mode 100755 new mode 100644 index f59a57b..d596956 --- a/linkit2 +++ b/linkit2 @@ -1 +1,18 @@ -obj/cc obj/symbol obj/parser obj/expression obj/scanner obj/mm obj/ccommon obj/cgi obj/cgc obj/asm obj/table obj/objout2 obj/native2 obj/dag2 obj/gen obj/header2 keep=obj/cc2 \ No newline at end of file +obj/cc +obj/symbol +obj/parser +obj/expression +obj/scanner +obj/mm +obj/ccommon +obj/cgi +obj/cgc +obj/asm +obj/table +obj/objout2 +obj/native2 +obj/dag2 +obj/gen +obj/header2 + +keep=obj/cc2 diff --git a/make b/make old mode 100755 new mode 100644 index cf9345c..adef392 --- a/make +++ b/make @@ -1 +1,191 @@ -unset exit unset cc unset cg Newer 5/cc cc.rez if {status} != 0 set exit on echo compile -e cc.rez keep=5/cc compile -e cc.rez keep=5/cc unset exit end if {#} == 0 Newer obj/asm.a asm.pas if {status} != 0 set asm asm set cc cc set parser parser end Newer obj/cc.a cc.pas if {status} != 0 set cc cc end Newer obj/ccommon.a ccommon.pas ccommon.asm if {Status} != 0 set ccommon ccommon set asm asm set cc cc set cgc cgc set cgi cgi set expression expression set mm mm set parser parser set scanner scanner set symbol symbol set table table set objout objout set native native set dag dag set gen gen set header header end Newer obj/cgc.a cgc.pas cgc.asm if {status} != 0 set cgc cgc set objout objout set native native end Newer obj/cgi.a cgi.pas cgi.comments cgi.debug if {status} != 0 set cgi cgi set asm asm set cc cc set cgc cgc set expression expression set parser parser set scanner scanner set symbol symbol set objout objout set native native set dag dag set header header end Newer obj/expression.a expression.pas expression.asm if {status} != 0 set expression expression set asm asm set cc cc set parser parser end Newer obj/mm.a mm.pas mm.asm if {status} != 0 set mm mm set asm asm set cc cc set expression expression set parser parser set scanner scanner set symbol symbol set header header end Newer obj/native.a native.pas native.asm if {status} != 0 set native native end Newer obj/objout.a objout.pas objout.asm if {status} != 0 set objout objout set native native end Newer obj/parser.a parser.pas if {status} != 0 set parser parser set cc cc end Newer obj/scanner.a scanner.pas scanner.debug scanner.asm if {status} != 0 set scanner scanner set asm asm set cc cc set expression expression set parser parser set symbol symbol set header header end Newer obj/symbol.a symbol.pas symbol.print symbol.asm if {status} != 0 set symbol symbol set asm asm set cc cc set expression expression set parser parser set header header end Newer obj/table.a table.pas table.asm if {status} != 0 set table table set asm asm set expression expression set parser parser set scanner scanner end Newer obj/dag.a dag.pas if {status} != 0 set dag dag end Newer obj/gen.a gen.pas if {status} != 0 set dag dag set gen gen end Newer obj/header.a header.pas if {status} != 0 set cc cc set parser parser set header header end else for i set {i} {i} end end set exit on if "{table}" == table if "{ccommon}" == ccommon echo compile +t +e ccommon.pas keep=obj/ccommon compile +t +e ccommon.pas keep=obj/ccommon unset ccommon end echo compile +t +e table.pas keep=obj/table compile +t +e table.pas keep=obj/table echo assemble +t +e table.asm keep=obj/table assemble +t +e table.asm keep=obj/table echo delete obj/table.root delete obj/table.root end set list "" set list "{ccommon} {mm} {cgi} {scanner} {symbol} {header} {expression}" set list {list} {cgc} {asm} {parser} {cc} {objout} {native} {gen} {dag} if "{list}" != "" for i in {list} echo compile +t +e {i}.pas keep=obj/{i} compile +t +e {i}.pas keep=obj/{i} end end unset exit set exit on compile linkit echo filetype 5/cc exe $DB01 filetype 5/cc exe $DB01 \ No newline at end of file +unset exit +unset cc +unset cg + +Newer 5/cc cc.rez +if {status} != 0 + set exit on + echo compile -e cc.rez keep=5/cc + compile -e cc.rez keep=5/cc + unset exit +end + + +if {#} == 0 + Newer obj/asm.a asm.pas + if {status} != 0 + set asm asm + set cc cc + set parser parser + end + + Newer obj/cc.a cc.pas + if {status} != 0 + set cc cc + end + + Newer obj/ccommon.a ccommon.pas ccommon.asm + if {Status} != 0 + set ccommon ccommon + set asm asm + set cc cc + set cgc cgc + set cgi cgi + set expression expression + set mm mm + set parser parser + set scanner scanner + set symbol symbol + set table table + set objout objout + set native native + set dag dag + set gen gen + set header header + end + + Newer obj/cgc.a cgc.pas cgc.asm + if {status} != 0 + set cgc cgc + set objout objout + set native native + end + + Newer obj/cgi.a cgi.pas cgi.comments cgi.debug + if {status} != 0 + set cgi cgi + set asm asm + set cc cc + set cgc cgc + set expression expression + set parser parser + set scanner scanner + set symbol symbol + set objout objout + set native native + set dag dag + set header header + end + + Newer obj/expression.a expression.pas expression.asm + if {status} != 0 + set expression expression + set asm asm + set cc cc + set parser parser + end + + Newer obj/mm.a mm.pas mm.asm + if {status} != 0 + set mm mm + set asm asm + set cc cc + set expression expression + set parser parser + set scanner scanner + set symbol symbol + set header header + end + + Newer obj/native.a native.pas native.asm + if {status} != 0 + set native native + end + + Newer obj/objout.a objout.pas objout.asm + if {status} != 0 + set objout objout + set native native + end + + Newer obj/parser.a parser.pas + if {status} != 0 + set parser parser + set cc cc + end + + Newer obj/scanner.a scanner.pas scanner.debug scanner.asm + if {status} != 0 + set scanner scanner + set asm asm + set cc cc + set expression expression + set parser parser + set symbol symbol + set header header + end + + Newer obj/symbol.a symbol.pas symbol.print symbol.asm + if {status} != 0 + set symbol symbol + set asm asm + set cc cc + set expression expression + set parser parser + set header header + end + + Newer obj/table.a table.pas table.asm + if {status} != 0 + set table table + set asm asm + set expression expression + set parser parser + set scanner scanner + end + + Newer obj/dag.a dag.pas + if {status} != 0 + set dag dag + end + + Newer obj/gen.a gen.pas + if {status} != 0 + set dag dag + set gen gen + end + + Newer obj/header.a header.pas + if {status} != 0 + set cc cc + set parser parser + set header header + end + +else + for i + set {i} {i} + end +end + +set exit on + +if "{table}" == table + if "{ccommon}" == ccommon + echo compile +t +e ccommon.pas keep=obj/ccommon + compile +t +e ccommon.pas keep=obj/ccommon + unset ccommon + end + echo compile +t +e table.pas keep=obj/table + compile +t +e table.pas keep=obj/table + echo assemble +t +e table.asm keep=obj/table + assemble +t +e table.asm keep=obj/table + echo delete obj/table.root + delete obj/table.root +end + +set list "" +set list "{ccommon} {mm} {cgi} {scanner} {symbol} {header} {expression}" +set list {list} {cgc} {asm} {parser} {cc} {objout} {native} {gen} {dag} +if "{list}" != "" + for i in {list} + echo compile +t +e {i}.pas keep=obj/{i} + compile +t +e {i}.pas keep=obj/{i} + end +end + +unset exit +set exit on +compile linkit +echo filetype 5/cc exe $DB01 +filetype 5/cc exe $DB01 diff --git a/make2 b/make2 old mode 100755 new mode 100644 index d72960c..64a2b21 --- a/make2 +++ b/make2 @@ -1 +1,193 @@ -unset exit unset cc unset cg Newer obj/cc2 cc.rez2 if {status} != 0 set exit on echo compile -e cc.rez2 keep=obj/cc2 compile -e cc.rez2 keep=obj/cc2 unset exit end if {#} == 0 Newer obj/asm.a asm.pas if {status} != 0 set asm asm set cc cc set parser parser end Newer obj/cc.a cc.pas if {status} != 0 set cc cc end Newer obj/ccommon.a ccommon.pas ccommon.asm if {Status} != 0 set ccommon ccommon set asm asm set cc cc set cgc cgc set cgi cgi set expression expression set mm mm set parser parser set scanner scanner set symbol symbol set table table set objout2 objout2 set native2 native2 set dag2 dag2 set gen gen set header2 header2 end Newer obj/cgc.a cgc.pas cgc.asm if {status} != 0 set cgc cgc set objout2 objout2 set native2 native2 end Newer obj/cgi.a cgi.pas cgi.comments cgi.debug if {status} != 0 set cgi cgi set asm asm set cc cc set cgc cgc set expression expression set parser parser set scanner scanner set symbol symbol set objout2 objout2 set native2 native2 set dag2 dag2 set header2 header2 end Newer obj/expression.a expression.pas expression.asm if {status} != 0 set expression expression set asm asm set cc cc set parser parser end Newer obj/mm.a mm.pas mm.asm if {status} != 0 set mm mm set asm asm set cc cc set expression expression set parser parser set scanner scanner set symbol symbol set header2 header2 end Newer obj/native2.a native2.pas if {status} != 0 set native2 native2 end Newer obj/objout2.a objout2.pas objout2.asm if {status} != 0 set objout2 objout2 set native2 native2 end Newer obj/parser.a parser.pas if {status} != 0 set parser parser set cc cc end Newer obj/scanner.a scanner.pas scanner.debug scanner.asm if {status} != 0 set scanner scanner set asm asm set cc cc set expression expression set parser parser set symbol symbol set header2 header2 end Newer obj/symbol.a symbol.pas symbol.print symbol.asm if {status} != 0 set symbol symbol set asm asm set cc cc set expression expression set parser parser set header2 header2 end Newer obj/table.a table.pas table.asm if {status} != 0 set table table set asm asm set expression expression set parser parser set scanner scanner end Newer obj/dag2.a dag2.pas if {status} != 0 set dag2 dag2 end Newer obj/gen.a gen.pas if {status} != 0 set dag2 dag2 set gen gen end Newer obj/header2.a header2.pas if {status} != 0 set cc cc set parser parser set header2 header2 end else for i set {i} {i} end end set exit on if "{table}" == table if "{ccommon}" == ccommon echo compile +t +e ccommon.pas keep=obj/ccommon compile +t +e ccommon.pas keep=obj/ccommon unset ccommon end echo compile +t +e table.pas keep=obj/table compile +t +e table.pas keep=obj/table echo assemble +t +e table.asm keep=obj/table assemble +t +e table.asm keep=obj/table echo delete obj/table.root delete obj/table.root end set list "" set list "{ccommon} {mm} {cgi} {scanner} {symbol} {header2} {expression}" set list {list} {cgc} {asm} {parser} {cc} {objout2} {native2} {gen} {dag2} if "{list}" != "" for i in {list} echo compile +t +e {i}.pas keep=obj/{i} compile +t +e {i}.pas keep=obj/{i} end end unset exit set exit on compile linkit2 echo filetype obj/cc2 exe $DB01 filetype obj/cc2 exe $DB01 * echo purge * purge >.null \ No newline at end of file +unset exit +unset cc +unset cg + +Newer obj/cc2 cc.rez2 +if {status} != 0 + set exit on + echo compile -e cc.rez2 keep=obj/cc2 + compile -e cc.rez2 keep=obj/cc2 + unset exit +end + + +if {#} == 0 + Newer obj/asm.a asm.pas + if {status} != 0 + set asm asm + set cc cc + set parser parser + end + + Newer obj/cc.a cc.pas + if {status} != 0 + set cc cc + end + + Newer obj/ccommon.a ccommon.pas ccommon.asm + if {Status} != 0 + set ccommon ccommon + set asm asm + set cc cc + set cgc cgc + set cgi cgi + set expression expression + set mm mm + set parser parser + set scanner scanner + set symbol symbol + set table table + set objout2 objout2 + set native2 native2 + set dag2 dag2 + set gen gen + set header2 header2 + end + + Newer obj/cgc.a cgc.pas cgc.asm + if {status} != 0 + set cgc cgc + set objout2 objout2 + set native2 native2 + end + + Newer obj/cgi.a cgi.pas cgi.comments cgi.debug + if {status} != 0 + set cgi cgi + set asm asm + set cc cc + set cgc cgc + set expression expression + set parser parser + set scanner scanner + set symbol symbol + set objout2 objout2 + set native2 native2 + set dag2 dag2 + set header2 header2 + end + + Newer obj/expression.a expression.pas expression.asm + if {status} != 0 + set expression expression + set asm asm + set cc cc + set parser parser + end + + Newer obj/mm.a mm.pas mm.asm + if {status} != 0 + set mm mm + set asm asm + set cc cc + set expression expression + set parser parser + set scanner scanner + set symbol symbol + set header2 header2 + end + + Newer obj/native2.a native2.pas + if {status} != 0 + set native2 native2 + end + + Newer obj/objout2.a objout2.pas objout2.asm + if {status} != 0 + set objout2 objout2 + set native2 native2 + end + + Newer obj/parser.a parser.pas + if {status} != 0 + set parser parser + set cc cc + end + + Newer obj/scanner.a scanner.pas scanner.debug scanner.asm + if {status} != 0 + set scanner scanner + set asm asm + set cc cc + set expression expression + set parser parser + set symbol symbol + set header2 header2 + end + + Newer obj/symbol.a symbol.pas symbol.print symbol.asm + if {status} != 0 + set symbol symbol + set asm asm + set cc cc + set expression expression + set parser parser + set header2 header2 + end + + Newer obj/table.a table.pas table.asm + if {status} != 0 + set table table + set asm asm + set expression expression + set parser parser + set scanner scanner + end + + Newer obj/dag2.a dag2.pas + if {status} != 0 + set dag2 dag2 + end + + Newer obj/gen.a gen.pas + if {status} != 0 + set dag2 dag2 + set gen gen + end + + Newer obj/header2.a header2.pas + if {status} != 0 + set cc cc + set parser parser + set header2 header2 + end + +else + for i + set {i} {i} + end +end + +set exit on + +if "{table}" == table + if "{ccommon}" == ccommon + echo compile +t +e ccommon.pas keep=obj/ccommon + compile +t +e ccommon.pas keep=obj/ccommon + unset ccommon + end + echo compile +t +e table.pas keep=obj/table + compile +t +e table.pas keep=obj/table + echo assemble +t +e table.asm keep=obj/table + assemble +t +e table.asm keep=obj/table + echo delete obj/table.root + delete obj/table.root +end + +set list "" +set list "{ccommon} {mm} {cgi} {scanner} {symbol} {header2} {expression}" +set list {list} {cgc} {asm} {parser} {cc} {objout2} {native2} {gen} {dag2} +if "{list}" != "" + for i in {list} + echo compile +t +e {i}.pas keep=obj/{i} + compile +t +e {i}.pas keep=obj/{i} + end +end + +unset exit +set exit on +compile linkit2 +echo filetype obj/cc2 exe $DB01 +filetype obj/cc2 exe $DB01 +* echo purge +* purge >.null diff --git a/smake b/smake old mode 100755 new mode 100644 index 53fe5c7..d77cb44 --- a/smake +++ b/smake @@ -1 +1,193 @@ -unset exit unset cc unset cg Newer 5/cc cc.rez if {status} != 0 set exit on echo compile -e cc.rez keep=5/cc compile -e cc.rez keep=5/cc unset exit end if {#} == 0 Newer obj/asm.a asm.pas if {status} != 0 set asm asm set cc cc set parser parser end Newer obj/cc.a cc.pas if {status} != 0 set cc cc end Newer obj/ccommon.a ccommon.pas ccommon.asm if {Status} != 0 set ccommon ccommon set asm asm set cc cc set cgc cgc set cgi cgi set expression expression set mm mm set parser parser set scanner scanner set symbol symbol set table table set objout2 objout2 set native2 native2 set dag2 dag2 set gen gen set header2 header2 end Newer obj/cgc.a cgc.pas cgc.asm if {status} != 0 set cgc cgc set objout2 objout2 set native2 native2 end Newer obj/cgi.a cgi.pas cgi.comments cgi.debug if {status} != 0 set cgi cgi set asm asm set cc cc set cgc cgc set expression expression set parser parser set scanner scanner set symbol symbol set objout2 objout2 set native2 native2 set dag2 dag2 set header2 header2 end Newer obj/expression.a expression.pas expression.asm if {status} != 0 set expression expression set asm asm set cc cc set parser parser end Newer obj/mm.a mm.pas mm.asm if {status} != 0 set mm mm set asm asm set cc cc set expression expression set parser parser set scanner scanner set symbol symbol set header2 header2 end Newer obj/native2.a native2.pas if {status} != 0 set native2 native2 end Newer obj/objout2.a objout2.pas objout2.asm if {status} != 0 set objout2 objout2 set native2 native2 end Newer obj/parser.a parser.pas if {status} != 0 set parser parser set cc cc end Newer obj/scanner.a scanner.pas scanner.debug scanner.asm if {status} != 0 set scanner scanner set asm asm set cc cc set expression expression set parser parser set symbol symbol set header2 header2 end Newer obj/symbol.a symbol.pas symbol.print symbol.asm if {status} != 0 set symbol symbol set asm asm set cc cc set expression expression set parser parser set header2 header2 end Newer obj/table.a table.pas table.asm if {status} != 0 set table table set asm asm set expression expression set parser parser set scanner scanner end Newer obj/dag2.a dag2.pas if {status} != 0 set dag2 dag2 end Newer obj/gen.a gen.pas if {status} != 0 set dag2 dag2 set gen gen end Newer obj/header2.a header2.pas if {status} != 0 set cc cc set parser parser set header2 header2 end else for i set {i} {i} end end set exit on if "{table}" == table if "{ccommon}" == ccommon echo compile +t +e ccommon.pas keep=obj/ccommon compile +t +e ccommon.pas keep=obj/ccommon unset ccommon end echo compile +t +e table.pas keep=obj/table compile +t +e table.pas keep=obj/table echo assemble +t +e table.asm keep=obj/table assemble +t +e table.asm keep=obj/table echo delete obj/table.root delete obj/table.root end set list "" set list "{ccommon} {mm} {cgi} {scanner} {symbol} {header2} {expression}" set list {list} {cgc} {asm} {parser} {cc} {objout2} {native2} {gen} {dag2} if "{list}" != "" for i in {list} purge >.null echo compile +t +e {i}.pas keep=obj/{i} compile +t +e {i}.pas keep=obj/{i} end end unset exit set exit on compile linkit2 echo filetype 5/cc exe $DB01 filetype 5/cc exe $DB01 echo purge purge >.null \ No newline at end of file +unset exit +unset cc +unset cg + +Newer 5/cc cc.rez +if {status} != 0 + set exit on + echo compile -e cc.rez keep=5/cc + compile -e cc.rez keep=5/cc + unset exit +end + +if {#} == 0 + Newer obj/asm.a asm.pas + if {status} != 0 + set asm asm + set cc cc + set parser parser + end + + Newer obj/cc.a cc.pas + if {status} != 0 + set cc cc + end + + Newer obj/ccommon.a ccommon.pas ccommon.asm + if {Status} != 0 + set ccommon ccommon + set asm asm + set cc cc + set cgc cgc + set cgi cgi + set expression expression + set mm mm + set parser parser + set scanner scanner + set symbol symbol + set table table + set objout2 objout2 + set native2 native2 + set dag2 dag2 + set gen gen + set header2 header2 + end + + Newer obj/cgc.a cgc.pas cgc.asm + if {status} != 0 + set cgc cgc + set objout2 objout2 + set native2 native2 + end + + Newer obj/cgi.a cgi.pas cgi.comments cgi.debug + if {status} != 0 + set cgi cgi + set asm asm + set cc cc + set cgc cgc + set expression expression + set parser parser + set scanner scanner + set symbol symbol + set objout2 objout2 + set native2 native2 + set dag2 dag2 + set header2 header2 + end + + Newer obj/expression.a expression.pas expression.asm + if {status} != 0 + set expression expression + set asm asm + set cc cc + set parser parser + end + + Newer obj/mm.a mm.pas mm.asm + if {status} != 0 + set mm mm + set asm asm + set cc cc + set expression expression + set parser parser + set scanner scanner + set symbol symbol + set header2 header2 + end + + Newer obj/native2.a native2.pas + if {status} != 0 + set native2 native2 + end + + Newer obj/objout2.a objout2.pas objout2.asm + if {status} != 0 + set objout2 objout2 + set native2 native2 + end + + Newer obj/parser.a parser.pas + if {status} != 0 + set parser parser + set cc cc + end + + Newer obj/scanner.a scanner.pas scanner.debug scanner.asm + if {status} != 0 + set scanner scanner + set asm asm + set cc cc + set expression expression + set parser parser + set symbol symbol + set header2 header2 + end + + Newer obj/symbol.a symbol.pas symbol.print symbol.asm + if {status} != 0 + set symbol symbol + set asm asm + set cc cc + set expression expression + set parser parser + set header2 header2 + end + + Newer obj/table.a table.pas table.asm + if {status} != 0 + set table table + set asm asm + set expression expression + set parser parser + set scanner scanner + end + + Newer obj/dag2.a dag2.pas + if {status} != 0 + set dag2 dag2 + end + + Newer obj/gen.a gen.pas + if {status} != 0 + set dag2 dag2 + set gen gen + end + + Newer obj/header2.a header2.pas + if {status} != 0 + set cc cc + set parser parser + set header2 header2 + end + +else + for i + set {i} {i} + end +end + +set exit on + +if "{table}" == table + if "{ccommon}" == ccommon + echo compile +t +e ccommon.pas keep=obj/ccommon + compile +t +e ccommon.pas keep=obj/ccommon + unset ccommon + end + echo compile +t +e table.pas keep=obj/table + compile +t +e table.pas keep=obj/table + echo assemble +t +e table.asm keep=obj/table + assemble +t +e table.asm keep=obj/table + echo delete obj/table.root + delete obj/table.root +end + +set list "" +set list "{ccommon} {mm} {cgi} {scanner} {symbol} {header2} {expression}" +set list {list} {cgc} {asm} {parser} {cc} {objout2} {native2} {gen} {dag2} +if "{list}" != "" + for i in {list} + purge >.null + echo compile +t +e {i}.pas keep=obj/{i} + compile +t +e {i}.pas keep=obj/{i} + end +end + +unset exit +set exit on +compile linkit2 +echo filetype 5/cc exe $DB01 +filetype 5/cc exe $DB01 +echo purge +purge >.null