zorkzero/pdefs.zil

297 lines
8.3 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

"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>