![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to io.l CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / pgrm / lisp / liszt|
Return to io.l CVS log | Up to [CSRG BSD Unix] / 43BSDReno / pgrm / lisp / liszt |
1.1 root 1: (include-if (null (get 'chead 'version)) "../chead.l")
2: (Liszt-file io
3: "$Header: io.l,v 1.17 87/12/15 17:03:20 sklower Exp $")
4:
5: ;;; ---- i o input output
6: ;;;
7: ;;; -[Fri Sep 2 21:37:05 1983 by layer]-
8:
9:
10: ;--- d-prelude :: emit code common to beginning of all functions
11: ;
12: (defun d-prelude nil
13: (let ((loada-op #+(or for-vax for-tahoe) 'movab #+for-68k 'lea)
14: (sub2-op #+(or for-vax for-tahoe) 'subl2 #+for-68k 'subl)
15: (add2-op #+(or for-vax for-tahoe) 'addl2 #+for-68k 'addl)
16: (temp-reg #+(or for-vax for-tahoe) '#.fixnum-reg #+for-68k 'a5))
17: #+for-68k (setq g-stackspace (d-genlab) g-masklab (d-genlab))
18: (if g-flocal
19: then #+for-tahoe (e-write2 '".word" '0x0)
20: (C-push '#.olbot-reg)
21: (e-write3 loada-op
22: `(,(* -4 g-currentargs) #.np-reg) '#.olbot-reg)
23: (e-writel g-topsym)
24: else #+(or for-vax for-tahoe) (e-write2 '".word" '0x5c0)
25: #+for-68k
26: (progn
27: (e-write3 'link 'a6 (concat "#-" g-stackspace))
28: (e-write2 'tstb '(-132 sp))
29: (e-write3 'moveml `($ ,g-masklab)
30: (concat "a6@(-" g-stackspace ")"))
31: (e-move '#.Nilatom '#.nil-reg))
32: (if fl-profile
33: then (e-write3 loada-op 'mcnts
34: #+(or for-vax for-tahoe) 'r0 #+for-68k 'a0)
35: (e-quick-call 'mcount))
36: (e-write3 loada-op 'linker '#.bind-reg)
37: (if (eq g-ftype 'lexpr)
38: then ; Here is the method:
39: ; We push the number of arguments, nargs,
40: ; on the name stack twice, setting olbot-reg
41: ; to point to the second one, so that the user
42: ; has a copy that he can set, and we have
43: ; one that we can use for address calcs.
44: ; So, the stack will look like this, after
45: ; the setup:
46: ;np ->
47: ;olbot -> nargs (II)
48: ; -> nargs (I)
49: ; -> (arg nargs)
50: ; -> (arg nargs-1)
51: ;...
52: ; -> (arg 1)
53: ;
54: (if (null $global-reg$)
55: then (e-move '#.np-sym '#.np-reg))
56: (e-writel g-topsym)
57: (e-move '#.np-reg temp-reg)
58: (e-write3 sub2-op
59: (if $global-reg$
60: then '#.lbot-reg
61: else '#.lbot-sym) temp-reg)
62: (e-write3 add2-op (e-cvt '(fixnum 0)) temp-reg)
63: (L-push temp-reg)
64: (e-move '#.np-reg '#.olbot-reg)
65: (L-push temp-reg)
66: else ; Set up old lbot register, base reg for variable
67: ; references, and make sure the np points where
68: ; it should since the caller might
69: ; have given too few or too many args.
70: (e-move
71: (if $global-reg$
72: then '#.lbot-reg
73: else '#.lbot-sym)
74: '#.olbot-reg)
75: #+for-68k
76: (e-write3 loada-op
77: `(,(* 4 g-currentargs) #.olbot-reg)
78: '#.np-reg)
79: (e-writel g-topsym)))))
80:
81: ;--- d-fini :: emit code at end of function
82: ;
83: (defun d-fini nil
84: (if g-flocal
85: then (C-pop '#.olbot-reg)
86: (e-write1 #+for-vax 'rsb #+for-tahoe 'ret #+for-68k 'rts)
87: else #+for-68k
88: (progn
89: (e-write3 'moveml (concat "a6@(-" g-stackspace ")")
90: `($ ,g-masklab))
91: (e-write2 'unlk 'a6))
92: (e-return)))
93:
94: ;--- d-bindtab :: emit binder table when all functions compiled
95: ;
96: (defun d-bindtab nil
97: (setq g-skipcode nil) ; make sure this isnt ignored
98: (e-writel "bind_org")
99: #+(or for-vax for-tahoe)
100: (progn
101: (e-write2 ".set linker_size," (length g-lits))
102: (e-write2 ".set trans_size," (length g-tran)))
103: #+for-68k
104: (progn
105: (e-write2 "linker_size = " (length g-lits))
106: (e-write2 "trans_size = " (length g-tran)))
107: (do ((ll (setq g-funcs (nreverse g-funcs)) (cdr ll)))
108: ((null ll))
109: (if (memq (caar ll) '(lambda nlambda macro eval))
110: then (e-write2 '".long"
111: (cdr (assoc (caar ll)
112: '((lambda . 0) (nlambda . 1)
113: (macro . 2) (eval . 99)))))
114: else (comp-err " bad type in lit list " (car ll))))
115:
116: (e-write1 ".long -1")
117: (e-writel "lit_org")
118: (d-asciiout (nreverse g-lits))
119: (if g-tran then (d-asciiout (nreverse g-tran)))
120: (d-asciiout (mapcar '(lambda (x) (if (eq (car x) 'eval)
121: then (cadr x)
122: else (caddr x)))
123: g-funcs))
124: (e-writel "lit_end"))
125:
126: ;--- d-asciiout :: print a list of asciz strings
127: ;
128: (defun d-asciiout (args)
129: (do ((lits args (cdr lits))
130: (form))
131: ((null lits))
132: (setq form (explode (car lits))
133: formsiz (length form))
134: (do ((remsiz formsiz)
135: (curform form)
136: (thissiz))
137: ((zerop remsiz))
138: (if (greaterp remsiz 60) then (sfilewrite '".ascii \"")
139: else (sfilewrite '".asciz \""))
140: (setq thissiz (min 60 remsiz))
141: (do ((count thissiz (1- count)))
142: ((zerop count)
143: (sfilewrite (concat '\" (ascii 10)))
144: (setq remsiz (difference remsiz thissiz)))
145: (if (eq '#.ch-newline (car curform))
146: then (sfilewrite '\\012)
147: else (if (or (eq '\\ (car curform))
148: (eq '\" (car curform)))
149: then (sfilewrite '\\))
150: (sfilewrite (car curform)))
151: (setq curform (cdr curform))))))
152:
153: ;--- d-autorunhead
154: ;
155: ; Here is the C program to generate the assembly language:
156: ; (after some cleaning up)
157: ;
158: ;main(argc,argv,arge)
159: ;register char *argv[];
160: ;register char **arge;
161: ;{
162: ; *--argv = "-f";
163: ; *--argv = "/usr/ucb/lisp";
164: ; execve("/usr/ucb/lisp",argv,arge);
165: ; exit(0);
166: ;}
167: ;
168: (defun d-printautorun nil
169: (let ((readtable (makereadtable t)) ; in raw readtable
170: tport ar-file)
171: (setsyntax #/; 'vsplicing-macro 'zapline)
172: (setq ar-file (concat lisp-library-directory
173: #+for-vax "/autorun/vax"
174: #+for-tahoe "/autorun/tahoe"
175: #+for-68k "/autorun/68k"))
176: (if (null (errset (setq tport (infile ar-file))))
177: then (comp-err "Can't open autorun header file " ar-file))
178: (do ((x (read tport '<eof>) (read tport '<eof>)))
179: ((eq '<eof> x) (close tport))
180: (sfilewrite x))))
181:
182: (defun e-cvt (arg)
183: (if (eq 'reg arg) then #+(or for-vax for-tahoe) 'r0 #+for-68k 'd0
184: elseif (eq 'areg arg) then #+(or for-vax for-tahoe) 'r0 #+for-68k 'a0
185: elseif (eq 'Nil arg) then #+(or for-vax for-tahoe) '($ 0)
186: #+for-68k '#.nil-reg
187: elseif (eq 'T arg)
188: then (if g-trueloc
189: thenret
190: else (setq g-trueloc (e-cvt (d-loclit t nil))))
191: elseif (eq 'stack arg) then '(+ #.np-reg)
192: elseif (eq 'unstack arg) then (progn #+for-tahoe (e-sub '($ 4) '#.np-reg)
193: '(- #.np-reg))
194: elseif (or (atom arg) (symbolp arg)) then arg
195: elseif (dtpr arg)
196: then (caseq (car arg)
197: (stack `(,(* 4 (1- (cadr arg))) #.olbot-reg))
198: (vstack `(* ,(* 4 (1- (cadr arg))) #.olbot-reg))
199: (bind `(* ,(* 4 (1- (cadr arg))) #.bind-reg))
200: (lbind `(,(* 4 (1- (cadr arg))) #.bind-reg))
201: (fixnum `(\# ,(cadr arg)))
202: (immed `($ ,(cadr arg)))
203: (racc (cdr arg))
204: (t (comp-err " bad arg to e-cvt : "
205: (or arg))))
206: else (comp-warn "bad arg to e-cvt : " (or arg))))
207:
208: ;--- e-uncvt :: inverse of e-cvt, used for making comments pretty
209: ;
210: (defun e-uncvt (arg)
211: (if (atom arg)
212: then (if (eq 'Nil arg)
213: then nil
214: else arg)
215: elseif (eq 'stack (car arg))
216: then (do ((i g-loccnt)
217: (ll g-locs))
218: ((and (equal i (cadr arg)) (atom (car ll))) (car ll))
219: (if (atom (car ll))
220: then (setq ll (cdr ll)
221: i (1- i))
222: else (setq ll (cdr ll))))
223: elseif (or (eq 'bind (car arg)) (eq 'lbind (car arg)))
224: then (do ((i g-litcnt (1- i))
225: (ll g-lits (cdr ll)))
226: ((equal i (cadr arg))
227: (cond ((eq 'lbind (car arg))
228: (list 'quote (car ll)))
229: (t (car ll)))))
230: else arg))
231:
232: ;--- e-cvtas :: convert an EIADR to vax unix assembler fmt and print it
233: ; - form : an EIADR form
234: ;
235: #+(or for-vax for-tahoe)
236: (defun e-cvtas (form)
237: (if (atom form)
238: then (sfilewrite form)
239: else (if (eq '* (car form))
240: then (if (eq '\# (cadr form))
241: then (setq form `($ ,(caddr form)))
242: else (sfilewrite "*")
243: (setq form (cdr form))))
244: (if (numberp (car form))
245: then (sfilewrite (car form))
246: (sfilewrite "(")
247: (sfilewrite (cadr form))
248: (sfilewrite ")")
249: (if (caddr form)
250: then (sfilewrite "[")
251: (sfilewrite (caddr form))
252: (sfilewrite "]"))
253: elseif (eq '+ (car form))
254: then (sfilewrite '"(")
255: (sfilewrite (cadr form))
256: (sfilewrite '")")
257: #-for-tahoe (sfilewrite '"+")
258: elseif (eq '- (car form))
259: then #-for-tahoe (sfilewrite '"-")
260: (sfilewrite '"(")
261: (sfilewrite (cadr form))
262: (sfilewrite '")")
263: elseif (eq '\# (car form)) ; 5120 is base of small fixnums
264: then (sfilewrite (concat "$" (+ (* (cadr form) 4) 5120)))
265: elseif (eq '$ (car form))
266: then (sfilewrite '"$")
267: (sfilewrite (cadr form)))))
268:
269: #+for-68k
270: (defun e-cvtas (form)
271: (if (atom form)
272: then (sfilewrite form)
273: else (if (eq '* (car form))
274: then (if (eq '\# (cadr form))
275: then (setq form `($ ,(caddr form)))))
276: (if (numberp (car form))
277: then (sfilewrite (cadr form))
278: (sfilewrite "@")
279: (if (not (zerop (car form)))
280: then (sfilewrite "(")
281: (sfilewrite (car form))
282: (sfilewrite ")"))
283: elseif (eq '% (car form))
284: then (setq form (cdr form))
285: (sfilewrite (cadr form))
286: (sfilewrite "@(")
287: (sfilewrite (car form))
288: (sfilewrite ",")
289: (sfilewrite (caddr form))
290: (sfilewrite ":L)")
291: elseif (eq '+ (car form))
292: then (sfilewrite (cadr form))
293: (sfilewrite '"@+")
294: elseif (eq '- (car form))
295: then (sfilewrite (cadr form))
296: (sfilewrite '"@-")
297: elseif (eq '\# (car form))
298: then (sfilewrite (concat '#.Nilatom "+0x1400"
299: (if (null (signp l (cadr form)))
300: then "+" else "")
301: (* (cadr form) 4)))
302: elseif (eq '$ (car form))
303: then (sfilewrite '"#")
304: (sfilewrite (cadr form))
305: else (comp-err " bad arg to e-cvtas : " (or form)))))
306:
307: ;--- e-postinc :: handle postincrement for the tahoe machine
308: ;
309:
310: #+for-tahoe
311: (defun e-postinc (addr)
312: (if (and (dtpr addr) (eq (car addr) '+))
313: (e-add '($ 4) (cadr addr))))
314:
315:
316: ;--- e-docomment :: print any comment lines
317: ;
318: (defun e-docomment nil
319: (if g-comments
320: then (do ((ll (nreverse g-comments) (cdr ll)))
321: ((null ll))
322: (sfilewrite " ")
323: (sfilewrite #.comment-char)
324: (do ((ll (exploden (car ll)) (cdr ll)))
325: ((null ll))
326: (tyo (car ll) vp-sfile)
327: (cond ((eq #\newline (car ll))
328: (sfilewrite #.comment-char))))
329: (terpr vp-sfile))
330: (setq g-comments nil)
331: else (terpr vp-sfile)))
332:
333: ;--- e-goto :: emit code to jump to the location given
334: ;
335: (defun e-goto (lbl)
336: (e-jump lbl))
337:
338: ;--- e-gotonil :: emit code to jump if nil was last computed
339: ;
340: (defun e-gotonil (lbl)
341: (e-write2 g-falseop lbl))
342:
343: ;--- e-gotot :: emit code to jump if t was last computed
344: (defun e-gotot (lbl)
345: (e-write2 g-trueop lbl))
346:
347: ;--- e-label :: emit a label
348: (defun e-label (lbl)
349: (setq g-skipcode nil)
350: (e-writel lbl))
351:
352: ;--- e-pop :: pop the given number of args from the stack
353: ; g-locs is not! fixed
354: ;
355: (defun e-pop (nargs)
356: (if (greaterp nargs 0)
357: then (e-dropnp nargs)))
358:
359: ;--- e-pushnil :: push a given number of nils on the stack
360: ;
361: #+for-vax
362: (defun e-pushnil (nargs)
363: (do ((i nargs))
364: ((zerop i))
365: (if (>& i 1)
366: then (e-write2 'clrq '#.np-plus)
367: (setq i (- i 2))
368: elseif (equal i 1)
369: then (e-write2 'clrl '#.np-plus)
370: (setq i (1- i)))))
371:
372: #+for-tahoe
373: (defun e-pushnil (nargs)
374: (do ((i nargs))
375: ((zerop i))
376: (e-write2 'clrl '#.np-plus)
377: (setq i (1- i))))
378:
379: #+for-68k
380: (defun e-pushnil (nargs)
381: (do ((i nargs))
382: ((zerop i))
383: (L-push '#.nil-reg)
384: (setq i (1- i))))
385:
386: ;--- e-setupbind :: setup for shallow binding
387: ;
388: (defun e-setupbind nil
389: (e-move '#.bnp-sym '#.bnp-reg))
390:
391: ;--- e-unsetupbind :: restore temp value of bnp to real loc
392: ;
393: (defun e-unsetupbind nil
394: (e-move '#.bnp-reg '#.bnp-sym))
395:
396: ;--- e-shallowbind :: shallow bind value of variable and initialize it
397: ; - name : variable name
398: ; - val : IADR value for variable
399: ;
400: #+(or for-vax for-68k)
401: (defun e-shallowbind (name val)
402: (let ((vloc (d-loclit name t)))
403: (e-move (e-cvt vloc) '(+ #.bnp-reg)) ; store old val
404: (e-move (e-cvt `(lbind ,@(cdr vloc)))
405: '(+ #.bnp-reg)) ; now name
406: (d-move val vloc)))
407:
408: #+for-tahoe
409: (defun e-shallowbind (name val)
410: (let ((vloc (d-loclit name t)))
411: (e-move (e-cvt vloc) '(0 #.bnp-reg)) ; store old val
412: (e-add '($ 4) '#.bnp-reg)
413: (e-move (e-cvt `(lbind ,@(cdr vloc)))
414: '(0 #.bnp-reg)) ; now name
415: (e-add '($ 4) '#.bnp-reg)
416: (d-move val vloc)))
417:
418: ;--- e-unshallowbind :: un shallow bind n variable from top of stack
419: ;
420: #+(or for-vax for-tahoe)
421: (defun e-unshallowbind (n)
422: (e-setupbind) ; set up binding register
423: (do ((i 1 (1+ i)))
424: ((greaterp i n))
425: (e-move `(,(* -8 i) #.bnp-reg) `(* ,(+ 4 (* -8 i)) #.bnp-reg)))
426: (e-sub3 `($ ,(* 8 n)) '#.bnp-reg '#.bnp-sym))
427:
428: #+for-68k
429: (defun e-unshallowbind (n)
430: (makecomment "e-unshallowbind begin...")
431: (e-setupbind) ; set up binding register
432: (do ((i 1 (1+ i)))
433: ((greaterp i n))
434: (e-move `(,(* -8 i) #.bnp-reg) `(* ,(+ 4 (* -8 i)) #.bnp-reg)))
435: (e-move '#.bnp-reg '#.bnp-sym)
436: (e-sub `($ ,(* 8 n)) '#.bnp-sym)
437: (makecomment "...end e-unshallowbind"))
438:
439: ;----------- very low level routines
440: ; all output to the assembler file goes through these routines.
441: ; They filter out obviously extraneous instructions as well as
442: ; combine sequential drops of np.
443:
444: ;--- e-dropnp :: unstack n values from np.
445: ; rather than output the instruction now, we just remember that it
446: ; must be done before any other instructions are done. This will
447: ; enable us to catch sequential e-dropnp's
448: ;
449: (defun e-dropnp (n)
450: (if (not g-skipcode)
451: then (setq g-dropnpcnt (+ n (if g-dropnpcnt thenret else 0)))))
452:
453: ;--- em-checknpdrop :: check if we have a pending npdrop
454: ; and do it if so.
455: ;
456: (defmacro em-checknpdrop nil
457: `(if g-dropnpcnt
458: then (let ((dr g-dropnpcnt))
459: (setq g-dropnpcnt nil)
460: (e-sub `($ ,(* dr 4)) '#.np-reg))))
461:
462: ;--- em-checkskip :: check if we are skipping this code due to jump
463: ;
464: (defmacro em-checkskip nil
465: '(if g-skipcode then (sfilewrite #.comment-char)))
466:
467:
468: ;--- e-jump :: jump to given label
469: ; and set g-skipcode so that all code following until the next label
470: ; will be skipped.
471: ;
472: (defun e-jump (l)
473: (em-checknpdrop)
474: (e-write2 #+(or for-vax for-tahoe) 'jbr #+for-68k 'jra l)
475: (setq g-skipcode t))
476:
477: ;--- e-return :: do return, and dont check for np drop
478: ;
479: (defun e-return nil
480: (setq g-dropnpcnt nil) ; we dont need to worry about nps
481: #+(or for-vax for-tahoe) (e-write1 'ret)
482: #+for-68k (progn (e-write1 'rts)
483: (sfilewrite
484: (concat g-masklab " = " (d-makemask) '#.ch-newline))
485: (sfilewrite
486: (concat g-stackspace " = "
487: (Cstackspace) '#.ch-newline))))
488:
489: ;--- e-writel :: write out a label
490: ;
491: (defun e-writel (label)
492: (setq g-skipcode nil)
493: (em-checknpdrop)
494: (sfilewrite label)
495: (sfilewrite ":")
496: (e-docomment))
497:
498: ;--- e-write1 :: write out one litteral
499: ;
500: (defun e-write1 (lit)
501: (em-checkskip)
502: (em-checknpdrop)
503: (sfilewrite " ")
504: (sfilewrite lit)
505: (e-docomment))
506:
507: ;--- e-write2 :: write one one litteral, and one operand
508: ;
509: #+(or for-vax for-tahoe)
510: (defun e-write2 (lit frm)
511: (em-checkskip)
512: (em-checknpdrop)
513: (sfilewrite " ")
514: (sfilewrite lit)
515: (sfilewrite " ")
516: (e-cvtas frm)
517: (e-docomment)
518: #+for-tahoe (e-postinc frm))
519:
520: #+for-68k
521: (defun e-write2 (lit frm)
522: (em-checkskip)
523: (em-checknpdrop)
524: (if (and (dtpr frm) (eq (car frm) '*))
525: then (e-move (cdr frm) 'a5)
526: (sfilewrite " ")
527: (sfilewrite lit)
528: (sfilewrite '" ")
529: (e-cvtas '(0 a5))
530: else (sfilewrite " ")
531: (sfilewrite lit)
532: (sfilewrite '" ")
533: (e-cvtas frm))
534: (e-docomment))
535:
536: ;--- e-write3 :: write one one litteral, and two operands
537: ;
538: #+(or for-vax for-tahoe)
539: (defun e-write3 (lit frm1 frm2)
540: (em-checkskip)
541: (em-checknpdrop)
542: (sfilewrite " ")
543: (sfilewrite lit)
544: (sfilewrite " ")
545: (e-cvtas frm1)
546: (sfilewrite ",")
547: (e-cvtas frm2)
548: (e-docomment)
549: #+for-tahoe (e-postinc frm1)
550: #+for-tahoe (e-postinc frm2))
551:
552: #+for-68k
553: (defun e-write3 (lit frm1 frm2)
554: (em-checkskip)
555: (em-checknpdrop)
556: (if (and (dtpr frm1) (eq (car frm1) '*)
557: (not (and (dtpr frm2) (eq (car frm2) '*))))
558: then (e-move (cdr frm1) 'a5)
559: (sfilewrite " ")
560: (sfilewrite lit)
561: (sfilewrite '" ")
562: (e-cvtas '(0 a5))
563: (sfilewrite '",")
564: (e-cvtas frm2)
565: (e-docomment)
566: elseif (and (not (and (dtpr frm1) (eq (car frm1) '*)))
567: (dtpr frm2) (eq (car frm2) '*))
568: then (e-move (cdr frm2) 'a5)
569: (sfilewrite " ")
570: (sfilewrite lit)
571: (sfilewrite '" ")
572: (e-cvtas frm1)
573: (sfilewrite '",")
574: (e-cvtas '(0 a5))
575: (e-docomment)
576: elseif (and (dtpr frm1) (eq (car frm1) '*)
577: (dtpr frm2) (eq (car frm2) '*))
578: then (d-regused 'd6)
579: (e-move (cdr frm1) 'a5)
580: (e-move '(0 a5) 'd6)
581: (e-move (cdr frm2) 'a5)
582: (sfilewrite " ")
583: (sfilewrite lit)
584: (sfilewrite '" ")
585: (e-cvtas 'd6)
586: (sfilewrite '",")
587: (e-cvtas '(0 a5))
588: (e-docomment)
589: else (sfilewrite " ")
590: (sfilewrite lit)
591: (sfilewrite '" ")
592: (e-cvtas frm1)
593: (sfilewrite '",")
594: (e-cvtas frm2)
595: (e-docomment)))
596:
597: ;--- e-write4 :: write one one litteral, and three operands
598: ;
599: #+(or for-vax for-tahoe)
600: (defun e-write4 (lit frm1 frm2 frm3)
601: (em-checkskip)
602: (em-checknpdrop)
603: (sfilewrite " ")
604: (sfilewrite lit)
605: (sfilewrite " ")
606: (e-cvtas frm1)
607: (sfilewrite ",")
608: (e-cvtas frm2)
609: (sfilewrite ",")
610: (e-cvtas frm3)
611: (e-docomment)
612: #+for-tahoe (e-postinc frm1)
613: #+for-tahoe (e-postinc frm2)
614: #+for-tahoe (e-postinc frm3))
615:
616:
617: ;--- e-write5 :: write one one litteral, and four operands
618: ;
619: #+(or for-vax for-tahoe)
620: (defun e-write5 (lit frm1 frm2 frm3 frm4)
621: (em-checkskip)
622: (em-checknpdrop)
623: (sfilewrite " ")
624: (sfilewrite lit)
625: (sfilewrite " ")
626: (e-cvtas frm1)
627: (sfilewrite ",")
628: (e-cvtas frm2)
629: (sfilewrite ",")
630: (e-cvtas frm3)
631: (sfilewrite ",")
632: (e-cvtas frm4)
633: (e-docomment)
634: #+for-tahoe (e-postinc frm1)
635: #+for-tahoe (e-postinc frm2)
636: #+for-tahoe (e-postinc frm3)
637: #+for-tahoe (e-postinc frm4))
638:
639: ;--- d-printdocstuff
640: ;
641: ; describe this version
642: ;
643: (defun d-printdocstuff nil
644: (sfilewrite (concat ".data "
645: #.comment-char
646: " this is just for documentation "))
647: (terpr vp-sfile)
648: (sfilewrite (concat ".asciz \"@(#)Compiled by " compiler-name
649: " on " (status ctime) '\"))
650: (terpr vp-sfile)
651: (do ((xx Liszt-file-names (cdr xx)))
652: ((null xx))
653: (sfilewrite (concat ".asciz \"" (car xx) '\"))
654: (terpr vp-sfile)))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.