(FILECREATED " 2-Feb-86 17:12:24" {DSK}<LISPFILES2>CUT.LSP;2
 2799   

      changes to:  (VARS CUTCOMS))


(* Copyright (c) 1986 by Quintus Computer Systems, Inc. All rights reserved.)

(PRETTYCOMPRINT CUTCOMS)

(RPAQQ CUTCOMS
 ((FNS R.body.cut R.cut.proceed R.cut.to.choice.point R.depart.cut R.head.cut 
		       R.load.choice.point W.body.cut W.cut.proceed W.cut.to.choice.point 
		       W.depart.cut W.head.cut W.load.choice.point cut)))
(DEFINEQ

(R.body.cut

  (LAMBDA NIL
    (put.24 S (get.24 B))
    (put.24 B (get.addr E saved.B0))
    (cut
)))

(R.cut.proceed

  (LAMBDA NIL
    (put.24 P (add.code CP 1))
    (put.24 S (get.24 B))
    (put.24 B (get.24 B0))
    (cut
)))

(R.cut.to.choice.point

  (LAMBDA NIL
    (put.24 S (get.24 B))
    (put.24 B (untag.stack T0))
    (cut
)))

(R.depart.cut

  (LAMBDA NIL
    (put.24 CP (get.addr E saved.CP))
    (put.24 P (add.code CP 1))
    (put.24 S (get.24 B))
    (put.24 B (get.addr E saved.B0))
    (put.24 E (get.addr E saved.CE))
    (cut
)))

(R.head.cut

  (LAMBDA NIL
    (put.24 S (get.24 B))
    (put.24 B (get.24 B0))
    (cut
)))

(R.load.choice.point

  (LAMBDA NIL
    (put.32 T1 (get.32 T0))
    (put.32 T0 (tag.stack B))
    (continue.reading 0)))

(W.body.cut

  (LAMBDA NIL
    (put.24 S (get.24 B))
    (put.24 B (get.addr E saved.B0))
    (cut
)))

(W.cut.proceed

  (LAMBDA NIL
    (put.24 P (add.code CP 1))
    (put.24 S (get.24 B))
    (put.24 B (get.24 B0))
    (cut
)))

(W.cut.to.choice.point

  (LAMBDA NIL
    (put.24 S (get.24 B))
    (put.24 B (untag.stack T0))
    (cut
)))

(W.depart.cut

  (LAMBDA NIL
    (put.24 CP (get.addr E saved.CP))
    (put.24 P (add.code CP 1))
    (put.24 S (get.24 B))
    (put.24 B (get.addr E saved.B0))
    (put.24 E (get.addr E saved.CE))
    (cut
)))

(W.head.cut

  (LAMBDA NIL
    (put.24 S (get.24 B))
    (put.24 B (get.24 B0))
    (cut
)))

(W.load.choice.point

  (LAMBDA NIL
    (put.32 T1 (get.32 T0))
    (put.32 T0 (tag.stack B))
    (continue.reading 0)))

(cut

  (LAMBDA NIL
    (if
 (
NOT
 (same.addr B S))
	then
 (put.24 C (get.24 TR))
	       (
PROG
 NIL
		   L1  (put.24 R (get.addr S saved.B))
		       (if
 (same.addr R B)
			   then
 (
GO
 L2))
		       (put.24 S (get.addr R saved.B))
		       (if
 (
NOT
 (same.addr S B))
			   then
 (
GO
 L1))
		       (put.24 S (get.24 R))
		   L2  (
RETURN
))
	       (put.24 HB (get.addr S saved.H))
	       (put.24 S (get.addr S saved.TR))
	       (put.24 TR (get.24 S))
	       (until
 (same.addr S C)
			(decrement.cell.pointer S)
			(put.24 R (get.addr S 0))
			(trail.safely R)))
    (continue.reading 0)))
)
(PUTPROPS CUT.LSP COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (452 2709 (R.body.cut 462 . 570) (R.cut.proceed 572 . 704) (R.cut.to.choice.point 706 . 
820) (R.depart.cut 822 . 1038) (R.head.cut 1040 . 1138) (R.load.choice.point 1140 . 1263) (W.body.cut 
1265 . 1373) (W.cut.proceed 1375 . 1507) (W.cut.to.choice.point 1509 . 1623) (W.depart.cut 1625 . 1841
) (W.head.cut 1843 . 1941) (W.load.choice.point 1943 . 2066) (cut 2068 . 2707)))))
STOP