Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
(FILECREATED "18-Jan-79 19:55:53" <LISPUSERS>CIALPHORDER..1 5055
changes to: CIALPHORDERCOMS
previous date: "18-Jan-79 19:54:41" <LISPUSERS>CIALPHORDER..1)
(PRETTYCOMPRINT CIALPHORDERCOMS)
(RPAQQ CIALPHORDERCOMS ((FNS CIALPHORDER)))
(DEFINEQ
(CIALPHORDER
[LAMBDA (A B) (* Edited by M.Yonke on
12-Jan-79.)
(* * Compares two atoms and returns T if they are in order.
Order precedence is numbers, literals, and everything else.
Numbers are sorted by magnitude. Literals
(strings, atoms, and pnames) are sorted alphabetically
(but case independent). Other types come at the end.)
(PROG ((TB (NTYP B)))
(SELECTQ (NTYP A)
(20 (ASSEMBLE NIL (* A is SMALLP)
(CQ A)
(SUBI 1 , ASZ))
(* Fast unbox for small
numbers.)
(GO UNBOXEDINT))
(18 (ASSEMBLE NIL
(CQ A)
(MOVE 1 , 0 (1))
(* Fast unbox for large
numbers.)
)
(* A is integer)
(GO UNBOXEDINT))
[16 (* A is floating)
(SELECTQ TB
[16 (* Both floating.
Do open FGREATERP.)
(ASSEMBLE NIL
(CQ B)
(MOVE 2 , 0 (1))
(* Fast unbox but into floating
format.)
(CQ A)
(CAMGE 2 , 0 (1))
(SKIPA 1 , KNIL)
(CQ T)
(CQ (RETURN (AC]
(20 (ASSEMBLE NIL
(CQ B)
(SUBI 1 , ASZ)))
[18 (ASSEMBLE NIL
(CQ B)
(MOVE 1 , 0 (1]
(RETURN T))
(* Return T for A floating, B
non-numeric.)
(ASSEMBLE NIL
(FASTCALL FXFLT)
(* Unboxed (integer) B in ac1.
FLOAT it and compare to A.)
(LDV2 'A SP 2)
(CAMGE 1 , 0 (2))
(SKIPA 1 , KNIL)
(CQ T)
(CQ (RETURN (AC]
(12 (ASSEMBLE NIL (* A is LITATOM)
(CQ A)
(HLRZ 1 , 2 (1)))
(GO LIT))
((24 28)
(* A is string or pname)
(ASSEMBLE NIL
(CQ A))
(GO LIT))
(SELECTQ TB
((28 24 12 20 18 16)
(* A is list, ARRAY or junk; B is something legal so it
belongs first.)
(RETURN NIL))
(RETURN T))) (* Both junk; return T.)
UNBOXEDINT
[ASSEMBLE NIL (* Unboxed integer A in ac1.
Stack it.)
(PUSHN)
(CQ (SELECTQ TB
(24Q (ASSEMBLE NIL
(CQ B)
(SUBI 1 , ASZ)))
[22Q (ASSEMBLE NIL
(CQ B)
(MOVE 1 , 0 (1]
[20Q (ASSEMBLE NIL
(NREF (MOVE 1 , 0))
(FASTCALL FXFLT)
(* A integral, B floating. float unboxed A on stack and load
ac1 with unboxed B.)
(NREF (MOVEM 1 , 0))
(CQ B)
(MOVE 1 , 0 (1]
(RETURN T)))
(* A numeric, B not.)
(NREF (CAMGE 1 , 0))
(* Compare two unboxed numbers. Fixed or floating doesn't
matter as long as both the same.)
(SKIPA 1 , KNIL)
(CQ T)
(POPNN 1)
(CQ (RETURN (AC]
LIT (ASSEMBLE NIL
(FASTCALL UPATM)
(* Ac3 has byte ptr to A; ac4 has NCHARS.
Notice use of CP here.)
(PUSHN 4)
(PUSH CP , 3)
[CQ (SELECTQ TB
((24Q 22Q 20Q)
(ASSEMBLE NIL
(POP CP , 1))
(* A was literal, B numeric.)
(RETURN))
((30Q 34Q)
(ASSEMBLE NIL
(CQ B)))
[14Q (ASSEMBLE NIL
(CQ B)
(HLRZ 1 , 2 (1]
(ASSEMBLE NIL
(POP CP , 1)
(* A was literal, B was list or
junk.)
(CQ (RETURN T]
(* At last the basic alphabetizer. Ac6 has NCHARS A;
ac5 has byte pointer to A; ac4 has NCHARS B
(from this call to UPATM), ac3 has byte pointer to B.)
(FASTCALL UPATM)
(POP CP , 5)
(POPN 6)
LP (SOJL 6 , SUCCEED) (* A won because shorter)
(SOJL 4 , FAIL) (* B won because shorter.)
(ILDB 1 , 5)
(CAIL 1 , 141Q)
(CAILE 1 , 172Q)
(SKIPA)
(SUBI 1 , 40Q)
(ILDB 2 , 3)
(CAIL 2 , 141Q)
(CAILE 2 , 172Q)
(SKIPA)
(SUBI 2 , 40Q)
(CAMN 1 , 2)
(JRST LP) (* Chars the same, try again.)
(CAML 1 , 2)
(* A and B have different spellings. Compare magnitude of
character byte and exit with result.)
FAIL(SKIPA 1 , KNIL)
SUCCEED
(CQ T)
(CQ (RETURN (AC])
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (264 5031 (CIALPHORDER 276 . 5028)))))
STOP