84 lines
4.4 KiB
Plaintext
84 lines
4.4 KiB
Plaintext
<FLAGS-AND-DEFAULTS (("P-ZORK0" %<>)("ONE-BYTE-PARTS-OF-SPEECH" %<>)(
|
|
"WORD-FLAGS-IN-TABLE" T)("IN-ZILCH" T)("P-APOSTROPHE-BREAKS-WORDS" T)(
|
|
"P-BE-VERB" T)) (("SETUP-ORPHAN-NP" "DEFS" #WORD *32734731554*) (
|
|
"WINNER-SAYS-WHICH?" "DEFS" #WORD *11064457026*) ("REFRESH" "DEFS" #WORD
|
|
*26533721703*))>
|
|
|
|
<ZZPACKAGE "PARSER">
|
|
<RENTRY PRINT-LEXV TELL-CTHE TELL-THE>
|
|
<INCLUDE "BASEDEFS" "PBITDEFS" "PDEFS">
|
|
<USE "PMEM" "PSTACK" "REDS">
|
|
<FILE-FLAGS MDL-ZIL? CLEAN-STACK?>
|
|
<BEGIN-SEGMENT 0>
|
|
<DEFAULTS-DEFINED CANT-FIND-OBJECT CANT-USE-MULTIPLE DONT-UNDERSTAND
|
|
PRINT-INTQUOTE PRINT-LEXV REFRESH SETUP-ORPHAN SETUP-ORPHAN-NP TOO-MANY-NOUNS
|
|
WHICH-LIST? WHICH-PRINT WINNER-SAYS-WHICH? YES?>
|
|
<DEFINE-ROUTINE TOO-MANY-NEW>
|
|
<DEFINE-ROUTINE NAKED-OOPS>
|
|
<DEFINE-ROUTINE CANT-OOPS>
|
|
<DEFINE-ROUTINE CANT-AGAIN>
|
|
<DEFAULT-DEFINITION CANT-USE-MULTIPLE <ROUTINE CANT-USE-MULTIPLE>>
|
|
<DEFINE-ROUTINE MAKE-ROOM-FOR-TOKENS>
|
|
<DEFINE-ROUTINE REPLACE-ONE-TOKEN>
|
|
<DEFAULT-DEFINITION REFRESH <DEFINE V-$REFRESH () <LOWCORE FLAGS <BAND <LOWCORE
|
|
FLAGS> <BCOM ,F-REFRESH>>> <CLEAR -1> <INIT-STATUS-LINE> <RTRUE>>>
|
|
<DEFAULT-DEFINITION PRINT-INTQUOTE <ROUTINE PRINT-INTQUOTE>>
|
|
<DEFAULT-DEFINITION PRINT-LEXV <ROUTINE PRINT-LEXV>>
|
|
<DEFINE-ROUTINE COPY-INPUT>
|
|
<COND (<NOT <OR <CHECK-VERSION? XZIP> <CHECK-VERSION? YZIP>>> <DEFINE
|
|
COPY-INBUF (SRC DEST "AUX" CNT:FIX) <SET CNT <- <GETB .SRC 0> 1>> <REPEAT () <
|
|
PUTB .DEST .CNT <GETB .SRC .CNT>> <COND (<L? <SET CNT <- .CNT 1>> 0> <RETURN>)>
|
|
>> <DEFINE COPY-LEXV (SRC DEST "OPT" (MAX:FIX ,LEXV-LENGTH) "AUX" (CTR:FIX 1))
|
|
<PUTB .DEST 0 <GETB .SRC 0>> <PUTB .DEST 1 <GETB .SRC 1>> <SET DEST <ZREST .
|
|
DEST <* ,P-LEXSTART:FIX 2>>> <SET SRC <ZREST .SRC <* ,P-LEXSTART:FIX 2>>> <
|
|
REPEAT () <ZPUT .DEST 0 <ZGET .SRC 0>> <PUTB .DEST 2 <GETB .SRC 2>> <PUTB .DEST
|
|
3 <GETB .SRC 3>> <COND (<G? <SET CTR <+ .CTR 1>> .MAX> <RETURN>)> <SET DEST <
|
|
ZREST .DEST <* 2 ,P-LEXELEN:FIX>>> <SET SRC <ZREST .SRC <* 2 ,P-LEXELEN:FIX>>>>
|
|
>)>
|
|
<END-SEGMENT>
|
|
<BEGIN-SEGMENT 0>
|
|
<ADD-WORD NO.WORD ADJ>
|
|
<DEFINE-ROUTINE BUFFER-PRINT>
|
|
<DEFINE-ROUTINE CAPITALIZE>
|
|
<DEFINE-ROUTINE PRINT-PARSER-FAILURE>
|
|
<DEFINE-ROUTINE NAKED-ADJECTIVE?>
|
|
<DEFINE-ROUTINE CHANGE-AND-TO-THEN?>
|
|
<DEFAULT-DEFINITION DONT-UNDERSTAND <ROUTINE DONT-UNDERSTAND>>
|
|
<DEFINE-ROUTINE MISSING>
|
|
<DEFAULT-DEFINITION CANT-FIND-OBJECT <ROUTINE CANT-FIND-NPP> <ROUTINE
|
|
CANT-FIND-OBJECT> <ROUTINE NP-CANT-SEE>>
|
|
<DEFAULT-DEFINITION WINNER-SAYS-WHICH? <DEFINE WINNER-SAYS-WHICH? (NP) <>>>
|
|
<DEFAULT-DEFINITION WHICH-LIST? <ROUTINE WHICH-LIST?>>
|
|
<DEFAULT-DEFINITION WHICH-PRINT <ROUTINE WHICH-PRINT>>
|
|
<DEFINE-ROUTINE NP-PRINT>
|
|
<DEFINE-ROUTINE ADJS-PRINT>
|
|
<DEFAULT-DEFINITION TOO-MANY-NOUNS <ROUTINE TOO-MANY-NOUNS>>
|
|
<DEFINE-ROUTINE INBUF-ADD>
|
|
<DEFINE-ROUTINE INBUF-PRINT>
|
|
<DEFAULT-DEFINITION YES? <CONSTANT YES-INBUF <ITABLE 19 (BYTE LENGTH) 0>> <
|
|
CONSTANT YES-LEXV <ITABLE 3 (LEXV) 0 0>> <DEFINE YES? ("OPT" (NO-Q <>) "AUX"
|
|
WORD VAL) <COND (<NOT .NO-Q> <TELL !\?>)> <REPEAT () <TELL "|>"> <COND (T <PUTB
|
|
,YES-INBUF 1 0>)> <COND (,DEMO-VERSION? <READ-DEMO ,YES-INBUF ,YES-LEXV>) (T <
|
|
ZREAD ,YES-INBUF ,YES-LEXV>)> <COND (<AND <NOT <0? <GETB ,YES-LEXV ,P-LEXWORDS>
|
|
>> <SET WORD <ZGET ,YES-LEXV ,P-LEXSTART>>> <COND (<COMPARE-WORD-TYPES <
|
|
WORD-CLASSIFICATION-NUMBER .WORD> <GET-CLASSIFICATION VERB>> <SET VAL <
|
|
WORD-VERB-STUFF .WORD>>) (T <SET VAL <>>)> <COND (<EQUAL? .VAL ,ACT?YES> <SET
|
|
VAL T> <RETURN>) (<OR <EQUAL? .VAL ,ACT?NO> <EQUAL? .WORD ,W?N>> <SET VAL <>> <
|
|
RETURN>) (<EQUAL? .VAL ,ACT?RESTART> <V-RESTART>) (<EQUAL? .VAL ,ACT?RESTORE> <
|
|
V-RESTORE>) (<EQUAL? .VAL ,ACT?QUIT> <V-QUIT>)>)> <TELL
|
|
"[Please type YES or NO.]">> .VAL>>
|
|
<DEFAULT-DEFINITION SETUP-ORPHAN <ROUTINE SETUP-ORPHAN>>
|
|
<DEFAULT-DEFINITION SETUP-ORPHAN-NP <DEFINE SETUP-ORPHAN-NP (STR OBJ1 OBJ2
|
|
"OPT" (OBJ3 <>) "AUX" NUM VEC) <DIROUT ,D-TABLE-ON ,O-INBUF> <TELL .STR> <
|
|
DIROUT ,D-TABLE-OFF> <PUTB ,O-INBUF 0 ,INBUF-LENGTH> <LEX ,O-INBUF ,O-LEXV> <
|
|
COND (<ZERO? <SET NUM <GETB ,O-LEXV ,P-LEXWORDS>>> <>) (<INTBL? 0 <ZREST ,
|
|
O-LEXV <* 2 ,P-LEXSTART>> .NUM 132> <>) (T <SETG P-OFLAG <- 1 <* ,P-LEXELEN <
|
|
GETB ,O-LEXV ,P-LEXWORDS>>>> <ZPUT ,OOPS-TABLE ,O-END <+ 2 <GETB ,O-INBUF 1>>>
|
|
<ZPUT ,OOPS-TABLE ,O-AGAIN <ZREST ,P-LEXV <* 2 ,P-LEXSTART>>> <SET VEC <
|
|
REST-TO-SLOT ,ORPHAN-SR FIND-RES-OBJ1>> <ZPUT .VEC 0 .OBJ1> <ZPUT .VEC 1 .OBJ2>
|
|
<SET NUM 2> <COND (<T? .OBJ3> <INC NUM> <ZPUT .VEC 2 .OBJ3>)> <FIND-RES-COUNT ,
|
|
ORPHAN-SR .NUM> T)>>>
|
|
<DEFINE-ROUTINE INSERT-ADJS>
|
|
<DEFINE-ROUTINE INSERT-ADJS-WD>
|
|
<END-SEGMENT>
|
|
<ENDPACKAGE> |