From b9159074995bf10dd69b16dcddcd1b794859e9db Mon Sep 17 00:00:00 2001 From: Eric Swenson Date: Fri, 3 Aug 2018 23:31:07 -0700 Subject: [PATCH] Revert to TRANSS 79 and build from source. No longer include TRANSS FASL or later versions of TRANSS, since these break Macyma's translate_file. Resolves #1146. --- Makefile | 2 +- bin/macsym/transs.fasl | Bin 12865 -> 0 bytes bin/maxer1/transs.80 | Bin 3126 -> 0 bytes build/build.tcl | 2 +- src/munfas/transs.unfasl | 51 --- src/transl/{transs.90 => transs.79} | 192 +++------- src/transl/transs.91 | 523 ---------------------------- 7 files changed, 48 insertions(+), 722 deletions(-) delete mode 100644 bin/macsym/transs.fasl delete mode 100755 bin/maxer1/transs.80 delete mode 100755 src/munfas/transs.unfasl rename src/transl/{transs.90 => transs.79} (71%) delete mode 100644 src/transl/transs.91 diff --git a/Makefile b/Makefile index 8b57e86b..4430fa56 100644 --- a/Makefile +++ b/Makefile @@ -29,7 +29,7 @@ DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \ xfont maxout ucode moon acount alan channa fonts games graphs humor \ kldcp libdoc lisp _mail_ midas quux scheme manual BIN = sys2 emacs _teco_ lisp liblsp alan inquir sail comlap c decsys moon \ - graphs draw datdrw fonts fonts1 fonts2 games macsym maxer1 maint imlac \ + graphs draw datdrw fonts fonts1 fonts2 games macsym maint imlac \ _www_ SUBMODULES = dasm itstar klh10 mldev simh sims supdup tapeutils diff --git a/bin/macsym/transs.fasl b/bin/macsym/transs.fasl deleted file mode 100644 index bca1aa026dba2f3493bdcbc444675c995e2e3cd7..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 12865 zcmcgzeQaFEao>H9Je^8XI*L+slI`Y6q-^TMCmuz~QYhKFJKiI8(tYVZOnq49$+ApK zwq!T5Y`Jb-8bKi#MdGAMQy6X01chrPfzbv+kp@PP6h%-JLC^%P(Lef6{%YX@kxtf; zZtNP@`Th3pJ(4E%@lPM1$JyQ4nc3Ny*_nN(5C8h={;o#pkUCn8or+bJJUZ=76ibC7 zV0m<4d0HH~*(t?gw z3l*;#tH!1{pB%GpvRWx*3&}K*2YjfQFIFoN@JN@BjO7R=$IHhJv>%h%SI#=gDj|>| z%P!37z$;XjR}Y|7fYt&Ee<-g`%+P2mH0`S|C^Z#3b-oHTUG^$RF{Dyywyiz`yb<34fCO_%slBFY_=z%mjAFn=4=m8~PZ=L9}F}Mm4d94Np zCFDw|Xu}#PoUuSAB2zFz{)UM1v%ptYOQwlT)^qd8oQFA%37>hqwn)X310p#RmWs;z|dky@&`~ZdCV(~n1)h;y+nYwg+z#l zrX8r21HNvPd9!S>mrAlyrSEXogeT1sH7spCUdR=*C5+(F<)Sy9Nt#`eeTlW)fE$zc zQq{?rx;%Dj=M<28AwWN%b%3@}6g2zLe2DV+3q`+96{`7k5g;D==z2i36*Gae&`0Zj z2#|3CpAv|74pd6hg=$5-a2m2rOT0){vo!ZR3ATM1!Gv5kQ*KMPL@+a9v0&RF7foeD zK<=|5QnpIv_;k)Imy?s8&*JvF+Y!*jhF;!Zy-1BO5zL@17HkIuTcR=aXlQIIlTRN< z>o$9b(a$aBkFEu*1B`$*`|9%UqY@TtqGd(NibQHxysqp*FXb2}-9{3Sb8jn2fI&2n zquIECmM8(ZHk1$?8N^z7CosHmG5_UuB0vj-U>`W%P00ML#_R=d2U2)emJ@u27t4tW z3wA8PAR0!gr(r-#^n@NgfUqzr=LCbu%B+DLy)EkiBVf%wyq00zfi0?(s@^otf$748 z@$Zx;XO{F!8jwv^yjE;mSum`4WU*kE5o*D7iDC>|ARVUyZ;5p1rvV|Ldee_3OD3qU zECgt5S}X*J=$yowN}HUl2+9_RFh`zY;pH-Zuf$ABP7G(MGFA>BFv$c+R*c_Ned(pXt0nSwl|$5=a2&5y%K+W-2WT&#`vH9c&;x+>1Nv=1j{xEs9Eu2J&T2nKVNeoIsvRHYCjfIg3-736qj2s}=FwHUocJ+xl9Pl8P}=q!SdQ ze6*TL1L_o!3*!=@-B!-!$|>eS1QF8Fkv36oiH_x9i^+;Rihf-(W>A?hrdcUSnS`n# z$*ROuDQyDgkc64AN9SmQF)^(Z9bu)0_6fa)HLD)!)#w$1aHv-~hanZ3fcj6OkgL~b)zSH{&MMatNk4~m*q!Z!zU~~{-4BM6@u0S~oU8tce@^U(6ZoJY6&#IHRc6E$sas%GZMnq;b^l0-Y zMo(d2c>Zr^)#-+Ht$B0)k7w0c6&ZBmC&PncSv~TamyMnVx1CT`{FB5_)bvnPvIOW> zL*|<*+P$^6p#<_*9`g0V-8cwjnwK#anV}Um87x15_9kYoVnJ`6v}M1cm3k;LIx-je zQuCvSVcK{)f$=K1Hldo+Sl$SrGZ=VNCu&<9j$&Y!p(3MaX-M-oMI7K=#iB-ucS~>S z?603zYQ{;;+_*w2dnLL>0e!il!AL1}PX3u%><$$&@b^ML%KnH&nH?4kpRz0gT z9jPre2g;pDNFD1SUNzRus+=Rr7f1wk9t6}os}8D;?vQgrv?3x>MbFRur!b)TU{m;5 zSd*BUm_W3XXT^|<6nr#E4bc57h}VEK%&n!2GP)@E|?82 z$+v((rE~$1Bfu+_3MF@heVV6Jb+B87A*X&6IDlF;84ec4eD+C3-Kt1frnqrn%VSd^ z&KlAF?u$x2?(|4!yi>v?Mms)9d_!p%@ehr4{5jZa-INJ*HH8H$|yfEXLhts08o~#uyO|0myeF?~y z7THNedSvC|+hcp%EG{)f$Nvsd?4f-#H(ujW5nW$<%I0~&6@b#+o(SNuX)vndjA572 z+z-AuOq}Gv(-L=ay5fm4w9`ZxY!Poh^+!V=MnX=nlM)4BA3i|5Suo0hcF?UH{5dL*K8CojU(As7wAlSyo`dhsWIY$eT?d zBP&*qG~~rJDR4FnvQnJ%^3#>1P&CiV9*Y^Tk~(b!WfGnR9vff~4Wq1(UInzoV}UFF zHz9Y|$x_8VR45!F*2?@b{OE1@2N(f=_TjaJ|Ht3`R=f}0lE4;H3u;^x4JhVKh|rP) znMVo^-#4E7)mhyGcR4s1t##0#{{XWCgZ7?k8MH=!H_Tud zL013ouVy639-0U6+R$*VL;S=dA5`f`7Y?*U#? zk^m^V^RolcdBrm!kR^gteyzLeg;{@ROtjiE3gK~c%WXpl&^nxWvKLL889p+gJ0$mhNKc+`n(Li2i%_UxUY&5Xf&~MheXfNDW{4uw&F2M~U(%+(n{wFfpyyb*MW^lWw-<>i>Vab`G>Ax*RRy$5p{+&D~gFX zogV44&MSSv85mTG19RVN-Rg7`MWyAaB3}K(to{$I?`^IRKHupVyoXNMHA%8l@(M@Q zt}ra&>p@6n&4)F=4EY}Rm39pYh1wjhjjQ^MXbHOc8WM-sftT@3`0Hp6@yzEcH>;3} z62)Y5s3)AmSYS;Yfzb(gbQ9C8k6MvY^xX&?hIsTxZ0gg#KN@$kJB5iKG)AzZpPRh% zm|*+1y`YYc>%$?@{AX)x?3lT*MRqneb!GR0{3ob+Y$*)mD14-TT~zo$k*1ImLCs^0 z;cw^pYOJ`QJ*)PisEBBOa@0@oE13*vIopt>OHhXt`iT;;1&ZYh#e!TynYQL9ecmUb zL(6Al*W6K2OA;HOlrmZh^gtt2z2CI)0snAaQ2qqakzQ4MmUp0k3VK<;LV7D$f(k{= zQ7mb>uneyGDXDj~n#|%vD{>UK`tH;r$sX9u}>|NJFvxQJkfqsQtJpSL!&W17kLqiN+t5!b#Aj5XrL)*2rJ3LM@lj?JsEqYObk z-HtPHdDw@o7GC3CZ zB`5`Ps72}uNm=}+ZkfWBzf>ugoqh4?k(~-e?;}yIYPD0m>RY_5r9|u2H~2#cOLj|E zj#SuO=N6-(4h99C_pNeCb&QBq=3=n*ZwDK0TbEC3YGXlZWBs{dbU$_-kG=twm|6zV zI~b5dSj-MhrgN1B`Z&Oo17!&G@A;Y=)~U-EF9(}oR3)B#T|&C$V5)NP0?jS}r2ZX{ zGlbE%%(Xv12+>%pi}`~P#blUZRS{hK8-6dH{oO$1fphZN$<4~wPjqfxb2(OIG(d1TR)0oOrq%)g@PZ@RuQ0gc0fE6D9hRxLH9Nx5p?r z=NKm@$9KaTmHgqG5=rLl__qFgk_pJ~EhE!h;##w5%l8#oplm$oM4wE=;rRdH=hso> z3ixhfy+a2Ka$&~LQ>v%`lJ`p@whSA#>lG zfeLud;RdDB5-U&=LL}}+t*NR`gm`S~9hKu5A1bINIaly$!F+-+er)M5KQeHioV7Do zM=r`)g8lb#0{x3git*KF?2E9>_})mO1q|HQ8! z4$hXas;#&8aj>H%=DAh+5L=%5=qLM|P4IcioHF+dTavTY#+_9hI<1=Uim33TraX0f zy~zVFMxa*g1249MJn*L&U~m!+a-9v7e_kdJ#GsUalCc&6Viuon|5me=BlC+->*r4` zJm=gc=QL+rbk05Z9HFx_r=K(V;^{BWT)trXF23lzNa%S-j($S?0UIH2r!ahZtYW@2 zb%8sRwVwl;smtqM06hcfmw?Uz`d2{bL7)RKu5_8)?|q<=-1|hM{UQGa4d#CD1L^}> z4>0(9Z?y3Fu;R(@KFlL$b^9Av@VkcHazA48*8;aTjC72^mCi~{Wpgj?+A$!&&lWib z1d$yTa${l^_Wcg*1(9(Y_A_o$wKg9nX F`9BSGROJ8w diff --git a/bin/maxer1/transs.80 b/bin/maxer1/transs.80 deleted file mode 100755 index a77f50ecb21ebec6f490fc1b4409237e4904f87f..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 3126 zcmb7G%Wm676lJorx81b6iy%U1!IWQdYS=&n0^G4@LBz9+EqDfOipyK2Ac@I8`Js4$rQ|RcXa(KSwClbD7G{Yu*W)oy z(HA^f@^CfJ!|)0CNfe<9n#M3!X|hOJ6b11DmI2P*C#AxIOr)Ge8P;zBzunxkIKv<<*h>fvI(G#Clt}671x9JA8>vn-KL-1$? zUnxY)PZJ~x*2}c-Q^m@a)v^x6^3(eChNN6UP||m} zOT(h9B(x8%*>jXd!~vNo=~4UXg8)7YM3PF22xx6@C|6rmD9ly~ehqkJWy%*h7CO?i z70|Szanyv@EDhKcD<6wRAV(RjIp*6uDjF4ySIDo?G{8<~{1OIOhF5US{2Sa(mtZqL z+eC~6DtS#Kjf!{NmOd&RDm#UVbSa*9f}u*oRaK&xq!cR}dJy|zj@1CVY&W`|2`2Ik<{V#$NZ)l1 z;MrZr`RQ`de`T9*uiWdgHSplOyMxMztgPDbi4hwMKJYU#v~64eL*0vm52PCg(};aI z61e@tycPb31p&J3t*GS1w54OnHW@bQLnNF-@5lB_yYCuy`|bdL#eOY#!seq-oxf+H zv0ftPh*7kneo0fiY5+Q7yo(>TuV@D;9gFT3nn6sv$)J5_-0)5F0XTI%WYKiSK;Me* z*sFzm{})Sz4kf@Y=ikUOj1&v42mIWtZfk+xf-W{IzLHx_Mv6ROO5#f*PzH6%51T(V z!utfiSYKD2P5CCOsJx3tE!gs}F4COK9;R?5Vo|&%_$AElYM{De>#0a58IOXh0-hDl zgR;2SqRbG9Q3@NkInO!hp9!czB}MHX$lkX1s9vH@-4KrqKV*3PVq4E3<+pi|VtbKi z$NeRsY5~-Bs&1&!$pdqSWj2$ym`WULpau-$S(xf@#U_C5Fz1Ibt5j(GqD_t8w&gfx&obI0Z|K75bCRj%T_4}?yf^c?bcz}bOvZfMujLD{b9#?ixaQSu|eM^p2IHa zcz2letl>nSvKYiE`F2sn>YCob?P8iI5<(KB%i@GmoQ%5i9yWPp^@ly2FE3FY6qi`Z z+goppPI2aivPm*BXq=KMlF2tH@(w2?1vEhcPw-wjDfw`&arKNW(5gyZ36&w@vJASZ bqEN7OtXE#IiAyJ~146+=n5(35f=cLL>+Vu@ diff --git a/build/build.tcl b/build/build.tcl index 3e9ed87d..0a75e6a8 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -100,7 +100,7 @@ proc build_macsyma_portion {} { expect "=Build=" respond "\r" "(mapcan " type "#'(lambda (x) (cond ((not (memq x\r" - type "'(TRANSS)\r" + type "'(DUMMY)\r" type ")) (doit x)))) (append todo todoi))" set timeout 1000 expect { diff --git a/src/munfas/transs.unfasl b/src/munfas/transs.unfasl deleted file mode 100755 index 87355add..00000000 --- a/src/munfas/transs.unfasl +++ /dev/null @@ -1,51 +0,0 @@ - -'(THIS IS THE UNFASL FOR ((DSK TRANSL) TRANSS /80)) -'(ASSEMBLED BY FASLAP /392) -'(COMPILED BY LISP COMPILER /936 COMAUX /25 PHAS1 /86 MAKLAP /80 INITIA /118) - -;COMPILED ON TUESDAY, JUNE 8, 1982, AT 2:01 PM - -;; Macsyma installation compilation by GJC. -;; Macsyma compilation environment version 28 -;; dumped on Sunday the thirtieth of May, 1982; 10:30:13 pm by GJC -;; Macro files: UMLMAC 35, DCL 5/29/82 8:19:42, NUMERM 12, PROCS 15, -;; TRANSM 128, ERMSGC 210, DEFOPT 5, MOPERS 47, DEFINE 64, -;; MFORMA 100, MAXMAC 198, LMMAC 82, MACSYMA-MODULE 7 -;initializing error messages. - -'*TRANSL-FILE-DEBUG* -'$TR_OUTPUT_FILE_DEFAULT -'$TR_FILE_TTY_MESSAGESP -'$TR_WINDY -'*TRANSLATION-MSGS-FILES* -'$TR_VERSION -'TRANSL-FILE -'$COMPGRIND -'$TR_TRUE_NAME_OF_FILE_BEING_TRANSLATED -'$TR_STATE_VARS -'DECLARES - (COMMENT **FASL** 0. (LAP $COMPFILE MFEXPR*S)) - (COMMENT **FASL** 165. (LAP COMPILE-FUNCTION SUBR)) -'TR-DEFAULTF - (COMMENT **FASL** 177. (LAP $TRANSLATE_FILE LSUBR)) -'$TR_GEN_TAGS -'TRF-START-HOOK - (COMMENT **FASL** 258. (LAP DELETE-OLD-AND-OPEN SUBR)) - (COMMENT **FASL** 275. (LAP TRANSLATE-FILE SUBR)) - (COMMENT **FASL** 476. (LAP PRINT* SUBR)) - (COMMENT **FASL** 489. (LAP SUB-PRINT* SUBR)) - (COMMENT **FASL** 551. (LAP PRINC* SUBR)) - (COMMENT **FASL** 560. (LAP |TRANSL;TRANSS 80_1.| LSUBR)) - (COMMENT **FASL** 568. (LAP NPRINC* LSUBR)) - (COMMENT **FASL** 576. (LAP TERPRI* SUBR)) - (COMMENT **FASL** 582. (LAP PRINT-MODULE SUBR)) - (COMMENT **FASL** 597. (LAP NEW-COMMENT-LINE SUBR)) - (COMMENT **FASL** 600. (LAP PRINT-TRANSL-MODULES SUBR)) - (COMMENT **FASL** 633. (LAP PRINT-TRANSL-HEADER SUBR)) - (COMMENT **FASL** 681. (LAP PRINT-ABORT-MSG SUBR)) - (COMMENT **FASL** 686. (LAP RENAME-TF SUBR)) - (COMMENT **FASL** 732. (LAP PUMP-STREAM LSUBR)) - (COMMENT **FASL** 765. (LAP $TRANSLATE MFEXPR*S)) -(COMMENT **** (UPDATE-GLOBAL-DECLARES TO-MACSYMA-NAMESTRING) - have been used but remain undefined in this file) - (COMMENT **FASL** TOTAL = 827. WORDS) \ No newline at end of file diff --git a/src/transl/transs.90 b/src/transl/transs.79 similarity index 71% rename from src/transl/transs.90 rename to src/transl/transs.79 index 1979ab2d..e75557ef 100644 --- a/src/transl/transs.90 +++ b/src/transl/transs.79 @@ -50,62 +50,29 @@ $TR_WARN_UNDEFINED_VARIABLE $TR_FUNCTION_CALL_DEFAULT $TR_ARRAY_AS_REF - $TR_NUMER - $DEFINE_VARIABLE)) - -(defmacro compfile-outputname-temp () - #-(or Multics Lispm) ''|_CMF_ OUTPUT| - #+Multics ''(* _cmf_ output) - #+LispM '`,(fs:parse-pathname "_cmf_")) + $TR_NUMER)) +(defmacro compfile-outputname-temp () ''|_CMF_ OUTPUT|) (defmacro compfile-outputname () - #-(or Multics Lispm)'`((DSK ,(STATUS UDIR)) - ,(STATUS USERID) - ,(stripdollar $TR_OUTPUT_FILE_DEFAULT)) - #+Multics '`(,(status udir) ,(stripdollar $tr_output_file_default)) - #+LispM '`,(fs:parse-pathname (stripdollar $tr_output_file_default))) + '`((DSK ,(STATUS UDIR)) + ,(STATUS USERID) + ,(stripdollar + $TR_OUTPUT_FILE_DEFAULT))) (defmacro trlisp-inputname-d1 () ;; so hacks on DEFAULTF will not stray the target. - #-(or Multics Lispm) '`((dsk ,(status udir)) * >) - #+Multics '`(,(status udir) * *) - #+LispM '`,(fs:parse-pathname "")) + '`((dsk ,(status udir)) * >)) (defmacro trlisp-outputname-d1 () - #-(or Multics Lispm) '`((* *) * ,(stripdollar $TR_OUTPUT_FILE_DEFAULT)) - #+Multics '`(* * ,(stripdollar $tr_output_file_default)) - #+LispM '`,(fs:parse-pathname (stripdollar $tr_output_file_default))) - -(defmacro trlisp-outputname () - #-(or Multics Lispm) ''|* TRLISP| - #+Multics ''(* * lisp) - #+LispM '`,(send (fs:parse-pathname "") ':new-canonical-type ':lisp)) - -(defmacro trlisp-outputname-temp () - #-(or Multics Lispm) ''|* _TRLI_| - #+Multics ''(* * _trli_) - #+LispM '`,(fs:parse-pathname "_trli_")) - -(defmacro trtags-outputname () - #-(or Multics Lispm) ''|* TAGS| - #+Multics ''(* * tags) - #+LispM '`,(fs:parse-pathname "tags")) - -(defmacro trtags-outputname-temp () - #-(or Multics Lispm) ''|* _TAGS_| - #+Multics ''(* * _tags_) - #+LispM '`,(fs:parse-pathname "_tags_")) + '`((* *) * ,(stripdollar $TR_OUTPUT_FILE_DEFAULT))) -(defmacro trcomments-outputname () - #-(or Multics Lispm) ''|* UNLISP| - #+Multics ''(* * unlisp) - #+LispM '`,(fs:parse-pathname "unlisp")) - -(defmacro trcomments-outputname-temp () - #-(or Multics Lispm) ''|* _UNLI_| - #+Multics ''(* * _unli_) - #+LispM '`,(fs:parse-pathname "_unli_")) +(defmacro trlisp-outputname () ''|* TRLISP|) +(defmacro trlisp-outputname-temp () ''|* _TRLI_|) +(defmacro trtags-outputname () ''|* TAGS|) +(defmacro trtags-outputname-temp () ''|* _TAGS_|) +(defmacro trcomments-outputname () ''|* UNLISP|) +(defmacro trcomments-outputname-temp () ''|* _UNLI_|) (DEFTRVAR DECLARES NIL) @@ -165,15 +132,7 @@ (DEFVAR TR-DEFAULTF NIL "A default only for the case of NO arguments to $TRANSLATE_FILE") - -;;; Temporary hack during debugging of this code. -#+LispM -(progn 'compile -(defmacro mergef (x y) `(fs:merge-pathnames ,x ,y)) -(defmacro truename (x) `(let ((name (send ,x ':truename))) - (if name name ,x))) -) - + (DEFMFUN $TRANSLATE_FILE (&OPTIONAL (INPUT-FILE-NAME NIL I-P) (OUTPUT-FILE-NAME NIL O-P)) (OR I-P TR-DEFAULTF @@ -201,21 +160,11 @@ (DEFVAR TRF-START-HOOK NIL) -#-LispM (DEFUN DELETE-OLD-AND-OPEN (X) - (IF (LET ((F (PROBEF X))) - (AND F (NOT (MEMQ (CADDR (NAMELIST #-Franz F #+Franz X)) '(< >))))) - (DELETEF X)) - (OPEN-OUT-DSK X)) - -#+LispM -(DEFUN DELETE-OLD-AND-OPEN (X) - (LET* ((F (PROBEF X)) - (VER (IF F (SEND F ':VERSION)))) - (if (OR (NUMBERP VER) - (EQ VER ':UNSPECIFIC)) - (DELETEF X))) - (OPEN-OUT-DSK X)) + (IF (LET ((F (PROBEF X))) + (AND F (NOT (MEMQ (CADDR (NAMELIST F)) '(< >))))) + (DELETEF X)) + (OPEN-OUT-DSK X)) (DEFUN TRANSLATE-FILE (IN-FILE-NAME OUT-FILE-NAME TTYMSGSP) (BIND-TRANSL-STATE @@ -226,7 +175,6 @@ (TAGS-OUTPUT-STREAM) (TAGS-OUTPUT-STREAM-STATE) (WINP NIL) - (TYO (IF (BOUNDP 'TYO) TYO T)) (TRUE-IN-FILE-NAME)) (UNWIND-PROTECT (PROGN @@ -234,9 +182,11 @@ TRUE-IN-FILE-NAME (TO-MACSYMA-NAMESTRING (TRUENAME IN-FILE)) $TR_TRUE_NAME_OF_FILE_BEING_TRANSLATED TRUE-IN-FILE-NAME TRANSL-FILE (DELETE-OLD-AND-OPEN - (MAKE-TRANSL-FILE-TEMP-NAME OUT-FILE-NAME)) + (MERGEF (trlisp-outputname-temp) + OUT-FILE-NAME)) DSK-MSGS-FILE (DELETE-OLD-AND-OPEN - (MAKE-MSGS-FILE-TEMP-NAME OUT-FILE-NAME)) + (MERGEF (trcomments-outputname-temp) + OUT-FILE-NAME)) *TRANSLATION-MSGS-FILES* (LIST DSK-MSGS-FILE)) (IF $TR_GEN_TAGS (SETQ TAGS-OUTPUT-STREAM @@ -254,8 +204,7 @@ TRUE-IN-FILE-NAME) (IF TRF-START-HOOK (FUNCALL TRF-START-HOOK TRUE-IN-FILE-NAME)) (IF TAGS-OUTPUT-STREAM (TAGS-START//END IN-FILE-NAME)) - #-MAXII(CALL-BATCH1 TRUE-IN-FILE-NAME (NOT *TRANSL-FILE-DEBUG*)) - #+MAXII(READ-AND-TRANSLATE TRUE-IN-FILE-NAME (NOT *TRANSL-FILE-DEBUG*)) + (CALL-BATCH1 TRUE-IN-FILE-NAME (NOT *TRANSL-FILE-DEBUG*)) ;; BATCH1 calls TRANSLATE-MACEXPR on each expression read. (MFORMAT DSK-MSGS-FILE "~%//* Variable settings were *//~%~%") @@ -272,20 +221,17 @@ ;;(CLOSE DSK-MSGS-FILE) ;; The CLOSE before RENAMEF clobbers the old temp file. ;; nope. you get a FILE-ALREADY-EXISTS error. darn. - (let ((TR-COMMENT-FILE-NAME (MAKE-MSGS-FILE-NAME OUT-FILE-NAME))) - (if (probef tr-comment-file-name) - (deletef tr-comment-file-name)) - #+LispM - (close dsk-msgs-file) - (RENAMEF DSK-MSGS-FILE tr-comment-file-name) + (RENAMEF DSK-MSGS-FILE + (MERGEF (trcomments-outputname) + OUT-FILE-NAME)) (SETQ WINP T) `((MLIST) ,(TO-MACSYMA-NAMESTRING TRUE-IN-FILE-NAME) ,(TO-MACSYMA-NAMESTRING OUT-FILE-NAME) - ,(TO-MACSYMA-NAMESTRING (TRUENAME tr-comment-file-name)) + ,(TO-MACSYMA-NAMESTRING (TRUENAME DSK-MSGS-FILE)) ,@(IF TAGS-OUTPUT-STREAM (LIST (TO-MACSYMA-NAMESTRING (TRUENAME TAGS-OUTPUT-STREAM))) - NIL)))) + NIL))) ;; Unwind protected. (IF DSK-MSGS-FILE (CLOSE DSK-MSGS-FILE)) (IF TRANSL-FILE (CLOSE TRANSL-FILE)) @@ -294,48 +240,7 @@ (IF TAGS-OUTPUT-STREAM (DELETEF TAGS-OUTPUT-STREAM)) (IF TRANSL-FILE (DELETEF TRANSL-FILE))))))) -#-LispM -(defun make-transl-file-temp-name (out-file-name) - (MERGEF out-file-name (trlisp-outputname-temp))) - -#+LispM -(defun make-transl-file-temp-name (out-file-name) - (send (fs:parse-pathname out-file-name) ':new-raw-name (send (trlisp-outputname-temp) - ':raw-name))) - -#-LispM -(defun make-msgs-file-name (out-file-name) - (mergef (trcomments-outputname) out-file-name)) - - -#+LispM -(defun make-msgs-file-name (out-file-name) - (send (fs:parse-pathname out-file-name) ':new-raw-name (send (trcomments-outputname) - ':raw-name))) - -#-LispM -(defun make-msgs-file-temp-name (out-file-name) - (MERGEF out-file-name (trcomments-outputname-temp))) - -#+LispM -(defun make-msgs-file-temp-name (out-file-name) - (send (fs:parse-pathname out-file-name) ':new-raw-name (send (trcomments-outputname-temp) - ':raw-name))) - - -#+LispM -(DEFUN READ-AND-TRANSLATE (FILENAME SILENT-P) - (LET ((EOF (LIST NIL)) - (NAME ($FILENAME_MERGE FILENAME)) - (*MREAD-PROMPT* "(Translating) ")) - (TRUEFNAME NAME) - (IF $LOADPRINT (MTELL "~%Translating the file ~M~%" NAME)) - (WITH-OPEN-FILE (STREAM NAME '(:IN :ASCII)) - (DO ((FORM NIL (MREAD STREAM EOF))) - ((EQ FORM EOF) - (IF $LOADPRINT (MTELL "Translation done.~%")) - '$DONE) - (TRANSLATE-MACEXPR-ACTUAL (CADDR FORM) 0.))))) + ;; Should be rewritten to use streams. Barf -- perhaps SPRINTER doesn't take ;; a stream argument? Yes Carl SPRINTER is old i/o, but KMP is writing @@ -395,13 +300,13 @@ (MFORMAT TRANSL-FILE ";;; -*- Mode: Lisp; Package: Macsyma -*-~%") (IF SOURCE - (MFORMAT TRANSL-FILE ";;; Translated code for ~A" (name-for-printing SOURCE)) + (MFORMAT TRANSL-FILE ";;; Translated code for ~A" SOURCE) (MFORMAT TRANSL-FILE ";;; Translated MACSYMA functions generated by COMPFILE.")) (MFORMAT TRANSL-FILE "~%;;; Written on ~:M, from MACSYMA ~A~ ~%;;; Translated for ~A~%" - ($TIMEDATE) $VERSION (sys-user-id)) + ($TIMEDATE) $VERSION (STATUS USERID)) (print-TRANSL-MODULEs) (MFORMAT TRANSL-FILE ;; The INCLUDEF must be in lower case for transportation @@ -426,25 +331,17 @@ ~% (setq $tr_semicompile '~S)~ ~% (setq forms-to-compile-queue ()))~ ~%~%(comment ~S)~%~%" - $tr_semicompile (name-for-printing source)) - (COND ($TRANSCOMPILE - (UPDATE-GLOBAL-DECLARES) - (IF $COMPGRIND - (MFORMAT - TRANSL-FILE + $tr_semicompile source) +(COND ($TRANSCOMPILE + (UPDATE-GLOBAL-DECLARES) + (IF $COMPGRIND + (MFORMAT + TRANSL-FILE ";;; General declarations required for translated MACSYMA code.~%")) - (PRINT* `(DECLARE . ,DECLARES)))) + (PRINT* `(DECLARE . ,DECLARES)))) ) -#-LispM -(defmacro name-for-printing (file) - `',file) - -#+LispM -(defmacro name-for-printing (file) - `(send ,file ':string-for-printing)) - (DEFUN PRINT-ABORT-MSG (FUN FROM) (MFORMAT *TRANSLATION-MSGS-FILES* "~:@M failed to Translate.~ @@ -458,15 +355,18 @@ (let ((IN-FILE)) (UNWIND-PROTECT (PROGN - (close transl-file) - (SETQ IN-FILE (OPEN-in-dsk (truename TRANSL-FILE))) + (SETQ IN-FILE (OPEN-in-dsk TRANSL-FILE)) (SETQ TRANSL-FILE - (OPEN-out-dsk (TRUENAME NEW-NAME))) + (OPEN-out-dsk (TRUENAME TRANSL-FILE))) + (PRINT-TRANSL-HEADER TRUE-IN-FILE-NAME) (MAPC #'PRINT* (NREVERSE *PRE-TRANSL-FORMS*)) ; clever eh? (terpri*) (PUMP-STREAM IN-FILE TRANSL-FILE) (MFORMAT TRANSL-FILE "~%(compile-forms-to-compile-queue)~%~%") + ;; IN-FILE and TRANSL-FILE both have the same name, + ;; ITS file locks keep thing straight. + (RENAMEF TRANSL-FILE NEW-NAME) (DELETEF IN-FILE)) ;; if something lost... (IF IN-FILE (CLOSE IN-FILE)) @@ -478,7 +378,7 @@ (DO ((C)) ((ZEROP N)) (DECLARE (FIXNUM C)) - (SETQ C (+TYI IN -1)) + (SETQ C (+TYI IN)) (IF (= C -1) (RETURN NIL)) (+TYO C OUT) (SETQ N (1- N)))) diff --git a/src/transl/transs.91 b/src/transl/transs.91 deleted file mode 100644 index 9f356b2d..00000000 --- a/src/transl/transs.91 +++ /dev/null @@ -1,523 +0,0 @@ -;;;;;;;;;;;;;;;;;;; -*- Mode: Lisp; Package: Macsyma -*- ;;;;;;;;;;;;;;;;;;; -;;; (c) Copyright 1980 Massachusetts Institute of Technology ;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(macsyma-module transs) - -(TRANSL-MODULE TRANSS) - - -(DEFMVAR *TRANSL-FILE-DEBUG* NIL - "set this to T if you don't want to have the temporary files - used automaticaly deleted in case of errors.") - -;;; User-hacking code, file-io, translator toplevel. -;;; There are various macros to cons-up filename TEMPLATES -;;; which to mergef into. The filenames are should be the only -;;; system dependant part of the code, although certain behavior -;;; of RENAMEF/MERGEF/DELETEF is assumed. - -(defmvar $TR_OUTPUT_FILE_DEFAULT '$TRLISP - "This is the second file name to be used for translated lisp - output.") - -(DEFMVAR $TR_FILE_TTY_MESSAGESP NIL - "It TRUE messages about translation of the file are sent - to the TTY also.") - -(DEFMVAR $TR_WINDY T - "Generate /"helpfull/" comments and programming hints.") - -(DEFTRVAR *TRANSLATION-MSGS-FILES* NIL - "Where the warning and other comments goes.") - -(DEFTRVAR $TR_VERSION (GET 'TRANSL-AUTOLOAD 'VERSION)) - -(DEFMVAR TRANSL-FILE NIL "output stream of $COMPFILE and $TRANSLATE_FILE") - -(DEFMVAR $COMPGRIND NIL "If TRUE lisp output will be pretty-printed.") - -(DEFMVAR $TR_TRUE_NAME_OF_FILE_BEING_TRANSLATED nil - "This is set by TRANSLATE_FILE for use by user macros - which want to know the name of the source file.") - -(DEFMVAR $TR_STATE_VARS - '((MLIST) $TRANSCOMPILE $TR_SEMICOMPILE - $TR_WARN_UNDECLARED - $TR_WARN_MEVAL - $TR_WARN_FEXPR - $TR_WARN_MODE - $TR_WARN_UNDEFINED_VARIABLE - $TR_FUNCTION_CALL_DEFAULT - $TR_ARRAY_AS_REF - $TR_NUMER - $DEFINE_VARIABLE)) - -(defmacro compfile-outputname-temp () - #-(or Multics Lispm) ''|_CMF_ OUTPUT| - #+Multics ''(* _cmf_ output) - #+LispM '`,(fs:parse-pathname "_cmf_")) - -(defmacro compfile-outputname () - #-(or Multics Lispm)'`((DSK ,(STATUS UDIR)) - ,(STATUS USERID) - ,(stripdollar $TR_OUTPUT_FILE_DEFAULT)) - #+Multics '`(,(status udir) ,(stripdollar $tr_output_file_default)) - #+LispM '`,(fs:parse-pathname (stripdollar $tr_output_file_default))) - -(defmacro trlisp-inputname-d1 () - ;; so hacks on DEFAULTF will not stray the target. - #-(or Multics Lispm) '`((dsk ,(status udir)) * >) - #+Multics '`(,(status udir) * *) - #+LispM '`,(fs:parse-pathname "")) - -(defmacro trlisp-outputname-d1 () - #-(or Multics Lispm) '`((* *) * ,(stripdollar $TR_OUTPUT_FILE_DEFAULT)) - #+Multics '`(* * ,(stripdollar $tr_output_file_default)) - #+LispM '`,(fs:parse-pathname (stripdollar $tr_output_file_default))) - -(defmacro trlisp-outputname () - #-(or Multics Lispm) ''|* TRLISP| - #+Multics ''(* * lisp) - #+LispM '`,(send (fs:parse-pathname "") ':new-canonical-type ':lisp)) - -(defmacro trlisp-outputname-temp () - #-(or Multics Lispm) ''|* _TRLI_| - #+Multics ''(* * _trli_) - #+LispM '`,(fs:parse-pathname "_trli_")) - -(defmacro trtags-outputname () - #-(or Multics Lispm) ''|* TAGS| - #+Multics ''(* * tags) - #+LispM '`,(fs:parse-pathname "tags")) - -(defmacro trtags-outputname-temp () - #-(or Multics Lispm) ''|* _TAGS_| - #+Multics ''(* * _tags_) - #+LispM '`,(fs:parse-pathname "_tags_")) - - -(defmacro trcomments-outputname () - #-(or Multics Lispm) ''|* UNLISP| - #+Multics ''(* * unlisp) - #+LispM '`,(fs:parse-pathname "unlisp")) - -(defmacro trcomments-outputname-temp () - #-(or Multics Lispm) ''|* _UNLI_| - #+Multics ''(* * _unli_) - #+LispM '`,(fs:parse-pathname "_unli_")) - -(DEFTRVAR DECLARES NIL) - -(DEFMSPEC $COMPFILE (FORMS) (setq forms (cdr forms)) - (bind-transl-state - (SETQ $TRANSCOMPILE T - *IN-COMPFILE* T) - (let ((OUT-FILE-NAME (COND ((MFILENAME-ONLYP (CAR FORMS)) - ($FILENAME_MERGE (POP FORMS))) - (T ""))) - (t-error nil) - (*TRANSLATION-MSGS-FILES* NIL)) - (SETQ OUT-FILE-NAME - (MERGEF OUT-FILE-NAME (COMPFILE-OUTPUTNAME))) - (UNWIND-PROTECT - (PROGN - (SETQ TRANSL-FILE (OPEN-out-dsk (MERGEF (COMPFILE-OUTPUTNAME-TEMP) - OUT-FILE-NAME))) - - (COND ((OR (MEMQ '$ALL FORMS) (MEMQ '$FUNCTIONS FORMS)) - (SETQ FORMS (MAPCAR #'CAAR (CDR $FUNCTIONS))))) - (DO ((L FORMS (CDR L)) - (DECLARES NIL NIL) - (TR-ABORT NIL NIL) - (ITEM) (LEXPRS NIL NIL) (FEXPRS NIL NIL) - (T-ITEM)) - ((NULL L)) - (SETQ ITEM (CAR L)) - (COND ((NOT (ATOM ITEM)) - (PRINT* (DCONVX (TRANSLATE ITEM)))) - (T - (SETQ T-ITEM - (COMPILE-FUNCTION - (SETQ ITEM ($VERBIFY ITEM)))) - (COND (TR-ABORT - (SETQ T-ERROR - (PRINT-ABORT-MSG ITEM - 'COMPFILE))) - (T - (COND ($COMPGRIND - (MFORMAT TRANSL-FILE - "~2%;; Function ~:@M~%" ITEM))) - (PRINT* T-ITEM)))))) - (RENAME-TF OUT-FILE-NAME NIL) - (TO-MACSYMA-NAMESTRING OUT-FILE-NAME)) - ;; unwind-protected - (IF TRANSL-FILE (CLOSE TRANSL-FILE)) - (IF T-ERROR (DELETEF TRANSL-FILE)))))) - - -(DEFUN COMPILE-FUNCTION (F) - (MFORMAT *TRANSLATION-MSGS-FILES* - "~%Translating ~:@M" F) - (LET ((FUN (TR-MFUN F))) - (COND (TR-ABORT NIL) - (T FUN)))) - -(DEFVAR TR-DEFAULTF NIL - "A default only for the case of NO arguments to $TRANSLATE_FILE") - -;;; Temporary hack during debugging of this code. -#+LispM -(progn 'compile -(defmacro mergef (x y) `(fs:merge-pathnames ,x ,y)) -(defmacro truename (x) `(let ((name (send ,x ':truename))) - (if name name ,x))) -) - -(DEFMFUN $TRANSLATE_FILE (&OPTIONAL (INPUT-FILE-NAME NIL I-P) - (OUTPUT-FILE-NAME NIL O-P)) - (OR I-P TR-DEFAULTF - (MERROR "Arguments are input file and optional output file~ - ~%which defaults to second name LISP, msgs are put~ - ~%in file with second file name UNLISP")) - (COND (I-P - (SETQ INPUT-FILE-NAME (MERGEF ($FILENAME_MERGE INPUT-FILE-NAME) - (trlisp-inputname-d1))) - (SETQ TR-DEFAULTF INPUT-FILE-NAME)) - (T - (SETQ TR-DEFAULTF INPUT-FILE-NAME))) - (SETQ OUTPUT-FILE-NAME - (IF O-P - (MERGEF ($FILENAME_MERGE OUTPUT-FILE-NAME) INPUT-FILE-NAME) - (MERGEF (TRLISP-OUTPUTNAME-D1) INPUT-FILE-NAME))) - (TRANSLATE-FILE INPUT-FILE-NAME - OUTPUT-FILE-NAME - $TR_FILE_TTY_MESSAGESP)) - - -(DEFMVAR $TR_GEN_TAGS NIL - "If TRUE, TRANSLATE_FILE generates a TAGS file for - use by the text editor") - -(DEFVAR TRF-START-HOOK NIL) - -#-LispM -(DEFUN DELETE-OLD-AND-OPEN (X) - (IF (LET ((F (PROBEF X))) - (AND F (NOT (MEMQ (CADDR (NAMELIST #-Franz F #+Franz X)) '(< >))))) - (DELETEF X)) - (OPEN-OUT-DSK X)) - -#+LispM -(DEFUN DELETE-OLD-AND-OPEN (X) - (LET* ((F (PROBEF X)) - (VER (IF F (SEND F ':VERSION)))) - (if (OR (NUMBERP VER) - (EQ VER ':UNSPECIFIC)) - (DELETEF X))) - (OPEN-OUT-DSK X)) - -(DEFUN TRANSLATE-FILE (IN-FILE-NAME OUT-FILE-NAME TTYMSGSP) - (BIND-TRANSL-STATE - (SETQ *IN-TRANSLATE-FILE* T) - (LET ((IN-FILE) - (*TRANSLATION-MSGS-FILES*) - (DSK-MSGS-FILE) - (TAGS-OUTPUT-STREAM) - (TAGS-OUTPUT-STREAM-STATE) - (WINP NIL) - (TYO (IF (BOUNDP 'TYO) TYO T)) - (TRUE-IN-FILE-NAME)) - (UNWIND-PROTECT - (PROGN - (SETQ IN-FILE (OPEN-in-dsk IN-FILE-NAME) - TRUE-IN-FILE-NAME (TO-MACSYMA-NAMESTRING (TRUENAME IN-FILE)) - $TR_TRUE_NAME_OF_FILE_BEING_TRANSLATED TRUE-IN-FILE-NAME - TRANSL-FILE (DELETE-OLD-AND-OPEN - (MAKE-TRANSL-FILE-TEMP-NAME OUT-FILE-NAME)) - DSK-MSGS-FILE (DELETE-OLD-AND-OPEN - (MAKE-MSGS-FILE-TEMP-NAME OUT-FILE-NAME)) - *TRANSLATION-MSGS-FILES* (LIST DSK-MSGS-FILE)) - (IF $TR_GEN_TAGS - (SETQ TAGS-OUTPUT-STREAM - (OPEN-out-dsk (MERGEF (trtags-outputname-temp) - IN-FILE-NAME)))) - (IF TTYMSGSP - (SETQ *TRANSLATION-MSGS-FILES* - (CONS TYO *TRANSLATION-MSGS-FILES*))) - (PROGN (CLOSE IN-FILE) - ;; IN-FILE stream of no use with old-io BATCH1. - (SETQ IN-FILE NIL)) - (MFORMAT DSK-MSGS-FILE "~%This is the UNLISP file for ~A.~%" - TRUE-IN-FILE-NAME) - (MFORMAT TERMINAL-IO "~%Translation begun on ~A.~%" - TRUE-IN-FILE-NAME) - (IF TRF-START-HOOK (FUNCALL TRF-START-HOOK TRUE-IN-FILE-NAME)) - (IF TAGS-OUTPUT-STREAM (TAGS-START//END IN-FILE-NAME)) - #-MAXII(CALL-BATCH1 TRUE-IN-FILE-NAME (NOT *TRANSL-FILE-DEBUG*)) - #+MAXII(READ-AND-TRANSLATE TRUE-IN-FILE-NAME (NOT *TRANSL-FILE-DEBUG*)) - ;; BATCH1 calls TRANSLATE-MACEXPR on each expression read. - (MFORMAT DSK-MSGS-FILE - "~%//* Variable settings were *//~%~%") - (DO ((L (CDR $TR_STATE_VARS) (CDR L))) - ((NULL L)) - (MFORMAT-OPEN DSK-MSGS-FILE - "~:M:~:M;~%" - (CAR L) (SYMEVAL (CAR L)))) - (RENAME-TF OUT-FILE-NAME TRUE-IN-FILE-NAME) - (WHEN TAGS-OUTPUT-STREAM - (TAGS-START//END) - ;;(CLOSE TAGS-OUTPUT-STREAM) - (RENAMEF TAGS-OUTPUT-STREAM (trtags-outputname))) - ;;(CLOSE DSK-MSGS-FILE) - ;; The CLOSE before RENAMEF clobbers the old temp file. - ;; nope. you get a FILE-ALREADY-EXISTS error. darn. - (let ((TR-COMMENT-FILE-NAME (MAKE-MSGS-FILE-NAME OUT-FILE-NAME))) - (if (probef tr-comment-file-name) - (deletef tr-comment-file-name)) - #+LispM - (close dsk-msgs-file) - (RENAMEF DSK-MSGS-FILE tr-comment-file-name) - (SETQ WINP T) - `((MLIST) ,(TO-MACSYMA-NAMESTRING TRUE-IN-FILE-NAME) - ,(TO-MACSYMA-NAMESTRING OUT-FILE-NAME) - ,(TO-MACSYMA-NAMESTRING (TRUENAME tr-comment-file-name)) - ,@(IF TAGS-OUTPUT-STREAM - (LIST (TO-MACSYMA-NAMESTRING - (TRUENAME TAGS-OUTPUT-STREAM))) - NIL)))) - ;; Unwind protected. - (IF DSK-MSGS-FILE (CLOSE DSK-MSGS-FILE)) - (IF TRANSL-FILE (CLOSE TRANSL-FILE)) - (IF TAGS-OUTPUT-STREAM (CLOSE TAGS-OUTPUT-STREAM)) - (WHEN (AND (NOT WINP) (NOT *TRANSL-FILE-DEBUG*)) - (IF TAGS-OUTPUT-STREAM (DELETEF TAGS-OUTPUT-STREAM)) - (IF TRANSL-FILE (DELETEF TRANSL-FILE))))))) - -#-LispM -(defun make-transl-file-temp-name (out-file-name) - (MERGEF out-file-name (trlisp-outputname-temp))) - -#+LispM -(defun make-transl-file-temp-name (out-file-name) - (send (fs:parse-pathname out-file-name) ':new-raw-name (send (trlisp-outputname-temp) - ':raw-name))) - -#-LispM -(defun make-msgs-file-name (out-file-name) - (mergef (trcomments-outputname) out-file-name)) - - -#+LispM -(defun make-msgs-file-name (out-file-name) - (send (fs:parse-pathname out-file-name) ':new-raw-name (send (trcomments-outputname) - ':raw-name))) - -#-LispM -(defun make-msgs-file-temp-name (out-file-name) - (MERGEF out-file-name (trcomments-outputname-temp))) - -#+LispM -(defun make-msgs-file-temp-name (out-file-name) - (send (fs:parse-pathname out-file-name) ':new-raw-name (send (trcomments-outputname-temp) - ':raw-name))) - - -#+LispM -(DEFUN READ-AND-TRANSLATE (FILENAME SILENT-P) - (LET ((EOF (LIST NIL)) - (NAME ($FILENAME_MERGE FILENAME)) - (*MREAD-PROMPT* "(Translating) ")) - (TRUEFNAME NAME) - (IF $LOADPRINT (MTELL "~%Translating the file ~M~%" NAME)) - (WITH-OPEN-FILE (STREAM NAME '(:IN :ASCII)) - (DO ((FORM NIL (MREAD STREAM EOF))) - ((EQ FORM EOF) - (IF $LOADPRINT (MTELL "Translation done.~%")) - '$DONE) - (TRANSLATE-MACEXPR-ACTUAL (CADDR FORM) 0.))))) - -;; Should be rewritten to use streams. Barf -- perhaps SPRINTER doesn't take -;; a stream argument? Yes Carl SPRINTER is old i/o, but KMP is writing -;; a new one for NIL. -GJC - -(DEFUN PRINT* (P) - (LET ((^W T) - (OUTFILES (LIST TRANSL-FILE)) - (^R T) - (*NOPOINT NIL) - ($LOADPRINT NIL)) ;;; lusing old I/O !!!!! - (SUB-PRINT* P))) - -;;; i might as well be real pretty and flatten out PROGN's. - -(DEFUN SUB-PRINT* (P &AUX (FLAG NIL)) - (COND ((ATOM P)) - ((AND (EQ (CAR P) 'PROGN) (CDR P) (EQUAL (CADR P) ''COMPILE)) - (MAPC #'SUB-PRINT* (CDDR P))) - (T - (SETQ FLAG (AND $TR_SEMICOMPILE - (NOT (MEMQ (CAR P) '(EVAL-WHEN INCLUDEF))))) - (WHEN FLAG (PRINC* '|(PROGN|) (TERPRI*)) - (COND ($COMPGRIND - (SPRIN1 P)) - (T - (PRIN1 P TRANSL-FILE))) - (WHEN FLAG (PRINC* '|)|)) - (TERPRI TRANSL-FILE)))) - -(DEFUN PRINC* (FORM) (PRINC FORM TRANSL-FILE)) - -(DEFUN NPRINC* (&REST FORM) - (MAPC #'(LAMBDA (X) (PRINC X TRANSL-FILE)) FORM)) - -(DEFUN TERPRI* () (TERPRI TRANSL-FILE)) - -(DEFUN PRINT-MODULE (M) - (NPRINC* " " M " version " (GET M 'VERSION))) - -(DEFUN NEW-COMMENT-LINE () - (TERPRI*) - (PRINC* ";;;")) - -(defun print-TRANSL-MODULEs () - (NEW-COMMENT-LINE) - (PRINT-MODULE 'TRANSL-AUTOLOAD) - (DO ((J 0 (1+ J)) - (S (DELETE 'TRANSL-AUTOLOAD (APPEND TRANSL-MODULES NIL)) - (CDR S))) - ((NULL S)) - (IF (= 0 (\ J 3)) (NEW-COMMENT-LINE)) - (PRINT-MODULE (CAR S)))) - - -(DEFUN PRINT-TRANSL-HEADER (SOURCE) - (MFORMAT TRANSL-FILE - ";;; -*- Mode: Lisp; Package: Macsyma -*-~%") - (IF SOURCE - (MFORMAT TRANSL-FILE ";;; Translated code for ~A" (name-for-printing SOURCE)) - (MFORMAT TRANSL-FILE - ";;; Translated MACSYMA functions generated by COMPFILE.")) - (MFORMAT TRANSL-FILE - "~%;;; Written on ~:M, from MACSYMA ~A~ - ~%;;; Translated for ~A~%" - ($TIMEDATE) $VERSION (sys-user-id)) - (print-TRANSL-MODULEs) - (MFORMAT TRANSL-FILE - ;; The INCLUDEF must be in lower case for transportation - ;; of translated code to Multics. - "~%~ - ~%(includef (cond ((status feature ITS) '|DSK:LIBMAX;TPRELU >|)~ - ~% ((status feature Multics) '|translate|)~ - ~% ((status feature Unix) '|libmax//tprelu.l|)~ - ~% (t (error '|Unknown system, see GJC@MIT-MC|))))~ - ~%~ - ~%(eval-when (compile eval)~ - ~% (or (status feature lispm)~ - ~% (setq *infile-name-key*~ - ~% ((lambda (file-name)~ - ~% ;; temp crock for multics.~ - ~% (cond ((eq (typep file-name) 'list)~ - ~% (namestring file-name))~ - ~% (t file-name)))~ - ~% (truename infile)))))~ - ~%~ - ~%(eval-when (compile)~ - ~% (setq $tr_semicompile '~S)~ - ~% (setq forms-to-compile-queue ()))~ - ~%~%(comment ~S)~%~%" - $tr_semicompile (name-for-printing source)) - (COND ($TRANSCOMPILE - (UPDATE-GLOBAL-DECLARES) - (IF $COMPGRIND - (MFORMAT - TRANSL-FILE - ";;; General declarations required for translated MACSYMA code.~%")) - (PRINT* `(DECLARE . ,DECLARES)))) - -) - -#-LispM -(defmacro name-for-printing (file) - `',file) - -#+LispM -(defmacro name-for-printing (file) - `(send ,file ':string-for-printing)) - -(DEFUN PRINT-ABORT-MSG (FUN FROM) - (MFORMAT *TRANSLATION-MSGS-FILES* - "~:@M failed to Translate.~ - ~%~A will continue, but file output will be aborted." - FUN FROM)) - -(defmacro extension-filename (x) `(caddr (namelist ,x))) - -(DEFUN RENAME-TF (NEW-NAME TRUE-IN-FILE-NAME) - ;; copy the TRANSL-FILE to the file of the new name. - (let ((IN-FILE)) - (UNWIND-PROTECT - (PROGN - (close transl-file) - (SETQ IN-FILE (OPEN-in-dsk (truename TRANSL-FILE))) - (SETQ TRANSL-FILE - (OPEN-out-dsk (TRUENAME NEW-NAME))) - (PRINT-TRANSL-HEADER TRUE-IN-FILE-NAME) - (MAPC #'PRINT* (NREVERSE *PRE-TRANSL-FORMS*)) ; clever eh? - (terpri*) - (PUMP-STREAM IN-FILE TRANSL-FILE) - (MFORMAT TRANSL-FILE "~%(compile-forms-to-compile-queue)~%~%") - (DELETEF IN-FILE)) - ;; if something lost... - (IF IN-FILE (CLOSE IN-FILE)) - (IF TRANSL-FILE (CLOSE TRANSL-FILE))))) - - -(DEFUN PUMP-STREAM (IN OUT &optional (n #.(lsh -1 -1))) - (declare (fixnum n)) - (DO ((C)) - ((ZEROP N)) - (DECLARE (FIXNUM C)) - (SETQ C #+ITS (+TYI IN) #-ITS (+TYI IN -1)) - (IF (= C -1) (RETURN NIL)) - (+TYO C OUT) - (SETQ N (1- N)))) - - - -(DEFMSPEC $TRANSLATE (FUNCTS) (SETQ FUNCTS (CDR FUNCTS)) - (COND ((AND FUNCTS ($LISTP (CAR FUNCTS))) - (MERROR "Use the function TRANSLATE_FILE")) - (T - (COND ((OR (MEMQ '$FUNCTIONS FUNCTS) - (MEMQ '$ALL FUNCTS)) - (SETQ FUNCTS (MAPCAR 'CAAR (CDR $FUNCTIONS))))) - (DO ((L FUNCTS (CDR L)) - (V NIL)) - ((NULL L) `((MLIST) ,@(NREVERSE V))) - (COND ((ATOM (CAR L)) - (LET ((IT (TRANSLATE-FUNCTION ($VERBIFY (CAR L))))) - (IF IT (PUSH IT V)))) - (T - (TR-TELL - (CAR L) - " is an illegal argument to TRANSLATE."))))))) - -#+LISPM -(PROGN 'COMPILE -(DECLARE (SPECIAL forms-to-compile-queue)) -(DEFMSPEC $COMPILE (FORM) - (LET ((L (MEVAL `(($TRANSLATE),@(CDR FORM))))) - (LET ((forms-to-compile-queue ())) - (MAPC #'(LAMBDA (X) (IF (FBOUNDP X) (COMPILE X))) (CDR L)) - (DO () - ((NULL FORMS-TO-COMPILE-QUEUE) L) - (MAPC #'(LAMBDA (FORM) - (EVAL FORM) - (AND (LISTP FORM) - (EQ (CAR FORM) 'DEFUN) - (SYMBOLP (CADR FORM)) - (COMPILE (CADR FORM)))) - (PROG1 FORMS-TO-COMPILE-QUEUE - (SETQ FORMS-TO-COMPILE-QUEUE NIL))))))) -)