"PARSER for
SUSPENSION
(c) Copyright 1982 Infocom, Inc. All Rights Reserved.
"
"Parser global variable convention: All parser globals will
begin with 'P-'. Local variables are not restricted in any
way.
"
<SETG SIBREAKS ".,\"">
<GLOBAL ALWAYS-LIT <>>
<GLOBAL GWIM-DISABLE <>>
<GLOBAL PRSA 0>
<GLOBAL PRSI 0>
<GLOBAL PRSO 0>
<GLOBAL P-ADVERB <>>
<GLOBAL P-ADJECTIVE <>>
<GLOBAL P-OADJECTIVE <>>
<GLOBAL P-OADJ <>>
<GLOBAL P-SPACE 1>
<GLOBAL P-TWOBOTS <>>
<GLOBAL P-TABLE 0>
<GLOBAL P-ONEOBJ 0>
The grammar line found when the most recent command was parsed. (Except for simple direction commands, which are a special case.) See the Grammar tab.
<GLOBAL P-SYNTAX 0>
<GLOBAL P-CCSRC 0>
<GLOBAL P-LEN 0>
<GLOBAL P-DIR 0>
In most Infocom games, HERE is the location of the WINNER. In Suspended, HERE is the robot you are currently commanding. (Technically this is based on ROFF rather than WINNER.)
Why the difference? Because the interpreter always displays HERE in top left of the status line, and in Suspended, that is a robot name.
<GLOBAL HERE 0>
WINNER is the actor in the current command.
For a BOTH command, WINNER is briefly set to the TWOBOTS object. It’s reset to OLD-WINNER at the end of the turn, though, so you won’t see this in the State tab.
<GLOBAL WINNER 0>
<GLOBAL P-LEXV <ITABLE BYTE 120>>
<GLOBAL P-INBUF <ITABLE BYTE 100>>
<GLOBAL P-CONT <>>
<GLOBAL P-IT-OBJECT <>>
<GLOBAL P-IT-LOC <>>
<GLOBAL P-OFLAG <>>
<GLOBAL P-MERGED <>>
<GLOBAL P-ACLAUSE <>>
<GLOBAL P-ANAM <>>
<GLOBAL P-AADJ <>>
<CONSTANT P-PHRLEN 3>
<CONSTANT P-ORPHLEN 7>
<CONSTANT P-RTLEN 3>
<CONSTANT P-LEXWORDS 1>
<CONSTANT P-LEXSTART 1>
<CONSTANT P-LEXELEN 2>
<CONSTANT P-WORDLEN 4>
<CONSTANT P-PSOFF 4>
<CONSTANT P-P1OFF 5>
<CONSTANT P-P1BITS 3>
<CONSTANT P-ITBLLEN 9>
<GLOBAL P-ITBL <TABLE 0 0 0 0 0 0 0 0 0 0>>
<GLOBAL P-OTBL <TABLE 0 0 0 0 0 0 0 0 0 0>>
<GLOBAL P-VTBL <TABLE 0 0 0 0>>
<GLOBAL P-NCN 0>
<CONSTANT P-VERB 0>
<CONSTANT P-VERBN 1>
<CONSTANT P-PREP1 2>
<CONSTANT P-PREP1N 3>
<CONSTANT P-PREP2 4>
<CONSTANT P-PREP2N 5>
<CONSTANT P-NC1 6>
<CONSTANT P-NC1L 7>
<CONSTANT P-NC2 8>
<CONSTANT P-NC2L 9>
<GLOBAL QUOTE-FLAG <>>
<GLOBAL SETUP-MODE <>>
" Grovel down the input finding the verb, prepositions, and noun clauses.
If the input is <direction> or <walk> <direction>, fall out immediately
setting PRSA to ,V?WALK and PRSO to <direction>. Otherwise, perform
all required orphaning, syntax checking, and noun clause lookup."
<ROUTINE PARSER ("AUX" (PTR ,P-LEXSTART) WORD (VAL 0) (VERB <>)
LEN (DIR <>) (NW 0) (LW 0) NUM SCNT (CNT -1))
<REPEAT ()
<COND (<G? <SET CNT <+ .CNT 1>> ,P-ITBLLEN> <RETURN>)
<COND (<NOT <VERB? $TELL>> <CRLF>)>)
(T
(T
<SET VERB ,ACT?WALK>
<CRLF>)>
<COND (<NOT <==? <BAND <GETB 0 1> 16> 0>>
<TELL "(FC linked to " D ,WINNER ")">)>
<TELL ">">
<TELL "FC: Communication meaningless." CR>
<RFALSE>)>
<REPEAT ()
<RETURN>)
(<OR <SET WORD <GET ,P-LEXV .PTR>>
<COND (<EQUAL? .WORD ,W?BOTH ,W?TOGETHER>
(<AND <==? .WORD ,W?TO>
<EQUAL? .VERB ,ACT?$TELL>>
<SET WORD ,W?QUOTE>)
(<AND <==? .WORD ,W?THEN>
<NOT .VERB>>
<SET WORD ,W?QUOTE>)>
This check for titles is copied from Deadline. It’s commented out here, since robots always use the informal.
<COND
(<OR <EQUAL? .WORD ,W?THEN ,W?.>
<EQUAL? .WORD ,W?QUOTE>>
<COND (<EQUAL? .WORD ,W?QUOTE>
<RETURN>)
(<AND <SET VAL
,PS?DIRECTION
,P1?DIRECTION>>
<OR <==? .LEN 1>
<AND <==? .LEN 2> <==? .VERB ,ACT?WALK>>
<AND <EQUAL? <SET NW
,W?THEN
,W?QUOTE>
<==? .VERB ,ACT?WALK>
<G? .LEN 2>>
<AND <EQUAL? .NW ,W?.>
<EQUAL? .VERB ,ACT?WALK <>>
<G? .LEN 1>>
<==? .LEN 2>
<EQUAL? .NW ,W?QUOTE>>
<AND <G? .LEN 2>
<==? .VERB ,ACT?WALK>
<EQUAL? .NW ,W?COMMA ,W?AND>>>>
<SET DIR .VAL>
<COND (<EQUAL? .NW ,W?COMMA ,W?AND>
,W?THEN>)>
<COND (<NOT <G? .LEN 2>>
<RETURN>)>)
(<AND <SET VAL <WT? .WORD ,PS?VERB ,P1?VERB>>
<NOT .VERB>>
<SET VERB .VAL>
<SET NUM
<+ <* .PTR 2> 2>>>>
(<OR <SET VAL <WT? .WORD ,PS?PREPOSITION 0>>
<AND <OR <EQUAL? .WORD ,W?ALL ,W?ONE ,W?A>
<EQUAL? .WORD ,W?BOTH>
<WT? .WORD ,PS?ADJECTIVE>
<SET VAL 0>>>
<COND (<AND <G? ,P-LEN 0>
,W?OF>
<0? .VAL>
<NOT
<EQUAL? .WORD ,W?ALL ,W?ONE ,W?A>>
<NOT <EQUAL? .WORD ,W?BOTH>>>)
(<AND <NOT <0? .VAL>>
<EQUAL? <GET ,P-LEXV <+ .PTR 2>>
,W?THEN ,W?.>>>
<TELL
"FC: I found too many nouns in that sentence." CR>
<RFALSE>)
(T
<OR <SET PTR <CLAUSE .PTR .VAL .WORD>>
<RFALSE>>
<COND (<L? .PTR 0>
<RETURN>)>)>)
This adverb check is copied from Deadline and Starcross. It’s only active in Deadline, though.
(<WT? .WORD ,PS?BUZZ-WORD>)
(T
<RFALSE>)>)
(T
<RFALSE>)>
<SET LW .WORD>
<COND (.DIR
<RETURN T>)>
T)>>
<ROUTINE ACTOR-CHANGE ()
<REPEAT ()
<CRLF>
<RTRUE>)>>>
<GLOBAL P-WALK-DIR <>>
<ROUTINE WT? (PTR BIT "OPTIONAL" (B1 5) "AUX" (OFFST ,P-P1OFF) TYP)
<COND (<BTST <SET TYP <GETB .PTR ,P-PSOFF>> .BIT>
<COND (<G? .B1 4> <RTRUE>)
(T
<COND (<NOT <==? .TYP .B1>> <SET OFFST <+ .OFFST 1>>)>
<GETB .PTR .OFFST>)>)>>
<ROUTINE CLAUSE (PTR VAL WORD "AUX" OFF NUM (ANDFLG <>) (FIRST?? T) NW (LW 0))
#DECL ((PTR VAL OFF NUM) FIX (WORD NW) <OR FALSE FIX TABLE>
(ANDFLG FIRST??) <OR ATOM FALSE>)
<SET OFF <* <- ,P-NCN 1> 2>>
<COND (<NOT <==? .VAL 0>>
<PUT ,P-ITBL <+ .NUM 1> .WORD>
<COND (<EQUAL? <GET ,P-LEXV .PTR> ,W?THE ,W?A ,W?AN>
<REPEAT ()
<RETURN -1>)>
<COND (<OR <SET WORD <GET ,P-LEXV .PTR>>
<COND (<0? ,P-LEN> <SET NW 0>)
<COND
(<EQUAL? .WORD ,W?AND ,W?COMMA> <SET ANDFLG T>)
(<EQUAL? .WORD ,W?ALL ,W?BOTH ,W?ONE>
<COND (<==? .NW ,W?OF>
(<OR <EQUAL? .WORD ,W?THEN ,W?.>
<AND <WT? .WORD ,PS?PREPOSITION>
<NOT .FIRST??>>>
<+ .NUM 1>
(<AND .ANDFLG
<OR <WT? .WORD ,PS?DIRECTION>
<SET PTR <- .PTR 4>>
<PUT ,P-LEXV <+ .PTR 2> ,W?THEN>
,PS?ADJECTIVE
,P1?ADJECTIVE>
<NOT <==? .NW 0>>
(<AND <NOT .ANDFLG>
<NOT <EQUAL? .NW ,W?BUT ,W?EXCEPT>>
<NOT <EQUAL? .NW ,W?AND ,W?COMMA>>>
<+ .NUM 1>
<REST ,P-LEXV <* <+ .PTR 2> 2>>>
<RETURN .PTR>)
(T <SET ANDFLG <>>)>)
(<OR <WT? .WORD ,PS?ADJECTIVE>
<WT? .WORD ,PS?BUZZ-WORD>>)
(<WT? .WORD ,PS?PREPOSITION> T)
(T
<RFALSE>)>)
<SET LW .WORD>
<SET FIRST?? <>>
<ROUTINE NUMBER? (PTR "AUX" CNT BPTR CHR (SUM 0) (TIM <>))
<SET CNT <GETB <REST ,P-LEXV <* .PTR 2>> 2>>
<SET BPTR <GETB <REST ,P-LEXV <* .PTR 2>> 3>>
<REPEAT ()
<COND (<L? <SET CNT <- .CNT 1>> 0> <RETURN>)
(T
<COND (<==? .CHR 58>
<SET TIM .SUM>
<SET SUM 0>)
(<G? .SUM 10000> <RFALSE>)
(<AND <L? .CHR 58> <G? .CHR 47>>
<SET SUM <+ <* .SUM 10> <- .CHR 48>>>)
(T <RFALSE>)>
<SET BPTR <+ .BPTR 1>>)>>
<COND (<G? .SUM 1000> <RFALSE>)
(.TIM
<COND (<L? .TIM 8> <SET TIM <+ .TIM 12>>)
(<G? .TIM 23> <RFALSE>)>
<SET SUM <+ .SUM <* .TIM 60>>>)>
,W?INTNUM>
<GLOBAL P-NUMBER 0>
<ROUTINE ORPHAN-MERGE ("AUX" (CNT -1) TEMP VERB BEG END (ADJ <>) WRD)
#DECL ((CNT TEMP VERB) FIX (BEG END) <PRIMTYPE VECTOR> (WRD) TABLE)
<COND
<RFALSE>)
<RFALSE>)
<0? .TEMP>>
(T <RFALSE>)>)
<0? .TEMP>>
(T <RFALSE>)>)
<COND
(T
<REPEAT ()
<COND (<==? .BEG .END>
<COND (.ADJ
<RETURN>)
(T
<RFALSE>)>)
(<AND <NOT .ADJ>
<BTST <GETB <SET WRD <GET .BEG 0>> ,P-PSOFF>
,PS?ADJECTIVE>>
<SET ADJ .WRD>)
(<OR <BTST <GETB .WRD ,P-PSOFF> ,PS?OBJECT>
<==? .WRD ,W?ONE>>
<COND (<NOT <EQUAL? .WRD ,P-ANAM ,W?ONE>> <RFALSE>)
(T
<RETURN>)>)>
<REPEAT ()
<RTRUE>)
T>
<ROUTINE ACLAUSE-WIN (ADJ)
<RTRUE>>
<ROUTINE WORD-PRINT (CNT BUF)
<REPEAT ()
<COND (<DLESS? CNT 0> <RETURN>)
(ELSE
<SET BUF <+ .BUF 1>>)>>>
<ROUTINE UNKNOWN-WORD (PTR "AUX" BUF)
#DECL ((PTR BUF) FIX)
<TELL "FC: I don't know the word '">
<TELL "'." CR>
<ROUTINE CANT-USE (PTR "AUX" BUF)
#DECL ((PTR BUF) FIX)
<TELL "FC: I can't use the word '">
<TELL "' here." CR>
<GLOBAL P-SLOCBITS 0>
<CONSTANT P-SYNLEN 8>
<CONSTANT P-SBITS 0>
<CONSTANT P-SPREP1 1>
<CONSTANT P-SPREP2 2>
<CONSTANT P-SFWIM1 3>
<CONSTANT P-SFWIM2 4>
<CONSTANT P-SLOC1 5>
<CONSTANT P-SLOC2 6>
<CONSTANT P-SACTION 7>
<CONSTANT P-SONUMS 3>
<ROUTINE SYNTAX-CHECK ("AUX" SYN LEN NUM OBJ (DRIVE1 <>) (DRIVE2 <>) PREP VERB TMP)
#DECL ((DRIVE1 DRIVE2) <OR FALSE <PRIMTYPE VECTOR>>
(SYN) <PRIMTYPE VECTOR> (LEN NUM VERB PREP) FIX
(OBJ) <OR FALSE OBJECT>)
<TELL "FC: I can't find a verb in that sentence!" CR>
<RFALSE>)>
<SET SYN <GET ,VERBS <- 255 .VERB>>>
<SET LEN <GETB .SYN 0>>
<SET SYN <REST .SYN>>
<REPEAT ()
<COND (<G? ,P-NCN .NUM> T)
(<AND <NOT <L? .NUM 1>>
<SET DRIVE1 .SYN>)
<COND (<AND <==? .NUM 2> <==? ,P-NCN 1>>
<SET DRIVE2 .SYN>)
<RTRUE>)>)>
<COND (<DLESS? LEN 1>
<COND (<OR .DRIVE1 .DRIVE2> <RETURN>)
(T
<TELL "FC: I don't understand that sentence." CR>
<RFALSE>)>)
<COND (<AND .DRIVE1
<SET OBJ
(<AND .DRIVE2
<SET OBJ
(<EQUAL? .VERB ,ACT?FIND>
<TELL "FC: I can't answer that question." CR>
<RFALSE>)
(T
<TELL "FC: What do you want to ">
<COND (<==? .TMP 0> <TELL "tell">)
<PRINTB <GET .TMP 0>>)
(T
<COND (.DRIVE2
<TELL "?" CR>
<RFALSE>)>>
<ROUTINE CANT-ORPHAN ()
<TELL
"\"FC: That command was incomplete. Why don't you try again?\"" CR>
<RFALSE>>
<ROUTINE ORPHAN (D1 D2 "AUX" (CNT -1))
#DECL ((D1 D2) <OR FALSE <PRIMTYPE VECTOR>>)
<REPEAT ()
<COND (.D1
(.D2
<ROUTINE CLAUSE-PRINT (BPTR EPTR)
<ROUTINE BUFFER-PRINT (BEG END CP "AUX" (NOSP <>) WRD (FIRST?? T) (PN <>))
#DECL ((BEG END) <PRIMTYPE VECTOR> (CP) <OR FALSE ATOM>)
<REPEAT ()
<COND (<==? .BEG .END> <RETURN>)
(T
<COND (.NOSP <SET NOSP <>>)
(T <TELL " ">)>
<COND (<==? <SET WRD <GET .BEG 0>> ,W?.> <SET NOSP T>)
(T
<COND (<AND .FIRST?? <NOT .PN> .CP>
<TELL "the ">)>
(<AND <==? .WRD ,W?IT>
(T
<GETB .BEG 3>>)>
<SET FIRST?? <>>)>)>
<ROUTINE CAPITALIZE (PTR)
<PRINTC <- <GETB ,P-INBUF <GETB .PTR 3>> 32>>
<WORD-PRINT <- <GETB .PTR 2> 1> <+ <GETB .PTR 3> 1>>>
<ROUTINE PREP-PRINT (PREP "AUX" WRD)
#DECL ((PREP) FIX)
<COND (<NOT <0? .PREP>>
<TELL " ">
<COND
(T <PRINTB .WRD>)>)>>
<ROUTINE CLAUSE-COPY (BPTR EPTR "OPTIONAL" (INSRT <>) "AUX" BEG END)
#DECL ((BPTR EPTR) FIX (BEG END) <PRIMTYPE VECTOR>
(INSRT) <OR FALSE TABLE>)
.BPTR
<REPEAT ()
<COND (<==? .BEG .END>
.EPTR
2>>>
<RETURN>)
(T
<COND (<AND .INSRT <==? ,P-ANAM <GET .BEG 0>>>
<ROUTINE CLAUSE-ADD (WRD "AUX" PTR)
#DECL ((WRD) TABLE (PTR) FIX)
<ROUTINE PREP-FIND (PREP "AUX" (CNT 0) SIZE)
#DECL ((PREP CNT SIZE) FIX)
<SET SIZE <* <GET ,PREPOSITIONS 0> 2>>
<REPEAT ()
<COND (<IGRTR? CNT .SIZE> <RFALSE>)
(<==? <GET ,PREPOSITIONS .CNT> .PREP>
<RETURN <GET ,PREPOSITIONS <- .CNT 1>>>)>>>
<ROUTINE SYNTAX-FOUND (SYN)
#DECL ((SYN) <PRIMTYPE VECTOR>)
<GLOBAL P-GWIMBIT 0>
<ROUTINE GWIM (GBIT LBIT PREP "AUX" OBJ)
#DECL ((GBIT LBIT) FIX (OBJ) OBJECT)
<COND (<AND <FSET? .OBJ ,VEHBIT>
<EQUAL? .PREP ,PR?DOWN>>
<SET PREP ,PR?ON>)>
<TELL "(">
<COND (<NOT <0? .PREP>>
<TELL " the ">)>
<TELL D .OBJ ")" CR>
.OBJ)>)
<ROUTINE SNARF-OBJECTS ("AUX" PTR)
#DECL ((PTR) <OR FIX <PRIMTYPE VECTOR>>)
<RTRUE>>
<ROUTINE BUT-MERGE (TBL "AUX" LEN BUTLEN (CNT 1) (MATCHES 0) OBJ NTBL)
#DECL ((TBL NTBL) TABLE (LEN BUTLEN MATCHES) FIX (OBJ) OBJECT)
<REPEAT ()
<COND (<DLESS? LEN 0> <RETURN>)
(T
<SET MATCHES <+ .MATCHES 1>>)>
<SET CNT <+ .CNT 1>>>
.NTBL>
<GLOBAL P-NAM <>>
<GLOBAL P-ADJ <>>
<GLOBAL P-ADJN <>>
<GLOBAL P-ACTORS <ITABLE NONE 20>>
<GLOBAL P-NACTORS 0>
<GLOBAL P-CACTOR 0>
<GLOBAL P-OPLEN 0>
<GLOBAL P-OPCONT 0>
<GLOBAL P-PRSO <ITABLE NONE 50>>
<GLOBAL P-PRSI <ITABLE NONE 50>>
<GLOBAL P-BUTS <ITABLE NONE 50>>
<GLOBAL P-MERGE <ITABLE NONE 50>>
<GLOBAL P-OCLAUSE <ITABLE NONE 50>>
<GLOBAL P-MATCHLEN 0>
<GLOBAL P-GETFLAGS 0>
<CONSTANT P-ALL 1>
<CONSTANT P-ONE 2>
<CONSTANT P-INHIBIT 4>
<GLOBAL P-CSPTR <>>
<GLOBAL P-CEPTR <>>
<ROUTINE SNARFEM (PTR EPTR TBL "AUX" (BUT <>) LEN WV WORD NW)
#DECL ((TBL) TABLE (PTR EPTR) <PRIMTYPE VECTOR> (ANDFLG) <OR ATOM FALSE>
(BUT) <OR FALSE TABLE> (WV) <OR FALSE FIX>)
<SET WORD <GET .PTR 0>>
<REPEAT ()
<COND (<==? .PTR .EPTR> <RETURN <GET-OBJECT <OR .BUT .TBL>>>)
(T
<COND (<EQUAL? .WORD ,W?ALL>
<COND (<==? .NW ,W?OF>
(<EQUAL? .WORD ,W?BUT ,W?EXCEPT>
(<EQUAL? .WORD ,W?A ,W?ONE>
<COND (<==? .NW ,W?OF>
(T
<AND <0? .NW> <RTRUE>>)>)
(<AND <EQUAL? .WORD ,W?AND ,W?COMMA>
<NOT <EQUAL? .NW ,W?AND ,W?COMMA>>>
T)
(<AND <WT? .WORD ,PS?PREPOSITION>
(<WT? .WORD ,PS?BUZZ-WORD>)
(<EQUAL? .WORD ,W?AND ,W?COMMA>)
(<==? .WORD ,W?OF>
(<AND <SET WV <WT? .WORD ,PS?ADJECTIVE ,P1?ADJECTIVE>>
(<WT? .WORD ,PS?OBJECT ,P1?OBJECT>
<COND (<NOT <==? .PTR .EPTR>>
<SET WORD .NW>)>>>
This adjective list is copied over from Starcross!
<ROUTINE ADJ-CHECK ()
<COND (<NOT ,P-ADJ> <RTRUE>)
(T <RTRUE>)>>
<CONSTANT SH 128>
<CONSTANT SC 64>
<CONSTANT SIR 32>
<CONSTANT SOG 16>
<CONSTANT STAKE 8>
<CONSTANT SMANY 4>
<CONSTANT SHAVE 2>
<ROUTINE GET-OBJECT (TBL
"OPTIONAL" (VRB T)
"AUX" LEN XBITS TLEN (GCHECK <>) (OLEN 0))
#DECL ((TBL) TABLE (XBITS TLEN LEN) FIX (GWIM) <OR FALSE FIX>
(VRB GCHECK) <OR ATOM FALSE>)
(T
<COND (.VRB
<TELL "FC: I think that sentence was missing a noun." CR>)>
<RFALSE>)>
<PROG ()
<EQUAL? ,P-NAM ,W?ROBOTS>>
<SET GCHECK T>)>
<COND (.GCHECK
(T
<NOT <0? .LEN>>>
<COND (<NOT <==? .LEN 1>>
<PUT .TBL 1 <GET .TBL <RANDOM .LEN>>>
<TELL "(How about the ">
<PRINTD <GET .TBL 1>>
<TELL "?)" CR>)>
(<OR <G? .LEN 1>
<SET OLEN .LEN>
<PUT .TBL
<AGAIN>)
(T
<COND (<0? .LEN> <SET LEN .OLEN>)>
(.VRB
<TELL "FC: You must supply a noun!" CR>)>
<RFALSE>)>)
(<AND <0? .LEN> .GCHECK>
<COND (.VRB
<TELL " any such">)>
<COND (<OR <EQUAL? ,P-NAM
,W?IRIS
,W?AUDA
,W?WALDO>
,W?WHIZ
,W?SENSA
,W?POET>>
<TELL " robot ">)>
(T
<COND (<OR <EQUAL? ,P-NAM
,W?IRIS
,W?AUDA
,W?WALDO>
,W?WHIZ
,W?SENSA
,W?POET>>
<TELL " ">)
(T <TELL " any">)>
<>>)>
<TELL " here." CR>
)
(T
<TELL "It's too dark to see." CR>)>)>
<RFALSE>)
(<0? .LEN> <SET GCHECK T> <AGAIN>)>
<RTRUE>>>
<ROUTINE WHICH-PRINT (TLEN LEN TBL "AUX" OBJ RLEN TEMPROFF)
<SET RLEN .LEN>
<TELL "FC: Which ">
<TELL " do you mean, ">
<REPEAT ()
<SET TLEN <+ .TLEN 1>>
<SET OBJ <GET .TBL .TLEN>>
<TELL "the ">
<TELL SD .OBJ>)
(T
<TELL D .OBJ>
)>
<COND (<==? .LEN 2>
<COND (<NOT <==? .RLEN 2>> <TELL ",">)>
<TELL " or ">)
(<G? .LEN 2> <TELL ", ">)>
<COND (<L? <SET LEN <- .LEN 1>> 1>
<TELL "?" CR>
<RETURN>)>>>
<ROUTINE GLOBAL-CHECK (TBL "AUX" LEN RMG RMGL (CNT 0) OBJ OBITS FOO)
#DECL ((TBL) TABLE (RMG) <OR FALSE TABLE> (RMGL CNT) FIX (OBJ) OBJECT)
<SET RMGL <- <PTSIZE .RMG> 1>>
<REPEAT ()
<COND (<THIS-IT? <SET OBJ <GETB .RMG .CNT>> .TBL>
<COND (<IGRTR? CNT .RMGL> <RETURN>)>>)>
<SET RMGL <- </ <PTSIZE .RMG> 4> 1>>
<SET CNT 0>
<REPEAT ()
<COND (<==? ,P-NAM <GET .RMG <* .CNT 2>>>
<GET .RMG <+ <* .CNT 2> 1>>>
<SET FOO
<PUT .FOO 0 <GET ,P-NAM 0>>
<PUT .FOO 1 <GET ,P-NAM 1>>
<RETURN>)
(<IGRTR? CNT .RMGL> <RETURN>)>>)>
<TELL
The parser in Suspended is somewhat diegetic. Messages that are normally out-of-world are phrased as if they came from the Filtering Computers. “FC: I don’t know the word ...”
But when you say WHIZ, QUERY ABOUT ..., you’re querying the Computer Library Core, so there’s a whole new set of parser messages. Disambiguation starts with this line, and proceeds to one of the CROWDED or NOT-FOUND messages.
The commented-out lines would force the game clock to advance. Apparently they considered the idea of actually making you hold on a minute (or a turn).
"CLC: Hmm. That's a tough one. Hold on a minute while I try to locate a reference ..." CR>
<CRLF>
<TELL "CLC: ">
1>
<OR <EQUAL? ,P-NAM ,W?WALKWA
,W?MECHAN ,W?BLT>
<EQUAL? ,P-NAM ,W?GLIDER>
,W?TRACK>>>
<SET FOO 1>)>
<COND (<0? .FOO>
(<G? .FOO 1>
<TELL
"I'm afraid you weren't specific enough. One object at a time, and adjectives can be helpful." CR>)
(T
(<VERB? WALK-TO MOVE-ROBOT-TO-LOC EXAMINE FOLLOW
>
Messages for failing to find an object in a QUERY ABOUT action. See this parser code.
<GLOBAL NOT-FOUND <LTABLE
"Nope. Can't find any reference to that one in this mess. Sorry."
"This is very embarrassing, but I can't seem to find that one."
"Sorry, but I don't have any reference to that one.">>
Messages for successfully resolving an ambiguous object in a QUERY ABOUT action. See this parser code.
<GLOBAL CROWDED <LTABLE
"Ah! Here's the tagged object. Sorry about that delay, but it's crowded in here."
"Found it! Sorry, but it sure is a mess in here."
"Here it is! I was beginning to think I was going senile.">>
<ROUTINE MOBY-FIND (TBL "AUX" FOO)
<SET FOO <FIRST? ,ROOMS>>
<REPEAT ()
<COND (<NOT .FOO> <RETURN>)
(T
<SET FOO <NEXT? .FOO>>)>>
<ROUTINE DO-SL (OBJ BIT1 BIT2)
#DECL ((OBJ) OBJECT (BIT1 BIT2) FIX)
(T
(T <RTRUE>)>)>>
<CONSTANT P-SRCBOT 2>
<CONSTANT P-SRCTOP 0>
<CONSTANT P-SRCALL 1>
<ROUTINE SEARCH-LIST (OBJ TBL LVL "AUX" FLS NOBJ)
#DECL ((OBJ NOBJ) <OR FALSE OBJECT> (TBL) TABLE (LVL) FIX (FLS) ANY)
<COND (<SET OBJ <FIRST? .OBJ>>
<REPEAT ()
<VERB? DROP>>
T)
<COND (<AND <OR <VERB? QUERY>
<SET NOBJ <FIRST? .OBJ>>
T)
(T
<SET FLS
<SEARCH-LIST .OBJ
.TBL
<COND (<SET OBJ <NEXT? .OBJ>>) (T <RETURN>)>>)>>
<ROUTINE OBJ-FOUND (OBJ TBL "AUX" PTR)
<RTRUE>)
<NOT <EQUAL? ,P-NAM ,W?ROBOTS>>
<RTRUE>)
<RTRUE>)
(T
<PUT .TBL <+ .PTR 1> .OBJ>
<ROUTINE TAKE-CHECK ()
<ROUTINE ITAKE-CHECK (TBL IBITS "AUX" PTR OBJ TAKEN TEMPROFF)
#DECL ((TBL) TABLE (IBITS PTR) FIX (OBJ) OBJECT
(TAKEN) <OR FALSE FIX ATOM>)
<REPEAT ()
<COND (<L? <SET PTR <- .PTR 1>> 0> <RETURN>)
(T
<SET OBJ <GET .TBL <+ .PTR 1>>>
<COND (<NOT <HELD? .OBJ>>
<SET TAKEN T>)
(<AND <BTST .IBITS ,STAKE>
<SET TAKEN <>>)
(T <SET TAKEN T>)>
<COND (<AND .TAKEN <BTST .IBITS ,SHAVE>>
<COND (<NOT
<TELL "the ">)>
<TELL D .OBJ>
<TELL "." CR>
<RFALSE>)
(<NOT .TAKEN>
"I have taken the liberty of taking the " <>>
<TELL D .OBJ " first." CR>)>)>)>>)
(T)>>
<ROUTINE HELD? (CAN)
<RFALSE>)>
<REPEAT ()
<SET CAN <LOC .CAN>>
<COND (<NOT .CAN> <RFALSE>)
(<==? .CAN ,WINNER> <RTRUE>)>>>
<ROUTINE MANY-CHECK ("AUX" (LOSS <>) TMP)
#DECL ((LOSS) <OR FALSE FIX>)
<SET LOSS 1>)
<SET LOSS 2>)>
<COND (.LOSS
<TELL "FC: I can't use multiple ">
<COND (<==? .LOSS 2> <TELL "in">)>
<TELL "direct objects with '">
<COND (<EQUAL? .TMP 0> <TELL "tell">)
<PRINTB <GET .TMP 0>>)
(T
<TELL "'." CR>
<RFALSE>)
(T)>>
<ROUTINE ZMEMQ (ITM TBL "OPTIONAL" (SIZE -1) "AUX" (CNT 1))
<COND (<NOT .TBL> <RFALSE>)>
<COND (<NOT <L? .SIZE 0>> <SET CNT 0>)
(ELSE <SET SIZE <GET .TBL 0>>)>
<REPEAT ()
<COND (<==? .ITM <GET .TBL .CNT>> <RTRUE>)
(<IGRTR? CNT .SIZE> <RFALSE>)>>>
<ROUTINE ZMEMQB (ITM TBL SIZE "AUX" (CNT 0))
#DECL ((ITM) ANY (TBL) TABLE (SIZE CNT) FIX)
<REPEAT ()
<COND (<==? .ITM <GETB .TBL .CNT>> <RTRUE>)
(<IGRTR? CNT .SIZE> <RFALSE>)>>>
<SETG ALWAYS-LIT <>>
Determine whether a given location has light. This is true if the room or anything in it has ONBIT, or if ALWAYS-LIT is set.
This is a stock bit of Infocom parser code; it is used to set the LIT variable. In Suspended it always returns true.
(It would be simpler if ALWAYS-LIT was set, but Suspended doesn’t do this.)
<ROUTINE LIT? (RM "AUX" OHERE (LIT <>))
#DECL ((RM OHERE) OBJECT (LIT) <OR ATOM FALSE>)
(T
.LIT>
<ROUTINE PRSO-PRINT ("AUX" PTR)
<ROUTINE PRSI-PRINT ("AUX" PTR)