github.com/erkyrath.infocom-zcode-terps
1
0
Fork 0
mirror of https://github.com/erkyrath/infocom-zcode-terps.git synced 2026-01-11 23:43:24 +00:00
Code Issues Packages Projects Releases Wiki Activity
erkyrath.infocom-zcode-terps/cpm86/cpm86.old
Andrew Plotkin b642da811e Initial commit.
2023-11-16 18:19:54 -05:00

2766 lines
65 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

TITLE 'ZIP: CPM/86 VERSION'
;
; MODIFIED 6/18/84 BY DAN HORN
; 1) Changed Verify Version Letter
; 2) Increased size of save for Opsave
; Changes noted with (***)
; 3) Fixed Random Bug
;
CSEG
START: MOV AX,.15H
MOV SS,AX
MOV SP,OFFSET STK_TOP
MOV DI,OFFSET ZSTK_TP
MOV CL,CFOPEN
MOV DX,OFFSET CNFFCB
INT 224 ;OPEN CONFIGURATION FILE
CMP AL,0FFH
JE ST1M ;NONE FOUND, USE DEFAULT
MOV CL,CRDSEQ
MOV DX,OFFSET CNFFCB
MOV AX,DS
MOV ES,AX
PUSH ES
INT 224 ;READ FIRST BLOCK
POP ES
CMP AL,0
JNE ST1M
MOV CX,80H
MOV SI,80H
MOV DI,100H
REP MOVS AL,AL ;TRANSFER STUFF FROM BUFFER TO 100H
MOV CL,CRDSEQ
MOV DX,OFFSET CNFFCB
PUSH ES
INT 224 ;READ SECOND BLOCK
POP ES
CMP AL,0
JNE ST1M
MOV CX,80H
MOV SI,80H
MOV DI,180H
REP MOVS AL,AL ;TRANSFER STUFF FROM BUFFER TO 180H
MOV CL,CFCLOS
MOV DX,OFFSET CNFFCB
PUSH ES
INT 224 ;CLOSE CONFIG. FILE
POP ES
ST1M: MOV CL,CFNMEM
MOV DX,OFFSET MBSTT
INT 224 ;GET SOME MEMORY, PLEASE
CMP AL,0FFH
JE MERR1
MOV AX,MBLEN ;GET LENGTH
CMP AX,800H
JB MERR1 ;DIE IF LESS THAN 32K (JL LOST ON 100+)
CMP AX,1000H
JBE STARTM
MOV MBLEN,1000H ;TAKE 64K AT MOST
STARTM: MOV CL,CALMEM
MOV DX,OFFSET MBSTT
INT 224 ;ALLOCATE THE BLOCK
CMP AL,0FFH
JE MERR1 ;SHOULDN'T EVER HAPPEN
MOV AX,MBSTT ;STARTING PARAGRAPH
MOV ES,AX ;AND THAT BECOMES OUR ES
JMP ZIPBGN ;JUMP TO BEGINNING OF ZIP CODE
MERR1: MOV AX,OFFSET FTL10
JMP FATAL
FEEP: MOV AX,7
CALL M_TTYO ;BELL
RET
OPVERI: MOV AX,OFFSET INTVER
CALL M_PRNT
MOV AX,ES:.PLENTH ;GET LENGTH OF FILE
PUSH SI
PUSH DI
PUSH ENDLOD
XCHG AH,AL
CALL BSPLIT
MOV SI,AX
MOV DI,BX ;SAVE PLENTH ZPC1/ZPC2
MOV AX,0 ;START AT BYTE 64
MOV BX,64
MOV DX,0 ;WILL HAVE CHECKSUM
MOV ENDLOD,0 ;FAKE IT TO BE ZERO
OPVR1: PUSH SI
PUSH DI
PUSH DX
CALL GETBYT
POP DX
POP DI
POP SI
ADD DX,CX ;ADD INTO CHECKSUM
CMP AX,SI
JNE OPVR1
CMP BX,DI
JNE OPVR1
MOV AX,ES:.PCHKSM ;GET CHECKSUM
XCHG AH,AL
POP ENDLOD ;RESTORE FROBS
POP DI
POP SI
CMP AX,DX ;COMPARE WITH GOOD CHECKSUM
JNE OPVR2
JMP PTRUE
OPVR2: JMP PFALSE
OPREST: MOV DSKDIR,0 ;INDICATE RESTORE
JMP OSV0
OPSAVE: MOV DSKDIR,1
OSV0: MOV AX,OFFSET SAV1
CALL M_PRNT ;PRINT 'File name (default is '
MOV AL,SAVFCB
CMP AL,0
JE OSVD1
ADD AL,'A'-1 ;MAKE THIS AN ASCII THING
CALL M_TTYO ;AND OUTPUT IT
MOV AL,':'
CALL M_TTYO
OSVD1: MOV CX,8 ;MAX. FIRST FILE NAME
MOV BX,OFFSET SAVFCB
OSVD3: INC BX ;POINT TO START OF SAVFCB
MOV AL,BYTE PTR [BX]
CMP AL,20H ;CHECK FOR SPACE
JE OSVD2
CALL M_TTYO ;OUTPUT IT
LOOP OSVD3
OSVD2: MOV AL,'.'
CALL M_TTYO ;AND THE PERIOD
MOV CX,3 ;MAX. EXTENSION
MOV BX,OFFSET SAVFCB
ADD BL,8 ;POINT TO EXTENSION
OSVD4: INC BX
MOV AL,BYTE PTR [BX]
CALL M_TTYO
LOOP OSVD4
MOV AX,OFFSET SAV2
CALL M_PRNT ;PRINT THE ': ' PROMPT
MOV BX,OFFSET INBUF
MOV AL,14 ;SAY MAX. LENGTH IS 14 (X:XXXXXXXX.XXX)
MOV BYTE PTR [BX],AL
MOV DX,BX
MOV CL,CRDLIN
PUSH ES
INT 224 ;BUFFERED CONSOLE READ
POP ES
MOV AL,10
CALL M_TTYO ;ECHO A LF (CHOMPER!)
MOV BX,OFFSET INBUF
MOV CL,BYTE PTR 1 [BX]
ADD BX,2 ;GO PAST THE HEADER
SUB CH,CH ;# CHARACTERS READ
CMP CL,0
JE OSVKL ;USE DEFAULT IF ZERO
CMP CL,2 ;CHECK FOR <2 CHARACTERS
JL OSVP2
MOV AL,BYTE PTR 1 [BX]
CMP AL,':' ;CHECK FOR DEVICE NAME
JNE OSVP2
MOV AL,BYTE PTR [BX]
CMP AL,'a'
JL OSVXC
CMP AL,'z'
JG OSVXC
SUB AL,32
OSVXC: SUB AL,'A'-1
JGE OSVP0
MOV AX,OFFSET ERR3
JMP OSVPER ;ILLEGAL IF <0
OSVKL: JMP OSVPN
OSVP0: CMP AL,16
JLE OSVP1
MOV AX,OFFSET ERR3
JMP OSVPER ;OR >16
OSVP1: MOV SAVFCB,AL ;SAVE IT AWAY
ADD BX,2 ;AND FLUSH IT
SUB CL,2 ;FLUSH 'EM FROM CL TOO
JE OSVPN ;THAT'S ALL FOLKS....
OSVP2: MOV BP,OFFSET SAVFCB
MOV DL,8 ;MAX. FIRST FILE NAME
OSVP3: INC BP ;POINT TO FIRST FILE NAME STUFF
MOV AL,BYTE PTR [BX];GET THE NEXT CHARACTER
CMP CL,0
JG OSVP3A
MOV AL,20H ;IF WE'RE OUT OF INPUT, USE SPACE
OSVP3A: CMP AL,'.'
JE OSVP4
CMP AL,'a'
JL OSVCP1
CMP AL,'z'
JG OSVCP1
SUB AL,32 ;UPPERCASE, IF NECESSARY
OSVCP1: MOV DS:BYTE PTR [BP],AL
INC BX
DEC CL
DEC DL
JNZ OSVP3
CMP CL,0
JLE OSVPN
MOV AL,BYTE PTR [BX]
CMP AL,'.'
JE OSVP4
MOV AX,OFFSET ERR3
JMP OSVPER ;BETTER BE A PERIOD
OSVP4: INC BX
MOV AL,20H
CMP DL,0 ;LOOP PADDING WITH SPACES
JE OSVP6
OSVP5: MOV DS:BYTE PTR [BP],AL
INC BP
DEC DL
JNZ OSVP5
CMP CL,4 ;SHOULD BE FOUR LEFT '.XXX'
JE OSVP6
MOV AX,OFFSET ERR3
JMP OSVPER
OSVP6: MOV AL,BYTE PTR [BX]
MOV DS:BYTE PTR [BP],AL
INC BP
INC BX
LOOP OSVP6
OSVPN: MOV BX,OFFSET SAVFCB
ADD BX,12 ;GO PAST THE FILE NAMES
MOV CX,30
MOV AL,0 ;FILL WITH ZEROS
OSVPNZ: MOV [BX],AL
INC BX
LOOP OSVPNZ
CMP DSKDIR,1 ;CHECK FOR SAVE OR RESTORE
JE OSVOPW ;OPEN FOR WRITE
MOV DX,OFFSET SAVFCB
MOV CL,CFOPEN ;FILE OPEN
PUSH ES
INT 224
POP ES
CMP AL,0FFH
JNE OSVPS
MOV AX,OFFSET ERR1
JMP OSVPER ;FILE NOT FOUND
OSVOPW: MOV DX,OFFSET SAVFCB
MOV CL,CFDELE
PUSH ES
INT 224
MOV DX,OFFSET SAVFCB
MOV CL,CFMAKE
INT 224
POP ES
CMP AL,0FFH
JNE OSVPS
MOV AX,OFFSET ERR4
JMP OSVPER
OSVPS: XCHG DI,SP
PUSH ZPC1
PUSH ZPC2
PUSH ZLOCS
PUSH ZORKID
MOV STKBOT,SP ;SAVE THE WORLD
MOV SP,DI
MOV CL,5
SHL AX,CL ;CHANGE TO BLOCK
PUSH AX ;SAVE STARTING BLOCK #
PUSH ES ;SAVE ES
MOV DX,SS
MOV ES,DX ;FAKE ES TO BE STACK SEGMENT
MOV BX,OFFSET STKBOT
MOV CX,2 ; *** WRITE OUT CX*4 (128 BYTES BLOCKS)
CALL SRBLKS ;READ/WRITE STACK
PUSHF
MOV DI,SP ;SAVE SP
MOV SP,STKBOT ;RETRIEVE SAVED USER STACK POINTER
POP AX
CMP AX,ZORKID ;CHECK GAME VERSIONS
JE OSVT0
MOV AX,OFFSET FTL4
JMP FATAL
OSVT0: POP ZLOCS
POP ZPC2
POP ZPC1
XCHG DI,SP
POPF
POP ES
POP AX
JC OSV4 ;DIE HERE IF FIRST READ/WRITE FAILED
MOV AX,2 ; *** NEXT BLOCK STARTS
SUB BX,BX ;START AT ES:0
MOV CX,PURBOT ;NUMBER OF PURE BLOCKS
CALL SRBLKS
PUSHF ;SAVE FLAGS FROM CALL
JC OSVCC
CMP DSKDIR,1
JNE OSVCC
MOV CL,CFCLOS
MOV DX,DSKFCB
PUSH ES
INT 224 ;CLOSE FILE ON SUCCESSFUL WRITE
POP ES
OSVCC: CALL M_CRLF
; MOV AX,OFFSET SAV3
; CALL M_PRNT
; CALL M_CHRI ;WAIT UNTIL READY
; CALL M_CRLF
OSV3C: CALL NEWZPC ;PAGE MAY HAVE CHANGED, LOSER!
POPF ;GET FLAGS BACK
JC OSV4
MOV AL,SCRFLG ;GET CURRENT SCRIPT STATE
XCHG AH,AL
MOV ES:.PFLAGS,AX ;AND MAKE RESTORED FLAGS REFLECT IT
JMP PTRUE
OSV4: MOV AX,OFFSET ERR5
CMP DSKDIR,1
JE OSVPER
MOV AX,OFFSET ERR6 ;DISTINGUISH READ/WRITE ERRORS
OSVPER: CALL M_PRNT
JMP PFALSE
OPRSTT: MOV BP,CHRPTR
MOV DS:BYTE PTR [BP],0 ;FORCE OUT THE BUFFER
MOV AX,OFFSET OUTBUF
CALL M_PRNT
JMP RESTRT ;JUMP TO RESTART ADDRESS
OPQUIT: JMP FINISH
OPUSL: PUSH DI
PUSH CHRPTR
MOV BX,SLSTR ;FAKE STATUS LINE STRING AS OUTPUT BUFFER
MOV CHRPTR,BX
MOV AX,16 ;FIRST GLOBAL
MOV DI,SLTAB
MOV CX,3 ;# OF THINGS TO PRINT
USLLP: PUSH AX
CALL GETVAR ;GET THE ROOM OBJECT
MOV DX,4[DI] ;THE STARTING CURSOR POSITION
CALL USLSET ;SET CURSOR POSITION HERE
PUSH CX
PUSH DI
CALL WORD PTR 2[DI] ;PRINT THE THING
POP DI
MOV DX,6[DI]
CALL USLSPC ;SPACE OVER TO HERE
USLN: ADD DI,8 ;POINT TO NEXT THING TO PRINT
POP CX
USL1: POP AX
INC AX ;POINT TO NEXT GLOBAL
LOOP USLLP
MOV AX,'$'
CALL PUTCHR ;PUT IN A STOP SIGNAL
CALL M_SOUT ;OUTPUT STATUS LINE
POP CHRPTR
POP DI
RET
USLSET: MOV BX,SLSTR
MOV CHRPTR,BX
ADD CHRPTR,DX
RET
USLSPC: MOV CX,CHRPTR
SUB CX,SLSTR ;THIS IS WHERE WE ARE
SUB DX,CX ;THIS IS WHERE WE WANT TO BE
MOV CX,DX ;CX HAS COUNT OF SPACES TO PUT IN
JLE USLSP1
USLSPL: MOV AX,20H
CALL PUTCHR ;OUTPUT A SPACE INTO BUFFER
LOOP USLSPL
USLSP1: RET
;ADD
OPADD: ADD AX,BX ;ADD OPR1 AND OPR2
JMP PUTVAL ;RETURN THE VALUE
;SUB
OPSUB: SUB AX,BX ;SUBTRACT OPR2 FROM OPR1
JMP PUTVAL ;RETURN THE VALUE
;MULTIPLY AX BY BX
OPMUL: IMUL BX ;MULTIPLY OPR1 BY OPR2,IGNORING OVERFLOW(DX)
JMP PUTVAL ;RETURN THE VALUE
;DIVIDE AX BY BX
OPDIV: CWD ;CLEAR HIGH WORD AND EXTEND SIGN FOR DIVIDE
IDIV BX ;DIVIDE OPR1 BY OPR2
JMP PUTVAL ;RETURN THE VALUE
;MOD
OPMOD: CWD ;CLEAR HIGH WORD AND EXTEND SIGN FOR DIVIDE
IDIV BX ;DIVIDE OPR1 BY OPR2
MOV AX,DX ;WE WANT REMAINDER
JMP PUTVAL ;RETURN THE VALUE
;RANDOM
OPRAND: SUB AH,AH
MOV RTEMP,AX
MOV AX,RSEED1
MOV BX,RSEED2
MOV RSEED2,AX
CLC
RCR AX,1
RCR BX,1
XOR RSEED1,BX
MOV AX,RSEED1
AND AX,0EFFFH
SUB DX,DX
DIV RTEMP
MOV AX,DX
INC AX ;MUST BE BETWEEN 1 AND N, INCLUSIVE
JMP PUTVAL ;SIMPLY RETURN
;LESS?
OPQLES: CMP AX,BX ;IS OPR1 LESS THAN OPR2?
JL JPT ;YES, PREDICATE TRUE
JPF: JMP PFALSE ;NO, PREDICATE FALSE
JPT: JMP PTRUE
;GRTR?
OPQGRT: CMP AX,BX ;IS OPR1 GREATER THAN OPR2?
JG JPT ;YES, PREDICATE TRUE
JMP JPF ;NO, PREDICATE FALSE
;BTST
OPBTST: NOT AX ;TURN OFF BITS IN OPR2 THAT ARE ON IN OPR1
AND BX,AX
JE JPT ;SUCCESS IF OPR2 COMPLETELY CLEARED
JMP JPF
;BOR
OPBOR: OR AX,BX ;LOGICAL OR
JMP PUTVAL ;RETURN THE VALUE
;BCOM
OPBCOM: NOT AX ;LOGICAL COMPLEMENT
JMP PUTVAL ;RETURN THE VALUE
;BAND
OPBAND: AND AX,BX ;LOGICAL AND
JMP PUTVAL ;RETURN THE VALUE
;EQUAL?
OPQEQU: NOP ;TELL CALLER TO USE ARGUMENT BLOCK
MOV BX,ARGBLK ;GET OPR1
CMP BX,ARGBLK+2 ;IS OPR1 EQUAL TO OPR2?
JE OQE1 ;YES
CMP AX,3 ;NO, IS THERE A THIRD OPERAND?
JL OQE2 ;NO
CMP BX,ARGBLK+4 ;YES, IS IT EQUAL TO OPR1?
JE OQE1 ;YES
CMP AX,4 ;NO, IS THERE A FOURTH?
JL OQE2 ;NO
CMP BX,ARGBLK+6 ;YES, IS IT EQUAL TO OPR1?
JNE OQE2 ;NO
OQE1: JMP PTRUE ;PREDICATE TRUE IF EQUAL
OQE2: JMP PFALSE ;PREDICATE FALSE IF NOT
;ZERO?
OPQZER: CMP AX,0 ;IS OPR ZERO?
JNE OQZ1 ;NO, PREDICATE FALSE
JMP PTRUE ;YES, PREDICATE TRUE
OQZ1: JMP PFALSE
;MOVE (OBJ1 INTO OBJ2)
OPMOVE: PUSH AX ;PROTECT OPRS FROM REMOVE CALL
PUSH BX
CALL OPREMO ;REMOVE OBJ1 FROM WHEREVER IT IS
POP DX ;OBJ2
MOV AX,DX
CALL OBJLOC ;FIND ITS LOCATION
MOV BX,AX ;MOVE TO BASE
POP CX ;OBJ1
MOV AX,CX
CALL OBJLOC ;FIND ITS LOCATION
MOV BP,AX ;MOVE TO BASE
MOV ES:4[BP],DL ;PUT OBJ2 INTO OBJ1'S LOC SLOT
MOV DH,ES:6[BX] ;GET CONTENTS OF OBJ2'S FIRST SLOT
MOV ES:6[BX],CL ;MAKE OBJ1 FIRST CONTENT OF OBJ2
CMP DH,0 ;WERE THERE ANY OTHER CONTENTS?
JE OMV1 ;NO
MOV ES:5[BP],DH ;YES, CHAIN ONTO OBJ1'S SIBLING SLOT
OMV1: RET
;REMOVE (OBJ FROM ITS PARENT)
OPREMO: MOV CX,AX ;SAVE OBJ FOR LATER
CALL OBJLOC ;FIND ITS LOCATION
MOV BX,AX ;MOVE TO BASE
MOV CH,ES:4[BX] ;GET ITS PARENT
CMP CH,0 ;DOES IT HAVE A PARENT?
JE ORM3 ;IF NOT, WE'RE DONE
MOV AL,CH ;PARENT
CALL OBJLOC ;FIND PARENT'S LOCATION
MOV BP,AX ;MOVE TO BASE
MOV DL,ES:6[BP] ;GET PARENT'S FIRST CONTENT
CMP DL,CL ;IS IT OBJ?
JNE ORM1 ;NO
MOV AL,ES:5[BX]
MOV ES:6[BP],AL ;YES, CHANGE SLOT TO OBJ'S SIBLING
JMP ORM2 ;AND RETURN
ORM1: MOV AL,DL ;CURRENT SIBLING
CALL OBJLOC ;FIND ITS LOCATION
MOV BP,AX ;MOVE TO BASE
MOV DL,ES:5[BP] ;GET NEXT SIBLING IN CHAIN
CMP DL,CL ;IS IT OBJ?
JNE ORM1 ;NO, CONTINUE LOOP
MOV AL,ES:5[BX]
MOV ES:5[BP],AL ;YES, CHANGE IT TO OBJ'S SIBLING
ORM2: MOV ES:BYTE PTR 4[BX],0 ;OBJ NOW HAS NO PARENT
MOV ES:BYTE PTR 5[BX],0 ;OR SIBLING
ORM3: RET
;FSET? (IS FLAG SET IN OBJ?)
OPQFSE: CALL OBJLOC ;FIND OBJ'S LOCATION
CMP BX,16 ;SECOND WORD FLAG?
JL OQF1 ;NO
SUB BX,16 ;YES, SUBTRACT 16 FROM FLAG NUMBER
INC AX ;AND USE SECOND FLAG WORD
INC AX
OQF1: MOV CX,BX ;MOVE TO COUNT
MOV BX,AX ;MOVE TO BASE
MOV AX,ES:[BX] ;GET THE FLAG WORD
XCHG AH,AL
MOV DX,8000H ;SHIFT A BIT TO PROPER POSITION
SHR DX,CL
TEST AX,DX ;IS THIS BIT SET IN FLAG WORD?
JE OQF2 ;NO, PREDICATE FALSE
JMP PTRUE ;YES, PREDICATE TRUE
OQF2: JMP PFALSE
;FSET (SET A FLAG IN OBJ)
OPFSET: CALL OBJLOC ;FIND OBJ'S LOCATION
CMP BX,16 ;SECOND WORD FLAG?
JL OFS1 ;NO
SUB BX,16 ;YES, SUBTRACT 16 FROM FLAG NUMBER
INC AX ;AND USE SECOND FLAG WORD
INC AX
OFS1: MOV CX,BX ;MOVE TO COUNT
MOV BX,AX ;MOVE TO BASE
MOV AX,ES:[BX] ;GET THE FLAG WORD
XCHG AH,AL
MOV DX,8000H ;SHIFT A BIT TO PROPER POSITION
SHR DX,CL
OR AX,DX ;SET THIS BIT IN FLAG WORD
XCHG AH,AL
MOV ES:[BX],AX ;STORE THE NEW FLAG WORD
RET
;FCLEAR (CLEAR A FLAG IN OBJ)
OPFCLE: CALL OBJLOC ;FIND OBJ'S LOCATION
CMP BX,16 ;SECOND WORD FLAG?
JL OFC1 ;NO
SUB BX,16 ;YES, SUBTRACT 16 FROM FLAG NUMBER
INC AX ;AND USE SECOND FLAG WORD
INC AX
OFC1: MOV CX,BX ;MOVE TO COUNT
MOV BX,AX ;MOVE TO BASE
MOV AX,ES:[BX] ;GET THE FLAG WORD
XCHG AH,AL
MOV DX,7FFFH ;SHIFT A BIT TO PROPER POSITION
ROR DX,CL
AND AX,DX ;CLEAR THIS BIT IN FLAG WORD
XCHG AH,AL ;STORE THE NEW FLAG WORD
MOV ES:[BX],AX
RET
;LOC (RETURN CONTAINER OF OBJ)
OPLOC: CALL OBJLOC ;FIND OBJ'S LOCATION
MOV BX,AX ;MOVE TO BASE
MOV AL,ES:4[BX] ;GET LOC SLOT
JMP BYTVAL ;RETURN THE BYTE VALUE
;FIRST? (RETURN FIRST SLOT OF OBJ, FAIL IF NONE)
OPQFIR: CALL OBJLOC ;FIND OBJ'S LOCATION
MOV BX,AX ;MOVE TO BASE
MOV AL,ES:6[BX] ;GET FIRST SLOT
PUSH AX ;SAVE IT
CALL BYTVAL ;RETURN THE BYTE VALUE
POP AX ;RESTORE IT
CMP AL,0 ;WAS IT ZERO?
JE JPF1 ;YES, PREDICATE FALSE
JPT1: JMP PTRUE ;NO, PREDICATE TRUE
JPF1: JMP PFALSE
;NEXT? (RETURN THE NEXT (SIBLING) SLOT OF OBJ, FAIL IF NONE)
OPQNEX: CALL OBJLOC ;FIND OBJ'S LOCATION
MOV BX,AX ;MOVE TO BASE
MOV AL,ES:5[BX] ;GET SIBLING SLOT
PUSH AX ;SAVE IT
CALL BYTVAL ;RETURN THE BYTE VALUE
POP AX ;RESTORE IT
CMP AL,0 ;WAS IT ZERO?
JE JPF1 ;YES, PREDICATE FALSE
JMP JPT1 ;NO, PREDICATE TRUE
;IN? (IS OBJ1 CONTAINED IN OBJ2?)
OPQIN: CALL OBJLOC ;FIND OBJ1'S LOCATION
XCHG AX,BX ;MOVE TO BASE
CMP ES:4[BX],AL ;IS OBJ1'S PARENT OBJ2?
JE JPT1 ;YES, PREDICATE TRUE
JMP JPF1 ;NO, PREDICATE FALSE
;GETP (GET SPECIFIED PROPERTY OF OBJ, DEFAULT IF NONE)
OPGETP: MOV DX,BX ;PROPERTY
CALL OBJLOC ;FIND OBJ'S LOCATION
MOV BP,AX ;MOVE TO BASE
MOV BX,ES:7[BP] ;GET LOCATION OF ITS PROPERTY TABLE
XCHG BH,BL
MOV AL,ES:[BX] ;LENGTH OF SHORT DESCRIPTION IN WORDS
SUB AH,AH ;CLEAN OFF ANY HIGH-ORDER BYTE
SHL AX,1 ;CONVERT TO BYTES
ADD BX,AX ;ADJUST POINTER TO SKIP IT
INC BX ;ALSO SKIP LENGTH BYTE
JMP OGP2 ;SKIP NEXT LINE FIRST TIME THROUGH LOOP
OGP1: CALL NXTPRP ;POINT TO NEXT PROPERTY
OGP2: MOV AL,ES:[BX] ;GET PROPERTY IDENTIFIER
AND AL,31 ;CLEAN OFF LENGTH BITS
CMP AL,DL ;COMPARE PROPERTY NUMBER WITH DESIRED ONE
JG OGP1 ;IF GREATER, LOOP (TABLE SORTED IN REVERSE)
JL OGP3 ;IF LESS, NO SUCH PROPERTY HERE
MOV AL,ES:[BX] ;GOT IT, NOW FIND LENGTH OF PROPERTY
INC BX ;POINT TO PROPERTY VALUE
AND AL,224 ;GET LENGTH BITS
MOV CL,5 ;PROPERTY SIZE
SHR AL,CL
CMP AL,0 ;BYTE VALUE?
JNE OGP5 ;NO
MOV AL,ES:[BX] ;GET THE BYTE
JMP BYTVAL ;AND RETURN IT
OGP3: DEC DX ;POINT INTO DEFAULT PROPERTY TABLE
SHL DX,1
MOV BX,DX
OGP4: ADD BX,OBJTAB ;GET THE WORD
OGP5: MOV AX,ES:[BX]
XCHG AH,AL
JMP PUTVAL ;AND RETURN IT
;PUTP (CHANGE VALUE OF A PROPERTY, ERROR IF BAD NUMBER)
OPPUTP: PUSH CX ;SAVE NEW VALUE
MOV DX,BX ;PROPERTY
CALL OBJLOC ;FIND OBJ'S LOCATION
MOV BP,AX ;MOVE TO BASE
MOV BX,ES:7[BP] ;GET LOCATION OF ITS PROPERTY TABLE
XCHG BH,BL
MOV AL,ES:[BX] ;LENGTH OF SHORT DESCRIPTION IN WORDS
SUB AH,AH ;CLEAN OFF ANY HIGH-ORDER BYTE
SHL AX,1 ;CONVERT TO BYTES
ADD BX,AX ;ADJUST POINTER TO SKIP IT
INC BX ;ALSO SKIP LENGTH BYTE
JMP OPP2 ;SKIP NEXT LINE FIRST TIME THROUGH LOOP
OPP1: CALL NXTPRP ;POINT TO NEXT PROPERTY
OPP2: MOV AL,ES:[BX] ;GET PROPERTY IDENTIFIER
AND AL,31 ;CLEAN OFF LENGTH BITS
CMP AL,DL ;COMPARE PROPERTY NUMBER WITH DESIRED ONE
JE OPP3 ;IF EQUAL, GOT IT
JG OPP1 ;IF GREATER, LOOP (TABLE SORTED IN REVERSE)
MOV AX,OFFSET FTL2
JMP FATAL
OPP3: MOV AL,ES:[BX] ;NOW FIND LENGTH OF PROPERTY
INC BX ;POINT TO PROPERTY VALUE
AND AL,224 ;GET LENGTH BITS
MOV CL,5 ;PROPSIZE
SHR AL,CL
CMP AL,0 ;BYTE VALUE?
POP AX ;RESTORE NEW VALUE
JNE OPP4 ;ZERO MEANS BYTE VALUE
MOV ES:[BX],AL ;STORE THE NEW BYTE
RET ;AND RETURN
OPP4: XCHG AH,AL
MOV ES:[BX],AX ;STORE THE NEW WORD VALUE
RET
;NEXTP (RETURN NUMBER OF NEXT PROP FOLLOWING GIVEN PROB IN OBJ)
OPNEXT: MOV DX,BX ;PROPERTY
CALL OBJLOC ;FIND OBJ'S LOCATION
MOV BP,AX ;MOVE TO BASE
MOV BX,ES:7[BP] ;GET ITS LOCATION
XCHG BH,BL
MOV AL,ES:[BX] ;LENGTH OF SHORT DESCRIPTION IN WORDS
SUB AH,AH ;CLEAN OFF ANY HIGH-ORDER BYTE
SHL AX,1 ;CONVERT TO BYTES
ADD BX,AX ;ADJUST POINTER TO SKIP IT
INC BX ;ALSO SKIP LENGTH BYTE
CMP DX,0 ;WERE WE GIVEN ZERO AS PROP?
JE ONX4 ;YES, GO RETURN FIRST PROPERTY NUMBER
JMP ONX2 ;NO, SKIP NEXT LINE FIRST TIME THROUGH LOOP
ONX1: CALL NXTPRP ;POINT TO NEXT PROPERTY
ONX2: MOV AL,ES:[BX] ;GET PROPERTY IDENTIFIER
AND AL,31 ;CLEAN OFF LENGTH BITS
CMP AL,DL ;COMPARE PROPERTY NUMBER WITH DESIRED ONE
JE ONX3 ;IF EQUAL, GOT IT
JG ONX1 ;IF GREATER, LOOP (TABLE SORTED IN REVERSE)
MOV AX,OFFSET FTL2
JMP FATAL
ONX3: CALL NXTPRP ;POINT TO NEXT PROPERTY
ONX4: MOV AL,ES:[BX] ;GET PROPERTY IDENTIFIER
AND AL,31 ;EXTRACT PROPERTY NUMBER
JMP PUTVAL ;AND RETURN IT
;GET (GET THE ITEM'TH WORD FROM TABLE)
OPGET: SHL BX,1 ;CONVERT ITEM TO BYTE COUNT
ADD AX,BX ;INDEX INTO TABLE
CALL BSPLTB ;SPLIT THE POINTER
CALL GETWRD ;GET THE WORD
MOV AX,CX
JMP PUTVAL ;AND RETURN IT
;GETB (GET THE ITEM'TH BYTE FROM TABLE)
OPGETB: ADD AX,BX ;INDEX INTO TABLE
CALL BSPLTB ;SPLIT THE POINTER
CALL GETBYT ;GET THE BYTE
MOV AX,CX
JMP BYTVAL ;AND RETURN IT
;PUT (REPLACE THE ITEM'TH WORD IN TABLE)
OPPUT: SHL BX,1 ;CONVERT ITEM TO BYTE COUNT
ADD BX,AX ;INDEX INTO TABLE
XCHG CH,CL
MOV ES:[BX],CX ;STORE THE WORD
RET
;PUTB (REPLACE ITEM'TH BYTE IN TABLE)
OPPUTB: ADD BX,AX ;INDEX INTO TABLE
MOV ES:[BX],CL ;STORE BYTE
RET
;GETPT (GET POINTER TO PROPERTY TABLE FOR GIVEN PROP)
OPGTPT: MOV DX,BX ;PROPERTY
CALL OBJLOC ;FIND OBJ'S LOCATION
MOV BP,AX ;MOVE TO BASE
MOV BX,ES:7[BP] ;GET LOCATION OF ITS PROPERTY TABLE
XCHG BH,BL
MOV AL,ES:[BX] ;LENGTH OF SHORT DESCRIPTION IN WORDS
SUB AH,AH ;CLEAN OFF ANY HIGH-ORDER BYTE
SHL AX,1 ;CONVERT TO BYTES
ADD BX,AX ;ADJUST POINTER TO SKIP IT
INC BX ;ALSO SKIP LENGTH BYTE
JMP OGT2 ;SKIP NEXT LINE FIRST TIME THROUGH LOOP
OGT1: CALL NXTPRP ;POINT TO NEXT PROPERTY
OGT2: MOV AL,ES:[BX] ;GET PROPERTY IDENTIFIER
AND AL,31 ;CLEAN OFF LENGTH BITS
CMP AL,DL ;COMPARE PROPERTY NUMBER WITH DESIRED ONE
JG OGT1 ;IF GREATER, LOOP (TABLE SORTED IN REVERSE)
JE OGT3 ;FOUND THE PROPERTY
SUB AX,AX ;RETURN ZERO FOR NO SUCH PROPERTY
JMP OGT4
OGT3: INC BX ;POINT TO PROPERTY VALUE
MOV AX,BX ;AND RETURN IT
OGT4: JMP PUTVAL
;PTSIZE (RETURN SIZE OF PROPERTY TABLE)
OPPTSI: MOV BX,AX ;TABLE POINTER
MOV AL,ES:[BX]-1 ;GET PROPERTY INDENTIFIER
AND AL,224 ;EXTRACT LENGTH BITS
SUB AH,AH
MOV CL,5 ;PROPSIZE
SHR AX,CL
INC AX ;ADJUST TO ACTUAL LENGTH
JMP PUTVAL ;RETURN IT
;VALUE (GET VALUE OF VAR)
OPVALU: CALL GETVAR ;GET THE VALUE
JMP PUTVAL ;AND RETURN IT
;SET (VAR TO VALUE)
OPSET: JMP PUTVAR ;STORE THE VALUE
;PUSH (A VALUE ONTO THE STACK)
OPPUSH: XCHG SP,DI
PUSH AX
XCHG SP,DI
RET
;POP (A VALUE OFF THE STACK INTO VAR)
OPPOP: XCHG SP,DI
POP BX
XCHG SP,DI
JMP PUTVAR ;AND STORE IT
;INC (INCREMENT VAR)
OPINC: MOV CX,AX ;VARIABLE
CALL GETVAR ;GET VAR'S VALUE
INC AX ;INCREMENT IT
OPINC1: MOV BX,AX ;VALUE
MOV AX,CX ;VARIABLE
JMP PUTVAR ;STORE NEW VALUE
;DEC (DECREMENT VAR)
OPDEC: MOV CX,AX ;VARIABLE
CALL GETVAR ;GET VAR'S VALUE
DEC AX ;DECREMENT IT
JMP OPINC1 ;STORE NEW VALUE
;IGRTR? (INCREMENT VAR & TEST IF GREATER THAN VAL)
OPQIGR: PUSH AX ;SAVE VARIABLE
CALL GETVAR ;GET VAR'S VALUE
INC AX ;INCREMENT IT
SUB CX,CX ;SET FLAG FALSE
CMP AX,BX ;NEW VALUE GREATER THAN VAL?
JLE OPQIG1 ;NO
OPQIG0: INC CX ;YES, CHANGE FLAG TO TRUE
OPQIG1: MOV BX,AX ;VALUE
POP AX ;RESTORE VARIABLE
CALL PUTVAR ;STORE NEW VALUE
CMP CX,0 ;TEST FLAG
JE OQI1 ;FALSE, PREDICATE FALSE
JMP PTRUE ;ELSE, PREDICATE TRUE
OQI1: JMP PFALSE
;DLESS? (DECREMENT VAR & TEST IF LESS THAN VAL)
OPQDLE: PUSH AX ;SAVE VARIABLE
CALL GETVAR ;GET VAR'S VALUE
DEC AX ;DECREMENT IT
SUB CX,CX ;SET FLAG FALSE
CMP AX,BX ;NEW VALUE LESS THAN VAL?
JGE OPQIG1 ;NO, PREDICATE FALSE
JMP OPQIG0 ;YES, PREDICATE TRUE
GETLIN: CMP RNDFLG,0
JNE GETLNN
PUSH AX
PUSH BX
PUSH CX
PUSH DX
PUSH SI
PUSH DI
PUSH ES
RNDLP: MOV DI,4
INT 40
CMP CL,0
JNE RNDL1
INC RSEED1
INC RSEED2
JMP RNDLP
RNDL1: MOV RNDFLG,1
POP ES
POP DI
POP SI
POP DX
POP CX
POP BX
POP AX
GETLNN: PUSH BX
MOV AL,SCRFLG
PUSH AX
MOV SCRFLG,0 ;DEFEAT SCRIPTING DURING INPUT
PUSH SI
MOV CL,ES:[SI] ;HERE'S WHERE LENGTH IS
MOV BX,OFFSET INBUF ;HERE'S THE BDOS INPUT BUFFER
MOV BYTE PTR [BX],CL;PUT MAX LENGTH THERE
MOV DX,BX
MOV CL,CRDLIN ;CONSOLE BUFFERED READ
PUSH ES
INT 224 ;READ A LINE
MOV CL,CCONIO
MOV DL,10
INT 224 ;ECHO LF
POP ES
POP DX ;GET BACK START OF BUFFER
MOV BX,OFFSET INBUF ;GET BDOS INPUT BUFFER AGAIN
MOV CL,BYTE PTR 1 [BX] ;THE # CHARACTERS READ
SUB CH,CH
INC BX ;FLUSH COUNT ACTUALLY READ
CMP CL,0
JE GETLEM ;IF NONE TYPED, DON'T LOOP FOREVER
GETLLP: INC SI
INC BX
MOV AL,BYTE PTR [BX]
CMP AL,'A'
JL GETLLC
CMP AL,'Z'
JG GETLLC
ADD AL,32
GETLLC: MOV ES:[SI],AL
LOOP GETLLP
GETLEM: INC SI
SUB AL,AL
MOV ES:[SI],AL
POP AX
MOV SCRFLG,AL
POP BX
RET
PRTOUT: PUSH ES
PUSH BX
MOV DL,AL
MOV CL,05H
INT 224
POP BX
POP ES
RET
SCRCHK: PUSH AX
PUSH BX
PUSH DX
MOV AX,ES:.PFLAGS
XCHG AH,AL
TEST AL,1 ;CHECK IF SCRIPTING IS REQUESTED
JZ SCRNN
MOV SCRFLG,1
SUB CX,CX ;COUNT OF CHARS PRINTED
MOV BP,DX ;START OF INPUT LINE
INC BP ;FIRST CHAR IS LENGTH OF BUFFER
SCR1L: MOV AL,ES:[BP]
INC BP ;GET CHARACTER
CMP BP,SI ;END OF INPUT?
JLE SCR2L
CALL PRTCRL
JMP SCREX
SCR2L: CALL PRTOUT ;OUTPUT ONE CHARACTER TO THE PRINTER
INC CX
CMP CL,SCPL
JNE SCR1L
CALL PRTCRL
JC SCREX
SUB CX,CX ;RESTART COUNT
JMP SCR1L ;GO FOR MORE
SCRNN: MOV SCRFLG,0
SCREX: POP DX
POP BX
POP AX
RET
PRTCRL: MOV AL,13 ;FINISH UP WITH CRLF
CALL PRTOUT
MOV AL,10
CALL PRTOUT
RET
;READ (A LINE OF INPUT & PARSE IT, LINE BUF IN ES:AX,
;RETURN BUF IN ES:BX)
OPREAD: PUSH AX ;SAVE LINE BUF
PUSH AX
PUSH BX
CALL OPUSL ;UPDATE STATUS LINE
POP BX
POP AX
MOV BP,CHRPTR ;NEXT CHARACTER POSITION
MOV DS:BYTE PTR [BP],80H ;DON'T END OUTPUT, IF ANY, WITH NEW LINE
ORD1: MOV AX,OFFSET OUTBUF
CALL M_PRNT
MOV CHRPTR,OFFSET OUTBUF ;RESET CHARACTER POINTER
POP SI ;INPUT BUFFER POINTER
MOV MORLIN,0 ;RE-INITIALIZE MORE COUNT FROM HERE
CALL GETLIN ;GET SOME CHARACTERS
CALL SCRCHK ;CHECK FOR SCRIPTING, SCRIPT INPUT IF ON
ORDNS: PUSH DI
MOV RDBOS,DX ;INITIALIZE RDBOS
MOV RDEOS,SI ;AND RDEOS
MOV RDRET,BX ;STORE RET POINTER
MOV RDNWDS,0 ;NO WORDS SO FAR
INC DX ;SKIP LENGTH BYTE
MOV DI,BX ;THIS WILL BE WORD ENTRY POINTER
INC DI ;SKIP MAX WORDS & NWORDS BYTES
INC DI
ORD8: MOV CX,OFFSET RDWSTR;HERE FOR NEXT WORD, POINT TO WORD STRING
MOV BX,DX ;AND SAVE BEGINNING OF WORD POINTER
ORD9: CMP DX,RDEOS ;END OF STRING?
JNE ORD10 ;NO
CMP CX,OFFSET RDWSTR;YES, WAS A WORD FOUND?
JNE ORD15 ;YES, WE STILL HAVE TO LOOKUP WORD
JMP ORD23 ;NO, WE'RE DONE
ORD10: MOV BP,DX ;GET NEXT CHARACTER FROM BUFFER
MOV AL,ES:[BP]
CMP AL,'A'
JL ORD1A
CMP AL,'Z'
JG ORD1A
ADD AL,32 ;LOWERCASIFY ALPHABETICS
ORD1A: INC DX
MOV SI,OFFSET RBRKS ;LIST OF READ BREAK CHARACTERS
ORD11: INC SI
CMP AL,-1[SI] ;SEARCH LIST FOR THIS ONE
JE ORD12 ;FOUND IT
CMP BYTE PTR [SI],0 ;END OF LIST?
JNE ORD11 ;NO, CONTINUE SEARCH
CMP CX,OFFSET RDWSTR+6 ;YES, NOT A BREAK, WORD STRING FULL?
JE ORD9 ;YES, LOOP UNTIL END OF WORD
MOV BP,CX ;NO, TACK THIS CHARACTER ONTO STRING
MOV DS:[BP],AL
INC CX
JMP ORD9 ;AND LOOP
ORD12: CMP CX,OFFSET RDWSTR;WORD READ BEFORE THIS BREAK?
JNE ORD14 ;YES
CMP SI,ESIBKS ;NO, BUT IS IT A SELF-INSERTING BREAK?
JBE ORD13 ;YES
INC BX ;NO, UPDATE BEGINNING OF WORD TO SKIP BREAK
JMP ORD9 ;AND RETURN TO LOOP TO FIND A WORD
ORD13: MOV BP,CX ;STORE THE BREAK IN WORD STRING
MOV DS:[BP],AL
INC CX
JMP ORD15 ;AND GO FOR THE WORD
ORD14: DEC DX ;UNREAD TERMINATING BREAK IN CASE IT WAS SI
ORD15: INC RDNWDS ;INCREMENT FOUND WORD COUNT
MOV BP,BX ;GREATER THAN MAX ALLOWED?
MOV BX,RDRET
MOV BL,ES:[BX]
CMP RDNWDS,BL
MOV BX,BP
JLE ORD16 ;NO
MOV AX,OFFSET ERR2
CALL M_PRNT ;YES. INFORM LOSER
MOV AX,BX ;BEGINNING OF THIS WORD
MOV BP,RDEOS ;SAVE BYTE AFTER EOS
MOV BL,ES:[BP]
MOV ES:BYTE PTR [BP],0 ;ZERO IT TO MAKE STRING ASCIZ
CALL M_PRNT ;PRINT IT
MOV ES:[BP],BL ;AND RESTORE OLD BYTE
DEC RDNWDS ;REMEMBER THAT WE FLUSHED THIS WORD
JMP ORD23 ;AND WE'RE DONE
ORD16: MOV AX,BX ;CALCULATE NUMBER OF CHARACTERS IN WORD
NEG AX
ADD AX,DX
MOV ES:2[DI],AL ;SAVE THE NUMBER IN RET TABLE
SUB BX,RDBOS ;BYTE OFFSET FOR BEGINNING OF WORD
MOV ES:3[DI],BL ;STORE IT, TOO
MOV BP,CX ;MAKE WORD STRING ASCIZ
MOV DS:BYTE PTR [BP],0
MOV AX,OFFSET RDWSTR;POINT TO IT
CALL ZWORD ;AND CONVERT TO (2-WORD) ZWORD
PUSH DX ;SAVE CHAR & WORD ENTRY POINTERS
PUSH DI
MOV DI,AX ;FIRST ZWORD WORD
MOV SI,VWORDS ;NUMBER OF VOCABULARY WORDS
MOV AX,SI
DEC AX ;WE WANT TO POINT TO LAST WORD
MUL VWLEN ;MULTIPLY BY WORD LENGTH IN BYTES
ADD AX,VOCBEG ;ADD POINTER TO BEGINNING TO FIND LAST WORD
MOV CX,AX ;POINTER TO LAST WORD
MOV DX,DI ;FIRST ZWORD WORD
MOV DI,BX ;SECOND ZWORD WORD
MOV BX,VWLEN ;CALCULATE INITIAL OFFSET FOR BINARY SEARCH
SAR SI,1
ORD17: SAL BX,1
SAR SI,1
CMP SI,0
JNE ORD17
MOV SI,VOCBEG ;BEGINNING OF WORD TABLE
ADD SI,BX ;ADD CURRENT OFFSET(HALF OF POWER-OF-2 TABLE)
PUSH AX ;SAVE
MOV AX,VWLEN ;AVOID FENCEPOST BUG FOR EXACT POWER-OF-2 TBL
SUB SI,AX
POP AX ;RESTORE
ORD18: SAR BX,1 ;NEXT OFFSET WILL BE HALF OF PREVIOUS ONE
MOV AX,ES:[SI] ;GET FIRST HALF OF CURRENT ZWORD
XCHG AH,AL
CMP DX,AX ;COMPARE DESIRED ONE TO IT
JA ORD19 ;GREATER, WE'LL HAVE TO MOVE UP
JB ORD20 ;LESS, WE'LL HAVE TO MOVE DOWN
MOV BP,SI ;SAME, GET SECOND HALF
INC BP
INC BP
MOV AX,ES:[BP]
XCHG AH,AL
CMP DI,AX ;COMPARE DESIRED WORD WITH IT
JA ORD19 ;GREATER, WE'LL HAVE TO MOVE UP
JB ORD20 ;LESS, WE'LL HAVE TO MOVE DOWN
JMP ORD22 ;SAME, WE'VE FOUND IT, RETURN IT
ORD19: ADD SI,BX ;TO MOVE UP, ADD CURRENT OFFSET
CMP SI,CX ;HAVE WE MOVED PAST END OF TABLE?
JBE ORD21 ;NO
MOV SI,CX ;YES, POINT TO END OF TABLE INSTEAD
JMP ORD21
ORD20: SUB SI,BX ;TO MOVE DOWN, SIMPLY SUBTRACT OFFSET
ORD21: CMP BX,VWLEN ;IS OFFSET RESOLUTION BELOW ONE WORD?
JGE ORD18 ;NO, CONTINUE LOOP
SUB SI,SI ;YES, WORD NOT FOUND, RETURN ZERO
ORD22: POP DI ;RESTORE WORD ENTRY POINTER
MOV DX,SI ;POINTER TO WORD FOUND
XCHG DH,DL
MOV ES:[DI],DX ;STORE IT
POP DX ;RESTORE CHAR POINTER
ADD DI,4 ;UPDATE POINTER FOR NEXT WORD ENTRY
JMP ORD8 ;GO FOR IT
ORD23: INC RDRET ;DONE, STORE NUMBER OF WORDS FOUND
MOV BP,RDRET
MOV DL,RDNWDS
MOV ES:[BP],DL
POP DI ;RESTORE USER STACK POINTER
RET ;AND RETURN
;PRINTC (PRINT CHAR WHOSE ASCII VALUE IS GIVEN)
OPPRNC: JMP PUTCHR ;QUEUE THE CHARACTER FOR PRINTING
;PRINTN (PRINT A NUMBER)
OPPRNN: MOV BX,AX ;NUMBER TO PRINT
CMP BX,0
JNE OPN1 ;NON-ZERO
MOV AX,'0' ;SPECIAL CASE ZERO
JMP PUTCHR
OPN1: JG OPN2 ;POSITIVE?
MOV AX,'-' ;NO, PRINT MINUS SIGN
CALL PUTCHR
NEG BX ;AND MAKE IT POSITIVE
OPN2: SUB CX,CX ;COUNT OF DIGITS ON STACK
JMP OPN4 ;START WITH GREATER-THAN-10 TEST
OPN3: MOV AX,BX ;EXTRACT A DIGIT
MOV BP,10
CWD
IDIV BP
PUSH DX ;PUSH IT
INC CX ;BUMP COUNT
MOV BX,AX ;GET QUOTIENT
OPN4: CMP BX,10 ;MORE DIGITS TO EXTRACT?
JGE OPN3 ;YES, GO LOOP
MOV AX,BX ;NO, GET LAST (FIRST) DIGIT
JMP OPN6 ;ALREADY IN PLACE
OPN5: POP AX ;POP NEXT DIGIT
OPN6: ADD AX,'0' ;ASCIIZE IT
CALL PUTCHR ;QUEUE IT
DEC CX ;REDUCE DIGIT COUNT
JGE OPN5 ;LOOP IF SOME LEFT
RET ;ELSE, RETURN
;PRINT (THE STRING POINTED TO BY ES:AX)
OPPRIN: CALL BSPLIT ;SPLIT THE BLOCK & WORD NUMBERS
JMP PUTSTR ;PRINT THE STRING
;PRINTB (PRINT THE STRING POINTED TO BY THE BYTE-POINTER ES:AX)
OPPRNB: CALL BSPLTB ;SPLIT THE BLOCK & BYTE NUMBERS
JMP PUTSTR ;PRINT THE STRING
;PSEUDO-INSTRUCTIONS FOR HOURS/MINUTES HERE FOR STATUS LINE
OPPRNH: MOV PMFLAG,0
CMP AL,12
JL OPH0
MOV PMFLAG,1
OPH0: CMP AL,0
JNE OPH00
MOV AL,12
OPH00: CMP AL,12
JLE OPH1
SUB AL,12 ;HOUR SLOT IS 24 HOUR TIME
OPH1: CMP AL,9
JG OPH2
PUSH AX
MOV AL,32
CALL PUTCHR ;OUTPUT SPACE FOR HOUR LESS THAN 10
POP AX
OPH2: CALL OPPRNN
MOV AL,':'
JMP PUTCHR ;AND COLO
OPPRNM: CMP AL,9
JG OPM1
PUSH AX
MOV AL,'0'
CALL PUTCHR
POP AX
OPM1: CALL OPPRNN
MOV AL,32
CALL PUTCHR
MOV AL,'a'
CMP PMFLAG,0
JE OPM2
MOV AL,'p'
OPM2: CALL PUTCHR
MOV AL,'m'
JMP PUTCHR
;PRINTD (PRINT OBJ'S SHORT DESCRIPTION)
OPPRND: CALL OBJLOC ;FIND OBJ'S LOCATION
ADD AX,7 ;PROPERTY TABLE POINTER
MOV BP,AX
MOV AX,ES:[BP] ;GET IT
XCHG AH,AL
INC AX ;POINT TO STRING
CALL BSPLTB ;SPLIT POINTER
JMP PUTSTR ;AND PRINT THE STRING
;PRINTI (PRINT THE STRING FOLLOWING THIS INSTRUCTION)
OPPRNI: MOV AX,ZPC1 ;GET POINTER TO STRING
MOV BX,ZPC2
CALL PUTSTR ;AND PRINT IT
MOV ZPC1,AX ;UPDATE ZPC
MOV ZPC2,BX
JMP NEWZPC
;PRINTR (PRINTI FOLLOWED BY RTRUE)
OPPRNR: CALL OPPRNI ;DO A PRINTI
CALL OPCRLF ;A CRLF
JMP OPRTRU ;AND AN RTRUE
;CRLF (DO A NEWLINE)
OPCRLF: JMP NEWLIN ;DO A NEWLINE
;CALL (A FUNCTION WITH OPTIONAL ARGUMENTS), # OF ARGS IN AX
OPCALL: NOP ;TELL CALLER TO USE ARGUMENT BLOCK
MOV DX,AX ;NUMBER OF ARGUMENTS TO CALL
MOV AX,ARGBLK ;FUNCTION TO CALL
CMP AX,0
JNE OCL1 ;ZERO?
SUB AX,AX ;YES, SIMPLY RETURN A ZERO
JMP PUTVAL
OCL1: XCHG SP,DI
PUSH ZPC1
PUSH ZPC2
MOV CX,ZLOCS ;AND OLD LOCAL POINTER
PUSH CX ;AND SAVE IT
XCHG SP,DI
CALL BSPLIT ;SPLIT FUNCTION POINTER
MOV ZPC1,AX ;MAKE IT THE NEW ZPC
MOV ZPC2,BX
CALL NEWZPC ;UPDATE ZPC STUFF
MOV ZLOCS,DI ;LOCALS WILL START AT NEXT STACK SLOT
SUB ZLOCS,2
CALL NXTBYT ;NUMBER OF LOCALS
MOV BX,AX
MOV BP,OFFSET ARGBLK+2 ;POINT TO FIRST OPTIONAL ARG
OCL2: DEC BX ;ANY MORE LOCALS?
JL OCL4 ;NO, WE'RE DONE
CALL NXTWRD ;YES, GET THE NEXT LOCAL DEFAULT VALUE
DEC DX ;ANY MORE OPTIONALS GIVEN?
JLE OCL3 ;NO
XCHG SP,DI
MOV CX,DS:[BP]
PUSH CX ;YES, USE ITS VALUE
XCHG SP,DI
ADD BP,2
JMP OCL2 ;AND CONTINUE LOOP
OCL3: XCHG SP,DI
PUSH AX ;OTHERWISE USE DEFAULT
XCHG SP,DI
JMP OCL2 ;AND LOOP
OCL4: RET
;RETURN (FROM CURRENT FUNCTION CALL)
OPRETU: MOV DI,ZLOCS ;RESTORE OLD TOP OF STACK
XCHG SP,DI
POP DX
POP ZLOCS
POP ZPC2
POP ZPC1
XCHG SP,DI
PUSH AX ;VALUE TO RETURN
CALL NEWZPC ;UPDATE ZPC STUFF
POP AX
JMP PUTVAL ;RETURN THE VALUE
;RTRUE
OPRTRU: MOV AX,1 ;RETURN A 1
JMP OPRETU
;RFALSE
OPRFAL: SUB AX,AX ;RETURN A 0
JMP OPRETU
;JUMP (TO A NEW LOCATION)
OPJUMP: ADD ZPC2,AX ;ADD OFFSET TO CURRENT ZPC
SUB ZPC2,2 ;ADJUST IT
JMP NEWZPC ;NORMALIZE IT & UPDATE ZPC STUFF
;RSTACK (RETURN STACK)
OPRSTA: XCHG SP,DI
POP AX
XCHG SP,DI
JMP OPRETU ;AND RETURN IT
;FSTACK (FLUSH A VALUE OFF THE STACK)
OPFSTA: XCHG SP,DI
POP DX
XCHG SP,DI
RET
;NOOP (NO OPERATION)
OPNOOP: RET ;DO NOTHING
;GET A BYTE, BLOCK-POINTER ES:AX, BYTE-POINTER ES:BX, RESULT IN CX,
;UPDATE AX & BX TO REFLECT BYTE GOTTEN
GETBYT: PUSH AX ;SAVE BLOCK-POINTER
CMP AX,ENDLOD ;IS THIS A PRELOADED LOCATION?
JGE GTY1 ;NO
MOV CL,9 ;YES, RECONSTRUCT POINTER
SHL AX,CL ;SHIFT BLOCK POINTER BY 9
OR AX,BX ;ADD IN THE OFFSET
XCHG AX,BX
MOV CL,ES:[BX] ;GET THE BYTE
JMP GTY2 ;CLEAR UNWANTED BYTE & RETURN IT
GTY1: CALL GETPAG ;FIND THE PROPER PAGE
ADD AX,BX ;POINT TO DESIRED BYTE
XCHG AX,BX
MOV CL,ES:[BX] ;GET IT
GTY2: SUB CH,CH ;CLEAR UNWANTED BYTE & RETURN IT
MOV BX,AX
POP AX ;RESTORE BLOCK-POINTER
INC BX ;UPDATE POINTER
CMP BX,200H ;END-OF-PAGE?
JNE GTY3 ;NO
SUB BX,BX ;YES, CLEAR BYTE-POINTER
INC AX ;AND UPDATE BLOCK-POINTER
GTY3: RET
;GET A WORD, BLOCK POINTER ES:AX, BYTE-POINTER ES:BX, RESULT IN CX
GETWRD: PUSH DX ;SAVE
CALL GETBYT ;GET HIGH-ORDER BYTE
PUSH CX ;SAVE IT
CALL GETBYT ;GET LOW-ORDER BYTE
POP DX ;GET OTHER BYTE
MOV CH,DL ;POSITION IT
POP DX ;RESTORE
RET
;GET THE NEXT BYTE, RETURN IT IN AX
NXTBYT: PUSH BX ;SAVE
MOV BX,ZPC2 ;BYTE POINTER
ADD BX,CURPAG ;INDEX INTO CURRENT PAGE
MOV AX,ES:[BX] ;SAVE BYTE ***POSSIBLE LOSER
PUSH AX
INC ZPC2 ;UPDATE PC
CMP ZPC2,200H ;END-OF-PAGE?
JL NXB1 ;NO
CALL NEWZPC ;YES, UPDATE PAGE
NXB1: POP AX ;RETRIEVE BYTE
SUB AH,AH ;CLEAR UNWANTED BYTE
POP BX ;RESTORE
RET ;AND RETURN IT
;GET THE NEXT WORD, RETURN IT IN AX
NXTWRD: PUSH BX ;SAVE
CALL NXTBYT ;GET HIGH-ORDER BYTE
PUSH AX ;SAVE IT
CALL NXTBYT ;GET LOW-ORDER BYTE
POP BX ;GET HIGH-ORDER BYTE
MOV AH,BL ;POSITION IT
POP BX ;RESTORE
RET ;RETURN THE WORD
;GET AN ARGUMENT GIVEN ITS TYPE IN AX
GETARG: DEC AX ;EXAMINE ARGUMENT
JL NXTWRD ;0 MEANT LONG IMMEDIATE
JE NXTBYT ;1 MEANT SHORT IMMEDIATE
CALL NXTBYT ;2 MEANT VARIABLE, GET THE VAR
CMP AX,0 ;STACK?
JNE GETVAR ;NO, JUST GET THE VAR'S VALUE
XCHG SP,DI
POP AX ;YES, POP THE STACK
XCHG SP,DI
RET
;GET VALUE OF A VARIABLE, VAR IN AX, VALUE RETURNED IN AX
GETVAR: CMP AX,0 ;STACK?
JNE GTV1 ;NO
MOV AX,SS:[DI] ;YES, GET TOP-OF-STACK
RET
GTV1: PUSH BP ;SAVE
CMP AX,16 ;LOCAL?
JGE GTV3 ;NO
DEC AX ;YES, POINT TO PROPER STACK ELEMENT
SHL AX,1
MOV BP,ZLOCS
SUB BP,AX
MOV AX,[BP] ;AND GET IT
GTV2: POP BP ;RESTORE
RET
GTV3: SUB AX,16 ;GLOBAL, POINT TO PROPER GLOBAL TABLE ELEMENT
SHL AX,1
ADD AX,GLOTAB
MOV BP,AX ;AND GET IT
MOV AX,ES:[BP]
XCHG AH,AL
JMP GTV2
;UPDATE VALUE OF A VARIABLE, VAR IN AX, NEW VALUE IN BX
PUTVAR: CMP AX,0 ;STACK?
JNE PTV1 ;NO
MOV SS:[DI],BX ;YES, UPDATE TOP-OF-STACK
RET
PTV1: CMP AX,16 ;LOCAL?
JGE PTV2 ;NO
PUSH BP ;SAVE
DEC AX ;YES, POINT TO PROPER STACK ELEMENT
SHL AX,1
MOV BP,ZLOCS
SUB BP,AX
MOV [BP],BX ;AND UPDATE IT
POP BP ;RESTORE
RET
PTV2: SUB AX,16 ;GLOBAL, POINT TO PROPER GLOBAL TABLE ELEMENT
SHL AX,1
ADD AX,GLOTAB
XCHG AX,BX ;AND UPDATE IT
XCHG AH,AL
MOV ES:[BX],AX
RET
;RETURN VAL IN AX TO LOCATION SPECIFIED BY NEXTBYTE
;DESTROYS BX, BUT IS USUALLY CALLED AT END OF TOP-LEVEL FUNCTION
BYTVAL: SUB AH,AH ;THIS ENTRY FOR BYTE VALUE TO CLEAR HIGH BYTE
JMP PUTVAL
PUTVAL: MOV BX,AX ;NORMAL ENTRY
CALL NXTBYT ;GET VAR TO USE
CMP AX,0 ;STACK?
JNE PUTVAR ;NO, GO STORE VALUE
XCHG SP,DI
PUSH BX ;YES, PUSH ONTO STACK
XCHG SP,DI
RET ;AND RETURN
;PREDICATE HANDLERS TRUE & FALSE
;DESTROYS REGISTERS, BUT ARE ONLY CALLED FROM END OF TOP-LEVEL FCNS
PFALSE: SUB BX,BX ;PREDICATE WAS FALSE, CLEAR FLAG
JMP PPRED
PTRUE: MOV BX,1 ;PREDICATE WAS TRUE, SET FLAG
JMP PPRED
PPRED: CALL NXTBYT ;GET FIRST (OR ONLY) PREDICATE JUMP BYTE
TEST AX,80H ;NORMAL POLARITY PREDICATE?
JE PPR1 ;NO, LEAVE FLAG ALONE
INC BX ;YES, INCREMENT FLAG
PPR1: TEST AX,40H ;ONE-BYTE JUMP OFFSET?
JE PPR2 ;NO
AND AX,0FF3FH ;YES, CLEAR SPECIAL BITS
JMP PPR3
PPR2: AND AX,0FF3FH ;CLR SPECIAL BITS FROM HIGH-ORDER OFFSET BYTE
MOV CX,AX ;HIGH-ORDER BYTE
CALL NXTBYT ;GET LOW-ORDER BYTE
MOV AH,CL ;MOVE IN HIGH-ORDER BITS
TEST AX,2000H ;IS NUMBER NEGATIVE (14-BIT 2'S COMP NUMBER)?
JE PPR3 ;NO
OR AX,0C000H ;YES, MAKE 16-BIT NUMBER NEGATIVE
PPR3: DEC BX ;TEST FLAG
JE PPR6 ;WAS 1, THAT MEANS DO NOTHING
CMP AX,0 ;ZERO JUMP?
JNE PPR4 ;NO
JMP OPRFAL ;YES, THAT MEANS DO AN RFALSE
PPR4: DEC AX ;ONE JUMP?
JNE PPR5 ;NO
JMP OPRTRU ;YES, THAT MEANS DO AN RTRUE
PPR5: DEC AX ;ADJUST OFFSET
ADD ZPC2,AX ;ADD TO PC
JMP NEWZPC ;AND UPDATE ZPC STUFF
PPR6: RET
;SPLIT BYTE-POINTER IN AX TO BLOCK-POINTER IN AX & BYTE OFFSET IN BX
BSPLTB: MOV BX,AX
XCHG AL,AH ;EXTRACT BLOCK BITS
SHR AX,1
AND AX,7FH ;CLEAR UNWANTED BITS
AND BX,1FFH ;CLEAR ALL BUT BYTE OFFSET BITS
RET
;SPLIT WORD-POINTER IN AX TO BLOCK-POINTER IN AX & BYTE-OFFSET IN BX
BSPLIT: MOV BX,AX
MOV AL,AH ;EXTRACT BLOCK BITS
SUB AH,AH ;CLEAR UNWANTED BITS
SUB BH,BH ;CLEAR ALL BUT WORD OFFSET BITS
SHL BX,1 ;CONVERT TO BYTE OFFSET
RET
;GIVEN OBJ NUMBER IN AX, RETURN OBJ LOCATION IN AX
OBJLOC: SUB AH,AH ;CLEAR UNWANTED BITS
PUSH BX ;MULTIPLY BY 9 THE LAZY WAY
MOV BX,AX
SHL AX,1
SHL AX,1
SHL AX,1
ADD AX,BX
POP BX ;RESTORE
ADD AX,OBJTAB ;INDEX INTO OBJECT TABLE
ADD AX,53 ;SKIPPING DEFAULT PROPERTY TABLE
RET
;GIVEN POINTER TO A PROPERTY IN BX!, UPDATE IT TO POINT TO NEXT PROP
NXTPRP: PUSH AX ;SAVE
PUSH CX ;SAVE
MOV AL,ES:[BX] ;GET PROPERTY IDENTIFIER
AND AL,224 ;EXTRACT PROPERTY LENGTH
MOV CL,5 ;PROPSIZE
SHR AL,CL
SUB AH,AH
ADD BX,AX ;ADD IT TO OLD POINTER
ADD BX,2 ;ADJUST FOR EXTRA LENGTH BYTE PLUS IDENTIFIER
POP CX ;RESTORE
POP AX ;RESTORE
RET
;OUTPUT A ZSTR, BLOCK-POINTER IN AX, BYTE-POINTER IN BX
;RETURN UPDATED POINTER
PUTSTR: PUSH SI ;SAVE
PUSH CX ;SAVE
PUSH DX ;SAVE
PUSH DI ;SAVE
PUSH BP ;SAVE
SUB DX,DX ;TEMP CS STARTS AT 0
SUB DI,DI ;PERM CS STARTS AT 0
PTS1: CALL GETWRD ;GET NEXT STRING WORD
MOV SI,CX
PUSH AX ;SAVE POINTER & COPY OF STRING WORD
PUSH BX
PUSH SI
MOV CX,3 ;3 BYTES IN WORD
PTS2: PUSH SI ;SAVE CURRENT BYTE (IN LOW-ORDER POSITION)
MOV BP,CX ;SHIFT TO NEXT BYTE
MOV CL,5
SAR SI,CL
MOV CX,BP
LOOP PTS2 ;LOOP UNTIL DONE
MOV CX,3 ;RETRIEVE THE 3 BYTES
PTS3: POP SI ;GET NEXT BYTE
AND SI,1FH ;CLEAR UNWANTED BITS
CMP DX,0 ;IN WORD MODE?
JGE PTS4 ;NO {WAS BPL, CHECK}
SAL SI,1 ;YES, CALCULATE WORD OFFSET
ADD SI,WRDTAB ;POINT INTO WORD TABLE
ADD SI,WRDOFF ;USING PROPER 32-WORD BLOCK
MOV AX,ES:[SI] ;POINT TO WORD STRING
XCHG AH,AL
CALL BSPLIT ;SPLIT IT
CALL PUTSTR ;AND PRINT IT
JMP PTS15 ;CONT. WHERE WE LEFT OFF WITH TEMP CS RESET
PTS4: CMP DX,3 ;CS 3 SELECTED (ASCII MODE)?
JL PTS6 ;NO, NORMAL CS
JNE PTS5 ;NO, BUT WE ARE IN ASCII MODE
XCHG DL,DH ;SHIFT SOME BITS HIGH TO MAKE NUMBER LARGE
OR DX,SI ;SAVE HIGH-ORDER ASCII BITS HERE
JMP PTS16 ;GO GET NEXT BYTE
PTS5: AND DX,3 ;EXTRACT PREVIOUSLY SAVED HIGH-ORDER BITS
MOV BP,CX ;POSITION THEM
MOV CL,5
SAL DX,CL
MOV CX,BP
OR DX,SI ;OR IN LOW-ORDER BITS
MOV AX,DX
JMP PTS14 ;GO PRINT THE CHARACTER
PTS6: CMP SI,6 ;SPECIAL CODE?
JL PTS9 ;YES, SPACE, WORD, OR SHIFT
CMP DX,2 ;MIGHT ALSO BE SPECIAL IF IN CS 2
JNE PTS8 ;BUT WE'RE NOT
CMP SI,7 ;CRLF?
JE PTS7 ;YES
JG PTS8 ;NO, NOT ASCII MODE, EITHER?
INC DX ;YES IT IS, SWITCH TO ASCII MODE
JMP PTS16 ;AND GO GET NEXT BYTE
PTS7: CALL NEWLIN ;CRLF REQUESTED, DO A NEWLINE
JMP PTS15
PTS8: MOV AX,DX ;NORMAL CHARACTER, GET CS
MOV BP,26 ;CALCULATE OFFSET FOR THIS CS
MUL BP
ADD AX,SI ;ADD IN CHARACTER OFFSET (+6)
SUB AX,6 ;CHARACTER OFFSET
MOV BX,OFFSET ZCHRS ;GET THE CHARACTER FROM CONVERSION VECTOR
XLAT ZCHRS
JMP PTS14 ;GO PRINT IT
PTS9: CMP SI,0 ;IS IT A SPACE?
JNE PTS10 ;NO
MOV AX,' ' ;YES, GO PRINT A SPACE
JMP PTS14
PTS10: CMP SI,3 ;IS IT A WORD?
JG PTS11 ;NO, MUST BE A SHIFT
OR DX,8000H ;SWITCH TO WORD MODE FOR NEXT BYTE
DEC SI ;CALCULATE WORD-TABLE BLOCK OFFSET
MOV BP,CX ;64 BYTES IN A BLOCK
MOV CL,6
SHL SI,CL
MOV CX,BP
MOV WRDOFF,SI ;SAVE IT AND LOOP
JMP PTS16
PTS11: SUB SI,3 ;CALCULATE NEW CS
CMP DX,0 ;TEMPORARY SHIFT (FROM CS 0)?
JNE PTS12 ;NO
MOV DX,SI ;YES, JUST SAVE NEW TEMP CS
JMP PTS16
PTS12: CMP SI,DX ;IS THIS THE CURRENT CS?
JE PTS13 ;YES, DO A PERM SHIFT TO IT
SUB DX,DX ;OTHERWISE, PERM SHIFT TO CS 0
PTS13: MOV DI,DX ;TEMP & PERM CS'S ARE SAME NOW
JMP PTS16
PTS3A: JMP PTS3 ;DUMMY FOR NON-SHORT LOOP
PTS14: CALL PUTCHR ;PRINT THE CHARACTER
PTS15: MOV DX,DI ;RESET TEMP CS TO PERM CS
PTS16: LOOP PTS3A ;NEXT BYTE
POP SI ;RESTORE POINTERS & ORIGINAL STRING WORD
POP BX
POP AX
CMP SI,0 ;END-OF-STRING?
JL PTS1A ;YES, CLEAN UP & RETURN UPDATED POINTER
JMP PTS1 ;NO, GET NEXT WORD
PTS1A: POP BP ;RESTORES
POP DI
POP DX
POP CX
POP SI
RET
;GIVEN AN ASCII CHARACTER IN AX, RETURN THE CHARACTER SET # IN AX
CHRCS: CMP AX,0 ;IS THIS A NULL?
JNE CCS1 ;NO
MOV AX,3 ;YES, RETURN DUMMY CS NUMBER
RET
CCS1: PUSH BX ;SAVE
MOV BX,OFFSET ZCHRS ;POINT TO CONVERSION VECTOR
CCS2: INC BX ;FOUND THE CHARACTER?
CMP AL,-1[BX]
JE CCS3 ;YES
CMP BYTE PTR [BX],0 ;NO, END OF STRING?
JNE CCS2 ;NO, CONTINUE LOOP
MOV AX,2 ;YES, CALL IT CS 2
JMP CCS5
CCS3: SUB BX,OFFSET ZCHRS ;FIND CHARACTER POSITION
SUB AX,AX ;START WITH CS 0
CCS4: SUB BX,26 ;EVERY 26 CHARACTERS IS A NEW CS
JLE CCS5 ;DONE
INC AX ;INCREMENT CS # & CONTINUE LOOP
JMP CCS4
CCS5: POP BX
RET
;GIVEN AN ASCII CHARACTER IN AX, RETURN ZSTR BYTE VALUE IN AX
CHRBYT: PUSH BX ;SAVE
MOV BX,OFFSET ZCHRS ;POINT TO CHARACTER CONVERSION TABLE
CHB1: INC BX ;FOUND THE CHARACTER?
CMP AL,-1[BX]
JE CHB2 ;YES
CMP BYTE PTR [BX],0 ;NO, END OF STRING?
JNE CHB1 ;NO, CONTINUE LOOP
SUB AX,AX ;YES, RETURN ZERO FOR FAILURE
JMP CHB4
CHB2: SUB BX,OFFSET ZCHRS-5 ;ADJUST POINTER SO FIRST CHARACTER IS 6
MOV AX,BX
CHB3: CMP AX,32 ;SUBTRACT MULTIPLES OF 26 UNTIL BASE CODE
JL CHB4
SUB AX,26
JMP CHB3
CHB4: POP BX ;RESTORE
RET
;CONVERT UP TO 6 ASCIZ CHARS POINTED TO BY DS:AX
;TO A 2-WORD ZSTR RETURNED IN AX & BX
ZWORD: PUSH SI ;SAVES
PUSH CX
PUSH DX
PUSH DI
PUSH BP
MOV SI,AX ;CHARACTER STRING POINTER
SUB DI,DI ;CS STARTS AT 0
MOV CX,6 ;MAKE 6 ZSTR BYTES
ZWD1: INC SI ;GET NEXT CHARACTER
MOV BL,-1[SI]
CMP BL,0
JNE ZWD3 ;NOT END-OF-STRING
MOV AX,OFFSET PADCHR;AT END-OF-STRING, PAD WITH PAD CHARACTER
ZWD2: PUSH AX ;SAVE A PAD BYTE
LOOP ZWD2 ;LOOP UNTIL DONE
JMP ZWD6 ;THEN GO FORM ZWORD
ZWD3: MOV AX,BX
CALL CHRCS ;FIND THE CS NUMBER FOR THIS CHAR
CMP AX,0 ;CS 0?
JE ZWD4 ;YES
ADD AX,3 ;NO, CALCULATE TEMP SHIFT BYTE
PUSH AX ;SAVE THE SHIFT BYTE
DEC CX ;REDUCE BYTE COUNT
JE ZWD6 ;DONE
ZWD4: MOV AX,BX ;FIND THE PROPER BYTE VALUE FOR THIS CHAR
CALL CHRBYT
CMP AX,0 ;IN NORMAL CS'S?
JNE ZWD5 ;YES
MOV AX,6 ;NO, USE ASCII SHIFT
PUSH AX
DEC CX ;DONE YET?
JE ZWD6 ;YES
MOV AX,BX ;NO, SAVE HIGH-ORDER ASCII BITS
MOV BP,CX
MOV CL,5
SAR AX,CL
MOV CX,BP
PUSH AX
DEC CX ;DONE YET?
JE ZWD6 ;YES
AND BX,1FH ;NO, SAVE LOW-ORDER ASCII BITS
MOV AX,BX
ZWD5: PUSH AX ;SAVE THIS BYTE
LOOP ZWD1 ;LOOP UNTIL ZWORD FULL
ZWD6: MOV BP,SP ;BUILD ZWORD WORDS FROM 6 SAVED BYTES
MOV AX,10[BP]
MOV CL,5
SHL AX,CL
OR AX,8[BP]
SHL AX,CL
OR AX,6[BP]
MOV BX,4[BP]
SHL BX,CL
OR BX,2[BP]
SHL BX,CL
OR BX,[BP]
OR BX,8000H ;SET END-OF-STRING BIT IN SECOND WORD
ADD SP,12 ;FLUSH STACK
POP BP ;RESTORES
POP DI
POP DX
POP CX
POP SI
RET
;QUEUE CHARACTER IN AX FOR OUTPUT
PUTCHR: PUSH BP
MOV BP,CHRPTR ;END OF BUFFER?
CMP BP,ENDBUF
JNE PTC7 ;NO
PUSH AX ;YES, ENTER OUTPUT ROUTINE; SAVES
PUSH BX
PUSH SI
MOV BX,ENDBUF ;END OF BUFFER
MOV SI,OFFSET OUTBUF;BEGINNING OF BUFFER
PTC1: DEC BX ;SEARCH FOR SPACE BACKWARDS FROM END
CMP BYTE PTR [BX],' '
JE PTC3
CMP BX,SI ;STOP AT BEGINNING OF BUFFER
JNE PTC1
PTC2: MOV AX,OFFSET OUTBUF
CALL M_PRNT ;NO SPACES. OUTPUT WHOLE LINE
MOV CHRPTR,SI ;RESTORE POINTER TO BEGINNING OF BUFFER
MOV BP,SP
CMP BYTE PTR 4[BP],' ' ;DID A SPACE CAUSE BUFFER OVERFLOW?
JNE PTC6 ;NO
MOV WORD PTR 4[BP],0 ;YES, FLUSH IT
JMP PTC6 ;AND RETURN
PTC3: CMP BX,SI ;DEGENERATE CASE WITH SPACE AT OUTBUF?
JE PTC2 ;YES, OUTPUT WHOLE LINE
MOV BYTE PTR [BX],0 ;NO, OUTPUT UP TO SPACE
MOV AX,OFFSET OUTBUF
CALL M_PRNT
MOV AX,ENDBUF ;END OF BUFFER
INC BX ;START GETTING CHARACTERS AFTER THE SPACE
PTC4: CMP BX,AX ;AT END YET?
JE PTC5 ;YES
MOV BP,AX ;SAVE AX
MOV AL,[BX]
MOV [SI],AL ;NO, COPY NEXT CHAR TO BEGINNING OF BUF
MOV AX,BP ;RESTORE AX
INC BX
INC SI
JMP PTC4 ;AND CONTINUE
PTC5: MOV CHRPTR,SI ;NEXT CHAR WILL GO AFTER COPIED STUFF
PTC6: POP SI ;CLEAN UP
POP BX
POP AX
CMP AX,0 ;AND IGNORE A NULL CHARACTER
JE PTC8
PTC7: MOV BP,CHRPTR ;NOW STORE THE CHARACTER IN BUFFER
MOV DS:[BP],AL
INC CHRPTR ;UPDATE POINTER
PTC8: POP BP ;RESTORE
RET ;AND RETURN
;GO TO NEW LINE, OUTPUTTING CURRENT BUFFER
NEWLIN: PUSH BX ;SAVE
MOV BX,CHRPTR ;END LINE AT CURRENT POINT
MOV BYTE PTR [BX],0
MOV CHRPTR,OFFSET OUTBUF ;RESET CHARACTER POINTER
POP BX ;RESTORE
MOV AX,OFFSET OUTBUF
CALL M_PRNT ;AND OUTPUT LINE
RET
;INITIALIZATION
TSETUP: MOV BX,OFFSET OUTBUF;START OF OUTPUT BUFFER
MOV AL,SCPL
SUB AH,AH
ADD BX,AX ;ADD LENGTH OF BUFFER
MOV ENDBUF,BX ;THIS IS ENDBUF POINTER
MOV BYTE PTR [BX],0 ;BUFFER IS FOLLOWED BY A 0 FOR CONVENIENCE
MOV BX,OFFSET SLSTAB
CMP TIMEMD,0
JE TSET1
ADD BX,4
TSET1: MOV AX,[BX]
MOV SLSTR,AX
MOV CX,2[BX]
MOV SLTAB,CX
CALL M_INIT
RET
ZIPBGN: CALL SYSINI ;DO ANY SYSTEM INITIALIZATION
STR5: MOV AX,MBLEN
MOV MEMTOP,AX
SUB AX,AX ;BLOCK 0
SUB BX,BX ;PUT AT BEGINNING OF GAME SEGMENT
CALL GETBLK ;GET THE BLOCK
CMP ES:BYTE PTR .PVERS1,ZMVERS ;PROPER Z-MACHINE VERSION?
JNE STR8 ;NO
TEST ES:BYTE PTR .PVERS2,1 ;YES,PROPER MODE BITS?
JE STR9 ;YES
STR8: MOV AX,OFFSET FTL4
JMP FATAL
STR9: TEST ES:BYTE PTR .PVERS2,2 ;TIME MODE REQUESTED?
JE STR10 ;NO
INC TIMEMD ;YES, SET TIME-MODE FLAG
STR10: MOV AX,ES:.PZRKID ;UNIQUE GAME & VERSION IDENTIFIER
XCHG AH,AL
MOV ZORKID,AX
MOV AX,ES:.PENDLD ;GET ENDLOD POINTER
XCHG AH,AL
TEST AX,1FFH ;ROUND UP TO NEXT BLOCK
JE STR12
AND AX,0FE00H
ADD AX,200H
STR12: MOV CX,AX
MOV BP,CX ;EXTRACT ENDLOD BLOCK
MOV CL,9
SAR BP,CL
MOV CX,BP
MOV ENDLOD,CX ;SAVE ENDLOD BLOCK NUMBER
DEC CX ;NUMBER OF BLOCKS LEFT TO LOAD
MOV AX,1 ;STARTING WITH BLOCK 1
MOV BX,200H ;LOCATION TO PUT THEM
CALL GTBLKS ;GET THE BLOCKS
MOV AX,ES:.PVOCTB ;VOCAB LOCATION
XCHG AH,AL
MOV VOCTAB,AX ;SAVE VOCABULARY TABLE POINTER
MOV AX,ES:.POBJTB ;GET OBJECT TABLE POINTER
XCHG AH,AL
MOV OBJTAB,AX
MOV AX,ES:.PGLOTB ;GET GLOBAL TABLE POINTER
XCHG AH,AL
MOV GLOTAB,AX
MOV AX,ES:.PWRDTB ;GET WORD TABLE POINTER
XCHG AH,AL
MOV WRDTAB,AX
MOV AX,ES:.PPURBT ;GET PURE CODE POINTER
XCHG AH,AL
TEST AX,1FFH ;ROUND UP TO NEXT BLOCK
JE STR13
ADD AX,200H
STR13: MOV CL,9 ;EXTRACT BLOCK NUMBER
SAR AX,CL
AND AX,7FH ;CLEAR UNWANTED BITS
MOV PURBOT,AX ;SAVE IT
MOV BX,OFFSET RBRKS ;START OF READ BREAK CHARACTER TABLE
MOV SI,VOCTAB ;VOCAB TABLE POINTER
MOV CL,ES:BYTE PTR [SI] ;1ST BYTE IN VOCTAB IS # OF SIBREAKS
SUB CH,CH ;CLEAR HIGH BYTE
INC SI
STR14: MOV AL,ES:[SI]
MOV [BX],AL ;TRANSFER THEM
INC BX
INC SI
LOOP STR14
MOV ESIBKS,BX ;REMEMBER END OF SI BREAKS
MOV BP,OFFSET IRBRKS;ALWAYS END WITH INITIAL BREAK CHARACTERS
STR15: MOV AL,DS:[BP]
MOV [BX],AL ;TRANSFER THEM
INC BX
INC BP
CMP AL,0
JNE STR15
MOV AL,ES:[SI] ;GET VOCABULARY ENTRY LENGTH
SUB AH,AH
MOV VWLEN,AX ;AND STORE IT AWAY
INC SI
MOV AX,ES:[SI] ;GET NEXT WORD IN TABLE
XCHG AH,AL
MOV VWORDS,AX ;NUMBER OF WORD ENTRIES IN VOCABULARY
ADD SI,2 ;MOVE TO NEXT WORD
MOV VOCBEG,SI ;BEGINNING OF ACTUAL VOCABULARY
MOV SI,ENDLOD ;GET # PAGES IN ENDLOD
MOV CL,9
SHL SI,CL ;THIS IS FIRST LOCATION (ES:) OF PAGING
MOV PAGES,SI ;SAVE THIS TO USE AS AN OFFSET
MOV SI,ENDLOD ;GET # PAGES IN ENDLOD
NEG SI
MOV DI,MEMTOP ;GET PARAGRAPHS OF MEMORY
MOV CL,5
SAR DI,CL ;CHANGE TO PAGES
ADD SI,DI ;NUMBER OF PAGES FOR PAGING
MOV BUFPGS,SI ;SAVE THIS NUMBER FOR FUTURE REFERENCE
CMP BUFPGS,63
JLE STR16
MOV BUFPGS,63 ;OUR TABLE IS ONLY SO BIG....
MOV SI,63
STR16: SHL SI,1
SHL SI,1 ;EACH PAGE HAS 4 BYTES OF INFO
MOV BX,OFFSET PAGTAB ;POINT INTO PAGE INFO TABLE
ADD SI,BX
MOV WORD PTR [SI],-1 ;MAKE THIS THE END OF TABLE MARK
CALL M_TIME ;GET THE CURRENT TIME-OF-DAY
JMP START1
;RESTART EXECUTION HERE
RESTRT: SUB AX,AX ;REREAD ALL OF THE IMPURE STUFF
SUB BX,BX
MOV CX,PURBOT
CALL GTBLKS
START1: CALL TSETUP ;SETUP TERMINAL/STATUS LINE
CALL CLRSCR ;CLEAR THE REMAINDER OF SCREEN
MOV SP,OFFSET STK_TOP ;INITIALIZE OUR STACK POINTER
MOV DI,OFFSET ZSTK_TP ;INITIALIZE USER STACK POINTER
MOV CHRPTR,OFFSET OUTBUF ;INITIALIZE OUTPUT CHARACTER POINTER
MOV ZLOCS,DI ;LOCALS WOULD START AT FIRST SLOT,
SUB ZLOCS,2 ;IF THERE WERE ANY
MOV AX,ES:.PSTART ;GET STARTING LOCATION
XCHG AH,AL
CALL BSPLTB ;SPLIT BLOCK & BYTE POINTERS
MOV ZPC1,AX ;INITIALIZE ZPC BLOCK-POINTER
MOV ZPC2,BX ;INITIALIZE ZPC BYTE-POINTER
CALL NEWZPC ;GET PAGE TO EXECUTE
JMP NXTINS
;MAIN INSTRUCTION INTERPRETATION LOOP
NXTINS: CALL NXTBYT ;GET THE OPERATION BYTE
MOV DX,AX ;SAVE A COPY
CMP AX,80H ;IS IT A 2OP?
JL NXI9 ;YES
CMP AX,0B0H ;NO, IS IT A 1OP?
JGE NXI0A ;NO
JMP NXI12 ;YES
NXI0A: CMP AX,0C0H ;IS IT A 0OP?
JG NXI0B ;NO
JMP NXI13 ;YES
NXI0B: AND AX,3FH ;IT'S EXTENDED, GET THE OPCODE
SHL AX,1 ;MAKE IT A WORD OFFSET
MOV BP,AX ;GET THE OPERATOR POINTER
MOV SI,DS:EXTOP[BP]
CMP SI,0
JNE NXI0C ;OPERATION EXISTS
JMP NXI14 ;NO SUCH OPERATION
NXI0C: CALL NXTBYT ;GET THE ARGUMENT BYTE
MOV CX,4 ;SPLIT IT INTO 4 2-BIT MODE BYTES
NXI1: PUSH AX
SAR AX,1
SAR AX,1
LOOP NXI1
MOV CX,4 ;RETRIEVE THE 4 BYTES IN PROPER ORDER
SUB DX,DX
MOV BX,OFFSET ARGBLK;FIRST ARGUMENT SLOT
NXI2: POP AX ;GET NEXT MODE BYTE?
AND AX,3 ;CLEAR OFF UNWANTED BITS
CMP AX,3 ;NO MORE ARGUMENTS?
JE NXI4 ;YES, FLUSH ANY OTHER MODE BYTES
CALL GETARG ;ELSE, GET THE NEXT ARGUMENT
MOV [BX],AX ;SAVE IT IN ARGUMENT BLOCK
ADD BX,2
INC DX ;REMEMBER NUMBER OF ARGS GOTTEN
NXI3: LOOP NXI2 ;LOOP FOR REST OF MODE BYTES
JMP NXI5
NXI4: DEC CX ;DETERMINE NUMBER OF REMAINING MODE BYTES
SHL CX,1 ;WORD COUNT
ADD SP,CX ;FLUSH THEM
NXI5: XCHG CX,DX
MOV AX,CX ;NUMBER OF ARGS GOES HERE FOR OPERATOR TO USE
CMP CS:BYTE PTR [SI],90H ;DOES OPERATOR WANT ARGBLK POINTER?
JE NXI8A ;YES, CALL OPERATOR NOW
DEC CX ;NO, IT WANTS ARGS IN REGISTERS
JL NXI8A ;NO ARGS, JUST CALL OPERATOR
JE NXI8 ;1 ARG, GET IT
SUB CX,2
JL NXI7 ;2 ARGS
JE NXI6 ;3 ARGS
MOV DX,ARGBLK+6 ;ELSE, 4 ARGS, GET 4TH
NXI6: MOV CX,ARGBLK+4 ;GET 3RD
NXI7: MOV BX,ARGBLK+2 ;GET 2ND
NXI8: MOV AX,ARGBLK ;GET FIRST ARG
NXI8A: JMP NXI15 ;AND CALL OPERATOR
NXI9: AND AX,1FH ;2OP, EXTRACT OPERATION BITS
SHL AX,1 ;MAKE IT A WORD OFFSET
MOV BP,AX ;FIND POINTER TO OPERATOR ROUTINE
MOV SI,DS:EXTOP[BP]
CMP SI,0
JE NXI14 ;NO SUCH OPERATION
MOV AX,1 ;ASSUME FIRST ARG IS AN IMMEDIATE
TEST DX,40H ;IS IT INSTEAD A VARIABLE?
JE NXI10 ;NO
INC AX ;YES, CHANGE MODE
NXI10: CALL GETARG ;GET THE FIRST ARG
PUSH AX ;SAVE IT
MOV AX,1 ;ASSUME SECOND ARG IS AN IMMEDIATE
TEST DX,20H ;IS IT INSTEAD A VARIABLE?
JE NXI11 ;NO
INC AX ;YES, CHANGE MODE
NXI11: CALL GETARG ;GET THE SECOND ARG
MOV BX,AX ;POSITION IT
POP AX ;RECOVER FIRST ARG
CMP CS:BYTE PTR [SI],90H ;DOES ROUTINE WANT ARGUMENT BLOCK?
JNE NXI15 ;NO, GO CALL IT
MOV ARGBLK,AX ;YES, MOVE ARGS TO ARGBLK
MOV ARGBLK+2,BX
MOV AX,2 ;ALWAYS 2 ARGS
JMP NXI15 ;NOW CALL OPERATOR
NXI12: AND DX,0FH ;1OP, EXTRACT OPERATION BITS
SHL DX,1 ;MAKE IT A WORD OFFSET
MOV BP,DX ;GET OPERATOR ROUTINE POINTER
MOV SI,DS:ONEOP[BP]
CMP SI,0
JE NXI14 ;ILLEGAL OPERATION
SAR AX,1 ;EXTRACT MODE BITS
SAR AX,1
SAR AX,1
SAR AX,1
AND AX,3
CALL GETARG ;GET THE ARGUMENT
JMP NXI15 ;AND CALL OPERATOR
NXI13: AND AX,0FH ;0OP, EXTRACT OPERATION BITS
SHL AX,1 ;MAKE IT A WORD OFFSET
MOV BP,AX ;GET OPERATOR ROUTINE POINTER
MOV SI,DS:ZEROOP[BP]
CMP SI,0
JNE NXI15 ;IT'S A LEGAL OPERATION
NXI14: MOV AX,OFFSET FTL5
JMP FATAL
NXI15: CALL SI ;CALL THE OPERATOR ROUTINE
JMP NXTINS ;AND LOOP FOR NEXT INSTRUCTION
;NORMALIZE ZPC & GET PROPER PAGE
NEWZPC: PUSH SI ;SAVES
PUSH BP
PUSH BX
PUSH CX
PUSH DX
SUB AX,AX ;USE DOUBLE-WORD ARITHMETIC
MOV BX,ZPC1 ;GET BLOCK-POINTER
MOV BH,BL ;POSITION IT
SUB BL,BL
SHL BX,1
ADC AX,0
MOV SI,ZPC2 ;GET BYTE-OFFSET
XCHG SI,AX ;DOUBLE-WORDIFY IT (MIGHT BE NEGATIVE)
CWD
XCHG SI,AX
ADD BX,SI ;ADD IT TO OTHER DOUBLE WORD
ADC AX,DX
MOV DX,BX
AND DX,1FFH ;EXTRACT BYTE-OFFSET
MOV ZPC2,DX ;SAVE IT
MOV CL,9 ;EXTRACT BLOCK-POINTER
SAR BX,CL
AND BX,7FH
TEST AX,1 ;TEST 17TH BIT
JE NWZ1 ;WAS 0
OR BX,80H ;WAS 1, SET PROPER BIT IN BLOCK-POINTER
NWZ1: MOV ZPC1,BX ;SAVE IT
CMP BX,CURBLK ;HAS IT CHANGED?
JE NWZ5 ;NO
MOV CURBLK,BX ;YES, REMEMBER NEW BLOCK
MOV AX,CURTAB ;IS OLD PAGE IN PAGING SPACE?
CMP AX,0
JE NWZ2 ;NO
MOV BP,AX ;YES, STORE CURRENT REF TIME FOR OLD PAGE
MOV CL,RTIME1
MOV DS:[BP],CL
MOV CX,RTIME2
MOV DS:1[BP],CX
INC AX
NWZ2: CMP BX,ENDLOD ;NEW PAGE ALREADY IN CORE?
JL NWZ3 ;YES
MOV AX,BX ;NO, GET NEW PAGE
CALL GETPAG
MOV BX,AX
MOV AX,LPTAB ;GET NEW PAGE TABLE POINTER
INC AX ;POINT TO REF SLOT
MOV CURTAB,AX ;SAVE THIS POINTER FOR LATER
MOV BP,AX ;STORE HIGHEST RTIME TO KEEP PAGE FOR US
MOV DS:BYTE PTR [BP],-1
MOV DS:WORD PTR 1[BP],-1
INC AX
JMP NWZ4
NWZ3: MOV CL,9 ;CALCULATE PAGE ADDRESS
SHL BX,CL
MOV CURTAB,0 ;CLEARING POINTER MEANS PAGE IS PRELOADED
NWZ4: MOV CURPAG,BX ;UPDATE PAGE POINTER
NWZ5: POP DX ;RESTORES
POP CX
POP BX
POP BP
POP SI
RET ;AND RETURN
;GET THE PAGE WHOSE NUMBER IS IN AX, RETURN A POINTER TO IT IN AX
GETPAG: CMP AX,LPAGE ;IS THIS THE SAME PAGE AS LAST REFERENCED?
JNE GTP1 ;NO
MOV AX,LPLOC ;YES, WE ALREADY HAVE LOCATION
RET ;RETURN IT
GTP1: MOV LPAGE,AX ;SAVE NEW PAGE NUMBER
PUSH CX ;SAVES
PUSH BX
ADD RTIME2,1 ;UPDATE REFERENCE TIME (COUNT)
ADC RTIME1,0
MOV BX,OFFSET PAGTAB;PAGE INFORMATION TABLE
GTP2: INC BX
CMP AL,-1[BX] ;SEARCH FOR DESIRED BLOCK
JNE GTP3 ;NOT IT
CMP AX,CURBLK
JE GTP2A
MOV CL,RTIME1
MOV [BX],CL ;FOUND IT, UPDATE ITS REFERENCE TIME
MOV CX,RTIME2
MOV 1[BX],CX
GTP2A: DEC BX ;BACKUP TO BEGINNING OF TABLE ENTRY
MOV LPTAB,BX ;SAVE IT
SUB BX,OFFSET PAGTAB;CALCULATE ADDRESS OF PAGE
MOV CL,7
SHL BX,CL
ADD BX,PAGES
JMP GTP4 ;AND RETURN PAGE POINTER
GTP3: ADD BX,3 ;SKIP REFERENCE TIME
CMP WORD PTR [BX],-1;END OF TABLE?
JNE GTP2 ;NO, CONTINUE SEARCH
CALL FINDPG ;YES, FIND A PAGE TO LOAD INTO
PUSH AX ;PAGE POINTER
MOV LPTAB,BX ;SAVE PAGE TABLE POINTER
MOV AX,LPAGE ;SAVE NEW BLOCK NUMBER
MOV [BX],AL
MOV CL,RTIME1
MOV 1[BX],CL ;AND CURRENT REF TIME
MOV CX,RTIME2
MOV 2[BX],CX
POP BX ;PAGE POINTER
CALL GETBLK ;GET THE BLOCK
GTP4: MOV AX,BX ;RETURN PAGE POINTER
MOV LPLOC,AX ;AND SAVE IT FOR LATER
POP BX ;RESTORES
POP CX
RET
;FIND A GOOD PAGE, RETURN PAGE POINTER IN AX & PAGTAB POINTER IN BX
FINDPG: PUSH CX
MOV BX,OFFSET PAGTAB
MOV CX,-1 ;FAKE BEST-CASE REFERENCE COUNT
MOV DX,CX
INC BX ;SKIP BLOCK NUMBER FOR NOW
FNP1: INC BX ;IS THIS REF TIME WORSE THAN CURRENT WORST?
CMP -1[BX],CL
JA FNP3 ;NO
JB FNP2 ;YES
CMP [BX],DX ;MAYBE, COMPARE LOW-ORDER WORDS, WORSE?
JAE FNP3 ;NO
FNP2: MOV CL,-1[BX] ;YES, SAVE ITS REF COUNT
MOV DX,[BX]
MOV AX,BX ;AND LOCATION (+2)
FNP3: ADD BX,3 ;SKIP SECOND WORD
CMP BYTE PTR [BX]-1,-1 ;LOOP UNTIL END OF TABLE
JNE FNP1
INC CX ;WAS A PAGE REALLY FOUND?
JE FNP4 ;NO, GROSS BUG!
SUB AX,2 ;YES, CALCULATE CORE LOCATION OF PAGE
MOV BX,AX
SUB AX,OFFSET PAGTAB
MOV CL,7
SHL AX,CL
ADD AX,PAGES
POP CX ;RESTORES
RET
FNP4: MOV AX,OFFSET FTL6
JMP FATAL
;SYSTEM INITIALIZATION
SYSINI: MOV CL,CFOPEN ;OPEN CODE
MOV DX,OFFSET GAMFCB
PUSH ES
INT 224 ;OPEN FILE
POP ES
CMP AL,0FFH
JE SYSFTL
MOV DX,ES
MOV CL,CSDMAB ;SET DMA BASE
PUSH ES
INT 224
POP ES
RET ;**THIS CHECKS # DRIVES, ETC.
SYSFTL: MOV AX,OFFSET FTL9
JMP FATAL
CLRSCR: RET ;**THIS SHOULD CLEAR THE SCREEN
;READ A CHARACTER INTO AX, WAITING UNTIL ONE IS AVAILABLE, NO ECHO
M_CHRI: PUSH CX
PUSH DX
CMP CHRFLG,0
JNZ MCHR1
MOV CHRFLG,1
;**INITIALIZE RANDOM NUMBER STUFF
MCHR1: MOV CL,CCONIN
PUSH ES
INT 224 ;GET A CHARACTER
POP ES
SUB AH,AH
POP DX
POP CX
RET
;PRINT THE CHARACTER IN AL, FOREGROUND IN AH
M_TTYO: PUSH AX
PUSH BX ;SAVES
PUSH CX
PUSH DX
PUSH BP
PUSH AX
MOV CL,CCONIO
MOV DL,AL
PUSH ES
INT 224 ;CHUCK IT
POP ES
POP AX
CMP SCRFLG,0
JZ MTYO1
CALL PRTOUT
MTYO1: POP BP ;RESTORES
POP DX
POP CX
POP BX
POP AX
RET
;PRINT SPACES, WITHOUT MOVING CURSOR, NUMBER IN AL, ATTRIBUTE IN AH
M_SPC: RET
;PRINT A CARRIAGE RETURN/LINE FEED, WITH MORE MODE (ASSUMING SCREEN
;BOTTOM)
M_CRLF: PUSH AX ;SAVES
PUSH BX
PUSH CX
PUSH DX
PUSH BP
INC MORLIN ;INCREMENT NUMBER OF LINES OUTPUT
MOV CL,CCONIO
MOV DL,13
PUSH ES
INT 224 ;PRINT CRLF
POP ES
MOV CL,CCONIO
MOV DL,10
PUSH ES
INT 224
POP ES
MOV AL,SLPP
CMP MORLIN,AL ;FULL PAGE OUTPUT?
JL MCR1 ;NOT YET
MOV MORLIN,0 ;RESET COUNTER
MOV AX,OFFSET MORE
CALL M_PRNT
CALL M_CHRI ;READ A CHARACTER TO CONTINUE
MOV AX,OFFSET EMORE
CALL M_PRNT ;FLUSH THE MORE STUFF
MCR1: CMP SCRFLG,0
JE MCR2
CALL PRTCRL ;CRLF TO PRINTER
MCR2: POP BP ;RESTORES
POP DX
POP CX
POP BX
POP AX
RET
;OUTPUT STATUS LINE HERE
M_SOUT: MOV BX,OFFSET SBLINE
CALL M_SPRT
MOV CL,09H
MOV DX,SLSTR
PUSH ES
INT 224
POP ES
MOV BX,OFFSET SELINE
CALL M_SPRT
RET
M_SPRT: PUSH ES
MOV CL,BYTE PTR [BX]
SUB CH,CH
CMP CL,0
JE MSPRT1
MSPLP: INC BX
MOV DL,BYTE PTR [BX]
PUSH CX
MOV CL,06H
PUSH BX
INT 224
POP BX
POP CX
LOOP MSPLP
MSPRT1: POP ES
RET
M_INIT: MOV BX,OFFSET STINIT
CALL M_SPRT
MOV BX,OFFSET SELINE
CALL M_SPRT
RET
;PRINT A STRING, POINTER (TO DATA SEGMENT) IN AX, WHITE FOREGROUND
M_PRNT: PUSH BX ;SAVE BX
MOV BX,AX ;STRING POINTER
MPR1: MOV AL,[BX] ;GET NEXT CHARACTER
CMP AL,0 ;END OF LINE, WITH CRLF?
JE MPR2 ;YES
CMP AL,80H ;END OF LINE, NO CRLF?
JE MPR3 ;YES
CALL M_TTYO ;PRINT CHARACTER
INC BX ;POINT TO NEXT CHARACTER
JMP MPR1 ;REPEAT
MPR2: CALL M_CRLF ;PRINT A CRLF
MPR3: POP BX ;RESTORE BX
RET
;GET TIME
M_TIME: RET
;GET A GAME FILE BLOCK, BLOCK NUMBER IN AX, CORE LOCATION IN ES:BX
GETBLK: PUSH CX ;SAVE
MOV CX,1 ;CALL GTBLKS FOR 1 BLOCK ONLY
CALL GTBLKS
POP CX ;RESTORE
RET
SRBLKS: MOV DSKFCB,OFFSET SAVFCB
JMP GTBKI
;GET A SERIES OF GAME FILE BLOCKS,
;FIRST BLOCK NUMBER IN AX, CORE LOCATION IN ES:BX # OF BLOCKS IN CX
GTBLKS: MOV DSKDIR,0 ;READ MODE
MOV DSKFCB,OFFSET GAMFCB ;GAME MODE
GTBKI: PUSH BX
PUSH DX ;SAVES
PUSH BP
SHL AX,1 ;CONVERT TO 128-BYTE BLOCKS
SHL AX,1
SHL CX,1 ;AND FOUR TIMES AS MANY OF THEM
SHL CX,1
MOV GTBSTT,AX
MOV GTBCOR,BX
MOV GTBCNT,CX ;SAVE THESE
GTBLP: MOV CL,CSDMAO
MOV DX,BX
PUSH ES
INT 224 ;SET DMA ADDRESS
POP ES
MOV AX,GTBSTT ;GET STARTING BLOCK #
MOV BX,DSKFCB ;GET FCB
MOV 33[BX],AX ;SET RANDOM READ/WRITE SLOT
MOV CL,CRDRND
CMP DSKDIR,0
JE GTBKIR
MOV CL,CWRRND
GTBKIR: MOV DX,DSKFCB
PUSH ES
INT 224 ;DO THE OPERATION
POP ES
CMP AL,0
JNE GTB2 ;FATAL IF FAILS (FOR NOW)
DEC GTBCNT ;CHECK IF DONE
JZ GTBFIN
ADD GTBCOR,128 ;ADD TO CORE LOCATION
MOV BX,GTBCOR
INC GTBSTT ;AND BLOCK ADDRESS
JMP GTBLP
GTBFIN: CLC
GTBOUT: POP BP
POP DX
POP BX
RET
GTB2: CMP DSKFCB,OFFSET GAMFCB
JE GTB3
STC
JMP GTBOUT
GTB3: MOV AX,OFFSET FTL7
JMP FATAL
FATAL: PUSH AX
CALL M_CRLF
MOV AX,OFFSET FATHDR
CALL M_PRNT
POP AX
CALL M_PRNT
FINISH: MOV BX,OFFSET STRESET
CALL M_SPRT
MOV CL,CRESET
MOV DL,0
INT 224
ORG 1500H
; CONSTANTS FROM EVERYWHERE
ZVERSN EQU 'A' ;ZIP VERSION NUMBER
ZMVERS EQU 3 ;Z-MACHINE VERSION NUMBER
LSTACK EQU 256 ;LENGTH OF USER STACK(MUST BE 1 PAGE FOR NOW)
EOICHR EQU 15 ;CARRIAGE RETURN IS NORMAL END OF INPUT
EOLCHR EQU 10 ;LINE-FEED IS END-OF-LINE CHARACTER
PADCHR EQU 5 ;ZSTR PADDING CHARACTER
CRESET EQU 0H ;SYSTEM RESET
CCONIN EQU 1H ;CONSOLE INPUT
CCONIO EQU 6H ;CONSOLE I/O
CRDLIN EQU 0AH ;BUFFERED CONSOLE READ
CFOPEN EQU 0FH ;FILE OPEN
CFCLOS EQU 10H ;FILE CLOSE
CFDELE EQU 13H ;FILE DELETE
CRDSEQ EQU 14H ;READ SEQUENTIAL
CFMAKE EQU 16H ;FILE MAKE
CSDMAO EQU 1AH ;SET DMA OFFSET
CRDRND EQU 21H ;READ RANDOM
CWRRND EQU 22H ;WRITE RANDOM
CSDMAB EQU 33H ;SET DMA BASE
CFNMEM EQU 35H ;FILE MEMORY BLOCK
CALMEM EQU 37H ;ALLOCATE MEMORY
PVERS1 EQU 0 ;POSITION OF ZVERSION VERSION BYTE
PVERS2 EQU 1 ;ZVERSION MODE BYTE
PZRKID EQU 2 ;ZORKID
PENDLD EQU 4 ;ENDLOD
PSTART EQU 6 ;START
PVOCTB EQU 10Q ;VOCAB
POBJTB EQU 12Q ;OBJECT
PGLOTB EQU 14Q ;GLOBALS
PPURBT EQU 16Q ;PURBOT
PFLAGS EQU 20Q ;USER FLAG WORD
PSERNM EQU 22Q ;SERIAL NUMBER (6 BYTES)
PWRDTB EQU 30Q ;WORDS
PLENTH EQU 32Q ;LENGTH OF GAME
PCHKSM EQU 34Q ;CHECKSUM FOR GAME
LMOUTB EQU 80 ;MAX LENGTH OF OUTBUF, EXCLUDING TERMINAL 0
LDOUTB EQU 80 ;DEFAULT LENGTH OF OUTBUF
LPAGES EQU 128 ;MAX NUMBER OF PAGES EXPECTED
LXBYTS EQU LSTACK+LMOUTB+(4*LPAGES)+2000Q ;LENGTH OF EXTRA BYTES NEEDED
DSEG
ORG 100H
SCPL DB 79 ;CHARACTERS/LINE
SLPP DB 22 ;LINES/PAGE
SNAME RB 8 ;NAME OF THE GAME
SCLF DB 1 ;PRINT LF AFTER CR ON CONSOLE
SLLF DB 1 ;PRINT LF AFTER CR ON PRINTER
SINV DB 0 ;ADD-ON FOR INVERSE VIDEO
STINIT DB 23 ;TERMINAL INIT
DB 27,'[2J',27,'[2;24r',27,'[0m',27,'[01;00H'
ORG 12DH
STRESET DB 14 ;TERMINAL RESET
DB 27,'[1;24r',27,'[24;0H'
ORG 14DH
SBLINE DB 12 ;BEGIN STATUS LINE
DB 27,'[7m',27,'[01;00H'
ORG 16DH
SELINE DB 12 ;END STATUS LINE
DB 27,'[0m',27,'[24;00H'
ORG 18DH
SPINIT DB 0 ;PRINTER INIT
ORG 200H
;VARIABLE DEFINITIONS:
;SCRIPTING STUFF
SCRFLG DB 0
PRNRDY DB ' * Printer not ready: Abort or Retry? ',80H
;GTBLKS
GAMFCB DB 0,'SEASTALKDAT' ;FCB FOR THE GAME FILE
RB 30
SAVFCB DB 0,'SEASTALKSAV' ;FCB FOR SAVE/RESTORE
RB 30
CNFFCB DB 0,'INTERLOGCNF' ;FCB FOR CONFIGURATION FILE
RB 30
DSKFCB DW 0 ;CONTAINS FCB FOR DISK OPERATION
DSKDIR DB 0 ;0 FOR READ, 1 FOR WRITE
GTBCNT DW 0 ;REMAINING BLOCKS TO BE READ
GTBSTT DW 0 ;STARTING BLOCK
GTBCOR DW 0 ;STARTING CORE ADDRESS
;OPRAND
RNDFLG DB 0
RSEED1 DW 0 ;SEED FOR RANDOM NUMBERS
RSEED2 DW 0 ;SEED TWO
RTEMP DW 0 ;TEMP FOR RANDOM ROUTINES
;READ
RDWSTR DW 0,0,0,0 ;WORD STRING BUFFER FOR ZWORD
RDBOS DW 0 ;BEGINNING OF STRING POINTER
RDEOS DW 0 ;END OF STRING POINTER
RDRET DW 0 ;RETURN TABLE POINTER
RDNWDS DB 0 ;NUMBER OF WORDS READ
;PUTSTR
WRDOFF DW 0 ;OFFSET INTO WORD TABLE FOR CURRENT SET
;PUTCHR
CHRPTR DW 0 ;POINTS TO NEXT CHARACTER POSITION
ENDBUF DW 0 ;POINTS JUST PAST END OF OUTPUT BUFFER (0)
;GETNUM
STATUS DW 0 ;STATUS-LINE-REQUESTED FLAG
;ZIPBGN
IRBRKS DB ' ',9,13,12,'.,?',0 ;INITIAL SET OF READ BREAK CHARS
MEMTOP DW 0 ;LAST AVAILABLE LOCATION
ZORKID DW 0 ;UNIQUE GAME & VERSION IDENTIFIER
ENDLOD DW 0 ;ENDLOD BLOCK NUMBER
VOCTAB DW 0 ;SAVE VOCABULARY TABLE POINTER
OBJTAB DW 0 ;OBJECT TABLE POINTER
GLOTAB DW 0 ;GLOBAL TABLE POINTER
WRDTAB DW 0 ;WORD TABLE POINTER
PURBOT DW 0 ;PURE CODE POINTER
ESIBKS DW 0 ;END OF SELF-INSERTING BREAK CHARACTERS
VWLEN DW 0 ;NUMBER OF BYTES IN A VOCABULARY WORD ENTRY
VWORDS DW 0 ;NUMBER OF WORD ENTRIES IN VOCABULARY
VOCBEG DW 0 ;BEGINNING OF ACTUAL VOCABULARY
OUTBUF RB 81 ;OUTPUT BUFFER
INBUF RB 150 ;INPUT BUFFER
RBRKS RB 32 ;STRING OF READ BREAK CHARACTERS
PAGTAB DB 254,0,0,0,254,0,0,0,254,0,0,0,254,0,0,0
DB 254,0,0,0,254,0,0,0,254,0,0,0,254,0,0,0
DB 254,0,0,0,254,0,0,0,254,0,0,0,254,0,0,0
DB 254,0,0,0,254,0,0,0,254,0,0,0,254,0,0,0
DB 254,0,0,0,254,0,0,0,254,0,0,0,254,0,0,0
DB 254,0,0,0,254,0,0,0,254,0,0,0,254,0,0,0
DB 254,0,0,0,254,0,0,0,254,0,0,0,254,0,0,0
DB 254,0,0,0,254,0,0,0,254,0,0,0,254,0,0,0
DB 254,0,0,0,254,0,0,0,254,0,0,0,254,0,0,0
DB 254,0,0,0,254,0,0,0,254,0,0,0,254,0,0,0
DB 254,0,0,0,254,0,0,0,254,0,0,0,254,0,0,0
DB 254,0,0,0,254,0,0,0,254,0,0,0,254,0,0,0
DB 254,0,0,0,254,0,0,0,254,0,0,0,254,0,0,0
DB 254,0,0,0,254,0,0,0,254,0,0,0,254,0,0,0
DB 254,0,0,0,254,0,0,0,254,0,0,0,254,0,0,0
DB 254,0,0,0,254,0,0,0,254,0,0,0,254,0,0,0
DB 255 ;END OF PAGE TABLE
PAGES DW 0 ;SWAPPING AREA
BUFPGS DW 0
CHRFLG DB 0
;RESTRT
ZLOCS DW 0 ;POINTER TO LOCALS
ZPC1 DW 0 ;ZPC BLOCK-POINTER
ZPC2 DW 0 ;ZPC BYTE-POINTER
ARGBLK RW 4 ;ARGUMENT BLOCK FOR EXTENDED OPERATIONS
;NEWZPC
CURPAG DW 0 ;CURRENT PAGE (WHERE ZPC IS) POINTER
CURBLK DW 0 ;CURRENT BLOCK, USUALLY SAME AS ZPC1
CURTAB DW 0 ;CURRENT PAGE TABLE POINTER +1
;GETPAG
RTIME1 DB 0 ;REFERENCE TIME, 1 1/2 WORDS USED
RTIME2 DW 0
LPAGE DW 0 ;LAST REFERENCED PAGE NUMBER
LPLOC DW 0 ;AND ITS CORE LOCATION
LPTAB DW 0 ;AND ITS TABLE POINTER
;OPERATION TABLES:
;ZERO ARGUMENT OPERATIONS
ZEROOP DW OPRTRU ;176
DW OPRFAL ;177
DW OPPRNI ;178
DW OPPRNR ;179
DW OPNOOP ;180
DW OPSAVE ;181
DW OPREST ;182
DW OPRSTT ;183
DW OPRSTA ;184
DW OPFSTA ;185
DW OPQUIT ;186
DW OPCRLF ;187
DW OPUSL ;188
DW OPVERI ;189
DW 0 ;190
DW 0 ;191
;ONE ARGUMENT OPERATIONS
ONEOP DW OPQZER ;128
DW OPQNEX ;129
DW OPQFIR ;130
DW OPLOC ;131
DW OPPTSI ;132
DW OPINC ;133
DW OPDEC ;134
DW OPPRNB ;135
DW 0 ;136
DW OPREMO ;137
DW OPPRND ;138
DW OPRETU ;139
DW OPJUMP ;140
DW OPPRIN ;141
DW OPVALU ;142
DW OPBCOM ;143
;TWO ARGUMENT AND EXTENDED ARGUMENT OPERATIONS
EXTOP DW 0 ;0
DW OPQEQU ;1
DW OPQLES ;2
DW OPQGRT ;3
DW OPQDLE ;4
DW OPQIGR ;5
DW OPQIN ;6
DW OPBTST ;7
DW OPBOR ;8
DW OPBAND ;9
DW OPQFSE ;10
DW OPFSET ;11
DW OPFCLE ;12
DW OPSET ;13
DW OPMOVE ;14
DW OPGET ;15
DW OPGETB ;16
DW OPGETP ;17
DW OPGTPT ;18
DW OPNEXT ;19
DW OPADD ;20
DW OPSUB ;21
DW OPMUL ;22
DW OPDIV ;23
DW OPMOD ;24
DW 0 ;25
DW 0 ;26
DW 0 ;27
DW 0 ;28
DW 0 ;29
DW 0 ;30
DW 0 ;31
DW OPCALL ;224
DW OPPUT ;225
DW OPPUTB ;226
DW OPPUTP ;227
DW OPREAD ;228
DW OPPRNC ;229
DW OPPRNN ;230
DW OPRAND ;231
DW OPPUSH ;232
DW OPPOP ;233
DW 0 ;234
DW 0 ;235
DW 0 ;236
DW 0 ;237
DW 0 ;238
DW 0 ;239
DW 0 ;240
DW 0 ;241
DW 0 ;242
DW 0 ;243
DW 0 ;244
DW 0 ;245
DW 0 ;246
DW 0 ;247
DW 0 ;248
DW 0 ;249
DW 0 ;250
DW 0 ;251
DW 0 ;252
DW 0 ;253
DW 0 ;254
DW 0 ;255
;.CRLF
MORE DB '**MORE** ',80H
EMORE DB 13,' ',13,80H
MORLIN DB 0
;.GETTM
TIMBLK RB 8 ;WHERE TIME PARAMETERS GO
;VERIFY
INTVER DB 'DEC Rainbow 100 Interpreter Version C',0
;SAVE/RESTORE STUFF
SAV1 DB 'File name (default is ',80H
SAV2 DB '): ',80H
SAV3 DB 'Replace game disk then hit RETURN to continue.',80H
;STRING DEFINITIONS
;RESTORE
ERR1 DB 'SAVE file not found',0
ERR3 DB 'Bad file name syntax',0
ERR4 DB 'No room in directory for SAVE file',0
ERR5 DB 'No room on disk for SAVE file',0
ERR6 DB 'Read of SAVE file failed',0
;READ
ERR2 DB 'Too many words typed, flushing: ',80H
;OPNEXT/OPPUTP
FTL2 DB 'No such property',0
;ZIPBGN
FTL4 DB 'Wrong game or version',0
;NXTINS
FTL5 DB 'Illegal operation',0
;FINDPG
FTL6 DB 'No free pages',0
;GTBLKS
FTL7 DB 'Game file read error',0
;SYSINI
FTL9 DB 'Game file not found',0
;START
FTL10 DB 'Not enough memory',0
;Fatal error header
FATHDR DB 'Fatal error: ',80H
;STATUS LINE STUFF
PMFLAG DB 0 ;AM/PM
TIMEMD DB 0 ;TIME MODE FLAG
SLSTR DW 0 ;STATUS LINE HEADER STRING
SLTAB DW 0 ;STATUS LINE TABLE USED BY OPUSL
SLSTAB DW SLS80
DW SLS80T
DW SLT80
DW SLT80T
;RULE HERE:
; 1111111111222222222233333333334444444444555555555566666666667777777
;1234567890123456789012345678901234567890123456789012345678901234567890123456
SLS80 DB ' Score: Moves: '
SLS80T DW -1
DW OPPRND
DW 1
DW 24
DW -1
DW OPPRNN
DW 57
DW 60
DW -1
DW OPPRNN
DW 72
DW 79
;RULE HERE:
; 1111111111222222222233333333334444444444555555555566666666667777777
;1234567890123456789012345678901234567890123456789012345678901234567890123456
SLT80 DB ' Time: '
SLT80T DW -1
DW OPPRND
DW 1
DW 24
DW -1
DW OPPRNH
DW 63
DW 65
DW -1
DW OPPRNM
DW 66
DW 79
;ZSTR CHARACTER CONVERSION VECTOR
ZCHRS DB 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ'
DB ' 0123456789.,!?_#''' ;THIS SHOULD BE QUOTE
DB '"/\-:()'
MBSTT DW 0
MBLEN DW 0FFFFH
MBMOR DB 0
SSEG
ORG 100H
RW 100H
STK_TOP:
STKBOT RW LSTACK
ZSTK_TP:
DB 0
END
Reference in New Issue View Git Blame Copy Permalink