PDP-10.its/src/draw/btext.500

;<DRAW>BTEXT.FAI.64, 15-NOV-75 18:03:04, EDIT BY HELLIWELL
VERSION(BTEXT,3)
MD,<
;BODY TEXT MODE TEXT AND PROPERTY PLACEMENT
;TOP LEVEL COMMAND DISPATCH HERE

ENTBTB:	MOVE A,BTBODY
	HLRZ A,(A)
	HRRZ A,1(A)
	JRST ALREAD		;ENTER EDITOR ON THIS BODY

ENTBTM:	PUSHJ P,GETCLS
	JRST PERRET
	MOVEM A,BTBODY
	MOVEI T,BTXTM
	JRST CHNGMD

BTXPLB:	PUSHJ P,GETCLS
	JRST PERRET
	CAIA
BTXPLC:	MOVE A,BTBODY
	SETZM BTEXT
	PUSHJ P,BTXPUT
	JFCL
	POPJ P,

;ADD NEW PROP TO BODY
;BTBODY = BODY TO ADD TO

BTXPRB:	PUSHJ P,GETCLS
	JRST PERRET
	CAIA
BTXPRP:	MOVE A,BTBODY
	TLNN M,DSKACT!MACACT
	OUTSTR[ASCIZ/PROPERTY NAME?
/]
	PUSHJ P,TREADU
	POPJ P,
	POPJ P,
	MOVE T,B
	PUSHJ P,BFPROP
	 JRST BTXPNW		;NOT FOUND
	 TROA TFLG		;REMEMBER FOUND IN BODY DEF
	TRZ TFLG		;REMEMBER FOUND IN BODY
	PUSHJ P,PUTFS		;RECLAIM TEXT STRING
	TLNN M,DSKACT!MACACT
	OUTSTR[ASCIZ/OLD PROPERTY, NEW TEXT?
/]

;FALLS THRU
;BTXPR1 - PUT VALUE ON PROP IN T
;TFLG = PROP NAME FOUND IN TYPE, NOT BODY
;A = BODY
BTXPR1:	MOVE E,T		;SAVE POINTER TO BLOCK
	PUSHJ P,TXREAD
	CAIE C,ALTMOD
	SKIPN 1(B)
	JRST PUTFS		;RETURN ANY TEXT READ
	TRNE TFLG		;DID WE FIND IN BODY OR BODY DEF?
	PUSHJ P,COPLTP		;COPY TEXT AND PROPERTIES INTO INDIRECT LIST
				;IF COPLTP CALLED, E SET TO INDIRECT POINTER BLOCK
	FETCH(TT,E,TXBIT)	;INDIRECT ?
	TRZN TT,TXBIND
	 JRST BTXPR2		;NO
;Property being modified is indirect to TYPE, make copy of indirect's prop
	STORE(TT,E,TXBIT)	;MAKE LOCAL PROP
	FETCH(T,E,TXIND)	;GET TEXT BLOCK OF TYPE
	FETCH(TTT,T,TXXY)	;COPY TYPE'S PROPERTY
	STORE(TTT,E,TXXY)
	FETCH(TTT,T,TXOFF)
	STORE(TTT,E,TXOFF)
	FETCH(T,T,TXNAM)	;PROPERTY NAME
	PUSH P,B		;PROPERTY VALUE
	PUSHJ P,LSTCOP		;COPY PROPERTY NAME
	STORE(B,E,TXNAM)
	POP P,B			;PROP VALUE
	MOVE T,TEXSIZ		;TEXT SIZE
	SKIPGE T
	MOVE T,STDBIG		;WHEN COPYING FROM TYPE, MAKE STD SIZE
BTXPR2:	TRO MCHG!NEEDCL
	FETCH(TT,E,TXVAL)
	SKIPGE T
	 FETCH(T,TT,TSSIZ)	;OLD TEXT SIZE
	STORE(T,B,TSSIZ)
	STORE(B,E,TXVAL)	;SET PROP VAL
	SKIPE B,TT
	PUSHJ P,PUTFS		;RETURN OLD PROP VAL
	MOVE B,E
	PUSHJ P,CMPBDT		;COMPILE SPECIAL PROPS (BDY IN A)
	MOVE C,E
	FETCH(T,E,TXXY)
	TRNN T,1
	POPJ P,			;NO AUTO OFFSET
	JRST EDTCEN		;GO CENTER IT

BTXPNW:	TLNN M,DSKACT!MACACT
	OUTSTR[ASCIZ/NEW PROPERTY, /]
	MOVEM T,BTEXT
	PUSHJ P,BTXPUT
	SKIPA B,BTEXT		;LOSE, MUST GIVE BACK PROPERTY NAME
	POPJ P,			;WIN, RETURN
	JRST PUTFS

;PUT PROPERTY ON BODY AT CURRENT CURSE LOC
;A =  BODY POINTER
;BTEXT = PROPERTY NAME
;RETURNS
;SKIPS IF TEXT ENTERED SUCCESSFULLY
;C = POINTER TO TEXT/PROP BLOCK
;E = POINTER TO 2ND BLOCK OF TEXT BLOCK  ???

BTXPUT:	TLNN M,DSKACT!MACACT
	OUTSTR[ASCIZ/TEXT?
/]
	PUSHJ P,TXREAD
	CAIE C,ALTMOD
	SKIPN 1(B)
	JRST PUTFS		;LOSE, GIVE BACK WHATEVER WAS READ
	TRO MCHG!NEEDCL
	PUSHJ P,MAKTXT		;GET TEXT BLOCK IN TT
	MOVE C,TT		;TEXT BLOCK
	MOVE T,CURSE
	ADJUST(SUB,T,<ADDR(A,BXY)>)
	FETCH(F,A,BORI)
	MOVE F,UNROT(F)
	PUSHJ P,ORIENT
	TRO T,1			;AUTO OFFSET INITIALLY
	STORE(T,C,TXXY)
	FETCH(TT,A,BTXT)	;ANY PROP LIST NOW?
	SKIPN TT		;YES, DON'T MAKE INITIAL INDIRECT LIST
	 PUSHJ P,COPLTP		;NO, COPY BODY DEF TEXT/PROPERTIES INTO INDIRECT LIST
	FETCH(D,A,BTXT)
	STORE(D,C,TXNXT)
	STORE(C,A,BTXT)		;ADD NEW PROP TO HEAD OF LIST
	MOVEI E,ADDR(C,TXNAM)	;COMPATIBILITY **
	STORE(B,C,TXVAL)	;DEPOSIT POINTER TO TEXT
	MOVE T,TEXSIZ
	SKIPGE T		;IF NO SIZE TYPED,
	 MOVE T,STDBIG		;USE STANDARD
	STORE(T,B,TSSIZ)	;DEPOSIT CHR SIZE IN FIRST BLOCK OF TEXT
	MOVE T,BTEXT		;GET PROPERTY NAME
	STORE(T,C,TXNAM)
	AOS (P)			;SKIP TO INDICATE SUCCESS, AND FALL INTO EDTCEN
	MOVE B,C		;PROPERTY BLOCK
	PUSHJ P,CMPBDT		;COMPILE ANY SPECIAL PROPS (BDY IN A)
	JRST EDTCEN		;OFFSET TEXT

;BODY TEXT COPY PROPS

BTCPRB:	PUSHJ P,GETCLS
	JRST PERRET
	CAIA
BTCPRP:	MOVE A,BTBODY
	FETCH(TTT,A,BTXT)
	JUMPE TTT,BTCPR1	;NO PROP LIST NOW
	PUSHJ P,BFCPRP
	POPJ P,
	TRZ TFLG		;FOUND IN BODY
BTCPR2:	TLNN M,DSKACT!MACACT
	OUTSTR[ASCIZ/NEW TEXT?
/]
	JRST BTXPR1

BTCPR1:	FETCH(TTT,A,BTYP)
	FETCH(TTT,TTT,TPROP)
	PUSHJ P,BFCPRP
	POPJ P,
	TRO TFLG
	JRST BTCPR2

;EDIT MODE TEXT AND PROPERTY PLACEMENT - FOR TYPES

EDTXT:	SETZM BTEXT
	PUSHJ P,EDTPUT
	POPJ P,			;DON'T DIDLE SIZE IF NO CHANGE
	FETCH(TT,C,TXVAL)
	FETCH(T,TT,TSSIZ)
	JUMPN T,CPOPJ		;ZERO SIZE?
	MOVE T,STDBIG		;YES, NOT ALLOWED, USE STANDARD
	STORE(T,TT,TSSIZ)
	POPJ P,

EDTPRP:	TLNN M,DSKACT!MACACT
	OUTSTR[ASCIZ/PROPERTY NAME?
/]
	PUSHJ P,TREADU
	 POPJ P,
	 POPJ P,
	MOVE T,B
	MOVE A,CURBOD
	PUSHJ P,FPROP
	 JRST EDTPNW		;NEW PROPERTY, ADD
	PUSHJ P,PUTFS		;OLD PROP, RECLAIM STRING
	TLNN M,DSKACT!MACACT
	OUTSTR[ASCIZ/OLD PROPERTY, NEW TEXT?
/]
EDTPR1:	MOVE A,T		;SAVE BLOCK FOUND
	PUSHJ P,TXREAD
	CAIE C,ALTMOD
	 SKIPN ADDR(B,TSASC)
	 JRST PUTFS		;LOSE, GIVE BACK WHATEVER WAS READ
	TRO MCHG!NEEDCL
	FETCH(TT,A,TXVAL)
	SKIPGE T
	 FETCH(T,TT,TSSIZ)	;IF NO SIZE TYPED, COPY OLD
	STORE(T,B,TSSIZ)
	STORE(B,A,TXVAL)	;STORE NEW PROP VAL
	MOVE B,TT
	PUSHJ P,PUTFS		;RELEASE OLD
	MOVE B,A		;TEXT/PROP BLOCK
	MOVE A,CURBOD
	PUSHJ P,CMPTYT		;CHECK FOR SPECIAL PROP ON TYPE
	MOVE C,B		;PROP BLOCK POINTER
	FETCH(T,C,TXXY)
	TRNN T,1		;AUTO OFFSET?
	POPJ P,			;NO
	JRST EDTCEN

EDTPNW:	MOVEM T,BTEXT
	TLNN M,DSKACT!MACACT
	OUTSTR[ASCIZ/NEW PROPERTY, /]
	PUSHJ P,EDTPUT
	SKIPA B,BTEXT		;HE QUIT, GIVE BACK STRING
	POPJ P,			;ALL OK
	JRST PUTFS

;PUT TEXT UNDER PROPERTY - EDIT
;ALSO PUTS ON ALL BODIES OF THIS TYPE (IF THEY HAVE EXPLICIT PROP LISTS)
;CURBOD = PTR TO TYPE DEFINITION
;BTEXT = PROPERTY NAME (0 IF JUST TEXT)
;SKIPS
;C = TEXT/PROP BLOCK

EDTPUT:	TLNN M,DSKACT!MACACT
	OUTSTR [ASCIZ /TEXT?
/]
	PUSHJ P,TXREAD		;READ TEXT
	CAIE C,ALTMOD		;IF ALTMODE TYPED,
	 SKIPN 1(B)		;OR NULL TEXT
	  JRST PUTFS		;LOSE, GIVE BACK WHATEVER WAS READ
	AOS (P)			;INDICATE SUCCESS
	TRO MCHG!NEEDCL
	MOVE A,CURBOD		;GET POINTER TO CURRENT TYPE
	PUSHJ P,MAKTXT
	MOVE C,TT		;NEW TYPE PROP BLOCK
	STORE(B,C,TXVAL)	;DEPOSIT POINTER TO TEXT
	MOVE T,TEXSIZ
	SKIPGE T		;IF NO SIZE TYPED,
	 MOVE T,STDBIG		;USE STANDARD
	STORE(T,B,TSSIZ)	;DEPOSIT CHR SIZE IN FIRST BLOCK OF TEXT
	MOVE T,BTEXT		;GET PROPERTY NAME
	STORE(T,C,TXNAM)
	MOVE B,C		;PROP BLOCK
	MOVE D,CURSE		;GET CURRENT POSITION
	TRO D,1			;SET AUTO OFFSET BIT
	TLZ D,1			;CLEAR MARK BIT
	STORE(D,C,TXXY)
	MOVE B,C
	PUSHJ P,ADDPRT		;ADD PROP(B) TO TYPE(A)
				;NOW CENTER TEXT
;FALLS THRU
;EDTCEN - CENTER BODY TEXT
;C = PTR TO TEXT/PROP BLOCK
;TEXLIN = #LINES,,MAX LENGTH

EDTCEN:	TRO MCHG
	FETCH(T,C,TXVAL)
	FETCH(T,T,TSSIZ)
	SKIPN T
	 MOVE T,STDBIG
	PUSH P,T
	ANDI T,377777		;REMOVE VERT BIT
	HRRZ TT,TEXLIN		;GET # CHARS
	IMUL TT,VIRPTX(T)
	ASH TT,-1		;ONLY HALF FOR OFFSET
	MOVNS TT
	STORE(TT,C,TXOX)	;X PART
	HLRZ TTT,TEXLIN		;GET # LINES-1
	SUBI TTT,1
	IMUL TTT,VIRPTY(T)
	ASH TTT,-1
	STORE(TTT,C,TXOY)	;Y OF CONSTANT OFFSET
	POP P,T
	TRNN T,400000		;VERT?
	 POPJ P,
	MOVEI F,1		;YES 90 DEGREES CCW
	FETCH(T,C,TXOFF)
	PUSHJ P,ORIENT
	STORE(T,C,TXOFF)
	POPJ P,

;OFFSET TEXT

BTXTZ:
EDTTZ:	PUSHJ P,GETCLS
	JRST PERRET
	MOVEI T,1
	IORM T,ADDR(A,TXXY)	;TURN ON AUTO OFFSET BIT
EDTTZA:	MOVEI T,1
	LSH T,@MODE
	TDNE T,[1EDTTM!1BTXTM]
	TRNN TMOVE
	JRST EDTTZ2
	CAME A,CLOSES
	JRST EDTTZ2
	TRZE INMOV
	TRO NEEDCL
EDTTZ2:	FETCH(T,A,TXVAL)
	ADD T,[POINT 7,1]
	SETZB TT,TTT
EDTTZ1:	PUSHJ P,GETTT
	JRST [	CAILE TTT,(TT)
		HRR TT,TTT
		MOVEM TT,TEXLIN
		MOVE C,A
		JRST EDTCEN]
	CAIE C,""
	AOJA TTT,EDTTZ1
	ADD TT,[1,,0]
	CAILE TTT,(TT)
	HRR TT,TTT
	SETZ TTT,
	JRST EDTTZ1

;$$Y IN EDIT MODES
EDCPRP:	MOVE TTT,CURBOD
	FETCH(TTT,TTT,TPROP)
	PUSHJ P,BFCPRP
	 POPJ P,
	TLNN M,DSKACT!MACACT
	OUTSTR[ASCIZ/NEW TEXT?
/]
	JRST EDTPR1

EDTENT:	MOVEI T,EDTTM
	JRST CHNGMD

STOBTP:	PUSHJ P,GETCLS
	 JRST PERRET
	FETCH(T,A,TXNAM)
	PUSHJ P,SETTT
	JUMPE T,ITSTUF
	JRST STOTX0

STOBTX:	PUSHJ P,GETCLS
	JRST PERRET
	FETCH(T,A,TXVAL)
	JRST STOTXB		;CALL ROUTINE FOR POINT TEXT

;PRINT ALL PROPERTIES FOR THIS BODY OR BODY DEF
LPROPS:	MOVEI T,1
	LSH T,@MODE
	TDNE T,[ALLEDM!1EDTAM]
	 JRST EDTLPR
	TDNE T,[1BTXTM]
	 JRST [	MOVE A,BTBODY
		JRST BTXLPR]
	TDNN T,[1BODM]
	 JRST PERRET
	PUSHJ P,GETCLS
	 JRST PERRET
BTXLPR:	TVOFF
	MOVE H,A
	OUTSTR [ASCIZ /
Package code: /]
	FETCH(T,H,BPAK)
	OUTSTR @PACKNM(T)
	FETCH(G,H,BTXT)
	JUMPE G,[OUTSTR[ASCIZ/
NO LOCAL BODY PROPERTIES.
/]
		JRST BTSLPE]
	OUTSTR[ASCIZ/
LOCAL BODY PROPERTIES:
* INDICATES PROPERTY FROM BODY DEF,
@ INDICATES PROPERTY FROM DIP DEF.
/]
	PUSHJ P,LPROPL	;LIST PROPERTY LIST
BTSLPE:	FETCH(H,H,BTYP)
	JRST EDLPR1

EDTLPR:	TVOFF
	MOVE H,CURBOD		;LIST BODY DEF PROPERTIES
EDLPR1:	OUTSTR[ASCIZ/
BODY NAME: /]
	FETCH(T,H,TNAM)		;BODY NAME
	PUSHJ P,OUTTXT
	FETCH(B,H,TLIB)		;on library?
	JUMPE B,EDLPR9
	PUSHJ P,LIBTYP
	OUTSTR [ASCIZ / from /]
	OUTSTR NAMBUF
EDLPR9:	OUTSTR [ASCIZ /
Type's package code: /]
	FETCH(T,H,TPAK)
	OUTSTR @PACKNM(T)
	FETCH(G,H,TPROP)
	JUMPE G,[OUTSTR[ASCIZ/
NO BODY DEFINITION PROPERTIES.
/]
		JRST LPROP9]
	OUTSTR[ASCIZ/
BODY DEFINITION PROPERTIES:
/]
	PUSHJ P,LPROPL
LPROP9:	TVON
	POPJ P,

LPROPL:	OUTSTR[ASCIZ/! INDICATES INVISIBLE PROPERTY.
/]
LPROP0:	MOVE C,[" ",," "]	;ASSUME LOCAL
	MOVE B,G
	FETCH(T,G,TXBIT)
	TRNN T,TXBIND
	 JRST LPROP1
	HRLI C,"*"		;INDIRECT
	FETCH(B,B,TXIND)
LPROP1:	TRNE T,TXBDIP
	 HRRI C,"@"
	FETCH(T,B,TXNAM)	;PROPERTY NAME
	JUMPE T,LPROP2		;SKIP TEXT
	OUTCHR C
	MOVSS C
	OUTCHR C
	FETCH(A,B,TXVAL)
	HLRZ A,(A)
	SKIPN A
	 OUTCHR["!"]
	SKIPE A
	 OUTCHR[" "]
	PUSHJ P,OUTTXT		;TYPE PROPERTY NAME
	OUTCHR[":"]
	FETCH(T,B,TXVAL)
	PUSHJ P,OUTTXT
	OUTSTR[ASCIZ/
/]
LPROP2:	HRRZ G,(G)
	JUMPN G,LPROP0
	POPJ P,
;LINE EDIT TEXT
STANFO,<
LODTPN:	FETCH(T,A,TXVAL)
	PUSHJ P,LODED	;LOAD IT
	POPJ P,

TPNTQ:	PUSHJ P,TPNTQA
	POPJ P,
	JRST EDTDL1

BTPNTQ:	PUSHJ P,TPNTQA
	POPJ P,
	JRST BTXDL0

TPNTQA:	PUSHJ P,GETCLS
	JRST PERRET		;NONE
	PUSHJ P,LODTPN
	JRST TPNTZ1

TPNTZ:	PUSHJ P,TPNTZA
	POPJ P,
	JRST EDTDL1

BTPNTZ:	PUSHJ P,TPNTZA
	POPJ P,
	JRST BTXDL0

TPNTZA:	PUSHJ P,GETCLS
	JRST PERRET
	PUSHJ P,LODTPN	;LOAD IT
	PTWRS9	[0
		[BYTE(9)271,271,271,377,0]]	;CTRL1 999 BACKSPACE
TPNTZ1:	PUSHJ P,TXREAD	;READ TEXT BACK
	CAIN C,ALTMOD
	JRST PUTFS	;NO CHANGE
	SKIPN 1(B)
	JRST [	PUSHJ P,PUTFS
		JRST CPOPJ1]
	FETCH(TT,A,TXNAM)
	JUMPN TT,ZSIZOK
	SKIPN T
	MOVE T,STDBIG		;IF TEXT ONLY, MUST HAVE SIZE
ZSIZOK:	SKIPGE T
	MOVE T,STDBIG		;NO SIZE, USE STANDARD
	HRLM T,(B)		;STO SIZE
	FETCH(T,A,TXVAL)	;OLD VAL
	STORE(B,A,TXVAL)	;REPLACE BY NEW
	MOVE B,T
	PUSHJ P,PUTFS
	TRO MCHG
	FETCH(T,A,TXXY)
	TRNN T,1		;AUTO OFFSET?
	POPJ P,			;NO
	MOVE C,A
	JRST EDTCEN		;TT STILL SETUP FROM TXREAD
>;STANFO
;TEXT, KILL

;KILL (STOP DISPLAYING PROPERTY)
EDTKIL:	PUSHJ P,GETCLS
	JRST PERRET
	TRO MCHG!NEEDCL
	TRZ INMOV
	FETCH(TT,A,TXNAM)	;PROP NAM
	JUMPE TT,EDTDL1		;JUST TEXT, DELETE IT
	FETCH(T,A,TXVAL)
	SKIPN T
	PUSHJ P,FUCKUP
	HRRZS (T)		;0 CHAR SIZE = NO DISPLAY
	POPJ P,

;DELETE PROP FROM TYPE

EDTDEL:	PUSHJ P,GETCLS
	JRST PERRET
	TRO MCHG!NEEDCL
	TRZ INMOV
;FIRST DELETE ALL INDIRECTS FROM BODY'S TO THIS TEXT/PROP
;A = TEXT/PROP BLOCK TO DELETE
EDTDL1:	MOVEI B,DBODPN
FBT1:	PUSHJ P,FBTPTR		;GET NEXT BODY WITH PROP IN A
	 JRST EDTDL2
	FETCH(TT,D,TXNXT)	;PATCH OUT INDIRECT BLOCK
	STORE(TT,C,TXNXT)	
	RETBLK(D,TEXT)
	JRST FBT1

;NEXT DELETE PROP FROM TYPE DEF
EDTDL2:	FETCH(B,A,TXNAM)	;ANY PROP NAME?
	JUMPE B,EDTDL3		;NO, PLAIN TEXT
	PUSH P,A
	MOVE B,A		;PROP BLOCK
	MOVE A,CURBOD
	PUSHJ P,FLSTYP		;CLEAR ANY SPECIAL PROPS
	POP P,A
	FETCH(B,A,TXNAM)
	PUSHJ P,PUTFS		;YES RETURN
EDTDL3:	MOVE C,CURBOD
	FETCH(B,C,TPROP)
	CAMN B,A		;IS IT THE FIRST ONE?
	 JRST EDTKP1		;YES
EDTKP2:	MOVE C,B		;NO, PATCH IT OUT OF LIST
	FETCH(B,C,TXNXT)
	CAME B,A		;IS THIS IT?
	JRST EDTKP2
	FETCH(TT,A,TXNXT)	;RPLACD IT OUT
	STORE(TT,C,TXNXT)	
EDTKP3:	FETCH(B,A,TXVAL)
	PUSHJ P,PUTFS		;RETURN PROP VAL
	RETBLK(A,TEXT)		;RETURN PROP BLOCK
	POPJ P,

EDTKP1:	FETCH(B,A,TXNXT)	;REMOVE FROM HEAD OF PROP LIST
	STORE(B,C,TPROP)
	JRST EDTKP3

;KILL, UNKILL PROP ON BODY

BTXKIL:	PUSHJ P,GETCLS
	JRST PERRET
	TRO MCHG!NEEDCL
	TRZ INMOV
	FETCH(TT,A,TXNAM)	;A PROPERTY?
	JUMPE TT,BTXDL0		;NO, TEXT SO DELETE IT
	FETCH(T,A,TXVAL)	;YES, SO MARK INVISIBLE
	CLEAR(T,TSSIZ)
	POPJ P,

BTXUKL:	PUSHJ P,GETCLS
	JRST PERRET
	FETCH(T,A,TXVAL)
	FETCH(TT,T,TSSIZ)
	JUMPN TT,[TLNN M,DSKACT!MACACT
		OUTSTR[ASCIZ/ALREADY VISIBLE.
/]
		POPJ P,]
	MOVE TT,STDBIG		;SET SIZE TO STANDARD
	STORE(TT,T,TSSIZ)
	POPJ P,			;THIS SHOULDN'T CHANGE PICTURE

;DELETE BODY TEXT/PROP

BTXDEL:	PUSHJ P,GETCLS
	JRST PERRET
	TRO MCHG!NEEDCL
;DELETE BODY TEXT
;A = TEXT/PROP BLOCK TO DELETE
;CLAST = PREVIOUS PTR
;BTBODY = BODY

BTXDL0:	HRL A,CLAST		;LAST PTR IN PROP LIST
BTXDL1:	FETCH(T,A,TXNAM)	;PROPERTY?
	JUMPE T,BTXDL4		;NO, ONLY TEXT, JUST FLUSH IT
	PUSH P,A
	MOVE A,BTBODY
	FETCH(A,A,BTYP)
	PUSHJ P,FPROP		;LOOK FOR THIS PROPERTY(T) IN BODY DEF
	 JRST BTXDL2		;NOT IN DEF, JUST DELETE
	MOVE A,BTBODY		;YES, CONS UP INDIRECT PTR
	PUSHJ P,MAKTXT
	STORE(T,TT,TXIND)
	MOVEI T,TXBIND
	STORE(T,TT,TXBIT)
	FETCH(T,A,BTXT)
	STORE(T,TT,TXNXT)
	STORE(TT,A,BTXT)
	MOVE B,TT
	PUSHJ P,CMPBDT		;POSSIBLY RE-COMPILE NEW VALUE
BTXDL2:	HRRZ B,(P)		;PROP BLOCK
	MOVE A,BTBODY
	PUSHJ P,FLSBDY		;FLUSH SPECIAL PROPS FROM BODY
	POP P,A
	FETCH(B,A,TXNAM)
	PUSHJ P,PUTFS		;RETURN PROP NAME
BTXDL4:	FETCH(B,A,TXVAL)
	PUSHJ P,PUTFS		;RETURN PROP VAL
	HLRZ B,A		;PREV POINTER
	HRRZ TT,(B)
	CAIE TT,(A)		;CORRECT LAST?
	 PUSHJ P,FUCKUP
	FETCH(C,A,TXNXT)
	HRRM C,(B)		;BACK POINTER MAY BE TO BODY
	RETBLK(A,TEXT)
;Now check if entire body list is indirect
	MOVE A,BTBODY
	FETCH(B,A,BTXT)
	JUMPE B,CPOPJ
BTXDL3:	FETCH(T,B,TXBIT)
	TRNN T,TXBIND		;INDIRECT?
	 POPJ P,		;NO, MUST KEEP LIST
	FETCH(B,B,TXNXT)
	JUMPN B,BTXDL3
	FETCH(C,A,BTXT)
	CLEAR(A,BTXT)		;DELETE BODIES PROP LIST, ALL INDIRECT
	JRST TXTREL

;$$D DELETE PROPERTY NAME
BTNPRP:
EDNPRP:	PUSHJ P,GETCLS
	JRST PERRET
	FETCH(B,A,TXNAM)
	JUMPE B,PERRET		;NO PROPERTY NAME, LOSE
	FETCH(T,A,TXVAL)
	FETCH(TT,T,TSSIZ)
	SKIPN TT
	 MOVE TT,STDBIG
	STORE(TT,T,TSSIZ)
	JRST PUTFS

;ALL NEW BODY/BODY DEF PROPERTY/TEXT ROUTINES.

;FPROP - FIND BODY DEF PROPERTY
;T = STRING PROPERTY NAME
;A = TYPE
;SKIP RETURNS
;T =  PROPERTY BLOCK POINTER
; (TTT NOW CONTAINS STRING POINTER)

;FPROPX - FIND PROPERTY NAME IN LIST SUPPLIED
;TTT = BODY OR TYPE DEF PROPERTY LIST POINTER

FPROP:	FETCH(TTT,A,TPROP)
	JUMPE TTT,CPOPJ
FPROPX:	PUSH P,A
	PUSH P,B
	PUSH P,T
FPROP1:	MOVE B,TTT
	FETCH(T,B,TXBIT)
	TRNN T,TXBIND
	JRST FPROP3
	FETCH(B,B,TXIND)
FPROP3:	FETCH(B,B,TXNAM)
	JUMPE B,FPROP2		;JUST TEXT
	MOVE A,(P)
	PUSHJ P,TXTMAT
	JRST FPROP2
	POP P,T			;FOUND
	POP P,B
	POP P,A
	EXCH T,TTT
	JRST CPOPJ1

FPROP2:	HRRZ TTT,(TTT)
	JUMPN TTT,FPROP1
	POP P,T
	POP P,B
	POP P,A
	POPJ P,

;FNDIPT - FIND DIP FROM TYPE
;A = TYPE POINTER 
;SKIP RETURNS 
;T = DIPTYPE BLOCK POINTER 

FNDIPT:	MOVEI T,CDIPTY
	PUSHJ P,FPROP
	 POPJ P,
FNDDP2:	TLO T,400000
	JRST CPOPJ1

;FNDDIP - FIND DIP TYPE FROM BODY OR TYPE
;A = BODY POINTER ,( -1,,TYPE IF TYPE POINTER)
;SKIP RETURNS 
;T = DIPTYPE BLOCK POINTER  (LH NEG IF FOUND ON TYPE)

FNDDIP:	JUMPL A,FNDIPT		;FIND ON TYPE?
	MOVEI T,CDIPTY
	PUSHJ P,BFPROP
	 POPJ P,
	 JRST FNDDP2		;FOUND IN TYPE
	FETCH(TT,T,TXBIT)	;FOUND IN BODY, CHECK FOR INDIRECT
	TRNN TT,TXBIND
	 JRST CPOPJ1
	FETCH(T,T,TXIND)
	JRST FNDDP2		;MARK AS FROM TYPE

CDIPTY:	XWD 0,.+2
	ASCII /DIPTY/
	0
	ASCIZ /PE/
;BFPROP - FIND PROPERTY FOR BODY
;A = BODY POINTER 
;T = STRING PROPERTY NAME 
;SKIP RETURNS 
;T = PROPERTY BLOCK POINTER 
;SKIPS 1 IF FOUND IN BODY DEF (NO INDIRECT LIST IN BODY)
;SKIPS 2 IF FOUND IN BODY (INDIRECT OR DIRECT)

BFPROP:	FETCH(TTT,A,BTXT)
	PUSH P,A
	JUMPE TTT,BFPRP4	;NO BODY PROPERTIES
	PUSH P,B		;YES, (LIST ALSO HAS INDIRECTS TO TYPE PROPERTIES)
	PUSH P,T
BFPRP2:	MOVE B,TTT
	FETCH(T,B,TXBIT)
	TRNN T,TXBIND
	 JRST BFPRP3		;DIRECT PROP
	FETCH(B,B,TXIND)	;NO, INDIRECT FROM TYPE DEF
BFPRP3:	FETCH(B,B,TXNAM)	;PROPERTY NAME
	JUMPE B,BFPRP1
	MOVE A,(P)
	PUSH P,TTT
	PUSHJ P,TXTMAT
	 JRST BFPRP9
	POP P,TTT
	POP P,B			;MATCH STRING
	POP P,B
	POP P,A
	MOVE T,TTT
	JRST CPOPJ2

BFPRP9:	POP P,TTT
BFPRP1:	FETCH(TTT,TTT,TXNXT)
	JUMPN TTT,BFPRP2
	POP P,T
	POP P,B
	POP P,A
	POPJ P,

BFPRP4:	FETCH(A,A,BTYP)		;NO PROPERTIES ON BODY
	PUSHJ P,FPROP		;LOOK IN BODY DEF
	 CAIA
	  AOS -1(P)		;SIGNAL FOUND
	POP P,A
	POPJ P,

;BFCPRP - FIND BODY OR BODY DEF PROPERTY BY CLOSEST MATCH NAME
;TTT = POINTER TO PROPERTY LIST 
;T = RETURNS PROPERTY BLOCK OR INDIRECT POINTER

BFCPRP:	TLNN M,DSKACT!MACACT
	OUTSTR[ASCIZ/PROPERTY NAME (ENOUGH TO UNIQUELY SPECIFY IT)?
/]
	JUMPE TTT,[PUSHJ P,SCARF
		POPJ P,
		JRST NXPROP]
	PUSHJ P,TREADU
	POPJ P,
	JRST NXPROP
	PUSH P,A
	PUSH P,B
	TRZ TFLG		;NO MATCHS YET
EDCPR2:	MOVE A,TTT
	FETCH(B,A,TXBIT)
	TRNN B,TXBIND
	JRST EDCPR4
	FETCH(A,A,TXIND)
EDCPR4:	FETCH(A,A,TXNAM)
	JUMPE A,EDCPR3
	MOVE B,(P)
	ADD A,[POINT 7,1]
	ADD B,[POINT 7,1]
EDCPR5:	PUSHJ P,BTGETB		;GET A MATCH CHARACTER
	JRST EDCPR6		;MATCH
	PUSHJ P,BTGETA		;GET A PROPERTY NAME CHARACTER
	JRST EDCPR3		;NO MATCH
	CAMN T,TT		;MATCH?
	JRST EDCPR5		;YES, LOOP
	JRST EDCPR3		;NO MATCH

EDCPR6:	TROE TFLG		;FLAG ONE FOUND, CHECK FOR MORE THAN ONE
	JRST AMBIGP		;AMBIGUOUS PROPERTY
	MOVEM TTT,BTEXT		;SAVE MATCH HERE
	PUSHJ P,BTGETA		;GET ONE MORE CHAR OF PROPERTY NAME
	JRST EXPROP		;EXACT MATCH, WIN NOW
EDCPR3:	HRRZ TTT,(TTT)
	JUMPN TTT,EDCPR2
EXPROP:	POP P,B
	PUSHJ P,PUTFS
	POP P,A
	MOVE T,BTEXT		;GET MATCH (IF ANY)
	TRNE TFLG		;WAS THERE A MATCH?
	JRST EDCPR7		;YES, PRINT NAME AND RETURN IT
NXPROP:	TLNN M,DSKACT!MACACT
	OUTSTR[ASCIZ/SORRY, NO SUCH PROPERTY.
/]
	POPJ P,

EDCPR7:	TLNE M,DSKACT!MACACT
	JRST CPOPJ1
	PUSH P,T
	MOVE TT,T
	FETCH(TTT,TT,TXBIT)
	TRNN TTT,TXBIND
	JRST EDCPR8
	FETCH(TT,TT,TXIND)
EDCPR8:	FETCH(T,TT,TXNAM)
	PUSHJ P,OUTTCR
	POP P,T
	JRST CPOPJ1

AMBIGP:	POP P,B
	PUSHJ P,PUTFS
	POP P,A
	TLNN M,DSKACT!MACACT
	OUTSTR[ASCIZ/SORRY, AMBIGUOUS PROPERTY NAME.
/]
	POPJ P,

BTGETA:	TLNN A,760000
	JRST [	HRR A,-1(A)
		TRNN A,-1
		POPJ P,
		JRST .+1]
	ILDB T,A
	JUMPE T,CPOPJ
	JRST CPOPJ1

BTGETB:	TLNN B,760000
	JRST [	HRR B,-1(B)
		TRNN B,-1
		POPJ P,
		JRST .+1]
	ILDB TT,B
	JUMPE TT,CPOPJ
	JRST CPOPJ1

;MPROP - MAKE A PROPERTY BLOCK AND ADD TO TYPE DEF
;T = STRING PROPERTY NAME IN T
;A = TYPE
;RETURNS
;T = NEW BLOCK (WITH NO VALUE STRING YET)

MPROP:	PUSHJ P,MAKTXT
	MOVEI TTT,1
	STORE(TTT,TT,TXXY)	;INITIALIZE TO AUTO OFFSET
	CLEAR(TT,TXOFF)		;NO CHAR OFFSET
	STORE(T,TT,TXNAM)
	FETCH(TTT,A,TPROP)
	STORE(TTT,TT,TXNXT)
	STORE(TT,A,TPROP)
	MOVE T,TT
	POPJ P,

;MAKTXT - MAKE TEXT/PROPERTY BLOCK, POINTER RETURNED IN TT

MAKTXT:	PUSH P,A
	GETBLK(TT,TEXT)
	BCLEAR(A,TT,TEXT)
	JRST POPAJ


;FBTPTR - FIND INSTANCE OF PROPERTY/TEXT INDIRECT POINTER
;B = LAST BODY FOUND 
;A = BODY DEF PROPERTY/TEXT BLOCK POINTER 
;SKIP RETURNS
;B = NEW BODY 
;D = POINTER TO INDIRECT BLOCK
;(C = PREVIOUS)

FBTPT1:	FETCH(T,B,BTYP)
	CAME T,CURBOD
	JRST FBTPTR
	MOVEI D,RADDR(B,BTXT,TXNXT)
	JRST FBTPT3

FBTPT2:	FETCH(T,D,TXBIT)
	TRNN T,TXBIND
	JRST FBTPT3		;IGNORE LOCAL PROP/TEXT
	FETCH(T,D,TXIND)	;SEE IF THIS USE OF THE TEXT FROM
	CAMN T,A		;THE TYPE IS THE ONE WE WANT
	JRST CPOPJ1
FBTPT3:	MOVE C,D
	FETCH(D,D,TXNXT)
	JUMPN D,FBTPT2
FBTPTR:	FETCH(B,B,BNXT)
	JUMPN B,FBTPT1
	POPJ P,

;COPLTP - MAKE INDIRECT LIST TO BODY DEF TEXT/PROPERTIES
;A = BODY POINTER 
;(IF E POINTS TO BODY DEF PROPERTY, IT IS CHANGED TO POINT TO INDIRECT BLOCK)
;RETURNS
;E = POSSIBLY UPDATED POINTER TO INDIRECT BLOCK
;T = PTR TO END OF LIST

COPLTP:	FETCH(T,A,BTYP)
	FETCH(TTT,T,TPROP)
	MOVEI T,ADDR(A,BTXT)	;POINT T TO NEW LISTHEAD
	JUMPE TTT,CPOPJ		;LEAVE IF NO BODY DEF LIST TO COPY
CPLTP1:	PUSHJ P,MAKTXT
	HRRM TT,(T)		;LINK IN INDIRECT BLOCK
	MOVEI T,TXBIND		;MARK AS INDIRECT
	STORE(T,TT,TXBIT)
	MOVE T,TT		;GET NEW END OF LIST
	STORE(TTT,TT,TXIND)	;PUT IN INDIRECT POINTER
	CAMN E,TTT		;DOES E POINT TO IT?
	MOVE E,TT		;YES, POINT E TO INDIRECT BLOCK
	HRRZ TTT,(TTT)
	JUMPN TTT,CPLTP1
	POPJ P,

;ASCCOP - MAKE INTERNAL FORMAT STRING FROM ASCIZ STRING
;TT = ASCIZ STRING POINTER 
;RETURNS 
;T = INTERNAL FORMAT STRING POINTER 

ASCCOP:	GETFS(T)
	HRLM T,(P)
	JRST ASCCP2

ASCCP1:	GETFS(TTT)
	HRRZM TTT,(T)
	MOVE T,TTT
ASCCP2:	MOVE TTT,(TT)
	MOVEM TTT,1(T)
	TRNN TTT,376
	JRST ASCCP3
	SKIPE 1(TT)
	AOJA TT,ASCCP1
ASCCP3:	SETZM (T)
	HLRZ T,(P)
	POPJ P,

;GETPRV - GET PREVIOUS LINK POINTER
;T = PTR TO LIST TO SEARCH
;TT = BLOCK TO LOOK FOR
; SKIPS OF FOUND

GETPRV:	JUMPE T,CPOPJ		;??
GETPR1:	HRRZ TTT,(T)
	JUMPE TTT,CPOPJ
	CAMN TT,TTT
	 JRST CPOPJ1
	MOVE T,TTT
	JRST GETPR1

;MERGEP - MERGE PROP LIST INTO BODY'S PROP LIST
;A = PTR TO BODY
;B = PROP LIST TO MERGE

MERGEP:	PUSH P,C
	PUSH P,D
	MOVE D,B		;OLD PROP LIST IN D
PRPCP1:	MOVE C,D		;GET NEXT TEXT/PROP OFF OLD LIST
	FETCH(D,D,TXNXT)
	FETCH(T,C,TXBIT)
	TRNE T,TXBIND
	 JRST PRPCP2
	FETCH(T,C,TXNAM)
	JUMPE T,PRPCP3		;NOT PROP, JUST TEXT
	FETCH(TTT,A,BTXT)	;CHECK IF PROP IS ALREADY ON BODY
	SKIPE TTT		;IF NO PROPS IN NEW BODY, JUST INSERT
	PUSHJ P,FPROPX		;LOOK FOR THIS PROPERTY (T) ALREADY IN BODY (TTT)
	 JRST PRPCP3		;NOT FOUND, INSERT NEW PROPERTY
	FETCH(TTT,T,TXBIT)	;CHECK FOUND DUPLICATE FOR INDIRECT
	TRNN TTT,TXBIND
	 JRST PRPCP2		;NOT INDIRECT, BUG CHECK FOR DUPLICATE PROPERTY ON BODY
;Old local prop matches indirect to TYPE def, clobber the indirect
	PUSH P,A
	MOVE A,C		;NEW PROP
	MOVE B,T		;OLD INDIRECT BLOCK
	PUSHJ P,CPYPRP		;COPY NEW TEXT BLOCK ONTO OLD
	POP P,A
	PUSHJ P,CMPBDT		;CHECK FOR SPECIAL PROPS (A=BODY, B=PROP BLOCK)
	JRST PRPCP2

PRPCP3:	PUSHJ P,MAKTXT
	FETCH(TTT,A,BTXT)	;SIMPLE, JUST ADD TO PROP LIST
	STORE(TTT,TT,TXNXT)	;CONS OLD TEXT/PROP ONTO BODY'S LIST
	STORE(TT,A,BTXT)
	PUSH P,A
	PUSH P,B
	MOVE A,C
	MOVE B,TT
	PUSHJ P,CPYPRP
	POP P,B
	POP P,A
	JRST PRPCP2

PRPCP2:	JUMPN D,PRPCP1		;LOOP IF MORE
	POP P,D
	POP P,C
	POPJ P,

;ADDPRT - ADD PROPERTY TO TYPE
;A = TYPE
;B = PROPERTY
ADDPRT:	FETCH(T,A,TPROP)	;PUT NEW BLOCK ON TYPE
	STORE(T,B,TXNXT)
	STORE(B,A,TPROP)
	PUSHJ P,CMPTYT		;CHECK FOR SPECIAL PROPS
;Now also add indirects to all BODIES
	PUSH P,D
	PUSH P,E
	SKIPN D,DBODPN
	 JRST ADDPR1		;NO BODIES TO INSERT INTO
BTXINS:	FETCH(TTT,D,BTYP)
	CAME TTT,A		;THIS BODY OF OUR TYPE?
	 JRST BTXIN1		;NO
	FETCH(E,D,BTXT)		;YES, GET BODIES CURRENT PROP
	JUMPE E,BTXIN1		;NO CURRENT LIST, DON'T HAVE TO ADD TO IT
	FETCH(T,B,TXNAM)	;PROPERTY NAME
	JUMPE BTXIN2		; ONLY TEXT, MAKE INDIRECT
	FETCH(TTT,D,BTXT)	;BODY PROPERTY LIST
	PUSHJ P,FPROPX		;SEE IF BODY ALREADY HAS THIS PROPERTY
	 JRST BTXIN2		;BODY DOESN'T HAVE IT, ADD IT
	JRST BTXIN1		;BODY ALREADY HAS ONE, DON'T ADD IT

BTXIN2:	PUSHJ P,MAKTXT		;MAKE IND PTR BLK
	MOVEI TTT,TXBIND
	STORE(TTT,TT,TXBIT)	;0 MEANS INDIRECT
	STORE(B,TT,TXIND)	;PTR TO TYPE'S PROP BLOCK
	FETCH(E,D,BTXT)		;ADD INDIRECT TO BODY
	STORE(E,TT,TXNXT)
	STORE(TT,D,BTXT)
BTXIN1:	HRRZ D,(D)		;NEXT BODY
	JUMPN D,BTXINS
ADDPR1:	POP P,E
	POP P,D
	POPJ P,

;TXTREL - RELEASE PROPERTY LIST FROM TYPE OR BODY
; C = PROPERTY LIST

TXTREL:	JUMPE C,CPOPJ		;DONE IF NO TEXT
	PUSH P,A
	PUSH P,B
GIVTXT:	MOVE A,C
	FETCH(B,A,TXBIT)
	TRNE B,TXBIND		;INDIRECT?
	JRST GIVTX1		;YES, NO STRINGS TO FLUSH
	FETCH(B,A,TXNAM)
	PUSHJ P,PUTFS
	FETCH(B,A,TXVAL)
	PUSHJ P,PUTFS
GIVTX1:	FETCH(C,A,TXNXT)
	RETBLK(A,TEXT)
	JUMPN C,GIVTXT
	POP P,B
	POP P,A
	POPJ P,


;CPYPRP - COPY CONTENTS OF ONE TEXT BLOCK ONTO ANOTHER
;A = SOURCE TEXT BLOCK
;B = DESTINATION "

CPYPRP:	FETCH(T,A,TXBIT)
	 STORE(T,B,TXBIT)
	TRNE T,TXBIND
	 JRST [	FETCH(T,A,TXIND)
		 STORE(T,B,TXIND)
		POPJ P,]
	PUSH P,B
	FETCH(T,A,TXNAM)
	PUSHJ P,LSTCOP		;COPY IT OVER
	MOVE T,(P)
	 STORE(B,T,TXNAM)
	FETCH(T,A,TXVAL)
	PUSHJ P,LSTCOP
	MOVE T,(P)
	 STORE(B,T,TXVAL)
	POP P,B
	FETCH(T,A,TXXY)
	 STORE(T,B,TXXY)
	FETCH(T,A,TXOFF)
	 STORE(T,B,TXOFF)
	POPJ P,

;SPECIAL PROPERTIES

DEFINE PROPS
<	PROPS1(PACKAGE,CMPPAK,CLRPAK)
	PROPS1(DIPTYPE,CMPDIP,CLRDIP)
>

DEFINE PROPS1(NAME,COMPILER,CLEARER)
<	[ASCIZ \NAME\]
>
PROPNT:	PROPS

DEFINE PROPS1(NAME,COMPILER,CLEARER)
<	COMPILER
>
PROPX:	PROPS			;SKIPS IF OK

DEFINE PROPS1(NAME,COMPILER,CLEARER)
<	CLEARER
>
PROPCL:	PROPS			;CONTACT, PROP CLEAR

MXPROP__0
DEFINE PROPS1(NAME,COMPILER,CLEARER)
<	MXPROP__MXPROP+1
>
	PROPS

;CLRDIP - REMOVE POSSIBLY OLD DIPDEF LIST
;A = BODY/TYPE (-1 IN LH MEANS TYPE)

CMPDIP:	AOS (P)			;ALWAYS SUCCEEDS
CLRDIP:	JUMPL A,[FETCH(C,A,TDEF)
		PUSHJ P,DDFREL
		CLEAR(A,TDEF)
		POPJ P,]
	FETCH(C,A,BDEF)
	PUSHJ P,DDFREL
	CLEAR(A,BDEF)
	POPJ P,

;CMPBDY,CMPTYP - COMPILE PROPERTIES ON BODY OR TYPE
;A = BODY OR TYPE
;LH A = FLG -1 MEANS TYPE

CMPBDY:	TLZ A,-1
	PUSH P,B
	FETCH(B,A,BTXT)		;ANY PROPS ON BODY
CMPBD3:	JUMPE B,CMPBD1
CMPBD2:	PUSHJ P,CMPIT
	FETCH(B,B,TXNXT)
	JUMPN B,CMPBD2
CMPBD1:	POP P,B
	POPJ P,

CMPTYP:	TLO A,-1
	PUSH P,B
	FETCH(B,A,TPROP)
	JRST CMPBD3

;CMPIT - COMPILE PROPERTY FOR BODY OR TYPE
;A = BODY (0 LH) OR TYPE (-1 LH)
;B = PROPERTY

CMPBDT:	TLZA A,-1		;COMPILE ONE PROP ON BODY
CMPTYT:	TLO A,-1		; "    ON TYPE
CMPIT:	JUMPL A,CMPIT3		;TYPE'S CAN'T HAVE INDIRECT
	FETCH(T,B,TXBIT)	;BODY WITH INDIRECT?
	TRNE T,TXBIND
	 POPJ P,		;DON'T COMPILE PROPS THAT ARE REALLY ON TYPE
CMPIT3:	PUSH P,C
	PUSH P,D
	FETCH(C,B,TXNAM)
	MOVSI D,-MXPROP
CMPIT1:	HRRZ T,PROPNT(D)
	PUSHJ P,MATTXT
	 JRST [	AOBJN D,CMPIT1
		JRST CMPIT4]
	FETCH(C,B,TXVAL)
	PUSHJ P,@PROPX(D)	;A:BODY/TYPE, B:PROP, C:VALUE
	 JRST [	OUTSTR [ASCIZ /
PROPERTY: /]
		FETCH(T,B,TXNAM)
		PUSHJ P,OUTTXT 
		OUTSTR [ASCIZ /, WITH STRANGE VALUE - /]
		FETCH(T,B,TXVAL)
		PUSHJ P,OUTTXT
		JRST CMPIT4]
CMPIT4:	POP P,D
	POP P,C
	POPJ P,

;FLSBDY, FLSTYP - DELETING PROPERTY, CHECK AND FLUSH MAYBE
;A = BODY OR TYPE
;B = PROP BEING FLUSHED

FLSTYP:	TLOA A,-1
FLSBDY:	TLZ A,-1
	PUSH P,C
	PUSH P,D
	FETCH(C,B,TXNAM)
	MOVSI D,-MXPROP
FLSIT1:	HRRZ T,PROPNT(D)
	PUSHJ P,MATTXT
	 JRST FLSIT2
	PUSHJ P,@PROPCL(D)
FLSIT2:	AOBJN D,FLSIT1
	POP P,D
	POP P,C
	POPJ P,

;VERPRP - CHECK BODY, TYPE FOR CONSISTENCY W.R.T. COMPILED SPECIAL PROPS
;A = BODY (0 IN LH), TYPE (-1 IN LH)

;RECMP - RECOMPILE PROPERTY ON BODY/TYPE
;A = BODY/TYPE (LH NEG MEANS TYPE)
;T = STRING NAME OF PROPERTY
;(ONLY RECOMPILES THOSE BODY PROPS THAT ARE LOCAL TO BODY, NOT ON TYPE)

RECMPT:	TLOA A,-1
RECMPB:	TLZ A,-1
RECMP:	JUMPL A,[PUSHJ P,FPROP
		 POPJ P,
		JRST RECMP1]
	PUSHJ P,BFPROP
	 POPJ P,
	 POPJ P,		;FOUND ON TYPE, IGNORE
RECMP1:	MOVE B,T
	JRST CMPIT

CPAKAG:	0,,.+2
	ASCII/PACKA/
	0
	ASCII/GE/

;MATTXT - MATCH ASCIZ AGAINST STRING
;C IS TEXT STRING
;T IS ASCIZ

MATTXT:	MOVE TT,(T)
	CAME TT,1(C)
	POPJ P,
	HRRZ C,(C)
	TRNE TT,376
	JRST [	JUMPE C,CPOPJ
		AOJA T,MATTXT]
	SKIPN C
	AOS (P)
	POPJ P,
>;MD