From b45338f482dc93f5f2ced44430e80f0a21b9b050 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Mon, 24 Mar 2025 00:01:01 -0700 Subject: [PATCH 1/4] New lispusers CHARCODEUTILS implements CHARCODE.ENCODE, the inverse of standard FNS: CHARCODE.DECODE (and CHARCODE). One argument, the 16-bit character integer. Returns the name (string) as could be given to CHARCODE. E.g. (CHARCODE "FUNCTION,#^Q") == 657. So (CHARCODE.ENCODE 657) == "Function,#^Q" (CHARCODE "#^GREEK,A") == 9857. So (CHARCODE.ENCODE 9857) == "Greek,^A" --- lispusers/CHARCODEUTILS | 111 ++++++++++++++++++++++++++++++++++ lispusers/CHARCODEUTILS.DFASL | Bin 0 -> 3586 bytes 2 files changed, 111 insertions(+) create mode 100644 lispusers/CHARCODEUTILS create mode 100644 lispusers/CHARCODEUTILS.DFASL diff --git a/lispusers/CHARCODEUTILS b/lispusers/CHARCODEUTILS new file mode 100644 index 000000000..4739de6d8 --- /dev/null +++ b/lispusers/CHARCODEUTILS @@ -0,0 +1,111 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "23-Mar-2025 23:50:49" {DSK}matt>Interlisp>medley>lispusers>CHARCODEUTILS.;3 5314 + + :EDIT-BY "mth" + + :CHANGES-TO (FUNCTIONS CHARCODE.ENCODE) + + :PREVIOUS-DATE "23-Mar-2025 22:25:54" +{DSK}matt>Interlisp>medley>lispusers>CHARCODEUTILS.;2) + + +(PRETTYCOMPRINT CHARCODEUTILSCOMS) + +(RPAQQ CHARCODEUTILSCOMS ((VARIABLES CHARCODE.CTRLBITS CHARCODE.CTRLMASK CHARCODE.HASHMASK + CHARCODE.UNCTRLBIT FUNCTION.CSET META.CSET) + (FUNCTIONS CHARCODE.ENCODE) + (PROP (FILETYPE MAKEFILE-ENVIRONMENT) + CHARCODEUTILS))) + +(CL:DEFCONSTANT CHARCODE.CTRLBITS (MASK.1'S 0 5) + "Mask corresponding to bits covering control characters") + +(CL:DEFCONSTANT CHARCODE.CTRLMASK (BITCLEAR 255 (LOGOR CHARCODE.CTRLBITS CHARCODE.HASHMASK)) + + "Mask corresponding to bits that aren't in hash or control characters") + +(CL:DEFCONSTANT CHARCODE.HASHMASK (MASK.1'S 7 1) + "Mask corresponding to bit added by # in CHARCODE") + +(CL:DEFCONSTANT CHARCODE.UNCTRLBIT (MASK.1'S 6 1) + + "The bit to set to map control char to corresponding non-control character") + +(CL:DEFCONSTANT FUNCTION.CSET (CADR (CL:ASSOC "Function" (GETTOPVAL 'CHARACTERSETNAMES) + :TEST + #'STRING-EQUAL)) + "The characterset for Function") + +(CL:DEFCONSTANT META.CSET (CADR (CL:ASSOC "Meta" (GETTOPVAL 'CHARACTERSETNAMES) + :TEST + #'STRING-EQUAL)) + "The characterset for Meta") + +(CL:DEFUN CHARCODE.ENCODE (C) (* ; "Edited 23-Mar-2025 23:49 by mth") + (DECLARE (GLOBALVARS CHARACTERNAMES CHARACTERSETNAMES)) + (CL:BLOCK NIL + (CL:UNLESS (SMALLP C) + (RETURN NIL)) + [LET ((CSET (LRSH C 8)) + (CC (LOGAND C 255)) + CTRL HASH CNAME TEMP) + (CL:WHEN [SETQ CNAME (CAR (CL:RASSOC C CHARACTERNAMES :KEY #'CAR] + + (* ;; "An exact character match, return that name") + + (RETURN (MKSTRING CNAME))) + (CL:FLET ((CTRLP (CX) + (NOT (BITTEST CX CHARCODE.CTRLMASK))) + (HASHP (CX) + (BITTEST CX CHARCODE.HASHMASK)) + (HASHMASK.KEY.FN (ITEM) + (BITSET (CAR ITEM) + CHARCODE.HASHMASK))) + (SETQ CTRL (AND (CTRLP CC) + "^")) + (SETQ HASH (AND (HASHP CC) + "#")) + (CL:WHEN [AND HASH (SETQ TEMP (CL:RASSOC C CHARACTERNAMES :KEY #'HASHMASK.KEY.FN)) + (NOT (HASHP (CADR TEMP] + (RETURN (CONCAT (OR HASH "") + (OR CTRL "") + (CAR TEMP)))) + [COND + [(SETQ CNAME (CAR (CL:RASSOC CC CHARACTERNAMES :KEY #'CAR] + ([AND HASH (SETQ TEMP (CL:RASSOC CC CHARACTERNAMES :KEY #'HASHMASK.KEY.FN)) + (NOT (HASHP (CADR TEMP] + (CL:WHEN (EQ CSET (LRSH (CADR TEMP) + 8)) + (SETQ CSET 0)) + (SETQ CNAME (CAR TEMP))) + (T (SETQ CNAME (COND + ((EQ CC 255) + (CONSTANT (OCTALSTRING 255))) + (CTRL (CHARACTER (BITSET (LOGAND CC CHARCODE.CTRLBITS) + CHARCODE.UNCTRLBIT))) + (HASH (CHARACTER (BITCLEAR CC CHARCODE.HASHMASK))) + ((AND (CL:PLUSP CSET) + (NEQ CSET META.CSET) + (NEQ CSET FUNCTION.CSET)) + (OCTALSTRING CC)) + (T (CHARACTER CC] + [SETQ CSET (COND + ((ZEROP CSET) + NIL) + [(CAR (CL:RASSOC CSET CHARACTERSETNAMES :KEY #'CAR] + (CSET (OCTALSTRING CSET] + (CL:WHEN CSET + (SETQ CSET (CONCAT CSET ","))) + (RETURN (CONCAT (OR CSET "") + (OR HASH "") + (OR CTRL "") + CNAME])) + +(PUTPROPS CHARCODEUTILS FILETYPE :COMPILE-FILE) + +(PUTPROPS CHARCODEUTILS MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP")) +(PUTPROPS CHARCODEUTILS COPYRIGHT (NONE)) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (1960 5091 (CHARCODE.ENCODE 1960 . 5091))))) +STOP diff --git a/lispusers/CHARCODEUTILS.DFASL b/lispusers/CHARCODEUTILS.DFASL new file mode 100644 index 0000000000000000000000000000000000000000..5e60e4c9799d5442c0ef7b6f389df8708192347f GIT binary patch literal 3586 zcmcIn&2Jmm5#J?gQnciVG8|hU6uge>1V~KTmg>538ddA%%3O0l81BlE+C&vCt-N$7 zk|wDHMiNvt+yX@wsA<*8PFkbwDVHK}93XHK2L^J=DTks!FFh1Uj9!iQ4^U>_@=F#K z7)Yyw=FPl$^X4}n`-XL{XI4@LskBng7wn2qTCJ5=Yr=A=B2-JOl|@@vM!E22(oDbo z6Q{IdPp;%@wMnH|vnz#swLH0EFBR-7leAu~+Lh|0loGR&k(6gFMK#A>nAmN0*jcRD zxthHsj87!ATqQAneEcM?PoF$~`iIZ&o)%5jzpklft`?VaSB|2Jfa;5mKnI9zoY=hO zZ3GUNIQ+ZV`qxXVfdQV0qr}9x0Po#&pO{uuS<1?yB_~xw3UJ=<+}N|GCF)5rn@lKr zX2yEfb7LojTB)2U*st3K3dBkPO?cPcp6MA~vJ^x2*7>!-C>o3<@8&%>{HDHID7?)fbnZ|aHABmw-)GAMK5)++7=Hv#m3AOVDEJtnh@g*|tdR+h zATzKfeUhP>VU$J*VG`qJQXKbe(FyGL*3npm)Xs}pg?u+VEsaT5Rz0Iw+l88FrnhLO zL^IV8?rmN&Mp0)5=;~$;#w1g==t@ntM4wp?5Z_dw+xlBJWSvTq9KGp=2&~7ndkB{` zmyuDtPZQIaPRyjNpI5SmuF1Lu`+G4?-tPmRyRTc#-gIC19<9N0c#`GN*-crwUpUC} z=BJR=?)`2lj&YtVNa|^-v9R)8XN_5uX_}!Ys76Ca=u|V&0u1)UAP<89Y@8oyx$0}eVyRNG ztL0L0DPO#Zr6*j-*QzLe-L8;eu~e*8N(Euj$yIWT_!X%>Nx8V;_B1c1d&B0OX~`N4 zb_vnK|0YCKXPqH}v0*qCf$`80m=Iv7ABK1sB3Q}qfK_vHH6d5Ai_g@Ad{J<6RY$;2 zXLpcr3WmDiS^NHYntih~p5cBN=3$ud9N!U-kXu^9kMo5q!eK(wtSCwl`aayn_o>JB z{m@S3+G_8eoge9k5gta!dBt*UswgU~s?EqsuDm7Sw6(Pei=|>>TS^+JMi{Eu&L(WX zC#(b84anF&@-x6cHt_f(z?&Z^_R(r%4rgKPML6~xcGoV^G!5x#T=koC+8IMlG|wEs zK8~K1Ez8K97ga3QND3w-h>t`35UTf?R#wr^Cghi9L^Y1DNeI8#)?R9U%B3jbJA*B* ziyD5&As*B`ca-AU?nR6!J^j2_RQ$1@`S>0WU%!Uz{~fQvN8;7`z;BNgq@M=$ z0BEg1jE=+TA<*Ms?1c;uql9p%D?-h#A!adQ_P`< zb;oV3uIAUA4TUNF+9&r?mmbd7^>KKQdwAI90(CiEgOC4Rd;!5FXj3xY>+U%K9Xn=`&XDJato!shGdDV-&G{L zj!hQMvi2nQ9Z-psQ8V(&^w03A%n(11e6-bYBzYNrL1Y{*5IMpK_itE0j{CwVpEFzB z`!N3oESy9OJzCno_$Vwq18P5={0-h8l*BBpe}(-WOv`h$ehb*e3dD)~DU2fF{sA_T zzoD%sTHdhUC-GfaBJz>1^Z_hi1p5LkKLtypU=PA_6nFVAJ(qRE{RaKGLEp#N9VLY) zJvTUU>J(Y}v%kl^i}YpOKa3MBKOdm2f1(R9oFOtaMJ6QGFlVxI0m@;xOxyp#p6k0b zRakp~6%)(TaI=eEv<&X?G%7bvP|hfA0cjR@IREg!@Ni^`FRXn-=lYv3;TT3{Y+5G^ zP;DLzDL7NKk6wj0;Bpz>g3AW2UTnCrfNtbt4s(NMDdtAoNaJ=Izn@~|$4a+zVrxsu z#=ykR^LH>#iEhl_<^WJMu7!QV1rOl73j0wbDjAu%ta3JG5fYqWbwii?*e?9QTMt2R f=dTEec5)apGy;b)j(v?3u-_}(dvw|L&CPECv{Bg; literal 0 HcmV?d00001 From e3be9c1e87eac84f1a90e56e695440c20b54ad5b Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Tue, 25 Mar 2025 15:53:25 -0700 Subject: [PATCH 2/4] Handle recursion in the CHARACTERNAMES alist. Allow (CL:CHARACTERP x) as well as SMALLP arguments. Cleanup handling of char=255 in any character set. --- lispusers/CHARCODEUTILS | 103 ++++++++++++++++++---------------- lispusers/CHARCODEUTILS.DFASL | Bin 3586 -> 3747 bytes 2 files changed, 56 insertions(+), 47 deletions(-) diff --git a/lispusers/CHARCODEUTILS b/lispusers/CHARCODEUTILS index 4739de6d8..05d6f0ce6 100644 --- a/lispusers/CHARCODEUTILS +++ b/lispusers/CHARCODEUTILS @@ -1,13 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "23-Mar-2025 23:50:49" {DSK}matt>Interlisp>medley>lispusers>CHARCODEUTILS.;3 5314 +(FILECREATED "25-Mar-2025 15:46:46" {DSK}matt>Interlisp>medley>lispusers>CHARCODEUTILS.;4 6141 :EDIT-BY "mth" :CHANGES-TO (FUNCTIONS CHARCODE.ENCODE) - :PREVIOUS-DATE "23-Mar-2025 22:25:54" -{DSK}matt>Interlisp>medley>lispusers>CHARCODEUTILS.;2) + :PREVIOUS-DATE "23-Mar-2025 23:50:49" +{DSK}matt>Interlisp>medley>lispusers>CHARCODEUTILS.;3) (PRETTYCOMPRINT CHARCODEUTILSCOMS) @@ -42,58 +42,67 @@ #'STRING-EQUAL)) "The characterset for Meta") -(CL:DEFUN CHARCODE.ENCODE (C) (* ; "Edited 23-Mar-2025 23:49 by mth") +(CL:DEFUN CHARCODE.ENCODE (C) (* ; "Edited 25-Mar-2025 15:31 by mth") + (* ; "Edited 23-Mar-2025 23:49 by mth") (DECLARE (GLOBALVARS CHARACTERNAMES CHARACTERSETNAMES)) (CL:BLOCK NIL - (CL:UNLESS (SMALLP C) + (CL:UNLESS [OR (SMALLP C) + (AND (CL:CHARACTERP C) + (SETQ C (CL:CHAR-CODE C] (RETURN NIL)) [LET ((CSET (LRSH C 8)) (CC (LOGAND C 255)) CTRL HASH CNAME TEMP) - (CL:WHEN [SETQ CNAME (CAR (CL:RASSOC C CHARACTERNAMES :KEY #'CAR] - - (* ;; "An exact character match, return that name") - - (RETURN (MKSTRING CNAME))) - (CL:FLET ((CTRLP (CX) - (NOT (BITTEST CX CHARCODE.CTRLMASK))) - (HASHP (CX) - (BITTEST CX CHARCODE.HASHMASK)) - (HASHMASK.KEY.FN (ITEM) - (BITSET (CAR ITEM) - CHARCODE.HASHMASK))) - (SETQ CTRL (AND (CTRLP CC) - "^")) - (SETQ HASH (AND (HASHP CC) - "#")) - (CL:WHEN [AND HASH (SETQ TEMP (CL:RASSOC C CHARACTERNAMES :KEY #'HASHMASK.KEY.FN)) - (NOT (HASHP (CADR TEMP] - (RETURN (CONCAT (OR HASH "") - (OR CTRL "") - (CAR TEMP)))) - [COND - [(SETQ CNAME (CAR (CL:RASSOC CC CHARACTERNAMES :KEY #'CAR] - ([AND HASH (SETQ TEMP (CL:RASSOC CC CHARACTERNAMES :KEY #'HASHMASK.KEY.FN)) - (NOT (HASHP (CADR TEMP] - (CL:WHEN (EQ CSET (LRSH (CADR TEMP) - 8)) - (SETQ CSET 0)) - (SETQ CNAME (CAR TEMP))) - (T (SETQ CNAME (COND - ((EQ CC 255) - (CONSTANT (OCTALSTRING 255))) - (CTRL (CHARACTER (BITSET (LOGAND CC CHARCODE.CTRLBITS) - CHARCODE.UNCTRLBIT))) - (HASH (CHARACTER (BITCLEAR CC CHARCODE.HASHMASK))) - ((AND (CL:PLUSP CSET) - (NEQ CSET META.CSET) - (NEQ CSET FUNCTION.CSET)) - (OCTALSTRING CC)) - (T (CHARACTER CC] + (CL:LABELS ((CTRLP (CX) + (NOT (BITTEST CX CHARCODE.CTRLMASK))) + (HASHP (CX) + (BITTEST CX CHARCODE.HASHMASK)) + (KEY.FN (ITEM &AUX (CITEM (CAR ITEM))) + (OR (SMALLP CITEM) + (CHARCODE.DECODE CITEM NIL))) + (HASHMASK.KEY.FN (ITEM) + (BITSET (KEY.FN ITEM) + CHARCODE.HASHMASK))) + [if (EQ CC 255) + then (SETQ CNAME (CONSTANT (OCTALSTRING 255))) + else (CL:WHEN [SETQ CNAME (CAR (CL:RASSOC C CHARACTERNAMES :KEY #'KEY.FN] + + (* ;; "An exact character match, return that name") + + (RETURN (MKSTRING CNAME))) + (SETQ CTRL (AND (CTRLP CC) + "^")) + (SETQ HASH (AND (HASHP CC) + "#")) + (CL:WHEN [AND HASH (SETQ TEMP (CL:RASSOC C CHARACTERNAMES :KEY + #'HASHMASK.KEY.FN)) + (NOT (HASHP (CADR TEMP] + (RETURN (CONCAT (OR HASH "") + (OR CTRL "") + (CAR TEMP)))) + (COND + [(SETQ CNAME (CAR (CL:RASSOC CC CHARACTERNAMES :KEY #'KEY.FN] + ([AND HASH (SETQ TEMP (CL:RASSOC CC CHARACTERNAMES :KEY + #'HASHMASK.KEY.FN)) + (NOT (HASHP (CADR TEMP] + (CL:WHEN (EQ CSET (LRSH (CADR TEMP) + 8)) + (SETQ CSET 0)) + (SETQ CNAME (CAR TEMP))) + (T (SETQ CNAME (COND + ((AND (CL:PLUSP CSET) + (NEQ CSET META.CSET) + (NEQ CSET FUNCTION.CSET)) + (SETQ HASH NIL CTRL NIL) + (OCTALSTRING CC)) + (CTRL (CHARACTER (BITSET (LOGAND CC CHARCODE.CTRLBITS) + CHARCODE.UNCTRLBIT))) + (HASH (CHARACTER (BITCLEAR CC CHARCODE.HASHMASK))) + (T (CHARACTER CC] [SETQ CSET (COND ((ZEROP CSET) NIL) - [(CAR (CL:RASSOC CSET CHARACTERSETNAMES :KEY #'CAR] + [(CAR (CL:RASSOC CSET CHARACTERSETNAMES :KEY #'KEY.FN] (CSET (OCTALSTRING CSET] (CL:WHEN CSET (SETQ CSET (CONCAT CSET ","))) @@ -107,5 +116,5 @@ (PUTPROPS CHARCODEUTILS MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP")) (PUTPROPS CHARCODEUTILS COPYRIGHT (NONE)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1960 5091 (CHARCODE.ENCODE 1960 . 5091))))) + (FILEMAP (NIL (1960 5918 (CHARCODE.ENCODE 1960 . 5918))))) STOP diff --git a/lispusers/CHARCODEUTILS.DFASL b/lispusers/CHARCODEUTILS.DFASL index 5e60e4c9799d5442c0ef7b6f389df8708192347f..aae01b0097938dddc21aff3c5d5eb00db09af15c 100644 GIT binary patch delta 936 zcmZuvQAiVE9KYMz^ya1m%b+$|*i&p$rb$I~*X?Yl+s^J5sF-bT7iTV3GZ7=3NfN?A z&JXK8C0``yMR4?DrcWXCR1ei#1W_~S$zFO2*7v`YLD2E>{l4G-|NH%a_rW*qTk+4O zuC}?9+*m%X2Cffh)j&G0rtYYjKx=y_mdb}(PqelNPPU(IJ583WlT)Jq$`WJhXeKog zB>Di+r?mh$f>ldtD`#u`&nR@kex7c7IcZ;Vg#WM(dR|-evu`N!6}741-eN>&oxnZ} znT4X}WxuVn*-H79wxPY&HnlA=TiG>opxG?ZU1)+ij6~)UddPTd=z+oc5>-Sy3`fV& zWtXpciFh_d2GncEx}J&IBjqgn-QxSZv3RpkMmblrEf_&}nL}vRB^Mf|DT@AWEa*;N zit}6o=tn#VuuZCU5})9rNfnW0^lbzk9v-iY2vSqbz6D;I9U(s7si}!?-u&tyn@Xf z3HyKv*bm^u833A?>#N~$E+#0XOno)G)Mu;$Td>$1R=aRUzy-0sv84la7)}?i*}&s=Q0y(=d#1L^vhVLliX58;FLb+xT8cusjXKQ_qf= z?@SA!w{G9Xs?dzAN~xcC-1Jau_?~rG#&D|#)^3OPB(z45+v7h_9aGIy@Hjf->8qV} OnvPkt=uzzpmC9dC0Ux;l delta 772 zcmZvW?@JSL9LMi=x_Ptd$O4OvMiTv+V4ETu(jC{C=QdC7R%*!Fbhj3)+$^y`7!9eQ zgH~VC`vgML1AP#Y31L4h=uwY)AW;xK2ugYy{R8X!*@+Q!e7V>6{rS8<@6Y#Vrp{S2xKngjKKJ$k-B1}1EFwhEH&90Y72GHdv`}$cYBw+SJb2b+VrVQ>D09# zwFIbrJR86Pl=j5Rn+ZqLf0Bs6^{`>GSktt6m%CNF=c7=|E@r*L_cb9`*?f_GnSGUg zon04_B;aZ$SNWUdu&c429ZlR@VIcDCm_ic#UefMvIdVqHResG)F!Xz>^e-s6eVaMq z2Vd1)kq64f;-)QvWZ3O<%qe8v-NGI1vy(r$wc^ea!>}K$`=(P;2P83$@-ZY33$$9V zN^vo&$2Dc(6xPbt9n-0ax~@tnZ$lK3r%u;s?^#(>2T>=e=A}MS6Q#JUVPy!;Awn>Q zI8X)i6Ou(LnRk#xtXIRBB}hy|vV%s{#Ul3RAS4e$v=K*d&o*&sG{TP7Fo?8L-}c8{5-9HRXenf?+EY<;C~@JecIP>ISXTcxO~pVs6Y z@OdW`u>YIz9v|7*(X`7U4O7k7mkb?zjxcb6-T~!M(SprfV*bN@dkq{S1Nx1HW2Ok From f701cdf5f8a00833ac531f0d366bed0c2f538c30 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Tue, 25 Mar 2025 22:38:01 -0700 Subject: [PATCH 3/4] Add support for list argument recursion a la CHARCODE.DECODE. Added optional argument NONCHAR.IDENTITY (default NIL). If the C argument isn't SMALLP or CL:CHARACTERP, return C itself if NONCHAR.IDENTITY is non-null, else NIL. --- lispusers/CHARCODEUTILS | 159 +++++++++++++++++++--------------- lispusers/CHARCODEUTILS.DFASL | Bin 3747 -> 3832 bytes 2 files changed, 89 insertions(+), 70 deletions(-) diff --git a/lispusers/CHARCODEUTILS b/lispusers/CHARCODEUTILS index 05d6f0ce6..ec5c97ff4 100644 --- a/lispusers/CHARCODEUTILS +++ b/lispusers/CHARCODEUTILS @@ -1,13 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Mar-2025 15:46:46" {DSK}matt>Interlisp>medley>lispusers>CHARCODEUTILS.;4 6141 +(FILECREATED "25-Mar-2025 22:34:57" {DSK}matt>Interlisp>medley>lispusers>CHARCODEUTILS.;7 6941 :EDIT-BY "mth" :CHANGES-TO (FUNCTIONS CHARCODE.ENCODE) - :PREVIOUS-DATE "23-Mar-2025 23:50:49" -{DSK}matt>Interlisp>medley>lispusers>CHARCODEUTILS.;3) + :PREVIOUS-DATE "25-Mar-2025 15:46:46" +{DSK}matt>Interlisp>medley>lispusers>CHARCODEUTILS.;4) (PRETTYCOMPRINT CHARCODEUTILSCOMS) @@ -42,79 +42,98 @@ #'STRING-EQUAL)) "The characterset for Meta") -(CL:DEFUN CHARCODE.ENCODE (C) (* ; "Edited 25-Mar-2025 15:31 by mth") +(CL:DEFUN CHARCODE.ENCODE (C &OPTIONAL (NONCHAR.IDENTITY NIL)) + (* ; "Edited 25-Mar-2025 22:34 by mth") (* ; "Edited 23-Mar-2025 23:49 by mth") (DECLARE (GLOBALVARS CHARACTERNAMES CHARACTERSETNAMES)) - (CL:BLOCK NIL - (CL:UNLESS [OR (SMALLP C) - (AND (CL:CHARACTERP C) - (SETQ C (CL:CHAR-CODE C] - (RETURN NIL)) - [LET ((CSET (LRSH C 8)) - (CC (LOGAND C 255)) - CTRL HASH CNAME TEMP) - (CL:LABELS ((CTRLP (CX) - (NOT (BITTEST CX CHARCODE.CTRLMASK))) - (HASHP (CX) - (BITTEST CX CHARCODE.HASHMASK)) - (KEY.FN (ITEM &AUX (CITEM (CAR ITEM))) - (OR (SMALLP CITEM) - (CHARCODE.DECODE CITEM NIL))) - (HASHMASK.KEY.FN (ITEM) - (BITSET (KEY.FN ITEM) - CHARCODE.HASHMASK))) - [if (EQ CC 255) - then (SETQ CNAME (CONSTANT (OCTALSTRING 255))) - else (CL:WHEN [SETQ CNAME (CAR (CL:RASSOC C CHARACTERNAMES :KEY #'KEY.FN] - - (* ;; "An exact character match, return that name") - - (RETURN (MKSTRING CNAME))) - (SETQ CTRL (AND (CTRLP CC) - "^")) - (SETQ HASH (AND (HASHP CC) - "#")) - (CL:WHEN [AND HASH (SETQ TEMP (CL:RASSOC C CHARACTERNAMES :KEY - #'HASHMASK.KEY.FN)) - (NOT (HASHP (CADR TEMP] - (RETURN (CONCAT (OR HASH "") - (OR CTRL "") - (CAR TEMP)))) - (COND - [(SETQ CNAME (CAR (CL:RASSOC CC CHARACTERNAMES :KEY #'KEY.FN] - ([AND HASH (SETQ TEMP (CL:RASSOC CC CHARACTERNAMES :KEY - #'HASHMASK.KEY.FN)) - (NOT (HASHP (CADR TEMP] - (CL:WHEN (EQ CSET (LRSH (CADR TEMP) - 8)) - (SETQ CSET 0)) - (SETQ CNAME (CAR TEMP))) - (T (SETQ CNAME (COND - ((AND (CL:PLUSP CSET) - (NEQ CSET META.CSET) - (NEQ CSET FUNCTION.CSET)) - (SETQ HASH NIL CTRL NIL) - (OCTALSTRING CC)) - (CTRL (CHARACTER (BITSET (LOGAND CC CHARCODE.CTRLBITS) - CHARCODE.UNCTRLBIT))) - (HASH (CHARACTER (BITCLEAR CC CHARCODE.HASHMASK))) - (T (CHARACTER CC] - [SETQ CSET (COND - ((ZEROP CSET) - NIL) - [(CAR (CL:RASSOC CSET CHARACTERSETNAMES :KEY #'KEY.FN] - (CSET (OCTALSTRING CSET] - (CL:WHEN CSET - (SETQ CSET (CONCAT CSET ","))) - (RETURN (CONCAT (OR CSET "") - (OR HASH "") - (OR CTRL "") - CNAME])) + [CL:LABELS ((CTRLP (CX) + (NOT (BITTEST CX CHARCODE.CTRLMASK))) + (HASHP (CX) + (BITTEST CX CHARCODE.HASHMASK)) + (KEY.FN (ITEM &AUX (CITEM (CAR ITEM))) + (OR (SMALLP CITEM) + (CHARCODE.DECODE CITEM NIL))) + (HASHMASK.KEY.FN (ITEM) + (BITSET (KEY.FN ITEM) + CHARCODE.HASHMASK))) + (COND + ((NULL C) + NIL) + ((LISTP C) + (CONS (CHARCODE.ENCODE (CAR C) + NONCHAR.IDENTITY) + (CHARCODE.ENCODE (CDR C) + NONCHAR.IDENTITY))) + ([NOT (OR (SMALLP C) + (AND (CL:CHARACTERP C) + (SETQ C (CL:CHAR-CODE C] + (AND NONCHAR.IDENTITY C)) + (T (PROG ((CSET (LRSH C 8)) + (CC (LOGAND C 255)) + CTRL HASH CNAME TEMP) + [COND + [(EQ CC 255) + + (* ;; + "This is never an allowed character in XCCS. Just give the octalstring.") + + (SETQ CNAME (CONSTANT (OCTALSTRING 255] + ([SETQ CNAME (CAR (CL:RASSOC C CHARACTERNAMES :KEY #'KEY.FN] + + (* ;; "An exact character match, return that name") + + (RETURN (MKSTRING CNAME))) + (T (SETQ CTRL (AND (CTRLP CC) + "^")) + (SETQ HASH (AND (HASHP CC) + "#")) + (CL:WHEN [AND HASH (SETQ TEMP (CL:RASSOC C CHARACTERNAMES :KEY + #'HASHMASK.KEY.FN)) + (NOT (HASHP (CADR TEMP] + (RETURN (CONCAT (OR HASH "") + (OR CTRL "") + (CAR TEMP)))) + (COND + [(SETQ CNAME (CAR (CL:RASSOC CC CHARACTERNAMES :KEY #'KEY.FN] + ([AND HASH (SETQ TEMP (CL:RASSOC CC CHARACTERNAMES :KEY + #'HASHMASK.KEY.FN)) + (NOT (HASHP (CADR TEMP] + (CL:WHEN (EQ CSET (LRSH (CADR TEMP) + 8)) + (SETQ CSET 0)) + (SETQ CNAME (CAR TEMP))) + (T (SETQ CNAME (COND + ((AND (CL:PLUSP CSET) + (NEQ CSET META.CSET) + (NEQ CSET FUNCTION.CSET)) + (SETQ HASH NIL CTRL NIL) + (OCTALSTRING CC)) + (CTRL (CHARACTER (BITSET (LOGAND CC + CHARCODE.CTRLBITS) + CHARCODE.UNCTRLBIT))) + (HASH (CHARACTER (BITCLEAR CC CHARCODE.HASHMASK))) + (T (CHARACTER CC] + [SETQ CSET (COND + ((AND (ZEROP CSET) + (NEQ CC 255)) + + (* ;; + "Can skip cset=0 prefix iff 'char' is not the 'non-char' 255") + + NIL) + [(CAR (CL:RASSOC CSET CHARACTERSETNAMES :KEY #'KEY.FN] + (CSET (OCTALSTRING CSET] + (CL:WHEN CSET + (SETQ CSET (CONCAT CSET ","))) + (RETURN (CONCAT (OR CSET "") + (OR HASH "") + (OR CTRL "") + CNAME]) (PUTPROPS CHARCODEUTILS FILETYPE :COMPILE-FILE) (PUTPROPS CHARCODEUTILS MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP")) (PUTPROPS CHARCODEUTILS COPYRIGHT (NONE)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1960 5918 (CHARCODE.ENCODE 1960 . 5918))))) + (FILEMAP (NIL (1960 6718 (CHARCODE.ENCODE 1960 . 6718))))) STOP diff --git a/lispusers/CHARCODEUTILS.DFASL b/lispusers/CHARCODEUTILS.DFASL index aae01b0097938dddc21aff3c5d5eb00db09af15c..2fbfabf4bdfb73ffd3ebf9e10e3bab834ba5d71e 100644 GIT binary patch delta 803 zcmX|;PiWI%7{}MSCP(A*_b9|nGI``(PprU4Ew)>p|ou1JlHXj z9TsqH5c3|L9u#4$+sTUu6})&5JPbX`E?#6Hf(SalH`$s%e(&=<-}}8^l4qgcq19Y} z+?TmMUoVvS^2}_BFVsu9xl)mj#v-X)Jrcbbjq%aw(BP$^SiHG%-m_m{Zoj$59*DRp za3f6IeA;zvtH~|9hS{*N)@Dx$+-9%9h(1Cufpypy5M0buE3wflyh9%ZH{x@iELPXr z%+A(T?_DNfDYJXK&Fa$3VzpJ>7)Y4Y-V^4w?@B{#3V|xU3Gm&7u)tX+W0{;~Fp~Ai z@SfEsbVXCeq-6wDO_dU2`hqeltGc3Rk1o-Mp!L{rOEeL6Dw&^f6R|_xLz<+E$&8*> z)NAN%)BW6OF_Y0Gl&|QL?i-D<>vCF~Km(}Z#Q~zE%V~64P((a*Fb_FY{g6kvY>@Bv zJn|aycWApOHSWy21^FQGe&Bm>?FVbs;Kt=F)^EWcR)CYJvJD6!`=E@#m+9#oK^0SS zhT7zposwOspnB=3=TMo3auzBBP&@-gFOAqEmO+qihs@u7{-B?80DHeV2Klm2P-zmz zWSJJznq_c<@wkf`%tv~bfTX1+l%zZwk&;?wGA(0p8fw_^$H6+(3Q+Sw9iva?`r%2p zUB*nWKXiP~{+omYY<4JZe|jQDg;sS42+30<3U`pnF&CO;Uk2)3bv17>CA*= zpneWtZ-{+SGZXkgidW2-(8KKQ8VO=Ao(ZjsM6u0G0a1*T9eBj*AA&gy zcV?yn#TceScoSx(dd*C6otY{=Gl>(3K*~SN=wSfS&!O}^D19CnEIJ^)=O6+MN1=2p zP(ryFNW@vs=wUWCH)jQDUkh}yfV01EfTxeEi>|YpkAHAzkSj=rduBe!m}d}b*35kW znfY8Z3qVpEC;#UOWdk!6Cr9zhiWk9RgvmJqsD}ZfjDK<;uci}Rj>R*?)fXl` zSQ*2HnKcl`yqO>i8zCe!NV*mzl|A_{udFEC7`PR|Gs`FI^F?xWvVnDUPM*M*$~^V| Fe*jD6)|mhR From 7bdaeaaac73874e61853741505d3296399f14d18 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Thu, 27 Mar 2025 23:32:20 -0700 Subject: [PATCH 4/4] Rewritten from scratch. Uses names from CHARACTERNAMES where ever it can. Simpler by pre-processing CHARACTERNAMES, which can be done once ahead and passed to multiple calls. Added test function which checks that all 65536 character codes will correctly "round trip" through (CHARCODE.DECODE (CHARCODE.ENCODE cc)). --- lispusers/CHARCODEUTILS | 269 +++++++++++++++++++--------------- lispusers/CHARCODEUTILS.DFASL | Bin 3832 -> 3347 bytes 2 files changed, 154 insertions(+), 115 deletions(-) diff --git a/lispusers/CHARCODEUTILS b/lispusers/CHARCODEUTILS index ec5c97ff4..40a69bc47 100644 --- a/lispusers/CHARCODEUTILS +++ b/lispusers/CHARCODEUTILS @@ -1,139 +1,178 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Mar-2025 22:34:57" {DSK}matt>Interlisp>medley>lispusers>CHARCODEUTILS.;7 6941 +(FILECREATED "27-Mar-2025 23:27:17" {DSK}matt>Interlisp>medley>lispusers>CHARCODEUTILS.;19 10047 :EDIT-BY "mth" - :CHANGES-TO (FUNCTIONS CHARCODE.ENCODE) + :CHANGES-TO (FUNCTIONS \MAKE-CHARCODE.ENCODE-TABLE CHARCODE.ENCODE \TEST.CHARCODE.ENCODE) + (VARS CHARCODEUTILSCOMS) - :PREVIOUS-DATE "25-Mar-2025 15:46:46" -{DSK}matt>Interlisp>medley>lispusers>CHARCODEUTILS.;4) + :PREVIOUS-DATE "27-Mar-2025 22:49:46" +{DSK}matt>Interlisp>medley>lispusers>CHARCODEUTILS.;15) (PRETTYCOMPRINT CHARCODEUTILSCOMS) -(RPAQQ CHARCODEUTILSCOMS ((VARIABLES CHARCODE.CTRLBITS CHARCODE.CTRLMASK CHARCODE.HASHMASK - CHARCODE.UNCTRLBIT FUNCTION.CSET META.CSET) - (FUNCTIONS CHARCODE.ENCODE) +(RPAQQ CHARCODEUTILSCOMS ((FUNCTIONS CHARCODE.ENCODE \MAKE-CHARCODE.ENCODE-TABLE + \TEST.CHARCODE.ENCODE) (PROP (FILETYPE MAKEFILE-ENVIRONMENT) CHARCODEUTILS))) -(CL:DEFCONSTANT CHARCODE.CTRLBITS (MASK.1'S 0 5) - "Mask corresponding to bits covering control characters") - -(CL:DEFCONSTANT CHARCODE.CTRLMASK (BITCLEAR 255 (LOGOR CHARCODE.CTRLBITS CHARCODE.HASHMASK)) - - "Mask corresponding to bits that aren't in hash or control characters") - -(CL:DEFCONSTANT CHARCODE.HASHMASK (MASK.1'S 7 1) - "Mask corresponding to bit added by # in CHARCODE") - -(CL:DEFCONSTANT CHARCODE.UNCTRLBIT (MASK.1'S 6 1) - - "The bit to set to map control char to corresponding non-control character") - -(CL:DEFCONSTANT FUNCTION.CSET (CADR (CL:ASSOC "Function" (GETTOPVAL 'CHARACTERSETNAMES) - :TEST - #'STRING-EQUAL)) - "The characterset for Function") - -(CL:DEFCONSTANT META.CSET (CADR (CL:ASSOC "Meta" (GETTOPVAL 'CHARACTERSETNAMES) - :TEST - #'STRING-EQUAL)) - "The characterset for Meta") - -(CL:DEFUN CHARCODE.ENCODE (C &OPTIONAL (NONCHAR.IDENTITY NIL)) - (* ; "Edited 25-Mar-2025 22:34 by mth") - (* ; "Edited 23-Mar-2025 23:49 by mth") +(CL:DEFUN CHARCODE.ENCODE (CCODE &OPTIONAL (CHNAMES.TABLE NIL) + (NONCHAR.IDENTITY NIL)) (* ; "Edited 27-Mar-2025 23:25 by mth") (DECLARE (GLOBALVARS CHARACTERNAMES CHARACTERSETNAMES)) - [CL:LABELS ((CTRLP (CX) - (NOT (BITTEST CX CHARCODE.CTRLMASK))) - (HASHP (CX) - (BITTEST CX CHARCODE.HASHMASK)) - (KEY.FN (ITEM &AUX (CITEM (CAR ITEM))) - (OR (SMALLP CITEM) - (CHARCODE.DECODE CITEM NIL))) - (HASHMASK.KEY.FN (ITEM) - (BITSET (KEY.FN ITEM) - CHARCODE.HASHMASK))) - (COND - ((NULL C) - NIL) - ((LISTP C) - (CONS (CHARCODE.ENCODE (CAR C) - NONCHAR.IDENTITY) - (CHARCODE.ENCODE (CDR C) - NONCHAR.IDENTITY))) - ([NOT (OR (SMALLP C) - (AND (CL:CHARACTERP C) - (SETQ C (CL:CHAR-CODE C] - (AND NONCHAR.IDENTITY C)) - (T (PROG ((CSET (LRSH C 8)) - (CC (LOGAND C 255)) - CTRL HASH CNAME TEMP) - [COND - [(EQ CC 255) - - (* ;; - "This is never an allowed character in XCCS. Just give the octalstring.") - - (SETQ CNAME (CONSTANT (OCTALSTRING 255] - ([SETQ CNAME (CAR (CL:RASSOC C CHARACTERNAMES :KEY #'KEY.FN] - - (* ;; "An exact character match, return that name") - - (RETURN (MKSTRING CNAME))) - (T (SETQ CTRL (AND (CTRLP CC) + (CL:WHEN CCODE (* ; "Is there anything to do?") + (SETQ CHNAMES.TABLE (OR CHNAMES.TABLE (\MAKE-CHARCODE.ENCODE-TABLE CHARACTERNAMES))) + [COND + ((LISTP CCODE) + (CONS (CHARCODE.ENCODE (CAR CCODE) + CHNAMES.TABLE NONCHAR.IDENTITY) + (CHARCODE.ENCODE (CDR CCODE) + CHNAMES.TABLE NONCHAR.IDENTITY))) + ([NOT (OR (AND (SMALLP CCODE) + (IGEQ CCODE 0)) + (AND (CL:CHARACTERP CCODE) + (SETQ CCODE (CL:CHAR-CODE CCODE] + (AND NONCHAR.IDENTITY CCODE)) + (T (LET [[HASHBIT (CONSTANT (PROGN + (* ;; "The bit set by the # in CHARCODE.DECODE") + + (CL:PARSE-INTEGER "10000000" :RADIX 2] + [CTRLMASK (CONSTANT (PROGN + (* ;; "Mask of bits present if NOT control or #") + + (* ;; + "= Mask of bits cleared by the ^ in CHARCODE.DECODE") + + (CL:PARSE-INTEGER "01100000" :RADIX 2] + (UNCTRLBIT (CONSTANT (PROGN + (* ;; + "Bit to turn on to make char for reporting a control character") + + (CL:PARSE-INTEGER "01000000" :RADIX 2] + (CL:LABELS ((CHCODE (CX) + (LOGAND CX 255)) + (CHARSET (CX) + (LRSH CX 8)) + (CTRLP (CX) + (NOT (BITTEST CX CTRLMASK))) + (HASHP (CX) + (BITTEST CX HASHBIT))) + (PROG* ((CSET (CHARSET CCODE)) + (CC (CHCODE CCODE)) + (CTRL (AND (CTRLP CC) "^")) - (SETQ HASH (AND (HASHP CC) + (HASH (AND (HASHP CC) "#")) - (CL:WHEN [AND HASH (SETQ TEMP (CL:RASSOC C CHARACTERNAMES :KEY - #'HASHMASK.KEY.FN)) - (NOT (HASHP (CADR TEMP] - (RETURN (CONCAT (OR HASH "") + (CSLIST (CDR (ASSOC CSET CHNAMES.TABLE))) + (CS0LIST (CDR (ASSOC 0 CHNAMES.TABLE))) + CNAME TEMP TC) + (CL:UNLESS CS0LIST (CL:ERROR + "No character set 0 entries in the CHNAMES.TABLE" + )) + (CL:WHEN CSLIST + + (* ;; "Exact charset list exists, check there first") + + (SETQ TEMP (COND + ((CL:FIND CCODE CSLIST :KEY #'CL:SECOND)) + [(AND CTRL HASH (CL:FIND CCODE CSLIST :KEY + #'CL:THIRD] + [(AND CTRL (CL:FIND CCODE CSLIST :KEY #'CL:FOURTH] + [(AND HASH (CL:FIND CCODE CSLIST :KEY #'CL:FIFTH] + (T NIL))) + (CL:WHEN TEMP + (CL:WHEN [CTRLP (SETQ TC (CHCODE (CL:SECOND TEMP] + (SETQ CTRL NIL)) + (CL:WHEN (HASHP TC) + (SETQ HASH NIL)) + (SETQ CNAME (CAR TEMP)) + (SETQ CSET 0))) + (CL:UNLESS (OR TEMP (EQ CSLIST CS0LIST)) + + (* ;; "We may have already done this, don't repeat") + + (SETQ TEMP (COND + ((CL:FIND CC CS0LIST :KEY #'CL:SECOND)) + [(AND CTRL HASH (CL:FIND CC CS0LIST :KEY + #'CL:THIRD] + [(AND CTRL (CL:FIND CC CS0LIST :KEY #'CL:FOURTH] + [(AND HASH (CL:FIND CC CS0LIST :KEY #'CL:FIFTH] + (T NIL))) + (CL:WHEN TEMP + (CL:WHEN (CTRLP (SETQ TC (CL:SECOND TEMP))) + (SETQ CTRL NIL)) + (CL:WHEN (HASHP TC) + (SETQ HASH NIL)) + (SETQ CNAME (CAR TEMP)))) + [SETQ CSET (COND + ((ZEROP CSET) + + (* ;; "Can skip cset=0 prefix") + + NIL) + [(CAR (CL:RASSOC CSET CHARACTERSETNAMES :KEY + #'CAR] + (CSET (OCTALSTRING CSET] + (RETURN (CONCAT (OR CSET "") + (OR (AND CSET ",") + "") + (OR HASH "") (OR CTRL "") - (CAR TEMP)))) - (COND - [(SETQ CNAME (CAR (CL:RASSOC CC CHARACTERNAMES :KEY #'KEY.FN] - ([AND HASH (SETQ TEMP (CL:RASSOC CC CHARACTERNAMES :KEY - #'HASHMASK.KEY.FN)) - (NOT (HASHP (CADR TEMP] - (CL:WHEN (EQ CSET (LRSH (CADR TEMP) - 8)) - (SETQ CSET 0)) - (SETQ CNAME (CAR TEMP))) - (T (SETQ CNAME (COND - ((AND (CL:PLUSP CSET) - (NEQ CSET META.CSET) - (NEQ CSET FUNCTION.CSET)) - (SETQ HASH NIL CTRL NIL) - (OCTALSTRING CC)) - (CTRL (CHARACTER (BITSET (LOGAND CC - CHARCODE.CTRLBITS) - CHARCODE.UNCTRLBIT))) - (HASH (CHARACTER (BITCLEAR CC CHARCODE.HASHMASK))) - (T (CHARACTER CC] - [SETQ CSET (COND - ((AND (ZEROP CSET) - (NEQ CC 255)) - - (* ;; - "Can skip cset=0 prefix iff 'char' is not the 'non-char' 255") - - NIL) - [(CAR (CL:RASSOC CSET CHARACTERSETNAMES :KEY #'KEY.FN] - (CSET (OCTALSTRING CSET] - (CL:WHEN CSET - (SETQ CSET (CONCAT CSET ","))) - (RETURN (CONCAT (OR CSET "") - (OR HASH "") - (OR CTRL "") - CNAME]) + (OR CNAME (CHARACTER (LOGOR (BITCLEAR CC HASHBIT) + (OR (AND CTRL UNCTRLBIT) + 0])) + +(CL:DEFUN \MAKE-CHARCODE.ENCODE-TABLE (CNAMES) + (DECLARE (GLOBALVARS CHARACTERNAMES)) (* ; "Edited 27-Mar-2025 23:25 by mth") + [LET [[HASHBIT (CONSTANT (PROGN + (* ;; "The bit set by the # in CHARCODE.DECODE") + + (CL:PARSE-INTEGER "10000000" :RADIX 2] + (CTRLMASK (CONSTANT (PROGN + (* ;; "Mask of bits cleared by the ^ in CHARCODE.DECODE") + + (CL:PARSE-INTEGER "01100000" :RADIX 2] + (CL:LABELS ((CHCODE (CX) + (LOGAND CX 255)) + (CHARSET (CX) + (LRSH CX 8))) + (CL:LOOP :FOR CNI :IN (OR CNAMES CHARACTERNAMES) + :WITH TABLE := (LIST (LIST 0)) + :AND CNAME :AND CSET :AND CCODE :AND CTRLCC :AND TROW :AND CSLIST :DO + (SETQ CNAME (MKSTRING (CAR CNI))) + (SETQ CCODE (CADR CNI)) + (SETQ CCODE (OR (SMALLP CCODE) + (CHARCODE.DECODE CCODE NIL))) + (SETQ CSET (CHARSET CCODE)) + (SETQ TROW (LIST CNAME CCODE (LOGOR (SETQ CTRLCC (BITCLEAR CCODE CTRLMASK)) + HASHBIT) + CTRLCC + (LOGOR CCODE HASHBIT))) + (SETQ CSLIST (ASSOC CSET TABLE)) + (CL:UNLESS CSLIST + (NCONC1 TABLE (SETQ CSLIST (LIST CSET)))) + (NCONC1 CSLIST TROW) + :FINALLY + (CL:IF (ASSOC 0 TABLE) + (RETURN TABLE) + (CL:ERROR "No character set 0 entries in CHARACTERNAMES"))]) + +(CL:DEFUN \TEST.CHARCODE.ENCODE (&OPTIONAL (CHTABLE (\MAKE-CHARCODE.ENCODE-TABLE NIL))) + (* ; "Edited 27-Mar-2025 23:27 by mth") + [CL:LOOP :FOR CH :FROM 0 :TO 65535 :WITH CAN.CHARNAME = (CL:FBOUNDP 'CHARNAME) + :AND ENC :AND DEC :NCONC (AND (NEQ CH (SETQ DEC (CHARCODE.DECODE (SETQ ENC (CHARCODE.ENCODE + CH CHTABLE)) + T))) + (LIST (LIST* :INPUT CH :ENCODED ENC :DECODED DEC + (AND CAN.CHARNAME (LIST :CHARNAME (CHARNAME + CH]) (PUTPROPS CHARCODEUTILS FILETYPE :COMPILE-FILE) (PUTPROPS CHARCODEUTILS MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP")) (PUTPROPS CHARCODEUTILS COPYRIGHT (NONE)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1960 6718 (CHARCODE.ENCODE 1960 . 6718))))) + (FILEMAP (NIL (748 7089 (CHARCODE.ENCODE 748 . 7089)) (7091 8982 (\MAKE-CHARCODE.ENCODE-TABLE 7091 . +8982)) (8984 9824 (\TEST.CHARCODE.ENCODE 8984 . 9824))))) STOP diff --git a/lispusers/CHARCODEUTILS.DFASL b/lispusers/CHARCODEUTILS.DFASL index 2fbfabf4bdfb73ffd3ebf9e10e3bab834ba5d71e..a3a5b71e2ff588bd79a744a060cfa657a3fd95d4 100644 GIT binary patch literal 3347 zcmbtWU2Gd!6`mOTsg6skn3YUfnY1iq2GV;~@a zz?>tX2*8fa*8AQq?!_ere&5{w^y6%Bkfr1h0-oVmZ`BPaG+mLhifAjcZb}^Ez3uWx zEn75XF)PP3BQt3q^<4ghP+PhbD;2&~D4{RP9H{W#aeEV!hGc7|;WgPh_dF=%WhJ2* zN(}Xac*5jCW0#px46Yvpg65s<=V|Xa&oI z6+LjqOxDZ<4g(n66+y{NTS1_P&_WsfW}zPs?Bd}fUX$~hU6ifuAq&944%et+U`hb# z@cFcuQet}+V!pYn?&r_L2KMNlWv>|k(Jnk8ZnO$rCANjivY^4WbiU+n(h* zq*c09chCw4rQW801+Xvee9uNEKW53QJo zzOQx%ZmHDob!WwC#ncPv{{2j0slW|&n|-RGUZc@eJ4rw}d|IlJ@+Zkg(w`VBMr%YX zUwxQdDaFCxxP86&fbM;u8+YX=8gbr%KZXn+V3+`H3s}ru8p07J+nO3>$!;sB-Jlx$JA?5t*- zLs|}6XD};TmMI~$0Uoq+=?PPhb^0#S&wyyp`NV4qv;)BGKe6LN6P6MDgB-`<4`d97 z-}>mTkACK(n?AbXqnCYj)JF$=)JqZbSBjViKKjf@zwpr=*tJ{9X3gwNWcZ6@_#hdH zz?Pf|^nfH%Ba_h011TkkbZk|$vr-pWicP(Uhx{9AN@xjNMf4YP3WwhSF_ z5{#F&9-@3uQn4a%_k9#xMd30E&J&x+uYqJ&{Ld)YgWiOY?<@Eo8EIc7%$;~6e(eHq zF>B5zMJMV+*PRXLzO$p1`(2~aDywXcrB%G4aqM)r-zTo8ojw$w?sU=nsdT#h!NZwS z{eh8&j}yfoTnlJ8LV4?Pv#|L1-QuF}ltS^*j~8dxt~=B- zYmO7mtrs_FyQUNxq145#t;dblbP~LqN~wMv7U(eZ2%7vTq< z;eoirrEP{yeq=LA*Va>uzu#zmpmE^%Xo%t7+Jax(`5gHg%`n=Jd(eQJ=r~=p>yh=inho zBCryY%uFt;ol|WrV|W_EC8P|{Rq_JdU8H~Ko0^1nB4`z$ggg(Y9)QPf1|RPDd}Mxz KzWeUh)_(vcaI9Pa literal 3832 zcmcInU2Gd!6`rvjC(cjfl(fx{L#Je0q*A+EhmchlB2UMY&eZc`Jd-MhrK)33GwwQe zYCDUf)v{LE6+%1G;)HhRvQ$VbUJw#$^VBUxl>mts9*}rIyt3^BFDTNA7bFPh+_9ac zNvf3=k|_6{bI(2ZeCOxhGfk#vK~OlMvb<6(SyisGT3=bMb2lngu2xyC<}L09@VPgW zM(VAv+m&T&b~#tC&&uVxRV@{3E3?a1p=7Pi;(WDcRco_?#AgIODbAa+V#HpZ={0ug z$ycph-70YL>8P5kM&mEXr@46i;?!3!PS5nt@rL3Z*A_EZty&?sb`In@kk8v3?f}x; z@=EXaJ@>9}vcka6Qs-YE&W46q$_^nBW_+xB$2l@5E25AQc~eX(y5M8n_nq)r!{oIj zpGih#Ej@3Zb)E19u3lM*maI3d5_)3U2P)hjIX!dpnqbPh=5DYJ-vlTOC&f8g6QigX zw$JHd&=}CuqUP&^4MBb01eHOUhLUndq?>&s?gnzY)4Y)4FN>}dk~LGzD6)}8K`<|A z@|Tq77Xp`fL+oW;C-|neS}MK80CeWm4r+>)LVrT1Cp_S;GZcRgP7POxA5pMjK+z30 zrZallKMusup7;s6Y6O8BLWD{1n}L2D*dyaR?rwmxZWO!9XJoY9*sUohm>K1gZ0={O zyph@?De;EXVjgWD5<{<31$cBj1~I`9O*~Q+P2M9md`Pzi@U+2>4pGCLL__a50R-z( z=^n&oX44|DhgCiW;e<$v+EqEDYpST3@f$@|AMES}AdPJ6Fx+;TowO!&t04J?(?>+@O&) zOi?8x2e|0^|Heg_XS-cQVq@fdH;D&MlPQjj4w6xpj3TV$3t-jlT%F5Rt@4-aT(QjA zxth(v-FYxbGDAiWz|;8rc-nPyIG(XVGRBfI#Pjl@c(`1l0Jrnv8aIh(+8Kob0^7$9 zus!jaZ9jEbx^~L@aO1}Z$v8{K(RkUkEzBrPteQoK<=o01hvU-TBrI3T(S0Flp&F;C z7Iqim&U->DaHjw%*^hSm*v||+@*ME?1w}8d9n8TDiG72d{|Z!B7jGE4a0X_BMpnI~ zE7A6z6Hv#Y%c5!O>8rc~$=WTEDS<@dBytMG`wcTAYnP+qH|KdJ03hbF1Ziy;v!~;zd3(;KJ+I;{Ctd3rY|eBL+~PIR#g>(c$<#P6s{i69PtUSt~fM-SMiiBBFTO54vqwjbHQ zwjbNSkxScKE={S&57;Y->nKc9s?0DaDSw!uImNzqSMk~v`E|;-qj%`oupjN?e0%f4 z3simQXR42FD{0#A6mQ!Ndoz-1rrx0%uQacC6P2YcLs)*1S=ZJdFwNBFg%=1Nc;Gz= ztoUTBdGn#lKEAI>H$UARk?28NP21_rZWkN&hv2J6GDUy?r7QR3(#dC~#8ZzRP7!(e z?PrvD*OPfH-Q2p?)ZUZ2{C6d~(6C)}bkjy{>-PO~p8A6w4O@RGbv7=1C{d@-C_j{% zlINQJ&QfTY!hACkw&9l{TsLG2?WC}?a99CqFmy&wloBy5FR^$H-Th7CD(Cy3fw+jFnPr*V&we=^aV5YHbC;1AkzKX+_&IKP9sf#4s{9} zIqRf=!@J(FN^(e@C5t$8(Si9pJ&yU9EPfZZ_oylFxH4HhMz{gO9YNVYz}?|biCLWg zme9lUB!X0yOyDp^Zs34Wj&v-b_X@C?f6`TEi!34a3y=CaS-M7UWXaMwQaDWtAz1Pa zx(=4*_f@1$df_*4;vDu~^mb@kmo2wvzkIiX55W-%) zr4Cy`_;Ug>^d{^8oVe3rCPnNp;UG`-G^p;snJ6`$K~9E?sIv=S=`={Nq~6x#6BdBc z+A|4zjwIS;TWUPTU4!knJ?5FTcR#hHqk;JkS)<1@zbD`GCYuDof8YD>Z!b4-`R$g8 z*TKXh<};Xxz2jjfE|E3-=J*mV7Fu+>+teK{DjJ$P{G-Dk!NhBQbQnX_wD*GE!1zx< zDUstK5fb!tHX~n_Omr5s?NCf&KV2m+xf=n}xBJtHgmzO9CQw2qA$I+(oS+|R%umo8 IA8c>`7xoMuUH||9