abyss/breds.zap
historicalsource 2ac9da82cb Final Revision
2019-04-14 16:25:39 -04:00

573 lines
11 KiB
Plaintext

.SEGMENT "0"
.FUNCT RED-BE-FORM:ANY:0:2,N,TYP
PUT PARSE-RESULT,2,TLEXV
POP DATA-STACK
PUT PARSE-RESULT,1,STACK
RTRUE
.FUNCT EXCH-4-5-Q:ANY:3:3,RED,N,TYP,X1,X2,X3,X4,X5
POP DATA-STACK >X1
POP DATA-STACK >X2
POP DATA-STACK >X3
POP DATA-STACK >X4
POP DATA-STACK >X5
EQUAL? N,6 \?CCL3
DEC 'N
POP DATA-STACK
PUT PARSE-RESULT,10,STACK
JUMP ?CND1
?CCL3: PUT PARSE-RESULT,10,0
?CND1: CALL2 PMEM?,X3
ZERO? STACK /?CCL6
XPUSH X3,DATA-STACK /?CND4
JUMP ?CND4
?CCL6: XPUSH X4,DATA-STACK /?CND4
?CND4: XPUSH X5,DATA-STACK /?BOGUS9
?BOGUS9: CALL2 PMEM?,X3
ZERO? STACK /?CCL12
XPUSH X4,DATA-STACK /?CND10
JUMP ?CND10
?CCL12: XPUSH X3,DATA-STACK /?CND10
?CND10: XPUSH X2,DATA-STACK /?BOGUS15
?BOGUS15: XPUSH X1,DATA-STACK /?BOGUS16
?BOGUS16: GET PARSE-RESULT,16
BOR PARSE-QUESTION,STACK
PUT PARSE-RESULT,16,STACK
CALL RED,N,TYP
RSTACK
.FUNCT RED-SBNN:ANY:0:2,N,TYP
CALL EXCH-4-5-Q,RED-SNBN,N,TYP
RSTACK
.FUNCT RED-SNBN:ANY:0:2,N,TYP,OK,NPP,OBJ,VERB,X,?TMP1
GET PARSE-RESULT,1 >VERB
POP DATA-STACK >NPP
ADD WORD-FLAG-TABLE,2 >?TMP1
GET WORD-FLAG-TABLE,0
INTBL? VERB,?TMP1,STACK,132 >X \?CCL6
GET X,1
JUMP ?CND4
?CCL6: PUSH FALSE-VALUE
?CND4: BTST STACK,1024 \?CCL3
POP DATA-STACK
EQUAL? TRUE-VALUE,STACK /?CND1
SET 'OK,TRUE-VALUE
JUMP ?CND1
?CCL3: POP DATA-STACK
EQUAL? TRUE-VALUE,STACK \?CND1
SET 'OK,TRUE-VALUE
?CND1: ZERO? OK /FALSE
CALL2 DETERMINE-SUBJ,VERB
ZERO? STACK /FALSE
CALL DETERMINE-OBJ,NPP,2 >OBJ
ZERO? OBJ \?CCL19
CALL PARSER-ERROR,0,PARSER-ERROR-NOOBJ,NPP
RSTACK
?CCL19: GET PARSE-RESULT,5
GET STACK,4
GET STACK,2
GET STACK,4 >?TMP1
ZERO? ?TMP1 /?PRD26
PUSH ?TMP1
JUMP ?PEN24
?PRD26: GET PARSE-RESULT,5
GET STACK,4
GET STACK,2
GET STACK,3
GET STACK,4
?PEN24: BTST STACK,32768 /?CCL21
GET PARSE-RESULT,5
GET STACK,4
GET STACK,2
GET STACK,4 >?TMP1
ZERO? ?TMP1 /?PRD29
PUSH ?TMP1
JUMP ?PEN27
?PRD29: GET PARSE-RESULT,5
GET STACK,4
GET STACK,2
GET STACK,3
GET STACK,4
?PEN27: BAND STACK,256
BAND STACK,32767
ZERO? STACK \FALSE
?CCL21: PUT PARSE-RESULT,6,OBJ
RETURN PARSE-RESULT
.FUNCT DETERMINE-SUBJ:ANY:1:3,VERB,SHORT,N1,DATA,TMP,OBJ1,?TMP1
ZERO? SHORT \?CND1
POP DATA-STACK
EQUAL? TRUE-VALUE,STACK /?CND1
GET PARSE-RESULT,16
BOR PARSE-NOT,STACK
PUT PARSE-RESULT,16,STACK
?CND1: POP DATA-STACK
ZERO? SHORT /?CCL7
POP DATA-STACK >TMP
PUT PARSE-RESULT,10,TMP
JUMP ?CND5
?CCL7: GET PARSE-RESULT,10 >TMP
?CND5: EQUAL? TMP,0,1 /?CCL9
GET TMP,4 >?TMP1
ZERO? ?TMP1 /?PRD16
PUSH ?TMP1
JUMP ?PEN14
?PRD16: GET TMP,3
GET STACK,4
?PEN14: BTST STACK,32768 /?CCL9
GET TMP,4 >?TMP1
ZERO? ?TMP1 /?PRD19
PUSH ?TMP1
JUMP ?PEN17
?PRD19: GET TMP,3
GET STACK,4
?PEN17: BAND STACK,256
BAND STACK,32767
ZERO? STACK \?CND8
?CCL9: GET PARSE-RESULT,16
BTST STACK,2 \?CCL22
SET 'TMP,W?BE?
JUMP ?CND8
?CCL22: SET 'TMP,W?BE
?CND8: GET TMP,3 >DATA
ZERO? SHORT /?CCL28
GET DATA,2 >TMP
JUMP ?CND26
?CCL28: GET DATA,3 >TMP
?CND26: ZERO? TMP \?CCL25
CALL PARSER-ERROR,0,PARSER-ERROR-TMNOUN
RSTACK
?CCL25: CALL GET-SYNTAX,TMP,1,1 >TMP
ZERO? TMP \?CCL30
CALL PARSER-ERROR,0,PARSER-ERROR-NOUND
RSTACK
?CCL30: ZERO? N1 /?PRD35
PUSH N1
JUMP ?PEN33
?PRD35: POP DATA-STACK >N1
PUSH N1
?PEN33: CALL DETERMINE-OBJ,STACK,1 >OBJ1
ZERO? OBJ1 \?CCL32
CALL PARSER-ERROR,0,PARSER-ERROR-NOOBJ,N1
RSTACK
?CCL32: PUT PARSE-RESULT,5,OBJ1
GET TMP,0
PUT PARSE-RESULT,4,STACK
RTRUE
.FUNCT RED-SBNA:ANY:0:2,N,TYP
CALL EXCH-4-5-Q,RED-SNBA,N,TYP
RSTACK
.FUNCT RED-SNBA:ANY:0:2,N,TYP,OK,ADJ,VERB,X,?TMP1
GET PARSE-RESULT,1 >VERB
POP DATA-STACK >ADJ
ADD WORD-FLAG-TABLE,2 >?TMP1
GET WORD-FLAG-TABLE,0
INTBL? VERB,?TMP1,STACK,132 >X \?CCL6
GET X,1
JUMP ?CND4
?CCL6: PUSH FALSE-VALUE
?CND4: BTST STACK,1024 \?CCL3
POP DATA-STACK
EQUAL? TRUE-VALUE,STACK /?CND1
SET 'OK,TRUE-VALUE
JUMP ?CND1
?CCL3: POP DATA-STACK
EQUAL? TRUE-VALUE,STACK \?CND1
SET 'OK,TRUE-VALUE
?CND1: ZERO? OK /FALSE
CALL2 DETERMINE-SUBJ,VERB
ZERO? STACK /FALSE
GET PARSE-RESULT,5
GET STACK,4
GET STACK,2
GET STACK,4 >?TMP1
ZERO? ?TMP1 /?PRD24
PUSH ?TMP1
JUMP ?PEN22
?PRD24: GET PARSE-RESULT,5
GET STACK,4
GET STACK,2
GET STACK,3
GET STACK,4
?PEN22: BTST STACK,32768 /?CCL19
GET PARSE-RESULT,5
GET STACK,4
GET STACK,2
GET STACK,4 >?TMP1
ZERO? ?TMP1 /?PRD27
PUSH ?TMP1
JUMP ?PEN25
?PRD27: GET PARSE-RESULT,5
GET STACK,4
GET STACK,2
GET STACK,3
GET STACK,4
?PEN25: BAND STACK,256
BAND STACK,32767
ZERO? STACK \FALSE
?CCL19: CALL DO-PMEM-ALLOC,4,NOUN-PHRASE-MIN-LENGTH >X
PUT X,1,1
PUT X,3,INTADJ
PUT PARSE-RESULT,6,X
PUT PARSE-RESULT,11,ADJ
RETURN PARSE-RESULT
.FUNCT RED-SBNP:ANY:0:2,N,TYP
CALL EXCH-4-5-Q,RED-SNBP,N,TYP
RSTACK
.FUNCT RED-SNBP:ANY:0:2,N,TYP,OK,PP,VERB,X,?TMP1
GET PARSE-RESULT,1 >VERB
POP DATA-STACK >PP
ADD WORD-FLAG-TABLE,2 >?TMP1
GET WORD-FLAG-TABLE,0
INTBL? VERB,?TMP1,STACK,132 >X \?CCL6
GET X,1
JUMP ?CND4
?CCL6: PUSH FALSE-VALUE
?CND4: BTST STACK,1024 \?CCL3
POP DATA-STACK
EQUAL? TRUE-VALUE,STACK /?CND1
SET 'OK,TRUE-VALUE
JUMP ?CND1
?CCL3: POP DATA-STACK
EQUAL? TRUE-VALUE,STACK \?CND1
SET 'OK,TRUE-VALUE
?CND1: ZERO? OK /FALSE
CALL2 DETERMINE-SUBJ,VERB
ZERO? STACK /FALSE
GET PARSE-RESULT,5
GET STACK,4
GET STACK,2
GET STACK,4 >?TMP1
ZERO? ?TMP1 /?PRD25
PUSH ?TMP1
JUMP ?PEN23
?PRD25: GET PARSE-RESULT,5
GET STACK,4
GET STACK,2
GET STACK,3
GET STACK,4
?PEN23: BTST STACK,32768 /?CCL20
GET PARSE-RESULT,5
GET STACK,4
GET STACK,2
GET STACK,4 >?TMP1
ZERO? ?TMP1 /?PRD28
PUSH ?TMP1
JUMP ?PEN26
?PRD28: GET PARSE-RESULT,5
GET STACK,4
GET STACK,2
GET STACK,3
GET STACK,4
?PEN26: BAND STACK,256
BAND STACK,32767
ZERO? STACK \FALSE
?CCL20: CALL DO-PMEM-ALLOC,4,NOUN-PHRASE-MIN-LENGTH >X
PUT X,1,1
PUT X,3,INTPP
PUT PARSE-RESULT,6,X
GET PARSE-RESULT,3
CALL REDUCE-LOCATION,PP,STACK,2 >OK
ZERO? OK /?CCL31
PUT PARSE-RESULT,9,OK
RETURN PARSE-RESULT
?CCL31: PUT PARSE-RESULT,9,PP
RETURN PARSE-RESULT
.FUNCT RED-SNBAP:ANY:0:2,N,TYP,OK,ADJ,PP,VERB,X,?TMP1
GET PARSE-RESULT,1 >VERB
POP DATA-STACK >PP
POP DATA-STACK >ADJ
ADD WORD-FLAG-TABLE,2 >?TMP1
GET WORD-FLAG-TABLE,0
INTBL? VERB,?TMP1,STACK,132 >X \?CCL6
GET X,1
JUMP ?CND4
?CCL6: PUSH FALSE-VALUE
?CND4: BTST STACK,1024 \?CCL3
POP DATA-STACK
EQUAL? TRUE-VALUE,STACK /?CND1
SET 'OK,TRUE-VALUE
JUMP ?CND1
?CCL3: POP DATA-STACK
EQUAL? TRUE-VALUE,STACK \?CND1
SET 'OK,TRUE-VALUE
?CND1: ZERO? OK /FALSE
CALL2 DETERMINE-SUBJ,VERB
ZERO? STACK /FALSE
GET PARSE-RESULT,5
GET STACK,4
GET STACK,2
GET STACK,4 >?TMP1
ZERO? ?TMP1 /?PRD25
PUSH ?TMP1
JUMP ?PEN23
?PRD25: GET PARSE-RESULT,5
GET STACK,4
GET STACK,2
GET STACK,3
GET STACK,4
?PEN23: BTST STACK,32768 /?CCL20
GET PARSE-RESULT,5
GET STACK,4
GET STACK,2
GET STACK,4 >?TMP1
ZERO? ?TMP1 /?PRD28
PUSH ?TMP1
JUMP ?PEN26
?PRD28: GET PARSE-RESULT,5
GET STACK,4
GET STACK,2
GET STACK,3
GET STACK,4
?PEN26: BAND STACK,256
BAND STACK,32767
ZERO? STACK \FALSE
?CCL20: CALL DO-PMEM-ALLOC,4,4 >X
PUT X,1,1
PUT X,3,INTPP
SET 'OK,X
PUT PARSE-RESULT,6,OK
GET PARSE-RESULT,3
CALL REDUCE-LOCATION,PP,STACK,2 >OK
ZERO? OK /?CCL31
PUT PARSE-RESULT,9,OK
JUMP ?CND29
?CCL31: GET PP,2
CALL2 DETERMINE-OBJ,STACK >OK
ZERO? OK /?CND32
PUT PP,2,OK
PUTB PP,1,PMEM-TYPE-LOCATION
?CND32: PUT PARSE-RESULT,9,PP
?CND29: PUT PARSE-RESULT,11,ADJ
RETURN PARSE-RESULT
.FUNCT P-PP-OBJ:ANY:0:0,TMP
GET PARSE-RESULT,9 >TMP
ZERO? TMP /FALSE
GETB TMP,1
EQUAL? STACK,6 \FALSE
GET TMP,2 >TMP
ZERO? TMP /FALSE
GET TMP,3
RSTACK
.FUNCT P-PP-PREP:ANY:0:0,TMP
GET PARSE-RESULT,9 >TMP
ZERO? TMP /FALSE
GET TMP,1
RSTACK
.FUNCT RED-SQBN:ANY:0:2,N,TYP,?TMP1
GET PARSE-RESULT,1 >?TMP1
POP DATA-STACK
CALL DETERMINE-SUBJ,?TMP1,TRUE-VALUE,STACK
ZERO? STACK /FALSE
RETURN PARSE-RESULT
.FUNCT RED-BE:ANY:0:2,N,TYP,E
EQUAL? N,1 \TRUE
POP DATA-STACK >E
EQUAL? W?BE,E \FALSE
RETURN E
.FUNCT RED-NOT:ANY:0:2,N,TYP,E
EQUAL? N,1 \TRUE
POP DATA-STACK >E
EQUAL? W?NOT,E \FALSE
RETURN E
.FUNCT RED-CANDO:ANY:0:2,N,TYP,TMP,OBJ,SUBJ,WD,END,?TMP1
ZERO? N /TRUE
EQUAL? N,1 \?CCL5
POP DATA-STACK >SUBJ
GET SUBJ,2
GET STACK,4 >?TMP1
ZERO? ?TMP1 /?PRD13
PUSH ?TMP1
JUMP ?PEN11
?PRD13: GET SUBJ,2
GET STACK,3
GET STACK,4
?PEN11: BTST STACK,32768 /?CCL8
GET SUBJ,2
GET STACK,4 >?TMP1
ZERO? ?TMP1 /?PRD16
PUSH ?TMP1
JUMP ?PEN14
?PRD16: GET SUBJ,2
GET STACK,3
GET STACK,4
?PEN14: BAND STACK,256
BAND STACK,32767
ZERO? STACK \FALSE
?CCL8: CALL2 DETERMINE-OBJ,SUBJ >OBJ
ZERO? OBJ \?CCL19
CALL PARSER-ERROR,0,PARSER-ERROR-NOOBJ,SUBJ
RSTACK
?CCL19: GET OBJ,1
EQUAL? STACK,1 \FALSE
GET OBJ,3
FSET? STACK,PERSONBIT \FALSE
PUT PARSE-RESULT,13,OBJ
RTRUE
?CCL5: POP DATA-STACK >SUBJ
CALL2 PMEM?,SUBJ
ZERO? STACK /?CCL26
POP DATA-STACK
GET PARSE-RESULT,16
BOR PARSE-NOT,STACK
PUT PARSE-RESULT,16,STACK
JUMP ?CND24
?CCL26: EQUAL? TRUE-VALUE,SUBJ /?CND27
GET PARSE-RESULT,16
BOR PARSE-NOT,STACK
PUT PARSE-RESULT,16,STACK
?CND27: POP DATA-STACK >SUBJ
EQUAL? N,3 \?CND24
PUT PARSE-RESULT,14,SUBJ
?CND24: POP DATA-STACK >TMP
EQUAL? N,3 \?CCL33
SET 'SUBJ,TMP
GET PARSE-RESULT,14 >TMP
JUMP ?CND31
?CCL33: GET PARSE-RESULT,16
BOR PARSE-QUESTION,STACK
PUT PARSE-RESULT,16,STACK
PUT PARSE-RESULT,14,TMP
?CND31: GET TMP,4 >?TMP1
ZERO? ?TMP1 /?PRD42
PUSH ?TMP1
JUMP ?PEN40
?PRD42: GET TMP,3
GET STACK,4
?PEN40: BTST STACK,32768 /?PRD37
GET TMP,4 >?TMP1
ZERO? ?TMP1 /?PRD45
PUSH ?TMP1
JUMP ?PEN43
?PRD45: GET TMP,3
GET STACK,4
?PEN43: BAND STACK,1
BAND STACK,32767
ZERO? STACK \?CND34
?PRD37: GET TMP,3 >OBJ
ZERO? OBJ /?CND34
SET 'TMP,OBJ
?CND34: GET TMP,3
GET STACK,2 >TMP
ZERO? TMP \?CCL48
CALL PARSER-ERROR,0,PARSER-ERROR-TMNOUN
RSTACK
?CCL48: CALL GET-SYNTAX,TMP,1,1 >TMP
ZERO? TMP \?CCL50
CALL PARSER-ERROR,0,PARSER-ERROR-NOUND
RSTACK
?CCL50: CALL DETERMINE-OBJ,SUBJ,1 >OBJ
ZERO? OBJ \?CCL52
CALL PARSER-ERROR,0,PARSER-ERROR-NOOBJ,SUBJ
RSTACK
?CCL52: PUT PARSE-RESULT,13,OBJ
PUT PARSE-RESULT,15,TMP
EQUAL? N,3 /TRUE
POP DATA-STACK >TMP
EQUAL? TRUE-VALUE,TMP \?CCL57
PUSH 0
JUMP ?CND55
?CCL57: PUSH TMP
?CND55: PUT PARSE-RESULT,10,STACK
EQUAL? TMP,W?WHAT,W?WHO \TRUE
INTBL? W?PERIOD,TLEXV,P-LEN,132 >SUBJ /?BOGUS60
?BOGUS60: ZERO? SUBJ \?CND61
INTBL? W?THEN,TLEXV,P-LEN,132 >SUBJ /?CND61
?CND61: ZERO? SUBJ \?CND64
INTBL? W??,TLEXV,P-LEN,132 >SUBJ /?CND64
?CND64: ZERO? SUBJ \?CND67
SUB P-LEN,1
MUL STACK,4
ADD TLEXV,STACK >SUBJ
?CND67: SET 'END,4
?PRG69: GET SUBJ,0 >WD
EQUAL? TMP,WD /TRUE
GET WD,4 >?TMP1
ZERO? ?TMP1 /?PRD80
PUSH ?TMP1
JUMP ?PEN78
?PRD80: GET WD,3
GET STACK,4
?PEN78: BTST STACK,32768 /?CCL75
GET WD,4 >?TMP1
ZERO? ?TMP1 /?PRD83
PUSH ?TMP1
JUMP ?PEN81
?PRD83: GET WD,3
GET STACK,4
?PEN81: BAND STACK,1
BAND STACK,32767
ZERO? STACK /?CCL75
ADD SUBJ,4
ICALL INSERT-WHAT,TMP,STACK
RTRUE
?CCL75: GET WD,4 >?TMP1
ZERO? ?TMP1 /?PRD90
PUSH ?TMP1
JUMP ?PEN88
?PRD90: GET WD,3
GET STACK,4
?PEN88: BTST STACK,32768 /?CCL85
GET WD,4 >?TMP1
ZERO? ?TMP1 /?PRD93
PUSH ?TMP1
JUMP ?PEN91
?PRD93: GET WD,3
GET STACK,4
?PEN91: BAND STACK,2048
BAND STACK,32767
ZERO? STACK /?CCL85
ADD SUBJ,END
ICALL INSERT-WHAT,TMP,STACK
RTRUE
?CCL85: SUB SUBJ,4 >SUBJ
GRTR? TLEXV,SUBJ \?PRG69
SET 'END,0
RTRUE
.FUNCT INSERT-WHAT:ANY:2:2,TMP,SUBJ
SUB SUBJ,4
GET STACK,0
EQUAL? TMP,STACK /FALSE
SUB SUBJ,P-LEXV
DIV STACK,2
ICALL INSERT-ADJS-WD,STACK,TMP
INC 'P-OLEN
CALL2 COPY-INPUT,1
RSTACK
.ENDSEG
.ENDI