1(* 2 Copyright (c) 2016-18, 2020 David C.J. Matthews 3 4 This library is free software; you can redistribute it and/or 5 modify it under the terms of the GNU Lesser General Public 6 License version 2.1 as published by the Free Software Foundation. 7 8 This library is distributed in the hope that it will be useful, 9 but WITHOUT ANY WARRANTY; without even the implied warranty of 10 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 Lesser General Public License for more details. 12 13 You should have received a copy of the GNU Lesser General Public 14 License along with this library; if not, write to the Free Software 15 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 16*) 17 18signature INTCODECONSSIG = 19sig 20 type machineWord = Address.machineWord 21 type address = Address.address 22 type code 23 type opcode 24 type labels 25 type closureRef 26 27 val opcode_notBoolean: opcode 28 val opcode_cellLength: opcode 29 and opcode_cellFlags: opcode 30 and opcode_clearMutable: opcode 31 and opcode_atomicIncr: opcode 32 and opcode_atomicDecr: opcode 33 and opcode_atomicReset: opcode 34 and opcode_longWToTagged: opcode 35 and opcode_signedToLongW: opcode 36 and opcode_unsignedToLongW: opcode 37 and opcode_realAbs: opcode 38 and opcode_realNeg: opcode 39 and opcode_fixedIntToReal: opcode 40 and opcode_fixedIntToFloat: opcode 41 and opcode_floatToReal: opcode 42 and opcode_floatAbs: opcode 43 and opcode_floatNeg: opcode 44 45 val opcode_equalWord: opcode 46 and opcode_lessSigned: opcode 47 and opcode_lessUnsigned: opcode 48 and opcode_lessEqSigned: opcode 49 and opcode_lessEqUnsigned: opcode 50 and opcode_greaterSigned: opcode 51 and opcode_greaterUnsigned: opcode 52 and opcode_greaterEqSigned: opcode 53 and opcode_greaterEqUnsigned: opcode 54 55 val opcode_fixedAdd: opcode 56 val opcode_fixedSub: opcode 57 val opcode_fixedMult: opcode 58 val opcode_fixedQuot: opcode 59 val opcode_fixedRem: opcode 60 val opcode_fixedDiv: opcode 61 val opcode_fixedMod: opcode 62 val opcode_wordAdd: opcode 63 val opcode_wordSub: opcode 64 val opcode_wordMult: opcode 65 val opcode_wordDiv: opcode 66 val opcode_wordMod: opcode 67 val opcode_wordAnd: opcode 68 val opcode_wordOr: opcode 69 val opcode_wordXor: opcode 70 val opcode_wordShiftLeft: opcode 71 val opcode_wordShiftRLog: opcode 72 val opcode_wordShiftRArith: opcode 73 val opcode_allocByteMem: opcode 74 val opcode_lgWordEqual: opcode 75 val opcode_lgWordLess: opcode 76 val opcode_lgWordLessEq: opcode 77 val opcode_lgWordGreater: opcode 78 val opcode_lgWordGreaterEq: opcode 79 val opcode_lgWordAdd: opcode 80 val opcode_lgWordSub: opcode 81 val opcode_lgWordMult: opcode 82 val opcode_lgWordDiv: opcode 83 val opcode_lgWordMod: opcode 84 val opcode_lgWordAnd: opcode 85 val opcode_lgWordOr: opcode 86 val opcode_lgWordXor: opcode 87 val opcode_lgWordShiftLeft: opcode 88 val opcode_lgWordShiftRLog: opcode 89 val opcode_lgWordShiftRArith: opcode 90 val opcode_realEqual: opcode 91 val opcode_realLess: opcode 92 val opcode_realLessEq: opcode 93 val opcode_realGreater: opcode 94 val opcode_realGreaterEq: opcode 95 val opcode_realUnordered: opcode 96 val opcode_realAdd: opcode 97 val opcode_realSub: opcode 98 val opcode_realMult: opcode 99 val opcode_realDiv: opcode 100 val opcode_floatEqual: opcode 101 val opcode_floatLess: opcode 102 val opcode_floatLessEq: opcode 103 val opcode_floatGreater: opcode 104 val opcode_floatGreaterEq: opcode 105 val opcode_floatUnordered: opcode 106 val opcode_floatAdd: opcode 107 val opcode_floatSub: opcode 108 val opcode_floatMult: opcode 109 val opcode_floatDiv: opcode 110 val opcode_getThreadId: opcode 111 val opcode_allocWordMemory: opcode 112 val opcode_alloc_ref: opcode 113 val opcode_loadMLWord: opcode 114 val opcode_loadMLByte: opcode 115 val opcode_loadC8: opcode 116 val opcode_loadC16: opcode 117 val opcode_loadC32: opcode 118 val opcode_loadC64: opcode 119 val opcode_loadCFloat: opcode 120 val opcode_loadCDouble: opcode 121 val opcode_loadUntagged: opcode 122 val opcode_storeMLWord: opcode 123 val opcode_storeMLByte: opcode 124 val opcode_storeC8: opcode 125 val opcode_storeC16: opcode 126 val opcode_storeC32: opcode 127 val opcode_storeC64: opcode 128 val opcode_storeCFloat: opcode 129 val opcode_storeCDouble: opcode 130 val opcode_storeUntagged: opcode 131 val opcode_blockMoveWord: opcode 132 val opcode_blockMoveByte: opcode 133 val opcode_blockEqualByte: opcode 134 val opcode_blockCompareByte: opcode 135 val opcode_deleteHandler: opcode 136 val opcode_allocCSpace: opcode 137 val opcode_freeCSpace: opcode 138 139 val codeCreate: string * Universal.universal list -> code (* makes the initial segment. *) 140 141 (* GEN- routines all put a value at the instruction counter and add 142 an appropriate amount to it. *) 143 144 (* gen... - put instructions and their operands. *) 145 val genCallClosure : code -> unit 146 val genRaiseEx : code -> unit 147 val genLock : code -> unit 148 val genLdexc : code -> unit 149 val genPushHandler : code -> unit 150 151 val genReturn : int * code -> unit 152 val genLocal : int * code -> unit 153 val genIndirect : int * code -> unit 154 val genSetStackVal : int * code -> unit 155 val genCase : int * code -> labels list 156 val genTuple : int * code -> unit 157 val genTailCall : int * int * code -> unit 158 159 val genIndirectClosure: { addr: int, item: int, code: code } -> unit 160 and genIndirectContainer: int * code -> unit 161 and genMoveToContainer: int * code -> unit 162 and genMoveToMutClosure: int * code -> unit 163 and genClosure: int * code -> unit 164 165 val genDoubleToFloat: IEEEReal.rounding_mode option * code -> unit 166 and genRealToInt: IEEEReal.rounding_mode * code -> unit 167 and genFloatToInt: IEEEReal.rounding_mode * code -> unit 168 169 val genAllocMutableClosure: int * code -> unit 170 171 val genRTSCallFast: int * code -> unit 172 val genRTSCallFastRealtoReal: code -> unit 173 val genRTSCallFastRealRealtoReal: code -> unit 174 val genRTSCallFastGeneraltoReal: code -> unit 175 val genRTSCallFastRealGeneraltoReal: code -> unit 176 val genRTSCallFastFloattoFloat: code -> unit 177 val genRTSCallFastFloatFloattoFloat: code -> unit 178 val genRTSCallFastGeneraltoFloat: code -> unit 179 val genRTSCallFastFloatGeneraltoFloat: code -> unit 180 181 val genOpcode: opcode * code -> unit 182 183 (* genEnter instructions are only needed when machine-code routines 184 can call interpreted routines or vice-versa. The enterInt instruction 185 causes the interpreter to be entered and the argument indicates the 186 reason. *) 187 188 val genEnterIntCatch : code -> unit 189 val genEnterIntCall : code * int -> unit 190 191 (* pushConst - Generates code to push a constant. *) 192 val pushConst : machineWord * code -> unit 193 194 (* Create a container on the stack *) 195 val genContainer : int * code -> unit 196 197 (* copyCode - Finish up after compiling a function. *) 198 val copyCode : {code: code, maxStack: int, numberOfArguments: int, resultClosure: closureRef } -> unit 199 200 (* putBranchInstruction puts in an instruction which involves 201 a forward reference. *) 202 datatype jumpTypes = Jump | JumpBack | JumpFalse | JumpTrue | SetHandler 203 val putBranchInstruction: jumpTypes * labels * code -> unit 204 205 val createLabel: unit -> labels 206 207 (* Define the position of a label. *) 208 val setLabel: labels * code -> unit 209 210 val resetStack: int * bool * code -> unit (* Set a pending reset *) 211 212 val genEqualWordConst: word * code -> unit 213 val genIsTagged: code -> unit 214 215 structure Sharing: 216 sig 217 type code = code 218 type opcode = opcode 219 type labels = labels 220 type closureRef = closureRef 221 end 222end ; 223