DECLARE SUB doforward (id%)
DEFINT A-Z

'Tijdelijk print2bas and printfromlist eruit gehaald( zie versie3)
'versie 5 is de eerste die procs ondersteund

DECLARE SUB resolveforward (id) : DECLARE SUB flowshort (id)
DECLARE SUB flowshortfw () : DECLARE SUB flownear16 (id)
DECLARE SUB flownear32 (id) : DECLARE SUB flownear32fw ()
DECLARE SUB flowmem () : DECLARE SUB flownear16fw ()
DECLARE SUB resolvenear16 (id, subextra) : DECLARE SUB resolvenear32 (id, subextra)
DECLARE SUB loopshortfw (id) : DECLARE SUB loopshort (id)
DECLARE FUNCTION isinsymboltable (start, negate) :
DECLARE FUNCTION formatoffset$ () : DECLARE SUB abortrefsize ()
DECLARE SUB printresolvedline (line2resolve)
DECLARE FUNCTION formatlineoffset$ () : DECLARE FUNCTION formatnames$ ()
DECLARE FUNCTION formatcomments$ () : DECLARE FUNCTION format4print$ ()
DECLARE SUB printobjlistscreen () : DECLARE SUB printoffset ()
DECLARE SUB printcomments () : DECLARE SUB printnames ()
DECLARE SUB dolabel () : DECLARE SUB abortlabelused ()
DECLARE SUB resolveshort (id) : DECLARE SUB loopitForward ()
DECLARE SUB loopitLabel () : DECLARE SUB loopit ()
DECLARE SUB jccs () : DECLARE SUB ismemorlabel ()
DECLARE SUB setCCs () : DECLARE SUB isbytereg ()
DECLARE SUB selecttoken () : DECLARE SUB initprogram ()
DECLARE SUB doprogram () : DECLARE SUB header ()
DECLARE FUNCTION footer$ () : DECLARE FUNCTION isnul (factor$)
DECLARE FUNCTION ishex (numstring$) : DECLARE FUNCTION isnum (numstring$)
DECLARE FUNCTION isbin (numstring$) : DECLARE FUNCTION isdec (numstring$)
DECLARE SUB print2bas (string2print$, addchrs)
DECLARE FUNCTION hexL$ (long2add&) : DECLARE FUNCTION hexL2$ (addlen, long2add&)
DECLARE FUNCTION hexB$ (byte2add) : DECLARE FUNCTION hexI$ (int2add)
DECLARE SUB abortstatement (expect$) : DECLARE FUNCTION isabsolute ()
DECLARE SUB flows () : DECLARE SUB islabel ()
DECLARE SUB flowrel () : DECLARE SUB jccshort (id%)
DECLARE SUB storesymbol (symtype%, value%)
DECLARE SUB jccnear32 (id%) : DECLARE SUB jccnear16 (id%)
DECLARE SUB jccnear32fw () : DECLARE SUB jccshortfw ()
DECLARE SUB jccnear16fw ()
'The scanner is in:
DECLARE SUB lookupinstruction ()
DECLARE SUB doinstruct ()
DECLARE SUB dosegment ()
DECLARE SUB dovar ()
DECLARE SUB dostruc ()
DECLARE SUB doproc ()
DECLARE SUB doequ ()
DECLARE SUB doendp ()
DECLARE SUB doendseg ()
DECLARE SUB doend ()
DECLARE SUB lookuptype ()
DECLARE SUB doident ()
DECLARE SUB initstatement ()
DECLARE SUB lookupaddintruct ()

'donderdag 15 of zo: versie !line!
'[You may distribute this as long as you 'know' me ;)]

'The body of this program is in :
DECLARE SUB validateregsizes (reg1%, reg2%)
DECLARE SUB writeregs ()
DECLARE SUB writebase ()
DECLARE SUB writebaseindex ()
DECLARE SUB validatewordsizeinstr ()
DECLARE SUB validatesegprefix (regs%)
DECLARE SUB validate16regs ()
DECLARE SUB validate16baseindex ()
DECLARE SUB validate32regs ()
DECLARE SUB writescaledindex ()
DECLARE SUB write32displacement ()
DECLARE SUB writedisplacement ()
DECLARE SUB write32base ()
DECLARE FUNCTION bytesize% (longvalue&)
DECLARE SUB proceed2variant (v%)
DECLARE FUNCTION lookupvariant% (begin%, ends%)
DECLARE SUB isxrm ()
DECLARE SUB exits ()
DECLARE SUB listonscreen ()
DECLARE SUB openfiles ()
DECLARE SUB ispointer ()
DECLARE SUB fpuREAL ()
DECLARE SUB fpuSTonly ()
DECLARE SUB fpuINT ()
DECLARE SUB fpuCTRL ()
DECLARE SUB fpufstsw ()
DECLARE SUB REALfaST ()
DECLARE SUB REALfST ()
DECLARE SUB REALfE ()
DECLARE SUB REALf ()
DECLARE SUB REALfa ()
DECLARE SUB REALp ()
DECLARE SUB REALfaE ()
DECLARE SUB isAXorE ()
DECLARE SUB isSTorMeM ()
DECLARE SUB isSTonly ()
DECLARE SUB invlpds ()
DECLARE SUB mwords ()
DECLARE SUB dts ()
DECLARE SUB acces ()
DECLARE SUB systems ()
DECLARE SUB bounds ()
DECLARE SUB arpls ()
DECLARE SUB aamaad ()
DECLARE SUB rets ()
DECLARE SUB enters ()
DECLARE SUB isImmidonly ()
DECLARE SUB incdecR ()
DECLARE SUB incdecE ()
DECLARE SUB popSeg ()
DECLARE SUB popR ()
DECLARE SUB popE ()
DECLARE SUB pushI ()
DECLARE SUB pushR ()
DECLARE SUB pushE ()
DECLARE SUB pushseg ()
DECLARE SUB pushs ()
DECLARE SUB pops ()
DECLARE SUB save ()
DECLARE SUB fill ()
DECLARE SUB interu ()
DECLARE SUB xaddcmpx ()
DECLARE SUB highlowbit ()
DECLARE SUB synchrEI ()
DECLARE SUB synchrER ()
DECLARE SUB synchr ()
DECLARE SUB inps ()
DECLARE SUB outps ()
DECLARE SUB ports ()
DECLARE SUB isAXonly ()
DECLARE SUB isDXorImmid ()
DECLARE SUB xchgAR ()
DECLARE SUB xchgRE ()
DECLARE SUB LsegW ()
DECLARE SUB movs ()
DECLARE SUB xchgs ()
DECLARE SUB leas ()
DECLARE SUB lseg ()
DECLARE SUB movseg ()
DECLARE SUB movRSYS ()
DECLARE SUB movSYSR ()
DECLARE SUB movsys ()
DECLARE SUB movRI ()
DECLARE SUB movER ()
DECLARE SUB movEdispA ()
DECLARE SUB movE ()
DECLARE SUB movEI ()
DECLARE SUB movRE ()
DECLARE SUB movAEdisp ()
DECLARE SUB movR ()
DECLARE SUB extend ()
DECLARE SUB swapRd ()
DECLARE SUB zeroext ()
DECLARE SUB signext ()
DECLARE SUB shdI ()
DECLARE SUB shifts ()
DECLARE SUB shds ()
DECLARE SUB shiftCL ()
DECLARE SUB shift1 ()
DECLARE SUB shiftI ()
DECLARE SUB abortnomatch ()
DECLARE SUB imul3RE ()
DECLARE SUB abortimmidbig (fieldid%)
DECLARE SUB imul3 ()
DECLARE SUB imul2RR ()
DECLARE SUB imul2RE ()
DECLARE SUB abortsize (fieldid%)
DECLARE SUB imul2 ()
DECLARE SUB testlogicRE ()
DECLARE SUB testlogicE ()
DECLARE SUB testlogicI ()
DECLARE SUB testlogicAI ()
DECLARE SUB testlogicEI ()
DECLARE SUB abortnotvalid (fieldid%)
DECLARE FUNCTION lookupmemdirect% ()
DECLARE SUB movsysregs ()
DECLARE SUB movsegregs ()
DECLARE SUB movimmids ()
DECLARE SUB movmem ()
DECLARE SUB movregs ()
DECLARE SUB arithmER ()
DECLARE SUB arithmRE ()
DECLARE SUB arithmAI ()
DECLARE SUB arithmEI ()
DECLARE SUB arithmI ()
DECLARE SUB arithmE ()
DECLARE SUB arithmR ()
DECLARE SUB fpu ()
DECLARE SUB arithm ()
DECLARE SUB imulmath ()
DECLARE SUB testlogic ()
DECLARE SUB initinstructtable ()
DECLARE SUB initopcodetable ()
DECLARE SUB validateadressize ()
DECLARE SUB validatenrfields ()
DECLARE SUB validateDfieldsize ()
DECLARE SUB validateEfieldsize ()
DECLARE SUB validateRfieldsize ()
DECLARE SUB lookupsymboltype ()
DECLARE SUB isCLorImmidorOne ()
DECLARE SUB isCLorImmid ()
DECLARE SUB validate1wordsize ()
DECLARE SUB isfield ()
DECLARE SUB decodefields ()
DECLARE SUB lookupfields ()
DECLARE FUNCTION skipRwhite$ (lnstring$)
DECLARE FUNCTION skipwhite$ (lnstring$)
DECLARE FUNCTION skipfactor$ (lnstring$)
DECLARE FUNCTION isTR% ()
DECLARE FUNCTION immid& (field$)
DECLARE FUNCTION isCR% ()
DECLARE FUNCTION isDR% ()
DECLARE FUNCTION isST% ()
DECLARE FUNCTION isseg% ()
DECLARE FUNCTION isregseg% ()
DECLARE FUNCTION ismem% ()
DECLARE FUNCTION isimmid% (immidstr$)
DECLARE SUB isindirectop (indirect$)
DECLARE SUB validatememoperand (operandid%)
DECLARE SUB isindirect ()
DECLARE SUB isdirect ()
DECLARE SUB ismemoperand ()
DECLARE FUNCTION lookupmemoperand% ()
DECLARE FUNCTION isdigit% (char$)
DECLARE FUNCTION validatehex& (hexstring$)
DECLARE FUNCTION validatebin& (binstring$)
DECLARE FUNCTION validatedec& (decstring$)
DECLARE SUB incdec ()
DECLARE SUB math ()
DECLARE SUB decodeopcode ()

'test versie van 9c/maar nu met file in/file out


'All NORMAL instructions up to .586( to help maintain it in an easy way
'and to understand it I put all constants in)

'Zero fields
CONST fwait = 1: CONST waits = 2: CONST locks = 3: CONST rep = 4:
CONST repnz = 5: CONST repne = 6: CONST repz = 7: CONST repe = 8
CONST daa = 9: CONST das = 10: CONST aaa = 11: CONST aas = 12
CONST cbw = 13: CONST cwde = 14: CONST cwd = 15: CONST cdq = 16:
CONST xlat = 17: CONST xlatb = 18:
CONST lodsb = 19: CONST lodsw = 20: CONST lodsd = 21
CONST movsb = 22: CONST movsw = 23: CONST movsd = 24
CONST stosb = 25: CONST stosw = 26: CONST stosd = 27
CONST insb = 28: CONST insw = 29: CONST insd = 30
CONST outsb = 31: CONST outsw = 32: CONST outsd = 33
CONST cmpsb = 34: CONST cmpsw = 35: CONST cmpsd = 36
CONST scasb = 37: CONST scasw = 38: CONST scasd = 39
CONST nop = 40: CONST hlt = 41: CONST iret = 42: CONST iretd = 43:
CONST into = 44: CONST popf = 45: CONST popfd = 46: CONST pushf = 47:
CONST pushfd = 48: CONST sahf = 49: CONST lahf = 50: CONST cmc = 51:
CONST clc = 52: CONST stc = 53: CONST cli = 54: CONST sti = 55:
CONST cld = 56: CONST std = 57: CONST pusha = 58: CONST pushad = 59:
CONST popa = 60: CONST popad = 61: CONST leave = 62: CONST clts = 63:
CONST invd = 64: CONST wbinvd = 65: CONST cpuid = 66: CONST salc = 67
CONST wrmsr = 68: CONST rdmsr = 69: CONST rdtsc = 70: CONST rsm = 71
CONST ud2 = 72: CONST rdpmc = 73

'1 operands
CONST cmpxchgb = 74: CONST aam = 75: CONST aad = 76
CONST invlpg = 77: CONST bswap = 78
CONST ja = 79: CONST jnbe = 80: CONST jae = 81: CONST jnb = 82
CONST jb = 83: CONST jnae = 84: CONST jbe = 85: CONST jna = 86
CONST jg = 87: CONST jnle = 88: CONST jge = 89: CONST jnl = 90:
CONST jl = 91: CONST jnge = 92: CONST jle = 93: CONST jng = 94
CONST je = 95: CONST jz = 96: CONST jne = 97: CONST jnz = 98
CONST jo = 99: CONST jno = 100: CONST jc = 101: CONST jnc = 102
CONST js = 103: CONST jns = 104: CONST jp = 105: CONST jpe = 106
CONST jnp = 107: CONST jpo = 108
CONST seta = 109: CONST setnbe = 110: CONST setae = 111: CONST setnb = 112
CONST setb = 113: CONST setnae = 114: CONST setbe = 115: CONST setna = 116
CONST setg = 117: CONST setnle = 118: CONST setge = 119: CONST setnl = 120:
CONST setl = 121: CONST setnge = 122: CONST setle = 123: CONST setng = 124
CONST sete = 125: CONST setz = 126: CONST setne = 127: CONST setnz = 128
CONST seto = 129: CONST setno = 130: CONST setc = 131: CONST setnc = 132
CONST sets = 133: CONST setns = 134: CONST setp = 135: CONST setpe = 136
CONST setnp = 137: CONST setpo = 138
CONST jcxz = 139: CONST jecxz = 140: CONST loops = 141: CONST loope = 142
CONST loopz = 143: CONST loopne = 144: CONST loopnz = 145: CONST jmp = 146:
CONST jmpfar = 147: CONST scall = 148: CONST callfar = 149: CONST ret = 150
CONST retf = 151: CONST push = 152: CONST pop = 153
CONST sldt = 154: CONST str = 155: CONST lldt = 156: CONST ltr = 157
CONST verr = 158: CONST verw = 159: CONST sgdt = 160: CONST sidt = 161
CONST lgdt = 162: CONST lidt = 163: CONST smsw = 164: CONST lmsw = 165
CONST neg = 166: CONST nots = 167: CONST inc = 168: CONST dec = 169
CONST idiv = 170: CONST div = 171: CONST mul = 172: CONST ints = 173

'Two fields
CONST add = 174: CONST ors = 175: CONST adc = 176: CONST sbb = 177:
CONST ands = 178: CONST subs = 179: CONST xors = 180: CONST cmp = 181
CONST test = 182
CONST rol = 183: CONST ror = 184: CONST rcl = 185: CONST rcr = 186
CONST shl = 187: CONST shr = 188: CONST sal = 189: CONST sar = 190
CONST xchg = 191: CONST lea = 192: CONST lds = 193: CONST les = 194:
CONST lfs = 195: CONST lgs = 196: CONST lss = 197: CONST mov = 198
CONST movsx = 199: CONST movzx = 200
CONST cmova = 201: CONST cmovnbe = 202: CONST cmovae = 203: CONST cmovnb = 204
CONST cmovb = 205: CONST cmovnae = 206: CONST cmovbe = 207: CONST cmovna = 208
CONST cmovg = 209: CONST cmovnle = 210: CONST cmovge = 211: CONST cmovnl = 212:
CONST cmovl = 213: CONST cmovnge = 214: CONST cmovle = 215: CONST cmovng = 216
CONST cmove = 217: CONST cmovz = 218: CONST cmovne = 219: CONST cmovnz = 220
CONST cmovo = 221: CONST cmovno = 222: CONST cmovc = 223: CONST cmovnc = 224
CONST cmovs = 225: CONST cmovns = 226: CONST cmovp = 227: CONST cmovpe = 228
CONST cmovnp = 229: CONST cmovpo = 230
CONST bt = 231: CONST bts = 232: CONST btr = 233: CONST btc = 234
CONST bsf = 235: CONST bsr = 236: CONST cmpxchg = 237: CONST xadd = 238
CONST in = 239: CONST outs = 240: CONST enter = 241:
CONST bound = 242: CONST arpl = 243: CONST lar = 244: CONST lsl = 245
'three fields
CONST imul = 246: CONST shld = 247: CONST shrd = 248

'FLOATING POINT UNIT
CONST fcompp = 249: CONST ftst = 250: CONST fxam = 251: CONST fucompp = 252
CONST fldl = 253: CONST fldl2t = 254: CONST fldl2e = 255: CONST fldpi = 256
CONST fldlg2 = 257: CONST fldln2 = 258: CONST fldz = 259
CONST fchs = 260: CONST fabs = 261: CONST f2xm1 = 262: CONST fyl2x = 263
CONST fptan = 264: CONST fpatan = 265: CONST fxtract = 266:
CONST fprem1 = 267: CONST fprem = 268: CONST fyl2xpi = 269
CONST fsqrt = 270: CONST fsincos = 271: CONST frndint = 272
CONST fscale = 273: CONST fsin = 274: CONST fcos = 275
CONST nopf = 276: CONST fdecstp = 277: CONST fincstp = 278
CONST feni = 279: CONST fdisi = 280: CONST fclex = 281:
CONST finit = 282: CONST fsetpm = 283:
CONST fild = 284: CONST fist = 285: CONST fistp = 286:
CONST ficom = 287: CONST ficomp = 288
CONST fiadd = 289: CONST fimul = 290: CONST fisub = 291
CONST fisubr = 292: CONST fidiv = 293: CONST fidivr = 294
CONST fld = 295: CONST fst = 296: CONST fstp = 297
CONST fcom = 298: CONST fcomp = 299
CONST fadd = 300: CONST fmul = 301: CONST fsub = 302
CONST fsubr = 303: CONST fdiv = 304: CONST fdivr = 305
CONST fbld = 306: CONST fbstp = 307: CONST fxchg = 308
CONST fucom = 309: CONST fucomp = 310
CONST faddp = 311: CONST fmulp = 312: CONST fsubp = 313
CONST fsubrp = 314: CONST fdivp = 315: CONST fdivrp = 316
CONST fldenv = 317: CONST fldcw = 318: CONST fstenv = 319
CONST fstcw = 320: CONST ffree = 324: CONST frstor = 321
CONST fsave = 322: CONST fstsw = 323


'Size constants
CONST sbyte = 1: CONST byte = 2: CONST word = 4: CONST dword = 8
CONST pword = 16: CONST qword = 32: CONST tbyte = 64: CONST word64 = 128
CONST short = sbyte: CONST near = word: CONST far = dword + 1 'to avoid confusion with near32
CONST near32 = dword: CONST far32 = pword

'Type constants
CONST Atype = 1: CONST Rtype = 2: CONST Etype = 3: CONST Ltype = 4
CONST Stype = 5: CONST abstype = 6: CONST Ctype = 7: CONST STtype = 8:
CONST Itype = 9
CONST CRtype = 10: CONST DRtype = 11: CONST TRtype = 12:
CONST onetype = 13

'3)Shared types a) INSTRUCTIONTABLE

TYPE instruction
  names AS STRING * 10      'toevoegen hier:opcode! en klaar is t'ie
  nrfields AS INTEGER       'if opcode < 0 then opcode = -opcode
  Pvalue AS INTEGER         'if position in subLIST of opcodes.
END TYPE

maxops = ffree
DIM SHARED instructs(maxops) AS instruction

initinstructtable

TYPE fieldtype          'will replace all fieldinfo in firstoptype,
  types AS INTEGER      'sourcetype BUT NOT immidsize etc..
  size  AS INTEGER      '1=Dc,2=Db,3=Dw,4=DD
END TYPE                'belangrijk: norm alleen bij Rd=4 anders altijd 3
                        'thisfield(i).size wel 3,4 !

'3)SHARED TYPES 3c)SEGMENT

TYPE segment
  names AS STRING * 20
  types AS INTEGER
  size AS INTEGER
END TYPE

DIM SHARED defseg AS segment

'3)SHARED TYPES 3d)STATEMENT

DIM SHARED thisfield(1 TO 3) AS fieldtype 'vervangt sourcetype,firstoptype,fieldsize

TYPE statement           'Input from statement to be checked against variant
 id AS INTEGER           'instruction id
 nrfields AS INTEGER

 'Input from statement to be used for xrm decoding
 Ereg   AS INTEGER        'reg from Either field or segreg or sysreg
 Rreg AS INTEGER          'reg from Reg field
 memsize AS INTEGER       'size of index/baseregs
 indexreg AS INTEGER
 basereg  AS INTEGER
 scalar  AS INTEGER

END TYPE
DIM SHARED this AS statement


'3)SHARED TYPES 3d)MACHINEBYTES(and helpvars and contants)


'Prefix constants (assuming 16 bit,16 bit mode)
CONST adressizechange = &H67
CONST wordsizechange = &H66

TYPE machinebytes              'encoding: parts below are values
   vid AS INTEGER              'variant..
   offset AS INTEGER           'offset

   segmentprefix  AS INTEGER
   adressprefix   AS INTEGER
   wordsizeprefix AS INTEGER
   instructprefix AS INTEGER

   opcodebytes AS INTEGER
   xrmthere AS INTEGER
   xrm AS INTEGER
   sibthere AS INTEGER
   sib AS INTEGER
 
   dispsize AS INTEGER  '1=Dc, 2=Db, 3=Dw
   displacement AS LONG
   immidsize AS INTEGER '1=Dc, 2=Db, 3=Dw
   immid AS LONG

END TYPE

DIM SHARED result AS machinebytes

TYPE swapheader
  linenr AS INTEGER
  offset AS INTEGER
  namelen AS INTEGER
  commentlen AS INTEGER
END TYPE
DIM SHARED swaps AS swapheader


'Constants used for decoding and for translating field operands

'regconstants
CONST AL = -1: CONST AX = -1: CONST eax = -1
CONST cl = 1: CONST CX = 1: CONST ECX = 1
CONST DL = 2: CONST DX = 2: CONST EDX = 2
CONST BL = 3: CONST BX = 3: CONST EBX = 3
CONST AH = 4: CONST SP = 4: CONST ESP = 4
CONST CH = 5: CONST BP = 5: CONST EBP = 5
CONST DH = 6: CONST SI = 6: CONST ESI = 6
CONST BH = 7: CONST DI = 7: CONST edi = 7

'segconstants
CONST ES = -1: CONST CS = 1: CONST SS = 2
CONST DS = 3: CONST FS = 4: CONST GS = 5

'segoverrides
DIM SHARED segoverride(-1 TO 5)
segoverride(ES) = &O46: segoverride(CS) = &O56: segoverride(DS) = &O76:
segoverride(SS) = &O66: segoverride(FS) = &O144: segoverride(GS) = &O145

'Sysreg constants
CONST CR0 = 0: CONST CR1 = 1: CONST CR2 = 2
CONST CR3 = 3: CONST DR0 = 0: CONST DR1 = 1
CONST DR2 = 2: CONST DR3 = 3: CONST DR6 = 6
CONST DR7 = 7: CONST TR6 = 6: CONST TR7 = 7

'Floating point Stackregisters
CONST ST = 0: CONST ST1 = 1: CONST ST2 = 2: CONST ST3 = 3:
CONST ST4 = 4: CONST ST5 = 5: CONST ST6 = 6: CONST ST7 = 7

'Memory field constants:

'si values... b2=0 ,1..8 en > 64
CONST EAX0 = &O10: CONST EAX2 = &O100: CONST EAX4 = &O200: CONST EAX8 = &O300
CONST ECX0 = &O1: CONST ECX2 = &O101: CONST ECX4 = &O201: CONST ECX8 = &O301
CONST EDX0 = &O2: CONST EDX2 = &O102: CONST EDX4 = &O202: CONST EDX8 = &O302
CONST EBX0 = &O3: CONST EBX2 = &O103: CONST EBX4 = &O203: CONST EBX8 = &O303
CONST EBP0 = &O5: CONST EBP2 = &O105: CONST EBP4 = &O205: CONST EBP8 = &O305
CONST ESI0 = &O6: CONST ESI2 = &O106: CONST ESI4 = &O206: CONST ESI8 = &O306
CONST EDI0 = &O7: CONST EDI2 = &O107: CONST EDI4 = &O207: CONST EDI8 = &O307
CONST ESP0 = &O4

'10..16 to distinguish from 32 bit regs//
CONST BXr = 13: CONST BPr = 15: CONST DIr = 17: CONST SIr = 16

'20..26 om ze te onderscheiden
CONST ESr = 19: CONST CSr = 21: CONST DSr = 22: CONST SSr = 23:
CONST FSr = 24: CONST GSr = 25

'30..40 om ze te onderscheiden van de andere..
CONST Bptr = 32: CONST Wptr = 33: CONST Dptr = 34
CONST Qptr = 38: CONST Tptr = 40:

'50..54 om ze te onderscheiden

CONST shortptr = 51: CONST nearptr = 52: CONST near32ptr = 53
CONST farptr = 54: CONST far32ptr = 55


'4)THE scanner
DIM SHARED asmstatement$                       'the statement
DIM SHARED token$                              'to be encoded part of stametn
DIM SHARED mem$
DIM SHARED asmline$                            'running raw statement
DIM SHARED fields$(1 TO 3)                     'the fields of instruction
DIM SHARED fieldnr                             'for errormessages needed
DIM SHARED offset
DIM SHARED asmlinenr
DIM SHARED name$                               'optional name
DIM SHARED comment$                          'optional comments

TYPE symtype
  names AS STRING * 8
  types AS INTEGER
  value AS INTEGER
END TYPE
maxsymbols = 100
DIM SHARED symboltable(maxsymbols) AS symtype
DIM SHARED scount                              'current symbol nr.
scount = 1
CONST var = 1: CONST struc = 2: CONST equ = 4
CONST label = 8: CONST proc = 16
CONST endall = 32: CONST endp = 64
CONST forward = 128: CONST null = 256

'4)TRANSLATING TO MACHINEBYTES(FINALLY the PROGRAM)

CLS :
ON ERROR GOTO outofbound
CALL initprogram
CALL doprogram

'_________________________________________________________________________
'         ONE LINE ASSEMBLER:

'Just a try to make opcode generation even more structured and
'simple. Builds on opcode.txt from Mark Hopkins( see x86snipps)
'_________________________________________________________________________

END

outofbound:
PRINT ERR
IF ERR = 6 THEN PRINT "The number is to big anyway...try again": RESUME NEXT

'
'Decodes a AAM [Dc] or AAD [Dc]
'
SUB aamaad

result.opcodebytes = instructs(this.id).Pvalue
IF this.nrfields = 0 THEN
  result.immidsize = sbyte: result.immid = 10
ELSEIF result.immidsize > sbyte THEN
  abortsize (1)
END IF

END SUB

'
'
SUB abort (expect$)

PRINT CHR$(7); expect$

END SUB

'
'Abort on immid to big
'
SUB abortimmidbig (fieldid)

instr$ = LEFT$(instructs(this.id).names, INSTR(instructs(this.id).names, " "))
abortstatement ("Size of immidiate " + fields$(fieldid) + " does not fit into " + fields$(1))

END SUB

'
'
'
SUB abortlabelused

abortstatement (token$ + " is already in use as label")

END SUB

'
'Abort on not a match between fields in size
'
SUB abortnomatch

abortstatement ("Size of " + fields$(1) + " and " + fields$(2) + " do not match")

END SUB

'
'Aborts on type not valid
'
SUB abortnotvalid (fieldid)

IF fieldid = 1 THEN fieldid$ = "Destiny" ELSE fieldid$ = "Source"
instr$ = LEFT$(instructs(this.id).names, INSTR(instructs(this.id).names, " "))
abortstatement (fieldid$ + "field " + fields$(fieldid) + " is not valid in " + instr$)

END SUB

'
'Difficult handling of a wrong reference..
'
SUB abortrefsize


END SUB

'
'Aborts when a reserved keyword label
'
SUB abortreserved

abortstatement ("field " + fields$(1) + " is a reserved keyword and cannot be used for labels")

END SUB

'
'Aborts on size not valid
'
SUB abortsize (fieldid)

IF fieldid = 1 THEN fieldid$ = "Destiny " ELSE fieldid$ = "Source "
instr$ = LEFT$(instructs(this.id).names, INSTR(instructs(this.id).names, " "))
abortstatement ("Size of " + fieldid$ + fields$(fieldid) + " not valid in " + instr$)

END SUB

'
'Cancel the current statement and get a new one
'While printing appropriate errormessages
'
SUB abortstatement (expect$)
PRINT asmstatement$
PRINT CHR$(7); expect$
PRINT #2, SPACE$(37) + ";" + asmstatement$
PRINT #2, "******Error ! " + expect$ + "**********"
keykey$ = footer$: IF keykey$ = CHR$(&H27) THEN exits ELSE doprogram

END SUB

'
'Decodes lar, lsl R,E
'
SUB acces

IF thisfield(1).types > Rtype THEN abortnotvalid (1)
IF thisfield(2).types > Etype THEN abortnotvalid (2)

IF (thisfield(2).size = word OR thisfield(1).size) = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
ELSEIF (thisfield(2).size OR thisfield(1).size) = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
ELSEIF thisfield(1).size = byte THEN
  abortsize (1)
ELSE
  abortnomatch
END IF
result.opcodebytes = &HF00 OR instructs(this.id).Pvalue
isxrm

END SUB

'
'Decodes the add,adc,sub,sbb,cmp,or,and,xor instructions
'
SUB arithm

IF thisfield(2).types = Itype THEN                 ' ,I
  arithmI
ELSEIF thisfield(2).types <= Rtype THEN            ' ,R
  arithmR
ELSEIF thisfield(2).types = Etype THEN             ' ,E
  arithmE
ELSE
  abortnotvalid (2)
END IF

END SUB

'
'Decodes an arithmatic A,I
'
SUB arithmAI

IF thisfield(1).size = byte AND result.immidsize <= byte THEN
    result.opcodebytes = &O10 * instructs(this.id).Pvalue + 4
ELSEIF thisfield(1).size = word AND result.immidsize <= word THEN
  result.opcodebytes = &O10 * instructs(this.id).Pvalue + 5
  result.immidsize = word
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
ELSEIF thisfield(1).size = dword AND result.immidsize <= dword THEN
  result.opcodebytes = &O10 * instructs(this.id).Pvalue + 5
  result.immidsize = dword
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
ELSE
  abortimmidbig (2)
END IF

END SUB

'
'Decodes an arithmatic with an E sourcefield( and no R or I source field)
'
SUB arithmE

IF thisfield(1).types <= Rtype THEN           'R,E
  arithmRE
ELSEIF thisfield(1).types = Etype THEN        'E,E
  abortstatement ("Both " + fields$(1) + " and " + fields$(2) + " are mem fields")
ELSE
  abortnotvalid (1)
END IF


END SUB

'
'Decodes an arithmatic E,I
'
SUB arithmEI

this.Ereg = this.Rreg: this.Rreg = instructs(this.id).Pvalue

IF thisfield(1).size = 0 THEN
  IF result.immidsize < dword THEN thisfield(1).size = word ELSE thisfield(1).size = dword
END IF

IF thisfield(1).size = byte AND result.immidsize <= byte THEN
  result.opcodebytes = &O200
ELSEIF thisfield(1).size = word AND result.immidsize = sbyte THEN
  result.opcodebytes = &O203
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
ELSEIF thisfield(1).size = dword AND result.immidsize = sbyte THEN
  result.opcodebytes = &O203
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
ELSEIF thisfield(1).size = word AND result.immidsize <= word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.immidsize = word
  result.opcodebytes = &O201
ELSEIF thisfield(1).size = dword AND result.immidsize <= dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.immidsize = dword
  result.opcodebytes = &O201
ELSEIF thisfield(1).size > dword THEN
  abortsize (1)
ELSE
  abortimmidbig (2)
END IF
isxrm


END SUB

'
'Decodes an arithmatic E,R fields( without R,R( that is done as R,E)
'
SUB arithmER

IF thisfield(1).size = 0 THEN thisfield(1).size = thisfield(2).size

IF thisfield(2).size = byte AND thisfield(1).size <= byte THEN
  result.opcodebytes = &O10 * instructs(this.id).Pvalue + 0
ELSEIF thisfield(2).size = word AND thisfield(1).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O10 * instructs(this.id).Pvalue + 1
ELSEIF thisfield(2).size = dword AND thisfield(1).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O10 * instructs(this.id).Pvalue + 1
ELSEIF thisfield(2).size > dword THEN
  abortsize (1)
ELSE
  abortnomatch
END IF
isxrm


END SUB

'
'Decodes arithmatics with an immidiate
'
SUB arithmI

IF thisfield(1).types = Atype THEN
   arithmAI
ELSEIF thisfield(1).types <= Etype THEN
   arithmEI
ELSE
  abortnotvalid (1)
END IF

END SUB

'
'Decodes arithmatics with source is R field( and no immid field).. R,E or E,R
'
SUB arithmR
 
IF thisfield(1).types <= Rtype THEN           'R,R
  arithmRE
ELSEIF thisfield(1).types = Etype THEN        'E,R
  arithmER
ELSE
  abortnotvalid (1)
END IF

END SUB

'
'Decode arithmatic R,E
'
SUB arithmRE

IF thisfield(2).size = 0 THEN thisfield(2).size = thisfield(1).size

IF thisfield(2).size = byte AND thisfield(1).size = byte THEN
  result.opcodebytes = &O10 * instructs(this.id).Pvalue + 2
ELSEIF thisfield(2).size = word AND thisfield(1).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O10 * instructs(this.id).Pvalue + 3
ELSEIF thisfield(2).size = dword AND thisfield(1).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O10 * instructs(this.id).Pvalue + 3
ELSEIF thisfield(2).size > dword THEN
  abortsize (2)
ELSE
  abortnomatch
END IF
isxrm

END SUB

'
'Decodes an arpls instruction
'
SUB arpls

IF thisfield(1).types > Etype THEN abortnotvalid (1)
IF thisfield(2).types > Rtype THEN abortnotvalid (2)

IF (thisfield(2).size = word OR thisfield(1).size = word) = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
ELSEIF (thisfield(2).size = dword OR thisfield(1).size) = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
ELSEIF thisfield(2).size <> dword OR thisfield(2).size <> word THEN
  abortsize (2)
ELSE
  abortnomatch
END IF

result.opcodebytes = &O143
isxrm




END SUB

'
'Decodes a bound R, E
'
SUB bounds

IF thisfield(1).types > Rtype THEN abortnotvalid (1)
IF thisfield(2).types <> Etype THEN abortnotvalid (2)
IF thisfield(2).size OR dword <> dword THEN abortsize (2)

IF thisfield(1).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
ELSEIF thisfield(1).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
ELSE
  abortnotvalid (1)
END IF
result.opcodebytes = &O142
isxrm


END SUB

'
'Checks a long for bytesize
'
FUNCTION bytesize (longvalue&)

IF longvalue& <= 127 AND longvalue& >= -127 THEN
  bytesize = sbyte
ELSEIF longvalue& <= 256 AND longvalue& >= 0 THEN
  bytesize = byte
ELSEIF longvalue& <= 32767 AND longvalue >= -32768 THEN
  bytesize = word
ELSE
  bytesize = dword
END IF

END FUNCTION

'
'Decodes the fields according to some rules for how to
'Validates some size too.
'
SUB decodefields

SELECT CASE this.id
 
  CASE fxchg, fucom, fucomp, ffree:
  fieldnr = 1: isSTorMeM
 
  CASE fild TO fistp, ficom, ficomp, fiadd TO fidivr
  fieldnr = 1: isSTorMeM

  CASE fld TO fstp
  fieldnr = 1: isSTorMeM
 
  CASE fldenv TO fstenv, frstor, fsave, fstsw:
  fieldnr = 1: isAXorE
 
  CASE fadd TO fdivr, faddp TO fdivrp:
  fieldnr = 1: isSTorMeM
  this.Ereg = this.Rreg: this.Rreg = 0
  fieldnr = 2: isSTorMeM

  CASE enter
  fieldnr = 1: isImmidonly
  result.dispsize = result.immidsize
  result.displacement = result.immid
  fieldnr = 2: isImmidonly

  CASE in:
  fieldnr = 1: isAXonly
  fieldnr = 2: isDXorImmid

  CASE outs
  fieldnr = 1: isDXorImmid
  fieldnr = 2: isAXonly
 
  CASE shld, shrd  'SHLD, SHRD
  FOR i = 1 TO 2: fieldnr = i: isfield: NEXT
  fieldnr = 3: isCLorImmid
 
  CASE rol TO sar 'RCL, RCR, SHL, SHR, SAL, SAR, ROL, ROR
  fieldnr = 1: isfield
  fieldnr = 2: isCLorImmidorOne

  CASE seta TO setpo
  fieldnr = 1: isbytereg

  CASE ja TO jpo, jmp, scall, jcxz TO loopnz, jmpfar, callfar
  fieldnr = 1: ismemorlabel
 
  CASE ELSE       'the rest
  FOR i = 1 TO instructs(this.id).nrfields
    fieldnr = i: isfield
  NEXT

END SELECT


END SUB

'
'Dispatcher mainly
'
SUB decodeopcode

SELECT CASE this.id

  CASE aam, aad: aamaad
  CASE seta TO setpo: setCCs
  CASE jmp TO callfar: flows
  CASE ja TO jpo: jccs
  CASE jcxz TO loopnz: loopit
  CASE add TO cmp: arithm
  CASE test: testlogic
  CASE inc, dec: incdec
  CASE idiv TO mul, nots, neg: math
  CASE imul: imulmath
  CASE rol TO sar: shifts
  CASE shld, shrd: shds
  CASE movsx, movzx: extend
  CASE bswap: swapRd
  CASE mov: movs
  CASE lea: leas
  CASE lds, les, lss, lfs, lgs: lseg
  CASE xchg: xchgs
  CASE in: inps
  CASE outs: outps
  CASE bt TO btc: synchr
  CASE bsf, bsr: highlowbit
  CASE xadd, cmpxchg: xaddcmpx
  CASE ints: interu
  CASE push: pushs
  CASE pop: pops
  CASE enter: enters
  CASE ret, retf: rets
  CASE bound: bounds
  CASE arpl: arpls
  CASE sldt TO verw: systems
  CASE lar, lsl: acces
  CASE sgdt TO lidt, smsw, lmsw: dts
  CASE invlpd: invlpds
 
  CASE fild TO fistp, ficom, ficomp, fiadd TO fidvr: fpuINT
  CASE fxchg, fucom, fucomp, ffree: fpuSTonly
  CASE fld TO fstp, fadd TO fdivr, faddp TO fdivrp, fcom TO fcomp: fpuREAL
  CASE fldenv TO fstcw, frstor, fsave: fpuCTRL
  CASE fstsw: fpufstsw


END SELECT

END SUB

'
'Parses an end statement
'
SUB doend

CALL storesymbol(endall, offset)
PRINT " "; name$


END SUB

'
'Parses and handles an endp statement
'
SUB doendp

id = isinsymboltable(0, forward)
IF id THEN
  symboltable(id).types = label
ELSE
  abortstatement ("No proc found with name " + name$)
END IF

IF LEN(asmline$) THEN abortstatement ("ENDP does not allow for arguments")
name$ = asmstatement$              'format for print only

END SUB

SUB doendseg


END SUB

SUB doequ

END SUB

'
'Processes a forward referenced name( in label, segment or proc)
'
SUB doforward (id)

IF symboltable(id).types = forward THEN
  resolveforward (symboltable(id).value) 'set first to label
  symboltable(id).types = label
  symboltable(id).value = offset
  id = isinsymboltable(id, 0)
  DO WHILE id
    resolveforward (symboltable(id).value)
    symboltable(id).types = null             'change it to null
    id = isinsymboltable(id, 0)
  LOOP
ELSE
  abortlabelused ',label: abortlabelused
END IF

END SUB

'
'Handles statements which starts with an identifier
'
SUB doident


name$ = token$:
IF name$ <> "END" THEN lookupsymboltype ELSE selecttoken: name$ = token$

SELECT CASE token$
    CASE "SEGMENT": dosegment
    CASE "PROC": doproc
    CASE "DB", "DW", "DD": CALL dovar
    CASE "STRUC": CALL dostruc
    CASE "LABEL", ":": CALL dolabel
    CASE "EQU": CALL doequ
    CASE "ENDP": CALL doendp
    CASE "ENDS": CALL doendseg
    CASE "END": CALL doend
    CASE ELSE:
   
    abortstatement ("unknown symboltype")
END SELECT


END SUB

'
'Parses an instruction_statement
'
SUB doinstruct

defseg.size = 16

IF instructs(this.id).nrfields < 0 THEN lookupaddintruct 'prefixes

IF instructs(this.id).nrfields THEN
  lookupfields                'vanwege printje niet in decodefields
  decodefields
  decodeopcode
ELSE
  result.opcodebytes = instructs(this.id).Pvalue
  validatewordsizeinstr
END IF





END SUB

'
'Processes a label['s name]
'
SUB dolabel

id = isinsymboltable(0, 0)
IF id THEN
  doforward (id)
ELSE
  CALL storesymbol(label, offset)
END IF

IF LEN(asmline$) THEN               'more on the line ?
  asmstatement$ = asmline$
  selecttoken
  lookupinstruction
  doinstruct
END IF
name$ = name$ + " LABEL"             'for print


END SUB

'
'Processes a procedures definition
'
SUB doproc

id = isinsymboltable(0, 0)
IF id THEN
  doforward (id)
ELSE
  CALL storesymbol(proc, offset)
END IF

IF LEN(asmline$) THEN abortstatement ("Alas, no arguments supported yet!"):
name$ = asmstatement$         'format for print only

END SUB

'
'Runs the program until esc..
'
SUB doprogram

DO
  initstatement
  selecttoken
  lookupinstruction
  IF this.id = 0 THEN doident ELSE doinstruct
  IF keykey$ <> CHR$(8) THEN printobjlistscreen
  keykey$ = footer$:
LOOP UNTIL keykey$ = CHR$(27)

endit = asmlinenr: CLS 2
asmstatement$ = "": offset = 0

FOR i = 1 TO endit
  GET #4, i, result
  asmlinenr = i
  PRINT format4print$
  SLEEP
NEXT

PRINT
FOR i = 0 TO scount - 1:
  PRINT i; " "; symboltable(i).names, symboltable(i).types, symboltable(i).value
  IF symboltable(i).types = forward THEN PRINT CHR$(7) + "ERROR because Label " + symboltable(i).names + "in line "; symboltable(i).value; " is unresolved forward!"
  IF symboltable(i).types = proc THEN PRINT CHR$(7) + "Open procedure " + symboltable(i).names
NEXT

CALL exits


END SUB

SUB dosegment

END SUB

SUB dostruc

END SUB

SUB dovar

END SUB

'
'Decodes the IDT,GDT and machine words instructions
'
SUB dts

IF thisfield(1).types > Etype THEN abortnotvalid (1)
IF (thisfield(1).size OR word) <> word THEN abortsize (1)

result.opcodebytes = &HF01
this.Rreg = instructs(this.id).Pvalue
isxrm


END SUB

'
'Decodes an enter D,D
'
SUB enters

IF result.dispsize > byte THEN abortsize (2)
IF defseg.size = 16 THEN result.dispsize = word ELSE result.dispsize = dword
result.opcodebytes = &O310
END SUB

'
'Closes all open files and ends program
'
SUB exits

PRINT #3, CHR$(13); CHR$(10); "END SUB"
CLOSE
END

END SUB

'
'Decodes movsx,movzx( R16,m8 R16,R8 and R32,R16/R8 R32,m16/m8)
'
SUB extend

IF thisfield(2).types > Etype THEN abortnotvalid (2)
IF thisfield(1).types > Rtype THEN abortnotvalid (1)

IF thisfield(1).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  IF thisfield(2).size <= byte THEN
    result.opcodebytes = &HF00 OR &O206 + instructs(this.id).Pvalue
  ELSE
    abortsize (2)
  END IF
ELSEIF thisfield(1).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  IF thisfield(2).size <= byte THEN
    result.opcodebytes = &HF00 OR &O206 + instructs(this.id).Pvalue
  ELSEIF thisfield(2).size = word THEN
    result.opcodebytes = &HF00 OR &O207 + instructs(this.id).Pvalue
  ELSE
    abortsize (2)
  END IF
ELSE
  abortsize (1)
END IF

isxrm

END SUB

'
'Decodes jmp/call far Af
'
SUB fars





END SUB

'
'Decodes the flow Etype
'
SUB flowmem

IF thisfield(1).types <> Etype THEN abortnotvalid (1)

result.opcodebytes = &O377

SELECT CASE thisfield(1).size
  CASE far:
  IF this.id = scall THEN this.Rreg = 3 ELSE this.Rreg = 5
  isxrm

  CASE far32
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  IF this.id = scall THEN this.Rreg = 3 ELSE this.Rreg = 5
  isxrm

  CASE near32
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  IF this.id = scall THEN this.Rreg = 2 ELSE this.Rreg = 4

  CASE near, 0
  IF this.id = scall THEN this.Rreg = 2 ELSE this.Rreg = 4
  isxrm
 
  CASE short: abortsize (1)
END SELECT


END SUB

'
'Decodes the jmp/call near16
'
SUB flownear16 (id)

IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange: subextra = 1
result.opcodebytes = &O350 + instructs(this.id).Pvalue
CALL resolvenear16(id, subextra)

END SUB

'
'Decodes a flow near L(forward)
'
SUB flownear16fw

IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
result.opcodebytes = &O350 + instructs(this.id).Pvalue
result.immidsize = near
CALL storesymbol(forward, asmlinenr)

END SUB

'
'Decodes a flow near32 L
'
SUB flownear32 (id)

result.opcodebytes = &O350 + instructs(this.id).Pvalue
IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange: subextra = 1
CALL resolvenear32(id, subextra)

END SUB

'
'Decodes a flow near32( Forward)
'
SUB flownear32fw

result.opcodebytes = &O350 + instructs(this.id).Pvalue
IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
result.immidsize = near32
CALL storesymbol(forward, asmlinenr)

END SUB

'
'Handles all relative jmp/calls
'
SUB flowrel

name$ = fields$(1)
id = isinsymboltable(0, forward)
IF id THEN
  SELECT CASE thisfield(1).size
    CASE short: flowshort (id)
    CASE 0: IF defseg.size = 16 THEN flownear16 (id) ELSE flownear32 (id)
    CASE near: flownear16 (id)
    CASE near32: CALL flownear32(id)
  END SELECT
ELSE
  SELECT CASE thisfield(1).size
    CASE short: flowshortfw
    CASE 0: IF defseg.size = 16 THEN flownear16fw ELSE flownear32fw
    CASE near: flownear16fw
    CASE near32: flownear32fw
  END SELECT
END IF


END SUB

'
'Decodes the control flow statements
'
SUB flows

IF thisfield(1).types = abstype THEN
  IF this.id = jmp THEN result.opcodebytes = &O352 ELSE result.opcodebytes = &O232
ELSEIF thisfield(1).types = Etype THEN
  flowmem
ELSEIF thisfield(1).types = Ltype THEN
  flowrel
ELSE
  abortnotvalid (1)
END IF

END SUB

'
'Handles a jmp short Label
'
SUB flowshort (id)

result.opcodebytes = &O353
resolveshort (id)

END SUB

'
'Decodes a flow short L( forward)
'
SUB flowshortfw

result.opcodebytes = &O353
result.immidsize = short
CALL storesymbol(forward, asmlinenr)

END SUB

'
'Prints footer message for next statement
'
FUNCTION footer$

a = CSRLIN
DEF SEG = &H40: POKE &H1C, (PEEK(&H1A)): DEF SEG : a$ = ""

VIEW PRINT
LOCATE 24, 1: PRINT "Press a key for next statement( BS=not saving this one, ESC=end)":
VIEW PRINT 3 TO 22
DO UNTIL a$ <> "": a$ = INKEY$: LOOP
footer$ = a$:

END FUNCTION

'
'Prints the QB and LIST files
'
FUNCTION format4print$

addi$ = formatoffset$
IF LEN(name$) THEN addi$ = addi$ + formatnames$
addlen = LEN(addi$)

IF result.wordsizeprefix THEN addi$ = addi$ + hexB$(result.wordsizeprefix)
IF result.segmentprefix THEN addi$ = addi$ + hexB$(result.segmentprefix)
IF result.adressprefix THEN addi$ = addi$ + hexB$(result.adressprefix)
IF result.instructprefix THEN addi$ = addi$ + hexB$(result.instructprefix)

IF result.opcodebytes THEN
  opcodebyte2 = result.opcodebytes \ &H100
  IF opcodebyte2 THEN
    addi$ = addi$ + hexB$(opcodebyte2 AND &HFF&) + hexB$(result.opcodebytes AND &HFF)
  ELSE
    addi$ = addi$ + hexB$(result.opcodebytes)
  END IF
END IF

IF result.xrmthere THEN addi$ = addi$ + hexB$(result.xrm)
IF result.sibthere THEN addi$ = addi$ + hexB$(result.sib)

SELECT CASE result.dispsize
    CASE sbyte, byte:
    resint = result.displacement& AND &HFF:
    addi$ = addi$ + hexB$(resint)
    CASE word:        
    resint = result.displacement& AND &HFFFF:
    addi$ = addi$ + hexI$(resint)
    CASE dword:
    addi$ = addi$ + hexL$(result.displacement&)
END SELECT

SELECT CASE result.immidsize
  CASE sbyte, byte:
    resint = result.immid& AND &HFF: addi$ = addi$ + hexB$(resint)
  CASE word
    resint = result.immid& AND &HFFFF: addi$ = addi$ + hexI$(resint)
  CASE dword
  IF LEN(addi$) - addlen > 20 THEN
    addi$ = addi$ + "+" + SPACE$(31 - LEN(addi$) + addlen) + ";"
    addi$ = addi$ + asmstatement$ + CHR$(13) + SPACE$(12) + hexL$(result.immid)
    addlen = LEN(addi$)
  ELSE
    addi$ = addi$ + hexL$(result.immid)
  END IF
END SELECT

addlen = LEN(addi$) - addlen
IF addlen THEN addi$ = addi$ + SPACE$(32 - addlen) + ";" + asmstatement$

'PRINT LEN(addi$)

IF LEN(comment$) THEN addi$ = addi$ + CHR$(13) + formatcomments$
format4print$ = addi$

addi$ = ""

END FUNCTION

'
'Formats the comment$
'
FUNCTION formatcomments$

formatcomments$ = SPACE$(12) + comment$
comment$ = ""

END FUNCTION

'
'Formats the name$
'
FUNCTION formatnames$

formatnames$ = name$ + CHR$(13) + SPACE$(12)
name$ = ""


END FUNCTION

'
'Formats the line and offset
'
FUNCTION formatoffset$

ln$ = MID$(STR$(asmlinenr), 2):
off$ = HEX$(result.offset)
ln$ = STRING$(4 - LEN(ln$), " ") + ln$ + SPACE$(2)
formatoffset$ = ln$ + STRING$(4 - LEN(off$), "0") + off$ + SPACE$(2)

END FUNCTION

'
'Decodes the fpuControl statements except fstsw
'
'
SUB fpuCTRL

IF thisfield(1).types <> Etype THEN abortnotvalid (1)
IF thisfield(1).size <> 0 OR thisfield(1).size <> word64 THEN abortsize (1)

SELECT CASE this.id
  CASE fldenv, fldcw, fstenv, fstcw: result.opcodebytes = &O331
  CASE frstor, fsave: result.opcodebytes = &O335
END SELECT

this.Rreg = instructs(this.id).Pvalue
isxrm
END SUB

'
'Decodes an fstsw
'
SUB fpufstsw

IF thisfield(1).size <> word THEN abortsize (1)

IF thisfield(1).types = Etype THEN
  result.opcodebytes = &O335
  isxrm
ELSEIF thisfield(1).types = Atype THEN
  result.opcodebytes = &O335
  result.xrm = &O340: result.xrmthere = 1
ELSE
  abortnotvalid (1)
END IF

END SUB

'
'Decodes the Integer Floating points (Data transfer,comparison,arithmatic)
'for int32,int16,int64(fild/fistp only)
'
SUB fpuINT

IF thisfield(1).types <> Etype THEN abortnotvalid (1)

SELECT CASE this.id
  CASE fild TO fistp: result.opcodebytes = &O333
  CASE ELSE: result.opcodebytes = &O332
END SELECT

result.xrm = instructs(this.id).Pvalue
IF thisfield(1).size = word THEN
  result.opcodebytes = result.opcodebytes + 4
ELSEIF thisfield(1).size = 0 AND defseg.size = 16 THEN
  result.opcodebytes = result.opcodebytes + 4
ELSEIF (this.id = fild OR this.id = fistp) AND thisfield(1).size = qword THEN
  result.opcodebytes = &O337
  result.xrm = result.xrm OR &O50
ELSEIF thisfield(1).size <> dword AND thisfield(1).size <> 0 THEN
  abortsize (1)
END IF

isxrm

END SUB

'
'Decodes the fpu REAL Data transfers and Comparisons
'
SUB fpuREAL

SELECT CASE this.id
  CASE fld TO fstp, fcmp, fcomp: REALf
  CASE fadd TO fdivr: REALfa
  CASE faddp TO fdivrp: REALp
END SELECT


END SUB

'
'Decodes the fxchg, fucom, fucomp, ffree ST[m]
'
SUB fpuSTonly

IF thisfield(1).types <> STtype THEN abortnotvalid (1)
result.xrm = &O300 + instructs(this.id).Pvalue + this.Rreg
result.xrmthere = 1

SELECT CASE this.id
  CASE fxchg: result.opcodebytes = &O331
  CASE fucom, fucomp, ffree: result.opcodebytes = &O335
END SELECT

END SUB

'Intro message etc..
'
SUB header

CLS : COLOR 0, 14: PRINT "ONE LINE ASSEMBLER RUNNING..."; : COLOR 7, 0: PRINT
LOCATE 1, 2: PRINT STRING$(80, "_")
KEY ON: KEY 1, "FILE": KEY 2, "1_LINE": KEY 3, "DEFAULTS"
LOCATE 23, 1: PRINT STRING$(80, "_")
VIEW PRINT 3 TO 22



END SUB

'
'Adds a byte to result
'
FUNCTION hexB$ (byte2add)

addi$ = HEX$(byte2add AND &HFF)
hexB$ = STRING$(2 - LEN(addi$), "0") + addi$ + " "

offset = offset + 1

END FUNCTION

'
'Adds an integer(two bytes to the result)
'
FUNCTION hexI$ (int2add)

addi$ = HEX$(int2add)
hexI$ = STRING$(4 - LEN(addi$), "0") + addi$ + " "
offset = offset + 2


END FUNCTION

'
'
FUNCTION hexL$ (long2add&)

addi$ = HEX$(long2add&)

hexL$ = STRING$(8 - LEN(addi$), "0") + addi$ + " "
offset = offset + 4

END FUNCTION

'
'Decodes a bsf or bsr
'
SUB highlowbit


IF thisfield(1).types > Rtype THEN abortnotvalid (1)
IF thisfield(2).types > Etype THEN abortnotvalid (2)

IF (thisfield(1).size OR thisfield(2).size) = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &HF00 OR &O270 + instructs(this.id).Pvalue
ELSEIF (thisfield(1).size OR thisfield(1).size) = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &HF00 OR &O270 + instructs(this.id).Pvalue
ELSEIF (thisfield(2).size > dword OR thisfield(2).size) < word THEN
  abortsize (2)
ELSE
  abortsize (1)
END IF
isxrm


END SUB

'
'Translates a numerical string to a long
'Writes: result.immid&
'
FUNCTION immid& (field$)

immids$ = UCASE$(field$)
IF INSTR(immids$, "H") THEN
  immids$ = LEFT$(immids$, INSTR(immids$, "H") - 1)
  immid& = validatehex&(immids$)
ELSEIF INSTR(immids$, "B") THEN
  immids$ = LEFT$(immids$, INSTR(immids$, "B") - 1)
  immid& = validatebin&(immids$)
ELSE
  IF INSTR(immids$, "D") THEN immids$ = LEFT$(immids$, INSTR(immids$, "D") - 1)
  immid& = validatedec&(immids$)
END IF


END FUNCTION

'
'Decodes a mul with two fields (R, )
'
SUB imul2

IF thisfield(2).types <= Etype THEN
  imul2RE
ELSE
  abortnotvalid (2)
END IF

END SUB

'
'Decodes an imul R,E
'
SUB imul2RE

IF thisfield(2).size = 0 THEN thisfield(2).size = thisfield(1).size

IF thisfield(2).size = word AND thisfield(1).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &HF00 OR &O257
ELSEIF thisfield(2).size = dword AND thisfield(1).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &HF00 OR &O257
ELSEIF thisfield(2).size > dword THEN
  abortsize (2)
ELSE
  abortnomatch
END IF
isxrm

END SUB

'
'Decodes an IMUL R,E,D
'
SUB imul3

IF thisfield(2).types <= Etype THEN
  imul3RE
ELSE
  abortnotvalid (2)
END IF

END SUB

'
'Decodes an imul R,E,D
'
SUB imul3RE

IF thisfield(2).size = 0 THEN thisfield(2).size = thisfield(1).size

IF thisfield(2).size = word AND thisfield(1).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  IF result.immidsize = sbyte THEN
    result.opcodebytes = &O153
  ELSEIF result.immidsize <= word THEN
    result.immidsize = word
    result.opcodebytes = &O151
  ELSE
    abortimmidbig (3)
  END IF
ELSEIF thisfield(2).size = dword AND thisfield(1).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  IF result.immidsize = sbyte THEN
    result.opcodebytes = &O153
  ELSEIF result.immidsize <= dword THEN
    result.immidsize = dword
    result.opcodebytes = &O151
  ELSE
    abortimmidbig (3)
  END IF
ELSEIF thisfield(2).size > dword THEN
  abortsize (2)
ELSE
  abortnomatch
END IF
isxrm

END SUB

'
'Decode the math instructions
'
SUB imulmath

SELECT CASE this.nrfields
  CASE 1: math
  CASE 2: IF thisfield(1).types <= Rtype THEN imul2 ELSE abortnotvalid (1)
  CASE 3: IF thisfield(1).types <= Rtype THEN imul3 ELSE abortnotvalid (1)
END SELECT


END SUB

'
'Decodes inc and dec instructions
'
SUB incdec

IF thisfield(1).types <= Rtype AND thisfield(1).size >= word THEN
  incdecR
ELSEIF thisfield(1).types <= Etype THEN
  incdecE
ELSE
  abortnotvalid (1)
END IF



END SUB

'
'Decodes a inc E or dec E
'
SUB incdecE

SELECT CASE thisfield(1).size
  CASE 0: result.opcodebytes = &O377
  CASE sbyte, byte: result.opcodebytes = &O366
  CASE word:  result.opcodebytes = &O377
              IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  CASE dword: result.opcodebytes = &O377
              IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  CASE ELSE: abortsize (1)
END SELECT

this.Ereg = this.Rreg
this.Rreg = instructs(this.id).Pvalue
isxrm

END SUB

'
'Decodes a inc R or dec R
'
SUB incdecR

IF thisfield(1).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O100 + instructs(this.id).Pvalue * &O10 + this.Rreg
ELSEIF thisfield(1).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O100 + instructs(this.id).Pvalue * &O10 + this.Rreg
ELSE
  abortsize (1)
END IF


END SUB

'
'Initializes tables
'
SUB initinstructtable

CONST waitpref = -4:
CONST lockpref = -3:
CONST reppref = -2: CONST repzpref = -1

instructs(0).names = "NUL"

'FIRST THE PREFIX INSTRUCTIONS(LOCK AND REP and WAIT/FWAIT)

FOR i = fwait TO waits: instructs(i).nrfields = waitpref: NEXT
instructs(fwait).names = "FWAIT": instructs(fwait).Pvalue = &O233
instructs(waits).names = "WAIT": instructs(waits).Pvalue = &O233

instructs(locks).names = "LOCK": instructs(locks).Pvalue = &O360
instructs(locks).nrfields = lockpref

instructs(rep).nrfields = reppref: instructs(rep).names = "REP":
instructs(rep).Pvalue = &O362

instructs(repnz).names = "REPNZ": instructs(repne).names = "REPNE":
FOR i = repnz TO repne: instructs(i).nrfields = repzpref: instructs(i).Pvalue = &O362: NEXT

instructs(repz).names = "REPZ": instructs(repe).names = "REPE":
FOR i = repz TO repe: instructs(i).nrfields = repzpref: instructs(i).Pvalue = &O363: NEXT

'FIRST THE ONES THAT USE NO opcode (9..60)

'TYPE CONVERSION EXCEPT BSWAP( NO OPERAND CONVERSIONS)
instructs(daa).names = "DAA": instructs(daa).Pvalue = &O47
instructs(das).names = "DAS": instructs(das).Pvalue = &O57
instructs(aaa).names = "AAA": instructs(aaa).Pvalue = &O67
instructs(aas).names = "AAS": instructs(aas).Pvalue = &O77
instructs(cbw).names = "CBW": instructs(cbw).Pvalue = &O230
instructs(cwde).names = "CWDE": instructs(cwde).Pvalue = &O230
instructs(cwd).names = "CWD": instructs(cwd).Pvalue = &O231
instructs(cdq).names = "CDQ": instructs(cdq).Pvalue = &O231
instructs(xlat).names = "XLAT": instructs(xlat).Pvalue = &O327
instructs(xlatb).names = "XLATB": instructs(xlatb).Pvalue = &O327

'STRINGOPERATIONS(MOVS, LODS, CMPS, SCAS ,REP, STOS)
         
instructs(lodsb).names = "LODSB": instructs(lodsb).Pvalue = &O254 'no rep
instructs(lodsw).names = "LODSW": instructs(lodsw).Pvalue = &O255
instructs(lodsd).names = "LODSD": instructs(lodsd).Pvalue = &O256
instructs(movsb).names = "MOVSB": instructs(movsb).Pvalue = &O244 'rep only
instructs(movsw).names = "MOVSW": instructs(movsw).Pvalue = &O245
instructs(movsd).names = "MOVSD": instructs(movsd).Pvalue = &O245
instructs(stosb).names = "STOSB": instructs(stosb).Pvalue = &O252
instructs(stosw).names = "STOSW": instructs(stosw).Pvalue = &O253
instructs(stosd).names = "STOSD": instructs(stosd).Pvalue = &O253
instructs(insb).names = "INSB": instructs(insb).Pvalue = &O154 'rep only
instructs(insw).names = "INSW": instructs(insw).Pvalue = &O155
instructs(insd).names = "INSD": instructs(insd).Pvalue = &O155
instructs(outsb).names = "OUTSB": instructs(outsb).Pvalue = &O156
instructs(outsw).names = "OUTSW": instructs(outsw).Pvalue = &O157
instructs(outsd).names = "OUTSD": instructs(outsd).Pvalue = &O157

instructs(cmpsb).names = "CMPSB": instructs(cmpsb).Pvalue = &O246 'repz/repnz
instructs(cmpsw).names = "CMPSW": instructs(cmpsw).Pvalue = &O247
instructs(cmpsd).names = "CMPSD": instructs(cmpsd).Pvalue = &O247
instructs(scasb).names = "SCASB": instructs(scasb).Pvalue = &O256
instructs(scasw).names = "SCASW": instructs(scasw).Pvalue = &O257
instructs(scasd).names = "SCASD": instructs(scasd).Pvalue = &O257

'SEMAPHORES AND SYNCHRONIZATION( WITHOUT opcode)

instructs(nop).names = "NOP": instructs(nop).Pvalue = &O220
instructs(hlt).names = "HLT": instructs(hlt).Pvalue = &O364
instructs(iret).names = "IRET": instructs(iret).Pvalue = &O317
instructs(iretd).names = "IRETD": instructs(iretd).Pvalue = &O317
instructs(into).names = "INTO": instructs(into).Pvalue = &O316

'FLAG OPERATIONS( NO opcode)

instructs(popf).names = "POPF": instructs(popfd).Pvalue = &O235
instructs(popfd).names = "POPFD": instructs(popfd).Pvalue = &O235
instructs(pushf).names = "PUSHF": instructs(pushf).Pvalue = &O234
instructs(pushfd).names = "PUSHFD": instructs(pusfd).Pvalue = &O234
instructs(sahf).names = "SAHF": instructs(sahf).Pvalue = &O236
instructs(lahf).names = "LAHF": instructs(lahf).Pvalue = &O237
instructs(cmc).names = "CMC": instructs(cmc).Pvalue = &O365
instructs(clc).names = "CLC": instructs(clc).Pvalue = &O370
instructs(stc).names = "STC": instructs(stc).Pvalue = &O371
instructs(cli).names = "CLI": instructs(cli).Pvalue = &O372
instructs(sti).names = "STI": instructs(sti).Pvalue = &O373
instructs(cld).names = "CLD": instructs(cld).Pvalue = &O374
instructs(std).names = "STD": instructs(std).Pvalue = &O375

'STACKOPERATIONS (NO opcode)

instructs(pusha).names = "PUSHA": instructs(pusha).Pvalue = &O140
instructs(pushad).names = "PUSHAD": instructs(pushad).Pvalue = &O140
instructs(popa).names = "POPA":  instructs(popa).Pvalue = &O141
instructs(popad).names = "POPAD": instructs(popad).Pvalue = &O141

'CONTROL FLOW (No opcode)
instructs(leave).names = "LEAVE": instructs(leave).Pvalue = &O311

'SYSTEM INSTRUCTIONS( NO opcode)
instructs(clts).names = "CLTS": instructs(clts).Pvalue = &O1706
instructs(invd).names = "INVD": instructs(invd).Pvalue = &O17010
instructs(wbinvd).names = "WBINVD": instructs(wbinvd).Pvalue = &O17011

'486(partly undoc)
instructs(cpuid).names = "CPUID": instructs(cpuid).Pvalue = &HFA2
instructs(salc).names = "SALC": instructs(salc).Pvalue = &HD6
'586(partly undoc)
instructs(wrmsr).names = "WHRMSR": instructs(wrmsr).Pvalue = &HF30
instructs(rdmsr).names = "RDMSR": instructs(rdmsr).Pvalue = &HF32
instructs(rdtsc).names = "RDTSC": instructs(rdtsc).Pvalue = &HF31
instructs(rsm).names = "RSM": instructs(rsm).Pvalue = &HFAA
instructs(ud2).names = "UD2": instructs(ud2).Pvalue = &HFB9
instructs(rdpmc).names = "RDPMC": instructs(rdpmc).Pvalue = &HF33

'NEXT THE ONE OPERAND FIELD USERS
FOR k = aam TO ints: instructs(k).nrfields = 1: NEXT

instructs(aam).names = "AAM": instructs(aam).Pvalue = &HD4  'two bytes(sign)
instructs(aad).names = "AAD": instructs(aad).Pvalue = &HD5
instructs(cmpxchgb).names = "CMPXCHG8B": instructs(cmpxchgb).Pvalue = &HFC7

'SYSTEM INSTRUCTIONS(WITH ONE OPERAND FIELD)
instructs(invlpg).names = "INVLPG": instructs(invlpg).Pvalue = 7

'OTHER TYPECONVERSIONS( WITH ONE OPERAND FIELD)
instructs(bswap).names = "BSWAP"

'CONDITIONAL OPERATIONS( JUMPS AND SETS)
instructs(ja).names = "JA": instructs(jnbe).names = "JNBE"
instructs(ja).Pvalue = 7: instructs(jnbe).Pvalue = 7
instructs(jae).names = "JAE": instructs(jnb).names = "JNB"
instructs(jae).Pvalue = 3: instructs(jnb).Pvalue = 3
instructs(jb).names = "JB": instructs(jnae).names = "JNAE"
instructs(jb).Pvalue = 2: instructs(jnae).Pvalue = 2
instructs(jbe).names = "JBE": instructs(jna).names = "JNA":
instructs(jbe).Pvalue = 6: instructs(jna).Pvalue = 6
instructs(jg).names = "JG": instructs(jnle).names = "JNLE"
instructs(jg).Pvalue = 17: instructs(jnle).Pvalue = 17
instructs(jge).names = "JGE": instructs(jnl).names = "JNL"
instructs(jge).Pvalue = 15: instructs(jnl).Pvalue = 15
instructs(jl).names = "JL": instructs(jnge).names = "JNGE":
instructs(jl).Pvalue = 14: instructs(jnge).Pvalue = 14
instructs(jle).names = "JLE": instructs(jng).names = "JNG":
instructs(jle).Pvalue = 16: instructs(jng).Pvalue = 16
instructs(je).names = "JE": instructs(jz).names = "JZ"
instructs(je).Pvalue = 4: instructs(jz).Pvalue = 4
instructs(jne).names = "JNE": instructs(jnz).names = "JNZ":
instructs(jne).Pvalue = 5: instructs(jnz).Pvalue = 5
instructs(jo).names = "JO": instructs(jno).names = "JNO":
instructs(jo).Pvalue = 0: instructs(jno).Pvalue = 1
instructs(jc).names = "JC": instructs(jnc).names = "JNC":
instructs(jc).Pvalue = 2: instructs(jnc).Pvalue = 3
instructs(js).names = "JS": instructs(jns).names = "JNS":
instructs(js).Pvalue = 10: instructs(jns).Pvalue = 11
instructs(jp).names = "JP": instructs(jpe).names = "JPE":
instructs(jp).Pvalue = 12: instructs(jpe).Pvalue = 12
instructs(jnp).names = "JNP": instructs(jpo).names = "JPO":
instructs(jnp).Pvalue = 13: instructs(jpo).Pvalue = 13

FOR i = seta TO setpo: instructs(i).Pvalue = instructs(i - 30).Pvalue: NEXT
instructs(seta).names = "SETA": instructs(setnbe).names = "SETNBE"
instructs(setae).names = "SETAE": instructs(setnb).names = "SETNB"
instructs(setb).names = "SETB": instructs(setnae).names = "SETNAE":
instructs(setbe).names = "SETBE": instructs(setna).names = "SETNA"
instructs(setg).names = "SETG": instructs(setnle).names = "SETNLE"
instructs(setge).names = "SETGE": instructs(setnl).names = "SETNL"
instructs(setl).names = "SETL": instructs(setnge).names = "SETNGE"
instructs(setle).names = "SETLE": instructs(setng).names = "SETNG":
instructs(sete).names = "SETE": instructs(setz).names = "SETZ"
instructs(setne).names = "SETNE": instructs(setnz).names = "SETNZ"
instructs(seto).names = "SETO": instructs(setno).names = "SETNO":
instructs(setc).names = "SETC": instructs(setnc).names = "SETNC":
instructs(sets).names = "SETS": instructs(setns).names = "SETNS"
instructs(setp).names = "SETP": instructs(setpe).names = "SETPE"
instructs(setnp).names = "SETNP": instructs(setpo).names = "SETPO"

FOR i = cmova TO cmovpo: instructs(i).Pvalue = instructs(i - 30).Pvalue: NEXT
instructs(cmova).names = "cmovA": instructs(cmovnbe).names = "cmovNBE"
instructs(cmovae).names = "cmovAE": instructs(cmovnb).names = "cmovNB"
instructs(cmovb).names = "cmovB": instructs(cmovnae).names = "cmovNAE":
instructs(cmovbe).names = "cmovBE": instructs(cmovna).names = "cmovNA"
instructs(cmovg).names = "cmovG": instructs(cmovnle).names = "cmovNLE"
instructs(cmovge).names = "cmovGE": instructs(cmovnl).names = "cmovNL"
instructs(cmovl).names = "cmovL": instructs(cmovnge).names = "cmovNGE"
instructs(cmovle).names = "cmovE": instructs(cmovng).names = "cmovNG":
instructs(cmove).names = "cmovE": instructs(cmovz).names = "cmovZ"
instructs(cmovne).names = "cmovNE": instructs(cmovnz).names = "cmovNZ"
instructs(cmovo).names = "cmovO": instructs(cmovno).names = "cmovNO":
instructs(cmovc).names = "cmovC": instructs(cmovnc).names = "cmovNC":
instructs(cmovs).names = "cmovS": instructs(cmovns).names = "cmovNS"
instructs(cmovp).names = "cmovP": instructs(cmovpe).names = "cmovPE"
instructs(cmovnp).names = "cmovNP": instructs(cmovpo).names = "cmovPO"

'CONTROLFLOW INSTRUCTIONS (USING ONE OPERAND FIELD)

instructs(jcxz).names = "JCXZ": instructs(jcxz).Pvalue = 3:
instructs(jecxz).names = "JECXZ": instructs(jecxz).Pvalue = 3
instructs(loops).names = "LOOP": instructs(loops).Pvalue = 2
instructs(loope).names = "LOOPE": instructs(loope).Pvalue = 1
instructs(loopz).names = "LOOPZ": instructs(loopz).Pvalue = 1
instructs(loopne).names = "LOOPNE": instructs(loopnz).names = "LOOPNZ":
instructs(jmp).names = "JMP": instructs(jmp).Pvalue = &O1:
instructs(jmpfar).names = "JMPFAR":
instructs(scall).names = "CALL":
instructs(callfar).names = "CALLFAR":
instructs(ret).names = "RET":
instructs(retf).names = "RETF": instructs(retf).Pvalue = &O10

'STACKOPERATIONS (WITH ONE OPERAND FIELD)

instructs(push).names = "PUSH": instructs(pop).names = "POP":
'SYSTEM INSTRUCTIONS (WITH ONE OPERAND FIELD)
FOR i = sldt TO verw: instructs(i).Pvalue = &O10 * (i - sldt): NEXT
instructs(sldt).names = "SLDT": instructs(str).names = "STR"
instructs(lldt).names = "LLDT": instructs(ltr).names = "LTR":
instructs(verr).names = "VERR": instructs(verw).names = "VERW"
FOR i = sgdt TO lidt: instructs(i).Pvalue = &O10 * (i - sgdt): NEXT
instructs(sgdt).names = "SGDT": instructs(sidt).names = "SIDT"
instructs(lgdt).names = "LGDT": instructs(lidt).names = "LIDT"
instructs(smsw).names = "SMSW": instructs(smsw).Pvalue = 4
instructs(lmsw).names = "LMSW": instructs(lmsw).Pvalue = 6

'ARITHMATICS WITH one field only
instructs(neg).names = "NEG": instructs(neg).Pvalue = &O3:
instructs(nots).names = "NOT": instructs(nots).Pvalue = &O2
instructs(dec).names = "DEC": instructs(dec).Pvalue = &O1
instructs(inc).names = "INC"
instructs(idiv).names = "IDIV": instructs(idiv).Pvalue = &O7:
instructs(div).names = "DIV": instructs(div).Pvalue = &O6:
instructs(mul).names = "MUL": instructs(mul).Pvalue = &O4


'SEMAPHORES WITH ONE FIELD
instructs(ints).names = "INT"

'**************************************
'NEXT THE TWO OPERAND FIELDS USERS:(165..207)
FOR k = add TO lsl: instructs(k).nrfields = 2: NEXT

'THE BINARY ARITHMICS
FOR i = add TO cmp: instructs(i).Pvalue = (i - add): NEXT
instructs(add).names = "ADD": instructs(ors).names = "OR"
instructs(adc).names = "ADC": instructs(sbb).names = "SBB"
instructs(ands).names = "AND": instructs(subs).names = "SUB"
instructs(xors).names = "XOR": instructs(cmp).names = "CMP"

instructs(test).names = "TEST":

'SHIFTS AND ROTATES
FOR i = rol TO sar: instructs(i).Pvalue = (i - rol): NEXT
instructs(rol).names = "ROL": instructs(ror).names = "ROR"
instructs(rcl).names = "RCL": instructs(rcr).names = "RCR"
instructs(shl).names = "SHL": instructs(shr).names = "SHR"
instructs(sal).names = "SAL": instructs(sar).names = "SAR"

'MOV-INCLUDING OPERATIONS AND OTHER TYPE-CONVERSIONS( USING OPERANDFIELDS)

instructs(xchg).names = "XCHG": instructs(lea).names = "LEA"
instructs(lds).names = "LDS": instructs(les).names = "LES"
instructs(lfs).names = "LFS": instructs(lgs).names = "LGS"
instructs(lss).names = "LSS": instructs(mov).names = "MOV"
instructs(movsx).names = "MOVSX": instructs(movsx).Pvalue = &O60
instructs(movzx).names = "MOVZX": instructs(movzx).Pvalue = &O70

'SEMAPHORES AND SYNCHRONIZATION( WITH OPERAND FIELDS)
instructs(bt).names = "BT": instructs(bt).Pvalue = 4
instructs(bts).names = "BTS": instructs(bts).Pvalue = 5
instructs(btr).names = "BTR": instructs(btr).Pvalue = 6
instructs(btc).names = "BTC": instructs(btc).Pvalue = 7
instructs(bsf).names = "BSF": instructs(bsf).Pvalue = 4
instructs(bsr).names = "BSR": instructs(bsr).Pvalue = 5
instructs(cmpxchg).names = "CMPXCHG": instructs(cmpxchg).Pvalue = &O246
instructs(xadd).names = "XADD": instructs(xadd).Pvalue = &O300

'PORT OPERATIONS

instructs(in).names = "IN": instructs(outs).names = "OUT"

'CONTROLFLOW OPERATIONS
instructs(enter).names = "ENTER":

'SYSTEM AND MEMORY CONTROL
instructs(bound).names = "BOUND": instructs(arpl).names = "ARPL":
instructs(lar).names = "LAR": instructs(lar).Pvalue = 2
instructs(lsl).names = "LSL": instructs(lsl).Pvalue = 3

'COPROCESSOR
'**************************************
'NEXT THE THREE OPERAND FIELDS USERS:(208..210)
FOR k = imul TO shrd: instructs(k).nrfields = 3: NEXT
instructs(imul).names = "IMUL": instructs(imul).Pvalue = &O5:
instructs(shld).names = "SHLD": instructs(shld).Pvalue = &O40
instructs(shrd).names = "SHRD": instructs(shrd).Pvalue = &O50

'FLOATING POINT UNIT

'next the floating point instruction first the nofielders then
'all the other ones(with one field) in the following order:
'I-op then F-op then P-op

'COMPARISON
instructs(fcompp).names = "FCOMPP": instructs(fcompp).Pvalue = &HDED9
instructs(ftst).names = "FTST": instructs(ftst).Pvalue = &HD9E4
instructs(fxam).names = "FXAM": instructs(fxam).Pvalue = &HD9E5
instructs(fucompp).names = "FUCOMPP": instructs(fucompp).Pvalue = &HDAE9

'CONSTANTS
instructs(fldl).names = "FLDL": instructs(fldl).Pvalue = &HD9E8
instructs(fldl2t).names = "FLDL2T": instructs(dldl2t).Pvalue = &HD9E9
instructs(fldl2e).names = "FLDL2E": instructs(fldl2e).Pvalue = &HD9EA
instructs(fldpi).names = "FLDPI": instructs(fldpi).Pvalue = &HD9EB
instructs(fldlg2).names = "FLDLG2": instructs(fldlg2).Pvalue = &HD9EC
instructs(fldln2).names = "FLDLN2": instructs(fldln2).Pvalue = &HD9ED
instructs(fldz).names = "FLDZ": instructs(fldz).Pvalue = &HD9EE

'BUILT IN FUNCTIONS
instructs(fchs).names = "FCHS": instructs(fchs).Pvalue = &HD9E0
instructs(fabs).names = "FABS": instructs(fabs).Pvalue = &HD9E1
instructs(f2xm1).names = "F2XM1": instructs(f2xm1).Pvalue = &HD9F0
instructs(fyl2x).names = "FYL2X": instructs(fyl2x).Pvalue = &HD9F1
instructs(fptan).names = "FPTAN": instructs(fptan).Pvalue = &HD9F2
instructs(fpatan).names = "FPATAN": instructs(fpatan).Pvalue = &HD9F3
instructs(fxtract).names = "FXTRACT": instructs(fxtract).Pvalue = &HD9F4
instructs(fprem1).names = "FPREM1": instructs(fprem1).Pvalue = &HD9F5
instructs(fprem).names = "FPREM": instructs(fprem).Pvalue = &HD9F8
instructs(fyl2xpi).names = "FYL2XPI": instructs(fyl2xpi).Pvalue = &HD9F9
instructs(fsqrt).names = "FSQRT": instructs(fsqrt).Pvalue = &HD9FA
instructs(fsincos).names = "FSINCOS": instructs(fsincos).Pvalue = &HD9FB
instructs(frndint).names = "FRNDINT": instructs(frndint).Pvalue = &HD9FC
instructs(fscale).names = "FSCALE": instructs(fscale).Pvalue = &HD9FD
instructs(fsin).names = "FSIN": instructs(fsin).Pvalue = &HD9FE
instructs(fcos).names = "FCOS": instructs(fcos).Pvalue = &HD9FF

'CONTROL
instructs(nopf).names = "FNOP": instructs(nopf).Pvalue = &HD9D0
instructs(fdecstp).names = "FDECSTP": instructs(fdecstp).Pvalue = &HD9F6
instructs(fincstp).names = "FINCSTP": instructs(fincstp).Pvalue = &HD9F7
instructs(feni).names = "FENI": instructs(feni).Pvalue = &HDBE0   'must be
instructs(fdisi).names = "FDISI": instructs(fdisi).Pvalue = &HDBE1  'a wait
instructs(fclex).names = "FCLEX": instructs(fclex).Pvalue = &HDBE2  'before
instructs(finit).names = "FINIT": instructs(finit).Pvalue = &HDBE3  'these ones
instructs(fsetpm).names = "FSETPM": instructs(fcmovpm).Pvalue = &HDBE4 'als prefix!
                                                                '&h9b
'all the other ones(with mostly one field) in the following order:
'I-op then F-op then P-op
FOR i = fild TO fcomp: instructs(i).nrfields = 1: NEXT

'DATA TRANSFER I-OP
instructs(fild).names = "FILD":
instructs(fist).names = "FIST": instructs(fist).Pvalue = &O20
instructs(fistp).names = "FISTP": instructs(fistp).Pvalue = &O30
'COMPARISON I-OP
FOR i = ficom TO ficomp: instructs(i).Pvalue = i - ficom + 2: NEXT
instructs(ficom).names = "FICOM": instructs(ficomp).names = "FICOMP"
'ARITHMATIC I-OP
FOR i = fiadd TO fidivr: instructs(i).Pvalue = i - fiadd: NEXT
instructs(fiadd).names = "FIADD": instructs(fimul).names = "FIMUL"
instructs(fisub).names = "FISUB": instructs(fisubr).names = "FISUBR":
instructs(fidiv).names = "FIDV": instructs(fidivr).names = "FIDIVR":
'DATA TRANSFER F-OP
instructs(fld).names = "FLD":
instructs(fst).names = "FST": instructs(fst).Pvalue = &O20
instructs(fstp).names = "FSTP": instructs(fstp).Pvalue = &O30
'COMPARISON F-OP
FOR i = fcom TO fcomp: instructs(i).Pvalue = i - fcom + 2: NEXT
instructs(fcom).names = "FCOM": instructs(fcomp).names = "FCOMP"
'ARITHMATIC F-OP
FOR i = fadd TO fdivr: instructs(i).nrfields = 2: NEXT
FOR i = fadd TO fdivr: instructs(i).Pvalue = i - fadd: NEXT
instructs(fadd).names = "FADD": instructs(fmul).names = "FMUL"
instructs(fsub).names = "FSUB": instructs(fsubr).names = "FSUBR":
instructs(fdiv).names = "FDIV": instructs(fdivr).names = "FDIVR":
'DATA TRANSFER B-OP AND FXCHG
FOR i = fbld TO fucomp: instructs(i).nrfields = 1: NEXT
instructs(fbld).names = "FBLD": instructs(fbld).Pvalue = &O40
instructs(fbstp).names = "FBSTP": instructs(fbstp).Pvalue = &O60
instructs(fxchg).names = "FXCHG": instructs(fxchg).Pvalue = &O10
'COMPARISON U-OP
FOR i = fucom TO fucomp: instructs(i).Pvalue = i - fucom + 4: NEXT
instructs(fucom).names = "FUCOM": instructs(fucomp).names = "FUCOMP"
'ARITHMATIC P-OP
FOR i = faddp TO fdivrp: instructs(i).nrfields = 2: NEXT
FOR i = faddp TO fdivrp: instructs(i).Pvalue = i - faddp: NEXT
instructs(faddp).names = "FADDP": instructs(fmulp).names = "FMULP"
instructs(fsubp).names = "FSUBP": instructs(fsubrp).names = "FSUBRP":
instructs(fdivp).names = "FDIVP": instructs(fdivrp).names = "FDIVRP":

'CONTROL STATEMENTS WITH OPERANDS
FOR i = fldenv TO ffree: instructs(i).nrfields = 1: NEXT
FOR i = fldenv TO fstcw: instructs(i).Pvalue = i - fldenv + 4: NEXT
instructs(fldenv).names = "FLDENV": instructs(fldcw).names = "FLDCW"
instructs(fstenv).names = "FSTENV": instructs(fstcw).names = "FSTCW":
instructs(frstor).names = "FRSTOR": instructs(frstor).Pvalue = 4
instructs(fsave).names = "FSAVE": instructs(fsave).Pvalue = 6
instructs(fstsw).names = "FSTSW": instructs(fstsw).Pvalue = 7 'ax=-3
instructs(ffree).names = "FFREE":

'END


END SUB

'
'Initializes the program
'
SUB initprogram

CALL header
CALL openfiles
defseg.size = 16
'CALL getsegdef


END SUB

'
'Initializes the founded values and gets another line
'Reads: asmline$
'
SUB initstatement

result.offset = 0
result.vid = 0: result.segmentprefix = 0: result.adressprefix = 0
result.wordsizeprefix = 0: result.instructprefix = 0: result.opcodebytes = 0
result.xrm = 0: result.sib = 0: result.dispsize = 0: result.displacement = 0
result.immidsize = 0: result.immid = 0
result.xrmthere = 0: result.sibthere = 0

this.id = 0:
this.Ereg = 0: this.Rreg = 0: this.Ereg = 0: this.basereg = 0: this.indexreg = 0
this.scalar = 0: this.memsize = 0

FOR i = 1 TO 3: thisfield(i).types = 0: thisfield(i).size = 0: NEXT
token$ = ""                            'to be encoded part of stametn
mem$ = ""
fieldnr = 0                            'for errormessages needed
asmline$ = "":
name$ = ""
swaps.namelen = 0
swaps.commentlen = 0

DEF SEG = &H40: POKE &H1C, PEEK(&H1A): DEF SEG
CLS 2: LOCATE 3, 1
DO
  LINE INPUT asmline$                      'kan ook uit een file...
  asmline$ = skipRwhite$(skipwhite$(asmline$))
LOOP UNTIL asmline$ <> ""

commentlen = INSTR(asmline$, ";")
IF commentlen THEN
  comment$ = skipwhite$(skipRwhite$(MID$(asmline$, commentlen + 1)))
  asmline$ = UCASE$(skipwhite$(skipRwhite$(LEFT$(asmline$, commentlen - 1))))
  commentlen = LEN(comment$)
ELSE
  asmline$ = UCASE$(asmline$)
END IF

asmstatement$ = asmline$
asmlinenr = asmlinenr + 1
CLS 2: LOCATE 3, 1


END SUB

'
'Decodes the INport statements
'
SUB inps

IF thisfield(1).size = byte THEN
  IF thisfield(2).types = Rtype THEN
    result.opcodebytes = &O354
  ELSEIF thisfield(2).types = Itype THEN
    result.opcodebytes = &O344
  ELSE
    abortnotvalid (2)
  END IF
ELSEIF thisfield(1).size = word THEN
  IF thisfield(2).types = Rtype THEN
    result.opcodebytes = &O355
  ELSEIF thisfield(2).types = Itype THEN
    result.opcodebytes = &O345
  ELSE
    abortnotvalid (2)
  END IF
ELSE
  abortsize (1)
END IF




END SUB

'
'Decodes an INT Db
'
SUB interu

IF thisfield(1).types <> Itype THEN abortnotvalid (1)
IF result.immidsize > byte THEN abortsize (1)
IF result.immid = 3 THEN
  result.opcodebytes = &O314: result.immid = 0
ELSE
  result.opcodebytes = &O315
END IF

END SUB

'
'Decodes an invlpg E
'
SUB invlpds

IF thisfield(1).types <> Etype THEN abortnotvalid (1)
IF thisfield(1).size <> word THEN abortsize (1)

result.opcodebytes = &HF00 OR &O20
this.Rreg = 7
isxrm


END SUB

'
'Parses and translates an absolute memory reference
'(CALL/JMP)
'
FUNCTION isabsolute

posi1 = INSTR(fields$(fieldnr), "FAR32")
posi = INSTR(fields$(fieldnr), "FAR")

IF posi1 THEN
  thisfield(1).size = far32
  abs$ = skipwhite(MID$(fields$(fieldnr), posi + 5)):
ELSEIF posi THEN
  thisfield(1).size = far
  abs$ = skipwhite(MID$(fields$(fieldnr), posi + 3)):
ELSE
  abs$ = fields$(fieldnr)
END IF

tokenP = INSTR(abs$, ":")
IF tokenP THEN
  segm$ = LEFT$(abs$, tokenP - 1)
ELSE
  segm$ = "0"
END IF
offs$ = MID$(abs$, tokenP + 1)

IF isimmid(segm$) > 0 AND isimmid(offs$) > 0 THEN
  isabsolute = 1:
  result.immid = immid(segm$)
  IF bytesize(result.immid) > word THEN abortstatement ("Double word " + segm$ + " is to big for a selector")
  result.immidsize = word:
  result.displacement = immid(offs$)
  result.dispsize = bytesize(result.displacement)
  IF thisfield(1).size = far AND result.dispsize <= word THEN
   result.dispsize = word:
   IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  ELSEIF thisfield(1).size = far32 AND result.dispsize <= dword THEN
   result.dispsize = dword:
   IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  ELSE
    abortsize (1)
  END IF
END IF



END FUNCTION

'
'
'
SUB isAXonly

reg = isregseg
IF reg AND (reg <> -1 OR thisfield(fieldnr).size > 3) THEN 'not al,ax
  abortstatement ("Other registers then AL or AX for IN_destiny or OUT_source not possible")
END IF


END SUB

'
'
'
SUB isAXorE

reg = isregseg
IF reg THEN
  IF this.Rreg THEN this.Ereg = reg ELSE this.Rreg = reg
ELSEIF ismem THEN
  thisfield(fieldnr).types = Etype
ELSE
  abortnotvalid (fieldnr)
END IF

END SUB

'
'Recognizes a binair value
'
FUNCTION isbin (numstring$)

i = LEN(numstring$)
DO WHILE i > 0
  IF INSTR("+-01", MID$(numstring$, i, 1)) THEN i = i - 1 ELSE i = -1
LOOP
IF i = 0 THEN isbin = 1

END FUNCTION

'
'Gets a bytereg
'
SUB isbytereg

this.Ereg = isregseg


END SUB

'
'Handles the CL or immid things( SHLD/SHRD)
'Validates:countsize and countregister
'CL NOT CODE AS this.Rreg or this.Ereg
SUB isCLorImmid

reg = isregseg
IF reg AND (reg <> 1 OR thisfield(fieldnr).size <> 2) THEN 'not cl
  abortstatement ("another register then CL for count is not possible")
ELSEIF reg = 0 AND isimmid(fields$(fieldnr)) THEN
  result.immid = immid&(fields$(fieldnr))
  result.immidsize = bytesize(result.immid)
  IF result.immidsize > byte THEN abortstatement ("Count is byte sized ..")
  thisfield(fieldnr).types = Itype
ELSEIF reg = 0 THEN
  abortnotvalid (1)
END IF

END SUB

'
'Handles the fields with CL,Db,1 fields( normal shifts and rotations)
'Validates :countsize, countregister
'DOES NOT STORE CL as this.Rreg or this.Ereg!
'
SUB isCLorImmidorOne

reg = isregseg
IF reg AND (reg <> cl OR thisfield(fieldnr).size <> byte) THEN 'not cl
  abortstatement ("another register then CL for count is not possible")
ELSEIF reg = 0 AND isimmid(fields$(fieldnr)) THEN
  result.immid = immid&(fields$(fieldnr))
  result.immidsize = bytesize(result.immid)
  IF result.immidsize > byte THEN abortstatement ("Count is byte sized ..")
  IF result.immid = 1 THEN thisfield(fieldnr).types = onetype ELSE thisfield(fieldnr).types = Itype
ELSEIF reg = 0 THEN
  abortnotvalid (1)
END IF

END SUB

'
'Parses and translates a CR register
'Writes: This.Ereg
'
FUNCTION isCR

SELECT CASE fields$(fieldnr)

 CASE "CR0": isCR = 1: this.Ereg = CR0:
            thisfield(fieldnr).size = 4: thisfield(fieldnr).types = 9
 CASE "CR1": isCR = 1: this.Ereg = CR1:
            thisfield(fieldnr).size = 4: thisfield(fieldnr).types = 9
 CASE "CR2": isCR = 1: this.Ereg = CR2:
            thisfield(fieldnr).size = 4: thisfield(fieldnr).types = 9
 CASE "CR3": isCR = 1: this.Ereg = CR3
            thisfield(fieldnr).size = 4: thisfield(fieldnr).types = 9

END SELECT

END FUNCTION

'
'Recognizes a valid decimal
'
FUNCTION isdec (numstring$)

i = LEN(numstring$)
DO WHILE i > 0
  IF INSTR("+-0123456789", MID$(numstring$, i, 1)) THEN i = i - 1 ELSE i = -1
LOOP
IF i = 0 THEN isdec = 1

END FUNCTION

'
'Recognizes a digit
'
FUNCTION isdigit (char$)

IF INSTR("0123456789", char$) THEN isdigit = 1


END FUNCTION

'
'Gets the first operand from a direct memory reference
'
SUB isdirect

token$ = "": mem$ = skipfactor$(mem$)
iswhite$ = SPACE$(1) + CHR$(9)
split$ = "+-[(" + iswhite$
lengte = LEN(mem$)

char$ = LEFT$(mem$, 1): i = 1
DO WHILE INSTR(split$, char$) = 0 AND i <= lengte
  IF INSTR(iswhite$, char$) = 0 THEN token$ = token$ + char$
  i = i + 1: char$ = MID$(mem$, i, 1)
LOOP
mem$ = skipwhite$(MID$(mem$, i))
validatememoperand (lookupmemdirect)


END SUB

'
'Parses and translates a DR reference
'Writes:This.Ereg
'
FUNCTION isDR

SELECT CASE fields$(fieldnr)

 CASE "DR0": isDR = 1: this.Ereg = DR0
            thisfield(fieldnr).size = 4: thisfield(fieldnr).types = 10
 CASE "DR1": isDR = 1: this.Ereg = DR1
            thisfield(fieldnr).size = 4: thisfield(fieldnr).types = 10
 CASE "DR2": isDR = 1: this.Ereg = DR2
            thisfield(fieldnr).size = 4: thisfield(fieldnr).types = 10
 CASE "DR3": isDR = 1: this.Ereg = DR3
            thisfield(fieldnr).size = 4: thisfield(fieldnr).types = 10
 CASE "DR6": isDR = 1: this.Ereg = DR6
            thisfield(fieldnr).size = 4: thisfield(fieldnr).types = 10
 CASE "DR7": isDR = 1: this.Ereg = DR7
            thisfield(fieldnr).size = 4: thisfield(fieldnr).types = 10

END SELECT


END FUNCTION

'
'
'
SUB isDXorImmid

reg = isregseg
IF (reg <> DX OR thisfield(fieldnr).size <> 3) THEN 'not dx
  abortstatement ("Other register then DX for IN_source or OUT_destiny is not possible")
ELSEIF reg = 0 AND isimmid(fields$(fieldnr)) THEN
  result.immid = immid&(fields$(fieldnr))
  result.immidsize = bytesize(result.immid)
  IF result.immidsize > byte THEN abortstatement ("IN_source or OUT_destiny is byte sized ..")
  thisfield(fieldnr).types = Itype
ELSEIF reg = 0 THEN
  abortnotvalid (1)
END IF


END SUB

'
'Parses and translates the field fieldnr
'Writes: all thisfieldsizes(alleen 0 als immid), thisfieldtypes
'        result.disp&,result.immid& and both sizes
'
SUB isfield

reg = isregseg
IF reg THEN
  IF this.Rreg THEN this.Ereg = reg ELSE this.Rreg = reg
ELSEIF isCR THEN
  thisfield(fieldnr).types = CRtype
ELSEIF isDR THEN
  thisfield(fieldnr).types = DRtype
ELSEIF isTR THEN
  thisfield(fieldnr).types = TRtype
ELSEIF ismem THEN
  thisfield(fieldnr).types = Etype
ELSEIF isimmid(fields$(fieldnr)) THEN
  thisfield(fieldnr).types = Itype
  result.immid = immid&(fields$(fieldnr))
  result.immidsize = bytesize(result.immid)
ELSE                           'identifier
  thisfield(fieldnr).types = Mtype
END IF


END SUB

'
'Recognizes a valid hexadecimal number
'
FUNCTION ishex (numstring$)

i = LEN(numstring$)
DO WHILE i
  IF INSTR("+-0123456789ABCDEF", MID$(numstring$, i, 1)) THEN i = i - 1 ELSE i = 0
LOOP

IF i = 0 THEN ishex = 1

END FUNCTION

'
'Recognizes and parses immidiate
'
FUNCTION isimmid (immidstr$)

lengte = LEN(immidstr$): typeofimmid$ = RIGHT$(immidstr$, 1)

IF typeofimmid$ = "H" AND lengte > 1 THEN
  IF ishex(LEFT$(immidstr$, lengte - 1)) THEN isimmid = 1
ELSEIF typeofimmid$ = "B" AND lengte > 1 THEN
  IF isbin(LEFT$(immidstr$, lengte - 1)) THEN isimmid = 1
ELSEIF typeofimmid$ = "D" AND lengte > 1 THEN
  IF isdec(LEFT$(immidstr$, lengte - 1)) THEN isimmid = 1
ELSE
  IF isdec(immidstr$) THEN isimmid = 1
END IF


END FUNCTION

'
'Gets an immidiate field.
'
SUB isImmidonly

IF isimmid(fields$(fieldnr)) THEN
  result.immid = immid&(fields$(fieldnr))
  result.immidsize = bytesize(result.immid)
ELSE
  abortnotvalid (1)
END IF

END SUB

'
'Parses and translates an indirect memory reference
'
SUB isindirect

tokenP = INSTR(mem$, "]")
IF tokenP = 0 THEN tokenP = INSTR(mem$, ")")
IF tokenP = 0 THEN PRINT "abort because open pointerss": END

indirect$ = skipRwhite$(LEFT$(mem$, tokenP - 1))
mem$ = skipwhite$(MID$(mem$, tokenP + 1))

DO
  CALL isindirectop(indirect$)
  validatememoperand (lookupmemoperand)
LOOP WHILE LEN(indirect$)

END SUB

'
'Separates a token$ from the indirect$
'
SUB isindirectop (indirect$)

token$ = "": indirect$ = skipfactor$(indirect$)
split$ = "+-": white$ = CHR$(9) + " ":
lengte = LEN(indirect$)

char$ = LEFT$(indirect$, 1): i = 1
DO WHILE INSTR(split$, char$) = 0 AND i <= lengte
  IF INSTR(white$, char$) = 0 THEN token$ = token$ + char$
  i = i + 1: char$ = MID$(indirect$, i, 1)
LOOP

indirect$ = skipwhite$(MID$(indirect$, i))

END SUB

'
'Looks in the symboltable for a match
'Negate sets the bits to negate
'
FUNCTION isinsymboltable (start, negate)

lengte = LEN(name$)
IF start THEN i = start - 1 ELSE i = scount

DO WHILE found = 0 AND i > 0
   IF LEFT$(symboltable(i).names, lengte) = name$ THEN
     IF symboltable(i).types AND negate THEN i = i - 1 ELSE found = i
     'moet zoiets worden als
     'if symboltable(i).types xor negate then found=i
   ELSE
    i = i - 1
   END IF
LOOP

isinsymboltable = found

END FUNCTION

'
'Recognizes a memory operand with a label...
'
SUB islabel

thisfield(1).types = Ltype
IF INSTR(fields$(1), "FAR") OR INSTR(fields$(1), "FAR32") OR INSTR(fields$(1), "PWORD") THEN
  abortsize (1)
ELSEIF INSTR(fields$(1), "SHORT") THEN
  IF this.id = scall THEN abortsize (1)
  thisfield(1).size = short
  fields$(1) = MID$(fields$(1), INSTR(fields$(1), "SHORT"))
  fields$(1) = skipwhite(MID$(fields$(1), INSTR(fields$(1), " ")))
ELSEIF INSTR(fields$(1), "NEAR32") THEN
  thisfield(1).size = near32
  fields$(1) = MID$(fields$(1), INSTR(fields$(1), "NEAR32"))
  fields$(1) = skipwhite(MID$(fields$(1), INSTR(fields$(1), " ")))
ELSEIF INSTR(fields$(1), "NEAR") THEN
  thisfield(1).size = near
  fields$(1) = MID$(fields$(1), INSTR(fields$(1), "NEAR"))
  fields$(1) = skipwhite(MID$(fields$(1), INSTR(fields$(1), " ")))
ELSEIF INSTR(fields$(1), "DWORD") THEN
  thisfield(1).size = dword
  fields$(1) = MID$(fields$(1), INSTR(fields$(1), "DWORD"))
  fields$(1) = skipwhite(MID$(fields$(1), INSTR(fields$(1), " ")))
ELSEIF INSTR(fields$(1), "WORD") THEN
  thisfield(1).size = word
  fields$(1) = MID$(fields$(1), INSTR(fields$(1), "WORD"))
  fields$(1) = skipwhite(MID$(fields$(1), INSTR(fields$(1), " ")))
END IF


END SUB

'
'Recognizes and parses a memory field
'Writes: thisfield(fieldnr).size, thisfield(fieldnr).types
'        this.basereg,this.indexreg,result.displacement
'        result.adressprefix,result.dispsize
'Validates: basereg and indexreg and dispsize of same size
'           adresssize(16/32 against defseg.size)
'
FUNCTION ismem

mem$ = LTRIM$(fields$(fieldnr))
IF INSTR(mem$, "[") = 0 AND INSTR(mem$, "(") = 0 THEN EXIT FUNCTION

ismem = 1
DO
  ismemoperand
LOOP WHILE LEN(mem$)

validateadressize


END FUNCTION

'
'Distinguishes between a direct / indirect memory reference
'
SUB ismemoperand

split$ = "[("

IF INSTR(split$, LEFT$(mem$, 1)) THEN
  mem$ = MID$(mem$, 2): isindirect
ELSE
  isdirect
END IF


END SUB

'
'Gets a memory or label
'
SUB ismemorlabel

IF INSTR(fields$(1), "[") = 0 AND INSTR(fields$(1), "(") = 0 THEN
  IF isabsolute THEN thisfield(1).types = abstype ELSE islabel
ELSEIF ismem THEN
  thisfield(1).types = Etype
ELSE
  abortnotvalid (1)
END IF

END SUB

'
'Recognizes a nul immid
'
FUNCTION isnul (factor$)

matchchar$ = LEFT$(factor$, 1)
IF matchchar$ = "&" THEN matchchar$ = MID$(factor$, 3, 1)
IF matchchar$ = "0" THEN isnul = 1

END FUNCTION

'
'Recognizes a valid hexadecimal(1),binair(2) or decimal(3) number
'
FUNCTION isnum (numstring$)

immidtype$ = UCASE$(RIGHT$(numstring$, 1))
IF immidtype$ = "H" THEN
  isnum = ishex(LEFT$(numstring$, LEN(numstring$) - 1))
ELSEIF immidtype$ = "B" THEN
  isnum = isbin(LEFT$(numstring$, LEN(numstring$) - 1))
ELSE
  IF INSTR(numstring$, "D") THEN numstring$ = LEFT$(numstring$, LEN(numstring$) - 1)
  isnum = isdec(numstring$)
END IF

END FUNCTION

'
'Parses and translates field fieldnr for a register reference
'Writes: this.Rreg,thisfield(fieldnr).types
'
FUNCTION isregseg

SELECT CASE fields$(fieldnr)

 CASE "ES": isregseg = ES: thisfield(fieldnr).size = word: thisfield(fieldnr).types = Stype
 CASE "CS": isregseg = CS: thisfield(fieldnr).size = word: thisfield(fieldnr).types = Stype
 CASE "SS": isregseg = SS: thisfield(fieldnr).size = word: thisfield(fieldnr).types = Stype
 CASE "DS": isregseg = DS: thisfield(fieldnr).size = word: thisfield(fieldnr).types = Stype
 CASE "FS": isregseg = FS: thisfield(fieldnr).size = word: thisfield(fieldnr).types = Stype
 CASE "GS": isregseg = GS: thisfield(fieldnr).size = word: thisfield(fieldnr).types = Stype
 CASE "AL": isregseg = AL: thisfield(fieldnr).size = byte: thisfield(fieldnr).types = Atype
 CASE "CL": isregseg = cl: thisfield(fieldnr).size = byte: thisfield(fieldnr).types = Rtype
 CASE "DL": isregseg = DL: thisfield(fieldnr).size = byte: thisfield(fieldnr).types = Rtype
 CASE "BL": isregseg = BL: thisfield(fieldnr).size = byte: thisfield(fieldnr).types = Rtype
 CASE "AH": isregseg = AH: thisfield(fieldnr).size = byte: thisfield(fieldnr).types = Rtype
 CASE "CH": isregseg = CH: thisfield(fieldnr).size = byte: thisfield(fieldnr).types = Rtype
 CASE "DH": isregseg = DH: thisfield(fieldnr).size = byte: thisfield(fieldnr).types = Rtype
 CASE "BH": isregseg = BH: thisfield(fieldnr).size = byte: thisfield(fieldnr).types = Rtype
 CASE "AX": isregseg = AX: thisfield(fieldnr).size = word: thisfield(fieldnr).types = Atype
 CASE "CX": isregseg = CX: thisfield(fieldnr).size = word: thisfield(fieldnr).types = Rtype
 CASE "DX": isregseg = DX: thisfield(fieldnr).size = word: thisfield(fieldnr).types = Rtype
 CASE "BX": isregseg = BX: thisfield(fieldnr).size = word: thisfield(fieldnr).types = Rtype
 CASE "SP": isregseg = SP: thisfield(fieldnr).size = word: thisfield(fieldnr).types = Rtype
 CASE "BP": isregseg = BP: thisfield(fieldnr).size = word: thisfield(fieldnr).types = Rtype
 CASE "SI": isregseg = SI: thisfield(fieldnr).size = word: thisfield(fieldnr).types = Rtype
 CASE "DI": isregseg = DI: thisfield(fieldnr).size = word: thisfield(fieldnr).types = Rtype
 CASE "EAX": isregseg = eax: thisfield(fieldnr).size = dword: thisfield(fieldnr).types = Atype
 CASE "ECX": isregseg = ECX: thisfield(fieldnr).size = dword: thisfield(fieldnr).types = Rtype
 CASE "EDX": isregseg = EDX: thisfield(fieldnr).size = dword: thisfield(fieldnr).types = Rtype
 CASE "EBX": isregseg = EBX: thisfield(fieldnr).size = dword: thisfield(fieldnr).types = Rtype
 CASE "ESP": isregseg = ESP: thisfield(fieldnr).size = dword: thisfield(fieldnr).types = Rtype
 CASE "EBP": isregseg = EBP: thisfield(fieldnr).size = dword: thisfield(fieldnr).types = Rtype
 CASE "EDI": isregseg = edi: thisfield(fieldnr).size = dword: thisfield(fieldnr).types = Rtype
 CASE "ESI": isregseg = ESI: thisfield(fieldnr).size = dword: thisfield(fieldnr).types = Rtype

END SELECT


END FUNCTION

'
'Parses and translates a floating point stack reference
'Writes:This.Rreg, thisfield(fieldnr).size
'
FUNCTION isST

SELECT CASE fields$(fieldnr)
 
  CASE "ST": isST = 1: this.Rreg = ST: thisfield(fieldnr).size = 10
  CASE "ST[0]", "ST [0]", "ST(0)", "ST (0)": isST = 1: this.Rreg = ST: thisfield(fieldnr).size = 10
  CASE "ST[1]", "ST [1]", "ST(1)", "ST (1)": isST = 1: this.Rreg = ST1: thisfield(fieldnr).size = 10
  CASE "ST[2]", "ST [2]", "ST(2)", "ST (2)": isST = 1: this.Rreg = ST2: thisfield(fieldnr).size = 10
  CASE "ST[3]", "ST [3]", "ST(3)", "ST (3)": isST = 1: this.Rreg = ST3: thisfield(fieldnr).size = 10
  CASE "ST[4]", "ST [4]", "ST(4)", "ST (4)": isST = 1: this.Rreg = ST4: thisfield(fieldnr).size = 10
  CASE "ST[5]", "ST [5]", "ST(5)", "ST (5)": isST = 1: this.Rreg = ST5: thisfield(fieldnr).size = 10
  CASE "ST[6]", "ST [6]", "ST(6)", "ST (6)": isST = 1: this.Rreg = ST6: thisfield(fieldnr).size = 10
  CASE "ST[7]", "ST [7]", "ST(7)", "ST (7)": isST = 1: this.Rreg = ST7: thisfield(fieldnr).size = 10

END SELECT


END FUNCTION

'
'ST only
'
SUB isSTorMeM

IF isST THEN
  thisfield(fieldnr).types = STtype
ELSEIF ismem THEN
  thisfield(fieldnr).types = Etype
ELSE
 abortnotvalid (fieldnr)
END IF

END SUB

'
'Parses and translates a TR register field
'Writes: THis.Ereg
'
FUNCTION isTR

SELECT CASE fields$(fieldnr)

 CASE "TR6": isTR = 1: this.Ereg = TR6:
        thisfield(fieldnr).size = 4: thisfield(fieldnr).types = 11

 CASE "TR7": isTR = 1: this.Ereg = TR7:
        thisfield(fieldnr).size = 4: thisfield(fieldnr).types = 11

END SELECT

END FUNCTION

'
'Proceeds with the xmr(sib) encoding
'
SUB isxrm

result.xrmthere = 1
IF this.Rreg = -1 THEN this.Rreg = 0

IF this.basereg = 0 AND this.indexreg = 0 AND result.dispsize = 0 THEN
  writeregs
ELSEIF this.basereg = 0 AND this.indexreg = 0 THEN
  IF this.memsize = 32 THEN CALL write32displacement ELSE CALL writedisplacement
ELSEIF this.indexreg = 0 THEN
  IF this.memsize = 32 THEN CALL write32base ELSE CALL writebase
ELSE
  IF this.memsize = 32 THEN CALL writescaledindex ELSE CALL writebaseindex
END IF

END SUB

'
'Decodes a jcc near
'
SUB jccnear16 (id)

IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange: subextra = 1
result.opcodebytes = &HF00 OR &O200 + instructs(this.id).Pvalue
CALL resolvenear16(id, subextra + 1)


END SUB

'
'Decodes a jcc near Label(forward)
'
SUB jccnear16fw

IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
result.opcodebytes = &HF00 OR &O200 + instructs(this.id).Pvalue
result.immidsize = near
CALL storesymbol(forward, asmlinenr)

END SUB

'
'Decodes a near 32 Jcc label
'
SUB jccnear32 (id)

IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange: subextra = 1
result.opcodebytes = &HF00 OR &O200 + instructs(this.id).Pvalue
CALL resolvenear32(id, subextra + 1)


END SUB

'
'Decodes a near 32 Jcc label(fw)
'
SUB jccnear32fw

IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
result.opcodebytes = &HF00 OR &O200 + instructs(this.id).Pvalue
result.immidsize = near32
CALL storesymbol(forward, asmlinenr)

END SUB

'
'Decodes the jCC Cb
'
SUB jccs

IF thisfield(1).types <> Ltype THEN abortnotvalid (1)

name$ = fields$(1)
id = isinsymboltable(0, forward)
IF id THEN
  SELECT CASE thisfield(1).size
    CASE short, 0: jccshort (id)
    CASE near: jccnear16 (id)
    CASE near32: CALL jccnear32(id)
  END SELECT
ELSE
  SELECT CASE thisfield(1).size
    CASE short: jccshortfw
    CASE 0: IF defseg.size = 16 THEN jccnear16fw ELSE jccnear32fw
    CASE near: jccnear16fw
    CASE near32: jccnear32fw
  END SELECT
END IF

END SUB

'
'Decodes a jcc short
'
SUB jccshort (id)

result.opcodebytes = &O160 + instructs(this.id).Pvalue
resolveshort (id)

END SUB

'
'Decodes a jcc (short) Label(forward)
'
SUB jccshortfw

result.opcodebytes = &O160 + instructs(this.id).Pvalue
result.immidsize = short
CALL storesymbol(forward, asmlinenr)

END SUB

'
'Decodes a lea
'
SUB leas

IF thisfield(1).types > Rtype THEN abortnotvalid (1)
IF thisfield(2).types <> Etype THEN abortnotvalid (2)
IF thisfield(1).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  IF thisfield(2).size = word OR thisfield(2).size = 0 THEN
    result.opcodebytes = &O215
  ELSE
    abortnomatch
  END IF
ELSEIF thisfield(1).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  IF thisfield(2).size = dword OR thisfield(2).size = 0 THEN
    result.opcodebytes = &O215
  ELSE
    abortnomatch
  END IF
ELSE
  abortsize (1)
END IF

END SUB

'
'Adds instructions to prefixes..
'
SUB lookupaddintruct

result.instructprefix = instructs(this.id).Pvalue:
pref = instructs(this.id).nrfields: this.id = 0
selecttoken
lookupinstruction

SELECT CASE pref
  CASE -4
  IF this.id < feni OR this.id > fsetpm THEN abortstatement ("FWAIT without need")
 
  CASE -3    'LOCK
  IF this.id <> xchg AND this.id <> mov AND this.id <> in AND this.id <> outs THEN
    abortstatement ("LOCK WITHOUT XCHG,MOV,IN or OUT")
  END IF

  CASE -2     'REP
  IF this.id < lodsb OR this.id > outsd THEN abortstatement ("REP WITHOUT MOVS,STOS,INS,OUTS IS NONSENSE")

  CASE -1:    'repz/repe/repnz/repne
  IF this.id < cmpsb OR this.id > scasd THEN abortstatement ("REPE/REPNE WITHOUT SCAS, CMPS IS NONSENSE")

END SELECT

END SUB

'
'Gets the fields of an instruction_statement
'Writes:fields$(),this.nrfields
'Validates: fieldnr against instructs().fieldnr
'
SUB lookupfields

DO WHILE LEN(asmline$)
  fieldnr = fieldnr + 1
 
  hit = INSTR(asmline$, ",")
  IF hit THEN
    fields$(fieldnr) = LEFT$(asmline$, hit - 1):
    asmline$ = LTRIM$(MID$(asmline$, hit + 1))
  ELSE
    fields$(fieldnr) = asmline$: asmline$ = ""
  END IF

LOOP

validatenrfields


END SUB

'
'Functions checks token for a valid 8386 instruction
'Writes: instructionid( index in instructiontable)
'
SUB lookupinstruction


i = UBOUND(instructs)
DO WHILE this.id = 0 AND i > 0
  b$ = LEFT$(instructs(i).names, INSTR(instructs(i).names, " ") - 1)
  IF token$ = b$ THEN
    this.id = i
  ELSE
    i = i - 1
  END IF
LOOP

END SUB

'
'Compares the current token$ with valid direct memory references
'
FUNCTION lookupmemdirect
 
SELECT CASE token$
  CASE "+DS", "-DS", "DS", "DS:": lookupmemdirect = DSr
  CASE "+ES", "-ES", "ES", "ES:": lookupmemdirect = ESr
  CASE "+CS", "-CS", "CS", "CS:": lookupmemdirect = CSr
  CASE "+SS", "-SS", "SS", "SS:": lookupmemdirect = SSr
  CASE "+FS", "-FS", "FS", "FS:": lookupmemdirect = FSr
  CASE "+GS", "-GS", "GS", "GS:": lookupmemdirect = GSr

  CASE "+B", "-B", "BYTEPTR", "+BYTEPTR", "-BYTEPTR", "BYTE", "+BYTE", "-BYTE"
                         lookupmemdirect = Bptr
  CASE "+W", "-W", "WORDPTR", "+WORDPTR", "-WORDPTR", "WORD", "+WORD", "-WORD":
                         lookupmemdirect = Wptr
  CASE "+D", "-D", "DWORDPTR", "+DWORDPTR", "-DWORDPTR", "DWORD", "+DWORD", "-DWORD", "DOUBLE", "+DOUBLE", "-DOUBLE":
                          lookupmemdirect = Dptr
  CASE "+Q", "-Q", "QWORDPTR", "+QWORDPTR", "-QWORDPTR", "QWORD", "+QWORD", "-QWORD":
                          lookupmemdirect = Qptr
  CASE "+T", "-T", "TBYTEPTR", "+TBYTEPTR", "-TBYTEPTR", "TBYTE", "+TBYTE", "-TBYTE":
                          lookupmemdirect = Tptr
  CASE "+S", "-S", "SHORT", "+SHORT", "-SHORT": lookupmemdirect = shortptr
  CASE "NEAR32", "-NEAR32", "+NEAR32": lookupmemdirect = near32ptr
  CASE "+N", "-N", "NEAR", "+NEAR", "-NEAR": lookupmemdirect = nearptr
  CASE "FAR32", "-FAR32", "+FAR32": lookupmemdirect = far32ptr
  CASE "+F", "-F", "FAR", "+FAR", "-FAR": lookupmemdirect = farptr
 
  CASE ELSE:  'misschien hier all hele displacement doen.. ?
  IF isimmid(token$) THEN lookupmemdirect = 60 ELSE lookupmemdirect = 61

END SELECT


END FUNCTION

'
'Compares the current token with known memory operands
'
FUNCTION lookupmemoperand

SELECT CASE token$
 
  CASE "BX", "+BX", "-BX": lookupmemoperand = BXr
  CASE "BP", "+BP", "-BP": lookupmemoperand = BPr
  CASE "SI", "+SI", "-SI": lookupmemoperand = SIr
  CASE "DI", "+DI", "-DI": lookupmemoperand = DIr

  CASE "+EAX", "-EAX", "EAX", "EAX*1": lookupmemoperand = EAX0
  CASE "EAX*2", "+EAX*2", "-EAX*2", "2*EAX", "+2*EAX", "-2EAX":
                         lookupmemoperand = EAX2
  CASE "EAX*4", "+EAX*4", "-EAX*4", "4*EAX", "+4*EAX", "-4EAX":
                         lookupmemoperand = EAX4
  CASE "EAX*8", "+EAX*8", "-EAX*8", "8*EAX", "+8*EAX", "-8EAX":
                         lookupmemoperand = EAX8
  CASE "+EBX", "-EBX", "EBX", "EBX*1": lookupmemoperand = EBX0
  CASE "EBX*2", "+EBX*2", "-EBX*2", "2*EBX", "+2*EBX", "-2EBX":
                         lookupmemoperand = EBX2
  CASE "EBX*4", "+EBX*4", "-EBX*4", "4*EBX", "+4*EBX", "-4EBX":
                         lookupmemoperand = EBX4
  CASE "EBX*8", "+EBX*8", "-EBX*8", "8*EBX", "+8*EBX", "-8EBX":
                         lookupmemoperand = EBX8
  CASE "-ECX", "+ECX", "ECX", "ECX*1": lookupmemoperand = ECX0
  CASE "ECX*2", "+ECX*2", "-ECX*2", "2*ECX", "+2*ECX", "-2ECX":
                         lookupmemoperand = ECX2
  CASE "ECX*4", "+ECX*4", "-ECX*4", "4*ECX", "+4*ECX", "-4ECX":
                         lookupmemoperand = ECX4
  CASE "ECX*8", "+ECX*8", "-ECX*8", "8*ECX", "+8*ECX", "-8ECX":
                         lookupmemoperand = ECX8
  CASE "+EDX", "-EDX", "EDX", "EDX*1": lookupmemoperand = EDX0
  CASE "EDX*2", "+EDX*2", "-EDX*2", "2*EDX", "+2*EDX", "-2EDX":
                         lookupmemoperand = EDX2
  CASE "EDX*4", "+EDX*4", "-EDX*4", "4*EDX", "+4*EDX", "-4EDX":
                         lookupmemoperand = EDX4
  CASE "EDX*8", "+EDX*8", "-EDX*8", "8*EDX", "+8*EDX", "-8EDX":
                         lookupmemoperand = EDX8
  CASE "-EBP", "+EBP", "EBP", "EBP*1": lookupmemoperand = EBP0
  CASE "EBP*2", "+EBP*2", "-EBP*2", "2*EBP", "+2*EBP", "-2EBP":
                         lookupmemoperand = EBP2
  CASE "EBP*4", "+EBP*4", "-EBP*4", "4*EBP", "+4*EBP", "-4EBP":
                         lookupmemoperand = EBP4
  CASE "EBP*8", "+EBP*8", "-EBP*8", "8*EBP", "+8*EBP", "-8EBP":
                         lookupmemoperand = EBP8
  CASE "-EDI", "+EDI", "EDI", "EDI*1": lookupmemoperand = EDI0
  CASE "EDI*2", "+EDI*2", "-EDI*2", "2*EDI", "+2*EDI", "-2EDI":
                         lookupmemoperand = EDI2
  CASE "EDI*4", "+EDI*4", "-EDI*4", "4*EDI", "+4*EDI", "-4EDI":
                         lookupmemoperand = EDI4
  CASE "EDI*8", "+EDI*8", "-EDI*8", "8*EDI", "+8*EDI", "-8EDI"
                         lookupmemoperand = EDI8
  CASE "+ESI", "-ESI", "ESI", "ESI*1": lookupmemoperand = ESI0
  CASE "ESI*2", "+ESI*2", "-ESI*2", "2*ESI", "+2*ESI", "-2ESI":
                         lookupmemoperand = ESI2
  CASE "ESI*4", "+ESI*4", "-ESI*4", "4*ESI", "+4*ESI", "-4ESI":
                         lookupmemoperand = ESI4
  CASE "ESI*8", "+ESI*8", "-ESI*8", "8*ESI", "+8*ESI", "-8ESI"
                         lookupmemoperand = ESI8
  CASE "+ESP", "-ESP", "ESP", "ESP*1": lookupmemoperand = ESP0

 
  CASE ELSE:  'misschien hier all hele displacement doen.. ?
  IF isimmid(token$) THEN lookupmemoperand = 60 ELSE lookupmemoperand = 61

END SELECT

END FUNCTION

'
'Looks up the next token when the first is ident..
'Validates: there must be a type
'Writes:token$,asmline$
'
SUB lookupsymboltype

labelcheck$ = LEFT$(asmline$, 1)
IF labelcheck$ = ":" THEN asmline$ = labelcheck$ + SPACE$(1) + MID$(asmline$, 2)
tokenP = INSTR(asmline$, " ")
TABP = INSTR(asmline$, CHR$(9))

IF (tokenP > 0 AND TABP > 0 AND tokenP < TABP) OR (tokenP > 0 AND TABP = 0) THEN
  token$ = LEFT$(asmline$, tokenP - 1)
  asmline$ = skipwhite$(MID$(asmline$, tokenP + 1))
ELSEIF TABP > 0 THEN
  token$ = LEFT$(asmline$, TABP - 1)
  asmline$ = skipwhite$(MID$(asmline$, TABP + 1))
ELSEIF asmline$ <> "" THEN
  token$ = skipwhite$(asmline$): asmline$ = ""
ELSE
  abortstatement ("name without a definition")
END IF


END SUB

'
'Decodes the loop/jecxz/jcxz Cb
'
SUB loopit

IF thisfield(1).types <> Ltype THEN abortnotvalid (1)
IF thisfield(1).size > shortptr THEN abortsize (1)

name$ = fields$(1)
id = isinsymboltable(0, forward)
IF id THEN
  loopshort (id)
ELSE
  loopshortfw (id)
END IF

IF (this.id = jecxz AND defseg.size = 16) OR (this.id = jcxz AND defseg.size = 32) THEN
  result.adressprefix = adresssizechange
END IF

END SUB

'
'Decodes the loop Label( near16)
'
SUB loopshort (id)

result.opcodebytes = &O340 + instructs(this.id).Pvalue
result.immidsize = short
resolveshort (id)

END SUB

'
'Decodes a loop Label(short forward)
'
SUB loopshortfw (id)

result.opcodebytes = &O340 + instructs(this.id).Pvalue
result.immidsize = short
CALL storesymbol(forward, asmlinenr)

END SUB

'
'Decodes a Lseg R,Ef
'
SUB lseg

IF thisfield(2).types <> Etype THEN abortnotvalid (2)
IF thisfield(1).types > Rtype THEN abortnotvalid (1)
IF thisfield(1).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  IF thisfield(2).size = 0 OR thisfield(2).size = word THEN
    LsegW
  ELSE
    abortnomatch
  END IF
ELSEIF thisfield(1).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  IF thisfield(2).size = 0 OR thisfield(2).size = dword THEN
    LsegW
  ELSE
    abortnomatch
  END IF
ELSE
  abortsize (1)
END IF


END SUB

'
'Decodes a Lseg Rw,Ef
'
SUB LsegW

SELECT CASE this.id
  CASE lds: result.opcodebytes = &O305
  CASE les: result.opcodebytes = &O304
  CASE lss: result.opcodebytes = &HF00 OR &O262
  CASE lfs: result.opcodebytes = &HF00 OR &O264
  CASE lgs: result.opcodebytes = &HF00 OR &O265
END SELECT

END SUB

'
'Decode the not and neg instructions
'
SUB math

IF thisfield(1).types > Etype THEN abortnotvalid (1)

SELECT CASE thisfield(1).size
  CASE 0: result.opcodebytes = &O367
  CASE sbyte, byte: result.opcodebytes = &O366
  CASE word:  result.opcodebytes = &O367
              IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  CASE dword: result.opcodebytes = &O367
              IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  CASE ELSE: abortsize (1)
END SELECT

this.Ereg = this.Rreg
this.Rreg = instructs(this.id).Pvalue
isxrm



END SUB

'
'Handles the main menu..(dummy)
'
SUB menuhandling






END SUB

'
' Decodes a mov A,[Dw]
'
SUB movAEdisp

IF thisfield(2).size = 0 THEN thisfield(2).size = thisfield(1).size

IF thisfield(2).size = byte AND thisfield(1).size = byte THEN
  result.opcodebytes = &O240
ELSEIF thisfield(2).size = word AND thisfield(1).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O241
ELSEIF thisfield(2).size = dword AND thisfield(1).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O241
ELSEIF thisfield(2).size > dword THEN
  abortsize (2)
ELSE
  abortnomatch
END IF
isxrm


END SUB

'
'Decodes a mov E,-( without immid source)
'
SUB movE

IF thisfield(2).types = Atype AND this.basereg = 0 AND this.indexreg = 0 THEN
    movEdispA
ELSEIF thisfield(2).types <= Rtype THEN
   movER
ELSE
  abortnotvalid (2)
END IF




END SUB

'
'Decodes a mov [Dw],A
'
SUB movEdispA

IF thisfield(1).size = 0 THEN thisfield(1).size = thisfield(2).size

IF thisfield(2).size = byte AND thisfield(1).size = byte THEN
  result.opcodebytes = &O242
ELSEIF thisfield(2).size = word AND thisfield(1).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O243
ELSEIF thisfield(2).size = dword AND thisfield(1).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O243
ELSEIF thisfield(2).size > dword THEN
  abortsize (2)
ELSE
  abortnomatch
END IF
isxrm

END SUB

'
'Decodes a mov E,I
'
SUB movEI

IF thisfield(1).size = 0 THEN
  IF result.immidsize < dword THEN thisfield(1).size = word ELSE thisfield(1).size = dword
END IF


this.Ereg = this.Rreg: this.Rreg = instructs(this.id).Pvalue

IF thisfield(1).size <= byte AND result.immidsize <= byte THEN
  result.opcodebytes = &O306
ELSEIF thisfield(1).size = word AND result.immidsize <= word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.immidsize = word
  result.opcodebytes = &O307
ELSEIF thisfield(1).size = dword AND result.immidsize <= dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.immidsize = dword
  result.opcodebytes = &O307
ELSEIF thisfield(1).size > dword THEN
  abortsize (1)
ELSE
  abortimmidbig (2)
END IF
isxrm

END SUB

'
'Decodes a mov E,R
'
SUB movER

IF thisfield(1).size = 0 THEN thisfield(1).size = thisfield(2).size

IF thisfield(2).size = byte AND thisfield(1).size = byte THEN
  result.opcodebytes = &O210
ELSEIF thisfield(2).size = word AND thisfield(1).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O211
ELSEIF thisfield(2).size = dword AND thisfield(1).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O211
ELSEIF thisfield(2).size > dword THEN
  abortsize (2)
ELSE
  abortnomatch
END IF
isxrm



END SUB

SUB movimmids
END SUB

SUB movmem

END SUB

'
'Decodes a mov R,- (source is not immid)
'
SUB movR

IF thisfield(2).types = Etype AND this.basereg = 0 AND this.indexreg = 0 AND thisfield(1).types = Atype THEN
    movAEdisp
ELSEIF thisfield(2).types <= Etype THEN
   movRE
ELSE
  abortnotvalid (2)
END IF

END SUB

'
'Decodes a mov R,E
'
SUB movRE

IF thisfield(2).size = 0 THEN thisfield(2).size = thisfield(1).size

IF thisfield(2).size = byte AND thisfield(1).size = byte THEN
  result.opcodebytes = &O212
ELSEIF thisfield(2).size = word AND thisfield(1).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O213
ELSEIF thisfield(2).size = dword AND thisfield(1).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O213
ELSEIF thisfield(2).size > dword THEN
  abortsize (2)
ELSE
  abortnomatch
END IF
isxrm


END SUB

'
'Decodes a mov R,I
'
SUB movRI



IF this.Rreg = -1 THEN this.Rreg = 0
IF thisfield(1).size = byte AND result.immidsize <= byte THEN
  result.opcodebytes = &O260 + this.Rreg
ELSEIF thisfield(1).size = word AND result.immidsize <= word THEN
  result.opcodebytes = &O270 + this.Rreg
  result.immidsize = word
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
ELSEIF thisfield(1).size = dword AND result.immidsize <= dword THEN
  result.opcodebytes = &O270 + this.Rreg
  result.immidsize = dword
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
ELSE
  abortimmidbig (2)
END IF




END SUB

'
'Decodes a mov R,SYSreg
'
SUB movRSYS

IF thisfield(1).size <> dword THEN abortnomatch

SELECT CASE thisfield(2).types
 
  CASE CRtype
  IF this.Ereg > 3 THEN abortnotvalid (2)
  result.opcodebytes = &HF00 OR &O40
 
  CASE DRtype
  IF this.Ereg > 3 AND (this.Ereg <> 6 OR this.Ereg <> 7) THEN abortnotvalid (2)
  result.opcodebytes = &HF00 OR &O41
 
  CASE TRtype
  IF (this.Ereg <> 6 OR this.Ereg <> 7) THEN abortnotvalid (2)
  result.opcodebytes = &HF00 OR &O44

END SELECT

IF this.Rreg = -1 THEN this.Rreg = 0
result.xrm = &O300 + this.Ereg * &O10 + this.Rreg




END SUB

'
'Decode mov instructions
'
SUB movs

IF thisfield(1).types >= CRtype OR thisfield(2).types >= CRtype THEN
  movsys
ELSEIF thisfield(1).types = Stype OR thisfield(2).types = Stype THEN
  movseg

ELSEIF thisfield(1).types <= Rtype THEN
  IF thisfield(2).types = Itype THEN movRI ELSE movR
ELSEIF thisfield(1).types = Etype THEN
  IF thisfield(2).types = Itype THEN movEI ELSE movE
ELSE
  abortstatement ("Fields for mov must be mem,immid or reg/sysreg/segreg")
END IF
END SUB

'
'Decodes a mov with a segreg field
'
SUB movseg

IF thisfield(1).types = Stype THEN                   'Sr,Es
  result.opcodebytes = &O214
  IF thisfield(2).types > Etype THEN abortnotvalid (2)
  IF thisfield(2).size <> word AND thisfield(2).size <> 0 THEN abortnomatch
  IF (this.Rreg = 1 OR this.Rreg > 5) THEN abortnotvalid (1)
ELSE                                                 'Es,Sr
  result.opcodebytes = &O216
  IF thisfield(1).types <= Rtype THEN
    SWAP this.Rreg, this.Ereg
  ELSEIF thisfield(1).types > Etype THEN
    abortnotvalid (1)
  END IF
  IF (thisfield(1).size <> word AND thisfield(1).size <> 0) THEN abortnomatch
  IF thisfield(1).types <= Rtype THEN SWAP this.Rreg, this.Ereg
  IF this.Rreg > 5 THEN abortnotvalid (2)
END IF
isxrm


END SUB

'
'Decodes a mov with a sysreg field
'
SUB movsys

IF thisfield(1).types <= Rtype THEN
  movRSYS
ELSEIF thisfield(1).types >= CRtype THEN
  movSYSR
ELSE
  abortnotvalid (1)
END IF

END SUB

'
'Decodes a mov SYSreg,R
'
SUB movSYSR

IF thisfield(2).size <> dword THEN abortnomatch

SELECT CASE thisfield(1).types

  CASE CRtype
  IF this.Ereg = 1 OR this.Ereg > 3 THEN abortnotvalid (1)
  result.opcodebytes = &HF00 OR &O42

  CASE DRtype
  IF this.Ereg > 3 AND (this.Ereg <> 6 OR this.Ereg <> 7) THEN abortnotvalid (2)
  result.opcodebytes = &HF00 OR &O43

  CASE TRtype
  IF (this.Ereg <> 6 OR this.Ereg <> 7) THEN abortnotvalid (2)
  result.opcodebytes = &HF00 OR &O46

END SELECT

result.xrm = &O300 + this.Ereg * &O10 + this.Rreg

END SUB

SUB movsysregs
END SUB

'
'Asks user for files to open and opens them
'
SUB openfiles

PCOPY 0, 3:
CLS :
OPEN "lst.asm" FOR OUTPUT AS #2
OPEN "lst.bas" FOR OUTPUT AS #3
PRINT #3, "SUB ASMCODE" + CHR$(13) + CHR$(10):
OPEN "lst.lst" FOR RANDOM AS #4
PCOPY 3, 0

END SUB

'
'Decodes an out statement
'
SUB outps

IF thisfield(2).size = byte THEN
  IF thisfield(1).types = Rtype THEN
    result.opcodebytes = &O356
  ELSEIF thisfield(1).types = Itype THEN
    result.opcodebytes = &O346
  ELSE
    abortnotvalid (1)
  END IF
ELSEIF thisfield(2).size = word THEN
  IF thisfield(1).types = Rtype THEN
    result.opcodebytes = &O357
  ELSEIF thisfield(1).types = Itype THEN
    result.opcodebytes = &O347
  ELSE
    abortnotvalid (1)
  END IF
ELSE
  abortsize (2)
END IF


END SUB

'
'Decodes a pop E
'
SUB popE

IF thisfield(1).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O217
ELSEIF thisfield(1).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O217
ELSEIF thisfield(1).size = 0 THEN
  result.opcodebytes = &O217
ELSE
  abortsize (1)
END IF
isxrm

END SUB

'
'Decodes a pop R
'
SUB popR

IF thisfield(1).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O130 + this.Rreg
ELSEIF thisfield(1).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O130 + this.Rreg
ELSE
  abortsize (1)
END IF

END SUB

'
'Decodes a pop
'
SUB pops

IF thisfield(1).types = Stype THEN
  popSeg
ELSEIF thisfield(1).types = Rtype THEN
  popR
ELSEIF thisfield(1).types <= Etype THEN
  popE
ELSE
  abortnotvalid (1)
END IF


END SUB

'
'Decodes a pop Seg
'
SUB popSeg

SELECT CASE this.Rreg
  CASE FS: result.opcodebytes = &HF00 OR &O241
  CASE GS: result.opcodebytes = &HF00 OR &O251
  CASE ES: result.opcodebytes = 7
  CASE DS, SS: result.opcodebytes = this.Rreg * &O10 + 7
  CASE ELSE: abortnotvalid (1)
END SELECT

END SUB

'
'Prints to the list swap file
'
'Format:=
'         result type AS
'         result.vid
'         result.offset etc..
'
SUB printobjlistscreen

'obj
result.offset = offset
PUT #4, asmlinenr, result

'screen,list
a$ = format4print$:
PRINT a$: PRINT #2, a$


END SUB

'
'Prints the resolved line
'
SUB printresolvedline (line2resolve)

off$ = HEX$(result.offset): off$ = STRING$(4 - LEN(off$), "0") + off$ + SPACE$(2)
ln$ = STR$(line2resolve): ln$ = STRING$(4 - LEN(ln$), " ") + ln$ + SPACE$(2)
PRINT ln$; off$; : result.offset = 0

IF result.wordsizeprefix THEN PRINT HEX$(result.wordsizeprefix); " "; : result.wordsizeprefix = 0
IF result.opcodebytes \ &H100 THEN PRINT "0"; HEX$((result.opcodebytes \ &H100) AND &HFF&); " ";
PRINT HEX$(result.opcodebytes AND &HFF); " "; : result.opcodebytes = 0
SELECT CASE result.immidsize
    CASE sbyte, byte:
      hexBy$ = HEX$(result.immid& AND &HFF):
      PRINT STRING$(2 - LEN(hexBy$), "0") + hexBy$;
    CASE word
      hexIn$ = HEX$(result.immid& AND &HFFFF):
      PRINT STRING$(4 - LEN(hexIn$), "0") + hexIn$;
    CASE dword
      hexLo$ = HEX$(result.immid)
      PRINT STRING$(8 - LEN(hexLo$), "0") + hexLo$;
END SELECT
PRINT , , "Resolved line!"
result.immid = 0: result.immidsize = 0

END SUB

'
'Sub prints the appropriate segment messages to both files and screen
'
SUB printsegmessages
COLOR 0, 7:
IF defseg.size = 2 THEN
  PRINT "IN 32";
  PRINT #2, "USE 32":
ELSE
  PRINT "IN 16";
  PRINT #2, "USE 16":
END IF

PRINT #3, "'QBASIC IN 32 BIT MODE ? I GUESS NOT!"

PRINT " BIT SEGMENT "; : COLOR 7, 0: PRINT SPACE$(40)

END SUB

'
'Decodes a push E
'
SUB pushE

IF thisfield(1).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O377
ELSEIF thisfield(1).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O377
ELSEIF thisfield(1).size = 0 THEN
  result.opcodebytes = &O377
ELSE
  abortsize (1)
END IF
this.Rreg = 6
isxrm




END SUB

'
'Decodes a push I
'
SUB pushI

IF result.immidsize = sbyte THEN
  result.opcodebytes = &O150
ELSEIF result.immidsize <= word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.immidsize = word
  result.opcodebytes = &O152
ELSEIF result.immidsize = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.immidsize = dword
  result.opcodebytes = &O152
ELSE
  abortsize (1)
END IF

END SUB

'
'Decodes a pushR
'
SUB pushR

IF thisfield(1).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O120 + this.Rreg
ELSEIF thisfield(1).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O120 + this.Rreg
ELSE
  abortsize (1)
END IF

END SUB

'
'Decodes push
'
SUB pushs

IF thisfield(1).types = Stype THEN
  pushseg
ELSEIF thisfield(1).types = Itype THEN
  pushI
ELSEIF thisfield(1).types = Rtype THEN
  pushR
ELSEIF thisfield(1).types <= Etype THEN
  pushE
ELSE
  abortnotvalid (1)
END IF

END SUB

'
'Decodes a push Seg
'
SUB pushseg

SELECT CASE this.Rreg
  CASE FS: result.opcodebytes = &HF00 OR &O240
  CASE GS: result.opcodebytes = &HF00 OR &O250
  CASE ES: result.opcodebytes = 6
  CASE CS, DS, SS: result.opcodebytes = 6 + this.Rreg * &O10
END SELECT


END SUB

'
'The REAL F-op fpu instructions
'
SUB REALf

IF thisfield(1).types = Etype THEN
  REALfE
ELSE
  REALfST
END IF

END SUB

'
'Decodes the REAL f-op arithmatics
'
SUB REALfa

IF thisfield(1).types = Etype THEN
  REALfaE
ELSE
  REALfaST
END IF



END SUB

'
'Decodes the REAL f-op arithmatics E
'
SUB REALfaE

result.opcodebytes = &O330
result.xrm = instructs(this.id).Pvalue
IF thisfield(1).size = qword THEN
  result.opcodebytes = result.opcodebytes + 4
ELSEIF thisfield(1).size = 0 AND defseg.size = 16 THEN
  result.opcodebytes = result.opcodebytes + 4
ELSEIF thisfield(1).size <> dword AND thisfield(1).size <> 0 THEN
  abortsize (1)
END IF
isxrm

END SUB

'
'Decodes the fpu f-real arithmatics  ST
'
SUB REALfaST

result.opcodebytes = &O330
IF this.nrfields = 0 THEN
  this.Rreg = 1
ELSEIF this.nrfields = 2 THEN
  IF this.Rreg = 0 THEN
    this.Rreg = this.Ereg
    result.opcodebytes = result.opcodebytes + 4
  ELSEIF this.Ereg <> 0 THEN
    abortstatement ("Either destiny or source must be ST[0]")
  END IF
END IF
isxrm

END SUB

'
'Decodes the REAL f-op E
'
SUB REALfE

SELECT CASE this.id
  CASE fld TO fstp: result.opcodebytes = &O331
  CASE fcmp, fcomp: result.opcodebytes = &O330
END SELECT

result.xrm = instructs(this.id).Pvalue
IF thisfield(1).size = qword THEN
  result.opcodebytes = result.opcodebytes + 4
ELSEIF thisfield(1).size = 0 AND defseg.size = 16 THEN
  result.opcodebytes = result.opcodebytes + 4
ELSEIF (this.id = fld OR this.id = fstp) AND thisfield(1).size = tbyte THEN
  result.opcodebytes = &O333
  result.xrm = result.xrm OR &O50
ELSEIF thisfield(1).size <> dword AND thisfield(1).size <> 0 THEN
  abortsize (1)
END IF
isxrm

END SUB

'
'Decodes the REAL F-OP ST[n]
'
SUB REALfST

SELECT CASE this.id
  CASE fld: result.opcodebytes = &O331
  CASE fst, fstp, fucom, fucomp: result.opcodebytes = &O335
END SELECT
result.xrm = &O300 + instructs(this.id).Pvalue + this.Rreg
result.xrmthere = 1

END SUB

'
'Decodes the fpu REAL P arithmatics ( ST[n],ST )
'
SUB REALp

IF this.nrfields = 0 THEN
  this.Ereg = 1
ELSEIF this.nrfields = 2 THEN
  IF this.Rreg <> 0 THEN abortnotvalid (2)
ELSE
  abortstatement ("1 field is not valid for fpu P-op aritmatics")
END IF
result.xrm = &O300 + instructs(this.id).Pvalue + this.Ereg
result.xrmthere = 1
result.opcodebytes = &O330

END SUB

'
'Resolves a forward referenced label
'
SUB resolveforward (line2resolve)

GET #4, line2resolve, result

SELECT CASE result.immidsize
  CASE short:
    result.immid = offset - 2 - result.offset
    IF bytesize(result.immid) > sbyte THEN abortrefsize
  CASE near, 0
    result.immid = offset - 3 - result.offset
    IF (result.opcodebytes \ &H100) THEN result.immid = result.immid - 1
    IF result.wordsizeprefix THEN result.immid = result.immid - 1
    IF bytesize(result.immid) > word THEN abortrefsize
  CASE near32
    result.immid = offset - 5 - result.offset
    IF (result.opcodebytes \ &H100) THEN result.immid = result.immid - 1
    IF result.wordsizeprefix THEN result.immid = result.immid - 1
    IF bytesize(result.immid) > dword THEN abortrefsize
END SELECT

PUT #4, line2resolve, result
printresolvedline (line2resolve)


END SUB

'
'Resolves a near jmp/jcc
'The extra substractions for 1) two byte opcode JCC, 2)wordsizeprefixs
'
SUB resolvenear16 (id, subextra)

result.immid = symboltable(id).value - offset - 3 - subextra
result.immidsize = bytesize(result.immid)
IF result.immidsize > near THEN abortsize (1) ELSE result.immidsize = near
END SUB

'
'Resolves a near 32 reference
'
SUB resolvenear32 (id, subextra)

result.immid = symboltable(id).value - offset - 5 - subextra
result.immidsize = bytesize(result.immid)
IF result.immidsize > near32 THEN abortsize (1) ELSE result.immidsize = near32

END SUB

'
'Resolves a short jmp/jcc
'
SUB resolveshort (id)

result.immid = symboltable(id).value - offset - 2
result.immidsize = bytesize(result.immid)
IF result.immidsize > short THEN abortsize (1) ELSE result.immidsize = short

END SUB

'
'Decodes a ret [Dw] or retf [Dw]
'
SUB rets

IF this.nrfields = 0 THEN
  result.opcodebytes = &O302 OR instructs(this.id).Pvalue
ELSEIF thisfield(1).types = Itype THEN
  result.opcodebytes = &O303 OR instructs(this.id).Pvalue
  result.immidsize = word
ELSE
  abortnotvalid (1)
END IF

END SUB

'
'Gets the firsttoken from the asmline
'
SUB selecttoken

tokenP = INSTR(asmline$, " ")
TABP = INSTR(asmline$, CHR$(9))
ColonP = INSTR(asmline$, ":")

IF tokenP = 0 THEN tokenP = LEN(asmline$) + 1
IF TABP > 0 AND TABP < tokenP THEN tokenP = TABP
IF ColonP > 0 AND ColonP < tokenP THEN
  token$ = LEFT$(asmline$, ColonP - 1)
  asmline$ = LTRIM$(MID$(asmline$, ColonP))
ELSE
  token$ = LEFT$(asmline$, tokenP - 1)
  asmline$ = LTRIM$(MID$(asmline$, tokenP + 1))
END IF

END SUB

'
'Decodes the setcc instructions
'
SUB setCCs

IF thisfield(1).types = 0 OR thisfield(1).types > Rtype THEN abortnotvalid (1)
IF thisfield(1).size <> byte THEN abortsize (1)

result.opcodebytes = &HF00 OR &H90 + instructs(this.id).Pvalue
isxrm


END SUB

'
'Decodes a shd E,R,CL
'
SUB shdCL

result.opcodebytes = &HF00 OR &O200 + instructs(this.id).Pvalue + 5


END SUB

'
'Decodes a shift E,R,I
'
SUB shdI

IF thisfield(1).size = word AND thisfield(2).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
ELSEIF thisfield(1).size = dword AND thisfield(2).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
ELSE
  abortnomatch
END IF
END SUB

'
'Decodes shrd/shld  E,R
'
SUB shds

IF thisfield(1).size = 0 THEN thisfield(1).size = thisfield(2).size 'field1=E

IF thisfield(2).types > Rtype THEN abortnotvalid (2)
IF thisfield(1).types > Etype THEN abortnotvalid (1)
IF thisfield(1).size < word OR thisfield(1).size > dword THEN abortsize (1)
IF thisfield(2).size < word OR thisfield(2).size > dword THEN abortsize (2)

IF thisfield(1).types <= Rtype THEN SWAP this.Rreg, this.Ereg 'first field=E

IF thisfield(3).types = Itype THEN
  result.opcodebytes = &HF00 OR &O200 + instructs(this.id).Pvalue + 4
ELSEIF thisfield(3).types = Rtype THEN
  result.opcodebytes = &HF00 OR &O200 + instructs(this.id).Pvalue + 5
ELSE
  abortnotvalid (3)
END IF

IF thisfield(1).size = word AND thisfield(2).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
ELSEIF thisfield(1).size = dword AND thisfield(2).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
ELSE
  abortnomatch
END IF

isxrm

END SUB

'
'Decodes a shift E,1
'
SUB shift1

result.immidsize = 0
IF thisfield(1).types > Etype THEN abortnotvalid (1)

IF thisfield(1).size <= byte THEN
  result.opcodebytes = &O320
ELSEIF thisfield(1).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O321
ELSEIF thisfield(1).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O321
ELSE
  abortsize (1)
END IF



END SUB

'
'Decodes a shift E,CL
'
SUB shiftCL

IF thisfield(1).types > Etype THEN abortnotvalid (1)

IF thisfield(1).size <= byte THEN
  result.opcodebytes = &O322
ELSEIF thisfield(1).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O323
ELSEIF thisfield(1).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O323
ELSE
  abortsize (1)
END IF


END SUB

'
'Decodes a shift E,I
'
SUB shiftI

IF thisfield(1).types > Etype THEN abortnotvalid (1)

IF thisfield(1).size <= byte THEN
  result.opcodebytes = &O300
ELSEIF thisfield(1).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O301
ELSEIF thisfield(1).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O301
ELSE
  abortsize (1)
END IF




END SUB

'
'Decodes shifts and rotations
'
SUB shifts

IF thisfield(1).size = 0 THEN thisfield(1).size = word
this.Ereg = this.Rreg

SELECT CASE thisfield(2).types
  CASE Rtype: shiftCL
  CASE Itype: shiftI
  CASE onetype: shift1
  CASE ELSE: abortnotvalid (2)
END SELECT
this.Rreg = instructs(this.id).Pvalue
isxrm

END SUB

'
'Recognizes a mem factor, store it to token$ and skip it
'
FUNCTION skipfactor$ (lnstring$)
addop$ = "+-": factor$ = LEFT$(lnstring$, 1)
IF INSTR(addop$, factor$) THEN
  token$ = factor$: skipfactor$ = skipwhite$(MID$(lnstring$, 2))
ELSE
  skipfactor$ = lnstring$
END IF

END FUNCTION

'
'Skips white after
'
FUNCTION skipRwhite$ (lnstring$)

lnstring$ = RTRIM$(lnstring$): l = LEN(lnstring$)
DO WHILE RIGHT$(lnstring$, 1) = CHR$(9)
   lnstring$ = LEFT$(lnstring$, l - 1)
LOOP
skipRwhite$ = lnstring$

END FUNCTION

'
'Skips white before
'
FUNCTION skipwhite$ (lnstring$)

lnstring$ = LTRIM$(lnstring$)
DO WHILE LEFT$(lnstring$, 1) = CHR$(9)
   lnstring$ = MID$(lnstring$, 2)
LOOP
skipwhite$ = lnstring$


END FUNCTION

'
'Stores a symbol in the symboltable
'Validates if its no duplicate..
'
SUB storesymbol (symtype, value)

symboltable(scount).names = name$
symboltable(scount).types = symtype
symboltable(scount).value = value      'for label:offset, forward:linenr
scount = scount + 1

END SUB

'
'Decodes bswap
'
SUB swapRd

IF thisfield(1).types > Rtype THEN abortnotvalid (1)
IF thisfield(1).size < dword THEN abortsize (1)

result.opcodebytes = &HF00 OR &O310 + this.Rreg

END SUB

'
'Decodes synchonizations
'
SUB synchr

IF thisfield(2).types = Itype THEN
  synchrEI
ELSEIF thisfield(2).types <= Rtype THEN
  synchrER
ELSE
  abortnotvalid (2)
END IF


END SUB

'
'Decodes a synchr E,I
'
SUB synchrEI



IF thisfield(1).size = 0 THEN
  IF result.immidsize < dword THEN thisfield(1).size = word ELSE thisfield(1).size = dword
END IF

IF thisfield(1).size = word AND result.immidsize <= byte THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &HF00 OR &O272
ELSEIF thisfield(1).size = dword AND result.immidsize <= dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &HF00 OR &O272
ELSEIF thisfield(1).size > dword OR thisfield(1).size < word THEN
  abortsize (1)
ELSE
  abortsize (2)
END IF

this.Ereg = this.Rreg: this.Rreg = instructs(this.id).Pvalue
isxrm

END SUB

'
'Decodes a synchr E,R( memsize=0 handled by OR)
'
SUB synchrER

IF (thisfield(1).size OR thisfield(2).size) = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &HF00 OR &O203 + instructs(this.id).Pvalue * &O10
ELSEIF (thisfield(1).size OR thisfield(2).size) = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &HF00 OR &O203 + instructs(this.id).Pvalue * &O10
ELSE
  abortnomatch
END IF
isxrm

END SUB

'
'Decodes system instructions E
'
SUB systems

IF thisfield(1).types > Etype THEN abortnotvalid (1)
IF thisfield(1).size <> word THEN abortsize (1)

result.opcodebytes = &HF00
this.Ereg = this.Rreg
this.Rreg = instructs(this.id).Pvalue
isxrm

END SUB

'
'Decodes a test instruction
'
SUB testlogic

IF thisfield(2).types = Itype THEN
  testlogicI                                       ' ,I
ELSEIF thisfield(2).types <= Etype THEN            ' ,E
  IF thisfield(1).types <= Rtype THEN
    testlogicRE                                    'R,E
  ELSE
    abortnotvalid (1)
  END IF
ELSE
  abortnotvalid (2)
END IF


END SUB

'
'Decodes a test A,I
'
SUB testlogicAI

IF thisfield(1).size = byte AND result.immidsize <= byte THEN
    result.opcodebytes = &O250
ELSEIF thisfield(1).size = word AND result.immidsize <= word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.immidsize = word
  result.opcodebytes = &O251
ELSEIF thisfield(1).size = dword AND result.immidsize <= dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.immidsize = dword
  result.opcodebytes = &O251
ELSE
  abortimmidbig (2)
END IF


END SUB

'
'Decodes a test E,I
'
SUB testlogicEI
IF thisfield(1).size = 0 THEN
  IF result.immidsize < dword THEN thisfield(1).size = word ELSE thisfield(1).size = dword
END IF


IF thisfield(1).size <= byte AND result.immidsize <= byte THEN
  result.opcodebytes = &O366
ELSEIF thisfield(1).size = word AND result.immidsize <= word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.immidsize = word
  result.opcodebytes = &O367
ELSEIF thisfield(1).size = dword AND result.immidsize <= dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.immidsize = dword
  result.opcodebytes = &O367
ELSEIF thisfield(1).size > dword THEN
  abortsize (1)
ELSE
  abortimmidbig (2)
END IF
isxrm
   
END SUB

'
'Decodes a test instruction with source I
'
SUB testlogicI

IF thisfield(1).types = Atype THEN
  testlogicAI
ELSEIF thisfield(1).types <= Etype THEN
  testlogicEI
ELSE
  abortnotvalid (1)
END IF


END SUB

'
'Decodes a test R,E
'
SUB testlogicRE
 
IF thisfield(2).size = 0 THEN thisfield(2).size = thisfield(1).size

IF thisfield(2).size = byte AND thisfield(1).size = byte THEN
  result.opcodebytes = &O204
ELSEIF thisfield(2).size = word AND thisfield(1).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O205
ELSEIF thisfield(2).size = dword AND thisfield(1).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O205
ELSEIF thisfield(2).size > dword THEN
  abortsize (2)
ELSE
  abortnomatch
END IF
isxrm


END SUB

'
'If needed swaps base and index
'
'Validates: both base and index are 16 bit
'           base nor index is sp
'           not two base or two indexregs
'
'
SUB validate16regs

'Validate for bx,bp, dx,di

IF this.basereg = SP OR this.indexreg = SP THEN CALL abortstatement("sp reference not allowed in 16 bit memref")

'Since bx or bp is maybe coded as indexreg, we will have maybe to do some swap in 16 bit

IF this.indexreg = BX OR this.indexreg = BP THEN SWAP this.indexreg, this.basereg
IF this.basereg >= SI THEN CALL abortstatement("Two index registers in memref") 'si,di
IF this.indexreg <= BP THEN CALL abortstatement("Two base registers in memref") 'bx,bp


END SUB

'
'Validates for being valid 32 bit index AND baseregister
'
SUB validate32regs

IF this.indexreg = ESP THEN CALL abortstatement("esp not allowed as indexreg")
IF this.basereg > 0 AND (this.basereg < 0 OR this.basereg > edi) THEN CALL abortstatement("Basereg is not a valied 32 bit memref")
IF this.indexreg > 0 AND (this.indexreg < 0 OR this.indexreg > edi) THEN CALL abortstatement("Indexreg is not a valid 32 bit memref")

END SUB

'
'Validates the adress size
'
SUB validateadressize

IF this.memsize = 16 AND defseg.size = 32 OR this.memsize = 32 AND defseg.size = 16 THEN
  result.adressprefix = adressizechange
END IF

END SUB

'
'Translates a bin string
'
FUNCTION validatebin& (binstring$)

factor$ = LEFT$(binstring$, 1)
IF INSTR("+-", factor$) THEN binstring$ = MID$(binstring$, 2)
LENGTH = LEN(binstring$)

FOR i = LENGTH TO 1 STEP -1
 TARGET$ = MID$(binstring$, i, 1)
 IF isbin(TARGET$) = 0 THEN abortstatement (binstring$ + " IS NOT A VALID BINAIR REFERENCE")
 IF TARGET$ = "1" THEN runningsum& = runningsum& + 2 ^ (LENGTH - i)
NEXT

IF factor$ = "-" THEN validatebin& = -runningsum& ELSE validatebin& = runningsum&


END FUNCTION

'
'Validates the size of a C field
'
SUB validateCfieldsize

END SUB

'
'Translates a decimal string
'
FUNCTION validatedec& (decstring$)

factor$ = LEFT$(decstring$, 1)
IF INSTR("+-", factor$) THEN decstring$ = MID$(decstring$, 2) ELSE factor$ = ""

FOR i = 1 TO LEN(decstring$)
 IF isdigit(MID$(decstring$, i, 1)) = 0 THEN
  abortstatement (decstring$ + " IS NOT A VALID DECIMAL REFERENCE")
 END IF
NEXT
validatedec& = VAL(factor$ + decstring$)


END FUNCTION

'
'Translates a hexstring
'
FUNCTION validatehex& (hexstring$)

factor$ = LEFT$(hexstring$, 1)
IF INSTR("+-", factor$) THEN hexstring$ = MID$(hexstring$, 2) ELSE factor$ = ""

FOR i = 1 TO LEN(hexstring$)
 IF ishex(MID$(hexstring$, i, 1)) = 0 THEN
  abortstatement (hexstring$ + " IS NOT A VALID HEXADECIMAL REFERENCE")
 END IF
NEXT

validatehex& = VAL("&H" + factor$ + hexstring$)

END FUNCTION

'
'Validates the immidiate size against the segdef for push immid
'Writes:wordsizeprefix
'
SUB validateimmidsize

IF (result.immid& > &H7FFF OR result.immid& < &HFFFF8000) AND defseg.size = 1 THEN
  result.wordsizeprefix = wordsizechange:
ELSEIF result.immidsize = 3 AND defseg.size = 2 THEN
  result.wordsizeprefix = wordsizechange
END IF


END SUB

'
'Validates and performs action on recognized memoperands
'Validates:regsizes, memreg sizes,
'
SUB validatememoperand (operandid)

SELECT CASE operandid
 
  CASE &O10, &O1 TO &O7, &O100 TO &O107, &O200 TO &O207, &O300 TO &O307'32 bitregs
 
  IF this.memsize = 16 THEN CALL abortstatement("Mixed reference of 16 bit and 32 bit regs in" + fields$(fieldnr))
  IF this.basereg <> 0 AND this.indexreg <> 0 THEN
    abortstatement ("To many registers in pointer" + fields$(fieldnr))
  ELSEIF this.indexreg > 0 AND (operandid AND &O700) > 0 THEN
    abortstatement ("To many scalar operations in pointer" + fields$(fieldnr))
  ELSEIF (operandid AND &O700) > 0 OR this.basereg > 0 THEN
    this.indexreg = operandid  ''LATER SCHEIDEN VAN SCALAR( NU: EAX=&011)
  ELSE
    this.basereg = operandid 'eax0=&011
  END IF
  this.memsize = 32
 
  CASE 10 TO 17    '16 bitregs
 
  IF this.memsize = 32 THEN CALL abortstatement("Mixed reference of 16 bit and 32 bit regs in" + fields$(fieldnr))
 
  IF this.indexreg > 0 AND this.basereg > 0 THEN
    abortstatement ("To many registers in pointer" + fields$(fieldnr))
  ELSEIF this.basereg > 0 AND operandid < 16 THEN
    abortstatement ("Two base registers registers in pointer" + fields$(fieldnr))
  ELSEIF this.indexreg > 0 AND operandid > 15 THEN
    abortstatement ("Two index registers registers in pointer" + fields$(fieldnr))
  ELSEIF operandid > 15 THEN
    this.indexreg = operandid - 10
  ELSE
    this.basereg = operandid - 10
  END IF
 
  CASE 19 TO 27    'segs

  result.segmentprefix = segoverride(operandid - 20)
 
  'b/w/d/qw/tb ptr
  CASE 31: thisfield(fieldnr).size = sbyte
  CASE 32: thisfield(fieldnr).size = byte
  CASE 33: thisfield(fieldnr).size = word
  CASE 34: thisfield(fieldnr).size = dword
  CASE 38: thisfield(fieldnr).size = qword
  CASE 40: thisfield(fieldnr).size = tbyte
 
  'f/n/s ptr
 
  CASE 51: thisfield(fieldnr).size = short
  CASE 52: thisfield(fieldnr).size = near
  CASE 54: thisfield(fieldnr).size = far
  CASE 53: thisfield(fieldnr).size = near32
  CASE 55: thisfield(fieldnr).size = far32

 
  CASE 60         'immid
  result.displacement = result.displacement + immid&(token$)
  IF result.displacement THEN result.dispsize = bytesize(result.displacement)
  IF result.dispsize > word THEN
    IF this.memsize = 16 THEN CALL abortstatement("Displacement to big in 16 adress size of " + fields$(fieldnr))
    this.memsize = 32
  END IF
  'operandid = result.displacement'tijdelijk

  CASE 61         'must be a symbol  dit nog niet, ook nog tegen reserved Keyw checken,,
  symbolid = insymboltable
  IF symbolid THEN
    result.displacement = result.displacement + symboltable(symbolid).value
  ELSE             'must be forward reference
    'result.forwarddisp = 1     'nieuwe bij constanten ad1,ad2 mov ax,ad1+ad2 maar
  END IF                       'maar niet bij vars alleen mov ax,ad1
END SELECT                     'dus 1 variable ,meerder constanten


'PRINT "Op: ";
'PRINT USING "\      \"; token$;
'PRINT " is: ";
'PRINT USING "###"; operandid;
'PRINT , mem$

END SUB

'
'Validates the number of fields against the max in instructs().nrfields
'
SUB validatenrfields

SELECT CASE this.id
  CASE imul
  IF fieldnr > 3 OR fieldnr < 1 THEN abortstatement ("IMUL can not have " + STR$(fieldnr) + " fields")
 
  CASE ret, retf, aam, aad
  IF fieldnr > 1 THEN abortstatement ("Ret, retf, aam or aad can not have more then one field")
 
  CASE fiadd TO fidivr, faddp TO fdivrp
  IF fieldnr > 2 THEN abortstatement ("Fpu arithmatics expect not more then two fields")
 
  CASE ELSE
  IF fieldnr <> instructs(this.id).nrfields THEN abortstatement (instructs(this.id).names + " can not have " + STR$(fieldnr) + " fields")

END SELECT
this.nrfields = fieldnr

END SUB

'
'validates a prefix against the default segment
'
'
SUB validatesegprefix (regs)

IF regs = BP OR regs = BP OR regs = EBP OR regs = ESP THEN
   IF result.segmentprefix = segss THEN result.segmentprefix = 0:
ELSE
   IF result.segmentprefix = segds THEN result.segmentprefix = 0:
END IF

END SUB

'
'Validates the default wordsize for WORD and DWORD instructions without fields
'Writes : result.wordsizeprefix
'Validates: defseg.size
'
SUB validatewordsizeinstr

SELECT CASE this.id:
 
CASE movsd, lodsd, stosd, cmpsd, scasd, cwde, cdq, iretd, popfd, pushfd, pushad, popad
IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange

CASE movsw, lodsw, stosw, cmpsw, scasw, cbw, cwd, iret, pushf, popf, pusha, popa
IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange

END SELECT


END SUB

'
'gets a value from the user
'
SUB valueinput (message$, var, nrsallowed)

PRINT message$;
l = CSRLIN: c = POS(1)
DO
  LOCATE l, c: PRINT SPACE$(10); : LOCATE l, c:
  INPUT " "; var
LOOP UNTIL var > 0 AND var < nrsallowed + 1

END SUB

'
'Translates to 32 bit xrm and disp bytes
'Writes:  xrm
'Validates: result.segmentprefix, this.basereg=esp, result.dispsize
'
SUB write32base

IF this.basereg = ESP0 THEN
  result.sib = &O44:  result.dispsize = 1     'esp=esp+0  =>set sib to &O44
ELSEIF this.basereg = EAX0 THEN
  this.basereg = 0
END IF

result.xrm = result.xrm + &O10 * (this.Rreg) + (this.basereg)     'adds rm to Pvalue
 
SELECT CASE result.dispsize              'writes x
 
  CASE 0: result.xrm = result.xrm + &O0                               'xrm only
  CASE sbyte: result.xrm = result.xrm + &O100:                        'xrm+dc(1)
  CASE IS >= byte: result.xrm = result.xrm + &O200: result.dispsize = dword'xmr+dw(4)
 
END SELECT


CALL validatesegprefix(this.basereg)

END SUB

'
'Translates to 32 bit xrm and disp bytes
'Writes: xrm
'Validates:result.segmentprefix
'
SUB write32displacement

result.xrm = result.xrm + &O10 * (this.Rreg) + &O6: result.dispsize = dword
IF result.segmentprefix = segds THEN result.segmentprefix = 0:

END SUB

'
'Translates the base reference to machinelanguage
'
'Writes: xrm
'Validates: result.segmentprefix, result.dispsize,bx/bp/di/si
'
SUB writebase

IF this.basereg = BP AND result.dispsize = 0 THEN result.dispsize = 1'bp+0-exception: translate to bp+0

result.xrm = result.xrm + this.Rreg * &O10    'adds r to Pvalue

SELECT CASE result.dispsize                                 'adds x
  CASE 0: result.xrm = &O0 + result.xrm                     'xrm
  CASE sbyte: result.xrm = &O100 + result.xrm               'xrm+Dc(1)
  CASE byte, word: result.xrm = &O200 + result.xrm: result.dispsize = word'xrm+Dw(2)
  CASE dword: CALL abortstatement("displacement to big in 16 bit memref")
END SELECT

SELECT CASE this.basereg                   'adds m
  CASE BP: result.xrm = result.xrm + &O6
  CASE BX: result.xrm = result.xrm + &O7
END SELECT

CALL validatesegprefix(this.basereg)

END SUB

'
'Translates the 16 bit base+index reference to xrm{+disp)
'Writes: xrm
'Validates: result.segmentprefix,displacementsize, this.base and this.indexreg
'
SUB writebaseindex

validate16regs

result.xrm = result.xrm + this.Rreg * &O10  'adds r to Pvalue

SELECT CASE result.dispsize               'adds x
  CASE 0: result.xrm = &O0 + result.xrm               'xrm
  CASE sbyte: result.xrm = &O100 + result.xrm         'xrm+Dc(1)
  CASE byte, word: result.xrm = &O200 + result.xrm: result.dispsize = word'xrm+Dw(2)
  CASE dword: CALL abortstatement("displacement to big in 16 bit memref")
END SELECT

IF this.basereg = BX AND this.indexreg = SI THEN  'adds m
 result.xrm = result.xrm + &O0
ELSEIF this.basereg = BX AND this.indexreg = DI THEN
  result.xrm = result.xrm + &O1
ELSEIF this.basereg = BP AND this.indexreg = SI THEN
  result.xrm = result.xrm + &O2
ELSEIF this.basereg = BP AND this.indexreg = DI THEN
  result.xrm = result.xrm + &O3
ELSEIF this.indexreg = SI THEN
  result.xrm = result.xrm + &O4
ELSEIF this.indexreg = DI THEN
  result.xrm = result.xrm + &O5
END IF

CALL validatesegprefix(this.basereg)
CALL validatesegprefix(this.indexreg)


END SUB

'
'Translates to 16 bit xrm and disp bytes
'Writes: result.xrm and result.dispsize
'Validates: result.segmentprefix
'
SUB writedisplacement

result.xrm = result.xrm + &O10 * this.Rreg + 6: result.dispsize = word
IF result.segmentprefix = segds THEN result.segmentprefix = 0:

END SUB

'
'Translates the two register fields to machine language.
'Validates :wordregsizes
'
SUB writeregs

IF this.Ereg = -1 THEN this.Ereg = 0
result.xrm = result.xrm + &O300 + this.Rreg * &O10 + this.Ereg

END SUB

'
'Translates to 32 bit xrm and sib and disp bytes
'IN    : this.indexreg > 0
'writes: xrm, sib
'Validates: result.segmentprefix,this.scalar,displacementsize,
'           this.indexreg=esp, ebp+0,this.indexreg and this.basereg=32bit
'
SUB writescaledindex

result.sibthere = 1
result.sib = this.indexreg AND &O770: this.indexreg = this.indexreg AND &O7

IF result.dispsize = 0 AND this.basereg = EBP THEN result.dispsize = 1                                  'ebp:=ebp+00

result.xrm = result.xrm + this.Rreg * &O10 + 4      'adds rm to Pvalue

SELECT CASE result.dispsize                                     'adds x
  CASE 0: result.xrm = result.xrm                                   'xrm only
  CASE sbyte: result.xrm = &O100 + result.xrm                       'xrm +Dc
  CASE IS >= byte: result.xrm = &O200 + result.xrm: result.dispsize = dword'xrm +Dw
END SELECT

'complete sib byte
IF this.basereg = 0 THEN
  this.basereg = EBP     'index only uses bp_alias
ELSEIF this.basereg = &O10 THEN
  this.basereg = 0
END IF

result.sib = result.sib + &O10 * this.indexreg + this.basereg 'writes i+r

validate32regs
CALL validatesegprefix(this.basereg)
CALL validatesegprefix(this.indexreg)

END SUB

'
'Decodes xadd,cmpxchg
'
SUB xaddcmpx

IF thisfield(1).types > Etype THEN abortnotvalid (1)
IF thisfield(2).types > Rtype THEN abortnotvalid (2)

IF (thisfield(1).size OR thisfield(2).size) = byte THEN
  result.opcodebytes = &HF00 OR instructs(this.id).Pvalue
ELSEIF (thisfield(1).size OR thisfield(2).size) = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &HF00 OR instructs(this.id).Pvalue + 1
ELSEIF (thisfield(1).size OR thisfield(2).size) = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &HF00 OR instructs(this.id).Pvalue + 1
ELSEIF thisfield(2).size > dword THEN
  abortsize (2)
ELSE
  abortnomatch
END IF
isxrm


END SUB

'
'Decodes a xchg Aw,R
'
SUB xchgAR

IF this.Ereg = -1 THEN this.Ereg = 0
IF thisfield(1).size = word AND thisfield(2).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O220 OR this.Ereg
ELSEIF thisfield(1).size = dword AND thisfield(2).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O220 OR this.Ereg
ELSE
  abortnomatch
END IF


END SUB

'
'Decodes a xchg R,E
'
SUB xchgRE

IF thisfield(2).size = 0 THEN thisfield(2).size = thisfield(1).size

IF thisfield(1).size = byte AND thisfield(2).size = byte THEN
  result.opcodebytes = &O206
ELSEIF thisfield(2).size = word AND thisfield(2).size = word THEN
  IF defseg.size = 32 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O207
ELSEIF thisfield(2).size = dword AND thisfield(2).size = dword THEN
  IF defseg.size = 16 THEN result.wordsizeprefix = wordsizechange
  result.opcodebytes = &O207
ELSE
  abortnomatch
END IF
isxrm

END SUB

'
'Decodes an xchg
'
SUB xchgs

IF thisfield(1).types = Atype AND thisfield(2).types <= Rtype THEN
  xchgAR
ELSEIF thisfield(1).types > Rtype THEN
  abortnotvalid (1)
ELSEIF thisfield(2).types > Etype THEN
  abortnotvalid (2)
ELSE
  xchgRE
END IF
END SUB

