From 84a31730e689e55b0a78592ad15913f23e9c30b2 Mon Sep 17 00:00:00 2001 From: 0rphee <0rph3e@proton.me> Date: Thu, 1 Aug 2024 09:15:47 -0600 Subject: [PATCH] Squash merge golden-tests into main --- app/Main.hs | 12 +- asmh.cabal | 9 +- src/Bin.hs | 72 +++--- src/Expr.hs | 97 +++++++- src/Parser.hs | 26 +- test/Spec.hs | 102 ++++---- test/data/asm/HexConvertor.asm | 121 ++++++++++ test/data/asm/calc.asm | 357 +++++++++++++++++++++++++++ test/data/asm/colors.asm | 75 ++++++ test/data/asm/colors.com | Bin 0 -> 75 bytes test/data/asm/factorial.asm | 336 ++++++++++++++++++++++++++ test/data/asm/fahrenheit.asm | 87 +++++++ test/data/asm/keybrd.asm | 58 +++++ test/data/asm/mouse.asm | 171 +++++++++++++ test/data/asm/robot.asm | 171 +++++++++++++ test/data/asm/stepper_motor.asm | 87 +++++++ test/data/emu8086/calc.com | Bin 0 -> 518 bytes test/data/emu8086/celsi.com | Bin 0 -> 95 bytes test/data/emu8086/colors.bin | Bin 0 -> 75 bytes test/data/emu8086/colors.com | Bin 0 -> 75 bytes test/data/emu8086/fact.com | Bin 0 -> 475 bytes test/data/emu8086/hex.com | Bin 0 -> 137 bytes test/data/emu8086/keybrd.com | Bin 0 -> 176 bytes test/data/emu8086/mouse.com | Bin 0 -> 858 bytes test/data/extra/calc.com.debug | Bin 0 -> 8616 bytes test/data/extra/calc.com.list | 388 ++++++++++++++++++++++++++++++ test/data/extra/calc.com.symbol | 43 ++++ test/data/extra/celsi.com.debug | Bin 0 -> 2136 bytes test/data/extra/celsi.com.list | 107 ++++++++ test/data/extra/celsi.com.symbol | 16 ++ test/data/extra/fact.com.debug | Bin 0 -> 8112 bytes test/data/extra/fact.com.list | 362 ++++++++++++++++++++++++++++ test/data/extra/fact.com.symbol | 44 ++++ test/data/extra/hex.com.debug | Bin 0 -> 2928 bytes test/data/extra/hex.com.list | 140 +++++++++++ test/data/extra/hex.com.symbol | 22 ++ test/data/extra/keybrd.com.debug | Bin 0 -> 1440 bytes test/data/extra/keybrd.com.list | 87 +++++++ test/data/extra/keybrd.com.symbol | 11 + test/data/extra/mouse.com.debug | Bin 0 -> 4152 bytes test/data/extra/mouse.com.list | 245 +++++++++++++++++++ test/data/extra/mouse.com.symbol | 51 ++++ 42 files changed, 3189 insertions(+), 108 deletions(-) create mode 100644 test/data/asm/HexConvertor.asm create mode 100644 test/data/asm/calc.asm create mode 100644 test/data/asm/colors.asm create mode 100644 test/data/asm/colors.com create mode 100644 test/data/asm/factorial.asm create mode 100644 test/data/asm/fahrenheit.asm create mode 100644 test/data/asm/keybrd.asm create mode 100644 test/data/asm/mouse.asm create mode 100644 test/data/asm/robot.asm create mode 100644 test/data/asm/stepper_motor.asm create mode 100755 test/data/emu8086/calc.com create mode 100755 test/data/emu8086/celsi.com create mode 100644 test/data/emu8086/colors.bin create mode 100755 test/data/emu8086/colors.com create mode 100755 test/data/emu8086/fact.com create mode 100755 test/data/emu8086/hex.com create mode 100755 test/data/emu8086/keybrd.com create mode 100755 test/data/emu8086/mouse.com create mode 100755 test/data/extra/calc.com.debug create mode 100755 test/data/extra/calc.com.list create mode 100755 test/data/extra/calc.com.symbol create mode 100755 test/data/extra/celsi.com.debug create mode 100755 test/data/extra/celsi.com.list create mode 100755 test/data/extra/celsi.com.symbol create mode 100755 test/data/extra/fact.com.debug create mode 100755 test/data/extra/fact.com.list create mode 100755 test/data/extra/fact.com.symbol create mode 100755 test/data/extra/hex.com.debug create mode 100755 test/data/extra/hex.com.list create mode 100755 test/data/extra/hex.com.symbol create mode 100755 test/data/extra/keybrd.com.debug create mode 100755 test/data/extra/keybrd.com.list create mode 100755 test/data/extra/keybrd.com.symbol create mode 100755 test/data/extra/mouse.com.debug create mode 100755 test/data/extra/mouse.com.list create mode 100755 test/data/extra/mouse.com.symbol diff --git a/app/Main.hs b/app/Main.hs index 2b5978f..18a689d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -6,17 +6,13 @@ import Data.Text (Text) import Data.Text qualified as T import Data.Text.IO qualified as T import Parser qualified -import Path +import Text.Megaparsec.Error (errorBundlePretty) main :: IO () main = do (Options sourceCodePath) <- runCmdOptions putStrLn $ "FILEPATH: " <> sourceCodePath assemblyCode <- T.readFile sourceCodePath - -- T.putStrLn assemblyCode - -- T.putStrLn $ T.replicate 10 "-" - mayStatements <- Parser.mainLocal assemblyCode - case mayStatements of - Nothing -> T.putStrLn "No results to be written" - Just statements -> do - writeBin sourceCodePath statements + case Parser.parseAssembly sourceCodePath assemblyCode of + Left e -> putStrLn $ errorBundlePretty e + Right statements -> writeBin sourceCodePath statements diff --git a/asmh.cabal b/asmh.cabal index e9db9e2..6b944e4 100644 --- a/asmh.cabal +++ b/asmh.cabal @@ -33,7 +33,6 @@ common common-options -funbox-strict-fields -fexpose-all-unfoldings -threaded - -with-rtsopts=-N -Wunused-packages default-extensions: @@ -64,12 +63,16 @@ library megaparsec, path, text, + text-display, vector, executable asmh import: common-options + ghc-options: + -with-rtsopts=-N + hs-source-dirs: app @@ -87,6 +90,7 @@ executable asmh cereal, filepath, githash, + megaparsec, optparse-applicative, path, text, @@ -110,8 +114,11 @@ test-suite asmh-test base >=4.7 && <5, bits-show, bytestring, + filepath, megaparsec, tasty, + tasty-golden, tasty-hunit, tasty-quickcheck, text, + text-display, diff --git a/src/Bin.hs b/src/Bin.hs index 6040467..ddfc8c2 100644 --- a/src/Bin.hs +++ b/src/Bin.hs @@ -1,19 +1,18 @@ {-# LANGUAGE OverloadedRecordDot #-} -module Bin (writeBin) where +module Bin (writeBin, compileStatements) where import Data.ByteString (ByteString) import Data.ByteString qualified as B +import Data.Char (ord) import Data.Map (Map) import Data.Map qualified as M import Data.Serialize.Put -import Data.Text (Text) import Data.Text qualified as T import Data.Text.IO qualified as T import Data.Vector (Vector) import Data.Vector qualified as V import Data.Word -import Debug.Trace import Expr import System.FilePath @@ -89,46 +88,51 @@ trans labelMap instrLoc = \case Just v -> v putAsW8 :: RawValue -> Put = putWord8 . \case - W8 w -> w - W16 w -> fromIntegral w - IntOrChar w -> fromIntegral w + RW8 w -> w + RW16 w -> fromIntegral w + RInt w -> fromIntegral w + RChar w -> fromIntegral $ ord w putAsW16 :: RawValue -> Put = putWord16le . \case - W8 w -> fromIntegral w - W16 w -> w - IntOrChar w -> fromIntegral w + RW8 w -> fromIntegral w + RW16 w -> w + RInt w -> fromIntegral w + RChar w -> fromIntegral $ ord w -firstPass :: [Statement] -> ProgramInfo -firstPass ls = go ls 0 (ProgramInfo mempty mempty mempty) +compileStatements :: [Statement] -> ByteString +compileStatements = secondPass . firstPass where - go :: [Statement] -> Int -> ProgramInfo -> ProgramInfo - go [] _offset accum = accum - go (x : xs) offset acc = case x of - Ins newInstr -> - let newOffset = offset + getInstOffset newInstr - in go xs newOffset $ acc {instructions = V.snoc acc.instructions newInstr} - Dir newDir -> go xs offset $ acc {directives = V.snoc acc.directives newDir} - Lab newLabel -> - case xs of - (Ins _ : _) -> - let newInstrPos = offset - in go xs offset $ acc {labels = M.insert newLabel newInstrPos acc.labels} - _ -> error "there must be a label after an instruction" + firstPass :: [Statement] -> ProgramInfo + firstPass ls = go ls 0 (ProgramInfo mempty mempty mempty) + where + go :: [Statement] -> Int -> ProgramInfo -> ProgramInfo + go [] _offset accum = accum + go (x : xs) offset acc = case x of + Ins newInstr -> + let newOffset = offset + getInstOffset newInstr + in go xs newOffset $ acc {instructions = V.snoc acc.instructions newInstr} + Dir newDir -> go xs offset $ acc {directives = V.snoc acc.directives newDir} + Lab newLabel -> + case xs of + (Ins _ : _) -> + let newInstrPos = offset + in go xs offset $ acc {labels = M.insert newLabel newInstrPos acc.labels} + _ -> error "there must be a label after an instruction" -secondPass :: ProgramInfo -> ByteString -secondPass = runPut . go 0 - where - go offset p = case V.uncons p.instructions of - Just (nextInstruction, rest) -> do - let nextInstructionIndex = offset + getInstOffset nextInstruction - trans p.labels nextInstructionIndex nextInstruction - go nextInstructionIndex (p {instructions = rest}) - Nothing -> pure () + secondPass :: ProgramInfo -> ByteString + secondPass = runPut . go 0 + where + go offset p = case V.uncons p.instructions of + Just (nextInstruction, rest) -> do + let nextInstructionIndex = offset + getInstOffset nextInstruction + trans p.labels nextInstructionIndex nextInstruction + go nextInstructionIndex (p {instructions = rest}) + Nothing -> pure () writeBin :: FilePath -> [Statement] -> IO () writeBin originalFileName instr = do let newFileName = takeBaseName originalFileName <> ".com" - let binaryFile = secondPass $ firstPass instr + let binaryFile = compileStatements instr B.writeFile newFileName binaryFile T.putStrLn $ "Output written to " <> T.pack newFileName diff --git a/src/Expr.hs b/src/Expr.hs index 15083b5..abf3420 100644 --- a/src/Expr.hs +++ b/src/Expr.hs @@ -6,11 +6,17 @@ module Expr , Operand (..) , Instruction (..) , Directive (..) + , ToHexString (..) ) where +import Bits.Show (showFiniteBits) +import Data.String (IsString (..)) import Data.Text (Text) +import Data.Text.Display +import Data.Text.Lazy.Builder (Builder) import Data.Word +import Numeric (showHex) import Prelude hiding (take) data Register @@ -48,12 +54,41 @@ data Register DH deriving (Show, Eq) +instance Display Register where + {-# INLINE displayBuilder #-} + displayBuilder = \case + AX -> "AX" + BX -> "BX" + CX -> "CX" + DX -> "DX" + SI -> "SI" + DI -> "DI" + BP -> "BP" + SP -> "SP" + AL -> "AL" + BL -> "BL" + CL -> "CL" + DL -> "DL" + AH -> "AH" + BH -> "BH" + CH -> "CH" + DH -> "DH" + data RawValue - = W8 Word8 - | W16 Word16 - | IntOrChar Int + = RW8 Word8 + | RW16 Word16 + | RInt Int + | RChar Char deriving (Show, Eq) +instance Display RawValue where + {-# INLINE displayBuilder #-} + displayBuilder = \case + RW8 w -> fromString (toHexString w) <> "b" + RW16 w -> fromString (toHexString w) <> "b" + RInt w -> displayBuilder w + RChar w -> "'" <> displayBuilder w <> "'" + type Label = Text data Statement @@ -62,6 +97,13 @@ data Statement | Lab Label deriving (Show, Eq) +instance Display Statement where + {-# INLINE displayBuilder #-} + displayBuilder = \case + Ins x -> displayBuilder x + Dir x -> displayBuilder x + Lab x -> displayBuilder x + data Operand = RegOp Register | ImmOp RawValue @@ -69,6 +111,13 @@ data Operand -- TODO: proper memory addresses deriving (Show, Eq) +instance Display Operand where + {-# INLINE displayBuilder #-} + displayBuilder = \case + RegOp x -> displayBuilder x + ImmOp x -> displayBuilder x + MemOp x -> "[" <> displayBuilder x <> "]" + data Instruction = MOV Operand Operand | ADD Operand Operand @@ -83,9 +132,51 @@ data Instruction | RET deriving (Show, Eq) +instance Display Instruction where + {-# INLINE displayBuilder #-} + displayBuilder = \case + MOV x y -> dis "MOV " [x, y] + ADD x y -> dis "ADD " [x, y] + SUB x y -> dis "SUB " [x, y] + OR x y -> dis "OR " [x, y] + INT x -> dis "INT " [x] + JNS x -> dis "JNS " [x] + JMP x -> dis "JMP " [x] + INC x -> dis "INC " [x] + CMP x y -> dis "CMP " [x, y] + JE x -> dis "JE " [x] + RET -> dis @Operand "RET" [] + where + dis :: Display x => Builder -> [x] -> Builder + dis iname args = iname <> go (if null args then "" else " ") args + where + go accum [] = accum + go accum (x : xs) = go (accum <> ", " <> displayBuilder x) xs + data Directive = ORG Word16 | DB (Either (Text, [Word8]) [Word8]) | END | NAME Text deriving (Show, Eq) + +instance Display Directive where + {-# INLINE displayBuilder #-} + displayBuilder = \case + ORG w -> "ORG" <> displayBuilder (RW16 w) + DB ei -> "TODO NOT DONE" + END -> "END" + NAME txt -> "NAME \"" <> displayBuilder txt <> "\"" + +class ToHexString a where + toHexString :: a -> String + +instance ToHexString Word8 where + toHexString w = pad2 $ showHex w "" + where + pad2 s = replicate (2 - length s) '0' ++ s + +instance ToHexString Word16 where + toHexString w = pad4 $ showHex w "" + where + pad4 s = replicate (4 - length s) '0' ++ s diff --git a/src/Parser.hs b/src/Parser.hs index 1355d4b..2433ef5 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -90,10 +90,10 @@ parseHex12 = parseHex 3 parseHex16 :: Parser Word16 parseHex16 = parseHex 4 -parseChar :: Parser Int +parseChar :: Parser Char parseChar = label "character enclosed in <'>" $ - ord <$> between "'" "'" anySingle + between "'" "'" anySingle parseDecimal :: Parser Int parseDecimal = @@ -145,10 +145,10 @@ parseOperand = , label "immediate value" $ ImmOp <$> choice - [ try $ IntOrChar <$> parseDecimal - , try $ W16 <$> parseImmediate16 - , try $ W8 <$> parseImmediate8 - , IntOrChar <$> parseChar + [ try $ RInt <$> parseDecimal + , try $ RW16 <$> parseImmediate16 + , try $ RW8 <$> parseImmediate8 + , RChar <$> parseChar ] , label "memory address" $ MemOp <$> parseMemory ] @@ -225,18 +225,14 @@ sc = L.space space1 (L.skipLineComment ";") (L.skipBlockComment "/*" "*/") -- Main parser function parseAssembly - :: Text - -> Either - (ParseErrorBundle Text Void) - [Statement] + :: FilePath -> Text -> Either (ParseErrorBundle Text Void) [Statement] parseAssembly = parse (sc *> some parseStatement <* eof) - "myfile" -mainLocal :: Text -> IO (Maybe [Statement]) -mainLocal assemblyCode = do - case parseAssembly assemblyCode of +parseTestHelper :: Text -> IO (Maybe [Statement]) +parseTestHelper assemblyCode = do + case parseAssembly "test" assemblyCode of Left err -> do putStrLn "Error: " putStrLn $ errorBundlePretty err @@ -247,6 +243,6 @@ mainLocal assemblyCode = do parseTest :: IO (Maybe [Statement]) parseTest = do - mainLocal "mov ah, \"text3243242moremore\"" + parseTestHelper "mov ah, \"text3243242moremore\"" -- mainLocal "mov ah, 3243242moremore\"" \ No newline at end of file diff --git a/test/Spec.hs b/test/Spec.hs index cf0e100..9f90be7 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,64 +1,49 @@ {-# LANGUAGE BinaryLiterals #-} -module Main where - --- import Control.Monad.ST --- import Data.ByteString.Char8 as B --- import Data.Foldable as F --- import Data.Vector as V --- import Expr --- import FlatParse.Stateful --- import Parser qualified as P --- import Scanner qualified as S +module Main (main) where +import Bin (compileStatements) import Bits.Show (showFiniteBits) -import Data.Text (Text) +import Data.ByteString.Lazy (fromStrict) import Data.Text qualified as T -import Data.Word -import Numeric (showHex) +import Data.Text.IO qualified as T +import Expr import Parser +import System.FilePath + ( replaceExtension + , takeBaseName + , takeDirectory + , takeFileName + , () + ) import Test.Tasty +import Test.Tasty.Golden (findByExtension, goldenVsStringDiff) import Test.Tasty.HUnit import Text.Megaparsec -import Text.Megaparsec.Char -import Text.Megaparsec.Char.Lexer qualified as L - --- import Test.Tasty.QuickCheck --- import Token data ImmediateLitType = Dec | Hex | Bin -class ToHexString a where - toHexString :: a -> String - -instance ToHexString Word8 where - toHexString w = pad2 $ showHex w "" - where - pad2 s = replicate (2 - length s) '0' ++ s - -instance ToHexString Word16 where - toHexString w = pad4 $ showHex w "" - where - pad4 s = replicate (4 - length s) '0' ++ s - main :: IO () -main = defaultMain tests +main = defaultMain =<< tests -tests :: TestTree -tests = - testGroup - "Tests" - [ testGroup - "Basic parsing tests" - [ testGroup - "parseImmediate" - [ testCaseNum Bin 0b1010_1010 parseImmediate8 - , testCaseNum Bin 0b1010_1010_1010_1010 parseImmediate16 - , testCaseNum Hex 0x2A parseImmediate8 - , testCaseNum Hex 0x0B01 parseImmediate16 - ] - ] - ] +tests :: IO TestTree +tests = do + gd <- golden + pure $ + testGroup + "Tests" + [ testGroup + "Basic parsing tests" + [ testGroup + "parseImmediate" + [ testCaseNum Bin 0b1010_1010 parseImmediate8 + , testCaseNum Bin 0b1010_1010_1010_1010 parseImmediate16 + , testCaseNum Hex 0x2A parseImmediate8 + , testCaseNum Hex 0x0B01 parseImmediate16 + ] + ] + , gd + ] where testCaseNum litType num parsingFunc = testCase ("parse " <> numStr <> " as " <> show num) $ do case parse parsingFunc "test" (T.pack numStr) of @@ -70,6 +55,29 @@ tests = Hex -> toHexString num <> "h" Bin -> showFiniteBits num <> "b" +golden :: IO TestTree +golden = do + asmFiles <- findByExtension [".asm"] "test/data/asm" + pure $ + testGroup + "Golden tests" + [ goldenVsStringDiff + (takeBaseName asmFile) + (\reference new -> ["diff", reference, new]) + comFile + ( do + res <- fmap compileStatements . parseAssembly asmFile <$> T.readFile asmFile + case res of + Left e -> error $ "Failed with parsing errors: \n" <> errorBundlePretty e + Right r -> pure $ fromStrict r + ) -- action whose result is tested + | asmFile <- asmFiles + , let comFile = + takeDirectory (takeDirectory asmFile) + "emu8086" + replaceExtension (takeFileName asmFile) ".bin" + ] + -- success :: Assertion -- success = pure () diff --git a/test/data/asm/HexConvertor.asm b/test/data/asm/HexConvertor.asm new file mode 100644 index 0000000..4955fea --- /dev/null +++ b/test/data/asm/HexConvertor.asm @@ -0,0 +1,121 @@ +; hex convertor. +; this example converts a 2 digit hexadecimal number +; into a numeric value and then into decimal/ascii string representation, +; and finally it prints out the result in binary code. + +; to see decimal string: +; 1. click "vars" +; 2. click "result" variable +; 3. enter "3" for the elements and "ascii" for show as. + + +name "hex" + +org 100h + +jmp start + +; source hex value is 2 char string. +; numeric value is stored into temp, +; and string decimal value is stored into result. + +source db '1b', 0 ; 1bh is converted to 27 (decimal) 00011011b (binary) +result db '000', 0 +temp dw ? + +start: +; convert first digit to value 0..15 from ascii: +mov al, source[0] +cmp al, '0' +jae f1 + +f1: +cmp al, '9' +ja f2 ; jumps only if not '0' to '9'. + +sub al, 30h ; convert char '0' to '9' to numeric value. +jmp num1_ready + +f2: +; gets here if it's 'a' to 'f' case: +or al, 00100000b ; remove upper case (if any). +sub al, 57h ; convert char 'a' to 'f' to numeric value. + +num1_ready: +mov bl, 16 +mul bl ; ax = al * bl + +mov temp, ax + +; convert second digit to value 0..15 from ascii: +mov al, source[1] +cmp al, '0' +jae g1 + +g1: +cmp al, '9' +ja g2 ; jumps only if not '0' to '9'. + +sub al, 30h ; convert char '0' to '9' to numeric value. +jmp num2_ready + +g2: +; gets here if it's 'a' to 'f' case: +or al, 00100000b ; remove upper case (if any). +sub al, 57h ; convert char 'a' to 'f' to numeric value. + +num2_ready: +xor ah, ah +add temp, ax +; convertion from hex string complete! +push temp ; store original temp value. + +; convert to decimal string, +; it has to be 3 decimal digits or less: + +mov di, 2 ; point to top of the string. + +next_digit: + +cmp temp, 0 +je stop + +mov ax, temp +mov bl, 10 +div bl ; al = ax / operand, ah = remainder. +mov result[di], ah +add result[di], 30h ; convert to ascii. + +xor ah, ah +mov temp, ax + +dec di ; next digit in string. +jmp next_digit + +stop: +pop temp ; re-store original temp value. + +; print result in binary: +mov bl, b.temp +mov cx, 8 +print: mov ah, 2 ; print function. + mov dl, '0' + test bl, 10000000b ; test first bit. + jz zero + mov dl, '1' +zero: int 21h + shl bl, 1 +loop print + +; print binary suffix: +mov dl, 'b' +int 21h + +; wait for any key press: +mov ah, 0 +int 16h + + + + +ret ; return to operating system. \ No newline at end of file diff --git a/test/data/asm/calc.asm b/test/data/asm/calc.asm new file mode 100644 index 0000000..b0aeb15 --- /dev/null +++ b/test/data/asm/calc.asm @@ -0,0 +1,357 @@ +; this sample gets two numbers from the user, +; then it calculates the sum of these numbers, +; and prints it out. + +name "calc" + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; these maros are copied from emu8086.inc ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +; this macro prints a string that is given as a parameter, example: +; PRINTN 'hello world!' +; the same as PRINT, but new line is automatically added. +PRINTN MACRO sdat +LOCAL next_char, s_dcl, printed, skip_dcl + +PUSH AX ; store registers... +PUSH SI ; + +JMP skip_dcl ; skip declaration. + s_dcl DB sdat, 0Dh,0Ah, 0 + +skip_dcl: + LEA SI, s_dcl + +next_char: + MOV AL, CS:[SI] + CMP AL, 0 + JZ printed + INC SI + MOV AH, 0Eh ; teletype function. + INT 10h + JMP next_char +printed: + +POP SI ; re-store registers... +POP AX ; +ENDM + +; this macro prints a char in AL and advances +; the current cursor position: +PUTC MACRO char + PUSH AX + MOV AL, char + MOV AH, 0Eh + INT 10h + POP AX +ENDM +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + + + +org 100h + + + + + + + +jmp start ; skip data. + +msg1 db 0Dh,0Ah, 'input numbers in this range: [-32768..32767]', 0Dh,0Ah + db 0Dh,0Ah, 'enter first number: $' + +msg2 db 0Dh,0Ah, 'enter second number: $' + +msg3 db 0Dh,0Ah, 'the sum is: $' + +; declaration of variable: +num dw ? + +start: + + +; print first message +mov dx, offset msg1 +mov ah, 9 +int 21h + + +call scan_num + +; keep first number: +mov num, cx + + +; print second message +mov dx, offset msg2 +mov ah, 9 +int 21h + + +call scan_num + + +; add numbers: +add num, cx +jo overflow + + +; print the result: +mov dx, offset msg3 +mov ah, 9 +int 21h + + +mov ax, num +call print_num + +jmp exit + +; process overlow error: +overflow: + + printn 'we have overflow!' + + +exit: + +; wait for any key press: +mov ah, 0 +int 16h + +ret ; return control to operating system. + + + + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; these functions are copied from emu8086.inc ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +; gets the multi-digit SIGNED number from the keyboard, +; and stores the result in CX register: +SCAN_NUM PROC NEAR + PUSH DX + PUSH AX + PUSH SI + + MOV CX, 0 + + ; reset flag: + MOV CS:make_minus, 0 + +next_digit: + + ; get char from keyboard + ; into AL: + MOV AH, 00h + INT 16h + ; and print it: + MOV AH, 0Eh + INT 10h + + ; check for MINUS: + CMP AL, '-' + JE set_minus + + ; check for ENTER key: + CMP AL, 0Dh ; carriage return? + JNE not_cr + JMP stop_input +not_cr: + + + CMP AL, 8 ; 'BACKSPACE' pressed? + JNE backspace_checked + MOV DX, 0 ; remove last digit by + MOV AX, CX ; division: + DIV CS:ten ; AX = DX:AX / 10 (DX-rem). + MOV CX, AX + PUTC ' ' ; clear position. + PUTC 8 ; backspace again. + JMP next_digit +backspace_checked: + + + ; allow only digits: + CMP AL, '0' + JAE ok_AE_0 + JMP remove_not_digit +ok_AE_0: + CMP AL, '9' + JBE ok_digit +remove_not_digit: + PUTC 8 ; backspace. + PUTC ' ' ; clear last entered not digit. + PUTC 8 ; backspace again. + JMP next_digit ; wait for next input. +ok_digit: + + + ; multiply CX by 10 (first time the result is zero) + PUSH AX + MOV AX, CX + MUL CS:ten ; DX:AX = AX*10 + MOV CX, AX + POP AX + + ; check if the number is too big + ; (result should be 16 bits) + CMP DX, 0 + JNE too_big + + ; convert from ASCII code: + SUB AL, 30h + + ; add AL to CX: + MOV AH, 0 + MOV DX, CX ; backup, in case the result will be too big. + ADD CX, AX + JC too_big2 ; jump if the number is too big. + + JMP next_digit + +set_minus: + MOV CS:make_minus, 1 + JMP next_digit + +too_big2: + MOV CX, DX ; restore the backuped value before add. + MOV DX, 0 ; DX was zero before backup! +too_big: + MOV AX, CX + DIV CS:ten ; reverse last DX:AX = AX*10, make AX = DX:AX / 10 + MOV CX, AX + PUTC 8 ; backspace. + PUTC ' ' ; clear last entered digit. + PUTC 8 ; backspace again. + JMP next_digit ; wait for Enter/Backspace. + + +stop_input: + ; check flag: + CMP CS:make_minus, 0 + JE not_minus + NEG CX +not_minus: + + POP SI + POP AX + POP DX + RET +make_minus DB ? ; used as a flag. +SCAN_NUM ENDP + + + + + +; this procedure prints number in AX, +; used with PRINT_NUM_UNS to print signed numbers: +PRINT_NUM PROC NEAR + PUSH DX + PUSH AX + + CMP AX, 0 + JNZ not_zero + + PUTC '0' + JMP printed + +not_zero: + ; the check SIGN of AX, + ; make absolute if it's negative: + CMP AX, 0 + JNS positive + NEG AX + + PUTC '-' + +positive: + CALL PRINT_NUM_UNS +printed: + POP AX + POP DX + RET +PRINT_NUM ENDP + + + +; this procedure prints out an unsigned +; number in AX (not just a single digit) +; allowed values are from 0 to 65535 (FFFF) +PRINT_NUM_UNS PROC NEAR + PUSH AX + PUSH BX + PUSH CX + PUSH DX + + ; flag to prevent printing zeros before number: + MOV CX, 1 + + ; (result of "/ 10000" is always less or equal to 9). + MOV BX, 10000 ; 2710h - divider. + + ; AX is zero? + CMP AX, 0 + JZ print_zero + +begin_print: + + ; check divider (if zero go to end_print): + CMP BX,0 + JZ end_print + + ; avoid printing zeros before number: + CMP CX, 0 + JE calc + ; if AXi< dp@v@qCHG%H+r+hv6)an^h3~Au7KXE8hXJgVA*cWV literal 0 HcmV?d00001 diff --git a/test/data/asm/factorial.asm b/test/data/asm/factorial.asm new file mode 100644 index 0000000..1f0e26e --- /dev/null +++ b/test/data/asm/factorial.asm @@ -0,0 +1,336 @@ +; this example gets the number from the user, +; and calculates factorial for it. +; supported input from 0 to 8 inclusive! + +name "fact" + +; this macro prints a char in AL and advances +; the current cursor position: +putc macro char + push ax + mov al, char + mov ah, 0eh + int 10h + pop ax +endm + + + +org 100h + +jmp start + + +result dw ? + + + +start: + +; get first number: + +mov dx, offset msg1 +mov ah, 9 +int 21h +jmp n1 +msg1 db 0Dh,0Ah, 'enter the number: $' +n1: + +call scan_num + + +; factorial of 0 = 1: +mov ax, 1 +cmp cx, 0 +je print_result + +; move the number to bx: +; cx will be a counter: + +mov bx, cx + +mov ax, 1 +mov bx, 1 + +calc_it: +mul bx +cmp dx, 0 +jne overflow +inc bx +loop calc_it + +mov result, ax + + +print_result: + +; print result in ax: +mov dx, offset msg2 +mov ah, 9 +int 21h +jmp n2 +msg2 db 0Dh,0Ah, 'factorial: $' +n2: + + +mov ax, result +call print_num_uns +jmp exit + + +overflow: +mov dx, offset msg3 +mov ah, 9 +int 21h +jmp n3 +msg3 db 0Dh,0Ah, 'the result is too big!', 0Dh,0Ah, 'use values from 0 to 8.$' +n3: +jmp start + +exit: + +; wait for any key press: +mov ah, 0 +int 16h + +ret + + + + + + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; these functions are copied from emu8086.inc ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +; gets the multi-digit SIGNED number from the keyboard, +; and stores the result in CX register: +SCAN_NUM PROC NEAR + PUSH DX + PUSH AX + PUSH SI + + MOV CX, 0 + + ; reset flag: + MOV CS:make_minus, 0 + +next_digit: + + ; get char from keyboard + ; into AL: + MOV AH, 00h + INT 16h + ; and print it: + MOV AH, 0Eh + INT 10h + + ; check for MINUS: + CMP AL, '-' + JE set_minus + + ; check for ENTER key: + CMP AL, 0Dh ; carriage return? + JNE not_cr + JMP stop_input +not_cr: + + + CMP AL, 8 ; 'BACKSPACE' pressed? + JNE backspace_checked + MOV DX, 0 ; remove last digit by + MOV AX, CX ; division: + DIV CS:ten ; AX = DX:AX / 10 (DX-rem). + MOV CX, AX + PUTC ' ' ; clear position. + PUTC 8 ; backspace again. + JMP next_digit +backspace_checked: + + + ; allow only digits: + CMP AL, '0' + JAE ok_AE_0 + JMP remove_not_digit +ok_AE_0: + CMP AL, '9' + JBE ok_digit +remove_not_digit: + PUTC 8 ; backspace. + PUTC ' ' ; clear last entered not digit. + PUTC 8 ; backspace again. + JMP next_digit ; wait for next input. +ok_digit: + + + ; multiply CX by 10 (first time the result is zero) + PUSH AX + MOV AX, CX + MUL CS:ten ; DX:AX = AX*10 + MOV CX, AX + POP AX + + ; check if the number is too big + ; (result should be 16 bits) + CMP DX, 0 + JNE too_big + + ; convert from ASCII code: + SUB AL, 30h + + ; add AL to CX: + MOV AH, 0 + MOV DX, CX ; backup, in case the result will be too big. + ADD CX, AX + JC too_big2 ; jump if the number is too big. + + JMP next_digit + +set_minus: + MOV CS:make_minus, 1 + JMP next_digit + +too_big2: + MOV CX, DX ; restore the backuped value before add. + MOV DX, 0 ; DX was zero before backup! +too_big: + MOV AX, CX + DIV CS:ten ; reverse last DX:AX = AX*10, make AX = DX:AX / 10 + MOV CX, AX + PUTC 8 ; backspace. + PUTC ' ' ; clear last entered digit. + PUTC 8 ; backspace again. + JMP next_digit ; wait for Enter/Backspace. + + +stop_input: + ; check flag: + CMP CS:make_minus, 0 + JE not_minus + NEG CX +not_minus: + + POP SI + POP AX + POP DX + RET +make_minus DB ? ; used as a flag. +SCAN_NUM ENDP + + + + + +; this procedure prints number in AX, +; used with PRINT_NUM_UNS to print signed numbers: +PRINT_NUM PROC NEAR + PUSH DX + PUSH AX + + CMP AX, 0 + JNZ not_zero + + PUTC '0' + JMP printed + +not_zero: + ; the check SIGN of AX, + ; make absolute if it's negative: + CMP AX, 0 + JNS positive + NEG AX + + PUTC '-' + +positive: + CALL PRINT_NUM_UNS +printed: + POP AX + POP DX + RET +PRINT_NUM ENDP + + + +; this procedure prints out an unsigned +; number in AX (not just a single digit) +; allowed values are from 0 to 65535 (FFFF) +PRINT_NUM_UNS PROC NEAR + PUSH AX + PUSH BX + PUSH CX + PUSH DX + + ; flag to prevent printing zeros before number: + MOV CX, 1 + + ; (result of "/ 10000" is always less or equal to 9). + MOV BX, 10000 ; 2710h - divider. + + ; AX is zero? + CMP AX, 0 + JZ print_zero + +begin_print: + + ; check divider (if zero go to end_print): + CMP BX,0 + JZ end_print + + ; avoid printing zeros before number: + CMP CX, 0 + JE calc + ; if AXrun from the menu. " +print 10,11,0010_1111b," click/hold both buttons to exit... " + +; display mouse cursor: +mov ax, 1 +int 33h + +check_mouse_buttons: +mov ax, 3 +int 33h +cmp bx, 3 ; both buttons +je hide +cmp cx, curX +jne print_xy +cmp dx, curY +jne print_xy +cmp bx, curB +jne print_buttons + + +print_xy: +print 0,0,0000_1111b,"x=" +mov ax, cx +call print_ax +print_space 4 +print 0,1,0000_1111b,"y=" +mov ax, dx +call print_ax +print_space 4 +mov curX, cx +mov curY, dx +jmp check_mouse_buttons + +print_buttons: +print 0,2,0000_1111b,"btn=" +mov ax, bx +call print_ax +print_space 4 +mov curB, bx +jmp check_mouse_buttons + + + +hide: +mov ax, 2 ; hide mouse cursor. +int 33h + +clear_screen + +print 1,1,1010_0000b," hardware must be free! free the mice! " + +stop: +; show box-shaped blinking text cursor: +mov ah, 1 +mov ch, 0 +mov cl, 8 +int 10h + +print 4,7,0000_1010b," press any key.... " +mov ah, 0 +int 16h + +ret + + +print_ax proc +cmp ax, 0 +jne print_ax_r + push ax + mov al, '0' + mov ah, 0eh + int 10h + pop ax + ret +print_ax_r: + pusha + mov dx, 0 + cmp ax, 0 + je pn_done + mov bx, 10 + div bx + call print_ax_r + mov ax, dx + add al, 30h + mov ah, 0eh + int 10h + jmp pn_done +pn_done: + popa + ret +endp diff --git a/test/data/asm/robot.asm b/test/data/asm/robot.asm new file mode 100644 index 0000000..42c55bd --- /dev/null +++ b/test/data/asm/robot.asm @@ -0,0 +1,171 @@ + +#start=robot.exe# + +name "robot" + +#make_bin# +#cs = 500# +#ds = 500# +#ss = 500# ; stack +#sp = ffff# +#ip = 0# + +; this is an example of contoling the robot. + +; this code randomly moves the robot, +; and makes it to switch the lamps on and off. + +; robot is a mechanical creature and it takes +; some time for it to complete a task. +; status register is used to see if robot is busy or not. + +; c:\emu8086\devices\robot.exe uses ports 9, 10 and 11 +; source code of the robot and other devices is in: +; c:\emu8086\devices\developer\sources\ +; robot is programmed in visual basic 6.0 + + +; robot base i/o port: +r_port equ 9 + +;=================================== + +eternal_loop: +; wait until robot +; is ready: +call wait_robot + +; examine the area +; in front of the robot: +mov al, 4 +out r_port, al + +call wait_exam + +; get result from +; data register: +in al, r_port + 1 + +; nothing found? +cmp al, 0 +je cont ; - yes, so continue. + +; wall? +cmp al, 255 +je cont ; - yes, so continue. + +; switched-on lamp? +cmp al, 7 +jne lamp_off ; - no, so skip. +; - yes, so switch it off, +; and turn: +call switch_off_lamp +jmp cont ; continue + +lamp_off: nop + +; if gets here, then we have +; switched-off lamp, because +; all other situations checked +; already: +call switch_on_lamp + +cont: +call random_turn + +call wait_robot + +; try to step forward: +mov al, 1 +out r_port, al + +call wait_robot + +; try to step forward again: +mov al, 1 +out r_port, al + +jmp eternal_loop ; go again! + +;=================================== + +; this procedure does not +; return until robot is ready +; to receive next command: +wait_robot proc +; check if robot busy: +busy: in al, r_port+2 + test al, 00000010b + jnz busy ; busy, so wait. +ret +wait_robot endp + +;=================================== + +; this procedure does not +; return until robot completes +; the examination: +wait_exam proc +; check if has new data: +busy2: in al, r_port+2 + test al, 00000001b + jz busy2 ; no new data, so wait. +ret +wait_exam endp + +;=================================== + +; switch off the lamp: +switch_off_lamp proc +mov al, 6 +out r_port, al +ret +switch_off_lamp endp + +;=================================== + +; switch on the lamp: +switch_on_lamp proc +mov al, 5 +out r_port, al +ret +switch_on_lamp endp + +;=================================== + +; generates a random turn using +; system timer: +random_turn proc + +; get number of clock +; ticks since midnight +; in cx:dx +mov ah, 0 +int 1ah + +; randomize using xor: +xor dh, dl +xor ch, cl +xor ch, dh + +test ch, 2 +jz no_turn + +test ch, 1 +jnz turn_right + +; turn left: +mov al, 2 +out r_port, al +; exit from procedure: +ret + +turn_right: +mov al, 3 +out r_port, al + +no_turn: +ret +random_turn endp + +;=================================== diff --git a/test/data/asm/stepper_motor.asm b/test/data/asm/stepper_motor.asm new file mode 100644 index 0000000..aef06de --- /dev/null +++ b/test/data/asm/stepper_motor.asm @@ -0,0 +1,87 @@ + + + +; this is an example of out instruction. +; it writes values to virtual i/o port +; that controls the stepper-motor. +; c:\emu8086\devices\stepper_motor.exe is on port 7 + +#start=stepper_motor.exe# + + +name "stepper" + +#make_bin# + +steps_before_direction_change = 20h ; 32 (decimal) + +jmp start + +; ========= data =============== + +; bin data for clock-wise +; half-step rotation: +datcw db 0000_0110b + db 0000_0100b + db 0000_0011b + db 0000_0010b + +; bin data for counter-clock-wise +; half-step rotation: +datccw db 0000_0011b + db 0000_0001b + db 0000_0110b + db 0000_0010b + + +; bin data for clock-wise +; full-step rotation: +datcw_fs db 0000_0001b + db 0000_0011b + db 0000_0110b + db 0000_0000b + +; bin data for counter-clock-wise +; full-step rotation: +datccw_fs db 0000_0100b + db 0000_0110b + db 0000_0011b + db 0000_0000b + + +start: +mov bx, offset datcw ; start from clock-wise half-step. +mov si, 0 +mov cx, 0 ; step counter + +next_step: +; motor sets top bit when it's ready to accept new command +wait: in al, 7 + test al, 10000000b + jz wait + +mov al, [bx][si] +out 7, al + +inc si + +cmp si, 4 +jb next_step +mov si, 0 + +inc cx +cmp cx, steps_before_direction_change +jb next_step + +mov cx, 0 +add bx, 4 ; next bin data + +cmp bx, offset datccw_fs +jbe next_step + +mov bx, offset datcw ; return to clock-wise half-step. + +jmp next_step + + + diff --git a/test/data/emu8086/calc.com b/test/data/emu8086/calc.com new file mode 100755 index 0000000000000000000000000000000000000000..7ddf2cb6124f83ff624bac7e00129725ac367298 GIT binary patch literal 518 zcmZWlJ4?e*6h3K#k3dwU2s+3WLP2Y-P$ zxOV8$3Ze!?lnQS84=Q)lp{RrAVFz_OeBU|W<6fqVf~x5jMVhs@K@1bA8lq{{L`F*6 zA#t=C9UYk%pOhqTOst85C=iVj18u8@*-*t%e}gv3W=7lkar1eaCdjn*kZQURpc3Lr zt<}ET5*)VaTxB6ZbHKSsZ?B|$e4=x;H(*0}nMHC0rBhjgGFf75?`Cp+q5v1CoK)at zpw088wrU4^T~|s_?Q#-$xeOrPG#!P&BfO;?rK&7i;g@5OTddv+fPE#^$N8{*i;Kv+ zP;jxupX^?anIXo@Q`w#d_wVKmd-?%SujD_#>K=}jzvpA~`t!PybRdCe04xC)V?m)#7w!x7CtQsBL@f;N8D3gUlsP!>7xF? qEdLIapLUFh`vGot{f&>|!lf^=ud&z0310oAu!n|!a%EL<1o#HU)4Tov literal 0 HcmV?d00001 diff --git a/test/data/emu8086/celsi.com b/test/data/emu8086/celsi.com new file mode 100755 index 0000000000000000000000000000000000000000..cce69ebc5aba3e8525435bb04306ce495d440357 GIT binary patch literal 95 zcmaFO!o|SA(8b5ZxPkNA%Z;qxezGVmVqxr(V_|$D2NY*!Y7`Jh7zVthG!KoJbv_kQ_@+*O}s$NbyhL)FaUeCCW!z5 literal 0 HcmV?d00001 diff --git a/test/data/emu8086/colors.bin b/test/data/emu8086/colors.bin new file mode 100644 index 0000000000000000000000000000000000000000..ced70a30aa4be42731afab94c2fc7f1725ab1e11 GIT binary patch literal 75 zcmdnN%y3p<2eZI#1|YqOVH?9{hS!|`jy3!fD3RI3u!ZTYz=p)_3_BSaws4*m_;>i< dp@v@qCHG%H+r+hv6)an^h3~Au7KXE8hXJgVA*cWV literal 0 HcmV?d00001 diff --git a/test/data/emu8086/colors.com b/test/data/emu8086/colors.com new file mode 100755 index 0000000000000000000000000000000000000000..ced70a30aa4be42731afab94c2fc7f1725ab1e11 GIT binary patch literal 75 zcmdnN%y3p<2eZI#1|YqOVH?9{hS!|`jy3!fD3RI3u!ZTYz=p)_3_BSaws4*m_;>i< dp@v@qCHG%H+r+hv6)an^h3~Au7KXE8hXJgVA*cWV literal 0 HcmV?d00001 diff --git a/test/data/emu8086/fact.com b/test/data/emu8086/fact.com new file mode 100755 index 0000000000000000000000000000000000000000..e50dbafc25521f533fc0250bd5f1e9ba0e4b1c1f GIT binary patch literal 475 zcmaFO#K5qNmvIZ{S;g0)yj-byC86u7OK*$K>?&9 zB47gtn0|fQ#-Nz#HH(d9nG{S6L(TF4kbX6g{s@rgBy|k7FmzvJK2gN=x*KdYgYp%ttrtWz>JY20NfzOPIdjjEjgm%n%e{%fL{|6|lho;vgX)x037ojerfhV1XCR z3_xW8!GS?Lf#EBl4wNo2YW~eoVhRd&7VE=BBESFu+Wq}Ai$Orw0kEd-LjfSy9ESM% SM#SrLF!Q4#qazM;F#rG}^R;&X literal 0 HcmV?d00001 diff --git a/test/data/emu8086/hex.com b/test/data/emu8086/hex.com new file mode 100755 index 0000000000000000000000000000000000000000..8005a6ecf285fd02388c0ac9ff4ddde06d583fa7 GIT binary patch literal 137 zcmaFOX_&-dU|_(&z_5Uc(Z-;d!N#(jMaSSZ3y*?M_-27`j~8x2K zjFWLc6GO8dCnH0N#6nKS&0OC;cPwRPY-nX=G%$Js)a(EHVLwo1mmDYKP7a1GOq&e8 b9d0OL+GKcE@xtRr?>8l#RoudGR_rhUD9S8f literal 0 HcmV?d00001 diff --git a/test/data/emu8086/keybrd.com b/test/data/emu8086/keybrd.com new file mode 100755 index 0000000000000000000000000000000000000000..ba91959fde2e2cb94e4f973461025746a0f0c5d2 GIT binary patch literal 176 zcmYL>F%E)25JkmK5{wm%7Gq*(W4T8`;S4x*jl0@Mp)r^$E4hlh}M2SGiE$Pu6 znCfi%ztl=2NW|+P&!&Z&=%GSEARtFQfVfwC`T5n*-|S1La9j?rf+r26=srEsX9YBE;WD&rj(fJSnpi2`LYTgmYXM|V z^C7_Cn)jHVE(f_CJ_2uTuogW}g6zg}Rzbr;-eSm1(bl=`V9yq4>OHg=Ya+L?<1p7n zoggi{-CU6Cf^*w)5zYauM_(3zI&0{0o@us*#hK%X4yR~NntaEx8x);Dl!e3eHgdyc zCH%Y217xFza%{sc74M+F5Hgo}_K|goWa;hV14mf6=h$XaqRA|=96O<`0LtMF z@N$ET(c1)YGmTeH3a{I|g}>`2Us%`RrBVqYkf>#WLZ25u6`@Q+sBXxTxKu5ulE_rI zGLkTtZOVr-crbt{tHf0(-5ogkIN6eFezuRt`B0@{SZUlsAVrl_&?CWc@)cGDhr~Q2 z;*`%W?cC*Zav&*J@S_f_F-HY#s5V1 iN&k+&G1i`rY99dTgkL_(!H@5gZ}X#}nq195AN>MnX*cr# literal 0 HcmV?d00001 diff --git a/test/data/extra/calc.com.debug b/test/data/extra/calc.com.debug new file mode 100755 index 0000000000000000000000000000000000000000..750ff52ae07de0fb5c583201534f22b50e0f7705 GIT binary patch literal 8616 zcmX}y37k >?)xEwV3VNp>1ShGFa@k)2lALL{k(P+IL8F?LecvUKm&ZIiv_m3rNq z?9wLXmMuk+RM&PtU-SLlUVUEAoVWk{o^#G~p7V^UBuSFm6#rb}AAK#mk#e~3d)U63 za=P#l-p<9N3LnMS1u3@+AJ4XC*{(}@UHDr26+Ei&qxLI#RNT zvHUK)4_+F(%7s6UH^B_xPr-HVUgyHQ;X2OpF8m=}&sV{P zPsVjz6Y*%;Td3j@1 zz^-@U)o{Ij+9ws>6xVsH;ljJ(dQED&@WHsw{|zpDyw~fRQ{js|U$21*e-qd7>KIh` zI=m6vy4R@iQ@GB9?gc9Rv^^D5;b-jiFcp5*ULRB8f8u(Nrn&IE+>rFV4P5w@_J+6$ z&u>r1RCocqj!lIZvNy(5coBOOOobP-H^o$V30&8BGp8GM4ob!OH)-x-eM7JV*23jv zZCx6N>ow1CsaRWj4cB>S>0-|7xUPkpTszkGrTt#t3RkiI0A88xn_WNF4kcX-n%~;R z`kc7l>up^4b-3vu~9Sx&xdt!k74?3c?{Qi=;~trX#1_W3V#yUef2gsni)^h zG_SuMSFwINuKU0pE_?-E6uZ+s#f)cZt>@f@t60C@-VIaX8*$zH?{?vPaGjs-ZVa=> z(NSFIr-vJlO`y}b&QDJ_5t~HkaGjrCF6Ljb_r_KDC0yr6Kc}e4%*dpo{Lr8|eO#1G#r%?l3&)eT+VbiIt=MTVD%xQ1G4^!bCahwFG!v#~ie7T5WFz|Fp!7_+#GZsCc0Q(*ggqY;YD#qC6k?g&eNPyUjH1fVtpB0KUZYB@HAZe zKgDUzr<8%~^?KfI!?sg9T>ClI#hebfK6j_N9jsN4dwmwJV*L~L>6i+C%02^A;m_D- zVk&%$eHNy|$Ju9NDtrQ-#`YW+zQH~hSK%k^^Dq@&nUkaQFyDn&wZDL?@aniecNe(u zzIY1uq6^Q&^?CY|+v)SU3NL{zbaJ)Hz6e*lFtyXZ7*o43^#h)t?IkXr_XMubm!)nG zYd@phEY|TZbFn@zuJtdw@N#%1>=n0<8DCQi&smPESl<#a$o2}i-|IVj{YqTL`mUb8 z3RB_3ah;!6UHBxtH1;>A`QOkIT=%!Xy93y_w8rcIfvcFa-M$)A-?8=}9r2vkF!dko zdpd{fy#3R~oC~;qu6W&rm*&l={d~jyz>GtbitGLRraO!sp-#BwzvW_17rX-YwhJGM z*TUAgqs%x)3vqpJzTg=>G-yLjIH_6@iSKY(Yj zz0qmTFI28T_RndXaCHj%l``-Qwl}-e*clpwr(y59-?6jw4&EAj&*|^I=jgw1lbufUi_#hUE?gDEic`Tt+3&~Qm@0vlq&j#pw)eQJ?JaT5 z-|OVpP!C+6gP*xlSZNwz--oL*_AI;_+n>|d_KN)38oUwP`{_HXgr(34ygu6p=@8Yx z>QcqR*?&Jdj4A!zp&s?bxrCAY?MNY1#Jvl*{~{qDjKdd^u~-OM+)roTMr z4@|}Sb6)=^rou}U&EC(yFx7?`w@^*I1Ka;~ZLxMV3fK8R=h|Z(C<||nop&9vPP7f@ zA-Uka+n(HIdySe|JPwE z*0;qg;pH)<_4-}oV7x3|0aKH)=V&6%zez<*Wnxok0jTSt5~iNFufX{-sf?+3-c_Dc z1yfqDHrcCUYAU97+N)t|8m4~0b-dLvm4&HOcs=}jOijmB<&ysW8E$p>072eWb8&lz}@ajBo9ZZD}#_QuZVk&$wuFt``n400^+Kh9^ zNh+q~YL~qpru6$_bqMDnsgJ3ce+1Wcl7^{SESf_XaDCo2z|>r99$j;F_MC>8iaDim zz9mV=n$mpME~eVJ?zhb_wFFyAw|Gu-OvRjbxb6cjFtyC<@4zeK8JLRoBk`JeOH73? z#dTaaVM=pep>?>9s}-h}V=HJkuJd^_rdDFB=rGPh(i&4S|0u5GZG*L^S6TEro%i|< zn2PlmaUEAjOugat`Pj+wcqdHB-=gbr-3K~j>TP=}uKnzSDY$D%O9Dw_yFfmN6n2VpAaOv3rmGbeg*4CVrs8_ z3tkl;g(>+yI)?L*Jcg-w-s8CTU%!i1pR?#o%E8Ie&*!5t^%eFtHOF~Kp1@Sh$-wpc zK8dODUU+T%DNKb=!F3*<#?*d>enao$dVf8GjiUqDA=-=ckc`Jv%-Lt3fT{2=@O0Ks z#MEKF`3MzeCpBjhreb|jT<3E#rjB}jDO~q~=P(uP8{pc{OiXFLYLDxDPQlbM>^Swq z_4+=Ksh_Z)X*90$JQY(XuwQAd*H6RLY3w)Jf$Mp*Fm(n~-{U-7{+;u5JofVtUJjpu zsoz<2mU4i)&(FkEtiKA^eR~$B{_y%zxITAgWAp77`LkM{^8%(~PD5Njr!BzLCDv+v zE1ZYqMNGx|*0_%AB}{3(>TX|%smuR!K`!32_C=V=fvK_f#hA*8skyk0YYC=uVd`aE z@6)B2iv3xSYd@D^Dtx2;WlV){w!ea@@b~bZ%vp}9+&pI&x0#Vk-Q9 DQ(x3{ literal 0 HcmV?d00001 diff --git a/test/data/extra/calc.com.list b/test/data/extra/calc.com.list new file mode 100755 index 0000000..cca5f8b --- /dev/null +++ b/test/data/extra/calc.com.list @@ -0,0 +1,388 @@ +EMU8086 GENERATED LISTING. MACHINE CODE <- SOURCE. + +calc.com -- emu8086 assembler version: 4.08 + +[ 7/16/2024 -- 10:18:01 AM ] + +=================================================================================================== +[LINE] LOC: MACHINE CODE SOURCE +=================================================================================================== + +[ 1] : ; this sample gets two numbers from the user, +[ 2] : ; then it calculates the sum of these numbers, +[ 3] : ; and prints it out. +[ 4] : +[ 5] : name "calc" +[ 6] : +[ 7] : ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +[ 8] : ;;; these maros are copied from emu8086.inc ;;; +[ 9] : ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +[ 10] : +[ 11] : ; this macro prints a string that is given as a parameter, example: +[ 12] : ; PRINTN 'hello world!' +[ 13] : ; the same as PRINT, but new line is automatically added. +[ 14] : PRINTN MACRO sdat +[ 15] : LOCAL next_char, s_dcl, printed, skip_dcl +[ 16] : +[ 17] : PUSH AX ; store registers... +[ 18] : PUSH SI ; +[ 19] : +[ 20] : JMP skip_dcl ; skip declaration. +[ 21] : s_dcl DB sdat, 0Dh,0Ah, 0 +[ 22] : +[ 23] : skip_dcl: +[ 24] : LEA SI, s_dcl +[ 25] : +[ 26] : next_char: +[ 27] : MOV AL, CS:[SI] +[ 28] : CMP AL, 0 +[ 29] : JZ printed +[ 30] : INC SI +[ 31] : MOV AH, 0Eh ; teletype function. +[ 32] : INT 10h +[ 33] : JMP next_char +[ 34] : printed: +[ 35] : +[ 36] : POP SI ; re-store registers... +[ 37] : POP AX ; +[ 38] : ENDM +[ 39] : +[ 40] : ; this macro prints a char in AL and advances +[ 41] : ; the current cursor position: +[ 42] : PUTC MACRO char +[ 43] : PUSH AX +[ 44] : MOV AL, char +[ 45] : MOV AH, 0Eh +[ 46] : INT 10h +[ 47] : POP AX +[ 48] : ENDM +[ 49] : ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +[ 50] : +[ 51] : +[ 52] : +[ 53] : +[ 54] : org 100h +[ 55] : +[ 56] : +[ 57] : +[ 58] : +[ 59] : +[ 60] : +[ 61] : +[ 62] 0100: EB 70 jmp start ; skip data. +[ 63] : +[ 64] 0102: 0D 0A 69 6E 70 75 74 20 6E 75 6D 62 msg1 db 0Dh,0Ah, 'input numbers in this range: [-32768..32767]', 0Dh,0Ah + 65 72 73 20 69 6E 20 74 68 69 73 20 + 72 61 6E 67 65 3A 20 5B 2D 33 32 37 + 36 38 2E 2E 33 32 37 36 37 5D 0D 0A + +[ 65] 0132: 0D 0A 65 6E 74 65 72 20 66 69 72 73 db 0Dh,0Ah, 'enter first number: $' + 74 20 6E 75 6D 62 65 72 3A 20 24 +[ 66] : +[ 67] 0149: 0D 0A 65 6E 74 65 72 20 73 65 63 6F msg2 db 0Dh,0Ah, 'enter second number: $' + 6E 64 20 6E 75 6D 62 65 72 3A 20 24 + +[ 68] : +[ 69] 0161: 0D 0A 74 68 65 20 73 75 6D 20 69 73 msg3 db 0Dh,0Ah, 'the sum is: $' + 3A 20 24 +[ 70] : +[ 71] : ; declaration of variable: +[ 72] 0170: 00 00 num dw ? +[ 73] : +[ 74] 0172: start: +[ 75] : +[ 76] : +[ 77] : ; print first message +[ 78] 0172: BA 02 01 mov dx, offset msg1 +[ 79] 0175: B4 09 mov ah, 9 +[ 80] 0177: CD 21 int 21h +[ 81] : +[ 82] : +[ 83] 0179: E8 53 00 call scan_num +[ 84] : +[ 85] : ; keep first number: +[ 86] 017C: 89 0E 70 01 mov num, cx +[ 87] : +[ 88] : +[ 89] : ; print second message +[ 90] 0180: BA 49 01 mov dx, offset msg2 +[ 91] 0183: B4 09 mov ah, 9 +[ 92] 0185: CD 21 int 21h +[ 93] : +[ 94] : +[ 95] 0187: E8 45 00 call scan_num +[ 96] : +[ 97] : +[ 98] : ; add numbers: +[ 99] 018A: 01 0E 70 01 add num, cx +[ 100] 018E: 70 0F jo overflow +[ 101] : +[ 102] : +[ 103] : ; print the result: +[ 104] 0190: BA 61 01 mov dx, offset msg3 +[ 105] 0193: B4 09 mov ah, 9 +[ 106] 0195: CD 21 int 21h +[ 107] : +[ 108] : +[ 109] 0197: A1 70 01 mov ax, num +[ 110] 019A: E8 F3 00 call print_num +[ 111] : +[ 112] 019D: EB 2B jmp exit +[ 113] : +[ 114] : ; process overlow error: +[ 115] 019F: overflow: +[ 116] : +[ 117] 019F: 50 56 EB 14 77 65 20 68 61 76 65 20 printn 'we have overflow!' + 6F 76 65 72 66 6C 6F 77 21 0D 0A 00 + BE A3 01 2E 8A 04 3C 00 74 07 46 B4 + 0E CD 10 EB F2 5E 58 +[ 118] : +[ 119] : +[ 120] 01CA: exit: +[ 121] : +[ 122] : ; wait for any key press: +[ 123] 01CA: B4 00 mov ah, 0 +[ 124] 01CC: CD 16 int 16h +[ 125] : +[ 126] 01CE: C3 ret ; return control to operating system. +[ 127] : +[ 128] : +[ 129] : +[ 130] : +[ 131] : +[ 132] : +[ 133] : ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +[ 134] : ;;; these functions are copied from emu8086.inc ;;; +[ 135] : ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +[ 136] : +[ 137] : +[ 138] : ; gets the multi-digit SIGNED number from the keyboard, +[ 139] : ; and stores the result in CX register: +[ 140] 01CF: SCAN_NUM PROC NEAR +[ 141] 01CF: 52 PUSH DX +[ 142] 01D0: 50 PUSH AX +[ 143] 01D1: 56 PUSH SI +[ 144] : +[ 145] 01D2: B9 00 00 MOV CX, 0 +[ 146] : +[ 147] : ; reset flag: +[ 148] 01D5: 2E C6 06 8F 02 00 MOV CS:make_minus, 0 +[ 149] : +[ 150] 01DB: next_digit: +[ 151] : +[ 152] : ; get char from keyboard +[ 153] : ; into AL: +[ 154] 01DB: B4 00 MOV AH, 00h +[ 155] 01DD: CD 16 INT 16h +[ 156] : ; and print it: +[ 157] 01DF: B4 0E MOV AH, 0Eh +[ 158] 01E1: CD 10 INT 10h +[ 159] : +[ 160] : ; check for MINUS: +[ 161] 01E3: 3C 2D CMP AL, '-' +[ 162] 01E5: 74 69 JE set_minus +[ 163] : +[ 164] : ; check for ENTER key: +[ 165] 01E7: 3C 0D CMP AL, 0Dh ; carriage return? +[ 166] 01E9: 75 03 JNE not_cr +[ 167] 01EB: E9 93 00 JMP stop_input +[ 168] 01EE: not_cr: +[ 169] : +[ 170] : +[ 171] 01EE: 3C 08 CMP AL, 8 ; 'BACKSPACE' pressed? +[ 172] 01F0: 75 1E JNE backspace_checked +[ 173] 01F2: BA 00 00 MOV DX, 0 ; remove last digit by +[ 174] 01F5: 8B C1 MOV AX, CX ; division: +[ 175] 01F7: 2E F7 36 04 03 DIV CS:ten ; AX = DX:AX / 10 (DX-rem). +[ 176] 01FC: 8B C8 MOV CX, AX +[ 177] 01FE: 50 B0 20 B4 0E CD 10 58 PUTC ' ' ; clear position. +[ 178] 0206: 50 B0 08 B4 0E CD 10 58 PUTC 8 ; backspace again. +[ 179] 020E: EB CB JMP next_digit +[ 180] 0210: backspace_checked: +[ 181] : +[ 182] : +[ 183] : ; allow only digits: +[ 184] 0210: 3C 30 CMP AL, '0' +[ 185] 0212: 73 02 JAE ok_AE_0 +[ 186] 0214: EB 04 JMP remove_not_digit +[ 187] 0216: ok_AE_0: +[ 188] 0216: 3C 39 CMP AL, '9' +[ 189] 0218: 76 1A JBE ok_digit +[ 190] 021A: remove_not_digit: +[ 191] 021A: 50 B0 08 B4 0E CD 10 58 PUTC 8 ; backspace. +[ 192] 0222: 50 B0 20 B4 0E CD 10 58 PUTC ' ' ; clear last entered not digit. +[ 193] 022A: 50 B0 08 B4 0E CD 10 58 PUTC 8 ; backspace again. +[ 194] 0232: EB A7 JMP next_digit ; wait for next input. +[ 195] 0234: ok_digit: +[ 196] : +[ 197] : +[ 198] : ; multiply CX by 10 (first time the result is zero) +[ 199] 0234: 50 PUSH AX +[ 200] 0235: 8B C1 MOV AX, CX +[ 201] 0237: 2E F7 26 04 03 MUL CS:ten ; DX:AX = AX*10 +[ 202] 023C: 8B C8 MOV CX, AX +[ 203] 023E: 58 POP AX +[ 204] : +[ 205] : ; check if the number is too big +[ 206] : ; (result should be 16 bits) +[ 207] 023F: 83 FA 00 CMP DX, 0 +[ 208] 0242: 75 19 JNE too_big +[ 209] : +[ 210] : ; convert from ASCII code: +[ 211] 0244: 2C 30 SUB AL, 30h +[ 212] : +[ 213] : ; add AL to CX: +[ 214] 0246: B4 00 MOV AH, 0 +[ 215] 0248: 8B D1 MOV DX, CX ; backup, in case the result will be too big. +[ 216] 024A: 03 C8 ADD CX, AX +[ 217] 024C: 72 0A JC too_big2 ; jump if the number is too big. +[ 218] : +[ 219] 024E: EB 8B JMP next_digit +[ 220] : +[ 221] 0250: set_minus: +[ 222] 0250: 2E C6 06 8F 02 01 MOV CS:make_minus, 1 +[ 223] 0256: EB 83 JMP next_digit +[ 224] : +[ 225] 0258: too_big2: +[ 226] 0258: 8B CA MOV CX, DX ; restore the backuped value before add. +[ 227] 025A: BA 00 00 MOV DX, 0 ; DX was zero before backup! +[ 228] 025D: too_big: +[ 229] 025D: 8B C1 MOV AX, CX +[ 230] 025F: 2E F7 36 04 03 DIV CS:ten ; reverse last DX:AX = AX*10, make AX = DX:AX / 10 +[ 231] 0264: 8B C8 MOV CX, AX +[ 232] 0266: 50 B0 08 B4 0E CD 10 58 PUTC 8 ; backspace. +[ 233] 026E: 50 B0 20 B4 0E CD 10 58 PUTC ' ' ; clear last entered digit. +[ 234] 0276: 50 B0 08 B4 0E CD 10 58 PUTC 8 ; backspace again. +[ 235] 027E: E9 5A FF JMP next_digit ; wait for Enter/Backspace. +[ 236] : +[ 237] : +[ 238] 0281: stop_input: +[ 239] : ; check flag: +[ 240] 0281: 2E 80 3E 8F 02 00 CMP CS:make_minus, 0 +[ 241] 0287: 74 02 JE not_minus +[ 242] 0289: F7 D9 NEG CX +[ 243] 028B: not_minus: +[ 244] : +[ 245] 028B: 5E POP SI +[ 246] 028C: 58 POP AX +[ 247] 028D: 5A POP DX +[ 248] 028E: C3 RET +[ 249] 028F: 00 make_minus DB ? ; used as a flag. +[ 250] : SCAN_NUM ENDP +[ 251] : +[ 252] : +[ 253] : +[ 254] : +[ 255] : +[ 256] : ; this procedure prints number in AX, +[ 257] : ; used with PRINT_NUM_UNS to print signed numbers: +[ 258] 0290: PRINT_NUM PROC NEAR +[ 259] 0290: 52 PUSH DX +[ 260] 0291: 50 PUSH AX +[ 261] : +[ 262] 0292: 3D 00 00 CMP AX, 0 +[ 263] 0295: 75 0A JNZ not_zero +[ 264] : +[ 265] 0297: 50 B0 30 B4 0E CD 10 58 PUTC '0' +[ 266] 029F: EB 12 JMP printed +[ 267] : +[ 268] 02A1: not_zero: +[ 269] : ; the check SIGN of AX, +[ 270] : ; make absolute if it's negative: +[ 271] 02A1: 3D 00 00 CMP AX, 0 +[ 272] 02A4: 79 0A JNS positive +[ 273] 02A6: F7 D8 NEG AX +[ 274] : +[ 275] 02A8: 50 B0 2D B4 0E CD 10 58 PUTC '-' +[ 276] : +[ 277] 02B0: positive: +[ 278] 02B0: E8 03 00 CALL PRINT_NUM_UNS +[ 279] 02B3: printed: +[ 280] 02B3: 58 POP AX +[ 281] 02B4: 5A POP DX +[ 282] 02B5: C3 RET +[ 283] : PRINT_NUM ENDP +[ 284] : +[ 285] : +[ 286] : +[ 287] : ; this procedure prints out an unsigned +[ 288] : ; number in AX (not just a single digit) +[ 289] : ; allowed values are from 0 to 65535 (FFFF) +[ 290] 02B6: PRINT_NUM_UNS PROC NEAR +[ 291] 02B6: 50 PUSH AX +[ 292] 02B7: 53 PUSH BX +[ 293] 02B8: 51 PUSH CX +[ 294] 02B9: 52 PUSH DX +[ 295] : +[ 296] : ; flag to prevent printing zeros before number: +[ 297] 02BA: B9 01 00 MOV CX, 1 +[ 298] : +[ 299] : ; (result of "/ 10000" is always less or equal to 9). +[ 300] 02BD: BB 10 27 MOV BX, 10000 ; 2710h - divider. +[ 301] : +[ 302] : ; AX is zero? +[ 303] 02C0: 3D 00 00 CMP AX, 0 +[ 304] 02C3: 74 32 JZ print_zero +[ 305] : +[ 306] 02C5: begin_print: +[ 307] : +[ 308] : ; check divider (if zero go to end_print): +[ 309] 02C5: 83 FB 00 CMP BX,0 +[ 310] 02C8: 74 35 JZ end_print +[ 311] : +[ 312] : ; avoid printing zeros before number: +[ 313] 02CA: 83 F9 00 CMP CX, 0 +[ 314] 02CD: 74 04 JE calc +[ 315] : ; if AX calc.com -- emu8086 assembler version: 4.08 +=================================================================================================== +Name Offset Size Type Segment +=================================================================================================== +MSG1 00102 1 VAR (NOSEG) +MSG2 00149 1 VAR (NOSEG) +MSG3 00161 1 VAR (NOSEG) +NUM 00170 2 VAR (NOSEG) +START 00172 -1 LABEL (NOSEG) +OVERFLOW 0019F -1 LABEL (NOSEG) +S_DCL_LOC1TMP 001A3 1 VAR (NOSEG) +SKIP_DCL_LOC1TMP 001B7 -1 LABEL (NOSEG) +NEXT_CHAR_LOC1TMP 001BA -1 LABEL (NOSEG) +PRINTED_LOC1TMP 001C8 -1 LABEL (NOSEG) +EXIT 001CA -1 LABEL (NOSEG) +SCAN_NUM 001CF -1 NEAR (NOSEG) +NEXT_DIGIT 001DB -1 LABEL (NOSEG) +NOT_CR 001EE -1 LABEL (NOSEG) +BACKSPACE_CHECKED 00210 -1 LABEL (NOSEG) +OK_AE_0 00216 -1 LABEL (NOSEG) +REMOVE_NOT_DIGIT 0021A -1 LABEL (NOSEG) +OK_DIGIT 00234 -1 LABEL (NOSEG) +SET_MINUS 00250 -1 LABEL (NOSEG) +TOO_BIG2 00258 -1 LABEL (NOSEG) +TOO_BIG 0025D -1 LABEL (NOSEG) +STOP_INPUT 00281 -1 LABEL (NOSEG) +NOT_MINUS 0028B -1 LABEL (NOSEG) +MAKE_MINUS 0028F 1 VAR (NOSEG) +PRINT_NUM 00290 -1 NEAR (NOSEG) +NOT_ZERO 002A1 -1 LABEL (NOSEG) +POSITIVE 002B0 -1 LABEL (NOSEG) +PRINTED 002B3 -1 LABEL (NOSEG) +PRINT_NUM_UNS 002B6 -1 NEAR (NOSEG) +BEGIN_PRINT 002C5 -1 LABEL (NOSEG) +CALC 002D3 -1 LABEL (NOSEG) +SKIP 002E7 -1 LABEL (NOSEG) +PRINT_ZERO 002F7 -1 LABEL (NOSEG) +END_PRINT 002FF -1 LABEL (NOSEG) +TEN 00304 2 VAR (NOSEG) +=================================================================================================== +[ 7/16/2024 -- 10:18:01 AM ] +< END > + diff --git a/test/data/extra/celsi.com.debug b/test/data/extra/celsi.com.debug new file mode 100755 index 0000000000000000000000000000000000000000..277f902d123e9e8b0c4aceb0cb53ea9bcb86348d GIT binary patch literal 2136 zcmYk7$xf6(6h@m#WfEi-1OY*2ML+~Zv;~=Eo}HpE;2Jb;4AHGIMpwqA8WTg@`V20N z#+~s2G{lw0IGqo_o7m}-P=~K?Ro(i#I*~{uk`S*yy!5wR52Tpz>x@(XBm50qH>8>H zTa5c5-Gu+bSamW?_-)2}VV4R2i?Q;%O?WLf3-*}snJirSOcOpEpN-RJgf^H0CC=-A zBJySUa>h9(RXON@N?fidfLB8RwaF#$p}narq{Lv3Lxsv(H4GCwT3( z!0dAVsq=++5&7r%7RE&;{Cj)@uGobC={hBN5&kz`Jt#GrS3S;Rk?L2O$-=3}#d!68 zzsbSnLY4FCso0ClgC^%Ia3UYK4?6Ig_kbzD6~X{sz0nznBAm`}8qYgXWn%ra&L6~! zQnKZ64X?FVn+jYdY`9JhUPPUn_O&<>{uW++K4ii_!#CmTO!&8W-aBWn^AG{Fo*JCF9b-dQ!VNR$v zY~Z#2PScC)gWIm(g%?q0)BZS4gujDVA9a_BlhhC|oj-vSk>9e{T`9u9!mE$HCj3Xd z`q^jtU4PqkPU1!6zv6Z0=?>k2ygu{Y`BQii`5$Xjnhz#*Ryse zz$IZAuR9}Y&f*4P4X<-OYlf7CyLjDUgJuLb3Xfc82rtHP zJZ=i!;B~$uM)&Lte8B6u8a1)sZM^R0F{Ar;4t~1MI9|--79bl@RcF#H zl3juxyw-ExEaO%n>HHL4tm4*S%K2%WxPZF|%Xoc{W=zbxiq~)8thq#1TycI5FCu>x qU&nafTqY|v@w!hIOyuvm&LUofzi+>U6X74&FXKe`hxRKt5&ka{WeuSK literal 0 HcmV?d00001 diff --git a/test/data/extra/celsi.com.list b/test/data/extra/celsi.com.list new file mode 100755 index 0000000..0dc20a2 --- /dev/null +++ b/test/data/extra/celsi.com.list @@ -0,0 +1,107 @@ +EMU8086 GENERATED LISTING. MACHINE CODE <- SOURCE. + +celsi.com -- emu8086 assembler version: 4.08 + +[ 7/16/2024 -- 10:19:04 AM ] + +=================================================================================================== +[LINE] LOC: MACHINE CODE SOURCE +=================================================================================================== + +[ 1] : ; centigrade (celsius) to fahrenheit calculation and vice-versa. +[ 2] : ; it may not be accurate, because of integer division. +[ 3] : +[ 4] : ; this program prints out the result in binary code. +[ 5] : ; to see result in hexadecimal or decimal form click vars. +[ 6] : +[ 7] : name "celsi" +[ 8] : +[ 9] : org 100h +[ 10] : +[ 11] 0100: EB 04 jmp start +[ 12] : +[ 13] 0102: 0A tc db 10 ; t celsius. +[ 14] 0103: 00 tf db 0 ; t fahrenheit. +[ 15] : +[ 16] 0104: 00 result1 db ? ; result in fahrenheit. +[ 17] 0105: 00 result2 db ? ; result in celsius. +[ 18] : +[ 19] 0106: start: +[ 20] : +[ 21] : ; convert celsius to fahrenheit according +[ 22] : ; to this formula: f = c * 9 / 5 + 32 +[ 23] : +[ 24] 0106: 8A 0E 02 01 mov cl, tc +[ 25] 010A: B0 09 mov al, 9 +[ 26] 010C: F6 E9 imul cl +[ 27] 010E: B1 05 mov cl, 5 +[ 28] 0110: F6 F9 idiv cl +[ 29] 0112: 04 20 add al, 32 +[ 30] 0114: A2 04 01 mov result1, al +[ 31] : +[ 32] 0117: 8A 1E 04 01 mov bl, result1 +[ 33] 011B: E8 1E 00 call print ; print bl +[ 34] : +[ 35] : +[ 36] : ; convert fahrenheit to celsius according +[ 37] : ; to this formula: c = (f - 32) * 5 / 9 +[ 38] : +[ 39] 011E: 8A 0E 03 01 mov cl, tf +[ 40] 0122: 80 E9 20 sub cl, 32 +[ 41] 0125: B0 05 mov al, 5 +[ 42] 0127: F6 E9 imul cl +[ 43] 0129: B1 09 mov cl, 9 +[ 44] 012B: F6 F9 idiv cl +[ 45] 012D: A2 05 01 mov result2, al +[ 46] : +[ 47] 0130: 8A 1E 05 01 mov bl, result2 +[ 48] 0134: E8 05 00 call print ; print bl +[ 49] : +[ 50] : ; wait for any key press... +[ 51] 0137: B4 00 mov ah, 0 +[ 52] 0139: CD 16 int 16h +[ 53] : +[ 54] : +[ 55] 013B: C3 ret ; return to the operating system. +[ 56] : +[ 57] : +[ 58] : ; procedure prints the binary value of bl +[ 59] 013C: print proc near +[ 60] : +[ 61] 013C: 60 pusha +[ 62] : +[ 63] : ; print result in binary: +[ 64] 013D: B9 08 00 mov cx, 8 +[ 65] 0140: B4 02 p1: mov ah, 2 ; print function. +[ 66] 0142: B2 30 mov dl, '0' +[ 67] 0144: F6 C3 80 test bl, 10000000b ; test first bit. +[ 68] 0147: 74 02 jz zero +[ 69] 0149: B2 31 mov dl, '1' +[ 70] 014B: CD 21 zero: int 21h +[ 71] 014D: D0 E3 shl bl, 1 +[ 72] 014F: E2 EF loop p1 +[ 73] : ; print binary suffix: +[ 74] 0151: B2 62 mov dl, 'b' +[ 75] 0153: CD 21 int 21h +[ 76] : ; print carrige return and new line: +[ 77] 0155: B2 0D mov dl, 0Dh +[ 78] 0157: CD 21 int 21h +[ 79] 0159: B2 0A mov dl, 0Ah +[ 80] 015B: CD 21 int 21h +[ 81] : +[ 82] 015D: 61 popa +[ 83] : +[ 84] 015E: C3 ret ; return to the main program. +[ 85] : print endp +[ 86] : +[ 87] : +[ 88] : +[ 89] : + +=================================================================================================== + + + + + +=================================================================================================== diff --git a/test/data/extra/celsi.com.symbol b/test/data/extra/celsi.com.symbol new file mode 100755 index 0000000..7115e6b --- /dev/null +++ b/test/data/extra/celsi.com.symbol @@ -0,0 +1,16 @@ +< THE SYMBOL TABLE > celsi.com -- emu8086 assembler version: 4.08 +=================================================================================================== +Name Offset Size Type Segment +=================================================================================================== +TC 00102 1 VAR (NOSEG) +TF 00103 1 VAR (NOSEG) +RESULT1 00104 1 VAR (NOSEG) +RESULT2 00105 1 VAR (NOSEG) +START 00106 -1 LABEL (NOSEG) +PRINT 0013C -1 NEAR (NOSEG) +P1 00140 -1 LABEL (NOSEG) +ZERO 0014B -1 LABEL (NOSEG) +=================================================================================================== +[ 7/16/2024 -- 10:19:04 AM ] +< END > + diff --git a/test/data/extra/fact.com.debug b/test/data/extra/fact.com.debug new file mode 100755 index 0000000000000000000000000000000000000000..359692fd52747f4c22a0447d6a94794c1b9f0b26 GIT binary patch literal 8112 zcmYk=37Ajy9>?)RvWz8rOkrja#%@$&$<7Q@DQ?1G>{7BPq|$AXO3AIKx=D*&kC3|A zWy$WUq@v~aR9bH9E$Ma@_x+jqe4i)J|NZ>uyyiE*|2gM>&iVhHBuSEH6#vfgPe04* zQ85?ZhviHv?!sqz`8=Lg_#OOQo=Ujz2U*q}=ezKEEH|f;E_@5iX;jLEf5>umD(%95 zV!0}nap5J|pj0fyg{R>)v9d0_jmMY6Rd`=q^K08w_!wO4UcrUmjB9%@aN!f|6>$|l z$zBOl;ZtzUUD<`-SF$fLA|fKeyH#jxQ+vz+bVpA=V^hd@LjmhhnB7>ui1=_ zdVDKf#rR{mwkyjuXKYLQ+};{jt+3Ygv*)=KQ!&pkxULPCxl29%9Io^Kaworx%5t&O z>t?&lvBGNxuJ^HxYm2v|Cb;Hl>)K-~8`pW>&Rv0Zpq@A{owRqco_V?s6 z$9KS0j2~?8h^g=bTJ_pzN*wtyCZnO~B`PI#J$9m9m zT<2GJmxJZfT3qK>57!gxMH}#REXU`^f{sN`#gRiu44QFT-W}57k(1g{u$&n&vW!6uI(M{p2uFG z-#q^iT*W+RaBWwCTg+G`)cOx~F}}Ec7_P!g*oR{(yrg{urov0xM`9{G#XbsC;pOb3 zF%@3HJ_b|a6>(j^ZgAn%5!jUhntvTN#&zAe!|D6edg|oycj7AM8DO7{DSfYcl_q@}K$ zYrp-~#XNIyeLuU~g)jB|_uy&+b8Mt-xX$-`-6m`^9ryhA;VS0&08e9ijtf77>pRH( zZVPj4rG{MeYG8BSHf%d}!nK|cxYx0rGzc$)J?M7XN8#Guhg`hw82db2g^$HMvHY;p zJiBQnUKe}By@BnaLmodLS9`JjRF0L=dHtw6fE}dHcz0}pJA}PS_u<;!zqz-tw`mdH z4ttEAq@&mgI*zwz`6+saKEOVuYMeycKa1RF*yq#|*Kzo)J8AEZYyUjwVn5{ApT|{r zPrNqEFSzhAxQ^$=PV;|3v+YZ8^(FQdJ%wkmywrV-{hK!9m9b^+8~b6;vm96QZ|Ms> zmE{%gJM4SXhmL%u`@x=yUxKZomq>n^I^k_tUPJ5YSL`g!z+1EY3T>csSV?x+YP>DW z8(k@^G<}KlNH)1L_Mbq0Og6jNZ>Q{Aa20+U*LTCME|4vL*!PIV?r(~Cl_1S}GV!K`VkGS^p8!o&$7gb%) z_qeJ|TAiBWI)3)L3$Ys11LrB(=VG2*ydJjSg^%+*2XIxBKTf54JGY*;yQod zc6Aw~|AS8R_@lUr@zZg3b@Gm@@A3EG8Q3u=&!lCZ|6N?^|Eo=Cr{{kUQ!)Q;oI^2r z-!=94BX|$&xRW=dY8Mop7bkGl9BWCv@f4OnaINeEa2>ZFI(ZgN!mq?Wa;>p!+UoHi zQL*T}{u=v^@~}QM63=G&d)F7cjuzrt z{~uiJpJnzRaTUH6=TJ%hpInT82hYHMb{d~gr*VDGo^pe*!BnYI(RJV# zTn)hrs6MXa;j|lSZ;A6`@~ey2&GJ0|#g)dZ9Q$vW8iuKS`~NUC98(i;ZSNU30#mc_ zEbMnT5>spN>ewGH*5?hJUngf>_+I-tyfA*jkI8;}!gX22_=EOhm%D zn9}{7u{0M?#ZxeKBX$!l_B>@V74s~`t1({pxGK^(#!jJ4xURRAFf|psg^qfj%9x6I zj^VlvRKb+)D{1^EcsgDcQ!&0+m7@Dl)i4#_1lM*|$CT!oPF-f!BmWY0M~YBXIxjB4RIFziCg<0M_xc+A$;;Xs zVk*X$w>QF6_yu?)=E=lVcs8DiH^x->aJ(t5dxk3f5nRW=?(3-sz5c6l9)5i!vu*Gx| zycF+&shB5~N%TD-2UANJyOdhtnkN@i%dq8?i+enu_z3hifsl zmbuqa9?qej^uhYk%h*OLzMCjNLcJ?-%WF%{#V!L>j0 zF}20xm*Bb%48l~5--&BI2V+X()w?*GTzC(52)-5DPT%1?k^)S!-H6G`w@E+_4Jl1m}UJD&M91Y&-Nz!QGU14^Nhn(%(DyE_q3Za^$ue-{s_)fG9FVg{w-YFH33r^ zuTI)0V(J*CezQ-))Vr7}&xfq$nT)CTFqMvLyQX03eM~jOb$(67RIE=ooL?umU@E+a zeHy01bM3ccD!dn-&pgvHb(~30&{B_|fvFh3+&ΞVbR8VJiGZ`z%a_ueRTgsqi)S ZJ1`Z#&VDDR!q?kpV=DYr`(2m{|35=H35Wmy literal 0 HcmV?d00001 diff --git a/test/data/extra/fact.com.list b/test/data/extra/fact.com.list new file mode 100755 index 0000000..839eef4 --- /dev/null +++ b/test/data/extra/fact.com.list @@ -0,0 +1,362 @@ +EMU8086 GENERATED LISTING. MACHINE CODE <- SOURCE. + +fact.com -- emu8086 assembler version: 4.08 + +[ 7/16/2024 -- 10:18:29 AM ] + +=================================================================================================== +[LINE] LOC: MACHINE CODE SOURCE +=================================================================================================== + +[ 1] : ; this example gets the number from the user, +[ 2] : ; and calculates factorial for it. +[ 3] : ; supported input from 0 to 8 inclusive! +[ 4] : +[ 5] : name "fact" +[ 6] : +[ 7] : ; this macro prints a char in AL and advances +[ 8] : ; the current cursor position: +[ 9] : putc macro char +[ 10] : push ax +[ 11] : mov al, char +[ 12] : mov ah, 0eh +[ 13] : int 10h +[ 14] : pop ax +[ 15] : endm +[ 16] : +[ 17] : +[ 18] : +[ 19] : org 100h +[ 20] : +[ 21] 0100: EB 02 jmp start +[ 22] : +[ 23] : +[ 24] 0102: 00 00 result dw ? +[ 25] : +[ 26] : +[ 27] : +[ 28] 0104: start: +[ 29] : +[ 30] : ; get first number: +[ 31] : +[ 32] 0104: BA 0D 01 mov dx, offset msg1 +[ 33] 0107: B4 09 mov ah, 9 +[ 34] 0109: CD 21 int 21h +[ 35] 010B: EB 15 jmp n1 +[ 36] 010D: 0D 0A 65 6E 74 65 72 20 74 68 65 20 msg1 db 0Dh,0Ah, 'enter the number: $' + 6E 75 6D 62 65 72 3A 20 24 +[ 37] 0122: n1: +[ 38] : +[ 39] 0122: E8 7F 00 call scan_num +[ 40] : +[ 41] : +[ 42] : ; factorial of 0 = 1: +[ 43] 0125: B8 01 00 mov ax, 1 +[ 44] 0128: 83 F9 00 cmp cx, 0 +[ 45] 012B: 74 15 je print_result +[ 46] : +[ 47] : ; move the number to bx: +[ 48] : ; cx will be a counter: +[ 49] : +[ 50] 012D: 8B D9 mov bx, cx +[ 51] : +[ 52] 012F: B8 01 00 mov ax, 1 +[ 53] 0132: BB 01 00 mov bx, 1 +[ 54] : +[ 55] 0135: calc_it: +[ 56] 0135: F7 E3 mul bx +[ 57] 0137: 83 FA 00 cmp dx, 0 +[ 58] 013A: 75 25 jne overflow +[ 59] 013C: 43 inc bx +[ 60] 013D: E2 F6 loop calc_it +[ 61] : +[ 62] 013F: A3 02 01 mov result, ax +[ 63] : +[ 64] : +[ 65] 0142: print_result: +[ 66] : +[ 67] : ; print result in ax: +[ 68] 0142: BA 4B 01 mov dx, offset msg2 +[ 69] 0145: B4 09 mov ah, 9 +[ 70] 0147: CD 21 int 21h +[ 71] 0149: EB 0E jmp n2 +[ 72] 014B: 0D 0A 66 61 63 74 6F 72 69 61 6C 3A msg2 db 0Dh,0Ah, 'factorial: $' + 20 24 +[ 73] 0159: n2: +[ 74] : +[ 75] : +[ 76] 0159: A1 02 01 mov ax, result +[ 77] 015C: E8 2C 01 call print_num_uns +[ 78] 015F: EB 3E jmp exit +[ 79] : +[ 80] : +[ 81] 0161: overflow: +[ 82] 0161: BA 6A 01 mov dx, offset msg3 +[ 83] 0164: B4 09 mov ah, 9 +[ 84] 0166: CD 21 int 21h +[ 85] 0168: EB 32 jmp n3 +[ 86] 016A: 0D 0A 74 68 65 20 72 65 73 75 6C 74 msg3 db 0Dh,0Ah, 'the result is too big!', 0Dh,0Ah, 'use values from 0 to 8.$' + 20 69 73 20 74 6F 6F 20 62 69 67 21 + 0D 0A 75 73 65 20 76 61 6C 75 65 73 + 20 66 72 6F 6D 20 30 20 74 6F 20 38 + 2E 24 +[ 87] 019C: n3: +[ 88] 019C: E9 65 FF jmp start +[ 89] : +[ 90] 019F: exit: +[ 91] : +[ 92] : ; wait for any key press: +[ 93] 019F: B4 00 mov ah, 0 +[ 94] 01A1: CD 16 int 16h +[ 95] : +[ 96] 01A3: C3 ret +[ 97] : +[ 98] : +[ 99] : +[ 100] : +[ 101] : +[ 102] : +[ 103] : +[ 104] : +[ 105] : ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +[ 106] : ;;; these functions are copied from emu8086.inc ;;; +[ 107] : ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +[ 108] : +[ 109] : +[ 110] : ; gets the multi-digit SIGNED number from the keyboard, +[ 111] : ; and stores the result in CX register: +[ 112] 01A4: SCAN_NUM PROC NEAR +[ 113] 01A4: 52 PUSH DX +[ 114] 01A5: 50 PUSH AX +[ 115] 01A6: 56 PUSH SI +[ 116] : +[ 117] 01A7: B9 00 00 MOV CX, 0 +[ 118] : +[ 119] : ; reset flag: +[ 120] 01AA: 2E C6 06 64 02 00 MOV CS:make_minus, 0 +[ 121] : +[ 122] 01B0: next_digit: +[ 123] : +[ 124] : ; get char from keyboard +[ 125] : ; into AL: +[ 126] 01B0: B4 00 MOV AH, 00h +[ 127] 01B2: CD 16 INT 16h +[ 128] : ; and print it: +[ 129] 01B4: B4 0E MOV AH, 0Eh +[ 130] 01B6: CD 10 INT 10h +[ 131] : +[ 132] : ; check for MINUS: +[ 133] 01B8: 3C 2D CMP AL, '-' +[ 134] 01BA: 74 69 JE set_minus +[ 135] : +[ 136] : ; check for ENTER key: +[ 137] 01BC: 3C 0D CMP AL, 0Dh ; carriage return? +[ 138] 01BE: 75 03 JNE not_cr +[ 139] 01C0: E9 93 00 JMP stop_input +[ 140] 01C3: not_cr: +[ 141] : +[ 142] : +[ 143] 01C3: 3C 08 CMP AL, 8 ; 'BACKSPACE' pressed? +[ 144] 01C5: 75 1E JNE backspace_checked +[ 145] 01C7: BA 00 00 MOV DX, 0 ; remove last digit by +[ 146] 01CA: 8B C1 MOV AX, CX ; division: +[ 147] 01CC: 2E F7 36 D9 02 DIV CS:ten ; AX = DX:AX / 10 (DX-rem). +[ 148] 01D1: 8B C8 MOV CX, AX +[ 149] 01D3: 50 B0 20 B4 0E CD 10 58 PUTC ' ' ; clear position. +[ 150] 01DB: 50 B0 08 B4 0E CD 10 58 PUTC 8 ; backspace again. +[ 151] 01E3: EB CB JMP next_digit +[ 152] 01E5: backspace_checked: +[ 153] : +[ 154] : +[ 155] : ; allow only digits: +[ 156] 01E5: 3C 30 CMP AL, '0' +[ 157] 01E7: 73 02 JAE ok_AE_0 +[ 158] 01E9: EB 04 JMP remove_not_digit +[ 159] 01EB: ok_AE_0: +[ 160] 01EB: 3C 39 CMP AL, '9' +[ 161] 01ED: 76 1A JBE ok_digit +[ 162] 01EF: remove_not_digit: +[ 163] 01EF: 50 B0 08 B4 0E CD 10 58 PUTC 8 ; backspace. +[ 164] 01F7: 50 B0 20 B4 0E CD 10 58 PUTC ' ' ; clear last entered not digit. +[ 165] 01FF: 50 B0 08 B4 0E CD 10 58 PUTC 8 ; backspace again. +[ 166] 0207: EB A7 JMP next_digit ; wait for next input. +[ 167] 0209: ok_digit: +[ 168] : +[ 169] : +[ 170] : ; multiply CX by 10 (first time the result is zero) +[ 171] 0209: 50 PUSH AX +[ 172] 020A: 8B C1 MOV AX, CX +[ 173] 020C: 2E F7 26 D9 02 MUL CS:ten ; DX:AX = AX*10 +[ 174] 0211: 8B C8 MOV CX, AX +[ 175] 0213: 58 POP AX +[ 176] : +[ 177] : ; check if the number is too big +[ 178] : ; (result should be 16 bits) +[ 179] 0214: 83 FA 00 CMP DX, 0 +[ 180] 0217: 75 19 JNE too_big +[ 181] : +[ 182] : ; convert from ASCII code: +[ 183] 0219: 2C 30 SUB AL, 30h +[ 184] : +[ 185] : ; add AL to CX: +[ 186] 021B: B4 00 MOV AH, 0 +[ 187] 021D: 8B D1 MOV DX, CX ; backup, in case the result will be too big. +[ 188] 021F: 03 C8 ADD CX, AX +[ 189] 0221: 72 0A JC too_big2 ; jump if the number is too big. +[ 190] : +[ 191] 0223: EB 8B JMP next_digit +[ 192] : +[ 193] 0225: set_minus: +[ 194] 0225: 2E C6 06 64 02 01 MOV CS:make_minus, 1 +[ 195] 022B: EB 83 JMP next_digit +[ 196] : +[ 197] 022D: too_big2: +[ 198] 022D: 8B CA MOV CX, DX ; restore the backuped value before add. +[ 199] 022F: BA 00 00 MOV DX, 0 ; DX was zero before backup! +[ 200] 0232: too_big: +[ 201] 0232: 8B C1 MOV AX, CX +[ 202] 0234: 2E F7 36 D9 02 DIV CS:ten ; reverse last DX:AX = AX*10, make AX = DX:AX / 10 +[ 203] 0239: 8B C8 MOV CX, AX +[ 204] 023B: 50 B0 08 B4 0E CD 10 58 PUTC 8 ; backspace. +[ 205] 0243: 50 B0 20 B4 0E CD 10 58 PUTC ' ' ; clear last entered digit. +[ 206] 024B: 50 B0 08 B4 0E CD 10 58 PUTC 8 ; backspace again. +[ 207] 0253: E9 5A FF JMP next_digit ; wait for Enter/Backspace. +[ 208] : +[ 209] : +[ 210] 0256: stop_input: +[ 211] : ; check flag: +[ 212] 0256: 2E 80 3E 64 02 00 CMP CS:make_minus, 0 +[ 213] 025C: 74 02 JE not_minus +[ 214] 025E: F7 D9 NEG CX +[ 215] 0260: not_minus: +[ 216] : +[ 217] 0260: 5E POP SI +[ 218] 0261: 58 POP AX +[ 219] 0262: 5A POP DX +[ 220] 0263: C3 RET +[ 221] 0264: 00 make_minus DB ? ; used as a flag. +[ 222] : SCAN_NUM ENDP +[ 223] : +[ 224] : +[ 225] : +[ 226] : +[ 227] : +[ 228] : ; this procedure prints number in AX, +[ 229] : ; used with PRINT_NUM_UNS to print signed numbers: +[ 230] 0265: PRINT_NUM PROC NEAR +[ 231] 0265: 52 PUSH DX +[ 232] 0266: 50 PUSH AX +[ 233] : +[ 234] 0267: 3D 00 00 CMP AX, 0 +[ 235] 026A: 75 0A JNZ not_zero +[ 236] : +[ 237] 026C: 50 B0 30 B4 0E CD 10 58 PUTC '0' +[ 238] 0274: EB 12 JMP printed +[ 239] : +[ 240] 0276: not_zero: +[ 241] : ; the check SIGN of AX, +[ 242] : ; make absolute if it's negative: +[ 243] 0276: 3D 00 00 CMP AX, 0 +[ 244] 0279: 79 0A JNS positive +[ 245] 027B: F7 D8 NEG AX +[ 246] : +[ 247] 027D: 50 B0 2D B4 0E CD 10 58 PUTC '-' +[ 248] : +[ 249] 0285: positive: +[ 250] 0285: E8 03 00 CALL PRINT_NUM_UNS +[ 251] 0288: printed: +[ 252] 0288: 58 POP AX +[ 253] 0289: 5A POP DX +[ 254] 028A: C3 RET +[ 255] : PRINT_NUM ENDP +[ 256] : +[ 257] : +[ 258] : +[ 259] : ; this procedure prints out an unsigned +[ 260] : ; number in AX (not just a single digit) +[ 261] : ; allowed values are from 0 to 65535 (FFFF) +[ 262] 028B: PRINT_NUM_UNS PROC NEAR +[ 263] 028B: 50 PUSH AX +[ 264] 028C: 53 PUSH BX +[ 265] 028D: 51 PUSH CX +[ 266] 028E: 52 PUSH DX +[ 267] : +[ 268] : ; flag to prevent printing zeros before number: +[ 269] 028F: B9 01 00 MOV CX, 1 +[ 270] : +[ 271] : ; (result of "/ 10000" is always less or equal to 9). +[ 272] 0292: BB 10 27 MOV BX, 10000 ; 2710h - divider. +[ 273] : +[ 274] : ; AX is zero? +[ 275] 0295: 3D 00 00 CMP AX, 0 +[ 276] 0298: 74 32 JZ print_zero +[ 277] : +[ 278] 029A: begin_print: +[ 279] : +[ 280] : ; check divider (if zero go to end_print): +[ 281] 029A: 83 FB 00 CMP BX,0 +[ 282] 029D: 74 35 JZ end_print +[ 283] : +[ 284] : ; avoid printing zeros before number: +[ 285] 029F: 83 F9 00 CMP CX, 0 +[ 286] 02A2: 74 04 JE calc +[ 287] : ; if AX fact.com -- emu8086 assembler version: 4.08 +=================================================================================================== +Name Offset Size Type Segment +=================================================================================================== +RESULT 00102 2 VAR (NOSEG) +START 00104 -1 LABEL (NOSEG) +MSG1 0010D 1 VAR (NOSEG) +N1 00122 -1 LABEL (NOSEG) +CALC_IT 00135 -1 LABEL (NOSEG) +PRINT_RESULT 00142 -1 LABEL (NOSEG) +MSG2 0014B 1 VAR (NOSEG) +N2 00159 -1 LABEL (NOSEG) +OVERFLOW 00161 -1 LABEL (NOSEG) +MSG3 0016A 1 VAR (NOSEG) +N3 0019C -1 LABEL (NOSEG) +EXIT 0019F -1 LABEL (NOSEG) +SCAN_NUM 001A4 -1 NEAR (NOSEG) +NEXT_DIGIT 001B0 -1 LABEL (NOSEG) +NOT_CR 001C3 -1 LABEL (NOSEG) +BACKSPACE_CHECKED 001E5 -1 LABEL (NOSEG) +OK_AE_0 001EB -1 LABEL (NOSEG) +REMOVE_NOT_DIGIT 001EF -1 LABEL (NOSEG) +OK_DIGIT 00209 -1 LABEL (NOSEG) +SET_MINUS 00225 -1 LABEL (NOSEG) +TOO_BIG2 0022D -1 LABEL (NOSEG) +TOO_BIG 00232 -1 LABEL (NOSEG) +STOP_INPUT 00256 -1 LABEL (NOSEG) +NOT_MINUS 00260 -1 LABEL (NOSEG) +MAKE_MINUS 00264 1 VAR (NOSEG) +PRINT_NUM 00265 -1 NEAR (NOSEG) +NOT_ZERO 00276 -1 LABEL (NOSEG) +POSITIVE 00285 -1 LABEL (NOSEG) +PRINTED 00288 -1 LABEL (NOSEG) +PRINT_NUM_UNS 0028B -1 NEAR (NOSEG) +BEGIN_PRINT 0029A -1 LABEL (NOSEG) +CALC 002A8 -1 LABEL (NOSEG) +SKIP 002BC -1 LABEL (NOSEG) +PRINT_ZERO 002CC -1 LABEL (NOSEG) +END_PRINT 002D4 -1 LABEL (NOSEG) +TEN 002D9 2 VAR (NOSEG) +=================================================================================================== +[ 7/16/2024 -- 10:18:29 AM ] +< END > + diff --git a/test/data/extra/hex.com.debug b/test/data/extra/hex.com.debug new file mode 100755 index 0000000000000000000000000000000000000000..50b0cfb9f9ad46226985f3de1d044e8a03adba4f GIT binary patch literal 2928 zcmXw*OH5T)6o!uoR=o9v2nZ;kh^T-f;)5bpgjy9JV13}LiXgs<3aHrHTGZAiHtoQH zPK_OCOgd_trpAF2wQ1CmHpax)#55h4*kMiE?@#}AbG~r*$A8z^ckO-7xk-{FV`c`(F;U&gov(oFdCj2FOA6aF{n()laG-{pNiWSH<}1q zehgkj{xrUfvDQI^ziOX_6XEaUYZ#9+;nQe>`jBnHrz2P4)N7H(=hLATuWXLVzzv5k zyuNF$$;6F-UOY#VXQF;TQfo57q?|v2pM%rdi^zYE*W3$?@+09UUgs?|qj00)9$srZ z(Tu^3h2QZU$s`l?A0f5ZicFUCPw=W=Y~;tmpZJ-$5|fP^4>@db)t_vlejdIKH^trBOqsMCqpJhk>B-}$|Gji;H&e~VW?%Z>5{a1;LyZo1KRG7;Y3 zHUAkV>imOOAM~BYBW|OUkLQblEqBRq9a5YeY*F1HP z6H%uMuX!#qbDgh2YM(Ti$hYIwuXl~|wQvrv^DQ>>aP#37Uguq6qRt(>`rK$1IRC(Y zDPG7ggco>yuO?H6TLiE1+Oy3j>gNyp-@k_!4P=){ z85_(-+!pAZ#^KLSFj&6fKyyn?%w&QldpzCbLi>PxNU&45c*-2J>hu8ku zYC3Sc;0M>)h8I!iCp<^8-E=yC1F8M+p^@)~m#(t|FQU#L_yWc|P55*kYMM`n(eH!( zkd05_c9{dX9w@?>;X2Jh+#zVjtN&f*Fs>Kc@m09prVn=n&f<06Zlm85$KZnN?7@ox z+;O<({9c^+821TW$7eC#XHMWgg}ZpI<9_oQ?j$_IYuyi+=)+^Yp7|e{@PFZTUG$jG zsWAxJT|C-Lya$>8qbmRnJ;l?p$@6~{U++v l+aJM;@D27yaU%R;`(ro}z7b!_c))zcImK@0kK;w;{{viyhco~H literal 0 HcmV?d00001 diff --git a/test/data/extra/hex.com.list b/test/data/extra/hex.com.list new file mode 100755 index 0000000..1216cc6 --- /dev/null +++ b/test/data/extra/hex.com.list @@ -0,0 +1,140 @@ +EMU8086 GENERATED LISTING. MACHINE CODE <- SOURCE. + +hex.com -- emu8086 assembler version: 4.08 + +[ 7/16/2024 -- 10:19:23 AM ] + +=================================================================================================== +[LINE] LOC: MACHINE CODE SOURCE +=================================================================================================== + +[ 1] : ; hex convertor. +[ 2] : ; this example converts a 2 digit hexadecimal number +[ 3] : ; into a numeric value and then into decimal/ascii string representation, +[ 4] : ; and finally it prints out the result in binary code. +[ 5] : +[ 6] : ; to see decimal string: +[ 7] : ; 1. click "vars" +[ 8] : ; 2. click "result" variable +[ 9] : ; 3. enter "3" for the elements and "ascii" for show as. +[ 10] : +[ 11] : +[ 12] : name "hex" +[ 13] : +[ 14] : org 100h +[ 15] : +[ 16] 0100: EB 09 jmp start +[ 17] : +[ 18] : ; source hex value is 2 char string. +[ 19] : ; numeric value is stored into temp, +[ 20] : ; and string decimal value is stored into result. +[ 21] : +[ 22] 0102: 31 62 00 source db '1b', 0 ; 1bh is converted to 27 (decimal) 00011011b (binary) +[ 23] 0105: 30 30 30 00 result db '000', 0 +[ 24] 0109: 00 00 temp dw ? +[ 25] : +[ 26] 010B: start: +[ 27] : ; convert first digit to value 0..15 from ascii: +[ 28] 010B: A0 02 01 mov al, source[0] +[ 29] 010E: 3C 30 cmp al, '0' +[ 30] 0110: 73 00 jae f1 +[ 31] : +[ 32] 0112: f1: +[ 33] 0112: 3C 39 cmp al, '9' +[ 34] 0114: 77 04 ja f2 ; jumps only if not '0' to '9'. +[ 35] : +[ 36] 0116: 2C 30 sub al, 30h ; convert char '0' to '9' to numeric value. +[ 37] 0118: EB 04 jmp num1_ready +[ 38] : +[ 39] 011A: f2: +[ 40] : ; gets here if it's 'a' to 'f' case: +[ 41] 011A: 0C 20 or al, 00100000b ; remove upper case (if any). +[ 42] 011C: 2C 57 sub al, 57h ; convert char 'a' to 'f' to numeric value. +[ 43] : +[ 44] 011E: num1_ready: +[ 45] 011E: B3 10 mov bl, 16 +[ 46] 0120: F6 E3 mul bl ; ax = al * bl +[ 47] : +[ 48] 0122: A3 09 01 mov temp, ax +[ 49] : +[ 50] : ; convert second digit to value 0..15 from ascii: +[ 51] 0125: A0 03 01 mov al, source[1] +[ 52] 0128: 3C 30 cmp al, '0' +[ 53] 012A: 73 00 jae g1 +[ 54] : +[ 55] 012C: g1: +[ 56] 012C: 3C 39 cmp al, '9' +[ 57] 012E: 77 04 ja g2 ; jumps only if not '0' to '9'. +[ 58] : +[ 59] 0130: 2C 30 sub al, 30h ; convert char '0' to '9' to numeric value. +[ 60] 0132: EB 04 jmp num2_ready +[ 61] : +[ 62] 0134: g2: +[ 63] : ; gets here if it's 'a' to 'f' case: +[ 64] 0134: 0C 20 or al, 00100000b ; remove upper case (if any). +[ 65] 0136: 2C 57 sub al, 57h ; convert char 'a' to 'f' to numeric value. +[ 66] : +[ 67] 0138: num2_ready: +[ 68] 0138: 32 E4 xor ah, ah +[ 69] 013A: 01 06 09 01 add temp, ax +[ 70] : ; convertion from hex string complete! +[ 71] 013E: FF 36 09 01 push temp ; store original temp value. +[ 72] : +[ 73] : ; convert to decimal string, +[ 74] : ; it has to be 3 decimal digits or less: +[ 75] : +[ 76] 0142: BF 02 00 mov di, 2 ; point to top of the string. +[ 77] : +[ 78] 0145: next_digit: +[ 79] : +[ 80] 0145: 83 3E 09 01 00 cmp temp, 0 +[ 81] 014A: 74 18 je stop +[ 82] : +[ 83] 014C: A1 09 01 mov ax, temp +[ 84] 014F: B3 0A mov bl, 10 +[ 85] 0151: F6 F3 div bl ; al = ax / operand, ah = remainder. +[ 86] 0153: 88 A5 05 01 mov result[di], ah +[ 87] 0157: 80 85 05 01 30 add result[di], 30h ; convert to ascii. +[ 88] : +[ 89] 015C: 32 E4 xor ah, ah +[ 90] 015E: A3 09 01 mov temp, ax +[ 91] : +[ 92] 0161: 4F dec di ; next digit in string. +[ 93] 0162: EB E1 jmp next_digit +[ 94] : +[ 95] 0164: stop: +[ 96] 0164: 8F 06 09 01 pop temp ; re-store original temp value. +[ 97] : +[ 98] : ; print result in binary: +[ 99] 0168: 8A 1E 09 01 mov bl, b.temp +[ 100] 016C: B9 08 00 mov cx, 8 +[ 101] 016F: B4 02 print: mov ah, 2 ; print function. +[ 102] 0171: B2 30 mov dl, '0' +[ 103] 0173: F6 C3 80 test bl, 10000000b ; test first bit. +[ 104] 0176: 74 02 jz zero +[ 105] 0178: B2 31 mov dl, '1' +[ 106] 017A: CD 21 zero: int 21h +[ 107] 017C: D0 E3 shl bl, 1 +[ 108] 017E: E2 EF loop print +[ 109] : +[ 110] : ; print binary suffix: +[ 111] 0180: B2 62 mov dl, 'b' +[ 112] 0182: CD 21 int 21h +[ 113] : +[ 114] : ; wait for any key press: +[ 115] 0184: B4 00 mov ah, 0 +[ 116] 0186: CD 16 int 16h +[ 117] : +[ 118] : +[ 119] : +[ 120] : +[ 121] 0188: C3 ret ; return to operating system. +[ 122] : + +=================================================================================================== + + + + + +=================================================================================================== diff --git a/test/data/extra/hex.com.symbol b/test/data/extra/hex.com.symbol new file mode 100755 index 0000000..54f4646 --- /dev/null +++ b/test/data/extra/hex.com.symbol @@ -0,0 +1,22 @@ +< THE SYMBOL TABLE > hex.com -- emu8086 assembler version: 4.08 +=================================================================================================== +Name Offset Size Type Segment +=================================================================================================== +SOURCE 00102 1 VAR (NOSEG) +RESULT 00105 1 VAR (NOSEG) +TEMP 00109 2 VAR (NOSEG) +START 0010B -1 LABEL (NOSEG) +F1 00112 -1 LABEL (NOSEG) +F2 0011A -1 LABEL (NOSEG) +NUM1_READY 0011E -1 LABEL (NOSEG) +G1 0012C -1 LABEL (NOSEG) +G2 00134 -1 LABEL (NOSEG) +NUM2_READY 00138 -1 LABEL (NOSEG) +NEXT_DIGIT 00145 -1 LABEL (NOSEG) +STOP 00164 -1 LABEL (NOSEG) +PRINT 0016F -1 LABEL (NOSEG) +ZERO 0017A -1 LABEL (NOSEG) +=================================================================================================== +[ 7/16/2024 -- 10:19:23 AM ] +< END > + diff --git a/test/data/extra/keybrd.com.debug b/test/data/extra/keybrd.com.debug new file mode 100755 index 0000000000000000000000000000000000000000..5590c8aac48511322cf41822c4823f62afea682e GIT binary patch literal 1440 zcmXw(J5N+m7)7tc`^~@r!$U;z0my)$IHHMmL~U%0v9K~hJ7Wxqg~XcJ7^9UE65|h$ zKS2Bg#)8m8Y>cIyu@KfKdr$7l%(u=r`<{F5xwj~a;xgoO$Vb2B=HY~ie@xu~B@@3& zz3efK$8Xs+@-5;&^ZO<=nfQHb{lD47|D?VIEhfH?2~Of#P5csGb8Iv5b$k!5-NdiB zzXLDgZ{xeEJ5Brp_jln%{6qX0wf-aG*YFi;om*&OORxbtU$1GPZiM%sxtC27bu(;& zuB*=^e+z#K*Kgu?@IyGATg30-)jMF~e>r~;FXDgWHE(5!7HZAsuluVwk^X=95$a(R zUt#i^hsH$w6kfTbM)|F93$Hn9O+_279q!}DsZW{?TqnH1a~zLpJo#(L32Lp8i2s0B z?u3co#_M`dn=Z1u;TvA}`;6(q^}=^N$MIg&eoW2}r0&&O6Mul$y*+2jWN0t{!7Kl~ z>Bm*zKc1twV3MPUMe9Cg;;VS&Pn!WU24NbneK})>a8;<|m4DGBXBn@3Fl&bC9f5mz ztz*rk|Cw{<@FM;>UeE5l8FkJ}yxswNwuQV{cg_M%B}H&1WLS&v}Q}@Dee`_;FW#Vtm8hyBfQq2Za(3@!UkUJcFkm-Z}7SpF literal 0 HcmV?d00001 diff --git a/test/data/extra/keybrd.com.list b/test/data/extra/keybrd.com.list new file mode 100755 index 0000000..cc9ca4a --- /dev/null +++ b/test/data/extra/keybrd.com.list @@ -0,0 +1,87 @@ +EMU8086 GENERATED LISTING. MACHINE CODE <- SOURCE. + +keybrd.com -- emu8086 assembler version: 4.08 + +[ 7/16/2024 -- 10:19:37 AM ] + +=================================================================================================== +[LINE] LOC: MACHINE CODE SOURCE +=================================================================================================== + +[ 1] : ; this sample shows the use of keyboard functions. +[ 2] : ; try typing something into emulator screen. +[ 3] : ; +[ 4] : ; keyboard buffer is used, when someone types too fast. +[ 5] : ; +[ 6] : ; for realistic emulation, run this example at maximum speed +[ 7] : ; +[ 8] : ; this code will loop until you press esc key, +[ 9] : ; all other keys will be printed. +[ 10] : +[ 11] : name "keybrd" +[ 12] : +[ 13] : org 100h +[ 14] : +[ 15] : ; print a welcome message: +[ 16] 0100: BA 1C 01 mov dx, offset msg +[ 17] 0103: B4 09 mov ah, 9 +[ 18] 0105: CD 21 int 21h +[ 19] : +[ 20] : ;============================ +[ 21] : ; eternal loop to get +[ 22] : ; and print keys: +[ 23] : +[ 24] 0107: wait_for_key: +[ 25] : +[ 26] : ; check for keystroke in +[ 27] : ; keyboard buffer: +[ 28] 0107: B4 01 mov ah, 1 +[ 29] 0109: CD 16 int 16h +[ 30] 010B: 74 FA jz wait_for_key +[ 31] : +[ 32] : ; get keystroke from keyboard: +[ 33] : ; (remove from the buffer) +[ 34] 010D: B4 00 mov ah, 0 +[ 35] 010F: CD 16 int 16h +[ 36] : +[ 37] : ; print the key: +[ 38] 0111: B4 0E mov ah, 0eh +[ 39] 0113: CD 10 int 10h +[ 40] : +[ 41] : ; press 'esc' to exit: +[ 42] 0115: 3C 1B cmp al, 1bh +[ 43] 0117: 74 02 jz exit +[ 44] : +[ 45] 0119: EB EC jmp wait_for_key +[ 46] : ;============================ +[ 47] : +[ 48] 011B: exit: +[ 49] 011B: C3 ret +[ 50] : +[ 51] 011C: 54 79 70 65 20 61 6E 79 74 68 69 6E msg db "Type anything...", 0Dh,0Ah + 67 2E 2E 2E 0D 0A +[ 52] 012E: 5B 45 6E 74 65 72 5D 20 2D 20 63 61 db "[Enter] - carriage return.", 0Dh,0Ah + 72 72 69 61 67 65 20 72 65 74 75 72 + 6E 2E 0D 0A +[ 53] 014A: 5B 43 74 72 6C 5D 2B 5B 45 6E 74 65 db "[Ctrl]+[Enter] - line feed.", 0Dh,0Ah + 72 5D 20 2D 20 6C 69 6E 65 20 66 65 + 65 64 2E 0D 0A +[ 54] 0167: 59 6F 75 20 6D 61 79 20 68 65 61 72 db "You may hear a beep", 0Dh,0Ah + 20 61 20 62 65 65 70 0D 0A +[ 55] 017C: 20 20 20 20 77 68 65 6E 20 62 75 66 db " when buffer is overflown.", 0Dh,0Ah + 66 65 72 20 69 73 20 6F 76 65 72 66 + 6C 6F 77 6E 2E 0D 0A +[ 56] 019B: 50 72 65 73 73 20 45 73 63 20 74 6F db "Press Esc to exit.", 0Dh,0Ah, "$" + 20 65 78 69 74 2E 0D 0A 24 +[ 57] : +[ 58] : end +[ 59] : +[ 60] : + +=================================================================================================== + + + + + +=================================================================================================== diff --git a/test/data/extra/keybrd.com.symbol b/test/data/extra/keybrd.com.symbol new file mode 100755 index 0000000..1d4f384 --- /dev/null +++ b/test/data/extra/keybrd.com.symbol @@ -0,0 +1,11 @@ +< THE SYMBOL TABLE > keybrd.com -- emu8086 assembler version: 4.08 +=================================================================================================== +Name Offset Size Type Segment +=================================================================================================== +WAIT_FOR_KEY 00107 -1 LABEL (NOSEG) +EXIT 0011B -1 LABEL (NOSEG) +MSG 0011C 1 VAR (NOSEG) +=================================================================================================== +[ 7/16/2024 -- 10:19:37 AM ] +< END > + diff --git a/test/data/extra/mouse.com.debug b/test/data/extra/mouse.com.debug new file mode 100755 index 0000000000000000000000000000000000000000..bf074c5e4a97e1dfd4f5327c42b1a13d82aa2e75 GIT binary patch literal 4152 zcmXxnXKa;a9ES13C?K@7We;0gQD!Nlw3Jbxl(JV#8D*-VfSB+_K~cfPKnc-AaeyX{ z7*wF5H~>Y(@WD|jAd+GND4H-tCCIYs2l2Y){*zwmIln%A&ig*+eV9MRKHE`jnJa6fr>F41Ywnltc;azy#oEp3Eo;=s@C%N$6JkO#gE_@=-Z>Od%d}cY6NLm;1UZh1cRbPF;5@{4}oP$aLZLxYk+M zqY7`r!D!vHTzETsHm<_E;acb0TzDR?b?)lIi*T)ju3Z&gg7cNQ!-bcETH|gmd>*cK z=qhsP3a`SoKD}J{s~+DQSK+&Goo|i{{|wjp>Y7&JU*S66To--_ z=PS|Ig&(o^!&UfET<6>0X(MVtr#yZDu44R;9-oJ)hKy}Q7wiKu)fh{nYxaChHNl$F z4bNYIshGb3n;Jh#407R(aP2*Xu9@d)f$O~;?Bu%F`{BB7hqxA43YFm6tA@IkSSn4z z^}54cyzUfS_im93UxaI~8t&4VBb`>@TF()#71o+o<9gkZt_{|fp1}3G#V+PwXCH;D z@G873&r4kR4qUH0+O=cu4zwHB>y|q0cb#az$B)5PXDowiaIN!Lmx*&$Hj3bt=X-I<9?u9xWpIV(Q{~7Go;r$;RjN{2qEx z-x>P_t+B7f*3*}m_L7tKDr_@#$8?Vtaxi+Yw$L`(fPGD?aK0tByLjD)aqYD`T=*tj z>tF3^_~nE2GOqQ1+tp&aN8j}PJ8>2BY{T`L@Qyp|@%ughySS2nOEsQ<7p8PSf2VNm z@9()|SRGx&^?tqYj$+mVnl3aVnYFzj4 zA(xD$(0V)-JM3CwY4p7P2wq3&SO#tN{Kv6#l!*7eKN1y>`mVme{J zfL)?dnD(9vxYqvPt!VF z_m}ol^$hkby@Kobwa2PB{@3ii%wB-0YuI&qz&;35e`58t7S}oyV(KsK zZ`y!s9R_16UUws&gAc(b&_9gr$sWAN^H0Q7FRV8m@cff7m4o%6Z#@5GOvU`QI9pa? z3Z`-ytB!iS{vKB`{+N9lro!uRUAOuyQ+++p8C>gDjwyM6x`gX~nU1LeSRUQLQ}7B* z4a8J3iPr?QZBA}W?^bDHiU-ay63` zsqxqZ+Kabkp1UwL5t~f49)CBcreIU)6t4ALgsEv*8C|sNZw6J4O{ahD`ujjtU^6I{ zMbkX@VrnKfi?VR7=MqfKw)XR|UA%a~Y;8F;$GSMJMjVR9tUkaosP=F%>@E Jem|zd{{t=jSLpx% literal 0 HcmV?d00001 diff --git a/test/data/extra/mouse.com.list b/test/data/extra/mouse.com.list new file mode 100755 index 0000000..6faacfa --- /dev/null +++ b/test/data/extra/mouse.com.list @@ -0,0 +1,245 @@ +EMU8086 GENERATED LISTING. MACHINE CODE <- SOURCE. + +mouse.com -- emu8086 assembler version: 4.08 + +[ 7/16/2024 -- 10:20:08 AM ] + +=================================================================================================== +[LINE] LOC: MACHINE CODE SOURCE +=================================================================================================== + +[ 1] : ; mouse test +[ 2] : +[ 3] : name "mouse" +[ 4] : +[ 5] : org 100h +[ 6] : +[ 7] : print macro x, y, attrib, sdat +[ 8] : LOCAL s_dcl, skip_dcl, s_dcl_end +[ 9] : pusha +[ 10] : mov dx, cs +[ 11] : mov es, dx +[ 12] : mov ah, 13h +[ 13] : mov al, 1 +[ 14] : mov bh, 0 +[ 15] : mov bl, attrib +[ 16] : mov cx, offset s_dcl_end - offset s_dcl +[ 17] : mov dl, x +[ 18] : mov dh, y +[ 19] : mov bp, offset s_dcl +[ 20] : int 10h +[ 21] : popa +[ 22] : jmp skip_dcl +[ 23] : s_dcl DB sdat +[ 24] : s_dcl_end DB 0 +[ 25] : skip_dcl: +[ 26] : endm +[ 27] : +[ 28] : clear_screen macro +[ 29] : pusha +[ 30] : mov ax, 0600h +[ 31] : mov bh, 0000_1111b +[ 32] : mov cx, 0 +[ 33] : mov dh, 24 +[ 34] : mov dl, 79 +[ 35] : int 10h +[ 36] : popa +[ 37] : endm +[ 38] : +[ 39] : print_space macro num +[ 40] : pusha +[ 41] : mov ah, 9 +[ 42] : mov al, ' ' +[ 43] : mov bl, 0000_1111b +[ 44] : mov cx, num +[ 45] : int 10h +[ 46] : popa +[ 47] : endm +[ 48] : +[ 49] : +[ 50] 0100: EB 06 jmp start +[ 51] : +[ 52] 0102: 00 00 curX dw 0 +[ 53] 0104: 00 00 curY dw 0 +[ 54] 0106: 00 00 curB dw 0 +[ 55] : +[ 56] : +[ 57] 0108: start: +[ 58] 0108: B8 03 10 mov ax, 1003h ; disable blinking. +[ 59] 010B: BB 00 00 mov bx, 0 +[ 60] 010E: CD 10 int 10h +[ 61] : +[ 62] : ; hide text cursor: +[ 63] 0110: B5 20 mov ch, 32 +[ 64] 0112: B4 01 mov ah, 1 +[ 65] 0114: CD 10 int 10h +[ 66] : +[ 67] : +[ 68] : ; reset mouse and get its status: +[ 69] 0116: B8 00 00 mov ax, 0 +[ 70] 0119: CD 33 int 33h +[ 71] 011B: 3D 00 00 cmp ax, 0 +[ 72] 011E: 75 35 jne ok +[ 73] 0120: 60 8C CA 8E C2 B4 13 B0 01 B7 00 B3 print 1,1,0010_1111b, " mouse not found :-( " + 2F B9 15 00 B2 01 B6 01 BD 3C 01 CD + 10 61 EB 16 20 6D 6F 75 73 65 20 6E + 6F 74 20 66 6F 75 6E 64 20 3A 2D 28 + 20 00 +[ 74] 0152: E9 9D 02 jmp stop +[ 75] : +[ 76] 0155: ok: +[ 77] 0155: 60 B8 00 06 B7 0F B9 00 00 B6 18 B2 clear_screen + 4F CD 10 61 +[ 78] : +[ 79] 0165: 60 8C CA 8E C2 B4 13 B0 01 B7 00 B3 print 7,7,0010_1011b," note: in the emulator you may need to press and hold mouse buttons " + 2B B9 44 00 B2 07 B6 07 BD 81 01 CD + 10 61 EB 45 20 6E 6F 74 65 3A 20 69 + 6E 20 74 68 65 20 65 6D 75 6C 61 74 + 6F 72 20 79 6F 75 20 6D 61 79 20 6E + 65 65 64 20 74 6F 20 70 72 65 73 73 + 20 61 6E 64 20 68 6F 6C 64 20 6D 6F + 75 73 65 20 62 75 74 74 6F 6E 73 20 + 00 +[ 80] 01C6: 60 8C CA 8E C2 B4 13 B0 01 B7 00 B3 print 7,8,0010_1011b," because mouse interrupts are not processed in real time. " + 2B B9 44 00 B2 07 B6 08 BD E2 01 CD + 10 61 EB 45 20 62 65 63 61 75 73 65 + 20 6D 6F 75 73 65 20 69 6E 74 65 72 + 72 75 70 74 73 20 61 72 65 20 6E 6F + 74 20 70 72 6F 63 65 73 73 65 64 20 + 69 6E 20 72 65 61 6C 20 74 69 6D 65 + 2E 20 20 20 20 20 20 20 20 20 20 20 + 00 +[ 81] 0227: 60 8C CA 8E C2 B4 13 B0 01 B7 00 B3 print 7,9,0010_1011b," for a real test, click external->run from the menu. " + 2B B9 44 00 B2 07 B6 09 BD 43 02 CD + 10 61 EB 45 20 66 6F 72 20 61 20 72 + 65 61 6C 20 74 65 73 74 2C 20 63 6C + 69 63 6B 20 65 78 74 65 72 6E 61 6C + 2D 3E 72 75 6E 20 66 72 6F 6D 20 74 + 68 65 20 6D 65 6E 75 2E 20 20 20 20 + 20 20 20 20 20 20 20 20 20 20 20 20 + 00 +[ 82] 0288: 60 8C CA 8E C2 B4 13 B0 01 B7 00 B3 print 10,11,0010_1111b," click/hold both buttons to exit... " + 2F B9 24 00 B2 0A B6 0B BD A4 02 CD + 10 61 EB 25 20 63 6C 69 63 6B 2F 68 + 6F 6C 64 20 62 6F 74 68 20 62 75 74 + 74 6F 6E 73 20 74 6F 20 65 78 69 74 + 2E 2E 2E 20 00 +[ 83] : +[ 84] : ; display mouse cursor: +[ 85] 02C9: B8 01 00 mov ax, 1 +[ 86] 02CC: CD 33 int 33h +[ 87] : +[ 88] 02CE: check_mouse_buttons: +[ 89] 02CE: B8 03 00 mov ax, 3 +[ 90] 02D1: CD 33 int 33h +[ 91] 02D3: 83 FB 03 cmp bx, 3 ; both buttons +[ 92] 02D6: 75 03 E9 B9 00 je hide +[ 93] 02DB: 3B 0E 02 01 cmp cx, curX +[ 94] 02DF: 75 0C jne print_xy +[ 95] 02E1: 3B 16 04 01 cmp dx, curY +[ 96] 02E5: 75 06 jne print_xy +[ 97] 02E7: 3B 1E 06 01 cmp bx, curB +[ 98] 02EB: 75 6D jne print_buttons +[ 99] : +[ 100] : +[ 101] 02ED: print_xy: +[ 102] 02ED: 60 8C CA 8E C2 B4 13 B0 01 B7 00 B3 print 0,0,0000_1111b,"x=" + 0F B9 02 00 B2 00 B6 00 BD 09 03 CD + 10 61 EB 03 78 3D 00 +[ 103] 030C: 8B C1 mov ax, cx +[ 104] 030E: E8 1E 01 call print_ax +[ 105] 0311: 60 B4 09 B0 20 B3 0F B9 04 00 CD 10 print_space 4 + 61 +[ 106] 031E: 60 8C CA 8E C2 B4 13 B0 01 B7 00 B3 print 0,1,0000_1111b,"y=" + 0F B9 02 00 B2 00 B6 01 BD 3A 03 CD + 10 61 EB 03 79 3D 00 +[ 107] 033D: 8B C2 mov ax, dx +[ 108] 033F: E8 ED 00 call print_ax +[ 109] 0342: 60 B4 09 B0 20 B3 0F B9 04 00 CD 10 print_space 4 + 61 +[ 110] 034F: 89 0E 02 01 mov curX, cx +[ 111] 0353: 89 16 04 01 mov curY, dx +[ 112] 0357: E9 74 FF jmp check_mouse_buttons +[ 113] : +[ 114] 035A: print_buttons: +[ 115] 035A: 60 8C CA 8E C2 B4 13 B0 01 B7 00 B3 print 0,2,0000_1111b,"btn=" + 0F B9 04 00 B2 00 B6 02 BD 76 03 CD + 10 61 EB 05 62 74 6E 3D 00 +[ 116] 037B: 8B C3 mov ax, bx +[ 117] 037D: E8 AF 00 call print_ax +[ 118] 0380: 60 B4 09 B0 20 B3 0F B9 04 00 CD 10 print_space 4 + 61 +[ 119] 038D: 89 1E 06 01 mov curB, bx +[ 120] 0391: E9 3A FF jmp check_mouse_buttons +[ 121] : +[ 122] : +[ 123] : +[ 124] 0394: hide: +[ 125] 0394: B8 02 00 mov ax, 2 ; hide mouse cursor. +[ 126] 0397: CD 33 int 33h +[ 127] : +[ 128] 0399: 60 B8 00 06 B7 0F B9 00 00 B6 18 B2 clear_screen + 4F CD 10 61 +[ 129] : +[ 130] 03A9: 60 8C CA 8E C2 B4 13 B0 01 B7 00 B3 print 1,1,1010_0000b," hardware must be free! free the mice! " + A0 B9 2C 00 B2 01 B6 01 BD C5 03 CD + 10 61 EB 2D 20 68 61 72 64 77 61 72 + 65 20 6D 75 73 74 20 62 65 20 66 72 + 65 65 21 20 20 20 20 20 20 66 72 65 + 65 20 74 68 65 20 6D 69 63 65 21 20 + 00 +[ 131] : +[ 132] 03F2: stop: +[ 133] : ; show box-shaped blinking text cursor: +[ 134] 03F2: B4 01 mov ah, 1 +[ 135] 03F4: B5 00 mov ch, 0 +[ 136] 03F6: B1 08 mov cl, 8 +[ 137] 03F8: CD 10 int 10h +[ 138] : +[ 139] 03FA: 60 8C CA 8E C2 B4 13 B0 01 B7 00 B3 print 4,7,0000_1010b," press any key.... " + 0A B9 13 00 B2 04 B6 07 BD 16 04 CD + 10 61 EB 14 20 70 72 65 73 73 20 61 + 6E 79 20 6B 65 79 2E 2E 2E 2E 20 00 + +[ 140] 042A: B4 00 mov ah, 0 +[ 141] 042C: CD 16 int 16h +[ 142] : +[ 143] 042E: C3 ret +[ 144] : +[ 145] : +[ 146] 042F: print_ax proc +[ 147] 042F: 3D 00 00 cmp ax, 0 +[ 148] 0432: 75 09 jne print_ax_r +[ 149] 0434: 50 push ax +[ 150] 0435: B0 30 mov al, '0' +[ 151] 0437: B4 0E mov ah, 0eh +[ 152] 0439: CD 10 int 10h +[ 153] 043B: 58 pop ax +[ 154] 043C: C3 ret +[ 155] 043D: print_ax_r: +[ 156] 043D: 60 pusha +[ 157] 043E: BA 00 00 mov dx, 0 +[ 158] 0441: 3D 00 00 cmp ax, 0 +[ 159] 0444: 74 12 je pn_done +[ 160] 0446: BB 0A 00 mov bx, 10 +[ 161] 0449: F7 F3 div bx +[ 162] 044B: E8 EF FF call print_ax_r +[ 163] 044E: 8B C2 mov ax, dx +[ 164] 0450: 04 30 add al, 30h +[ 165] 0452: B4 0E mov ah, 0eh +[ 166] 0454: CD 10 int 10h +[ 167] 0456: EB 00 jmp pn_done +[ 168] 0458: pn_done: +[ 169] 0458: 61 popa +[ 170] 0459: C3 ret +[ 171] : endp +[ 172] : +[ 173] : + +=================================================================================================== + + + + + +=================================================================================================== diff --git a/test/data/extra/mouse.com.symbol b/test/data/extra/mouse.com.symbol new file mode 100755 index 0000000..853ae50 --- /dev/null +++ b/test/data/extra/mouse.com.symbol @@ -0,0 +1,51 @@ +< THE SYMBOL TABLE > mouse.com -- emu8086 assembler version: 4.08 +=================================================================================================== +Name Offset Size Type Segment +=================================================================================================== +CURX 00102 2 VAR (NOSEG) +CURY 00104 2 VAR (NOSEG) +CURB 00106 2 VAR (NOSEG) +START 00108 -1 LABEL (NOSEG) +S_DCL_LOC1TMP 0013C 1 VAR (NOSEG) +S_DCL_END_LOC1TMP 00151 1 VAR (NOSEG) +SKIP_DCL_LOC1TMP 00152 -1 LABEL (NOSEG) +OK 00155 -1 LABEL (NOSEG) +S_DCL_LOC2TMP 00181 1 VAR (NOSEG) +S_DCL_END_LOC2TMP 001C5 1 VAR (NOSEG) +SKIP_DCL_LOC2TMP 001C6 -1 LABEL (NOSEG) +S_DCL_LOC3TMP 001E2 1 VAR (NOSEG) +S_DCL_END_LOC3TMP 00226 1 VAR (NOSEG) +SKIP_DCL_LOC3TMP 00227 -1 LABEL (NOSEG) +S_DCL_LOC4TMP 00243 1 VAR (NOSEG) +S_DCL_END_LOC4TMP 00287 1 VAR (NOSEG) +SKIP_DCL_LOC4TMP 00288 -1 LABEL (NOSEG) +S_DCL_LOC5TMP 002A4 1 VAR (NOSEG) +S_DCL_END_LOC5TMP 002C8 1 VAR (NOSEG) +SKIP_DCL_LOC5TMP 002C9 -1 LABEL (NOSEG) +CHECK_MOUSE_BUTTONS 002CE -1 LABEL (NOSEG) +PRINT_XY 002ED -1 LABEL (NOSEG) +S_DCL_LOC6TMP 00309 1 VAR (NOSEG) +S_DCL_END_LOC6TMP 0030B 1 VAR (NOSEG) +SKIP_DCL_LOC6TMP 0030C -1 LABEL (NOSEG) +S_DCL_LOC7TMP 0033A 1 VAR (NOSEG) +S_DCL_END_LOC7TMP 0033C 1 VAR (NOSEG) +SKIP_DCL_LOC7TMP 0033D -1 LABEL (NOSEG) +PRINT_BUTTONS 0035A -1 LABEL (NOSEG) +S_DCL_LOC8TMP 00376 1 VAR (NOSEG) +S_DCL_END_LOC8TMP 0037A 1 VAR (NOSEG) +SKIP_DCL_LOC8TMP 0037B -1 LABEL (NOSEG) +HIDE 00394 -1 LABEL (NOSEG) +S_DCL_LOC9TMP 003C5 1 VAR (NOSEG) +S_DCL_END_LOC9TMP 003F1 1 VAR (NOSEG) +SKIP_DCL_LOC9TMP 003F2 -1 LABEL (NOSEG) +STOP 003F2 -1 LABEL (NOSEG) +S_DCL_LOC10TMP 00416 1 VAR (NOSEG) +S_DCL_END_LOC10TMP 00429 1 VAR (NOSEG) +SKIP_DCL_LOC10TMP 0042A -1 LABEL (NOSEG) +PRINT_AX 0042F -1 NEAR (NOSEG) +PRINT_AX_R 0043D -1 LABEL (NOSEG) +PN_DONE 00458 -1 LABEL (NOSEG) +=================================================================================================== +[ 7/16/2024 -- 10:20:08 AM ] +< END > +