EQUALALL tests equivalence of bitmaps and big bitmaps (#1302)
* EQUALALL tests equivalence of bitmaps and big bitmaps * Oops, off by one --------- Co-authored-by: Larry Masinter <lmm@acm.org>
This commit is contained in:
rmkaplan
GitHub
@@ -1,11 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 3-Aug-2022 21:31:57" {DSK}<home>larry>medley>sources>HPRINT.;3 58021
|
||||
(FILECREATED "31-Jul-2023 13:33:10" {WMEDLEY}<sources>HPRINT.;5 57926
|
||||
|
||||
:CHANGES-TO (VARS HPRINTCOMS)
|
||||
(FNS HPRINT)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "17-Oct-2021 13:54:11" {DSK}<home>larry>medley>sources>HPRINT.;1)
|
||||
:CHANGES-TO (FNS EQUALALL)
|
||||
|
||||
:PREVIOUS-DATE " 3-Aug-2022 21:31:57" {WMEDLEY}<sources>HPRINT.;2)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -901,8 +902,8 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2022 by Venue & Xerox Corporation
|
||||
(DEFINEQ
|
||||
|
||||
(EQUALALL
|
||||
[LAMBDA (X Y) (* ;
|
||||
"Edited 26-Apr-2021 14:34 by rmk:")
|
||||
[LAMBDA (X Y) (* ; "Edited 31-Jul-2023 13:31 by rmk")
|
||||
(* ; "Edited 26-Apr-2021 14:34 by rmk:")
|
||||
(OR (EQ X Y)
|
||||
(PROG ((TY (TYPENAME Y))
|
||||
TEM)
|
||||
@@ -925,7 +926,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2022 by Venue & Xerox Corporation
|
||||
(ARRAYSIZE Y))
|
||||
(for I from (ARRAYORIG X) as J to TEM
|
||||
always (EQUALALL (ELT X I)
|
||||
(ELT Y I])
|
||||
(ELT Y I])
|
||||
((ONED-ARRAY TWOD-ARRAY GENERAL-ARRAY)
|
||||
(* ; "RMK: Added CL arrays")
|
||||
[AND (EQUAL (CL:ARRAY-DIMENSIONS X)
|
||||
@@ -939,14 +940,12 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2022 by Venue & Xerox Corporation
|
||||
(EQP (CL:FILL-POINTER X)
|
||||
(CL:FILL-POINTER Y)))
|
||||
(NOT (CL:ARRAY-HAS-FILL-POINTER-P Y)))
|
||||
(FOR I FROM 0 TO (SUB1 (CL:ARRAY-TOTAL-SIZE
|
||||
X))
|
||||
(FOR I FROM 0 TO (SUB1 (CL:ARRAY-TOTAL-SIZE X))
|
||||
ALWAYS (EQUALALL (XCL:ROW-MAJOR-AREF X I)
|
||||
(XCL:ROW-MAJOR-AREF Y I])
|
||||
(XCL:ROW-MAJOR-AREF Y I])
|
||||
(HARRAYP (EQUALHASH X Y))
|
||||
(READTABLEP (for I from 0 to 127
|
||||
always (EQUALALL (GETSYNTAX I X)
|
||||
(GETSYNTAX I Y))))
|
||||
(READTABLEP (for I from 0 to 127 always (EQUALALL (GETSYNTAX I X)
|
||||
(GETSYNTAX I Y))))
|
||||
(TERMTABLEP [AND (EQ (GETCONTROL X)
|
||||
(GETCONTROL Y))
|
||||
(EQ (GETRAISE X)
|
||||
@@ -965,18 +964,19 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2022 by Venue & Xerox Corporation
|
||||
Y]
|
||||
(for I from 0 to 31
|
||||
always (EQ (ECHOCONTROL I NIL X)
|
||||
(ECHOCONTROL I NIL Y)))
|
||||
(ECHOCONTROL I NIL Y)))
|
||||
(EVERY ORIGDELETECONTROL
|
||||
(FUNCTION (LAMBDA (Z)
|
||||
(EQUAL (DELETECONTROL (CAR Z)
|
||||
NIL X)
|
||||
(DELETECONTROL (CAR Z)
|
||||
NIL Y])
|
||||
((BITMAP BIGBM)
|
||||
(BITMAPEQUAL X Y))
|
||||
(OR (EQP X Y)
|
||||
(AND (SETQ TY (GETDESCRIPTORS TY))
|
||||
(for FIELD in TY always (EQUALALL
|
||||
(FETCHFIELD FIELD X)
|
||||
(FETCHFIELD FIELD Y])
|
||||
(for FIELD in TY always (EQUALALL (FETCHFIELD FIELD X)
|
||||
(FETCHFIELD FIELD Y])
|
||||
|
||||
(EQUALHASH
|
||||
[LAMBDA (AR1 AR2)
|
||||
@@ -1118,14 +1118,14 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2022 by Venue & Xerox Corporation
|
||||
(PUTPROPS HPRINT COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991
|
||||
1993 1994 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3694 6232 (MAKEHVPRETTYCOMS 3704 . 4991) (READVARS 4993 . 5559) (HPRINT0 5561 . 6230))
|
||||
(6234 6567 (READVARS-FROM-STRINGS 6234 . 6567)) (6569 6956 (READVARS-FROM-STREAM 6569 . 6956)) (6957
|
||||
8885 (READVAR-FROM-STRING 6967 . 7373) (READVARS-FROM-STRING 7375 . 7611) (HPRINT-TO-STRING 7613 .
|
||||
7819) (HPRINT-TO-STRINGS 7821 . 8883)) (9696 38289 (HPRINT 9706 . 11697) (HPRINT1 11699 . 23201) (
|
||||
HPRINTEND 23203 . 24239) (RPTPRINT 24241 . 24479) (RPTEND 24481 . 24640) (RPTPUT 24642 . 25140) (
|
||||
HPRINTSP 25142 . 25206) (HPERR 25208 . 25305) (HVFWDCDREAD 25307 . 25686) (HVBAKREAD 25688 . 33733) (
|
||||
HVREADCHECKGETFN 33735 . 35134) (HVREADEND 35136 . 35488) (HVRPTREAD 35490 . 36016) (HVFWDREAD 36018
|
||||
. 36872) (HREAD 36874 . 37196) (HPINITRDTBL 37198 . 38032) (HVREADERR 38034 . 38147) (HPRINSP 38149
|
||||
. 38287)) (38290 47172 (COPYALL 38300 . 42203) (\COPYDATATYPE 42205 . 42894) (HCOPYALL 42896 . 43206)
|
||||
(HCOPYALL1 43208 . 47170)) (47173 54520 (EQUALALL 47183 . 52841) (EQUALHASH 52843 . 54518)))))
|
||||
(FILEMAP (NIL (3652 6190 (MAKEHVPRETTYCOMS 3662 . 4949) (READVARS 4951 . 5517) (HPRINT0 5519 . 6188))
|
||||
(6192 6525 (READVARS-FROM-STRINGS 6192 . 6525)) (6527 6914 (READVARS-FROM-STREAM 6527 . 6914)) (6915
|
||||
8843 (READVAR-FROM-STRING 6925 . 7331) (READVARS-FROM-STRING 7333 . 7569) (HPRINT-TO-STRING 7571 .
|
||||
7777) (HPRINT-TO-STRINGS 7779 . 8841)) (9654 38247 (HPRINT 9664 . 11655) (HPRINT1 11657 . 23159) (
|
||||
HPRINTEND 23161 . 24197) (RPTPRINT 24199 . 24437) (RPTEND 24439 . 24598) (RPTPUT 24600 . 25098) (
|
||||
HPRINTSP 25100 . 25164) (HPERR 25166 . 25263) (HVFWDCDREAD 25265 . 25644) (HVBAKREAD 25646 . 33691) (
|
||||
HVREADCHECKGETFN 33693 . 35092) (HVREADEND 35094 . 35446) (HVRPTREAD 35448 . 35974) (HVFWDREAD 35976
|
||||
. 36830) (HREAD 36832 . 37154) (HPINITRDTBL 37156 . 37990) (HVREADERR 37992 . 38105) (HPRINSP 38107
|
||||
. 38245)) (38248 47130 (COPYALL 38258 . 42161) (\COPYDATATYPE 42163 . 42852) (HCOPYALL 42854 . 43164)
|
||||
(HCOPYALL1 43166 . 47128)) (47131 54425 (EQUALALL 47141 . 52746) (EQUALHASH 52748 . 54423)))))
|
||||
STOP
|
||||
|
||||
Reference in New Issue
Block a user