1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2% 3% File: PXC:os2386-ASM.SL 4% Description: Windows NT 386 specific information for LAP-TO-ASM 5% Author: 6% Created: 16-Jan-1993 7% Modified: 8% Mode: Lisp 9% Package: 10% Status: Experimental (Do Not Distribute) 11% 12%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 13% 14% Revisions: 15% 16%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 17 18(compiletime (load if-system)) 19 20(global '($eol$)) 21 22(Fluid '(CodeFileNameFormat* 23 DataFileNameFormat* 24 InitFileNameFormat* 25 InputSymFile* 26 OutputSymFile* 27 CommentFormat* 28 GlobalDataFileName* 29 LabelFormat* 30 ExternalDeclarationFormat* 31 ExportedDeclarationFormat* 32 FullWordFormat* 33 HalfWordFormat* 34 ReserveDataBlockFormat* 35 ReserveZeroBlockFormat* 36 DefinedFunctionCellFormat* 37 UndefinedFunctionCellInstructions* 38 MainEntryPointName* 39 CodeOut* 40 DataOut* 41 *Lower 42 ASMOpenParen* 43 ASMCloseParen* 44 ModuleName* 45 NumericRegisterNames* 46 ForeignExternList* 47 DataProcState* 48 PathIn* 49 printexpressionform* 50 printexpressionformpointer* 51 *declarebeforeuse)) 52 53%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 54% This assembler produces two files: a code file and a data file. Both % 55% of these files are assembled to reside in the dataspace % 56%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 57 58%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 59%FORMATS% 60%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 61 62(setq *DeclareBeforeUse t) 63 64(setq CodeFileNameFormat* "%w.asm") % The name of the code segment file 65(setq DataFileNameFormat* "d%w.asm") % postfix the "d" so that the files 66 % [20] is a reasonable guess at aU 67 % size specification 68 69(setq InitFileNameFormat* "%w.init") % [20] is a reasonable guess at a 70 % size specification; it may need to 71 % be changed. 72 73(setq InputSymFile* "sun386.sym") % default for full-kernel-build 74(setq OutputSymFile* "sun386.sym") 75 76(setq MainEntryPointName* '!m!a!i!n) % chose a simple default 77 % main procedure name 78 79(setq NumericRegisterNames* '[nil "eax" "ebx" "ecx" "edx" "ebp" ]) 80 81(setq LabelFormat* "%w:%n") % Labels are in the first column 82(setq dataLabelFormat* " ALIGN 4%n%w ") 83(setq CommentFormat* "; %p%n") % Comments begin with a slash 84 % will group alphabetically 85 86(setq ExportedDeclarationFormat* " PUBLIC %w%n") 87(setq ExternalDeclarationFormat* " EXTRN %w:NEAR%n") % All in DATA space 88 89(setq FullWordFormat* " DD %e%n") % FullWord expects %e for parameter 90(setq HalfWordFormat* " DW %e%n") % Will EVAL formatter 91 92(setq ReserveDataBlockFormat* " .bss %w,%e%n") 93% This does *not* make zero blocks, however, the Sun manuals 94% promise that a.out memory is init'ed to 0s 95% Changed below to be like Vax version, so heap will be in bss. bao 96(setq ReserveZeroBlockFormat* "%w DB %e DUP (0)%n") 97 98(put 'MkItem 'ASMExpressionFormat "%e*08000000h+OFFSET %e" ) 99 100(setq DefinedFunctionCellFormat* " DD %w%n") %/ Must be LONG 101 102(setq UndefinedFunctionCellInstructions* '(( DD UndefinedFunction))) 103 104%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 105%LISTS and CONSTANT DEFINITIONS% 106%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 107 108(setq ASMOpenParen* "(") 109(setq ASMCloseParen* ")") 110 111(DefList '((LAnd &) (LOr !!)) 'BinaryASMOp) 112 113(DefList '( (t1 "edi") (t2 "esi") (eax "eax") (al "al") (ax "ax") 114 (dl "dl") (ah "ah") (bx "bx") (ebx "ebx") 115 (edi "edi") (esi "esi") 116 (edx "edx") (es "es") (cs "cs") (ds "ds") (ss "ss") 117 (ecx "ecx") (cl "cl") (cx "cx") 118 (sp "esp") (esp "esp") (st "esp") ) % Stack Pointer 119 'RegisterName) 120 121 122(setq DataProcState* 'data) 123 124%%% This put is to associate the above code with (float x) in LAP 125 126(put 'Float 'ASMPseudoOp 'ASMPseudoPrintFloat) 127 128(de ASMPseudoPrintFloat (x) 129 (cond ((EqN (cadr x) 0.0) 130 (printf " DD 0%n DD 0%n") 131 ) 132 ((EqN (cadr x) 1.0) 133 (printf " DD 0x3ff00000%n DD 0%n") 134 ) 135 ) 136) 137 138 % dont print operand size prefix for assembler 139 % (is encoded in the register name already) 140 141(put 'OS: 'asmPseudoOp '(lambda(x) nil)) 142 143%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 144%CODE HEADERS AND TRAILERS% 145%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 146 147 148(de CodeFileHeader nil % Pure Code Segment 149 (CodePrintF " .386%n") 150 (CodePrintF "DGROUP group _DATA, _BSS%n") 151 (CodePrintF "_DATA segment dword public 'DATA'%n") 152 (CodePrintF " include mhdr.asm %n") 153 (CodePrintF " ALIGN 4%n") 154 (CodePrintF " INCLUDE S_VA_FN.ASM%n") 155 (CodePrintF "_DATA ends%n%n") 156 (CodePrintF "_BSS segment dword public 'BSS'%n") 157 (CodePrintF "_BSS ends%n%n") 158 (CodePrintF "_TEXT segment dword public 'CODE'%n") 159 (CodePrintF " assume CS:_TEXT%n") 160 (CodePrintF " assume DS:DGROUP%n") 161 (setq DataProcState* 'data) 162 (setq ForeignExternList* nil)) 163 164(de DataFileHeader nil 165 (DataPrintF " .386%n") 166 (DataPrintF " .MODEL SMALL%n") 167 ) 168 169 170(de DataFileTrailer nil 171 (DataPrintF " END %n") 172 nil) 173 174(de CodeFileTrailer nil 175 (CodePrintF "_TEXT ends%n") 176 (CodePrintF "_DATA segment dword public 'DATA'%n") 177 (CodePrintF " INCLUDE S_PR_NA.ASM%n") 178 (CodePrintF " INCLUDE KSTRUCTS.ASM%n") 179 % (CodePrintF " align 4%n") 180 (CodePrintF "_DATA ends%n") 181 (CodePrintF " END %n") 182 nil) 183 184(de CheckForeignExtern (Fn) 185 (cond 186 ((not (Memq Fn ForeignExternList*)) 187 (setq ForeignExternList* (cons Fn ForeignExternList*))))) 188 189(de CodeBlockHeader nil nil) %/ Chuck this? 190 191 192(de CodeBlockTrailer nil nil) 193 194 195(de DataAlignFullWord nil nil) 196 197 198%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%`%% 199% PRINT PROCEDURES% 200%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 201 202 203(de PrintString (S) 204 (prog (n) 205 (cond 206 ((neq (Size S) -1) 207 (progn (setq n (Size S)) 208 (printf " DB ") 209 (PrintExpression (Indx S 0)) 210 (for (from i 1 n 1) 211 (do (PrintByte!, (Indx S i)))) 212 (PrintByte!, 0) 213 (cond 214 ((equal (Remainder n 2) 1) 215 (PrintByte!, 0))) 216 (Terpri) 217 nil)) 218 (t 219 (progn 220 (printf " DB ") 221 (PrintExpression 0) 222 (PrintByte!, 0) 223 (Terpri) nil))))) 224 225 226(de PrintByte!, (x) 227 (progn (cond 228 ((greaterp (POSN) 40) 229 (printf "%n DB ")) 230 (t (Prin2 ","))) 231 (PrintExpression x))) 232 233(de TruncateString (S n) 234 (cond 235 ((leq (Size S) n) 236 S) 237 (t 238 (SUB S 0 n)))) 239 240(de PrintByteList (L) 241 (foreach x in L do (PrintByte x))) 242 243(de PrintByte (x) 244 (progn (printf " DB ") 245 (PrintExpression x) 246 (Prin2 $EOL$))) 247 248(de PrintHalfWordList (L) 249 (foreach x in L do (PrintHalfWord x))) 250 251(de PrintHalfWord (x) 252 (progn (printf " .word ") 253 (PrintExpression x) 254 (Prin2 $EOL$))) 255 256(de PrintHalfWords (x) 257 (progn (RplacA PrintExpressionFormPointer* x) 258 (printf HalfWordFormat* PrintExpressionForm*))) 259 260 261(put 'HalfWord 'asmpseudoop 'ASMPseudoPrintHalfWords) 262 263(de ASMPseudoPrintHalfWords (x) 264 (foreach Y in (cdr x) do (PrintHalfWord Y))) 265 266 267(fluid '(*sun-mnemonic-change-table*)) 268 269%%% Print out an opcode id (derived from LAP) 270%%% The Sun requires a number of transformations to the opcodes 271%%% (which are based on the Motorola standard, ignored by Sun) 272%%% Must change to lower case, take out the . separator, and 273%%% change the names of certain mnemonics... 274 275(de PrintOpcode (opcode) 276 (let ((xform (atsoc opcode *sun-mnemonic-change-table*))) 277 (if xform (setq opcode (cdr xform))) 278 (prin2 (eval `(string 279 ,@(for (in x (delete 246 (string2list (id2string opcode)))) 280% ausser Gefecht w.n. 281 (collect (asm-char-downcase x)) 282 ) 283 ) 284 ) 285 ) 286 ) 287) 288 289%%% Taken from PU:chars.lsp, this routine converts a character (a small 290%%% number) from uppercase to lowercase. This version is considerably 291%%% simplified from the PU: one so that it works in a bare PSL (a primitive 292%%% if there ever was one) 293 294(de asm-char-downcase (c) 295 (if (not (or (lessp c (char A)) (greaterp c (char Z)))) 296 (plus (char !a) (difference c (char !A))) 297 c 298 ) 299) 300 301%%% Mapping table for the mnemonics that Sun decided to "improve" 302 303(setq *sun-mnemonic-change-table* 304 '( 305 %(cdq . cltd ) 306 %(cwde . cwtl ) 307 %(cbw . cbtw ) 308 ) 309) 310 311 312(de SpecialActionForMainEntryPoint nil 313 (progn (CodePrintLabel MainEntryPointName*) 314 (CodeDeclareExported MainEntryPointName*))) 315 316 317%%% Predicate to decide whether the given id or string is a valid 318%%% one to the machine's assembler (though what lap-to-asm does if 319%%% this predicate fails is beyond me!) 320 321(de ASMSymbolP (x) 322 (SunSymbolP (if (idp x) (id2string x) x)) 323) 324 325(de SunSymbolP (x) 326 (let ((n (size x)) 327 (c (indx x 0)) 328 ) 329 (and (geq n 0) % empty strings not valid 330 (or (and (geq c (char A)) (leq c (char Z))) 331 (and (geq c (char !a)) (leq c (char !z))) 332 (eqn c (char !_)) 333 ) 334 (for (from i 1 n) 335 (with (rslt t)) 336 (while rslt) 337 (do (setq c (indx x i)) 338 (setq rslt (or (and (geq c (char A)) (leq c (char Z))) 339 (and (geq c (char !a)) (leq c (char !z))) 340 (eqn c (char !_)) 341 ) 342 ) 343 ) 344 (returns rslt) 345 ) 346 ) 347 ) 348) 349 350 351%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 352 353(de PrintNumericOperand (x) 354 (printf "%w" x)) 355 356 357(de OperandPrintIndirect (x) % (Indirect x) 358 (progn (setq x (cadr x)) 359 (if (regp x) (progn 360 (prin2 (if (equal x '(reg 5)) 361 "DWORD PTR ds:[" 362 "DWORD PTR [" )) 363 (PrintOperand x) 364 (Prin2 "]")) 365 (prin2 "[") 366 (PrintOperand x) 367 (Prin2 "]")) 368)) 369 370(put 'Indirect 'OperandPrintFunction 'OperandPrintIndirect) 371 372(de OperandPrintOffset (x) 373 (prin2 "OFFSET " ) (printoperand (cadr x))) 374 375(put 'offset 'OperandPrintFunction 'OperandPrintOffset) 376 377(de OperandPrintDisplacement (x) % (Displacement (reg x) disp) 378 (progn (setq x (cdr x)) 379 (prin2 " DWORD PTR ") 380 (PrintExpression (cadr x)) 381 (Prin2 "[") 382 (Printoperand (car x)) 383 (Prin2 "]"))) 384 385(put 'displacement 'OperandPrintFunction 'OperandPrintDisplacement) 386 387% (Indexed (reg y)(displacement (reg x) disp)) 388% or (times (reg y) 1/2/4/8) (displacement (reg x) disp)) 389% or (times (reg y) 1/2/4/8) lab) for jumpon 390% 391(de OperandPrintIndexed (x) % (indexed (reg y) (displacement (reg x) disp)) 392 (if (regp (second x)) 393 (let ((part2 (third x))) 394 (printexpression (third part2)) 395 (prin2 "[") 396 (PrintRegister (cadr part2)) 397 (prin2 "][") 398 (PrintRegister (cadr x)) 399 (prin2 "*1]"))) 400 (if (eqcar (second x) 'times) 401 (let ((part2 (third x)) 402 (part1 (second x))) 403 (if (atom part2) 404 (progn (printexpression part2)) 405 (printexpression (third part2))) 406 (prin2 "[") 407 (when (pairp part2) (PrintRegister (cadr part2))) 408 (prin2 "][") 409 (PrintRegister (cadr part1)) 410 (prin2 "*") 411 (when (not (memq (third part1) '(1 2 4 8))) 412 (error 199 "Wrong Indexed mode")) 413 (prin2 (third part1)) 414 (prin2 "]"))) 415) 416 417(put 'Indexed 'OperandPrintFunction 'OperandPrintIndexed) 418 419(de OperandPrintImmediate (x) % (Immediate x) % for ADDRESS 420 (progn %(prin2 "#") 421 (PrintExpression (cadr x)))) 422 423(put 'Immediate 'OperandPrintFunction 'OperandPrintImmediate) 424 425 426(de OperandPrintPostIncrement (x) % (PostIncrement x) 427 (progn (PrintOperand (cadr x)) 428 (Prin2 "@+"))) 429 430(put 'PostIncrement 'OperandPrintFunction 'OperandPrintPostIncrement) 431 432(de OperandPrintRegList (x) % (Reglist x) 433 (progn (setq x (cdr x)) 434 (PrintOperand (car x)) 435 (setq x (cdr x)) 436 (While x 437 (progn (Prin2 "/") 438 (PrintOperand (car x)) 439 (setq x (cdr x)))) nil)) 440 441 442(put 'RegList 'OperandPrintFunction 'OperandPrintRegList) 443 444(de OperandPrintPreDecrement (x) % (PreDecrement x) 445 (progn (PrintOperand (cadr x)) 446 (Prin2 "@-"))) 447 448(put 'PreDecrement 'OperandPrintFunction 'OperandPrintPreDecrement) 449 450(de OperandPrintAbsolute (x) % (Absolute x) 451 (PrintExpression (cadr x))) 452 453 454(put 'Absolute 'OperandPrintFunction 'OperandPrintAbsolute) 455 456(de OperandPrintForeignEntry (x) % (ForeignEntry FcnName) 457 (let ((*lower t)) 458 (printf "%w" (cadr x)))) 459 460(put 'ForeignEntry 'OperandPrintFunction 'OperandPrintForeignEntry) 461 462(Fluid '(ResultingCode*)) 463 464(de MCPrint (x) % Echo of MC's 465 (CodePrintF "; %p%n" x)) 466 467(de InstructionPrint (x) 468 (CodePrintF "; %p%n" x)) 469 470(de *cerror (x) 471 (prog (i) 472 (setq i (wrs nil)) 473 (printf "%n *** CERROR: %r %n " x) 474 (wrs i) 475 (return (list (list 'cerror x))))) 476 477 478(put 'cerror 'asmpseudoop 'printcomment) 479 480(DefCMacro *cerror) 481 482%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 483% A HORRID patch for BRA/BRA!.W incompatibility between 484% KERNEL and LAP 485% In Kernel, BRA means word sized branch 486% IN LAp and FASL BRA seems to mean bytes sized (?) even though 487% must be coerced somewhere 488%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%@%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 489 490 491(de datareserveblock (x) nil) 492% (dataprintf " DB %w DUP (0)%n" x)) 493 494% (rplaca printexpressionformpointer* 495% (list 'times2 (compiler-constant 'addressingunitsperitem) x)) 496% (dataprintf reservedatablockformat* (gensym) printexpressionform*)) 497 498(de datareservefunctioncellblock (x) nil) 499% (dataprintf " DB %w DUP (0)%n" x)) % dup(?) 500 501% (rplaca printexpressionformpointer* 502% (list 'times2 (compiler-constant 'addressingunitsperfunctioncell) x)) 503% (dataprintf reservedatablockformat* (gensym) printexpressionform*)) 504 505 506(de initializesymboltable () 507 (let ((maxsymbol (compiler-constant 'maxsymbols)) olddataout) 508 (when (lessp maxsymbol nextidnumber*) 509 (errorprintf "*** MaxSymbols %r is too small; at least %r are needed" 510 maxsymbol nextidnumber*) 511 (setq maxsymbol (plus nextidnumber* 100))) 512 (flag '(nil) 'nilinitialvalue) 513 (put 't 'initialvalue 't) 514 (setq nilnumber* (compileconstant nil)) 515 (setq olddataout dataout*) 516 (setq dataout* (open "S_VA_FN.asm" 'output)) 517 (dataalignfullword) 518 (initializesymval) 519 (datareserveblock (plus (difference maxsymbol nextidnumber*) 1)) 520 (initializesymfnc) 521 (datareservefunctioncellblock 522 (plus (difference maxsymbol nextidnumber*) 1)) 523 (close dataout*) 524 (setq dataout* (open "S_PR_NA.asm" 'output)) 525 (initializesymprp) 526 (datareserveblock (plus (difference maxsymbol nextidnumber*) 1)) 527 (initializesymnam) 528 (datareserveblock (plus (difference maxsymbol nextidnumber*) 1)) 529 (dataprintf " DD %w DUP (?) %n" (times2 4 maxsymbol)) 530 (close dataout*) 531 (setq dataout* olddataout) 532% (initializesymget) % SYMGET feature 533% (datareserveblock (plus (difference maxsymbol nextidnumber*) 1)) 534% (dataalignfullword) 535% (dataprintgloballabel (findgloballabel 'nextsymbol)) 536% (dataprintfullword nextidnumber*) 537 )) 538 539% End of file. 540 541