abyss/top.zap

488 lines
9.6 KiB
Plaintext

.SEGMENT "0"
.FUNCT MORE-SPECIFIC:ANY:0:0
SET 'CLOCK-WAIT,TRUE-VALUE
PRINTR "[Please be more specific.]"
.FUNCT V-PDEBUG:ANY:0:0
ZERO? PRSO /?CCL3
ZERO? IDEBUG /?PRT4
SET 'IDEBUG,0
JUMP ?PRE6
?PRT4: SET 'IDEBUG,1
?PRE6: PRINTC 123
PRINTN IDEBUG
PRINTR "}"
?CCL3: ZERO? P-DBUG /?PRT9
SET 'P-DBUG,0
JUMP ?PRE11
?PRT9: SET 'P-DBUG,1
?PRE11: ZERO? P-DBUG /?CCL8
PRINTR "Find them bugs, boss!"
?CCL8: PRINTR "No bugs left, eh?"
.FUNCT VERB-ALL-TEST:ANY:2:2,O,I,L
LOC O >L
FSET? O,FL-NO-ALL /FALSE
EQUAL? PRSA,V?DROP \?CCL5
FSET? O,FL-WORN /FALSE
EQUAL? L,WINNER /TRUE
RFALSE
?CCL5: EQUAL? PRSA,V?PUT,V?PUT-IN \?CCL12
EQUAL? O,I /FALSE
FSET? O,FL-WORN /FALSE
IN? O,I /FALSE
RTRUE
?CCL12: EQUAL? PRSA,V?TAKE \?CCL21
CALL RT-META-IN?,WINNER,O
ZERO? STACK \FALSE
IN? O,WINNER /FALSE
ZERO? I \?CCL28
CALL RT-META-IN?,O,WINNER
ZERO? STACK \FALSE
?CCL28: FSET? O,FL-WORN /FALSE
FSET? O,FL-TAKEABLE \FALSE
ZERO? I /?CCL36
EQUAL? L,I \FALSE
?CCL36: EQUAL? L,HERE /TRUE
FSET? L,FL-PERSON /TRUE
FSET? L,FL-SURFACE /TRUE
FSET? L,FL-CONTAINER \FALSE
FSET? L,FL-OPEN /TRUE
RFALSE
?CCL21: ZERO? I /TRUE
EQUAL? O,I /FALSE
RTRUE
.FUNCT FIX-HIM-HER-IT:ANY:2:2,PRON,OBJ
ZERO? OBJ \?CCL3
ICALL1 MORE-SPECIFIC
RFALSE
?CCL3: CALL2 ACCESSIBLE?,OBJ
ZERO? STACK \?CCL5
EQUAL? PRON,PRSO \?PRD9
CALL2 EVERYWHERE-VERB?,1
ZERO? STACK /?CTR4
?PRD9: EQUAL? PRON,PRSI \?CCL5
CALL2 EVERYWHERE-VERB?,2
ZERO? STACK \?CCL5
?CTR4: ICALL2 NOT-HERE,OBJ
RFALSE
?CCL5: EQUAL? PRSO,PRON \?CND14
SET 'PRSO,OBJ
ICALL TELL-PRONOUN,OBJ,PRON
?CND14: EQUAL? PRSI,PRON \?CND16
SET 'PRSI,OBJ
ICALL TELL-PRONOUN,OBJ,PRON
?CND16: EQUAL? PRSS,PRON \TRUE
SET 'PRSS,OBJ
ICALL TELL-PRONOUN,OBJ,PRON
RTRUE
.FUNCT TELL-PRONOUN:ANY:2:2,OBJ,PRON
FSET? PRON,TOUCHBIT /FALSE
EQUAL? OPRSO,OBJ /FALSE
EQUAL? PRSA,V?DO? /FALSE
PRINTI "["""
ICALL2 RT-PRINT-DESC,PRON
PRINTI """ meaning "
ICALL2 TELL-THE,OBJ
PRINTR "]"
.FUNCT NO-M-WINNER-VERB?:ANY:0:0
GET NO-M-WINNER-VERB-TABLE,0
INTBL? PRSA,NO-M-WINNER-VERB-TABLE+2,STACK /TRUE
RFALSE
.FUNCT FIND-A-WINNER:ANY:0:1,RM,WHO
ASSIGNED? 'RM /?CND1
SET 'RM,HERE
?CND1: ZERO? QCONTEXT /?CCL5
IN? QCONTEXT,RM \?CCL5
RETURN QCONTEXT
?CCL5: CALL FIND-FLAG,HERE,FL-PERSON,CH-PLAYER >WHO
ZERO? WHO /?CCL9
RETURN WHO
?CCL9: CALL FIND-FLAG,HERE,FL-ALIVE,CH-PLAYER >WHO
ZERO? WHO /FALSE
RETURN WHO
.FUNCT TELL-SAID-TO:ANY:1:1,PER
PRINTI "[said to"
ICALL RT-PRINT-OBJ,PER,K-ART-THE
PRINTC 93
CRLF
RTRUE
.FUNCT QCONTEXT-GOOD?:ANY:0:0
ZERO? QCONTEXT /FALSE
FSET? QCONTEXT,PERSONBIT \FALSE
CALL2 META-LOC,QCONTEXT
EQUAL? HERE,STACK \FALSE
RETURN QCONTEXT
.FUNCT META-LOC:ANY:1:2,OBJ,INV,L
LOC OBJ >L
?PRG1: EQUAL? FALSE-VALUE,OBJ,L /FALSE
EQUAL? L,LOCAL-GLOBALS,GLOBAL-OBJECTS,GENERIC-OBJECTS \?CCL7
RETURN L
?CCL7: IN? OBJ,ROOMS \?CCL9
RETURN OBJ
?CCL9: ZERO? INV /?CND10
FSET? OBJ,INVISIBLE /FALSE
?CND10: SET 'OBJ,L
LOC OBJ >L
JUMP ?PRG1
.FUNCT CANT-UNDO:ANY:0:0
PRINTR "[I can't undo that now.]"
.FUNCT SEE-VERB?:ANY:0:0
EQUAL? PRSA,V?EXAMINE,V?LOOK,V?LOOK-IN /TRUE
EQUAL? PRSA,V?LOOK-ON /TRUE
RFALSE
.FUNCT PERFORM:ANY:1:3,PA,PO,PI,V,OA,OO,OI,OQ,OS,X,?TMP1,?TMP2
SET 'OA,PRSA
SET 'OO,PRSO
SET 'OI,PRSI
ZERO? OO /?CCL3
EQUAL? OO,PI \?CCL3
SET 'OBJ-SWAP,TRUE-VALUE
JUMP ?CND1
?CCL3: ZERO? OI /?CCL7
EQUAL? OI,PO \?CCL7
SET 'OBJ-SWAP,TRUE-VALUE
JUMP ?CND1
?CCL7: SET 'OBJ-SWAP,FALSE-VALUE
?CND1: SET 'PRSA,PA
SET 'PRSI,PI
SET 'PRSO,PO
ZERO? P-DBUG /?CND10
PRINTI "{Perform: A="
PRINTN PA
ZERO? PO /?CND12
PRINTI "/O="
EQUAL? PRSA,V?WALK \?CCL16
PRINTN PO
JUMP ?CND12
?CCL16: ICALL2 TELL-D-LOC,PO
?CND12: ZERO? PI /?CND17
PRINTI "/I="
ICALL2 TELL-D-LOC,PI
?CND17: ZERO? PRSQ /?CND19
PRINTI "/Q="
PRINTN PRSQ
?CND19: ZERO? PRSS /?CND21
PRINTI "/S="
ICALL2 TELL-D-LOC,PRSS
?CND21: PRINTI "}
"
?CND10: SET 'V,FALSE-VALUE
ZERO? PRSS /?CND23
ICALL2 THIS-IS-IT,PRSS
?CND23: ZERO? PRSI /?CND25
ICALL2 THIS-IS-IT,PRSI
?CND25: ZERO? PRSO /?CND27
EQUAL? PRSA,V?TELL /?CND27
EQUAL? PRSA,V?WALK /?CND27
ICALL2 THIS-IS-IT,PRSO
?CND27: EQUAL? WINNER,PLAYER /?CND32
ICALL2 THIS-IS-IT,WINNER
?CND32: SET 'PO,PRSO
SET 'PI,PRSI
CALL1 NO-M-WINNER-VERB?
ZERO? STACK \?CND34
GETP WINNER,P?ACTION
CALL D-APPLY,STR?49,STACK,M-WINNER >V
?CND34: ZERO? PRSS /?CND37
ZERO? V \?CND39
GETP PRSS,P?ACTION
CALL D-APPLY,STR?50,STACK,M-SUBJ >V
?CND39: ZERO? V \?CND41
ZERO? PRSQ /?CND41
GET ACTIONS,PA >?TMP2
ADD QACTIONS,2 >?TMP1
GET QACTIONS,0
INTBL? ?TMP2,?TMP1,STACK >X \?CND41
GET X,2
CALL D-APPLY,STR?51,STACK >V
?CND41: ZERO? V \?CND47
ZERO? PRSQ /?CCL51
GET ACTIONS,PA >?TMP2
ADD QACTIONS,2 >?TMP1
GET QACTIONS,0
INTBL? ?TMP2,?TMP1,STACK >X \?CND52
GET X,1 >X
ZERO? X /?CND52
CALL D-APPLY,FALSE-VALUE,X >V
?CND52: ZERO? V \?CND47
GET ACTIONS,PRSQ
CALL D-APPLY,FALSE-VALUE,STACK >V
JUMP ?CND47
?CCL51: ICALL D-APPLY,FALSE-VALUE,V-STATEMENT
?CND47: EQUAL? M-FATAL,V \?CND58
SET 'P-CONT,-1
?CND58: SET 'PRSA,OA
SET 'PRSO,OO
SET 'PRSI,OI
RETURN V
?CND37: ZERO? V \?CND60
LOC WINNER
IN? STACK,ROOMS /?CND60
LOC WINNER
GETP STACK,P?ACTION
CALL D-APPLY,STR?52,STACK,M-BEG >V
?CND60: ZERO? V \?CND64
GETP HERE,P?ACTION
CALL D-APPLY,STR?52,STACK,M-BEG >V
?CND64: ZERO? V \?CND66
GET PREACTIONS,PA
CALL D-APPLY,STR?51,STACK >V
?CND66: SET 'NOW-PRSI,1
ZERO? V \?CND68
ZERO? PI /?CND68
EQUAL? PRSA,V?WALK /?CND68
LOC PI
ZERO? STACK /?CND68
LOC PI
GETP STACK,P?CONTFCN >V
ZERO? V /?CND68
CALL D-APPLY,STR?53,V,M-CONTAINER >V
?CND68: ZERO? V \?CND76
ZERO? PI /?CND76
EQUAL? PI,GLOBAL-HERE \?CND80
GETP HERE,P?ACTION
CALL D-APPLY,STR?54,STACK >V
?CND80: ZERO? V \?CND76
GETP PI,P?ACTION
CALL D-APPLY,STR?54,STACK >V
?CND76: SET 'NOW-PRSI,0
ZERO? V \?CND84
ZERO? PO /?CND84
EQUAL? PRSA,V?WALK /?CND84
LOC PO
ZERO? STACK /?CND84
LOC PO
GETP STACK,P?CONTFCN >V
ZERO? V /?CND84
CALL D-APPLY,STR?53,V,M-CONTAINER >V
?CND84: ZERO? V \?CND92
ZERO? PO /?CND92
EQUAL? PRSA,V?WALK /?CND92
EQUAL? PO,GLOBAL-HERE \?CND97
GETP HERE,P?ACTION
CALL D-APPLY,STR?55,STACK >V
?CND97: ZERO? V \?CND92
GETP PO,P?ACTION
CALL D-APPLY,STR?55,STACK >V
?CND92: ZERO? V \?CND101
GET ACTIONS,PA
CALL D-APPLY,FALSE-VALUE,STACK >V
?CND101: EQUAL? M-FATAL,V \?CND104
SET 'P-CONT,-1
?CND104: SET 'PRSA,OA
SET 'PRSO,OO
SET 'PRSI,OI
RETURN V
.FUNCT TELL-TOO-DARK:ANY:0:0
PRINT TOO-DARK
RETURN M-FATAL
.FUNCT ITAKE-CHECK:ANY:2:2,OBJ,BITS,TAKEN,V
CALL HELD?,OBJ,WINNER
ZERO? STACK \FALSE
EQUAL? OBJ,TH-HANDS,ROOMS /FALSE
FSET? OBJ,FL-TRY-TAKE /?CND6
CALL RT-META-IN?,OBJ,WINNER
ZERO? STACK /?CND6
CALL RT-META-IN?,WINNER,OBJ
ZERO? STACK \?CND6
BTST BITS,32 \?CND6
CALL ITAKE,OBJ,FALSE-VALUE >V
ZERO? V /?CND6
EQUAL? V,M-FATAL /?CND6
SET 'TAKEN,TRUE-VALUE
?CND6: ZERO? TAKEN \FALSE
BTST BITS,64 \FALSE
ICALL2 THIS-IS-IT,OBJ
PRINTC 91
ICALL RT-PRINT-OBJ,WINNER,K-ART-THE,TRUE-VALUE,STR?56
PRINTI "n't holding"
ICALL RT-PRINT-OBJ,OBJ,K-ART-THE
PRINTR ".]"
.FUNCT TELL-D-LOC:ANY:1:1,OBJ
PRINTD OBJ
IN? OBJ,GLOBAL-OBJECTS \?CCL3
PRINTI "(gl)"
JUMP ?CND1
?CCL3: IN? OBJ,LOCAL-GLOBALS \?CCL5
PRINTI "(lg)"
JUMP ?CND1
?CCL5: IN? OBJ,ROOMS \?CND1
PRINTI "(rm)"
?CND1: EQUAL? OBJ,INTNUM \FALSE
PRINTC 40
PRINTN P-NUMBER
PRINTC 41
RTRUE
.FUNCT D-APPLY:ANY:2:3,STR,FCN,FOO,RES
ZERO? FCN /FALSE
ZERO? P-DBUG /?CND4
ZERO? STR \?CCL8
PRINTI "{Action:}
"
JUMP ?CND4
?CCL8: PRINTC 123
PRINT STR
EQUAL? STR,STR?49 \?CND9
PRINTC 61
ICALL2 RT-PRINT-DESC,WINNER
?CND9: PRINTI ": "
?CND4: ZERO? FOO /?CCL13
CALL FCN,FOO >RES
JUMP ?CND11
?CCL13: CALL FCN >RES
?CND11: ZERO? P-DBUG /?CND14
ZERO? STR /?CND14
EQUAL? M-FATAL,RES /?CTR19
EQUAL? P-CONT,-1 \?CCL20
?CTR19: PRINTI "Fatal}
"
RETURN RES
?CCL20: ZERO? RES \?CCL24
PRINTI "Not handled}
"
RETURN RES
?CCL24: PRINTI "Handled}
"
?CND14: RETURN RES
.FUNCT CAPITAL-NOUN?:ANY:1:1,NAM
EQUAL? NAM,W?COFFEY,W?LINDSEY /TRUE
RFALSE
.FUNCT NOT-HERE:ANY:1:2,OBJ,CLOCK
ZERO? CLOCK \?CND1
SET 'CLOCK-WAIT,TRUE-VALUE
PRINTC 91
?CND1: ICALL RT-PRINT-OBJ,OBJ,K-ART-THE,TRUE-VALUE,STR?56
PRINTI "n't "
CALL2 VISIBLE?,OBJ
ZERO? STACK /?CCL5
PRINTI "close enough"
CALL1 SPEAKING-VERB?
ZERO? STACK /?CND3
PRINTI " to hear you"
JUMP ?CND3
?CCL5: PRINTI "here"
?CND3: PRINTC 46
ICALL2 THIS-IS-IT,OBJ
ZERO? CLOCK \?CND8
PRINTC 93
?CND8: CRLF
RTRUE
.FUNCT SPEAKING-VERB?:ANY:0:0
EQUAL? PRSA,V?ASK-ABOUT,V?TALK-TO,V?TELL /TRUE
EQUAL? PRSA,V?TELL-ABOUT /TRUE
RFALSE
.FUNCT GET-OWNER:ANY:1:1,OBJ,TMP,NP
CALL2 GET-NP,OBJ >NP
ZERO? NP /FALSE
GET NP,4 >TMP
ZERO? TMP \?CTR5
GET NP,1 >TMP
ZERO? TMP /?CCL6
GET TMP,2 >TMP
ZERO? TMP /?CCL6
?CTR5: LESS? 0,TMP \FALSE
GRTR? TMP,LAST-OBJECT /FALSE
RETURN TMP
?CCL6: GETP OBJ,P?OWNER >TMP
ZERO? TMP /FALSE
LESS? 0,TMP \?CCL17
GRTR? TMP,LAST-OBJECT \FALSE
?CCL17: RETURN PLAYER
.FUNCT GET-NP:ANY:0:1,OBJ,PRSI?
SET 'PRSI?,NOW-PRSI
EQUAL? OBJ,FALSE-VALUE,PRSO,PRSI \FALSE
ZERO? OBJ /?CND1
EQUAL? OBJ,PRSO \?CCL7
SET 'PRSI?,FALSE-VALUE
JUMP ?CND1
?CCL7: SET 'PRSI?,TRUE-VALUE
?CND1: ZERO? OBJ-SWAP /?CCL10
ZERO? PRSI? /?CCL13
RETURN PRSO-NP
?CCL13: RETURN PRSI-NP
?CCL10: ZERO? PRSI? /?CCL15
RETURN PRSI-NP
?CCL15: RETURN PRSO-NP
.FUNCT NOUN-USED?:ANY:2:4,OBJ,WD1,WD2,WD3,X
CALL2 GET-NP,OBJ >X
ZERO? X /FALSE
GET X,2 >X
ZERO? X /FALSE
EQUAL? X,WD1,WD2,WD3 /TRUE
RFALSE
.FUNCT ADJ-USED?:ANY:2:4,OBJ,WD1,WD2,WD3,NP,CT
CALL2 GET-NP,OBJ >NP
GET NP,1 >NP
ZERO? NP /?CCL3
GET NP,2
EQUAL? PLAYER,STACK \?CCL6
EQUAL? W?MY,WD1,WD2,WD3 \?CCL6
RETURN W?MY
?CCL6: GET NP,4 >CT
GRTR? CT,0 \?CCL10
ADD NP,10 >NP
INTBL? WD1,NP,CT \?CCL13
RETURN WD1
?CCL13: ZERO? WD2 /FALSE
INTBL? WD2,NP,CT \?CCL18
RETURN WD2
?CCL18: ZERO? WD3 /FALSE
INTBL? WD3,NP,CT \FALSE
RETURN WD3
?CCL10: EQUAL? WD1,FALSE-VALUE /TRUE
RFALSE
?CCL3: EQUAL? WD1,FALSE-VALUE /TRUE
RFALSE
.ENDSEG
.ENDI