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