1746 lines
37 KiB
Plaintext
1746 lines
37 KiB
Plaintext
|
|
|
|
.FUNCT PARSER:ANY:0:0,PTR,WRD,VAL,VERB,OF-FLAG,OWINNER,OMERGED,LEN,DIR,NW,LW,CNT,?TMP2,?TMP1
|
|
SET 'PTR,P-LEXSTART
|
|
SET 'CNT,-1
|
|
?PRG1: IGRTR? 'CNT,P-ITBLLEN /?REP2
|
|
ZERO? P-OFLAG \?CND6
|
|
GET P-ITBL,CNT
|
|
PUT P-OTBL,CNT,STACK
|
|
?CND6: PUT P-ITBL,CNT,0
|
|
JUMP ?PRG1
|
|
?REP2: SET 'OWINNER,WINNER
|
|
SET 'OMERGED,P-MERGED
|
|
SET 'P-ADVERB,FALSE-VALUE
|
|
SET 'P-MERGED,FALSE-VALUE
|
|
SET 'P-END-ON-PREP,FALSE-VALUE
|
|
PUT P-PRSO,P-MATCHLEN,0
|
|
PUT P-PRSI,P-MATCHLEN,0
|
|
PUT P-BUTS,P-MATCHLEN,0
|
|
ZERO? QUOTE-FLAG \?CND8
|
|
EQUAL? WINNER,PLAYER /?CND8
|
|
SET 'WINNER,PLAYER
|
|
CALL2 META-LOC,PLAYER >HERE
|
|
CALL2 LIT?,HERE >LIT
|
|
?CND8: ZERO? RESERVE-PTR /?CCL14
|
|
SET 'PTR,RESERVE-PTR
|
|
ICALL STUFF,RESERVE-LEXV,P-LEXV
|
|
ZERO? SUPER-BRIEF \?CND15
|
|
EQUAL? PLAYER,WINNER \?CND15
|
|
CRLF
|
|
?CND15: SET 'RESERVE-PTR,FALSE-VALUE
|
|
SET 'P-CONT,FALSE-VALUE
|
|
JUMP ?CND12
|
|
?CCL14: ZERO? P-CONT /?CCL20
|
|
SET 'PTR,P-CONT
|
|
ZERO? SUPER-BRIEF \?CND21
|
|
EQUAL? PLAYER,WINNER \?CND21
|
|
EQUAL? PRSA,V?SAY /?CND21
|
|
CRLF
|
|
?CND21: SET 'P-CONT,FALSE-VALUE
|
|
JUMP ?CND12
|
|
?CCL20: SET 'WINNER,PLAYER
|
|
SET 'QUOTE-FLAG,FALSE-VALUE
|
|
LOC WINNER
|
|
FSET? STACK,VEHBIT /?CND26
|
|
LOC WINNER >HERE
|
|
?CND26: CALL2 LIT?,HERE >LIT
|
|
ZERO? SUPER-BRIEF \?PRG30
|
|
CRLF
|
|
?PRG30: ICALL1 UPDATE-STATUS-LINE
|
|
PRINTC 62
|
|
PUTB P-INBUF,1,0
|
|
READ P-INBUF,P-LEXV
|
|
?CND12: GETB P-LEXV,P-LEXWORDS >P-LEN
|
|
ZERO? P-LEN \?CND32
|
|
PRINTI "Bitte?"
|
|
CRLF
|
|
RFALSE
|
|
?CND32: GET P-LEXV,PTR >WRD
|
|
EQUAL? WRD,W?ACH \?CCL36
|
|
ADD PTR,P-LEXELEN
|
|
GET P-LEXV,STACK
|
|
EQUAL? STACK,W?PERIOD,W?COMMA \?CND37
|
|
ADD PTR,P-LEXELEN >PTR
|
|
DEC 'P-LEN
|
|
?CND37: GRTR? P-LEN,1 /?CCL41
|
|
PRINTI "Das war tolpatschig."
|
|
CRLF
|
|
RFALSE
|
|
?CCL41: GET OOPS-TABLE,O-PTR
|
|
ZERO? STACK /?CCL43
|
|
GRTR? P-LEN,2 \?CCL46
|
|
ADD PTR,P-LEXELEN
|
|
GET P-LEXV,STACK
|
|
EQUAL? STACK,W?QUOTE \?CCL46
|
|
PRINTI "Es tut mir leid, aber Fehler im vorgegebenen Text lassen sich nicht korrigieren."
|
|
CRLF
|
|
RFALSE
|
|
?CCL46: GRTR? P-LEN,2 \?CND44
|
|
PRINTI "Warnung: nur das erste Wort nach ACH kann gelten."
|
|
CRLF
|
|
?CND44: GET OOPS-TABLE,O-PTR >?TMP1
|
|
ADD PTR,P-LEXELEN
|
|
GET P-LEXV,STACK
|
|
PUT AGAIN-LEXV,?TMP1,STACK
|
|
SET 'WINNER,OWINNER
|
|
MUL PTR,P-LEXELEN
|
|
ADD STACK,6
|
|
GETB P-LEXV,STACK >?TMP2
|
|
MUL PTR,P-LEXELEN
|
|
ADD STACK,7
|
|
GETB P-LEXV,STACK >?TMP1
|
|
GET OOPS-TABLE,O-PTR
|
|
MUL STACK,P-LEXELEN
|
|
ADD STACK,3
|
|
ICALL INBUF-ADD,?TMP2,?TMP1,STACK
|
|
ICALL STUFF,AGAIN-LEXV,P-LEXV
|
|
GETB P-LEXV,P-LEXWORDS >P-LEN
|
|
GET OOPS-TABLE,O-START >PTR
|
|
ICALL INBUF-STUFF,OOPS-INBUF,P-INBUF
|
|
JUMP ?CND34
|
|
?CCL43: PUT OOPS-TABLE,O-END,FALSE-VALUE
|
|
PRINTI "Hier gab es kein Wort zu ersetzen!"
|
|
CRLF
|
|
RFALSE
|
|
?CCL36: EQUAL? WRD,W?WIEDER /?CND50
|
|
SET 'P-NUMBER,0
|
|
?CND50: PUT OOPS-TABLE,O-END,FALSE-VALUE
|
|
?CND34: GET P-LEXV,PTR
|
|
EQUAL? STACK,W?WIEDER \?CCL54
|
|
GETB OOPS-INBUF,1
|
|
ZERO? STACK \?CCL57
|
|
PRINTI "Bitte?"
|
|
CRLF
|
|
RFALSE
|
|
?CCL57: ZERO? P-OFLAG /?CCL59
|
|
PRINTI "Gespr%achsfetzen wiederholen ist schwierig."
|
|
CRLF
|
|
RFALSE
|
|
?CCL59: ZERO? P-WON \?CCL61
|
|
PRINTI "Das w%urde den Fehler nur wiederholen."
|
|
CRLF
|
|
RFALSE
|
|
?CCL61: GRTR? P-LEN,1 \?CCL63
|
|
ADD PTR,P-LEXELEN
|
|
GET P-LEXV,STACK
|
|
EQUAL? STACK,W?PERIOD,W?COMMA,W?DANN /?CTR65
|
|
ADD PTR,P-LEXELEN
|
|
GET P-LEXV,STACK
|
|
EQUAL? STACK,W?UND \?CCL66
|
|
?CTR65: ADD PTR,4 >PTR
|
|
GETB P-LEXV,P-LEXWORDS
|
|
SUB STACK,2
|
|
PUTB P-LEXV,P-LEXWORDS,STACK
|
|
JUMP ?CND55
|
|
?CCL66: PRINTI "Dieser Satz ist nicht verstanden worden."
|
|
CRLF
|
|
RFALSE
|
|
?CCL63: ADD PTR,P-LEXELEN >PTR
|
|
GETB P-LEXV,P-LEXWORDS
|
|
SUB STACK,1
|
|
PUTB P-LEXV,P-LEXWORDS,STACK
|
|
?CND55: GETB P-LEXV,P-LEXWORDS
|
|
GRTR? STACK,0 \?CCL71
|
|
ICALL STUFF,P-LEXV,RESERVE-LEXV
|
|
SET 'RESERVE-PTR,PTR
|
|
JUMP ?CND69
|
|
?CCL71: SET 'RESERVE-PTR,FALSE-VALUE
|
|
?CND69: SET 'WINNER,OWINNER
|
|
SET 'P-MERGED,OMERGED
|
|
ICALL INBUF-STUFF,OOPS-INBUF,P-INBUF
|
|
ICALL STUFF,AGAIN-LEXV,P-LEXV
|
|
SET 'CNT,-1
|
|
SET 'DIR,AGAIN-DIR
|
|
?PRG72: IGRTR? 'CNT,P-ITBLLEN /?CND52
|
|
GET P-OTBL,CNT
|
|
PUT P-ITBL,CNT,STACK
|
|
JUMP ?PRG72
|
|
?CCL54: ICALL STUFF,P-LEXV,AGAIN-LEXV
|
|
ICALL INBUF-STUFF,P-INBUF,OOPS-INBUF
|
|
PUT OOPS-TABLE,O-START,PTR
|
|
MUL 4,P-LEN
|
|
PUT OOPS-TABLE,O-LENGTH,STACK
|
|
GETB P-LEXV,P-LEXWORDS
|
|
MUL P-LEXELEN,STACK
|
|
ADD PTR,STACK
|
|
MUL 2,STACK >LEN
|
|
SUB LEN,1
|
|
GETB P-LEXV,STACK >?TMP1
|
|
SUB LEN,2
|
|
GETB P-LEXV,STACK
|
|
ADD ?TMP1,STACK
|
|
PUT OOPS-TABLE,O-END,STACK
|
|
SET 'RESERVE-PTR,FALSE-VALUE
|
|
SET 'LEN,P-LEN
|
|
SET 'P-DIR,FALSE-VALUE
|
|
SET 'P-NCN,0
|
|
SET 'P-GETFLAGS,0
|
|
?PRG77: DLESS? 'P-LEN,0 \?CCL81
|
|
SET 'QUOTE-FLAG,FALSE-VALUE
|
|
JUMP ?CND52
|
|
?CCL81: GET P-LEXV,PTR >WRD
|
|
ZERO? WRD \?CTR82
|
|
CALL2 NUMBER?,PTR >WRD
|
|
ZERO? WRD /?CCL83
|
|
?CTR82: ZERO? P-LEN \?CCL88
|
|
SET 'NW,0
|
|
JUMP ?CND86
|
|
?CCL88: ADD PTR,P-LEXELEN
|
|
GET P-LEXV,STACK >NW
|
|
?CND86: EQUAL? WRD,W?ZU \?CCL91
|
|
EQUAL? VERB,ACT?SAG \?CCL91
|
|
SET 'WRD,W?QUOTE
|
|
JUMP ?CND89
|
|
?CCL91: EQUAL? WRD,W?DANN \?CND89
|
|
GRTR? P-LEN,0 \?CND89
|
|
ZERO? VERB \?CND89
|
|
ZERO? QUOTE-FLAG \?CND89
|
|
EQUAL? LW,0,W?PERIOD \?CCL101
|
|
SET 'WRD,W?DER
|
|
JUMP ?CND89
|
|
?CCL101: PUT P-ITBL,P-VERB,ACT?SAG
|
|
PUT P-ITBL,P-VERBN,0
|
|
SET 'WRD,W?QUOTE
|
|
?CND89: EQUAL? WRD,W?DANN,W?PERIOD,W?QUOTE \?CCL104
|
|
EQUAL? WRD,W?QUOTE \?CND105
|
|
ZERO? QUOTE-FLAG /?CCL109
|
|
SET 'QUOTE-FLAG,FALSE-VALUE
|
|
JUMP ?CND105
|
|
?CCL109: SET 'QUOTE-FLAG,TRUE-VALUE
|
|
?CND105: ZERO? P-LEN /?PEN110
|
|
ADD PTR,P-LEXELEN >P-CONT
|
|
?PEN110: PUTB P-LEXV,P-LEXWORDS,P-LEN
|
|
JUMP ?CND52
|
|
?CCL104: CALL WT?,WRD,16,3 >VAL
|
|
ZERO? VAL /?CCL113
|
|
EQUAL? VERB,FALSE-VALUE,ACT?GEH \?CCL113
|
|
EQUAL? LEN,1 /?CTR112
|
|
EQUAL? LEN,2 \?PRD119
|
|
EQUAL? VERB,ACT?GEH /?CTR112
|
|
?PRD119: EQUAL? NW,W?DANN,W?PERIOD,W?QUOTE \?PRD122
|
|
LESS? LEN,2 \?CTR112
|
|
?PRD122: ZERO? QUOTE-FLAG /?PRD125
|
|
EQUAL? LEN,2 \?PRD125
|
|
EQUAL? NW,W?QUOTE /?CTR112
|
|
?PRD125: GRTR? LEN,2 \?CCL113
|
|
EQUAL? NW,W?COMMA,W?UND \?CCL113
|
|
?CTR112: SET 'DIR,VAL
|
|
EQUAL? NW,W?COMMA,W?UND \?CND131
|
|
ADD PTR,P-LEXELEN
|
|
PUT P-LEXV,STACK,W?DANN
|
|
?CND131: GRTR? LEN,2 /?CND79
|
|
SET 'QUOTE-FLAG,FALSE-VALUE
|
|
JUMP ?CND52
|
|
?CCL113: CALL WT?,WRD,64,1 >VAL
|
|
ZERO? VAL /?CCL136
|
|
ZERO? VERB \?CCL136
|
|
SET 'VERB,VAL
|
|
PUT P-ITBL,P-VERB,VAL
|
|
PUT P-ITBL,P-VERBN,P-VTBL
|
|
PUT P-VTBL,0,WRD
|
|
MUL PTR,2
|
|
ADD STACK,2 >CNT
|
|
GETB P-LEXV,CNT
|
|
PUTB P-VTBL,2,STACK
|
|
ADD CNT,1
|
|
GETB P-LEXV,STACK
|
|
PUTB P-VTBL,3,STACK
|
|
JUMP ?CND79
|
|
?CCL136: CALL WT?,WRD,8,0 >VAL
|
|
ZERO? VAL \?CTR139
|
|
EQUAL? WRD,W?ALLES /?CTR139
|
|
EQUAL? WRD,W?EIN,W?EINE,W?EINER /?CTR139
|
|
EQUAL? WRD,W?EINEM,W?EINEN /?CTR139
|
|
CALL WT?,WRD,32
|
|
ZERO? STACK \?CTR139
|
|
CALL WT?,WRD,128
|
|
ZERO? STACK /?CCL140
|
|
?CTR139: GRTR? P-LEN,1 \?CCL149
|
|
EQUAL? NW,W?VOLL \?CCL149
|
|
ZERO? VAL \?CCL149
|
|
EQUAL? WRD,W?ALLES /?CCL149
|
|
EQUAL? WRD,W?EIN,W?EINE,W?EINER /?CCL149
|
|
EQUAL? WRD,W?EINEM,W?EINEN /?CCL149
|
|
SET 'OF-FLAG,TRUE-VALUE
|
|
JUMP ?CND79
|
|
?CCL149: ZERO? VAL /?CCL158
|
|
ZERO? P-LEN /?CTR157
|
|
EQUAL? NW,W?DANN,W?PERIOD \?CCL158
|
|
?CTR157: SET 'P-END-ON-PREP,TRUE-VALUE
|
|
LESS? P-NCN,2 \?CND79
|
|
PUT P-ITBL,P-PREP1,VAL
|
|
PUT P-ITBL,P-PREP1N,WRD
|
|
JUMP ?CND79
|
|
?CCL158: EQUAL? P-NCN,2 \?CCL166
|
|
PRINTI "Der Satz hatte zu viele Substantive."
|
|
CRLF
|
|
RFALSE
|
|
?CCL166: INC 'P-NCN
|
|
SET 'P-ACT,VERB
|
|
CALL CLAUSE,PTR,VAL,WRD >PTR
|
|
ZERO? PTR /FALSE
|
|
LESS? PTR,0 \?CND79
|
|
SET 'QUOTE-FLAG,FALSE-VALUE
|
|
?CND52: PUT OOPS-TABLE,O-PTR,FALSE-VALUE
|
|
ZERO? DIR /?CCL186
|
|
SET 'PRSA,V?WALK
|
|
SET 'PRSO,DIR
|
|
SET 'P-OFLAG,FALSE-VALUE
|
|
SET 'P-WALK-DIR,DIR
|
|
SET 'AGAIN-DIR,DIR
|
|
RETURN AGAIN-DIR
|
|
?CCL140: EQUAL? WRD,W?VOLL \?CCL172
|
|
ZERO? OF-FLAG /?CTR174
|
|
EQUAL? NW,W?PERIOD,W?DANN \?CCL175
|
|
?CTR174: ICALL2 CANT-USE,PTR
|
|
RFALSE
|
|
?CCL175: SET 'OF-FLAG,FALSE-VALUE
|
|
?CND79: SET 'LW,WRD
|
|
ADD PTR,P-LEXELEN >PTR
|
|
JUMP ?PRG77
|
|
?CCL172: CALL WT?,WRD,4
|
|
ZERO? STACK \?CND79
|
|
EQUAL? VERB,ACT?SAG \?CCL180
|
|
CALL WT?,WRD,64,1
|
|
ZERO? STACK /?CCL180
|
|
EQUAL? WINNER,PLAYER \?CCL180
|
|
PRINTI "Bitte lies die Anleitung zum Spiel, um die richtige Anrede zu finden, die man f%ur andere Leute oder Biester benutzt."
|
|
CRLF
|
|
RFALSE
|
|
?CCL180: ICALL2 CANT-USE,PTR
|
|
RFALSE
|
|
?CCL83: ICALL2 UNKNOWN-WORD,PTR
|
|
RFALSE
|
|
?CCL186: ZERO? P-OFLAG /?CND187
|
|
ICALL1 ORPHAN-MERGE
|
|
?CND187: SET 'P-WALK-DIR,FALSE-VALUE
|
|
SET 'AGAIN-DIR,FALSE-VALUE
|
|
CALL1 SYNTAX-CHECK
|
|
ZERO? STACK /FALSE
|
|
CALL1 SNARF-OBJECTS
|
|
ZERO? STACK /FALSE
|
|
CALL1 MANY-CHECK
|
|
ZERO? STACK /FALSE
|
|
CALL1 TAKE-CHECK
|
|
ZERO? STACK \TRUE
|
|
RFALSE
|
|
|
|
|
|
.FUNCT STUFF:ANY:2:3,SRC,DEST,MAX,PTR,CTR,BPTR
|
|
ASSIGNED? 'MAX /?CND1
|
|
SET 'MAX,29
|
|
?CND1: SET 'PTR,P-LEXSTART
|
|
SET 'CTR,1
|
|
GETB SRC,0
|
|
PUTB DEST,0,STACK
|
|
GETB SRC,1
|
|
PUTB DEST,1,STACK
|
|
?PRG3: GET SRC,PTR
|
|
PUT DEST,PTR,STACK
|
|
MUL PTR,2
|
|
ADD STACK,2 >BPTR
|
|
GETB SRC,BPTR
|
|
PUTB DEST,BPTR,STACK
|
|
MUL PTR,2
|
|
ADD STACK,3 >BPTR
|
|
GETB SRC,BPTR
|
|
PUTB DEST,BPTR,STACK
|
|
ADD PTR,P-LEXELEN >PTR
|
|
IGRTR? 'CTR,MAX \?PRG3
|
|
RTRUE
|
|
|
|
|
|
.FUNCT INBUF-STUFF:ANY:2:2,SRC,DEST,CNT
|
|
GETB SRC,0
|
|
SUB STACK,1 >CNT
|
|
?PRG1: GETB SRC,CNT
|
|
PUTB DEST,CNT,STACK
|
|
DLESS? 'CNT,0 \?PRG1
|
|
RTRUE
|
|
|
|
|
|
.FUNCT INBUF-ADD:ANY:3:3,LEN,BEG,SLOT,DBEG,CTR,TMP,?TMP1
|
|
GET OOPS-TABLE,O-END >TMP
|
|
ZERO? TMP /?CCL3
|
|
SET 'DBEG,TMP
|
|
JUMP ?CND1
|
|
?CCL3: GET OOPS-TABLE,O-LENGTH >TMP
|
|
GETB AGAIN-LEXV,TMP >?TMP1
|
|
ADD TMP,1
|
|
GETB AGAIN-LEXV,STACK
|
|
ADD ?TMP1,STACK >DBEG
|
|
?CND1: ADD DBEG,LEN
|
|
PUT OOPS-TABLE,O-END,STACK
|
|
?PRG4: ADD DBEG,CTR >?TMP1
|
|
ADD BEG,CTR
|
|
GETB P-INBUF,STACK
|
|
PUTB OOPS-INBUF,?TMP1,STACK
|
|
INC 'CTR
|
|
EQUAL? CTR,LEN \?PRG4
|
|
PUTB AGAIN-LEXV,SLOT,DBEG
|
|
SUB SLOT,1
|
|
PUTB AGAIN-LEXV,STACK,LEN
|
|
RTRUE
|
|
|
|
|
|
.FUNCT WT?:ANY:2:3,PTR,BIT,B1,OFFS,TYP
|
|
ASSIGNED? 'B1 /?CND1
|
|
SET 'B1,5
|
|
?CND1: SET 'OFFS,P-P1OFF
|
|
GETB PTR,P-PSOFF >TYP
|
|
BTST TYP,BIT \FALSE
|
|
GRTR? B1,4 /TRUE
|
|
EQUAL? BIT,128 /TRUE
|
|
BAND TYP,P-P1BITS >TYP
|
|
EQUAL? TYP,B1 /?CND11
|
|
INC 'OFFS
|
|
?CND11: GETB PTR,OFFS
|
|
RSTACK
|
|
|
|
|
|
.FUNCT CLAUSE:ANY:3:3,PTR,VAL,WRD,OFF,NUM,ANDFLG,FIRST??,NW,LW,?TMP1
|
|
SET 'FIRST??,TRUE-VALUE
|
|
SUB P-NCN,1
|
|
MUL STACK,2 >OFF
|
|
ZERO? VAL /?CCL3
|
|
ADD P-PREP1,OFF >NUM
|
|
PUT P-ITBL,NUM,VAL
|
|
ADD NUM,1
|
|
PUT P-ITBL,STACK,WRD
|
|
ADD PTR,P-LEXELEN >PTR
|
|
JUMP ?CND1
|
|
?CCL3: INC 'P-LEN
|
|
?CND1: ZERO? P-LEN \?CND4
|
|
DEC 'P-NCN
|
|
RETURN -1
|
|
?CND4: ADD P-NC1,OFF >NUM
|
|
MUL PTR,2
|
|
ADD P-LEXV,STACK
|
|
PUT P-ITBL,NUM,STACK
|
|
GET P-LEXV,PTR
|
|
EQUAL? STACK,W?DER,W?DIE,W?DAS /?CCL7
|
|
GET P-LEXV,PTR
|
|
EQUAL? STACK,W?EIN,W?EINE,W?EINEM /?CCL7
|
|
GET P-LEXV,PTR
|
|
EQUAL? STACK,W?EINEN,W?EINER \?PRG11
|
|
?CCL7: GET P-ITBL,NUM
|
|
ADD STACK,4
|
|
PUT P-ITBL,NUM,STACK
|
|
?PRG11: DLESS? 'P-LEN,0 \?CND13
|
|
ADD NUM,1 >?TMP1
|
|
MUL PTR,2
|
|
ADD P-LEXV,STACK
|
|
PUT P-ITBL,?TMP1,STACK
|
|
RETURN -1
|
|
?CND13: GET P-LEXV,PTR >WRD
|
|
ZERO? WRD \?CTR16
|
|
CALL2 NUMBER?,PTR >WRD
|
|
ZERO? WRD /?CCL17
|
|
?CTR16: ZERO? P-LEN \?CCL22
|
|
SET 'NW,0
|
|
JUMP ?CND20
|
|
?CCL22: ADD PTR,P-LEXELEN
|
|
GET P-LEXV,STACK >NW
|
|
?CND20: EQUAL? WRD,W?UND,W?COMMA \?CCL25
|
|
SET 'ANDFLG,TRUE-VALUE
|
|
JUMP ?CND15
|
|
?CCL25: EQUAL? WRD,W?ALLES /?CTR26
|
|
EQUAL? WRD,W?EIN,W?EINE,W?EINER /?CTR26
|
|
EQUAL? WRD,W?EINEM,W?EINEN \?CCL27
|
|
?CTR26: EQUAL? NW,W?VOLL \?CND15
|
|
DEC 'P-LEN
|
|
ADD PTR,P-LEXELEN >PTR
|
|
JUMP ?CND15
|
|
?CCL27: EQUAL? WRD,W?DANN,W?PERIOD /?CTR33
|
|
CALL WT?,WRD,8
|
|
ZERO? STACK /?CCL34
|
|
GET P-ITBL,P-VERB
|
|
ZERO? STACK /?CCL34
|
|
ZERO? FIRST?? \?CCL34
|
|
?CTR33: INC 'P-LEN
|
|
ADD NUM,1 >?TMP1
|
|
MUL PTR,2
|
|
ADD P-LEXV,STACK
|
|
PUT P-ITBL,?TMP1,STACK
|
|
SUB PTR,P-LEXELEN
|
|
RSTACK
|
|
?CCL34: CALL WT?,WRD,128
|
|
ZERO? STACK /?CCL41
|
|
GRTR? P-LEN,0 \?CCL44
|
|
EQUAL? NW,W?VOLL \?CCL44
|
|
EQUAL? WRD,W?ALLES /?CCL44
|
|
EQUAL? WRD,W?EIN,W?EINE,W?EINER /?CCL44
|
|
EQUAL? WRD,W?EINEM,W?EINEN \?CND15
|
|
?CCL44: CALL WT?,WRD,32
|
|
ZERO? STACK /?CCL51
|
|
ZERO? NW /?CCL51
|
|
CALL WT?,NW,128
|
|
ZERO? STACK \?CND15
|
|
?CCL51: ZERO? ANDFLG \?CCL56
|
|
EQUAL? NW,W?ABER,W?AUSSER,W?AU%SER /?CCL56
|
|
EQUAL? NW,W?UND,W?COMMA /?CCL56
|
|
ADD NUM,1 >?TMP1
|
|
ADD PTR,2
|
|
MUL STACK,2
|
|
ADD P-LEXV,STACK
|
|
PUT P-ITBL,?TMP1,STACK
|
|
RETURN PTR
|
|
?CCL56: SET 'ANDFLG,FALSE-VALUE
|
|
JUMP ?CND15
|
|
?CCL41: ZERO? P-MERGED \?PRD62
|
|
ZERO? P-OFLAG \?PRD62
|
|
GET P-ITBL,P-VERB
|
|
ZERO? STACK /?CCL60
|
|
?PRD62: CALL WT?,WRD,32
|
|
ZERO? STACK \?CND15
|
|
CALL WT?,WRD,4
|
|
ZERO? STACK \?CND15
|
|
?CCL60: ZERO? ANDFLG /?CCL69
|
|
CALL WT?,WRD,16
|
|
ZERO? STACK \?CTR68
|
|
CALL WT?,WRD,64
|
|
ZERO? STACK /?CCL69
|
|
?CTR68: SUB PTR,4 >PTR
|
|
ADD PTR,2
|
|
PUT P-LEXV,STACK,W?DANN
|
|
ADD P-LEN,2 >P-LEN
|
|
?CND15: SET 'LW,WRD
|
|
SET 'FIRST??,FALSE-VALUE
|
|
ADD PTR,P-LEXELEN >PTR
|
|
JUMP ?PRG11
|
|
?CCL69: CALL WT?,WRD,8
|
|
ZERO? STACK \?CND15
|
|
ICALL2 CANT-USE,PTR
|
|
RFALSE
|
|
?CCL17: ICALL2 UNKNOWN-WORD,PTR
|
|
RFALSE
|
|
|
|
|
|
.FUNCT NUMBER?:ANY:1:1,PTR,CNT,BPTR,CHR,SUM,TIM,?TMP1
|
|
MUL PTR,2
|
|
ADD P-LEXV,STACK
|
|
GETB STACK,2 >CNT
|
|
MUL PTR,2
|
|
ADD P-LEXV,STACK
|
|
GETB STACK,3 >BPTR
|
|
?PRG1: DLESS? 'CNT,0 /?REP2
|
|
GETB P-INBUF,BPTR >CHR
|
|
EQUAL? CHR,58 \?CCL8
|
|
SET 'TIM,SUM
|
|
SET 'SUM,0
|
|
JUMP ?CND6
|
|
?CCL8: GRTR? SUM,10000 /FALSE
|
|
LESS? CHR,58 \FALSE
|
|
GRTR? CHR,47 \FALSE
|
|
MUL SUM,10 >?TMP1
|
|
SUB CHR,48
|
|
ADD ?TMP1,STACK >SUM
|
|
?CND6: INC 'BPTR
|
|
JUMP ?PRG1
|
|
?REP2: PUT P-LEXV,PTR,W?INTNUM
|
|
GRTR? SUM,1000 /FALSE
|
|
ZERO? TIM /?CND15
|
|
LESS? TIM,8 \?CCL21
|
|
ADD TIM,12 >TIM
|
|
JUMP ?CND19
|
|
?CCL21: GRTR? TIM,23 /FALSE
|
|
?CND19: MUL TIM,60
|
|
ADD SUM,STACK >SUM
|
|
?CND15: SET 'P-NUMBER,SUM
|
|
RETURN W?INTNUM
|
|
|
|
|
|
.FUNCT ORPHAN-MERGE:ANY:0:0,CNT,TEMP,VERB,BEG,END,ADJ,WRD,?TMP1
|
|
SET 'CNT,-1
|
|
SET 'P-OFLAG,FALSE-VALUE
|
|
GET P-ITBL,P-VERBN
|
|
GET STACK,0 >WRD
|
|
CALL WT?,WRD,64,1 >?TMP1
|
|
GET P-OTBL,P-VERB
|
|
EQUAL? ?TMP1,STACK /?CTR2
|
|
CALL WT?,WRD,32
|
|
ZERO? STACK /?CCL3
|
|
?CTR2: SET 'ADJ,TRUE-VALUE
|
|
JUMP ?CND1
|
|
?CCL3: CALL WT?,WRD,128,0
|
|
ZERO? STACK /?CND1
|
|
ZERO? P-NCN \?CND1
|
|
PUT P-ITBL,P-VERB,0
|
|
PUT P-ITBL,P-VERBN,0
|
|
ADD P-LEXV,2
|
|
PUT P-ITBL,P-NC1,STACK
|
|
ADD P-LEXV,6
|
|
PUT P-ITBL,P-NC1L,STACK
|
|
SET 'P-NCN,1
|
|
?CND1: GET P-ITBL,P-VERB >VERB
|
|
ZERO? VERB /?CCL11
|
|
ZERO? ADJ \?CCL11
|
|
GET P-OTBL,P-VERB
|
|
EQUAL? VERB,STACK \FALSE
|
|
?CCL11: EQUAL? P-NCN,2 /FALSE
|
|
GET P-OTBL,P-NC1
|
|
EQUAL? STACK,1 \?CCL18
|
|
GET P-ITBL,P-PREP1 >TEMP
|
|
GET P-OTBL,P-PREP1
|
|
EQUAL? TEMP,STACK /?CTR20
|
|
ZERO? TEMP \FALSE
|
|
?CTR20: ZERO? ADJ /?CCL26
|
|
ADD P-LEXV,2
|
|
PUT P-OTBL,P-NC1,STACK
|
|
GET P-ITBL,P-NC1L
|
|
ZERO? STACK \?CND27
|
|
ADD P-LEXV,6
|
|
PUT P-ITBL,P-NC1L,STACK
|
|
?CND27: ZERO? P-NCN \?CND24
|
|
SET 'P-NCN,1
|
|
JUMP ?CND24
|
|
?CCL26: GET P-ITBL,P-NC1
|
|
PUT P-OTBL,P-NC1,STACK
|
|
?CND24: GET P-ITBL,P-NC1L
|
|
PUT P-OTBL,P-NC1L,STACK
|
|
JUMP ?CND9
|
|
?CCL18: GET P-OTBL,P-NC2
|
|
EQUAL? STACK,1 \?CCL32
|
|
GET P-ITBL,P-PREP1 >TEMP
|
|
GET P-OTBL,P-PREP2
|
|
EQUAL? TEMP,STACK /?CTR34
|
|
ZERO? TEMP \FALSE
|
|
?CTR34: ZERO? ADJ /?CND38
|
|
ADD P-LEXV,2
|
|
PUT P-ITBL,P-NC1,STACK
|
|
GET P-ITBL,P-NC1L
|
|
ZERO? STACK \?CND38
|
|
ADD P-LEXV,6
|
|
PUT P-ITBL,P-NC1L,STACK
|
|
?CND38: GET P-ITBL,P-NC1
|
|
PUT P-OTBL,P-NC2,STACK
|
|
GET P-ITBL,P-NC1L
|
|
PUT P-OTBL,P-NC2L,STACK
|
|
SET 'P-NCN,2
|
|
JUMP ?CND9
|
|
?CCL32: ZERO? P-ACLAUSE /?CND9
|
|
EQUAL? P-NCN,1 /?CCL45
|
|
ZERO? ADJ \?CCL45
|
|
SET 'P-ACLAUSE,FALSE-VALUE
|
|
RFALSE
|
|
?CCL45: GET P-ITBL,P-NC1 >BEG
|
|
ZERO? ADJ /?CND48
|
|
ADD P-LEXV,2 >BEG
|
|
SET 'ADJ,FALSE-VALUE
|
|
?CND48: GET P-ITBL,P-NC1L >END
|
|
?PRG50: GET BEG,0 >WRD
|
|
EQUAL? BEG,END \?CCL54
|
|
ZERO? ADJ /?CCL57
|
|
ICALL2 ACLAUSE-WIN,ADJ
|
|
JUMP ?CND9
|
|
?CCL57: SET 'P-ACLAUSE,FALSE-VALUE
|
|
RFALSE
|
|
?CCL54: ZERO? ADJ \?CCL59
|
|
GETB WRD,P-PSOFF
|
|
BTST STACK,32 /?CTR58
|
|
EQUAL? WRD,W?ALLES /?CTR58
|
|
EQUAL? WRD,W?EIN,W?EINE,W?EINER /?CTR58
|
|
EQUAL? WRD,W?EINEM,W?EINEN \?CCL59
|
|
?CTR58: SET 'ADJ,WRD
|
|
?CND52: ADD BEG,P-WORDLEN >BEG
|
|
ZERO? END \?PRG50
|
|
SET 'END,BEG
|
|
SET 'P-NCN,1
|
|
SUB BEG,4
|
|
PUT P-ITBL,P-NC1,STACK
|
|
PUT P-ITBL,P-NC1L,BEG
|
|
JUMP ?PRG50
|
|
?CCL59: EQUAL? WRD,W?EIN,W?EINE,W?EINER /?CTR66
|
|
EQUAL? WRD,W?EINEM,W?EINEN \?CCL67
|
|
?CTR66: ICALL2 ACLAUSE-WIN,ADJ
|
|
JUMP ?CND9
|
|
?CCL67: GETB WRD,P-PSOFF
|
|
BTST STACK,128 \?CND52
|
|
EQUAL? WRD,P-ANAM \?CCL73
|
|
ICALL2 ACLAUSE-WIN,ADJ
|
|
JUMP ?CND9
|
|
?CCL73: ICALL1 NCLAUSE-WIN
|
|
?CND9: GET P-OVTBL,0
|
|
PUT P-VTBL,0,STACK
|
|
GETB P-OVTBL,2
|
|
PUTB P-VTBL,2,STACK
|
|
GETB P-OVTBL,3
|
|
PUTB P-VTBL,3,STACK
|
|
PUT P-OTBL,P-VERBN,P-VTBL
|
|
PUTB P-VTBL,2,0
|
|
?PRG76: IGRTR? 'CNT,P-ITBLLEN \?CCL80
|
|
SET 'P-MERGED,TRUE-VALUE
|
|
RTRUE
|
|
?CCL80: GET P-OTBL,CNT
|
|
PUT P-ITBL,CNT,STACK
|
|
JUMP ?PRG76
|
|
|
|
|
|
.FUNCT ACLAUSE-WIN:ANY:1:1,ADJ
|
|
GET P-OTBL,P-VERB
|
|
PUT P-ITBL,P-VERB,STACK
|
|
PUT P-CCTBL,CC-SBPTR,P-ACLAUSE
|
|
ADD P-ACLAUSE,1
|
|
PUT P-CCTBL,CC-SEPTR,STACK
|
|
PUT P-CCTBL,CC-DBPTR,P-ACLAUSE
|
|
ADD P-ACLAUSE,1
|
|
PUT P-CCTBL,CC-DEPTR,STACK
|
|
ICALL CLAUSE-COPY,P-OTBL,P-OTBL,ADJ
|
|
GET P-OTBL,P-NC2
|
|
ZERO? STACK /?PEN1
|
|
SET 'P-NCN,2
|
|
?PEN1: SET 'P-ACLAUSE,FALSE-VALUE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT NCLAUSE-WIN:ANY:0:0
|
|
PUT P-CCTBL,CC-SBPTR,P-NC1
|
|
PUT P-CCTBL,CC-SEPTR,P-NC1L
|
|
PUT P-CCTBL,CC-DBPTR,P-ACLAUSE
|
|
ADD P-ACLAUSE,1
|
|
PUT P-CCTBL,CC-DEPTR,STACK
|
|
ICALL CLAUSE-COPY,P-ITBL,P-OTBL
|
|
GET P-OTBL,P-NC2
|
|
ZERO? STACK /?PEN1
|
|
SET 'P-NCN,2
|
|
?PEN1: SET 'P-ACLAUSE,FALSE-VALUE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT WORD-PRINT:ANY:2:3,CNT,BUF,CAP?,DID-CAP
|
|
?PRG1: DLESS? 'CNT,0 /TRUE
|
|
ZERO? DID-CAP \?CCL8
|
|
ZERO? CAP? /?CCL8
|
|
SET 'DID-CAP,TRUE-VALUE
|
|
GETB P-INBUF,BUF
|
|
SUB STACK,32
|
|
PRINTC STACK
|
|
JUMP ?CND6
|
|
?CCL8: GETB P-INBUF,BUF
|
|
PRINTC STACK
|
|
?CND6: INC 'BUF
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT UNKNOWN-WORD:ANY:1:1,PTR,BUF,?TMP1
|
|
PUT OOPS-TABLE,O-PTR,PTR
|
|
EQUAL? PRSA,V?SAY \?CND1
|
|
PRINTI "Hier passiert garnichts."
|
|
CRLF
|
|
RFALSE
|
|
?CND1: PRINTI "Das Wort %>"
|
|
MUL PTR,2 >BUF
|
|
ADD P-LEXV,BUF
|
|
GETB STACK,2 >?TMP1
|
|
ADD P-LEXV,BUF
|
|
GETB STACK,3
|
|
ICALL WORD-PRINT,?TMP1,STACK
|
|
PRINTI "%< kann nicht von dem Spielvokabular verstanden werden."
|
|
CRLF
|
|
SET 'QUOTE-FLAG,FALSE-VALUE
|
|
SET 'P-OFLAG,FALSE-VALUE
|
|
RETURN P-OFLAG
|
|
|
|
|
|
.FUNCT CANT-USE:ANY:1:1,PTR,BUF,?TMP1
|
|
EQUAL? PRSA,V?SAY \?CND1
|
|
PRINTI "Hier passiert garnichts."
|
|
CRLF
|
|
RFALSE
|
|
?CND1: PRINTI "Du hast das Wort %>"
|
|
MUL PTR,2 >BUF
|
|
ADD P-LEXV,BUF
|
|
GETB STACK,2 >?TMP1
|
|
ADD P-LEXV,BUF
|
|
GETB STACK,3
|
|
ICALL WORD-PRINT,?TMP1,STACK
|
|
PRINTI "%< so gebraucht, da%s ich es nicht verstehen kann."
|
|
CRLF
|
|
SET 'QUOTE-FLAG,FALSE-VALUE
|
|
SET 'P-OFLAG,FALSE-VALUE
|
|
RETURN P-OFLAG
|
|
|
|
|
|
.FUNCT SYNTAX-CHECK:ANY:0:0,SYN,LEN,NUM,OBJ,DRIVE1,DRIVE2,PREP,VERB,TMP,THE-PREP,?TMP2,?TMP1
|
|
GET P-ITBL,P-VERB >VERB
|
|
ZERO? VERB \?CND1
|
|
PRINTI "In diesem Satz fehlt das Verb!"
|
|
CRLF
|
|
RFALSE
|
|
?CND1: SUB 255,VERB
|
|
GET VERBS,STACK >SYN
|
|
GETB SYN,0 >LEN
|
|
INC 'SYN
|
|
?PRG3: GETB SYN,P-SBITS
|
|
BAND STACK,P-SONUMS >NUM
|
|
GRTR? P-NCN,NUM /?CND5
|
|
LESS? NUM,1 /?CCL9
|
|
ZERO? P-NCN \?CCL9
|
|
GET P-ITBL,P-PREP1 >PREP
|
|
ZERO? PREP /?CTR8
|
|
GETB SYN,P-SPREP1
|
|
EQUAL? PREP,STACK \?CCL9
|
|
?CTR8: SET 'DRIVE1,SYN
|
|
JUMP ?CND5
|
|
?CCL9: GETB SYN,P-SPREP1 >?TMP1
|
|
GET P-ITBL,P-PREP1
|
|
EQUAL? ?TMP1,STACK \?CND5
|
|
EQUAL? NUM,2 \?CCL18
|
|
EQUAL? P-NCN,1 \?CCL18
|
|
SET 'DRIVE2,SYN
|
|
?CND5: DLESS? 'LEN,1 \?CCL24
|
|
ZERO? DRIVE1 \?REP4
|
|
ZERO? DRIVE2 \?REP4
|
|
PRINTI "Das Spiel erkennt diesen Satz nicht."
|
|
CRLF
|
|
RFALSE
|
|
?CCL18: GETB SYN,P-SPREP2 >?TMP1
|
|
GET P-ITBL,P-PREP2
|
|
EQUAL? ?TMP1,STACK \?CND5
|
|
ICALL2 SYNTAX-FOUND,SYN
|
|
RTRUE
|
|
?CCL24: ADD SYN,P-SYNLEN >SYN
|
|
JUMP ?PRG3
|
|
?REP4: ZERO? DRIVE1 /?CCL32
|
|
SET 'GWIM-PRSO?,TRUE-VALUE
|
|
ZERO? GWIM-PRSO? /?CCL32
|
|
GETB DRIVE1,P-SFWIM1 >?TMP2
|
|
GETB DRIVE1,P-SLOC1 >?TMP1
|
|
GETB DRIVE1,P-SPREP1
|
|
CALL GWIM,?TMP2,?TMP1,STACK >OBJ
|
|
ZERO? OBJ /?CCL32
|
|
PUT P-PRSO,P-MATCHLEN,1
|
|
PUT P-PRSO,1,OBJ
|
|
CALL2 SYNTAX-FOUND,DRIVE1
|
|
RSTACK
|
|
?CCL32: ZERO? DRIVE2 /?CCL37
|
|
CALL1 SET-GWIM-PRSO?
|
|
ZERO? STACK /?CCL37
|
|
GETB DRIVE2,P-SFWIM2 >?TMP2
|
|
GETB DRIVE2,P-SLOC2 >?TMP1
|
|
GETB DRIVE2,P-SPREP2
|
|
CALL GWIM,?TMP2,?TMP1,STACK >OBJ
|
|
ZERO? OBJ /?CCL37
|
|
PUT P-PRSI,P-MATCHLEN,1
|
|
PUT P-PRSI,1,OBJ
|
|
CALL2 SYNTAX-FOUND,DRIVE2
|
|
RSTACK
|
|
?CCL37: EQUAL? VERB,ACT?FIND \?CCL42
|
|
PRINTI "Diese Frage kann nicht beantwortet werden."
|
|
CRLF
|
|
RFALSE
|
|
?CCL42: EQUAL? WINNER,PLAYER /?CCL44
|
|
CALL1 CANT-ORPHAN
|
|
RSTACK
|
|
?CCL44: ICALL ORPHAN,DRIVE1,DRIVE2
|
|
GET P-OTBL,P-VERBN >TMP
|
|
SET 'P-OFLAG,TRUE-VALUE
|
|
ZERO? DRIVE1 /?CCL47
|
|
ZERO? TMP \?CCL50
|
|
PRINTI "Was?!"
|
|
CRLF
|
|
RFALSE
|
|
?CCL50: GETB P-VTBL,2
|
|
ZERO? STACK \?CCL52
|
|
GET TMP,0
|
|
ICALL2 CAPITALIZE,STACK
|
|
JUMP ?CND48
|
|
?CCL52: GETB TMP,2 >?TMP1
|
|
GETB TMP,3
|
|
ICALL WORD-PRINT,?TMP1,STACK,TRUE-VALUE
|
|
PUTB P-VTBL,2,0
|
|
?CND48: GETB DRIVE1,P-SPREP1 >THE-PREP
|
|
CALL NON-SEP?,VERB,THE-PREP
|
|
ZERO? STACK /?CCL55
|
|
GETB DRIVE1,P-SPREP1
|
|
ICALL2 PREP-PRINT,STACK
|
|
PRINTI " was"
|
|
JUMP ?CND45
|
|
?CCL55: PRINTI " was"
|
|
GETB DRIVE1,P-SPREP1
|
|
ICALL2 PREP-PRINT,STACK
|
|
JUMP ?CND45
|
|
?CCL47: ZERO? DRIVE2 /?CCL57
|
|
PRINTI "Na ja,"
|
|
GETB DRIVE2,P-SPREP2
|
|
ICALL2 PREP-PRINT,STACK
|
|
PRINTI " was"
|
|
JUMP ?CND45
|
|
?CCL57: PRINTI "Na ja, "
|
|
ZERO? TMP \?CCL60
|
|
PRINTI "was?"
|
|
CRLF
|
|
RFALSE
|
|
?CCL60: GETB P-VTBL,2
|
|
ZERO? STACK \?CCL62
|
|
GET TMP,0
|
|
PRINTB STACK
|
|
JUMP ?CND58
|
|
?CCL62: GETB TMP,2 >?TMP1
|
|
GETB TMP,3
|
|
ICALL WORD-PRINT,?TMP1,STACK
|
|
PUTB P-VTBL,2,0
|
|
?CND58: PRINTI " was"
|
|
?CND45: PRINTC 63
|
|
CRLF
|
|
RFALSE
|
|
|
|
|
|
.FUNCT NON-SEP?:ANY:2:2,VERB,THE-PREP
|
|
EQUAL? VERB,ACT?TRINK,ACT?SPRING,ACT?GRAB /TRUE
|
|
EQUAL? VERB,ACT?ISS,ACT?TRITT,ACT?UNTERSUCH /TRUE
|
|
EQUAL? VERB,ACT?SUCH,ACT?SCHWIMM /TRUE
|
|
EQUAL? VERB,ACT?HOER \?PRD8
|
|
EQUAL? THE-PREP,W?NACH /TRUE
|
|
?PRD8: EQUAL? VERB,ACT?SCHAU \?PRD11
|
|
EQUAL? THE-PREP,W?AN \TRUE
|
|
?PRD11: EQUAL? VERB,ACT?STEIG \?PRD14
|
|
EQUAL? THE-PREP,W?AUF,W?DURCH /TRUE
|
|
?PRD14: EQUAL? VERB,ACT?GEH \FALSE
|
|
EQUAL? THE-PREP,W?DURCH,W?IN,W?AUF /TRUE
|
|
RFALSE
|
|
|
|
|
|
.FUNCT CANT-ORPHAN:ANY:0:0
|
|
PRINTI "%>Ich verstehe das nicht! Worauf beziehst du dich?%<"
|
|
CRLF
|
|
RFALSE
|
|
|
|
|
|
.FUNCT ORPHAN:ANY:2:2,D1,D2,CNT
|
|
SET 'CNT,-1
|
|
ZERO? P-MERGED \?CND1
|
|
PUT P-OCLAUSE,P-MATCHLEN,0
|
|
?CND1: GET P-VTBL,0
|
|
PUT P-OVTBL,0,STACK
|
|
GETB P-VTBL,2
|
|
PUTB P-OVTBL,2,STACK
|
|
GETB P-VTBL,3
|
|
PUTB P-OVTBL,3,STACK
|
|
?PRG3: IGRTR? 'CNT,P-ITBLLEN /?REP4
|
|
GET P-ITBL,CNT
|
|
PUT P-OTBL,CNT,STACK
|
|
JUMP ?PRG3
|
|
?REP4: EQUAL? P-NCN,2 \?CND8
|
|
PUT P-CCTBL,CC-SBPTR,P-NC2
|
|
PUT P-CCTBL,CC-SEPTR,P-NC2L
|
|
PUT P-CCTBL,CC-DBPTR,P-NC2
|
|
PUT P-CCTBL,CC-DEPTR,P-NC2L
|
|
ICALL CLAUSE-COPY,P-ITBL,P-OTBL
|
|
?CND8: LESS? P-NCN,1 /?CND10
|
|
PUT P-CCTBL,CC-SBPTR,P-NC1
|
|
PUT P-CCTBL,CC-SEPTR,P-NC1L
|
|
PUT P-CCTBL,CC-DBPTR,P-NC1
|
|
PUT P-CCTBL,CC-DEPTR,P-NC1L
|
|
ICALL CLAUSE-COPY,P-ITBL,P-OTBL
|
|
?CND10: ZERO? D1 /?CCL14
|
|
GETB D1,P-SPREP1
|
|
PUT P-OTBL,P-PREP1,STACK
|
|
PUT P-OTBL,P-NC1,1
|
|
RTRUE
|
|
?CCL14: ZERO? D2 /FALSE
|
|
GETB D2,P-SPREP2
|
|
PUT P-OTBL,P-PREP2,STACK
|
|
PUT P-OTBL,P-NC2,1
|
|
RTRUE
|
|
|
|
|
|
.FUNCT THING-PRINT:ANY:1:2,PRSO?,THE?,BEG,END
|
|
ZERO? PRSO? /?CCL3
|
|
GET P-ITBL,P-NC1 >BEG
|
|
GET P-ITBL,P-NC1L >END
|
|
JUMP ?CND1
|
|
?CCL3: GET P-ITBL,P-NC2 >BEG
|
|
GET P-ITBL,P-NC2L >END
|
|
?CND1: CALL BUFFER-PRINT,BEG,END,THE?
|
|
RSTACK
|
|
|
|
|
|
.FUNCT BUFFER-PRINT:ANY:3:3,BEG,END,CP,NOSP,WRD,FIRST??,PN,Q?,?TMP1
|
|
SET 'NOSP,TRUE-VALUE
|
|
SET 'FIRST??,TRUE-VALUE
|
|
?PRG1: EQUAL? BEG,END /TRUE
|
|
GET BEG,0 >WRD
|
|
EQUAL? WRD,W?COMMA \?CCL8
|
|
PRINTI ", "
|
|
JUMP ?CND6
|
|
?CCL8: ZERO? NOSP /?CCL10
|
|
SET 'NOSP,FALSE-VALUE
|
|
JUMP ?CND6
|
|
?CCL10: PRINTC 32
|
|
?CND6: EQUAL? WRD,W?PERIOD,W?COMMA \?CCL13
|
|
SET 'NOSP,TRUE-VALUE
|
|
JUMP ?CND3
|
|
?CCL13: EQUAL? WRD,W?MICH \?CCL15
|
|
PRINTD ME
|
|
SET 'PN,TRUE-VALUE
|
|
JUMP ?CND3
|
|
?CCL15: EQUAL? WRD,W?INTNUM \?CCL17
|
|
PRINTN P-NUMBER
|
|
SET 'PN,TRUE-VALUE
|
|
JUMP ?CND3
|
|
?CCL17: ZERO? FIRST?? /?CND18
|
|
ZERO? PN \?CND18
|
|
ZERO? CP /?CND18
|
|
PRINTI "the "
|
|
?CND18: ZERO? P-OFLAG \?CTR24
|
|
ZERO? P-MERGED /?CCL25
|
|
?CTR24: PRINTB WRD
|
|
JUMP ?CND23
|
|
?CCL25: EQUAL? WRD,W?ER,W?IHN,W?IHM \?CCL29
|
|
CALL2 ACCESSIBLE?,P-HIM-OBJECT
|
|
ZERO? STACK /?CCL29
|
|
PRINTD P-HIM-OBJECT
|
|
JUMP ?CND23
|
|
?CCL29: EQUAL? WRD,W?SIE,W?IHR \?CCL33
|
|
CALL2 ACCESSIBLE?,P-HER-OBJECT
|
|
ZERO? STACK /?CCL33
|
|
PRINTD P-HER-OBJECT
|
|
JUMP ?CND23
|
|
?CCL33: EQUAL? WRD,W?ES,W?IHM \?CCL37
|
|
CALL2 ACCESSIBLE?,P-IT-OBJECT
|
|
ZERO? STACK /?CCL37
|
|
PRINTD P-IT-OBJECT
|
|
JUMP ?CND23
|
|
?CCL37: GETB BEG,2 >?TMP1
|
|
GETB BEG,3
|
|
ICALL WORD-PRINT,?TMP1,STACK
|
|
?CND23: SET 'FIRST??,FALSE-VALUE
|
|
?CND3: ADD BEG,P-WORDLEN >BEG
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT PREP-PRINT:ANY:1:2,PREP,CAP?,WRD
|
|
ZERO? PREP /FALSE
|
|
CALL2 PREP-FIND,PREP >WRD
|
|
ZERO? CAP? /?CCL5
|
|
CALL2 CAPITALIZE,WRD
|
|
RSTACK
|
|
?CCL5: PRINTC 32
|
|
PRINTB WRD
|
|
RTRUE
|
|
|
|
|
|
.FUNCT CAPITALIZE:ANY:1:1,PTR,?TMP1
|
|
GETB PTR,3
|
|
GETB P-INBUF,STACK
|
|
SUB STACK,32
|
|
PRINTC STACK
|
|
GETB PTR,2
|
|
SUB STACK,1 >?TMP1
|
|
GETB PTR,3
|
|
ADD STACK,1
|
|
CALL WORD-PRINT,?TMP1,STACK
|
|
RSTACK
|
|
|
|
|
|
.FUNCT CLAUSE-COPY:ANY:2:3,SRC,DEST,INSRT,BEG,END,?TMP1
|
|
GET P-CCTBL,CC-SBPTR
|
|
GET SRC,STACK >BEG
|
|
GET P-CCTBL,CC-SEPTR
|
|
GET SRC,STACK >END
|
|
GET P-CCTBL,CC-DBPTR >?TMP1
|
|
GET P-OCLAUSE,P-MATCHLEN
|
|
MUL STACK,P-LEXELEN
|
|
ADD STACK,2
|
|
ADD P-OCLAUSE,STACK
|
|
PUT DEST,?TMP1,STACK
|
|
?PRG1: EQUAL? BEG,END \?CCL5
|
|
GET P-CCTBL,CC-DEPTR >?TMP1
|
|
GET P-OCLAUSE,P-MATCHLEN
|
|
MUL STACK,P-LEXELEN
|
|
ADD STACK,2
|
|
ADD P-OCLAUSE,STACK
|
|
PUT DEST,?TMP1,STACK
|
|
RTRUE
|
|
?CCL5: ZERO? INSRT /?CND6
|
|
GET BEG,0
|
|
EQUAL? P-ANAM,STACK \?CND6
|
|
ICALL2 CLAUSE-ADD,INSRT
|
|
?CND6: GET BEG,0
|
|
ICALL2 CLAUSE-ADD,STACK
|
|
ADD BEG,P-WORDLEN >BEG
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT CLAUSE-ADD:ANY:1:1,WRD,PTR
|
|
GET P-OCLAUSE,P-MATCHLEN
|
|
ADD STACK,2 >PTR
|
|
SUB PTR,1
|
|
PUT P-OCLAUSE,STACK,WRD
|
|
PUT P-OCLAUSE,PTR,0
|
|
PUT P-OCLAUSE,P-MATCHLEN,PTR
|
|
RTRUE
|
|
|
|
|
|
.FUNCT PREP-FIND:ANY:1:1,PREP,CNT,SIZE
|
|
GET PREPOSITIONS,0
|
|
MUL STACK,2 >SIZE
|
|
?PRG1: IGRTR? 'CNT,SIZE /FALSE
|
|
GET PREPOSITIONS,CNT
|
|
EQUAL? STACK,PREP \?PRG1
|
|
SUB CNT,1
|
|
GET PREPOSITIONS,STACK
|
|
RSTACK
|
|
|
|
|
|
.FUNCT SYNTAX-FOUND:ANY:1:1,SYN
|
|
SET 'P-SYNTAX,SYN
|
|
GETB SYN,P-SACTION >PRSA
|
|
RETURN PRSA
|
|
|
|
|
|
.FUNCT SET-GWIM-PRSO?:ANY:0:0
|
|
SET 'GWIM-PRSO?,FALSE-VALUE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT GWIM:ANY:3:3,GBIT,LBIT,PREP,OBJ,VERB,THE-PREP
|
|
EQUAL? GBIT,KLUDGEBIT \?CND1
|
|
RETURN ROOMS
|
|
?CND1: SET 'P-GWIMBIT,GBIT
|
|
SET 'P-SLOCBITS,LBIT
|
|
GET P-ITBL,P-VERB >VERB
|
|
PUT P-MERGE,P-MATCHLEN,0
|
|
CALL GET-OBJECT,P-MERGE,FALSE-VALUE
|
|
ZERO? STACK /?CCL5
|
|
SET 'P-GWIMBIT,0
|
|
GET P-MERGE,P-MATCHLEN
|
|
EQUAL? STACK,1 \FALSE
|
|
GET P-MERGE,1 >OBJ
|
|
PRINTC 40
|
|
ZERO? PREP /?CCL11
|
|
ZERO? P-END-ON-PREP \?CCL11
|
|
CALL2 PREP-FIND,PREP >THE-PREP
|
|
ZERO? GWIM-PRSO? /?CCL16
|
|
EQUAL? VERB,ACT?SAG,ACT?FRAG /?CTR18
|
|
EQUAL? THE-PREP,W?MIT,W?NACH,W?AUS /?CTR18
|
|
EQUAL? THE-PREP,W?ZU,W?VON \?CCL19
|
|
?CTR18: CALL NON-SEP?,VERB,THE-PREP
|
|
ZERO? STACK /?CCL25
|
|
PRINTB THE-PREP
|
|
PRINTC 32
|
|
ICALL2 DER-DAT-PRINT,OBJ
|
|
JUMP ?CND17
|
|
?CCL25: ICALL2 DER-DAT-PRINT,OBJ
|
|
PRINTC 32
|
|
PRINTB THE-PREP
|
|
JUMP ?CND17
|
|
?CCL19: CALL NON-SEP?,VERB,THE-PREP
|
|
ZERO? STACK /?CCL27
|
|
PRINTB THE-PREP
|
|
PRINTC 32
|
|
ICALL2 DER-ACC-PRINT,OBJ
|
|
JUMP ?CND17
|
|
?CCL27: ICALL2 DER-ACC-PRINT,OBJ
|
|
PRINTC 32
|
|
PRINTB THE-PREP
|
|
?CND17: SET 'GWIM-PRSO?,FALSE-VALUE
|
|
JUMP ?CND14
|
|
?CCL16: EQUAL? THE-PREP,W?MIT,W?AUS,W?ZU /?CTR28
|
|
EQUAL? THE-PREP,W?VON,W?NACH \?CCL29
|
|
?CTR28: PRINTB THE-PREP
|
|
PRINTC 32
|
|
ICALL2 DER-DAT-PRINT,OBJ
|
|
JUMP ?CND14
|
|
?CCL29: PRINTB THE-PREP
|
|
PRINTC 32
|
|
ICALL2 DER-ACC-PRINT,OBJ
|
|
?CND14: PRINTC 41
|
|
CRLF
|
|
CRLF
|
|
RETURN OBJ
|
|
?CCL11: EQUAL? VERB,ACT?SAG,ACT?FRAG /?CTR32
|
|
EQUAL? THE-PREP,W?MIT,W?NACH,W?AUS /?CTR32
|
|
EQUAL? THE-PREP,W?ZU,W?VON \?CCL33
|
|
?CTR32: ICALL2 DER-DAT-PRINT,OBJ
|
|
PRINTC 41
|
|
CRLF
|
|
CRLF
|
|
RETURN OBJ
|
|
?CCL33: ICALL2 DER-ACC-PRINT,OBJ
|
|
PRINTC 41
|
|
CRLF
|
|
CRLF
|
|
RETURN OBJ
|
|
?CCL5: SET 'P-GWIMBIT,0
|
|
RFALSE
|
|
|
|
|
|
.FUNCT SNARF-OBJECTS:ANY:0:0,OPTR,IPTR,L
|
|
PUT P-BUTS,P-MATCHLEN,0
|
|
GET P-ITBL,P-NC2 >IPTR
|
|
ZERO? IPTR /?CND1
|
|
GETB P-SYNTAX,P-SLOC2 >P-SLOCBITS
|
|
GET P-ITBL,P-NC2L
|
|
CALL SNARFEM,IPTR,STACK,P-PRSI
|
|
ZERO? STACK /FALSE
|
|
?CND1: GET P-ITBL,P-NC1 >OPTR
|
|
ZERO? OPTR /?CND5
|
|
GETB P-SYNTAX,P-SLOC1 >P-SLOCBITS
|
|
GET P-ITBL,P-NC1L
|
|
CALL SNARFEM,OPTR,STACK,P-PRSO
|
|
ZERO? STACK /FALSE
|
|
?CND5: GET P-BUTS,P-MATCHLEN
|
|
ZERO? STACK /TRUE
|
|
GET P-PRSO,P-MATCHLEN >L
|
|
ZERO? OPTR /?CND11
|
|
CALL2 BUT-MERGE,P-PRSO >P-PRSO
|
|
?CND11: ZERO? IPTR /TRUE
|
|
ZERO? OPTR /?CCL14
|
|
GET P-PRSO,P-MATCHLEN
|
|
EQUAL? L,STACK \TRUE
|
|
?CCL14: CALL2 BUT-MERGE,P-PRSI >P-PRSI
|
|
RTRUE
|
|
|
|
|
|
.FUNCT BUT-MERGE:ANY:1:1,TBL,LEN,BUTLEN,CNT,MATCHES,OBJ,NTBL
|
|
SET 'CNT,1
|
|
GET TBL,P-MATCHLEN >LEN
|
|
PUT P-MERGE,P-MATCHLEN,0
|
|
?PRG1: DLESS? 'LEN,0 /?REP2
|
|
GET TBL,CNT >OBJ
|
|
CALL ZMEMQ,OBJ,P-BUTS
|
|
ZERO? STACK \?CND3
|
|
ADD MATCHES,1
|
|
PUT P-MERGE,STACK,OBJ
|
|
INC 'MATCHES
|
|
?CND3: INC 'CNT
|
|
JUMP ?PRG1
|
|
?REP2: PUT P-MERGE,P-MATCHLEN,MATCHES
|
|
SET 'NTBL,P-MERGE
|
|
SET 'P-MERGE,TBL
|
|
RETURN NTBL
|
|
|
|
|
|
.FUNCT SNARFEM:ANY:3:3,PTR,EPTR,TBL,BUT,LEN,WV,WRD,NW,WAS-ALL
|
|
SET 'P-AND,FALSE-VALUE
|
|
EQUAL? P-GETFLAGS,P-ALL \?CND1
|
|
SET 'WAS-ALL,TRUE-VALUE
|
|
?CND1: SET 'P-GETFLAGS,0
|
|
PUT TBL,P-MATCHLEN,0
|
|
GET PTR,0 >WRD
|
|
?PRG3: EQUAL? PTR,EPTR \?CCL7
|
|
ZERO? BUT /?PRD10
|
|
PUSH BUT
|
|
JUMP ?PEN8
|
|
?PRD10: PUSH TBL
|
|
?PEN8: CALL2 GET-OBJECT,STACK >WV
|
|
ZERO? WAS-ALL \?CCL12
|
|
RETURN WV
|
|
?CCL12: SET 'P-GETFLAGS,P-ALL
|
|
RETURN WV
|
|
?CCL7: ADD PTR,P-WORDLEN
|
|
EQUAL? EPTR,STACK \?CCL15
|
|
SET 'NW,0
|
|
JUMP ?CND13
|
|
?CCL15: GET PTR,P-LEXELEN >NW
|
|
?CND13: EQUAL? WRD,W?ALLES \?CCL18
|
|
SET 'P-GETFLAGS,P-ALL
|
|
EQUAL? NW,W?VOLL \?CND5
|
|
ADD PTR,P-WORDLEN >PTR
|
|
JUMP ?CND5
|
|
?CCL18: EQUAL? WRD,W?ABER,W?AUSSER,W?AU%SER \?CCL22
|
|
ZERO? BUT /?PRD27
|
|
PUSH BUT
|
|
JUMP ?PEN25
|
|
?PRD27: PUSH TBL
|
|
?PEN25: CALL2 GET-OBJECT,STACK
|
|
ZERO? STACK /FALSE
|
|
SET 'BUT,P-BUTS
|
|
PUT BUT,P-MATCHLEN,0
|
|
JUMP ?CND5
|
|
?CCL22: EQUAL? WRD,W?EIN,W?EINE,W?EINEM /?CTR28
|
|
EQUAL? WRD,W?EINEN,W?EINER \?CCL29
|
|
?CTR28: ZERO? P-ADJ \?CCL34
|
|
SET 'P-GETFLAGS,P-ONE
|
|
EQUAL? NW,W?VOLL \?CND5
|
|
ADD PTR,P-WORDLEN >PTR
|
|
JUMP ?CND5
|
|
?CCL34: SET 'P-NAM,P-ONEOBJ
|
|
ZERO? BUT /?PRD41
|
|
PUSH BUT
|
|
JUMP ?PEN39
|
|
?PRD41: PUSH TBL
|
|
?PEN39: CALL2 GET-OBJECT,STACK
|
|
ZERO? STACK /FALSE
|
|
ZERO? NW \?CND5
|
|
RTRUE
|
|
?CCL29: EQUAL? WRD,W?UND,W?COMMA \?CCL45
|
|
EQUAL? NW,W?UND,W?COMMA /?CCL45
|
|
SET 'P-AND,TRUE-VALUE
|
|
ZERO? BUT /?PRD52
|
|
PUSH BUT
|
|
JUMP ?PEN50
|
|
?PRD52: PUSH TBL
|
|
?PEN50: CALL2 GET-OBJECT,STACK
|
|
ZERO? STACK \?CND5
|
|
RFALSE
|
|
?CCL45: CALL WT?,WRD,4
|
|
ZERO? STACK \?CND5
|
|
EQUAL? WRD,W?UND,W?COMMA /?CND5
|
|
EQUAL? WRD,W?VOLL \?CCL56
|
|
ZERO? P-GETFLAGS \?CND5
|
|
SET 'P-GETFLAGS,P-INHIBIT
|
|
JUMP ?CND5
|
|
?CCL56: CALL WT?,WRD,32
|
|
ZERO? STACK /?CCL60
|
|
ZERO? P-ADJ \?CCL60
|
|
SET 'P-ADJ,WRD
|
|
JUMP ?CND5
|
|
?CCL60: CALL WT?,WRD,128,0
|
|
ZERO? STACK /?CND5
|
|
SET 'P-NAM,WRD
|
|
SET 'P-ONEOBJ,WRD
|
|
?CND5: EQUAL? PTR,EPTR /?PRG3
|
|
ADD PTR,P-WORDLEN >PTR
|
|
SET 'WRD,NW
|
|
JUMP ?PRG3
|
|
|
|
|
|
.FUNCT GET-OBJECT:ANY:1:2,TBL,VRB,BITS,LEN,XBITS,TLEN,GCHECK,OLEN,OBJ
|
|
ASSIGNED? 'VRB /?CND1
|
|
SET 'VRB,TRUE-VALUE
|
|
?CND1: SET 'XBITS,P-SLOCBITS
|
|
GET TBL,P-MATCHLEN >TLEN
|
|
BTST P-GETFLAGS,P-INHIBIT /TRUE
|
|
ZERO? P-NAM \?CND5
|
|
ZERO? P-ADJ /?CND5
|
|
CALL WT?,P-ADJ,128,0
|
|
ZERO? STACK /?CCL11
|
|
SET 'P-NAM,P-ADJ
|
|
SET 'P-ADJ,FALSE-VALUE
|
|
?CND5: ZERO? P-NAM \?CND13
|
|
ZERO? P-ADJ \?CND13
|
|
EQUAL? P-GETFLAGS,P-ALL /?CND13
|
|
ZERO? P-GWIMBIT \?CND13
|
|
ZERO? VRB /FALSE
|
|
PRINTI "In diesem Satz scheint ein Substantiv zu fehlen!"
|
|
CRLF
|
|
RFALSE
|
|
?CCL11: CALL WT?,P-ADJ,16,3 >BITS
|
|
ZERO? BITS /?CND5
|
|
SET 'P-ADJ,FALSE-VALUE
|
|
PUT TBL,P-MATCHLEN,1
|
|
PUT TBL,1,INTDIR
|
|
SET 'P-DIRECTION,BITS
|
|
RTRUE
|
|
?CND13: EQUAL? P-GETFLAGS,P-ALL \?CCL22
|
|
ZERO? P-SLOCBITS \?CND21
|
|
?CCL22: SET 'P-SLOCBITS,-1
|
|
?CND21: SET 'P-TABLE,TBL
|
|
?PRG25: ZERO? GCHECK /?CCL29
|
|
ICALL2 GLOBAL-CHECK,TBL
|
|
JUMP ?CND27
|
|
?CCL29: ZERO? LIT /?CND30
|
|
FCLEAR PLAYER,TRANSBIT
|
|
ICALL DO-SL,HERE,SOG,SIR
|
|
FSET PLAYER,TRANSBIT
|
|
?CND30: ICALL DO-SL,PLAYER,SH,SC
|
|
?CND27: GET TBL,P-MATCHLEN
|
|
SUB STACK,TLEN >LEN
|
|
BTST P-GETFLAGS,P-ALL /?CND32
|
|
BTST P-GETFLAGS,P-ONE \?CCL35
|
|
ZERO? LEN /?CCL35
|
|
EQUAL? LEN,1 /?CND38
|
|
RANDOM LEN
|
|
GET TBL,STACK
|
|
PUT TBL,1,STACK
|
|
PRINTC 40
|
|
GET TBL,1
|
|
PRINTD STACK
|
|
PRINTI "?)"
|
|
CRLF
|
|
?CND38: PUT TBL,P-MATCHLEN,1
|
|
JUMP ?CND32
|
|
?CCL35: GRTR? LEN,1 /?CCL40
|
|
ZERO? LEN \?CND32
|
|
EQUAL? P-SLOCBITS,-1 /?CND32
|
|
?CCL40: EQUAL? P-SLOCBITS,-1 \?CCL47
|
|
SET 'P-SLOCBITS,XBITS
|
|
SET 'OLEN,LEN
|
|
GET TBL,P-MATCHLEN
|
|
SUB STACK,LEN
|
|
PUT TBL,P-MATCHLEN,STACK
|
|
JUMP ?PRG25
|
|
?CCL47: ZERO? LEN \?CND48
|
|
SET 'LEN,OLEN
|
|
?CND48: EQUAL? WINNER,PLAYER /?CCL52
|
|
ICALL1 CANT-ORPHAN
|
|
RFALSE
|
|
?CCL52: ZERO? VRB /?CCL54
|
|
ZERO? P-NAM /?CCL54
|
|
ICALL WHICH-PRINT,TLEN,LEN,TBL
|
|
EQUAL? TBL,P-PRSO \?CCL59
|
|
SET 'P-ACLAUSE,P-NC1
|
|
JUMP ?CND57
|
|
?CCL59: SET 'P-ACLAUSE,P-NC2
|
|
?CND57: SET 'P-AADJ,P-ADJ
|
|
SET 'P-ANAM,P-NAM
|
|
ICALL ORPHAN,FALSE-VALUE,FALSE-VALUE
|
|
SET 'P-OFLAG,TRUE-VALUE
|
|
JUMP ?CND50
|
|
?CCL54: ZERO? VRB /?CND50
|
|
PRINTI "In diesem Satz scheint ein Substantiv zu fehlen!"
|
|
CRLF
|
|
?CND50: SET 'P-NAM,FALSE-VALUE
|
|
SET 'P-ADJ,FALSE-VALUE
|
|
RFALSE
|
|
?CND32: ZERO? LEN \?CCL63
|
|
ZERO? GCHECK /?CCL63
|
|
ZERO? VRB /?CND66
|
|
SET 'P-SLOCBITS,XBITS
|
|
ZERO? LIT \?CTR69
|
|
EQUAL? PRSA,V?TELL \?CCL70
|
|
?CTR69: ICALL OBJ-FOUND,NOT-HERE-OBJECT,TBL
|
|
SET 'P-XNAM,P-NAM
|
|
SET 'P-XADJ,P-ADJ
|
|
SET 'P-NAM,FALSE-VALUE
|
|
SET 'P-ADJ,FALSE-VALUE
|
|
RTRUE
|
|
?CCL70: PRINTI "Es ist zu dunkel, um das zu sehen."
|
|
CRLF
|
|
?CND66: SET 'P-NAM,FALSE-VALUE
|
|
SET 'P-ADJ,FALSE-VALUE
|
|
RFALSE
|
|
?CCL63: ZERO? LEN \?CND61
|
|
SET 'GCHECK,TRUE-VALUE
|
|
JUMP ?PRG25
|
|
?CND61: SET 'P-SLOCBITS,XBITS
|
|
SET 'P-NAM,FALSE-VALUE
|
|
SET 'P-ADJ,FALSE-VALUE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT WHICH-PRINT:ANY:3:3,TLEN,LEN,TBL,OBJ,RLEN
|
|
SET 'RLEN,LEN
|
|
PRINTI "Welche"
|
|
INC 'TLEN
|
|
GET TBL,TLEN >OBJ
|
|
FSET? OBJ,DERBIT \?CCL3
|
|
PRINTC 114
|
|
JUMP ?CND1
|
|
?CCL3: FSET? OBJ,DASBIT \?CND1
|
|
PRINTC 115
|
|
?CND1: ZERO? P-OFLAG \?CTR6
|
|
ZERO? P-MERGED \?CTR6
|
|
ZERO? P-AND /?CCL7
|
|
?CTR6: ZERO? P-NAM /?CCL13
|
|
PRINTC 32
|
|
PRINTB P-NAM
|
|
JUMP ?CND5
|
|
?CCL13: ZERO? P-ADJ /?CND5
|
|
PRINTC 32
|
|
PRINTB P-ADJ
|
|
JUMP ?CND5
|
|
?CCL7: PRINTC 32
|
|
EQUAL? TBL,P-PRSO /?PRD15
|
|
PUSH 0
|
|
JUMP ?PRD16
|
|
?PRD15: PUSH 1
|
|
?PRD16: ICALL2 THING-PRINT,STACK
|
|
?CND5: PRINTI " meinst du, "
|
|
?PRG17: ICALL2 DER-ACC-PRINT,OBJ
|
|
INC 'TLEN
|
|
GET TBL,TLEN >OBJ
|
|
EQUAL? LEN,2 \?CCL21
|
|
EQUAL? RLEN,2 /?CND22
|
|
PRINTC 44
|
|
?CND22: PRINTI " or "
|
|
JUMP ?CND19
|
|
?CCL21: GRTR? LEN,2 \?CND19
|
|
PRINTI ", "
|
|
?CND19: DLESS? 'LEN,1 \?PRG17
|
|
PRINTR "?"
|
|
|
|
|
|
.FUNCT GLOBAL-CHECK:ANY:1:1,TBL,LEN,RMG,RMGL,CNT,OBJ,OBITS,FOO
|
|
GET TBL,P-MATCHLEN >LEN
|
|
SET 'OBITS,P-SLOCBITS
|
|
GETPT HERE,P?GLOBAL >RMG
|
|
ZERO? RMG /?CND1
|
|
PTSIZE RMG
|
|
DIV STACK,2
|
|
SUB STACK,1 >RMGL
|
|
?PRG3: GET RMG,CNT >OBJ
|
|
CALL THIS-IT?,OBJ,TBL
|
|
ZERO? STACK /?CND5
|
|
ICALL OBJ-FOUND,OBJ,TBL
|
|
?CND5: IGRTR? 'CNT,RMGL \?PRG3
|
|
?CND1: GET TBL,P-MATCHLEN
|
|
EQUAL? STACK,LEN \FALSE
|
|
SET 'P-SLOCBITS,-1
|
|
SET 'P-TABLE,TBL
|
|
ICALL DO-SL,GLOBAL-OBJECTS,1,1
|
|
SET 'P-SLOCBITS,OBITS
|
|
GET TBL,P-MATCHLEN
|
|
ZERO? STACK \FALSE
|
|
EQUAL? PRSA,V?LOOK-INSIDE,V?SEARCH,V?EXAMINE \FALSE
|
|
CALL DO-SL,ROOMS,1,1
|
|
RSTACK
|
|
|
|
|
|
.FUNCT DO-SL:ANY:3:3,OBJ,BIT1,BIT2,BTS
|
|
ADD BIT1,BIT2
|
|
BTST P-SLOCBITS,STACK \?CCL3
|
|
CALL SEARCH-LIST,OBJ,P-TABLE,P-SRCALL
|
|
RSTACK
|
|
?CCL3: BTST P-SLOCBITS,BIT1 \?CCL6
|
|
CALL SEARCH-LIST,OBJ,P-TABLE,P-SRCTOP
|
|
RSTACK
|
|
?CCL6: BTST P-SLOCBITS,BIT2 \TRUE
|
|
CALL SEARCH-LIST,OBJ,P-TABLE,P-SRCBOT
|
|
RSTACK
|
|
|
|
|
|
.FUNCT SEARCH-LIST:ANY:3:3,OBJ,TBL,LVL,FLS,NOBJ
|
|
FIRST? OBJ >OBJ \FALSE
|
|
?PRG4: EQUAL? LVL,P-SRCBOT /?CND6
|
|
GETPT OBJ,P?SYNONYM
|
|
ZERO? STACK /?CND6
|
|
CALL THIS-IT?,OBJ,TBL
|
|
ZERO? STACK /?CND6
|
|
ICALL OBJ-FOUND,OBJ,TBL
|
|
?CND6: ZERO? LVL \?PRD14
|
|
FSET? OBJ,SEARCHBIT /?PRD14
|
|
FSET? OBJ,SURFACEBIT \?CND11
|
|
?PRD14: FIRST? OBJ >NOBJ \?CND11
|
|
FSET? OBJ,OPENBIT /?CCL12
|
|
FSET? OBJ,TRANSBIT \?CND11
|
|
?CCL12: FSET? OBJ,SURFACEBIT \?CCL23
|
|
PUSH P-SRCALL
|
|
JUMP ?CND21
|
|
?CCL23: FSET? OBJ,SEARCHBIT \?CCL25
|
|
PUSH P-SRCALL
|
|
JUMP ?CND21
|
|
?CCL25: PUSH P-SRCTOP
|
|
?CND21: CALL SEARCH-LIST,OBJ,TBL,STACK >FLS
|
|
?CND11: NEXT? OBJ >OBJ /?PRG4
|
|
RTRUE
|
|
|
|
|
|
.FUNCT OBJ-FOUND:ANY:2:2,OBJ,TBL,PTR
|
|
GET TBL,P-MATCHLEN >PTR
|
|
ADD PTR,1
|
|
PUT TBL,STACK,OBJ
|
|
ADD PTR,1
|
|
PUT TBL,P-MATCHLEN,STACK
|
|
RTRUE
|
|
|
|
|
|
.FUNCT TAKE-CHECK:ANY:0:0
|
|
GETB P-SYNTAX,P-SLOC1
|
|
CALL ITAKE-CHECK,P-PRSO,STACK
|
|
ZERO? STACK /FALSE
|
|
GETB P-SYNTAX,P-SLOC2
|
|
CALL ITAKE-CHECK,P-PRSI,STACK
|
|
RSTACK
|
|
|
|
|
|
.FUNCT ITAKE-CHECK:ANY:2:2,TBL:TABLE,IBITS:FIX,PTR:FIX,OBJ:OBJECT,TAKEN:ANY
|
|
GET TBL,P-MATCHLEN >PTR
|
|
ZERO? PTR /TRUE
|
|
BTST IBITS,SHAVE /?PRG8
|
|
BTST IBITS,STAKE \TRUE
|
|
?PRG8: DLESS? 'PTR,0 /TRUE
|
|
ADD PTR,1
|
|
GET TBL,STACK >OBJ
|
|
EQUAL? OBJ,HIM \?CCL15
|
|
CALL2 ACCESSIBLE?,P-HIM-OBJECT
|
|
ZERO? STACK \?CCL18
|
|
ICALL1 REFERRING
|
|
RFALSE
|
|
?CCL18: SET 'OBJ,P-HIM-OBJECT
|
|
JUMP ?CND13
|
|
?CCL15: EQUAL? OBJ,HER \?CCL20
|
|
CALL2 ACCESSIBLE?,P-HER-OBJECT
|
|
ZERO? STACK \?CCL23
|
|
ICALL1 REFERRING
|
|
RFALSE
|
|
?CCL23: SET 'OBJ,P-HER-OBJECT
|
|
JUMP ?CND13
|
|
?CCL20: EQUAL? OBJ,IT \?CND13
|
|
CALL2 ACCESSIBLE?,P-IT-OBJECT
|
|
ZERO? STACK \?CCL27
|
|
ICALL1 REFERRING
|
|
RFALSE
|
|
?CCL27: SET 'OBJ,P-IT-OBJECT
|
|
?CND13: CALL2 HELD?,OBJ
|
|
ZERO? STACK \?PRG8
|
|
EQUAL? OBJ,HANDS,ME /?PRG8
|
|
SET 'PRSO,OBJ
|
|
FSET? OBJ,TRYTAKEBIT \?CCL34
|
|
SET 'TAKEN,TRUE-VALUE
|
|
JUMP ?CND32
|
|
?CCL34: EQUAL? WINNER,ADVENTURER /?CCL36
|
|
SET 'TAKEN,FALSE-VALUE
|
|
JUMP ?CND32
|
|
?CCL36: BTST IBITS,STAKE \?CCL38
|
|
CALL2 ITAKE,FALSE-VALUE
|
|
EQUAL? STACK,TRUE-VALUE \?CCL38
|
|
SET 'TAKEN,FALSE-VALUE
|
|
JUMP ?CND32
|
|
?CCL38: SET 'TAKEN,TRUE-VALUE
|
|
?CND32: ZERO? TAKEN /?CCL43
|
|
BTST IBITS,SHAVE \?CCL43
|
|
EQUAL? WINNER,ADVENTURER \?CCL43
|
|
EQUAL? OBJ,NOT-HERE-OBJECT \?CND47
|
|
PRINTI "Das hast du nicht!"
|
|
CRLF
|
|
RFALSE
|
|
?CND47: PRINTI "Du hast "
|
|
ICALL2 DER-ACC-PRINT,OBJ
|
|
PRINTI " nicht."
|
|
CRLF
|
|
RFALSE
|
|
?CCL43: ZERO? TAKEN \?PRG8
|
|
EQUAL? WINNER,ADVENTURER \?PRG8
|
|
PRINTC 40
|
|
ICALL2 DER-ACC-CAP-PRINT,OBJ
|
|
PRINTI " erst nehmen)"
|
|
CRLF
|
|
JUMP ?PRG8
|
|
|
|
|
|
.FUNCT REFERRING:ANY:0:0
|
|
PRINTR "Es ist nicht klar, worauf du dich beziehst."
|
|
|
|
|
|
.FUNCT MANY-CHECK:ANY:0:0,LOSS,TMP,?TMP1
|
|
GET P-PRSO,P-MATCHLEN
|
|
GRTR? STACK,1 \?CCL3
|
|
GETB P-SYNTAX,P-SLOC1
|
|
BTST STACK,SMANY /?CCL3
|
|
SET 'LOSS,1
|
|
JUMP ?CND1
|
|
?CCL3: GET P-PRSI,P-MATCHLEN
|
|
GRTR? STACK,1 \?CND1
|
|
GETB P-SYNTAX,P-SLOC2
|
|
BTST STACK,SMANY /?CND1
|
|
SET 'LOSS,2
|
|
?CND1: ZERO? LOSS /TRUE
|
|
PRINTI "Man kann mehrere "
|
|
EQUAL? LOSS,2 \?CCL14
|
|
PRINTI "Dative"
|
|
JUMP ?CND12
|
|
?CCL14: PRINTI "Akkusitiv"
|
|
?CND12: PRINTI " nicht mit %>"
|
|
GET P-ITBL,P-VERBN >TMP
|
|
ZERO? TMP \?CCL17
|
|
PRINTI "das"
|
|
JUMP ?CND15
|
|
?CCL17: ZERO? P-OFLAG \?CTR18
|
|
ZERO? P-MERGED /?CCL19
|
|
?CTR18: GET TMP,0
|
|
PRINTB STACK
|
|
JUMP ?CND15
|
|
?CCL19: GETB TMP,2 >?TMP1
|
|
GETB TMP,3
|
|
ICALL WORD-PRINT,?TMP1,STACK
|
|
?CND15: PRINTI "%< gebrauchen."
|
|
CRLF
|
|
RFALSE
|
|
|
|
|
|
.FUNCT ZMEMQ:ANY:2:3,ITM,TBL,SIZE,CNT
|
|
ASSIGNED? 'SIZE /?CND1
|
|
SET 'SIZE,-1
|
|
?CND1: SET 'CNT,1
|
|
ZERO? TBL /FALSE
|
|
LESS? SIZE,0 /?CCL7
|
|
SET 'CNT,0
|
|
JUMP ?PRG8
|
|
?CCL7: GET TBL,0 >SIZE
|
|
?PRG8: GET TBL,CNT
|
|
EQUAL? ITM,STACK \?CCL12
|
|
MUL CNT,2
|
|
ADD TBL,STACK
|
|
RSTACK
|
|
?CCL12: IGRTR? 'CNT,SIZE \?PRG8
|
|
RFALSE
|
|
|
|
|
|
.FUNCT LIT?:ANY:1:2,RM,RMBIT,OHERE,LIT
|
|
ASSIGNED? 'RMBIT /?CND1
|
|
SET 'RMBIT,TRUE-VALUE
|
|
?CND1: ZERO? ALWAYS-LIT /?CND3
|
|
EQUAL? WINNER,PLAYER /TRUE
|
|
?CND3: SET 'P-GWIMBIT,ONBIT
|
|
SET 'OHERE,HERE
|
|
SET 'HERE,RM
|
|
ZERO? RMBIT /?CCL9
|
|
FSET? RM,ONBIT \?CCL9
|
|
SET 'LIT,TRUE-VALUE
|
|
JUMP ?CND7
|
|
?CCL9: PUT P-MERGE,P-MATCHLEN,0
|
|
SET 'P-TABLE,P-MERGE
|
|
SET 'P-SLOCBITS,-1
|
|
EQUAL? OHERE,RM \?CND12
|
|
ICALL DO-SL,WINNER,1,1
|
|
EQUAL? WINNER,PLAYER /?CND12
|
|
IN? PLAYER,RM \?CND12
|
|
ICALL DO-SL,PLAYER,1,1
|
|
?CND12: ICALL DO-SL,RM,1,1
|
|
GET P-TABLE,P-MATCHLEN
|
|
GRTR? STACK,0 \?CND7
|
|
SET 'LIT,TRUE-VALUE
|
|
?CND7: SET 'HERE,OHERE
|
|
SET 'P-GWIMBIT,0
|
|
RETURN LIT
|
|
|
|
|
|
.FUNCT THIS-IT?:ANY:2:2,OBJ,TBL,SYNS
|
|
FSET? OBJ,INVISIBLE /FALSE
|
|
ZERO? P-NAM /?CCL5
|
|
GETPT OBJ,P?SYNONYM >SYNS
|
|
PTSIZE SYNS
|
|
DIV STACK,2
|
|
SUB STACK,1
|
|
CALL ZMEMQ,P-NAM,SYNS,STACK
|
|
ZERO? STACK /FALSE
|
|
?CCL5: ZERO? P-ADJ /?CCL9
|
|
GETPT OBJ,P?ADJECTIVE >SYNS
|
|
ZERO? SYNS /FALSE
|
|
PTSIZE SYNS
|
|
DIV STACK,2
|
|
SUB STACK,1
|
|
CALL ZMEMQ,P-ADJ,SYNS,STACK
|
|
ZERO? STACK /FALSE
|
|
?CCL9: ZERO? P-GWIMBIT /TRUE
|
|
FSET? OBJ,P-GWIMBIT /TRUE
|
|
RFALSE
|
|
|
|
|
|
.FUNCT ACCESSIBLE?:ANY:1:1,OBJ,L,?TMP1
|
|
ZERO? OBJ /FALSE
|
|
LOC OBJ >L
|
|
ZERO? L /FALSE
|
|
FSET? OBJ,INVISIBLE /FALSE
|
|
ZERO? L /FALSE
|
|
EQUAL? L,GLOBAL-OBJECTS /TRUE
|
|
EQUAL? L,LOCAL-GLOBALS \?CCL14
|
|
CALL GLOBAL-IN?,OBJ,HERE
|
|
ZERO? STACK \TRUE
|
|
?CCL14: CALL2 META-LOC,OBJ >?TMP1
|
|
LOC WINNER
|
|
EQUAL? ?TMP1,HERE,STACK \FALSE
|
|
LOC WINNER
|
|
EQUAL? L,WINNER,HERE,STACK /TRUE
|
|
FSET? L,OPENBIT \FALSE
|
|
CALL2 ACCESSIBLE?,L
|
|
ZERO? STACK /FALSE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT META-LOC:ANY:1:1,OBJ
|
|
?PRG1: ZERO? OBJ /FALSE
|
|
IN? OBJ,GLOBAL-OBJECTS \?CND3
|
|
RETURN GLOBAL-OBJECTS
|
|
?CND3: IN? OBJ,ROOMS \?CCL9
|
|
RETURN OBJ
|
|
?CCL9: LOC OBJ >OBJ
|
|
JUMP ?PRG1
|
|
|
|
.ENDI
|