perm filename CYCCAT.LAP[3,LMM] blob sn#037507 filedate 1973-04-22 generic text, type T, neo UTF8
(DEFPROP CYCCATFNS (CYCCATFNS MAKECAT TRIVGRAPH CHORDLENGTH TRIVALENTCODES (SETQ LASTNODE 0.) (AND LOADING (SETQ→
 CATALOG-LIST (MAKECAT TRIVALENTCODES)))) VALUE) 

(LAP MAKECAT SUBR) 
       (PUSH P 1.) 
       (PUSH P 1.) 
       (PUSH P (C 0. 0. (QUOTE NIL) 0.)) 
       (PUSH P (C 0. 0. (QUOTE NIL) 0.)) 
       (PUSH P (C 0. 0. (QUOTE NIL) 0.)) 
 TAG1  (MOVE 1. -3. P) 
       (JUMPE 1. TAG9) 
       (HLRZ@ 1. -3. P) 
       (HLRZ@ 2. 1.) 
       (MOVEM 1. -2. P) 
       (MOVEM 2. -1. P) 
       (PUSH P (C 0. 0. TAG15 0.)) 
       (PUSH P -1. P) 
       (HRRZ@ 1. 1.) 
       (PUSH P 1.) 
       (PUSH P (C 0. 0. (QUOTE NIL) 0.)) 
       (PUSH P (C 0. 0. (QUOTE NIL) 0.)) 
 TAG2  (MOVE 1. -2. P) 
       (JUMPE 1. TAG5) 
       (HLRZ@ 1. -2. P) 
       (MOVEM 1. -1. P) 
       (PUSH P (C 0. 0. TAG21 0.)) 
       (PUSH P -1. P) 
       (MOVE 2. 1.) 
       (MOVE 1. -8. P) 
       (CALL 2. (E TRIVGRAPH) S) 
       (CALL 1. (E NCONS) S) 
       (PUSH P 1.) 
       (MOVNI 6. 2.) 
       (JCALL 14. (E NCONC) S) 
 TAG21 (MOVEM 1. 0. P) 
 TAG3 
 TAG4  (HRRZ@ 1. -2. P) 
       (MOVEM 1. -2. P) 
       (JRST 0. TAG2) 
 TAG5  (MOVE 1. 0. P) 
       (CALL 1. (E NCONS) S) 
       (SUB P (C 3. 0. 3. 0.)) 
       (PUSH P 1.) 
       (MOVNI 6. 2.) 
       (JCALL 14. (E NCONC) S) 
 TAG15 (MOVEM 1. 0. P) 
 TAG6 
 TAG7 
 TAG8  (HRRZ@ 1. -3. P) 
       (MOVEM 1. -3. P) 
       (JRST 0. TAG1) 
 TAG9  (MOVE 1. 0. P) 
       (SUB P (C 5. 0. 5. 0.)) 
       (POPJ P) 
       NIL 

(LAP TRIVGRAPH SUBR) 
       (JSP 6. SPECBIND) 
       (0. 0. (SPECIAL Y) S) 
       (PUSH P 1.) 
       (PUSH P 2.) 
       (PUSH P 2.) 
       (CALL 1. (E SINGLERING) S) 
       (PUSH P 1.) 
       (PUSH P (C 0. 0. (QUOTE NIL) 0.)) 
       (PUSH P (C 0. 0. (QUOTE NIL) 0.)) 
       (PUSH P -5. P) 
       (PUSH P (C 0. 0. (QUOTE NIL) 0.)) 
 TAG1  (MOVEI 2. (QUOTE 1.)) 
       (MOVE 1. -1. P) 
       (CALL 2. (E *LESS) S) 
       (JUMPN 1. TAG4) 
       (MOVE 2. 0. P) 
       (MOVE 1. -1. P) 
       (CALL 2. (E CONS) S) 
       (MOVEM 1. 0. P) 
 TAG2 
 TAG3  (MOVEI 2. (QUOTE -1.)) 
       (MOVE 1. -1. P) 
       (CALL 2. (E *PLUS) S) 
       (MOVEM 1. -1. P) 
       (JRST 0. TAG1) 
 TAG4  (MOVE 2. 0. P) 
       (SUB P (C 2. 0. 2. 0.)) 
       (MOVEM 2. 0. P) 
       (PUSH P (C 0. 0. (QUOTE NIL) 0.)) 
 TAG19 
 TAG19 
 TAG7  (MOVE 1. -1. P) 
       (JUMPE 1. TAG11) 
       (MOVE 1. -5. P) 
       (JUMPE 1. TAG11) 
       (HLRZ@ 1. -5. P) 
       (CALL 1. (E CHORDLENGTH) S) 
       (HLRZ@ 2. -1. P) 
       (CALL 2. (E *PLUS) S) 
       (MOVE 2. -3. P) 
       (MOVEM 1. -2. P) 
       (HLRZ@ 1. -1. P) 
       (CALL 2. (E FINDCTE) S) 
       (MOVE 2. -3. P) 
       (PUSH P 1.) 
       (MOVE 1. -3. P) 
       (CALL 2. (E FINDCTE) S) 
       (MOVE 2. 1.) 
       (POP P 1.) 
       (CALL 2. (E CONNECT) S) 
       (MOVE 2. -1. P) 
       (MOVE 1. -2. P) 
       (CALL 2. (E DELETE) S) 
       (MOVEM 1. -1. P) 
 TAG8 
 TAG9  (HRRZ@ 1. -5. P) 
       (MOVEM 1. -5. P) 
 TAG10 (HRRZ@ 1. -1. P) 
       (MOVEM 1. -1. P) 
       (JRST 0. TAG7) 
 TAG11 (SUB P (C 1. 0. 1. 0.)) 
       (MOVE 2. -3. P) 
       (MOVE 1. -5. P) 
       (CALL 2. (E CONS) S) 
       (HRRZ@ 2. -2. P) 
       (HRRZ@ 2. 2.) 
       (HRRZ@ 2. 2.) 
       (CALL 2. (E CONS) S) 
       (HRRZ@ 2. -2. P) 
       (HLRZ@ 2. 2.) 
       (CALL 2. (E XCONS) S) 
       (HLRZ@ 2. -2. P) 
       (CALL 2. (E XCONS) S) 
       (SUB P (C 6. 0. 6. 0.)) 
       (JRST 0. SPECSTR) 
       NIL 

(LAP CHORDLENGTH SUBR) 
       (MOVEI 3. (QUOTE NIL)) 
       (MOVEI 2. (QUOTE ((A . 1.) (B . 2.) (C . 3.) (D . 4.) (E . 5.) (F . 6.) (G . 7.) (H . 8.) (I . 9.))) S) 
       (CALL 3. (E SASSOC) S) 
       (HRRZ@ 1. 1.) 
       (POPJ P) 
       NIL 

(DEFPROP TRIVALENTCODES (TRIVALENTCODES (2. (A)) (4. (B B) (A A)) (6. (B C B) (A A A) (A B B) (A C A) (C C C)) (→
8. (B C C B) (B D D B) (C E C C) (A A A A) (A A B B) (A A C A) (A B C B) (A B D A) (A C D B) (A D D A) (A E B B)→
 (A E C A) (B B B B))) VALUE) 

(SETQ LASTNODE 0.) 

(AND LOADING (SETQ CATALOG-LIST (MAKECAT TRIVALENTCODES)))