pdefs.zil

"PDEFS file for NEW PARSER
Copyright (C) 1988 Infocom, Inc.  All rights reserved."

<ZZSECTION "PDEFS">

<USE "NEWSTRUC" "PMEM">

<INCLUDE "BASEDEFS">

<FILE-FLAGS MDL-ZIL? ZAP-TO-SOURCE-DIRECTORY?>

"Defaults for ZIL-type DEFSTRUCTs"
<SET-DEFSTRUCT-FILE-DEFAULTS ('START-OFFSET 0) ('NTH ZGET) ('PUT ZPUT)
			     'NODECL>

<BLOCK (<ROOT>)>
ZMEMQ
ZMEMQB
<ENDBLOCK>

<COND (<OR <CHECK-VERSION? XZIP>
	   <CHECK-VERSION? YZIP>>
       <DEFMAC ZMEMQB ('OBJ 'TBL 'LEN)
         <FORM INTBL? .OBJ .TBL .LEN 1>>)
      (T
       <ROUTINE ZMEMQB ZM (OBJ:ANY TBL:TABLE LEN:FIX)
         <REPEAT ((N 0))
		 <COND (<==? <GETB .TBL .N> .OBJ>
			<RETURN <ZREST .TBL .N> .ZM>)>
		 <COND (<G=? <SET N <+ .N 1>> .LEN>
			<RETURN <> .ZM>)>>>)>

<COND (<CHECK-VERSION? ZIP>
       <ROUTINE ZMEMQ (OBJ:ANY TBL:TABLE LEN:FIX)
         <REPEAT ((N 0))
	   <COND (<==? <ZGET .TBL .N> .OBJ>
		  <RETURN <ZREST .TBL <* .N 2>>>)>
	   <COND (<G=? <SET N <+ .N 1>> .LEN>
		  <RETURN <>>)>>>)
      (T
       <DEFMAC ZMEMQ ('OBJ 'TBL 'LEN)
         <FORM INTBL? .OBJ .TBL .LEN>>)>

<SETG20 PDEFS-INTERNAL-OBLIST .OBLIST>

;<MSETG PARSER-ERROR-ARG-PMEM 1>
;<MSETG PARSER-ERROR-ARG-VWORD 2>
<MSETG PARSER-ERROR-TMNOUN 247>
<MSETG PARSER-ERROR-NOOBJ 248>
;<MSETG PARSER-ERROR-NOOBJ2 249>
<MSETG PARSER-ERROR-ORPH-NP 250>
<MSETG PARSER-ERROR-ORPH-S 251>
<MSETG PARSER-ERROR-NOMULT 252>
<MSETG PARSER-ERROR-NOUND 253>
;<MSETG PARSER-ERROR-QUIET 254>

<MSETG PARSER-RESULT-DEAD 0>
<MSETG PARSER-RESULT-FAILED 1>
<MSETG PARSER-RESULT-WON 2>
<MSETG PARSER-RESULT-AGAIN 3>

<MSETG FD-INCLUDE? 1>
<MSETG FD-SEARCH? 2>
<MSETG FD-NEST? 4>
<MSETG FD-NOTOP? 8>

"Definitions for various PMEMs"
<MSETG ADJS-MAX-COUNT 4>
<PM-TYPE ADJS ;1 <+ 4 ,ADJS-MAX-COUNT>
	 (LEXPTR FIX)
	 (POSS ANY ;<OR FALSE OBJECT PMEM ;"noun">)
	 (QUANT <OR FALSE FIX>)
	 (COUNT FIX 0)>
<CONSTANT ORPHAN-ADJS <ITABLE <+ 1 <+ 4 ,ADJS-MAX-COUNT>> 0>>

<MSETG NP-LENGTH 9>
<PM-TYPE NP ;2 ,NP-LENGTH
	 (ADJS <OR FALSE PMEM>)
	 (NAME <OR FALSE VWORD>)
	 (QUANT <OR FALSE FIX>)
	 (OF <OR FALSE PMEM>)
	 (LOC <OR FALSE PMEM>)
	 (EXCEPT <OR FALSE PMEM>)
	 (LEXBEG <OR FALSE FIX>)
	 (LEXEND <OR FALSE FIX>)>
<CONSTANT ORPHAN-NP	<ITABLE <+ 1 ,NP-LENGTH> 0>>
<CONSTANT ORPHAN-NP2	<ITABLE <+ 1 ,NP-LENGTH> 0>>

<PM-TYPE NPP ;3 3
	 (NEXT <OR FALSE PMEM ;NPP>)
	 (NOUN <OR FALSE PMEM ;NP>)
	 (NOUN-PHRASE <OR FALSE PMEM>)>
<PM-TYPE NOUN-PHRASE ;4 <>
	 (COUNT FIX 0)
	 (FLAGS FIX 0)
	 (OBJ1 <OR FALSE FIX ;OBJECT>)
	 (NP1 <OR FALSE PMEM ;NP>)>

<MSETG NP-FLAG-MULTI 1>
;<DEFMAC NP-MULTI? ('NOUN-PHRASE)
  <FORM NOT <FORM 0? <FORM ANDB <FORM NOUN-PHRASE-FLAGS .NOUN-PHRASE>
			   ,NP-FLAG-MULTI>>>>
<MSETG NOUN-PHRASE-ENTLENB 4>
<MSETG NOUN-PHRASE-ENTLEN 2>
<MSETG NOUN-PHRASE-HEADER-LEN 3>
<MSETG NOUN-PHRASE-MIN-LENGTH 4>

<PM-TYPE PP ;5 2
	 (PREP VWORD NONE)
	 (NOUN PMEM ;<OR NP NPP> NONE)>
<PM-TYPE LOCATION ;6 2
	 (PREP VWORD NONE)
	 (OBJECT PMEM NONE)>
<PM-TYPE OBJLIST ;7 <>
	 (SIZE FIX)
	 ;(COUNT <OR FALSE FIX>)
	 (NEXT <OR FALSE PMEM>)
	 (OWNER ANY)	;"for compatibility with FIND-RES"
	 (OBJ1 ANY)>

"NP-QUANT slot"
<MSETG NP-QUANT-NONE <>>
<MSETG NP-QUANT-A 1>
;<MSETG NP-QUANT-SOME 2>
<MSETG NP-QUANT-ALL 3>
<MSETG NP-QUANT-BOTH 4>
<MSETG NP-QUANT-NOTHING 5>
<MSETG NP-QUANT-PLURAL 6>

<ADD-WORD ALL QUANT>
<ADD-WORD A QUANT>
<ADD-WORD AN QUANT>
<ADD-WORD ANY QUANT>
<ADD-WORD EITHER QUANT>
;<ADD-WORD SOME QUANT>	"It's a can of some worms."

<CONSTANT NP-QUANT-TBL-LEN 6>
<CONSTANT NP-QUANT-TBL
    <PTABLE	NP-QUANT-ALL	<VOC "ALL">
		NP-QUANT-BOTH	<VOC "BOTH">
		NP-QUANT-A	<VOC "ONE">
		NP-QUANT-A	<VOC "EITHER">
		NP-QUANT-A	<VOC "ANY">
		;NP-QUANT-SOME	;<VOC "SOME">
		;NP-QUANT-NOTHING ;<VOC "NONE">>>

<GDECL (VALID-VERB-CLASSES VALID-QUESTION-CLASSES) <VECTOR [REST FIX]>>

ADJ-CLASS
NOUN-CLASS

<MSETG FIRST-PERSON 8>
<MSETG PLURAL-FLAG 16>
<MSETG SECOND-PERSON 32>
<MSETG THIRD-PERSON 64>
<MSETG PRESENT-TENSE 256>
<MSETG PAST-TENSE 512>
<MSETG FUTURE-TENSE 1024>
<MSETG POSSESSIVE 16384>
;"<MSETG PERSON-PNF 4096>
<MSETG THING-PNF 8192>
<MSETG DONT-ORPHAN 32768>
<MSETG DEFAULT-OBJECT 65536>"

<COND (<OR <CHECK-VERSION? XZIP>
	   <CHECK-VERSION? YZIP>>
       <DEFMAC ZSUBSTRUC ('OT 'CT 'NT)
         <FORM COPYT .OT .NT <FORM * .CT 2>>>)
      (T
       <ROUTINE ZSUBSTRUC (OT:<PRIMTYPE TABLE> CT:FIX NT:<PRIMTYPE TABLE>)
         <REPEAT ()
		 <COND (<L? <SET CT <- .CT 1>> 0> <RETURN>)>
		 <ZPUT .NT .CT <ZGET .OT .CT>>>
	 .NT>)>

<DEFSTRUCT PARSE-RESULT
	   (TABLE
	    ('PRINTTYPE TABLE-PRINT))
	;0 (PARSE-ADV <OR FALSE VWORD>)
	   (PARSE-VERB <OR FALSE VWORD>)
	   (PARSE-VERB-LEXV <OR FALSE TABLE>)
	;6 (PARSE-SYNTAX <OR FALSE VERB-SYNTAX>)
	   (PARSE-ACTION <OR FALSE FIX>)
	   (PARSE-OBJ1 <OR FALSE PMEM ;NOUN-PHRASE>)
	;12(PARSE-OBJ2 <OR FALSE PMEM>)
	   (PARSE-PARTICLE1 <OR FALSE VWORD>)
	   (PARSE-PARTICLE2 <OR FALSE VWORD>)
	;18(PARSE-LOC <OR FALSE PMEM ;PP>)
	   (PARSE-QW <OR FALSE VWORD>)
	   (PARSE-ADJ <OR FALSE VWORD>)
	;24(PARSE-CHOMPER <OR FALSE PMEM ;NOUN-PHRASE ;OBJECT>)
	   (PARSE-SUBJ <OR FALSE PMEM>)
	   (PARSE-QUERY <OR FALSE VWORD>)
	;30(PARSE-QUERY-SYNTAX <OR FALSE VERB-SYNTAX>)
	   (PARSE-FLAGS FIX)>

<MSETG PARSE-NOT 1>
<MSETG PARSE-QUESTION 2>

<CONSTANT ORPHAN-S <ITABLE 7 0>>
<CONSTANT O-VERB 0 ;<OR FALSE VWORD>>
<CONSTANT O-LEXPTR 1 ;<OR FALSE TABLE>>
<CONSTANT O-SYNTAX 2 ;<OR FALSE VERB-SYNTAX>>
<CONSTANT O-WHICH 3 ;<OR FALSE FIX>>
<CONSTANT O-PART 4 ;<OR FALSE VWORD>>
<CONSTANT O-OBJECT 5 ;<OR FALSE OBJECT>>
<CONSTANT O-SUBJECT 6 ;<OR FALSE OBJECT>>

"Objects are inserted (starting at find-res-obj1 until the vector is full;
 then additional objects go into an objlist allocated from pmem;
 the TOTAL count goes in find-res-count..."

<DEFSTRUCT FIND-RES
	   (TABLE 'NOTYPE)
	   ;(FIND-RES-HEADER FIX 'NONE)
	   (FIND-RES-SIZE FIX 'NONE)	;( 'NTH GETB 'PUT PUTB 'OFFSET 0)
	   (FIND-RES-COUNT FIX 0)	;( 'NTH GETB 'PUT PUTB 'OFFSET 1)
	   (FIND-RES-NEXT <OR PMEM FALSE>)
	   (FIND-RES-OWNER ANY <>)	;"owner found for body part"
	   (FIND-RES-OBJ1 ANY <>)
	   ;(FIND-RES-OBJ2 ANY <>)>

<MSETG FIND-RES-LENGTH 10 ;13>
<MSETG FIND-RES-MAXOBJ 6 ;7>

<CONSTANT SEARCH-RES
	  <MAKE-FIND-RES 'FIND-RES <ITABLE ,FIND-RES-LENGTH 0>
			 'FIND-RES-SIZE ,FIND-RES-MAXOBJ
			 'FIND-RES-COUNT 0>>

<CONSTANT ORPHAN-SR
	  <MAKE-FIND-RES 'FIND-RES <ITABLE ,FIND-RES-LENGTH 0>
			 'FIND-RES-SIZE ,FIND-RES-MAXOBJ
			 'FIND-RES-COUNT 0>>

<CONSTANT OWNER-SR-HERE
	  <MAKE-FIND-RES 'FIND-RES <ITABLE ,FIND-RES-LENGTH 0>
			 'FIND-RES-SIZE ,FIND-RES-MAXOBJ
			 'FIND-RES-COUNT 0>>

<CONSTANT OWNER-SR-THERE
	  <MAKE-FIND-RES 'FIND-RES <ITABLE ,FIND-RES-LENGTH 0>
			 'FIND-RES-SIZE ,FIND-RES-MAXOBJ
			 'FIND-RES-COUNT 0>>

<DEFSTRUCT FINDER
	   TABLE
	;0 (FIND-APPLIC <OR TABLE FIX> 0) ;"Thing to call to check object"
	   (FIND-FLAGS FIX)	;"Gwimming, search globals, etc."
	   (FIND-QUANT <OR FIX FALSE>)	;"All, one, etc."
	;6 (FIND-SYNTAX <OR FALSE VERB-SYNTAX>)
	   (FIND-WHICH FIX)	;"Which argument of the verb we're getting"
	   (FIND-ADJS <OR PMEM FALSE>)
	;12(FIND-NOUN <OR VWORD FALSE>)
	   (FIND-OF <OR FALSE PMEM>)
	   (FIND-EXCEPTIONS <OR PMEM FALSE>)
	;18(FIND-RES <OR FIND-RES FALSE>)
	   ;"Where to put result, whatever it is."
	   (FIND-NUM FIX)>

;"<DEFMAC WT? ('PTR 'BIT 'OPT' 'B1)
  <COND (<AND <TYPE? .BIT GVAL>
	      <=? <MEMBER 'PS?' <SPNAME <CHTYPE .BIT ATOM>>>
		  <SPNAME <CHTYPE .BIT ATOM>>>>
	 <SET BIT <REST <SPNAME <CHTYPE .BIT ATOM>> 3>>)>
  <SET BIT <GET-CLASSIFICATION .BIT>>
  <COND (<OR <NOT <ASSIGNED? B1>>
	     <COMPARE-WORD-TYPES .BIT <GET-CLASSIFICATION NOUN>>>
	 <FORM COMPARE-WORD-TYPES <FORM WORD-CLASSIFICATION-NUMBER .PTR>
	       .BIT>)
	(T
	 <COND (<COMPARE-WORD-TYPES .BIT <GET-CLASSIFICATION ADJ>>
		<COND (T ;<CHECK-EXTENDED?>
			   <FORM COMPARE-WORD-TYPES .BIT
				 <FORM WORD-CLASSIFICATION-NUMBER .PTR>>)
		      ;(T
			   <FORM COND (<FORM COMPARE-WORD-TYPES .BIT
					     <FORM WORD-CLASSIFICATION-NUMBER
						   .PTR>>
				       <FORM WORD-ADJ-ID .PTR>)>)>)
	       (<COMPARE-WORD-TYPES .BIT <GET-CLASSIFICATION VERB>>
		<FORM COND (<FORM COMPARE-WORD-TYPES .BIT
				  <FORM WORD-CLASSIFICATION-NUMBER .PTR>>
			    <FORM WORD-VERB-STUFF .PTR>)>)
	       (<COMPARE-WORD-TYPES .BIT <GET-CLASSIFICATION DIR>>
		<FORM COND (<FORM COMPARE-WORD-TYPES .BIT
				  <FORM WORD-CLASSIFICATION-NUMBER .PTR>>
			    <FORM WORD-DIR-ID .PTR>)>)
	       (T
		<FORM COMPARE-WORD-TYPES .BIT
		      <FORM WORD-CLASSIFICATION-NUMBER .PTR>>)>)>>"

<DEFMAC OBJECT? ('N)
	<FORM AND <FORM L? 0 .N> <FORM L=? .N ',LAST-OBJECT>>>

<END-DEFINITIONS>