mirror of
https://github.com/erkyrath/infocom-zcode-terps.git
synced 2026-01-11 23:43:24 +00:00
2807 lines
76 KiB
Plaintext
2807 lines
76 KiB
Plaintext
.TITLE ZIP Z-language Interpreter Program
|
||
|
||
.IDENT /ZIP.15/
|
||
ZMVERS= 3 ;Z-MACHINE VERSION NUMBER
|
||
.ENABL LC
|
||
|
||
|
||
; Proprietary documentation of:
|
||
;
|
||
; Infocom, Inc.
|
||
; 55 Wheeler St.
|
||
; Cambridge, MA 02138
|
||
;
|
||
; Copyright (C) 1982, 1983 Infocom, Inc. All rights reserved.
|
||
;
|
||
;This listing is furnished for a specific purpose under an
|
||
;agreement that it will not be copied in any form or made
|
||
;available to any other party. Neither will the information
|
||
;contained herein be disclosed. When the purpose for which
|
||
;this listing has been furnished is completed, the listing
|
||
;will be returned to Infocom. This listing will at all times
|
||
;remain the property of Infocom.
|
||
.SBTTL DEFINE PROGRAM SECTIONS AND ATTRIBUTES
|
||
|
||
.PSECT PARAM,D ;PARAMETERS, MUST BE FIRST
|
||
.PSECT DATA,D ;MOST MODIFIABLE DATA
|
||
.PSECT STRING,RO,D ;STRING SPACE, READ ONLY
|
||
.PSECT CODE,RO ;INSTRUCTIONS, READ ONLY
|
||
.PSECT BUFFER,D ;EXPANDABLE DATA AREA AT END OF PROGRAM
|
||
.SBTTL PROGRAMMING CONVENTIONS
|
||
|
||
|
||
;PROGRAM SECTIONS:
|
||
; CODE READ ONLY, CONTAINS ALL CODE AND SOME CONSTANT DATA
|
||
; DATA CONTAINS MOST DATA INCLUDING EVERYTHING MODIFIABLE
|
||
; STRING CONTAINS STRING DATA, MOSTLY FROM STRING MACROS
|
||
; BUFFER POINTS TO DYNAMICALLY ALLOCATED MEMORY ABOVE PROGRAM
|
||
; PARAM SET UP PARAMETERS PATCHED IN BY USER (HOPEFULLY)
|
||
|
||
;EACH SUBROUTINE IS OFFSET FROM THE NEXT BY A BLANK LINE. EACH BEGINS
|
||
;WITH A SHORT DESCRIPTION INCLUDING REGISTERS USED - BOTH ARGUMENTS
|
||
;AND RETURNED VALUES.
|
||
|
||
;GENERALLY, A SINGLE ARGUMENT IS PASSED IN R0. A SINGLE VALUE WILL
|
||
;LIKEWISE BE RETURNED IN R0. IN ANY CASE, R0 IS A SCRATCH REGISTER
|
||
;AND NEED NOT BE PRESERVED. ALL OTHER REGISTERS, EXCEPT WHERE OTHER-
|
||
;WISE SPECIFIED, MUST BE PRESERVED ACROSS EACH SUBROUTINE CALL. NOTE
|
||
;THAT TOP-LEVEL ROUTINES, OPx ROUTINES, ARE EXCLUDED FROM THIS
|
||
;RESTRICTION.
|
||
|
||
;SUBROUTINES ARE NORMALLY CALLED VIA JSR PC. THOSE THAT SKIP RETURN
|
||
;OR TAKE FOLLOWING ARGUMENTS, AS SPECIFIED IN THE INDIVIDUAL DESCRIPTION,
|
||
;ARE CALLED VIA JSR R5. SINCE R5 IS ALSO USED AS THE ZSTACK-POINTER,
|
||
;SUCH SUBROUTINES CANNOT USE THE ZSTACK.
|
||
.SBTTL CONFIGURATION FLAGS
|
||
|
||
|
||
SOBINS= 0 ;HAS NO HARDWARE SOB
|
||
EIS= 0 ;HAS NO HARDWARE EIS
|
||
NEW11= 0 ;HAS NO SXT, XOR, MARK, RTT, SOB, OR EIS
|
||
RT11= 1 ;USE RT-11 MONITOR CALLS
|
||
.SBTTL GENERAL MACROS
|
||
|
||
|
||
;PUSH REGISTERS ONTO STACK
|
||
.MACRO SAVE REGS
|
||
.IRPC REGNUM,REGS
|
||
MOV R'REGNUM,-(SP)
|
||
.ENDM
|
||
.ENDM SAVE
|
||
|
||
;POP REGISTERS FROM STACK
|
||
.MACRO RESTOR REGS
|
||
.IRPC REGNUM,REGS
|
||
MOV (SP)+,R'REGNUM
|
||
.ENDM
|
||
.ENDM RESTOR
|
||
|
||
;PRINT A STRING STORED IN STRING AREA AND THEN DIE
|
||
.MACRO FATAL STR
|
||
.PSECT STRING
|
||
$$$=.
|
||
.ASCIZ \STR\
|
||
.PSECT CODE
|
||
JSR R5,FATALR
|
||
.WORD $$$
|
||
.ENDM FATAL
|
||
|
||
;PRINT A STRING STORED IN STRING AREA WITH INFORMATIONAL HEADER
|
||
.MACRO INFORM STR
|
||
.PSECT STRING
|
||
$$$=.
|
||
.ASCIZ \STR\
|
||
.PSECT CODE
|
||
JSR R5,INFRMR
|
||
.WORD $$$
|
||
.ENDM INFORM
|
||
|
||
;PRINT A STRING STORED IN STRING AREA WITH NO NEWLINE
|
||
.MACRO PRIN1 STR
|
||
.PSECT STRING
|
||
$$$=.
|
||
.ASCII \STR\<200>
|
||
.PSECT CODE
|
||
MOV #$$$,R0
|
||
JSR PC,OUTSTR
|
||
.ENDM PRIN1
|
||
|
||
;DEFINE A VARIABLE IN DATA SECTION
|
||
.MACRO DEFVAR NAM,VAL
|
||
.PSECT DATA
|
||
.IF NB ^\VAL\
|
||
NAM:: VAL
|
||
.IFF
|
||
NAM:: 0
|
||
.ENDC
|
||
.PSECT CODE
|
||
.ENDM DEFVAR
|
||
|
||
|
||
;IF NO NEW 11 INSTRUCTIONS, REPLACE WITH OTHER INSTRUCTIONS
|
||
.IF EQ NEW11
|
||
|
||
SOBINS= 0 ;CAN'T HAVE THESE, EITHER
|
||
EIS= 0
|
||
|
||
;SIGN EXTEND
|
||
.MACRO SXT ARG,?NEGLOC,?ENDLOC
|
||
BMI NEGLOC ;WAS OTHER WORD NEGATIVE?
|
||
CLR ARG ;NO, MAKE THIS WORD ZERO (NON-NEGATIVE),
|
||
BR ENDLOC ;& SKIP TO END
|
||
NEGLOC: MOV #-1,ARG ;YES, MAKE THIS WORD ALL ONES (NEGATIVE)
|
||
ENDLOC:
|
||
.ENDM SXT
|
||
|
||
;EXCLUSIVE OR
|
||
.MACRO XOR REG,ARG
|
||
.ERROR ;XOR NOT IMPLEMENTED
|
||
.ENDM XOR
|
||
|
||
;MARK STACK
|
||
.MACRO MARK LOC
|
||
.ERROR ;MARK NOT IMPLEMENTED
|
||
.ENDM MARK
|
||
|
||
;RETURN FROM TRAP WITH T-BIT TRAP INHIBITED
|
||
.MACRO RTT
|
||
.ERROR ;RTT NOT IMPLEMENTED
|
||
.ENDM RTT
|
||
|
||
.ENDC
|
||
|
||
|
||
;IF NO SOB, REPLACE WITH OTHER INSTRUCTIONS
|
||
.IF EQ SOBINS
|
||
.MACRO SOB REG,LOC
|
||
DEC REG
|
||
BNE LOC
|
||
.ENDM SOB
|
||
.ENDC
|
||
|
||
|
||
;IF NO EIS INSTRUCTIONS, REPLACE WITH SIMULATION ROUTINES
|
||
.IF EQ EIS
|
||
|
||
;ARITHMETIC SHIFT (SINGLE WORD)
|
||
.MACRO ASH NUM,REG
|
||
MOV REG,-(SP)
|
||
MOV NUM,-(SP)
|
||
JSR PC,ASHSIM
|
||
MOV (SP)+,REG
|
||
.ENDM ASH
|
||
|
||
;ARITHMETIC SHIFT (DOUBLE WORD)
|
||
.MACRO ASHC NUM,REG
|
||
.ERROR ;ASHC NOT IMPLEMENTED
|
||
.ENDM ASHC
|
||
|
||
;MULTIPLY (SINGLE WORD ONLY)
|
||
.MACRO MUL NUM,REG
|
||
.IF DIF REG,R1
|
||
.IF DIF REG,R3
|
||
.IF DIF REG,R5
|
||
.ERROR ;DOUBLE WORD MULTIPLY NOT IMPLEMENTED
|
||
.ENDC
|
||
.ENDC
|
||
.ENDC
|
||
MOV REG,-(SP)
|
||
MOV NUM,-(SP)
|
||
JSR PC,MULSIM
|
||
MOV (SP)+,REG
|
||
.ENDM MUL
|
||
|
||
;DIVIDE (DOUBLE WORD)
|
||
.MACRO DIV NUM,REG
|
||
MOV REG,-(SP)
|
||
MOV REG+1,-(SP)
|
||
MOV NUM,-(SP)
|
||
JSR PC,DIVSIM
|
||
MOV (SP)+,REG+1
|
||
MOV (SP)+,REG
|
||
.ENDM DIV
|
||
|
||
.ENDC
|
||
.SBTTL ARITHMETIC OPERATIONS
|
||
|
||
.PSECT CODE
|
||
|
||
|
||
;ADD
|
||
OPADD:: ADD R1,R0 ;ADD OPR1 AND OPR2
|
||
JMP PUTVAL ;RETURN THE VALUE
|
||
|
||
;SUB
|
||
OPSUB:: SUB R1,R0 ;SUBTRACT OPR2 FROM OPR1
|
||
JMP PUTVAL ;RETURN THE VALUE
|
||
|
||
;MUL
|
||
OPMUL:: MUL R0,R1 ;MULTIPLY OPR1 BY OPR2
|
||
MOV R1,R0 ;IGNORING OVERFLOW
|
||
JMP PUTVAL ;RETURN THE VALUE
|
||
|
||
;DIV
|
||
OPDIV:: MOV R1,R2 ;REARRANGE OPERANDS FOR DIVIDE
|
||
MOV R0,R1
|
||
SXT R0
|
||
DIV R2,R0 ;DIVIDE OPR1 BY OPR2
|
||
JMP PUTVAL ;RETURN THE VALUE
|
||
|
||
;MOD
|
||
OPMOD:: MOV R1,R2 ;REARRANGE OPERANDS FOR DIVIDE
|
||
MOV R0,R1
|
||
SXT R0
|
||
DIV R2,R0 ;DIVIDE OPR1 BY OPR2
|
||
MOV R1,R0 ;WE WANT REMAINDER
|
||
JMP PUTVAL ;RETURN THE VALUE
|
||
|
||
;RANDOM
|
||
DEFVAR RSEED ;SEED FOR RANDOM NUMBERS
|
||
OPRAND::MOV RSEED,R1 ;GET THE SEED
|
||
MUL #257.,R1 ;TRANSFORM IT
|
||
ADD #13,R1
|
||
MOV R0,R2
|
||
MOV R1,RSEED ;SAVE NEW VALUE
|
||
CLR R0 ;TRIM IT TO PROPER SIZE
|
||
BIC #100000,R1 ;CLEAR BIT TO PREVENT POSSIBLE OVERFLOW
|
||
DIV R2,R0
|
||
MOV R1,R0
|
||
INC R0 ;MUST BE BETWEEN 1 AND N, INCLUSIVE
|
||
JMP PUTVAL ;RETURN THE VALUE
|
||
|
||
;LESS?
|
||
OPQLES::CMP R0,R1 ;IS OPR1 LESS THAN OPR2?
|
||
BLT JPT ;YES, PREDICATE TRUE
|
||
JPF: JMP PFALSE ;NO, PREDICATE FALSE
|
||
JPT: JMP PTRUE
|
||
|
||
|
||
;GRTR?
|
||
OPQGRT::CMP R0,R1 ;IS OPR1 GREATER THAN OPR2?
|
||
BGT JPT ;YES, PREDICATE TRUE
|
||
BR JPF ;NO, PREDICATE FALSE
|
||
.SBTTL LOGICAL OPERATIONS
|
||
|
||
|
||
;BTST
|
||
OPBTST::BIC R0,R1 ;TURN OFF ALL BITS IN OPR2 THAT ARE ON IN OPR1
|
||
BEQ JPT ;SUCCESS IF OPR2 COMPLETELY CLEARED
|
||
BR JPF
|
||
|
||
;BOR
|
||
OPBOR:: BIS R1,R0 ;LOGICAL OR
|
||
JMP PUTVAL ;RETURN THE VALUE
|
||
|
||
;BCOM
|
||
OPBCOM::COM R0 ;LOGICAL COMPLEMENT
|
||
JMP PUTVAL ;RETURN THE VALUE
|
||
|
||
;BAND
|
||
OPBAND::COM R1 ;LOGICAL AND
|
||
BIC R1,R0
|
||
JMP PUTVAL ;RETURN THE VALUE
|
||
.SBTTL GENERAL PREDICATES
|
||
|
||
|
||
;EQUAL?
|
||
OPQEQU::NOP ;TELL CALLER TO USE ARGUMENT BLOCK
|
||
CMP 2(R0),4(R0) ;IS OPR1 EQUAL TO OPR2?
|
||
BEQ 1$ ;YES
|
||
CMP (R0),#3 ;NO, IS THERE A THIRD OPERAND?
|
||
BLT 2$ ;NO
|
||
CMP 2(R0),6(R0) ;YES, IS IT EQUAL TO OPR1?
|
||
BEQ 1$ ;YES
|
||
CMP (R0),#4 ;NO, IS THERE A FOURTH?
|
||
BLT 2$ ;NO
|
||
CMP 2(R0),10(R0) ;YES, IS IT EQUAL TO OPR1?
|
||
BNE 2$ ;NO
|
||
1$: JMP PTRUE ;PREDICATE TRUE IF EQUAL
|
||
2$: JMP PFALSE ;PREDICATE FALSE IF NOT
|
||
|
||
;ZERO?
|
||
OPQZER::TST R0 ;IS OPR ZERO?
|
||
BNE 1$ ;NO, PREDICATE FALSE
|
||
JMP PTRUE ;YES, PREDICATE TRUE
|
||
1$: JMP PFALSE
|
||
.SBTTL OBJECT OPERATIONS
|
||
|
||
|
||
;MOVE (OBJ1 INTO OBJ2)
|
||
OPMOVE::SAVE 01 ;PROTECT OPRS FROM REMOVE CALL
|
||
JSR PC,OPREMO ;REMOVE OBJ1 FROM WHEREVER IT IS
|
||
MOV (SP),R0 ;OBJ2
|
||
JSR PC,OBJLOC ;FIND ITS LOCATION
|
||
MOV R0,R2 ;SAVE FOR LATER
|
||
MOV 2(SP),R0 ;OBJ1
|
||
JSR PC,OBJLOC ;FIND ITS LOCATION
|
||
RESTOR 1 ;OBJ2
|
||
MOVB R1,4(R0) ;PUT OBJ2 INTO OBJ1'S LOC SLOT
|
||
MOVB 6(R2),R3 ;GET CONTENTS OF OBJ2'S FIRST SLOT
|
||
RESTOR 1 ;OBJ1
|
||
MOVB R1,6(R2) ;MAKE OBJ1 FIRST CONTENT OF OBJ2
|
||
TST R3 ;WERE THERE ANY OTHER CONTENTS?
|
||
BEQ 1$ ;NO
|
||
MOVB R3,5(R0) ;YES, CHAIN ONTO OBJ1'S SIBLING SLOT
|
||
1$: RTS PC
|
||
|
||
;REMOVE (OBJ FROM ITS PARENT)
|
||
OPREMO::MOV R0,R2 ;SAVE OBJ FOR LATER
|
||
JSR PC,OBJLOC ;FIND ITS LOCATION
|
||
MOV R0,R1 ;SAVE THAT
|
||
MOVB 4(R1),R0 ;GET ITS PARENT
|
||
BEQ 3$ ;IF NO PARENT, WE'RE DONE
|
||
JSR PC,OBJLOC ;FIND PARENT'S LOCATION
|
||
MOVB 6(R0),R3 ;GET PARENT'S FIRST CONTENT
|
||
CMPB R3,R2 ;IS IT OBJ?
|
||
BNE 1$ ;NO
|
||
MOVB 5(R1),6(R0) ;YES, CHANGE SLOT TO OBJ'S SIBLING
|
||
BR 2$ ;AND RETURN
|
||
1$: MOV R3,R0 ;CURRENT SIBLING
|
||
JSR PC,OBJLOC ;FIND ITS LOCATION
|
||
MOVB 5(R0),R3 ;GET NEXT SIBLING IN CHAIN
|
||
CMPB R3,R2 ;IS IT OBJ?
|
||
BNE 1$ ;NO, CONTINUE LOOP
|
||
MOVB 5(R1),5(R0) ;YES, CHANGE IT TO OBJ'S SIBLING
|
||
2$: CLRB 4(R1) ;OBJ NOW HAS NO PARENT
|
||
CLRB 5(R1) ;OR SIBLING
|
||
3$: RTS PC
|
||
|
||
;FSET? (IS FLAG SET IN OBJ?)
|
||
OPQFSE::JSR PC,OBJLOC ;FIND OBJ'S LOCATION
|
||
CMP R1,#20 ;SECOND WORD FLAG?
|
||
BLT 1$ ;NO
|
||
SUB #20,R1 ;YES, SUBTRACT 16 FROM FLAG NUMBER
|
||
ADD #2,R0 ;AND USE SECOND FLAG WORD
|
||
1$: JSR PC,GTAWRD ;GET THE FLAG WORD
|
||
SUB #17,R1 ;SHIFT A BIT TO PROPER POSITION
|
||
NEG R1
|
||
MOV #1,R2
|
||
ASH R1,R2
|
||
BIT R2,R0 ;IS THIS BIT SET IN FLAG WORD?
|
||
BEQ 2$ ;NO, PREDICATE FALSE
|
||
JMP PTRUE ;YES, PREDICATE TRUE
|
||
2$: JMP PFALSE
|
||
|
||
;FSET (SET A FLAG IN OBJ)
|
||
OPFSET::JSR PC,OBJLOC ;FIND OBJ'S LOCATION
|
||
CMP R1,#20 ;SECOND WORD FLAG?
|
||
BLT 1$ ;NO
|
||
SUB #20,R1 ;YES, SUBTRACT 16 FROM FLAG NUMBER
|
||
ADD #2,R0 ;AND USE SECOND FLAG WORD
|
||
1$: MOV R0,R3 ;REMEMBER THIS LOCATION
|
||
JSR PC,GTAWRD ;GET THE FLAG WORD
|
||
SUB #17,R1 ;SHIFT A BIT TO PROPER POSITION
|
||
NEG R1
|
||
MOV #1,R2
|
||
ASH R1,R2
|
||
BIS R2,R0 ;SET THIS BIT IN FLAG WORD
|
||
MOV R0,R1
|
||
MOV R3,R0
|
||
JMP PTAWRD ;STORE THE NEW FLAG WORD
|
||
|
||
;FCLEAR (CLEAR A FLAG IN OBJ)
|
||
OPFCLE::JSR PC,OBJLOC ;FIND OBJ'S LOCATION
|
||
CMP R1,#20 ;SECOND WORD FLAG?
|
||
BLT 1$ ;NO
|
||
SUB #20,R1 ;YES, SUBTRACT 16 FROM FLAG NUMBER
|
||
ADD #2,R0 ;AND USE SECOND FLAG WORD
|
||
1$: MOV R0,R3 ;REMEMBER THIS LOCATION
|
||
JSR PC,GTAWRD ;GET THE FLAG WORD
|
||
SUB #17,R1 ;SHIFT A BIT TO PROPER POSITION
|
||
NEG R1
|
||
MOV #1,R2
|
||
ASH R1,R2
|
||
BIC R2,R0 ;CLEAR THIS BIT IN FLAG WORD
|
||
MOV R0,R1
|
||
MOV R3,R0
|
||
JMP PTAWRD ;STORE THE NEW FLAG WORD
|
||
|
||
;LOC (RETURN CONTAINER OF OBJ)
|
||
OPLOC:: JSR PC,OBJLOC ;FIND OBJ'S LOCATION
|
||
MOVB 4(R0),R0 ;GET LOC SLOT
|
||
JMP BYTVAL ;RETURN THE BYTE VALUE
|
||
|
||
;FIRST? (RETURN FIRST SLOT OF OBJ, FAIL IF NONE)
|
||
OPQFIR::JSR PC,OBJLOC ;FIND OBJ'S LOCATION
|
||
MOVB 6(R0),R0 ;GET FIRST SLOT
|
||
SAVE 0
|
||
JSR PC,BYTVAL ;RETURN THE BYTE VALUE
|
||
RESTOR 0 ;WAS IT ZERO?
|
||
BEQ 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::JSR PC,OBJLOC ;FIND OBJ'S LOCATION
|
||
MOVB 5(R0),R0 ;GET SIBLING SLOT
|
||
SAVE 0
|
||
JSR PC,BYTVAL ;RETURN THE BYTE VALUE
|
||
RESTOR 0 ;WAS IT ZERO?
|
||
BEQ JPF1 ;YES, PREDICATE FALSE
|
||
BR JPT1 ;NO, PREDICATE TRUE
|
||
|
||
;IN? (IS OBJ1 CONTAINED IN OBJ2?)
|
||
OPQIN:: JSR PC,OBJLOC ;FIND OBJ1'S LOCATION
|
||
CMPB 4(R0),R1 ;IS OBJ1'S PARENT OBJ2?
|
||
BEQ JPT1 ;YES, PREDICATE TRUE
|
||
BR JPF1 ;NO, PREDICATE FALSE
|
||
|
||
;GETP (GET SPECIFIED PROPERTY OF OBJ, DEFAULT IF NONE)
|
||
OPGETP::JSR PC,OBJLOC ;FIND OBJ'S LOCATION
|
||
ADD #7,R0 ;POINT TO PROPERTY TABLE SLOT
|
||
JSR PC,GTAWRD ;GET ITS LOCATION
|
||
ADD #BUFFER,R0 ;ABSOLUTIZE IT
|
||
MOVB (R0),R2 ;LENGTH OF SHORT DESCRIPTION IN WORDS
|
||
BIC #^C377,R2 ;CLEAN OFF ANY HIGH-ORDER BYTE
|
||
ASL R2 ;CONVERT TO BYTES
|
||
ADD R2,R0 ;ADJUST POINTER TO SKIP IT
|
||
INC R0 ;ALSO SKIP LENGTH BYTE
|
||
BR 2$ ;SKIP NEXT LINE FIRST TIME THROUGH LOOP
|
||
1$: JSR PC,NXTPRP ;POINT TO NEXT PROPERTY
|
||
2$: MOVB (R0),R2 ;GET PROPERTY IDENTIFIER
|
||
BIC #^C37,R2 ;CLEAN OFF LENGTH BITS
|
||
CMP R2,R1 ;COMPARE PROPERTY NUMBER WITH DESIRED ONE
|
||
BGT 1$ ;IF GREATER, LOOP (TABLE SORTED IN REVERSE)
|
||
BLT 3$ ;IF LESS, NO SUCH PROPERTY HERE
|
||
MOVB (R0),R2 ;GOT IT, NOW FIND LENGTH OF PROPERTY
|
||
INC R0 ;POINT TO PROPERTY VALUE
|
||
ASH #-5,R2 ;GET LENGTH BITS
|
||
BIC #^C7,R2
|
||
BNE 4$ ;ZERO MEANS BYTE VALUE
|
||
MOVB (R0),R0 ;GET THE BYTE
|
||
JMP BYTVAL ;AND RETURN IT
|
||
3$: DEC R1 ;POINT INTO DEFAULT PROPERTY TABLE
|
||
ASL R1
|
||
ADD OBJTAB,R1
|
||
MOV R1,R0
|
||
4$: JSR PC,GTAWRD ;GET THE WORD
|
||
JMP PUTVAL ;AND RETURN IT
|
||
|
||
;PUTP (CHANGE VALUE OF A PROPERTY, ERROR IF BAD NUMBER)
|
||
.ENABL LSB
|
||
OPPUTP::JSR PC,OBJLOC ;FIND OBJ'S LOCATION
|
||
ADD #7,R0 ;POINT TO PROPERTY TABLE SLOT
|
||
JSR PC,GTAWRD ;GET ITS LOCATION
|
||
ADD #BUFFER,R0 ;ABSOLUTIZE IT
|
||
MOVB (R0),R3 ;LENGTH OF SHORT DESCRIPTION IN WORDS
|
||
BIC #^C377,R3 ;CLEAN OFF ANY HIGH-ORDER BYTE
|
||
ASL R3 ;CONVERT TO BYTES
|
||
ADD R3,R0 ;ADJUST POINTER TO SKIP IT
|
||
INC R0 ;ALSO SKIP LENGTH BYTE
|
||
BR 2$ ;SKIP NEXT LINE FIRST TIME THROUGH LOOP
|
||
1$: JSR PC,NXTPRP ;POINT TO NEXT PROPERTY
|
||
2$: MOVB (R0),R3 ;GET PROPERTY IDENTIFIER
|
||
BIC #^C37,R3 ;CLEAN OFF LENGTH BITS
|
||
CMP R3,R1 ;COMPARE PROPERTY NUMBER WITH DESIRED ONE
|
||
BEQ 3$ ;IF EQUAL, GOT IT
|
||
BGT 1$ ;IF GREATER, LOOP (TABLE SORTED IN REVERSE)
|
||
FATAL <No such property> ;OTHERWISE, FATAL ERROR
|
||
3$: MOVB (R0),R3 ;NOW FIND LENGTH OF PROPERTY
|
||
INC R0 ;POINT TO PROPERTY VALUE
|
||
ASH #-5,R3 ;GET LENGTH BITS
|
||
BIC #^C7,R3
|
||
BNE 4$ ;ZERO MEANS BYTE VALUE
|
||
MOVB R2,(R0) ;STORE THE NEW BYTE
|
||
RTS PC ;AND RETURN
|
||
4$: MOV R2,R1 ;STORE THE NEW WORD VALUE
|
||
JMP PTAWRD
|
||
.DSABL LSB
|
||
|
||
;NEXTP (RETURN NUMBER OF NEXT PROP FOLLOWING GIVEN PROB IN OBJ)
|
||
.ENABL LSB
|
||
OPNEXT::JSR PC,OBJLOC ;FIND OBJ'S LOCATION
|
||
ADD #7,R0 ;POINT TO PROPERTY TABLE SLOT
|
||
JSR PC,GTAWRD ;GET ITS LOCATION
|
||
ADD #BUFFER,R0 ;ABSOLUTIZE IT
|
||
MOVB (R0),R3 ;LENGTH OF SHORT DESCRIPTION IN WORDS
|
||
BIC #^C377,R3 ;CLEAN OFF ANY HIGH-ORDER BYTE
|
||
ASL R3 ;CONVERT TO BYTES
|
||
ADD R3,R0 ;ADJUST POINTER TO SKIP IT
|
||
INC R0 ;ALSO SKIP LENGTH BYTE
|
||
TST R1 ;WERE WE GIVEN ZERO AS PROP?
|
||
BEQ 4$ ;YES, GO RETURN FIRST PROPERTY NUMBER
|
||
BR 2$ ;NO, SKIP NEXT LINE FIRST TIME THROUGH LOOP
|
||
1$: JSR PC,NXTPRP ;POINT TO NEXT PROPERTY
|
||
2$: MOVB (R0),R3 ;GET PROPERTY IDENTIFIER
|
||
BIC #^C37,R3 ;CLEAN OFF LENGTH BITS
|
||
CMP R3,R1 ;COMPARE PROPERTY NUMBER WITH DESIRED ONE
|
||
BEQ 3$ ;IF EQUAL, GOT IT
|
||
BGT 1$ ;IF GREATER, LOOP (TABLE SORTED IN REVERSE)
|
||
FATAL <No such property> ;OTHERWISE, FATAL ERROR
|
||
3$: JSR PC,NXTPRP ;POINT TO NEXT PROPERTY
|
||
4$: MOVB (R0),R0 ;GET PROPERTY IDENTIFIER
|
||
BIC #^C37,R0 ;EXTRACT PROPERTY NUMBER
|
||
JMP PUTVAL ;AND RETURN IT
|
||
.DSABL LSB
|
||
.SBTTL TABLE OPERATIONS
|
||
|
||
|
||
;GET (GET THE ITEM'TH WORD FROM TABLE)
|
||
OPGET:: ASL R1 ;CONVERT ITEM TO BYTE COUNT
|
||
ADD R1,R0 ;INDEX INTO TABLE
|
||
JSR PC,BSPLTB ;SPLIT THE POINTER
|
||
JSR PC,GETWRD ;GET THE WORD
|
||
MOV R2,R0
|
||
JMP PUTVAL ;AND RETURN IT
|
||
|
||
;GETB (GET THE ITEM'TH BYTE FROM TABLE)
|
||
OPGETB::ADD R1,R0 ;INDEX INTO TABLE
|
||
JSR PC,BSPLTB ;SPLIT THE POINTER
|
||
JSR PC,GETBYT ;GET THE BYTE
|
||
MOV R2,R0
|
||
JMP BYTVAL ;AND RETURN IT
|
||
|
||
;PUT (REPLACE THE ITEM'TH WORD IN TABLE)
|
||
OPPUT:: ASL R1 ;CONVERT ITEM TO BYTE COUNT
|
||
ADD R1,R0 ;INDEX INTO TABLE
|
||
ADD #BUFFER,R0 ;ABSOLUTIZE POINTER
|
||
MOV R2,R1
|
||
JMP PTAWRD ;STORE THE WORD
|
||
|
||
;PUTB (REPLACE ITEM'TH BYTE IN TABLE)
|
||
OPPUTB::ADD R1,R0 ;INDEX INTO TABLE
|
||
MOVB R2,BUFFER(R0) ;STORE BYTE
|
||
RTS PC
|
||
|
||
;GETPT (GET POINTER TO PROPERTY TABLE FOR GIVEN PROP)
|
||
OPGTPT::JSR PC,OBJLOC ;FIND OBJ'S LOCATION
|
||
ADD #7,R0 ;POINT TO PROPERTY TABLE SLOT
|
||
JSR PC,GTAWRD ;GET ITS LOCATION
|
||
ADD #BUFFER,R0 ;ABSOLUTIZE IT
|
||
MOVB (R0),R2 ;LENGTH OF SHORT DESCRIPTION IN WORDS
|
||
BIC #^C377,R2 ;CLEAN OFF ANY HIGH-ORDER BYTE
|
||
ASL R2 ;CONVERT TO BYTES
|
||
ADD R2,R0 ;ADJUST POINTER TO SKIP IT
|
||
INC R0 ;ALSO SKIP LENGTH BYTE
|
||
BR 2$ ;SKIP NEXT LINE FIRST TIME THROUGH LOOP
|
||
1$: JSR PC,NXTPRP ;POINT TO NEXT PROPERTY
|
||
2$: MOVB (R0),R2 ;GET PROPERTY IDENTIFIER
|
||
BIC #^C37,R2 ;CLEAN OFF LENGTH BITS
|
||
CMP R2,R1 ;COMPARE PROPERTY NUMBER WITH DESIRED ONE
|
||
BGT 1$ ;IF GREATER, LOOP (TABLE SORTED IN REVERSE)
|
||
BEQ 3$ ;FOUND THE PROPERTY
|
||
CLR R0 ;RETURN ZERO FOR NO SUCH PROPERTY
|
||
BR 4$
|
||
3$: SUB #BUFFER-1,R0 ;POINT TO PROPERTY VALUE & RE-RELATIVIZE IT
|
||
4$: JMP PUTVAL ;AND RETURN IT
|
||
|
||
;PTSIZE (RETURN SIZE OF PROPERTY TABLE)
|
||
OPPTSI::MOVB BUFFER-1(R0),R0 ;GET PROPERTY IDENTIFIER
|
||
ASH #-5,R0 ;EXTRACT LENGTH BITS
|
||
BIC #^C7,R0
|
||
INC R0 ;ADJUST TO ACTUAL LENGTH
|
||
JMP PUTVAL ;RETURN IT
|
||
.SBTTL VARIABLE OPERATIONS
|
||
|
||
|
||
;VALUE (GET VALUE OF VAR)
|
||
OPVALU::JSR PC,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::MOV R0,-(R5) ;PUSH THE VALUE
|
||
RTS PC
|
||
|
||
;POP (A VALUE OFF THE STACK INTO VAR)
|
||
OPPOP:: MOV (R5)+,R1 ;POP A VALUE
|
||
JMP PUTVAR ;AND STORE IT
|
||
|
||
;INC (INCREMENT VAR)
|
||
OPINC:: SAVE 0
|
||
JSR PC,GETVAR ;GET VAR'S VALUE
|
||
INC R0 ;INCREMENT IT
|
||
OPINC1: MOV R0,R1
|
||
RESTOR 0
|
||
JSR PC,PUTVAR ;STORE NEW VALUE
|
||
RTS PC
|
||
|
||
;DEC (DECREMENT VAR)
|
||
OPDEC:: SAVE 0
|
||
JSR PC,GETVAR ;GET VAR'S VALUE
|
||
DEC R0 ;DECREMENT IT
|
||
BR OPINC1 ;STORE NEW VALUE
|
||
|
||
;IGRTR? (INCREMENT VAR & TEST IF GREATER THAN VAL)
|
||
OPQIGR::SAVE 0
|
||
JSR PC,GETVAR ;GET VAR'S VALUE
|
||
INC R0 ;INCREMENT IT
|
||
CLR R2 ;SET FLAG FALSE
|
||
CMP R0,R1 ;NEW VALUE GREATER THAN VAL?
|
||
BLE OPQIG1 ;NO
|
||
OPQIG0: INC R2 ;YES, CHANGE FLAG TO TRUE
|
||
OPQIG1: MOV R0,R1
|
||
RESTOR 0
|
||
JSR PC,PUTVAR ;STORE NEW VALUE
|
||
TST R2 ;TEST FLAG
|
||
BEQ 1$ ;FALSE, PREDICATE FALSE
|
||
JMP PTRUE ;ELSE, PREDICATE TRUE
|
||
1$: JMP PFALSE
|
||
|
||
;DLESS? (DECREMENT VAR & TEST IF LESS THAN VAL)
|
||
OPQDLE::SAVE 0
|
||
JSR PC,GETVAR ;GET VAR'S VALUE
|
||
DEC R0 ;DECREMENT IT
|
||
CLR R2 ;SET FLAG FALSE
|
||
CMP R0,R1 ;NEW VALUE LESS THAN VAL?
|
||
BGE OPQIG1 ;NO, PREDICATE FALSE
|
||
BR OPQIG0 ;YES, PREDICATE TRUE
|
||
.SBTTL I/O OPERATIONS
|
||
|
||
|
||
EOLCHR= 12 ;LINE-FEED IS END-OF-LINE CHARACTER
|
||
MOVVAR= 22 ;NUMBER-OF-MOVES GLOBAL
|
||
SCRVAR= 21 ;SCORE VARIABLE
|
||
RMVAR= 20 ;CURRENT ROOM VARIABLE
|
||
|
||
;USL (UPDATE STATUS LINE)
|
||
DEFVAR OLDCHS ;OLD NUMBER OF CHARACTERS PRINTED IN NUMBERS
|
||
DEFVAR OLDRM ;OLD ROOM
|
||
.ENABL LSB
|
||
OPUSL:: TST P$TERM ;STATUS LINE REQUESTED?
|
||
BNE 1$ ;YES
|
||
RTS PC ;NO, DO NOTHING
|
||
1$: CLR R3 ;COUNT NUMBER CHARACTERS HERE
|
||
MOV SAVPOS,R0 ;SAVE OLD POSITION & SET ATTRIBUTES
|
||
JSR PC,OUTSTR
|
||
TST TIMEMD ;IN TIME MODE?
|
||
BNE 2$ ;YES
|
||
MOV SCRPOS,R0 ;NO, MOVE TO SCORE POSITION
|
||
JSR PC,OUTSTR
|
||
MOV #SCRVAR,R0 ;GET SCORE
|
||
JSR PC,GETVAR
|
||
JSR PC,OUTNUM ;PRINT IT
|
||
ADD R0,R3
|
||
MOV #'/,R0 ;SEPARATOR
|
||
JSR PC,OUTCHR
|
||
MOV #MOVVAR,R0 ;GET NUMBER-OF-MOVES
|
||
JSR PC,GETVAR
|
||
JSR PC,OUTNUM ;PRINT NUMBER OF MOVES
|
||
ADD R0,R3
|
||
BR 6$
|
||
2$: MOV TIMPOS,R0 ;MOVE TO TIME POSITION
|
||
JSR PC,OUTSTR
|
||
MOV #SCRVAR,R0 ;GET HOUR
|
||
JSR PC,GETVAR
|
||
MOV #'a,R2 ;ASSUME AM
|
||
CMP R0,#12. ;PM?
|
||
BLT 4$ ;NO
|
||
BEQ 3$ ;YES, BUT 12PM IS SPECIAL
|
||
SUB #12.,R0 ;CONVERT TO 12-HOUR TIME
|
||
3$: MOV #'p,R2 ;MODIFY EARLIER ASSUMPTION
|
||
4$: TST R0 ;00 IS REALLY 12 AM
|
||
BNE 5$
|
||
MOV #12.,R0
|
||
5$: JSR PC,OUTNUM ;PRINT HOUR
|
||
ADD R0,R3
|
||
MOV #':,R0 ;SEPARATOR
|
||
JSR PC,OUTCHR
|
||
MOV #MOVVAR,R0 ;GET MINUTES
|
||
JSR PC,GETVAR
|
||
MOV R0,R1 ;OUTPUT MINUTES IN TWO DIGITS
|
||
CLR R0
|
||
DIV #10.,R0 ;SEPARATE DIGITS
|
||
ADD #'0,R0 ;PRINT FIRST ONE
|
||
JSR PC,OUTCHR
|
||
MOV R1,R0 ;PRINT OTHER DIGIT
|
||
ADD #'0,R0
|
||
JSR PC,OUTCHR
|
||
MOV #40,R0 ;SPACE
|
||
JSR PC,OUTCHR
|
||
MOV R2,R0 ;AM OR PM
|
||
JSR PC,OUTCHR
|
||
MOV #'m,R0
|
||
JSR PC,OUTCHR
|
||
6$: MOV #RMVAR,R0 ;GET CURRENT ROOM
|
||
JSR PC,GETVAR
|
||
CMP R0,OLDRM ;HAS IT CHANGED?
|
||
BNE 7$ ;YES
|
||
CMP R3,OLDCHS ;NO, BUT HAS SIZE OF NUMBERS CHANGED?
|
||
BNE 7$ ;YES
|
||
CMP P$TERM,#1 ;NO, BUT IS THIS A VT100?
|
||
BEQ 8$ ;OK, GIVE UP
|
||
7$: MOV R0,OLDRM ;SAVE NEW ROOM
|
||
MOV R3,OLDCHS ;AND NUMBER OF CHARACTERS
|
||
MOV LOCPOS,R0 ;MOVE TO ROOM POSITION
|
||
JSR PC,OUTSTR
|
||
MOV #OUTCHR,CHRFUN ;CHANGE CHARACTER FUNCTION TO DIRECT OUTPUT
|
||
MOV OLDRM,R0
|
||
JSR PC,OPPRND ;PRINT ROOM DESCRIPTION
|
||
MOV #PUTCHR,CHRFUN ;RESET CHARACTER FUNCTION
|
||
MOV CLRROL,R0 ;CLEAR REST OF LINE
|
||
JSR PC,OUTSTR
|
||
8$: MOV RETPOS,R0 ;RETURN TO OLD POSITION, RESET ATTRIBUTES,
|
||
JMP OUTSTR ;& RETURN
|
||
.DSABL LSB
|
||
|
||
;READ (A LINE OF INPUT & PARSE IT, LINE BUF IN R0, RETURN BUF IN R1)
|
||
.ENABL LSB
|
||
OPREAD::SAVE 01
|
||
JSR PC,OPUSL ;UPDATE STATUS LINE
|
||
RESTOR 1
|
||
JSR PC,TSTSCR ;TEST FOR SCRIPTING & UPDATE FLAGS ACCORDINGLY
|
||
MOVB #200,@CHRPTR ;DON'T END OUTPUT, IF ANY, WITH NEW LINE
|
||
1$: JSR PC,BUFOUT ;FORCE OUT ANY QUEUED TEXT
|
||
CLRB @CHRPTR ;RESTORE CRLF CHARACTER
|
||
MOV OUTBUF,CHRPTR ;RESET CHARACTER POINTER
|
||
RESTOR 2 ;INPUT BUFFER POINTER
|
||
ADD #BUFFER,R2 ;ABSOLUTIZE IT
|
||
MOV R2,R4
|
||
MOVB (R2)+,R3 ;MAX NUMBER OF CHARACTERS TO GET
|
||
2$: JSR PC,GETCHR ;INPUT A CHARACTER
|
||
CMP R0,#EOLCHR ;END OF THE LINE?
|
||
BEQ 5$ ;YES
|
||
CMP R0,#'A ;NO, UPPERCASE?
|
||
BLT 3$ ;NO
|
||
CMP R0,#'Z
|
||
BGT 3$ ;NO
|
||
ADD #40,R0 ;YES, LOWERCASIFY IT
|
||
3$: MOVB R0,(R2)+ ;SAVE IN LINE BUFFER
|
||
SOB R3,2$ ;LOOP UNTIL EOL OR BUFFER FULL
|
||
JSR PC,GETCHR ;BUFFER FULL, LAST CHANCE FOR EOL
|
||
CMP R0,#EOLCHR ;IS IT?
|
||
BEQ 5$ ;YES, WIN
|
||
SAVE 0 ;NO, INFORM LOSER
|
||
PRIN1 <Input line too long, flushing: >
|
||
RESTOR 0
|
||
4$: JSR PC,OUTCHR ;AND FLUSH REST OF LINE
|
||
JSR PC,GETCHR
|
||
CMP R0,#EOLCHR
|
||
BNE 4$
|
||
JSR PC,OUTCHR
|
||
|
||
5$: CMPB 1(R4),#'@ ;IS THIS A REQUEST FOR A COMMAND FILE?
|
||
BNE 7$ ;NO
|
||
TST CMDBUF ;YES, ALREADY HAVE A COMMAND FILE OPEN?
|
||
BNE 6$ ;YES, IGNORE THIS LINE & GET ANOTHER
|
||
JSR PC,OPNCFL ;NO, OPEN THE COMMAND FILE
|
||
6$: SUB #BUFFER,R4 ;RERELATIVIZE INPUT BUFFER POINTER,
|
||
SAVE 4 ;PUT ONTO STACK,
|
||
BR 1$ ;AND READ ANOTHER LINE
|
||
|
||
7$: DEFVAR RDWSTR,<.BLKW 4> ;WORD STRING BUFFER FOR ZWORD
|
||
DEFVAR RDBOS ;BEGINNING OF STRING POINTER
|
||
DEFVAR RDEOS ;END OF STRING POINTER
|
||
DEFVAR RDRET ;RETURN TABLE POINTER
|
||
DEFVAR RDNWDS ;NUMBER OF WORDS READ
|
||
SAVE 5
|
||
MOV R4,RDBOS ;INITIALIZE RDBOS
|
||
MOV R2,RDEOS ;AND RDEOS
|
||
ADD #BUFFER,R1 ;ABSOLUTIZE RET POINTER
|
||
MOV R1,RDRET ;AND STORE IT
|
||
CLR RDNWDS ;NO WORDS SO FAR
|
||
INC R4 ;SKIP LENGTH BYTE
|
||
MOV R1,R5 ;THIS WILL BE WORD ENTRY POINTER
|
||
ADD #2,R5 ;SKIP MAX WORDS & NWORDS BYTES
|
||
8$: MOV #RDWSTR,R3 ;HERE FOR NEXT WORD, POINT TO WORD STRING
|
||
MOV R4,R1 ;AND SAVE BEGINNING OF WORD POINTER
|
||
9$: CMP R4,RDEOS ;END OF STRING?
|
||
BNE 10$ ;NO
|
||
CMP R3,#RDWSTR ;YES, WAS A WORD FOUND?
|
||
BEQ 23$ ;NO, WE'RE DONE
|
||
BR 15$ ;YES, WE STILL HAVE TO LOOKUP WORD
|
||
10$: MOVB (R4)+,R0 ;GET NEXT CHARACTER FROM BUFFER
|
||
MOV RBRKS,R2 ;LIST OF READ BREAK CHARACTERS
|
||
11$: CMPB R0,(R2)+ ;SEARCH LIST FOR THIS ONE
|
||
BEQ 12$ ;FOUND IT
|
||
TSTB (R2) ;END OF LIST?
|
||
BNE 11$ ;NO, CONTINUE SEARCH
|
||
CMP R3,#RDWSTR+6 ;YES, NOT A BREAK, WORD STRING FULL?
|
||
BEQ 9$ ;YES, LOOP UNTIL END OF WORD
|
||
MOVB R0,(R3)+ ;NO, TACK THIS CHARACTER ONTO STRING
|
||
BR 9$ ;AND LOOP
|
||
12$: CMP R3,#RDWSTR ;WORD READ BEFORE THIS BREAK?
|
||
BNE 14$ ;YES
|
||
CMP R2,ESIBKS ;NO, BUT IS IT A SELF-INSERTING BREAK?
|
||
BLOS 13$ ;YES
|
||
INC R1 ;NO, UPDATE BEGINNING OF WORD TO SKIP BREAK
|
||
BR 9$ ;AND RETURN TO LOOP TO FIND A WORD
|
||
13$: MOVB R0,(R3)+ ;STORE THE BREAK IN WORD STRING
|
||
BR 15$ ;AND GO FOR THE WORD
|
||
14$: DEC R4 ;UNREAD TERMINATING BREAK IN CASE IT WAS SI
|
||
15$: INC RDNWDS ;INCREMENT FOUND WORD COUNT
|
||
CMPB RDNWDS,@RDRET ;GREATER THAN MAX ALLOWED?
|
||
BLE 16$ ;NO
|
||
PRIN1 <Too many words typed, flushing: > ;YES, INFORM LOSER
|
||
MOV R1,R0 ;BEGINNING OF THIS WORD
|
||
MOVB @RDEOS,R1 ;SAVE BYTE AFTER EOS
|
||
CLRB @RDEOS ;ZERO IT TO MAKE STRING ASCIZ
|
||
JSR PC,OUTSTR ;PRINT IT
|
||
MOVB R1,@RDEOS ;AND RESTORE OLD BYTE
|
||
DEC RDNWDS ;REMEMBER THAT WE FLUSHED THIS WORD
|
||
BR 23$ ;AND WE'RE DONE
|
||
16$: MOV R1,R0 ;CALCULATE NUMBER OF CHARACTERS IN WORD
|
||
NEG R0
|
||
ADD R4,R0
|
||
MOVB R0,2(R5) ;SAVE THE NUMBER IN RET TABLE
|
||
SUB RDBOS,R1 ;BYTE OFFSET FOR BEGINNING OF WORD
|
||
MOVB R1,3(R5) ;STORE IT, TOO
|
||
CLRB (R3) ;MAKE WORD STRING ASCIZ
|
||
MOV #RDWSTR,R0 ;POINT TO IT
|
||
JSR PC,ZWORD ;AND CONVERT TO (2-WORD) ZWORD
|
||
SAVE 45 ;SAVE CHAR & WORD ENTRY POINTERS
|
||
MOV R0,R4 ;FIRST ZWORD WORD
|
||
MOV R1,R5 ;SECOND ZWORD WORD
|
||
MOV VWORDS,R2 ;NUMBER OF VOCABULARY WORDS
|
||
MOV R2,R3
|
||
DEC R3 ;WE WANT TO POINT TO LAST WORD
|
||
MUL VWLEN,R3 ;MULTIPLY BY WORD LENGTH IN BYTES
|
||
ADD VOCBEG,R3 ;ADD POINTER TO BEGINNING TO FIND LAST WORD
|
||
MOV VWLEN,R1 ;CALCULATE INITIAL OFFSET FOR BINARY SEARCH
|
||
ASR R2
|
||
17$: ASL R1
|
||
ASR R2
|
||
BNE 17$
|
||
MOV VOCBEG,R2 ;BEGINNING OF WORD TABLE
|
||
ADD R1,R2 ;ADD CURRENT OFFSET (HALF OF POWER-OF-2 TABLE)
|
||
SUB VWLEN,R2 ;AVOID FENCE-POST BUG FOR EXACT POWER-OF-2 TBL
|
||
18$: ASR R1 ;NEXT OFFSET WILL BE HALF OF PREVIOUS ONE
|
||
MOV R2,R0 ;GET FIRST HALF OF CURRENT ZWORD
|
||
JSR PC,GTAWRD
|
||
CMP R4,R0 ;COMPARE DESIRED ONE TO IT
|
||
BHI 19$ ;GREATER, WE'LL HAVE TO MOVE UP
|
||
BLO 20$ ;LESS, WE'LL HAVE TO MOVE DOWN
|
||
MOV R2,R0 ;SAME, GET SECOND HALF
|
||
ADD #2,R0
|
||
JSR PC,GTAWRD
|
||
CMP R5,R0 ;COMPARE DESIRED WORD WITH IT
|
||
BHI 19$ ;GREATER, WE'LL HAVE TO MOVE UP
|
||
BLO 20$ ;LESS, WE'LL HAVE TO MOVE DOWN
|
||
SUB #BUFFER,R2 ;SAME, WE'VE FOUND IT, RELATIVIZE POINTER
|
||
BR 22$ ;AND RETURN IT
|
||
19$: ADD R1,R2 ;TO MOVE UP, ADD CURRENT OFFSET
|
||
CMP R2,R3 ;HAVE WE MOVED PAST END OF TABLE?
|
||
BLOS 21$ ;NO
|
||
MOV R3,R2 ;YES, POINT TO END OF TABLE INSTEAD
|
||
BR 21$
|
||
20$: SUB R1,R2 ;TO MOVE DOWN, SIMPLY SUBTRACT OFFSET
|
||
21$: CMP R1,VWLEN ;IS OFFSET RESOLUTION BELOW ONE WORD?
|
||
BGE 18$ ;NO, CONTINUE LOOP
|
||
CLR R2 ;YES, WORD NOT FOUND, RETURN ZERO
|
||
22$: RESTOR 54 ;RESTORE WORD ENTRY AND CHAR POINTERS
|
||
MOV R5,R0 ;POINTER TO WORD FOUND GOES HERE
|
||
MOV R2,R1 ;THE POINTER
|
||
JSR PC,PTAWRD ;STORE IT
|
||
ADD #4,R5 ;UPDATE POINTER FOR NEXT WORD ENTRY
|
||
JMP 8$ ;GO FOR IT
|
||
23$: INC RDRET ;DONE, STORE NUMBER OF WORDS FOUND
|
||
MOVB RDNWDS,@RDRET
|
||
RESTOR 5 ;RESTORE USER STACK POINTER
|
||
RTS PC ;AND RETURN
|
||
.DSABL LSB
|
||
|
||
;PRINTC (PRINT CHAR WHOSE ASCII VALUE IS GIVEN)
|
||
OPPRNC::JMP PUTCHR ;QUEUE THE CHARACTER FOR PRINTING
|
||
|
||
;PRINTN (PRINT A NUMBER)
|
||
OPPRNN::MOV R0,R1 ;NUMBER TO PRINT
|
||
BNE 1$ ;NON-ZERO
|
||
MOV #'0,R0 ;SPECIAL CASE ZERO
|
||
JMP PUTCHR
|
||
1$: BGT 2$ ;POSITIVE?
|
||
MOV #'-,R0 ;NO, PRINT MINUS SIGN
|
||
JSR PC,PUTCHR
|
||
NEG R1 ;AND MAKE IT POSITIVE
|
||
2$: CLR R2 ;COUNT OF DIGITS ON STACK
|
||
BR 4$ ;START WITH GREATER-THAN-10 TEST
|
||
3$: CLR R0 ;EXTRACT A DIGIT
|
||
DIV #10.,R0
|
||
MOV R1,-(SP) ;PUSH IT
|
||
INC R2 ;BUMP COUNT
|
||
MOV R0,R1 ;GET QUOTIENT
|
||
4$: CMP R1,#10. ;MORE DIGITS TO EXTRACT?
|
||
BGE 3$ ;YES, GO LOOP
|
||
MOV R1,R0 ;NO, GET LAST (FIRST) DIGIT
|
||
BR 6$ ;ALREADY IN PLACE
|
||
5$: MOV (SP)+,R0 ;POP NEXT DIGIT
|
||
6$: ADD #'0,R0 ;ASCIIZE IT
|
||
JSR PC,PUTCHR ;QUEUE IT
|
||
DEC R2 ;REDUCE DIGIT COUNT
|
||
BGE 5$ ;LOOP IF SOME LEFT
|
||
RTS PC ;ELSE, RETURN
|
||
|
||
;PRINT (THE STRING POINTED TO)
|
||
OPPRIN::JSR PC,BSPLIT ;SPLIT THE BLOCK & WORD NUMBERS
|
||
JMP PUTSTR ;PRINT THE STRING
|
||
|
||
;PRINTB (PRINT THE STRING POINTED TO BY THE BYTE-POINTER)
|
||
OPPRNB::JSR PC,BSPLTB ;SPLIT THE BLOCK & BYTE NUMBERS
|
||
JMP PUTSTR ;PRINT THE STRING
|
||
|
||
;PRINTD (PRINT OBJ'S SHORT DESCRIPTION)
|
||
OPPRND::JSR PC,OBJLOC ;FIND OBJ'S LOCATION
|
||
ADD #7,R0 ;PROPERTY TABLE POINTER
|
||
JSR PC,GTAWRD ;GET IT
|
||
INC R0 ;POINT TO STRING
|
||
JSR PC,BSPLTB ;SPLIT POINTER
|
||
JMP PUTSTR ;AND PRINT THE STRING
|
||
|
||
;PRINTI (PRINT THE STRING FOLLOWING THIS INSTRUCTION)
|
||
OPPRNI::MOV ZPC1,R0 ;GET POINTER TO STRING
|
||
MOV ZPC2,R1
|
||
JSR PC,PUTSTR ;AND PRINT IT
|
||
MOV R0,ZPC1 ;UPDATE ZPC
|
||
MOV R1,ZPC2
|
||
JMP NEWZPC
|
||
|
||
;PRINTR (PRINTI FOLLOWED BY RTRUE)
|
||
OPPRNR::JSR PC,OPPRNI ;DO A PRINTI
|
||
JSR PC,OPCRLF ;A CRLF
|
||
JMP OPRTRU ;AND AN RTRUE
|
||
|
||
;CRLF (DO A NEWLINE)
|
||
OPCRLF::JMP NEWLIN ;DO A NEWLINE
|
||
.SBTTL CONTROL OPERATIONS
|
||
|
||
|
||
;CALL (A FUNCTION WITH OPTIONAL ARGUMENTS)
|
||
OPCALL::NOP ;TELL CALLER TO USE ARGUMENT BLOCK
|
||
MOV R0,R2 ;ARGUMENT BLOCK POINTER
|
||
MOV 2(R2),R0 ;FUNCTION TO CALL
|
||
BNE 1$ ;ZERO?
|
||
CLR R0 ;YES, SIMPLY RETURN A ZERO
|
||
JMP PUTVAL
|
||
1$: MOV ZPC1,-(R5) ;OTHERWISE, SAVE OLD ZPC
|
||
MOV ZPC2,-(R5)
|
||
MOV ZLOCS,-(R5) ;AND OLD LOCAL POINTER
|
||
SUB STKBOT,(R5) ;BUT RELATIVIZE IT IN CASE OF SAVE
|
||
JSR PC,BSPLIT ;SPLIT FUNCTION POINTER
|
||
MOV R0,ZPC1 ;MAKE IT THE NEW ZPC
|
||
MOV R1,ZPC2
|
||
JSR PC,NEWZPC ;UPDATE ZPC STUFF
|
||
MOV R5,ZLOCS ;LOCALS WILL START AT NEXT STACK SLOT
|
||
SUB #2,ZLOCS
|
||
JSR PC,NXTBYT ;NUMBER OF LOCALS
|
||
MOV R0,R1
|
||
MOV (R2),R3 ;NUMBER OF ARGUMENTS TO CALL
|
||
ADD #4,R2 ;POINT TO FIRST OPTIONAL ARG
|
||
2$: DEC R1 ;ANY MORE LOCALS?
|
||
BLT 4$ ;NO, WE'RE DONE
|
||
JSR PC,NXTWRD ;YES, GET THE NEXT LOCAL DEFAULT VALUE
|
||
DEC R3 ;ANY MORE OPTIONALS GIVEN?
|
||
BLE 3$ ;NO
|
||
MOV (R2)+,-(R5) ;YES, USE ITS VALUE
|
||
BR 2$ ;AND CONTINUE LOOP
|
||
3$: MOV R0,-(R5) ;OTHERWISE, USE DEFAULT
|
||
BR 2$ ;AND LOOP
|
||
4$: RTS PC
|
||
|
||
;RETURN (FROM CURRENT FUNCTION CALL)
|
||
OPRETU::MOV ZLOCS,R5 ;RESTORE OLD TOP OF STACK
|
||
TST (R5)+
|
||
MOV (R5)+,ZLOCS ;AND OTHER VALUES
|
||
ADD STKBOT,ZLOCS ;RE-ABSOLUTIZE THIS ONE
|
||
MOV (R5)+,ZPC2
|
||
MOV (R5)+,ZPC1
|
||
SAVE 0 ;VALUE TO RETURN
|
||
JSR PC,NEWZPC ;UPDATE ZPC STUFF
|
||
RESTOR 0
|
||
JMP PUTVAL ;RETURN THE VALUE
|
||
|
||
;RTRUE
|
||
OPRTRU::MOV #1,R0 ;RETURN A 1
|
||
BR OPRETU
|
||
|
||
;RFALSE
|
||
OPRFAL::CLR R0 ;RETURN A 0
|
||
BR OPRETU
|
||
|
||
;JUMP (TO A NEW LOCATION)
|
||
OPJUMP::ADD R0,ZPC2 ;ADD OFFSET TO CURRENT ZPC
|
||
SUB #2,ZPC2 ;ADJUST IT
|
||
JMP NEWZPC ;NORMALIZE IT & UPDATE ZPC STUFF
|
||
|
||
;RSTACK (RETURN STACK)
|
||
OPRSTA::MOV (R5)+,R0 ;POP A VALUE
|
||
BR OPRETU ;AND RETURN IT
|
||
|
||
;FSTACK (FLUSH A VALUE OFF THE STACK)
|
||
OPFSTA::TST (R5)+ ;FLUSH ONE
|
||
RTS PC
|
||
|
||
;NOOP (NO OPERATION)
|
||
OPNOOP::RTS PC ;DO NOTHING
|
||
.SBTTL GAME COMMANDS
|
||
|
||
|
||
;SAVE (THE CURRENT STATE OF THE GAME)
|
||
OPSAVE::MOV PURBOT,R0 ;NUMBER OF BLOCKS NEEDED FOR IMPURE STUFF
|
||
INC R0 ;+ 1 BLOCK FOR STACK = SAVE FILE LENGTH
|
||
JSR R5,NEWSFL ;CREATE THE SAVE FILE
|
||
BR JPF2 ;FAILURE
|
||
MOV ZPC1,-(R5) ;SUCCESS, SAVE STUFF ON USER STACK
|
||
MOV ZPC2,-(R5)
|
||
MOV ZLOCS,-(R5)
|
||
SUB STKBOT,(R5) ;RELATIVIZE THIS ONE
|
||
MOV ZORKID,-(R5)
|
||
MOV R5,@STKBOT ;SAVE USER SP IN KNOWN LOCATION
|
||
SUB STKBOT,@STKBOT ;RELATIVIZE IT
|
||
CLR R0 ;THIS WILL BE BLOCK ZERO
|
||
MOV STKBOT,R1 ;STARTING AT BOTTOM OF STACK PAGE
|
||
MOV #1,R2 ;STACK IS 1 PAGE LONG
|
||
JSR R5,PTSBKS ;WRITE IT OUT
|
||
BR JPF2 ;FAILURE
|
||
ADD #10,R5 ;RESET STACK POINTER
|
||
MOV #1,R0 ;IMPURE STUFF STARTS AT BLOCK 1
|
||
MOV #BUFFER,R1 ;BEGINNING OF IMPURE STUFF IN CORE
|
||
MOV PURBOT,R2 ;NUMBER OF PAGES
|
||
JSR R5,PTSBKS ;WRITE THEM OUT
|
||
BR JPF2 ;FAILURE
|
||
JSR PC,CLSSFL ;AND CLOSE THE FILE
|
||
JPT2: JMP PTRUE ;PREDICATE TRUE
|
||
JPF2: JMP PFALSE ;PREDICATE FALSE
|
||
|
||
;RESTORE (A PREVIOUSLY SAVED GAME STATE)
|
||
OPREST::JSR R5,OPNSFL ;OPEN THE SAVE FILE
|
||
BR JPF2 ;FAILURE
|
||
CLR R0 ;GET STACK FIRST FROM BLOCK 0
|
||
MOV STKBOT,R1 ;PUT IT HERE
|
||
MOV #1,R2 ;1 PAGE LONG
|
||
JSR PC,GTSBKS ;READ IT IN
|
||
MOV @STKBOT,R5 ;RESTORE SAVED USER SP
|
||
ADD STKBOT,R5 ;ABSOLUTIZE IT
|
||
CMP (R5)+,ZORKID ;IS SAVED ZORKID SAME AS OURS?
|
||
BNE 1$ ;NO
|
||
MOV (R5)+,ZLOCS ;YES, RESTORE OTHER STUFF
|
||
ADD STKBOT,ZLOCS ;RE-ABSOLUTIZE THIS ONE
|
||
MOV (R5)+,ZPC2
|
||
MOV (R5)+,ZPC1
|
||
MOV BUFFER+PFLAGS,R4 ;SAVE OLD FLAGS
|
||
MOV #1,R0 ;GET IMPURE PART STARTING AT BLOCK 1
|
||
MOV #BUFFER,R1 ;PUT IT HERE
|
||
MOV PURBOT,R2 ;LENGTH OF IMPURE PART
|
||
JSR PC,GTSBKS ;READ IT IN
|
||
JSR PC,CLSSFL ;CLOSE THE FILE
|
||
MOV R4,BUFFER+PFLAGS ;RESTORE OLD FLAGS
|
||
JSR PC,NEWZPC ;POINT TO PROPER ZPC PAGE
|
||
BR JPT2 ;AND RETURN PREDICATE TRUE
|
||
1$: FATAL <Wrong game or version>
|
||
|
||
;RESTART (THE GAME)
|
||
OPRSTT::CLRB @CHRPTR ;FORCE OUT ANY QUEUED TEXT
|
||
JSR PC,BUFOUT
|
||
JMP RESTRT ;SKIP FILE OPENING & USER DIALOGUE
|
||
|
||
;QUIT
|
||
OPQUIT::TST P$TERM ;STATUS LINE
|
||
BEQ 1$ ;NO
|
||
MOV TRMUNI,R0 ;YES, UNINITIALIZE THE TERMINAL
|
||
JSR PC,OUTSTR
|
||
1$: JMP FINISH ;DIE PEACEFULLY
|
||
|
||
;VERIFY (GAME FILE)
|
||
OPVERI::MOV #BUFFER+PLENTH,R0 ;GET FILE LENGTH
|
||
CALL GTAWRD
|
||
CALL BSPLIT
|
||
SAVE 5
|
||
MOV R0,R4
|
||
MOV R1,R5
|
||
CLR R0 ;STARTING BLOCK POINTER
|
||
MOV #100,R1 ;BYTE POINTER
|
||
CLR R3 ;PUT CHECKSUM HERE
|
||
MOV ENDLOD,-(SP)
|
||
CLR ENDLOD ;FORCE LOADING FROM DISK
|
||
1$: CALL GETBYT ;GET NEXT BYTE
|
||
ADD R2,R3 ;ADD IN TO CHECKSUM
|
||
CMP R0,R4 ;DONE YET?
|
||
BNE 1$ ;NO
|
||
CMP R1,R5 ;MAYBE
|
||
BNE 1$ ;NO
|
||
MOV #BUFFER+PCHKSM,R0 ;DONE, COMPARE WITH REAL CHECKSUM
|
||
CALL GTAWRD
|
||
MOV (SP)+,ENDLOD ;RESTORE PROPER ENDLOD
|
||
RESTOR 5
|
||
CMP R0,R3
|
||
BNE 2$ ;ERROR
|
||
JMP PTRUE ;SUCCESS
|
||
2$: JMP PFALSE ;FAILURE
|
||
.SBTTL LOW LEVEL FUNCTIONS
|
||
|
||
|
||
;GET CORE WORD, ABSOLUTE POINTER GIVEN IN R0, RETURN WORD IN R0
|
||
GTAWRD::SAVE 1
|
||
MOV R0,R1
|
||
MOVB (R1)+,R0 ;GET HIGH-ORDER BYTE
|
||
SWAB R0 ;POSITION IT
|
||
BIC #377,R0 ;CLEAR UNWANTED BITS
|
||
BISB (R1),R0 ;OR IN LOW-ORDER BYTE
|
||
RESTOR 1
|
||
RTS PC
|
||
|
||
;UPDATE CORE WORD, ABSOLUTE POINTER GIVEN IN R0, NEW VALUE IN R1
|
||
PTAWRD::MOVB R1,1(R0) ;STORE LOW-ORDER BYTE
|
||
SWAB R1
|
||
MOVB R1,(R0) ;STORE HIGH-ORDER BYTE
|
||
RTS PC
|
||
|
||
;GET A BYTE, BLOCK-POINTER IN R0, BYTE-POINTER IN R1, RESULT IN R2,
|
||
;UPDATE R0 & R1 TO REFLECT BYTE GOTTEN
|
||
GETBYT::SAVE 0
|
||
CMP R0,ENDLOD ;IS THIS A PRELOADED LOCATION?
|
||
BGE 1$ ;NO
|
||
ASH #9.,R0 ;YES, RECONSTRUCT POINTER
|
||
BIS R1,R0
|
||
MOVB BUFFER(R0),R2 ;GET THE BYTE
|
||
BR 2$ ;CLEAR UNWANTED BYTE & RETURN IT
|
||
1$: JSR PC,GETPAG ;FIND THE PROPER PAGE
|
||
ADD R1,R0 ;POINT TO DESIRED BYTE
|
||
MOVB (R0),R2 ;GET IT
|
||
2$: BIC #^C377,R2 ;CLEAR UNWANTED BYTE & RETURN IT
|
||
RESTOR 0
|
||
INC R1 ;UPDATE POINTER
|
||
CMP R1,#1000 ;END-OF-PAGE?
|
||
BNE 3$ ;NO
|
||
CLR R1 ;YES, CLEAR BYTE-POINTER
|
||
INC R0 ;AND UPDATE BLOCK-POINTER
|
||
3$: RTS PC
|
||
|
||
;GET A WORD, BLOCK POINTER IN R0, BYTE-POINTER IN R1, RESULT IN R2
|
||
GETWRD::JSR PC,GETBYT ;GET HIGH-ORDER BYTE
|
||
SWAB R2 ;POSITION IT
|
||
MOV R2,-(SP) ;SAVE IT
|
||
JSR PC,GETBYT ;GET LOW-ORDER BYTE
|
||
BIS (SP)+,R2 ;OR IN OTHER BYTE
|
||
RTS PC
|
||
|
||
;GET THE NEXT BYTE, RETURN IT IN R0
|
||
NXTBYT::MOV ZPC2,R0 ;BYTE POINTER
|
||
ADD CURPAG,R0 ;INDEX INTO CURRENT PAGE
|
||
MOVB (R0),-(SP) ;SAVE BYTE
|
||
INC ZPC2 ;UPDATE PC
|
||
CMP ZPC2,#1000 ;END-OF-PAGE?
|
||
BLT 1$ ;NO
|
||
JSR PC,NEWZPC ;YES, UPDATE PAGE
|
||
1$: MOVB (SP)+,R0 ;RETRIEVE BYTE
|
||
BIC #^C377,R0 ;CLEAR UNWANTED BYTE
|
||
RTS PC ;AND RETURN IT
|
||
|
||
;GET THE NEXT WORD, RETURN IT IN R0
|
||
NXTWRD::JSR PC,NXTBYT ;GET HIGH-ORDER BYTE
|
||
SWAB R0 ;MOVE TO PROPER POSITION
|
||
MOV R0,-(SP) ;SAVE IT
|
||
JSR PC,NXTBYT ;GET LOW-ORDER BYTE
|
||
BIS (SP)+,R0 ;OR IN HIGH-ORDER BYTE
|
||
RTS PC ;RETURN THE WORD
|
||
|
||
;GET AN ARGUMENT GIVEN ITS TYPE IN R0
|
||
GETARG::DEC R0 ;EXAMINE ARGUMENT
|
||
BLT NXTWRD ;0 MEANT LONG IMMEDIATE
|
||
BEQ NXTBYT ;1 MEANT SHORT IMMEDIATE
|
||
JSR PC,NXTBYT ;2 MEANT VARIABLE, GET THE VAR
|
||
TST R0 ;STACK?
|
||
BNE GETVAR ;NO, JUST GET THE VAR'S VALUE
|
||
1$: MOV (R5)+,R0 ;YES, POP THE STACK
|
||
RTS PC
|
||
|
||
;GET VALUE OF A VARIABLE, VAR IN R0, VALUE RETURNED IN R0
|
||
GETVAR::TST R0 ;STACK?
|
||
BNE 1$ ;NO
|
||
MOV (R5),R0 ;YES, GET TOP-OF-STACK
|
||
RTS PC
|
||
1$: CMP R0,#20 ;LOCAL?
|
||
BGE 2$ ;NO
|
||
DEC R0 ;YES, POINT TO PROPER STACK ELEMENT
|
||
ASL R0
|
||
NEG R0
|
||
ADD ZLOCS,R0
|
||
MOV (R0),R0 ;AND GET IT
|
||
RTS PC
|
||
2$: SUB #20,R0 ;GLOBAL, POINT TO PROPER GLOBAL TABLE ELEMENT
|
||
ASL R0
|
||
ADD GLOTAB,R0
|
||
JMP GTAWRD ;AND GET IT
|
||
|
||
;UPDATE VALUE OF A VARIABLE, VAR IN R0, NEW VALUE IN R1
|
||
PUTVAR::TST R0 ;STACK?
|
||
BNE 1$ ;NO
|
||
MOV R1,(R5) ;YES, UPDATE TOP-OF-STACK
|
||
RTS PC
|
||
1$: CMP R0,#20 ;LOCAL?
|
||
BGE 2$ ;NO
|
||
DEC R0 ;YES, POINT TO PROPER STACK ELEMENT
|
||
ASL R0
|
||
NEG R0
|
||
ADD ZLOCS,R0
|
||
MOV R1,(R0) ;AND UPDATE IT
|
||
RTS PC
|
||
2$: SUB #20,R0 ;GLOBAL, POINT TO PROPER GLOBAL TABLE ELEMENT
|
||
ASL R0
|
||
ADD GLOTAB,R0
|
||
JMP PTAWRD ;AND UPDATE IT
|
||
|
||
;RETURN VAL IN R0 TO LOCATION SPECIFIED BY NEXTBYTE
|
||
;DESTROYS R1, BUT IS USUALLY CALLED AT END OF TOP-LEVEL FUNCTION
|
||
BYTVAL::BIC #^C377,R0 ;THIS ENTRY FOR BYTE VALUE TO CLEAR HIGH BYTE
|
||
PUTVAL::MOV R0,R1 ;NORMAL ENTRY
|
||
JSR PC,NXTBYT ;GET VAR TO USE
|
||
TST R0 ;STACK?
|
||
BNE PUTVAR ;NO, GO STORE VALUE
|
||
MOV R1,-(R5) ;YES, PUSH ONTO STACK
|
||
RTS PC ;AND RETURN
|
||
|
||
;PREDICATE HANDLERS TRUE & FALSE
|
||
;DESTROYS REGISTERS, BUT ARE ONLY CALLED FROM END OF TOP-LEVEL FCNS
|
||
PFALSE::CLR R1 ;PREDICATE WAS FALSE, CLEAR FLAG
|
||
BR PTRUE1
|
||
PTRUE:: MOV #1,R1 ;PREDICATE WAS TRUE, SET FLAG
|
||
PTRUE1: JSR PC,NXTBYT ;GET FIRST (OR ONLY) PREDICATE JUMP BYTE
|
||
BIT #200,R0 ;NORMAL POLARITY PREDICATE?
|
||
BEQ 1$ ;NO, LEAVE FLAG ALONE
|
||
INC R1 ;YES, INCREMENT FLAG
|
||
1$: BIT #100,R0 ;ONE-BYTE JUMP OFFSET?
|
||
BEQ 2$ ;NO
|
||
BIC #300,R0 ;YES, CLEAR SPECIAL BITS
|
||
BR 3$
|
||
2$: BIC #300,R0 ;CLEAR SPECIAL BITS FROM HIGH-ORDER OFFSET BYT
|
||
SWAB R0 ;POSITION IT
|
||
MOV R0,R2
|
||
JSR PC,NXTBYT ;GET LOW-ORDER BYTE
|
||
BIS R2,R0 ;OR IN HIGH-ORDER BITS
|
||
BIT #20000,R0 ;IS NUMBER NEGATIVE (14-BIT 2'S COMP NUMBER)?
|
||
BEQ 3$ ;NO
|
||
BIS #140000,R0 ;YES, MAKE 16-BIT NUMBER NEGATIVE
|
||
3$: DEC R1 ;TEST FLAG
|
||
BEQ 6$ ;WAS 1, THAT MEANS DO NOTHING
|
||
TST R0 ;ZERO JUMP?
|
||
BNE 4$ ;NO
|
||
JMP OPRFAL ;YES, THAT MEANS DO AN RFALSE
|
||
4$: DEC R0 ;ONE JUMP?
|
||
BNE 5$ ;NO
|
||
JMP OPRTRU ;YES, THAT MEANS DO AN RTRUE
|
||
5$: DEC R0 ;ADJUST OFFSET
|
||
ADD R0,ZPC2 ;ADD TO PC
|
||
JMP NEWZPC ;AND UPDATE ZPC STUFF
|
||
6$: RTS PC
|
||
|
||
;SPLIT BYTE-POINTER IN R0 INTO BLOCK-POINTER IN R0 & BYTE OFFSET IN R1
|
||
BSPLTB::MOV R0,R1
|
||
SWAB R0 ;EXTRACT BLOCK BITS
|
||
ASR R0
|
||
BIC #^C177,R0 ;CLEAR UNWANTED BITS
|
||
BIC #^C777,R1 ;CLEAR ALL BUT BYTE OFFSET BITS
|
||
RTS PC
|
||
|
||
;SPLIT WORD-POINTER IN R0 INTO BLOCK-POINTER IN R0 & BYTE-OFFSET IN R1
|
||
BSPLIT::MOV R0,R1
|
||
SWAB R0 ;EXTRACT BLOCK BITS
|
||
BIC #^C377,R0 ;CLEAR UNWANTED BITS
|
||
BIC #^C377,R1 ;CLEAR ALL BUT WORD OFFSET BITS
|
||
ASL R1 ;CONVERT TO BYTE OFFSET
|
||
RTS PC
|
||
.SBTTL OBJECT HACKERS
|
||
|
||
|
||
;GIVEN OBJ NUMBER IN R0, RETURN OBJ LOCATION IN R0
|
||
OBJLOC::BIC #^C377,R0 ;CLEAR UNWANTED BITS
|
||
MOV R0,-(SP) ;MULTIPLY BY 9 THE LAZY WAY
|
||
ASL R0
|
||
ASL R0
|
||
ASL R0
|
||
ADD (SP)+,R0
|
||
ADD OBJTAB,R0 ;INDEX INTO OBJECT TABLE
|
||
ADD #53.,R0 ;SKIPPING DEFAULT PROPERTY TABLE
|
||
RTS PC
|
||
|
||
;GIVEN POINTER TO A PROPERTY IN R0, UPDATE IT TO POINT TO NEXT PROP
|
||
NXTPRP::MOV R0,-(SP) ;SAVE POINTER FOR LATER
|
||
MOVB (R0),R0 ;GET PROPERTY IDENTIFIER
|
||
ASH #-5,R0 ;EXTRACT PROPERTY LENGTH (MINUS 1)
|
||
BIC #^C7,R0
|
||
ADD (SP)+,R0 ;ADD IT TO OLD POINTER
|
||
ADD #2,R0 ;ADJUST FOR EXTRA LENGTH BYTE PLUS IDENTIFIER
|
||
RTS PC
|
||
.SBTTL STRING FUNCTIONS
|
||
|
||
|
||
.PSECT STRING
|
||
|
||
;ZSTR CHARACTER CONVERSION VECTOR
|
||
ZCHRS:: .ASCII /abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ/
|
||
.ASCII \ 0123456789.,!?_#'"/\
|
||
.ASCIZ /\-:()/
|
||
|
||
.PSECT CODE
|
||
|
||
PADCHR= 5 ;ZSTR PADDING CHARACTER
|
||
|
||
;OUTPUT A ZSTR, BLOCK-POINTER IN R0, BYTE-POINTER IN R1
|
||
;RETURN UPDATED POINTER
|
||
DEFVAR CHRFUN,PUTCHR ;CHARACTER OUTPUT FUNCTION
|
||
DEFVAR WRDOFF ;OFFSET INTO WORD TABLE FOR CURRENT SET
|
||
PUTSTR::SAVE 2345
|
||
CLR R4 ;TEMP CS STARTS AT 0
|
||
CLR R5 ;PERM CS STARTS AT 0
|
||
1$: JSR PC,GETWRD ;GET NEXT STRING WORD
|
||
SAVE 012 ;SAVE POINTER & COPY OF STRING WORD
|
||
MOV #3,R3 ;3 BYTES IN WORD
|
||
2$: SAVE 2 ;SAVE CURRENT BYTE (IN LOW-ORDER POSITION)
|
||
ASH #-5,R2 ;SHIFT TO NEXT BYTE
|
||
SOB R3,2$ ;LOOP UNTIL DONE
|
||
MOV #3,R3 ;RETRIEVE THE 3 BYTES
|
||
3$: RESTOR 2 ;GET NEXT BYTE
|
||
BIC #^C37,R2 ;CLEAR UNWANTED BITS
|
||
TST R4 ;IN WORD MODE?
|
||
BPL 4$ ;NO
|
||
ASL R2 ;YES, CALCULATE WORD OFFSET
|
||
ADD WRDTAB,R2 ;POINT INTO WORD TABLE
|
||
ADD WRDOFF,R2 ;USING PROPER 32-WORD BLOCK
|
||
MOV R2,R0
|
||
JSR PC,GTAWRD ;POINT TO WORD STRING
|
||
JSR PC,BSPLIT ;SPLIT IT
|
||
JSR PC,PUTSTR ;AND PRINT IT
|
||
BR 15$ ;CONTINUE WHERE WE LEFT OFF WITH TEMP CS RESET
|
||
4$: CMP R4,#3 ;CS 3 SELECTED (ASCII MODE)?
|
||
BLT 6$ ;NO, NORMAL CS
|
||
BNE 5$ ;NO, BUT WE ARE IN ASCII MODE
|
||
SWAB R4 ;SHIFT SOME BITS HIGH TO MAKE NUMBER LARGE
|
||
BIS R2,R4 ;SAVE HIGH-ORDER ASCII BITS HERE
|
||
BR 16$ ;GO GET NEXT BYTE
|
||
5$: BIC #^C3,R4 ;EXTRACT PREVIOUSLY SAVED HIGH-ORDER BITS
|
||
ASH #5,R4 ;POSITION THEM
|
||
BIS R2,R4 ;OR IN LOW-ORDER BITS
|
||
MOV R4,R0
|
||
BR 14$ ;GO PRINT THE CHARACTER
|
||
6$: CMP R2,#6 ;SPECIAL CODE?
|
||
BLT 9$ ;YES, SPACE, WORD, OR SHIFT
|
||
CMP R4,#2 ;MIGHT ALSO BE SPECIAL IF IN CS 2
|
||
BNE 8$ ;BUT WE'RE NOT
|
||
CMP R2,#7 ;CRLF?
|
||
BEQ 7$ ;YES
|
||
BGT 8$ ;NO, NOT ASCII MODE, EITHER?
|
||
INC R4 ;YES IT IS, SWITCH TO ASCII MODE
|
||
BR 16$ ;AND GO GET NEXT BYTE
|
||
7$: JSR PC,NEWLIN ;CRLF REQUESTED, DO A NEWLINE
|
||
BR 15$
|
||
8$: MOV R4,R1 ;NORMAL CHARACTER, GET CS
|
||
MUL #26.,R1 ;CALCULATE OFFSET FOR THIS CS
|
||
ADD R2,R1 ;ADD IN CHARACTER OFFSET (+6)
|
||
MOVB ZCHRS-6(R1),R0 ;GET THE CHARACTER FROM CONVERSION VECTOR
|
||
BR 14$ ;GO PRINT IT
|
||
9$: TST R2 ;IS IT A SPACE?
|
||
BNE 10$ ;NO
|
||
MOV #40,R0 ;YES, GO PRINT A SPACE
|
||
BR 14$
|
||
10$: CMP R2,#3 ;IS IT A WORD?
|
||
BGT 11$ ;NO, MUST BE A SHIFT
|
||
BIS #100000,R4 ;SWITCH TO WORD MODE FOR NEXT BYTE
|
||
DEC R2 ;CALCULATE WORD-TABLE BLOCK OFFSET
|
||
ASH #6,R2 ;64 BYTES IN A BLOCK
|
||
MOV R2,WRDOFF ;SAVE IT AND LOOP
|
||
BR 16$
|
||
11$: SUB #3,R2 ;CALCULATE NEW CS
|
||
TST R4 ;TEMPORARY SHIFT (FROM CS 0)?
|
||
BNE 12$ ;NO
|
||
MOV R2,R4 ;YES, JUST SAVE NEW TEMP CS
|
||
BR 16$
|
||
12$: CMP R2,R4 ;IS THIS THE CURRENT CS?
|
||
BEQ 13$ ;YES, DO A PERM SHIFT TO IT
|
||
CLR R4 ;OTHERWISE, PERM SHIFT TO CS 0
|
||
13$: MOV R4,R5 ;TEMP & PERM CS'S ARE SAME NOW
|
||
BR 16$
|
||
14$: JSR PC,@CHRFUN ;PRINT THE CHARACTER
|
||
15$: MOV R5,R4 ;RESET TEMP CS TO PERM CS
|
||
16$: SOB R3,3$ ;NEXT BYTE
|
||
RESTOR 210 ;RESTORE POINTERS & ORIGINAL STRING WORD
|
||
TST R2 ;END-OF-STRING?
|
||
BGE 1$ ;NO, GET NEXT WORD
|
||
RESTOR 5432 ;YES, CLEAN UP & RETURN UPDATED POINTER
|
||
RTS PC
|
||
|
||
;GIVEN AN ASCII CHARACTER IN R0, RETURN THE CHARACTER SET # IN R0
|
||
CHRCS:: TST R0 ;IS THIS A NULL?
|
||
BNE 1$ ;NO
|
||
MOV #3,R0 ;YES, RETURN DUMMY CS NUMBER
|
||
RTS PC
|
||
1$: SAVE 1
|
||
MOV #ZCHRS,R1 ;POINT TO CONVERSION VECTOR
|
||
2$: CMPB R0,(R1)+ ;FOUND THE CHARACTER?
|
||
BEQ 3$ ;YES
|
||
TSTB (R1) ;NO, END OF STRING?
|
||
BNE 2$ ;NO, CONTINUE LOOP
|
||
MOV #2,R0 ;YES, CALL IT CS 2
|
||
BR 5$
|
||
3$: SUB #ZCHRS,R1 ;FIND CHARACTER POSITION
|
||
CLR R0 ;START WITH CS 0
|
||
4$: SUB #26.,R1 ;EVERY 26 CHARACTERS IS A NEW CS
|
||
BLE 5$ ;DONE
|
||
INC R0 ;INCREMENT CS # & CONTINUE LOOP
|
||
BR 4$
|
||
5$: RESTOR 1
|
||
RTS PC
|
||
|
||
;GIVEN AN ASCII CHARACTER IN R0, RETURN ZSTR BYTE VALUE IN R0
|
||
CHRBYT::SAVE 1
|
||
MOV #ZCHRS,R1 ;POINT TO CHARACTER CONVERSION TABLE
|
||
1$: CMPB R0,(R1)+ ;FOUND THE CHARACTER?
|
||
BEQ 2$ ;YES
|
||
TSTB (R1) ;NO, END OF STRING?
|
||
BNE 1$ ;NO, CONTINUE LOOP
|
||
CLR R0 ;YES, RETURN ZERO FOR FAILURE
|
||
BR 4$
|
||
2$: SUB #ZCHRS-5,R1 ;ADJUST POINTER SO FIRST CHARACTER IS 6
|
||
MOV R1,R0
|
||
3$: CMP R0,#32. ;SUBTRACT MULTIPLES OF 26 UNTIL BASE CODE
|
||
BLT 4$
|
||
SUB #26.,R0
|
||
BR 3$
|
||
4$: RESTOR 1
|
||
RTS PC
|
||
|
||
;CONVERT UP TO 6 ASCIZ CHARS POINTED TO BY R0
|
||
;TO A 2-WORD ZSTR RETURNED IN R0 & R1
|
||
ZWORD:: SAVE 2345
|
||
MOV R0,R2 ;CHARACTER STRING POINTER
|
||
CLR R5 ;CS STARTS AT 0
|
||
MOV #6,R3 ;MAKE 6 ZSTR BYTES
|
||
1$: MOVB (R2)+,R1 ;GET NEXT CHARACTER
|
||
BNE 3$ ;NOT END-OF-STRING
|
||
MOV #PADCHR,R0 ;AT END-OF-STRING, PAD WITH PAD CHARACTER
|
||
2$: SAVE 0 ;SAVE A PAD BYTE
|
||
SOB R3,2$ ;LOOP UNTIL DONE
|
||
BR 6$ ;THEN GO FORM ZWORD
|
||
3$: MOV R1,R0
|
||
JSR PC,CHRCS ;FIND THE CS NUMBER FOR THIS CHAR
|
||
TST R0 ;CS 0?
|
||
BEQ 4$ ;YES
|
||
ADD #3,R0 ;NO, CALCULATE TEMP SHIFT BYTE
|
||
SAVE 0 ;SAVE THE SHIFT BYTE
|
||
DEC R3 ;REDUCE BYTE COUNT
|
||
BEQ 6$ ;DONE
|
||
4$: MOV R1,R0 ;FIND THE PROPER BYTE VALUE FOR THIS CHAR
|
||
JSR PC,CHRBYT
|
||
TST R0 ;IN NORMAL CS'S?
|
||
BNE 5$ ;YES
|
||
MOV #6,R0 ;NO, USE ASCII SHIFT
|
||
SAVE 0
|
||
DEC R3 ;DONE YET?
|
||
BEQ 6$ ;YES
|
||
MOV R1,R0 ;NO, SAVE HIGH-ORDER ASCII BITS
|
||
ASH #-5,R0
|
||
SAVE 0
|
||
DEC R3 ;DONE YET?
|
||
BEQ 6$ ;YES
|
||
BIC #^C37,R1 ;NO, SAVE LOW-ORDER ASCII BITS
|
||
MOV R1,R0
|
||
5$: SAVE 0 ;SAVE THIS BYTE
|
||
SOB R3,1$ ;LOOP UNTIL ZWORD FULL
|
||
6$: MOV 12(SP),R0 ;BUILD ZWORD WORDS FROM 6 SAVED BYTES
|
||
ASH #5,R0
|
||
BIS 10(SP),R0
|
||
ASH #5,R0
|
||
BIS 6(SP),R0
|
||
MOV 4(SP),R1
|
||
ASH #5,R1
|
||
BIS 2(SP),R1
|
||
ASH #5,R1
|
||
BIS (SP),R1
|
||
BIS #100000,R1 ;SET END-OF-STRING BIT IN SECOND WORD
|
||
ADD #14,SP ;FLUSH STACK
|
||
RESTOR 5432
|
||
RTS PC
|
||
.SBTTL TERMINAL I/O
|
||
|
||
|
||
;QUEUE CHARACTER IN R0 FOR OUTPUT
|
||
DEFVAR OUTBUF ;POINTS TO OUTPUT BUFFER
|
||
DEFVAR CHRPTR ;POINTS TO NEXT CHARACTER POSITION
|
||
DEFVAR ENDBUF ;POINTS JUST PAST END OF OUTPUT BUFFER (0)
|
||
PUTCHR::CMP CHRPTR,ENDBUF ;END OF BUFFER?
|
||
BNE 7$ ;NO
|
||
SAVE 012 ;YES, ENTER OUTPUT ROUTINE
|
||
MOV ENDBUF,R1 ;END OF BUFFER
|
||
MOV OUTBUF,R2 ;BEGINNING OF BUFFER
|
||
1$: CMPB -(R1),#40 ;SEARCH FOR SPACE BACKWARDS FROM END
|
||
BEQ 3$
|
||
CMP R1,R2 ;STOP AT BEGINNING OF BUFFER
|
||
BNE 1$
|
||
2$: JSR PC,LINOUT ;NO SPACES, OUTPUT WHOLE LINE
|
||
MOV R2,CHRPTR ;RESTORE POINTER TO BEGINNING OF BUFFER
|
||
CMP 4(SP),#40 ;DID A SPACE CAUSE BUFFER OVERFLOW?
|
||
BNE 6$ ;NO
|
||
CLR 4(SP) ;YES, FLUSH IT
|
||
BR 6$ ;AND RETURN
|
||
3$: CMP R1,R2 ;DEGENERATE CASE WITH SPACE AT OUTBUF?
|
||
BEQ 2$ ;YES, OUTPUT WHOLE LINE
|
||
CLRB (R1) ;NO, OUTPUT UP TO SPACE
|
||
JSR PC,LINOUT
|
||
MOV ENDBUF,R0 ;END OF BUFFER
|
||
INC R1 ;START GETTING CHARACTERS AFTER THE SPACE
|
||
4$: CMP R1,R0 ;AT END YET?
|
||
BEQ 5$ ;YES
|
||
MOVB (R1)+,(R2)+ ;NO, COPY NEXT CHARACTER TO BEGINNING OF BUF
|
||
BR 4$ ;AND CONTINUE
|
||
5$: MOV R2,CHRPTR ;NEXT CHAR WILL GO AFTER COPIED STUFF
|
||
6$: RESTOR 210 ;CLEAN UP
|
||
BEQ 8$ ;AND IGNORE A NULL CHARACTER
|
||
7$: MOVB R0,@CHRPTR ;NOW STORE THE CHARACTER IN BUFFER
|
||
INC CHRPTR ;UPDATE POINTER
|
||
8$: RTS PC ;AND RETURN
|
||
|
||
;GO TO NEW LINE, OUTPUTTING CURRENT BUFFER
|
||
NEWLIN::CLRB @CHRPTR ;END LINE AT CURRENT POINT
|
||
MOV OUTBUF,CHRPTR ;RESET CHARACTER POINTER
|
||
JMP LINOUT ;AND OUTPUT LINE
|
||
|
||
;INPUT A CHARACTER FROM TERMINAL OR COMMAND FILE
|
||
GETCHR::TST CMDBUF ;COMMAND FILE OPEN?
|
||
BNE 1$ ;YES
|
||
JSR PC,INCHR ;NO, GET CHARACTER FROM TERMINAL
|
||
BR 4$
|
||
1$: CMP CMDPTR,CMDEND ;END OF BLOCK?
|
||
BNE 2$ ;NO
|
||
JSR PC,GETCBK ;YES, GET NEXT ONE
|
||
BR GETCHR ;AND START AGAIN
|
||
2$: MOVB @CMDPTR,R0 ;GET NEXT CHARACTER
|
||
BNE 3$ ;NOT NULL
|
||
INC CMDPTR ;NULL, SKIP IT
|
||
BR 1$
|
||
3$: INC CMDPTR ;OTHERWISE, INC POINTER AND RETURN
|
||
JSR PC,OUTCHR ;AND ECHO CHARACTER
|
||
CMP R0,#EOLCHR ;END-OF-LINE FROM COMMAND FILE
|
||
BNE 4$ ;NO
|
||
SAVE 0
|
||
JSR PC,NXTLIN ;YES, CHECK FOR END-OF-PAGE
|
||
RESTOR 0
|
||
4$: TST SCRIPT ;SCRIPT?
|
||
BNE SCRCHR ;YES, QUEUE CHARACTER FOR SCRIPTING
|
||
RTS PC ;NO, JUST RETURN
|
||
|
||
;QUEUE A CHARACTER IN R0 FOR SCRIPTING AND RETURN IT
|
||
SCRCHR::MOVB R0,@SCRPTR ;QUEUE IT
|
||
INC SCRPTR ;UPDATE POINTER
|
||
CMP SCRPTR,SCREND ;END OF BUFFER?
|
||
BNE 1$ ;NO
|
||
SAVE 0 ;DON'T LOSE CHARACTER
|
||
JSR PC,PUTPBK ;OUTPUT THE PRINT FILE BLOCK
|
||
RESTOR 0 ;RETRIEVE CHARACTER
|
||
1$: RTS PC ;AND RETURN IT
|
||
|
||
EOICHR= 15 ;CARRIAGE RETURN IS NORMAL END OF INPUT
|
||
|
||
;READ A NUMBER, RETURN IT IN R0, ALSO SET P$TERM IF ENDED WITH LF
|
||
GETNUM::SAVE 1
|
||
CLR R1 ;ACCUMULATE NUMBER HERE
|
||
1$: JSR PC,INCHR ;GET THE NEXT CHARACTER
|
||
CMP R0,#'0 ;IS IT A DIGIT?
|
||
BLT 2$ ;NO
|
||
CMP R0,#'9
|
||
BGT 2$ ;NO
|
||
MUL #10.,R1 ;YES, DECIMAL SHIFT PREVIOUS NUMBER
|
||
SUB #'0,R0
|
||
ADD R0,R1 ;AND ADD IN NEW DIGIT
|
||
BR 1$ ;LOOP
|
||
2$: CMP R0,#EOICHR ;IS THE CHARACTER A CARRIAGE RETURN?
|
||
BEQ 3$ ;YES
|
||
MOV #1,P$TERM ;NO, SET VT100 TERMINAL TYPE
|
||
BR 4$
|
||
3$: JSR PC,INCHR ;GET REST OF LINE AND IGNORE IT
|
||
4$: CMP R0,#EOLCHR
|
||
BNE 3$
|
||
MOV R1,R0 ;RETURN NUMBER
|
||
RESTOR 1
|
||
RTS PC
|
||
|
||
;OUTPUT A NUMBER IN R0, RETURNS NUMBERS OF CHARACTERS USED
|
||
OUTNUM::SAVE 12
|
||
CLR R2 ;COUNT CHARACTERS HERE
|
||
MOV R0,R1
|
||
BGE 1$ ;NEGATIVE?
|
||
NEG R1 ;YES, POSITIVIZE IT
|
||
MOV #'-,R0 ;PRINT A MINUS SIGN
|
||
INC R2
|
||
JSR PC,OUTCHR
|
||
1$: MOV #-1,-(SP) ;MARKER END-OF-LIST
|
||
2$: CLR R0
|
||
DIV #10.,R0 ;EXTRACT NEXT DIGIT
|
||
SAVE 1 ;SAVE IT
|
||
MOV R0,R1
|
||
BNE 2$ ;LOOP UNTIL ZERO QUOTIENT
|
||
3$: RESTOR 0 ;GET NEXT DIGIT
|
||
BLT 4$ ;STOP WHEN MARKER REACHED
|
||
ADD #'0,R0 ;PRINT IT
|
||
JSR PC,OUTCHR
|
||
INC R2
|
||
BR 3$ ;LOOP THROUGH ALL DIGITS
|
||
4$: MOV R2,R0 ;RETURN NUMBER OF CHARACTERS PRINTED
|
||
RESTOR 21
|
||
RTS PC
|
||
|
||
;RAD50 CONVERSION TABLE
|
||
.PSECT STRING
|
||
R50TAB::.ASCII <0>/ABCDEFGHIJKLMNOPQRSTUVWXYZ$.%0123456789/
|
||
.PSECT CODE
|
||
|
||
;OUTPUT A RAD50 NUMBER IN R0
|
||
OUTR50::SAVE 1
|
||
MOV R0,R1
|
||
CLR R0
|
||
DIV #50,R0 ;EXTRACT LAST CHARACTER
|
||
SAVE 1
|
||
MOV R0,R1
|
||
CLR R0
|
||
DIV #50,R0 ;SEPARATE FIRST TWO CHARACTERS
|
||
JSR PC,1$ ;PRINT FIRST ONE
|
||
MOV R1,R0
|
||
JSR PC,1$ ;AND SECOND ONE
|
||
RESTOR 01 ;FALL THROUGH TO PRINT THIRD
|
||
1$: MOVB R50TAB(R0),R0 ;GET THE ASCII EQUIVALENT
|
||
BEQ 2$ ;IGNORE SPACES (ZERO IN TABLE)
|
||
JSR PC,OUTCHR ;PRINT THE CHARACTER
|
||
2$: RTS PC ;AND RETURN
|
||
.SBTTL OPERATION TABLES
|
||
|
||
|
||
.PSECT DATA
|
||
|
||
;ZERO ARGUMENT OPERATIONS
|
||
ZEROOP::OPRTRU ;176
|
||
OPRFAL ;177
|
||
OPPRNI ;178
|
||
OPPRNR ;179
|
||
OPNOOP ;180
|
||
OPSAVE ;181
|
||
OPREST ;182
|
||
OPRSTT ;183
|
||
OPRSTA ;184
|
||
OPFSTA ;185
|
||
OPQUIT ;186
|
||
OPCRLF ;187
|
||
OPUSL ;188
|
||
OPVERI ;189
|
||
0 ;190
|
||
0 ;191
|
||
|
||
;ONE ARGUMENT OPERATIONS
|
||
ONEOP:: OPQZER ;128
|
||
OPQNEX ;129
|
||
OPQFIR ;130
|
||
OPLOC ;131
|
||
OPPTSI ;132
|
||
OPINC ;133
|
||
OPDEC ;134
|
||
OPPRNB ;135
|
||
0 ;136
|
||
OPREMO ;137
|
||
OPPRND ;138
|
||
OPRETU ;139
|
||
OPJUMP ;140
|
||
OPPRIN ;141
|
||
OPVALU ;142
|
||
OPBCOM ;143
|
||
|
||
;TWO ARGUMENT AND EXTENDED ARGUMENT OPERATIONS
|
||
EXTOP:: 0 ;0
|
||
OPQEQU ;1
|
||
OPQLES ;2
|
||
OPQGRT ;3
|
||
OPQDLE ;4
|
||
OPQIGR ;5
|
||
OPQIN ;6
|
||
OPBTST ;7
|
||
OPBOR ;8
|
||
OPBAND ;9
|
||
OPQFSE ;10
|
||
OPFSET ;11
|
||
OPFCLE ;12
|
||
OPSET ;13
|
||
OPMOVE ;14
|
||
OPGET ;15
|
||
OPGETB ;16
|
||
OPGETP ;17
|
||
OPGTPT ;18
|
||
OPNEXT ;19
|
||
OPADD ;20
|
||
OPSUB ;21
|
||
OPMUL ;22
|
||
OPDIV ;23
|
||
OPMOD ;24
|
||
.REPT 7
|
||
0 ;25-31
|
||
.ENDR
|
||
OPCALL ;224
|
||
OPPUT ;225
|
||
OPPUTB ;226
|
||
OPPUTP ;227
|
||
OPREAD ;228
|
||
OPPRNC ;229
|
||
OPPRNN ;230
|
||
OPRAND ;231
|
||
OPPUSH ;232
|
||
OPPOP ;233
|
||
.REPT 22.
|
||
0 ;234-255
|
||
.ENDR
|
||
|
||
.PSECT CODE
|
||
.SBTTL TOP LEVEL STUFF
|
||
|
||
|
||
PVERS1= 0 ;POSITION OF ZVERSION VERSION BYTE
|
||
PVERS2= 1 ;ZVERSION MODE BYTE
|
||
PZRKID= 2 ;ZORKID
|
||
PENDLD= 4 ;ENDLOD
|
||
PSTART= 6 ;START
|
||
PVOCTB= 10 ;VOCAB
|
||
POBJTB= 12 ;OBJECT
|
||
PGLOTB= 14 ;GLOBALS
|
||
PPURBT= 16 ;PURBOT
|
||
PFLAGS= 20 ;USER FLAG WORD
|
||
PSERNM= 22 ;SERIAL NUMBER (6 BYTES)
|
||
PWRDTB= 30 ;WORDS
|
||
PLENTH= 32 ;LENGTH (IN WORDS)
|
||
PCHKSM= 34 ;CHECKSUM (ALL BYTES STARTING AT 100 OCTAL)
|
||
LSTACK= 1000 ;LENGTH OF USER STACK (MUST BE 1 PAGE FOR NOW)
|
||
LMOUTB= 132. ;MAX LENGTH OF OUTBUF, EXCLUDING TERMINAL 0
|
||
LDOUTB= 80. ;DEFAULT LENGTH OF OUTBUF
|
||
LPAGES= 140 ;MAX NUMBER OF PAGES EXPECTED
|
||
LXBYTS= LSTACK+LMOUTB+<4*LPAGES>+2000 ;LENGTH OF EXTRA BYTES NEEDED
|
||
|
||
.PSECT STRING
|
||
.NLIST BEX
|
||
IRBRKS::.ASCIZ <40><11><15><14>/.,?/ ;INITIAL SET OF READ BREAK CHARS
|
||
.LIST BEX
|
||
.PSECT CODE
|
||
|
||
|
||
;INITIALIZATION
|
||
.ENABL LSB
|
||
START:: DEFVAR TOPSP ;TOP LEVEL STACK POINTER
|
||
MOV SP,TOPSP ;SAVE FOR LATER
|
||
JSR PC,SYSINI ;DO ANY SYSTEM INITIALIZATION
|
||
MOV P$LINE,R0 ;CHECK FOR LINE LENGTH
|
||
BNE 1$ ;GOT IT ALREADY
|
||
PRIN1 <Line width (default is 80, end with LF for status line): >
|
||
JSR PC,GETNUM ;GET IT
|
||
TST R0 ;USE DEFAULT?
|
||
BNE 1$ ;NO
|
||
MOV #LDOUTB,R0 ;YES, INSERT THAT
|
||
1$: CMP R0,#LMOUTB ;NUMBER HIGHER THAN MAX ALLOWED?
|
||
BLOS 2$ ;NO
|
||
MOV #LMOUTB,R0 ;YES, USE MAX INSTEAD
|
||
2$: DEFVAR TWIDTH ;TERMINAL WIDTH
|
||
MOV R0,TWIDTH ;SAVE IT
|
||
|
||
3$: JSR PC,GETMEM ;GET ALL THE MEMORY WE CAN
|
||
CMP R0,#BUFFER+1000 ;IS THERE ENOUGH FOR FIRST PAGE?
|
||
BHI 5$ ;YES
|
||
4$: FATAL <Insufficient memory> ;NO, DIE
|
||
5$: DEFVAR MEMTOP ;LAST AVAILABLE LOCATION
|
||
MOV R0,MEMTOP
|
||
JSR PC,OPNGAM ;OPEN GAME FILE
|
||
CLR R0 ;BLOCK 0
|
||
MOV #BUFFER,R1 ;PUT AT BEGINNING OF BUFFER
|
||
JSR PC,GETBLK ;GET THE BLOCK
|
||
CMPB BUFFER+PVERS1,#ZMVERS ;PROPER Z-MACHINE VERSION?
|
||
BNE 6$ ;NO
|
||
BITB #1,BUFFER+PVERS2 ;YES, PROPER MODE BITS?
|
||
BEQ 7$ ;YES
|
||
6$: FATAL <Wrong game version> ;SOMETHING WRONG, DIE
|
||
7$: TST P$TERM ;STATUS LINE REQUESTED?
|
||
BNE 8$ ;YES
|
||
BISB #20,BUFFER+PVERS2 ;NO, SET NO-STATUS-LINE BIT
|
||
BR 10$
|
||
8$: JSR PC,SETERM ;SET UP TERMINAL TABLE FOR PROPER TYPE
|
||
MOV TRMINI,R0 ;BEGIN TO SET UP STATUS LINE
|
||
JSR PC,OUTSTR
|
||
DEFVAR TIMEMD ;TIME-(VERSUS SCORE)-MODE-FOR-STATUS-LINE FLAG
|
||
MOV TRMINS,R0 ;GET STRING FOR SCORE (INITIAL ASSUMPTION)
|
||
BITB #2,BUFFER+PVERS2 ;TIME MODE REQUESTED?
|
||
BEQ 9$ ;NO
|
||
INC TIMEMD ;YES, SET TIME-MODE FLAG
|
||
MOV TRMINT,R0 ;& USE TIME STRING INSTEAD
|
||
9$: JSR PC,OUTSTR ;DISPLAY IT, NOW
|
||
10$: DEFVAR ZORKID ;UNIQUE GAME & VERSION IDENTIFIER
|
||
MOV #BUFFER+PZRKID,R0
|
||
JSR PC,GTAWRD
|
||
MOV R0,ZORKID
|
||
MOV #BUFFER+PENDLD,R0 ;GET ENDLOD POINTER
|
||
JSR PC,GTAWRD
|
||
BIT #777,R0 ;ROUND UP TO NEXT BLOCK
|
||
BEQ 11$
|
||
BIC #777,R0
|
||
ADD #1000,R0
|
||
11$: MOV R0,R2
|
||
ADD #BUFFER+LXBYTS,R0 ;CALCULATE MINIMUM TOP OF MEMORY NEEDED
|
||
CMP R0,MEMTOP
|
||
BHI 4$ ;NOT ENOUGH MEMORY, DIE
|
||
ASH #-9.,R2 ;EXTRACT ENDLOD BLOCK
|
||
DEFVAR ENDLOD ;ENDLOD BLOCK NUMBER
|
||
MOV R2,ENDLOD ;SAVE IT
|
||
DEC R2 ;NUMBER OF BLOCKS LEFT TO LOAD
|
||
MOV #1,R0 ;STARTING WITH BLOCK 1
|
||
MOV #BUFFER+1000,R1 ;LOCATION TO PUT THEM
|
||
JSR PC,GTBLKS ;GET THE BLOCKS
|
||
MOV #BUFFER+PVOCTB,R0 ;VOCAB LOCATION
|
||
JSR PC,GTAWRD ;GET IT
|
||
ADD #BUFFER,R0 ;ABSOLUTIZE IT
|
||
DEFVAR VOCTAB ;SAVE VOCABULARY TABLE POINTER
|
||
MOV R0,VOCTAB
|
||
MOV #BUFFER+POBJTB,R0 ;GET OBJECT TABLE POINTER
|
||
JSR PC,GTAWRD
|
||
ADD #BUFFER,R0
|
||
DEFVAR OBJTAB
|
||
MOV R0,OBJTAB
|
||
MOV #BUFFER+PGLOTB,R0 ;GET GLOBAL TABLE POINTER
|
||
JSR PC,GTAWRD
|
||
ADD #BUFFER,R0
|
||
DEFVAR GLOTAB
|
||
MOV R0,GLOTAB
|
||
MOV #BUFFER+PWRDTB,R0 ;GET WORD TABLE POINTER
|
||
JSR PC,GTAWRD
|
||
ADD #BUFFER,R0
|
||
DEFVAR WRDTAB
|
||
MOV R0,WRDTAB
|
||
MOV #BUFFER+PPURBT,R0 ;GET PURE CODE POINTER
|
||
JSR PC,GTAWRD
|
||
BIT #777,R0 ;ROUND UP TO NEXT BLOCK
|
||
BEQ 12$
|
||
ADD #1000,R0
|
||
12$: ASH #-9.,R0 ;EXTRACT BLOCK NUMBER
|
||
BIC #^C177,R0 ;CLEAR UNWANTED BITS
|
||
DEFVAR PURBOT
|
||
MOV R0,PURBOT ;SAVE IT
|
||
MOV ENDLOD,R5 ;CALCULATE BEGINNING OF FREE MEMORY
|
||
ASH #9.,R5
|
||
ADD #BUFFER,R5
|
||
DEFVAR STKBOT ;BOTTOM OF STACK
|
||
MOV R5,STKBOT ;IS HERE
|
||
ADD #LSTACK,R5 ;ADD LENGTH OF USER STACK & INIT USER SP
|
||
MOV R5,OUTBUF ;ALSO START OF OUTPUT BUFFER
|
||
MOV R5,R1
|
||
ADD TWIDTH,R1 ;ADD LENGTH OF BUFFER
|
||
MOV R1,ENDBUF ;THIS IS ENDBUF POINTER
|
||
CLRB (R1)+ ;BUFFER IS FOLLOWED BY A 0 FOR CONVENIENCE
|
||
DEFVAR RBRKS ;POINTER TO STRING OF READ BREAK CHARACTERS
|
||
DEFVAR ESIBKS ;END OF SELF-INSERTING BREAK CHARACTERS
|
||
MOV R1,RBRKS ;STRING STARTS HERE
|
||
MOV VOCTAB,R2
|
||
MOVB (R2)+,R0 ;FIRST BYTE IN VOCTAB IS NUMBER OF SIBREAKS
|
||
13$: MOVB (R2)+,(R1)+ ;TRANSFER THEM
|
||
SOB R0,13$
|
||
MOV R1,ESIBKS ;REMEMBER END OF SI BREAKS
|
||
MOV #IRBRKS,R3 ;ALWAYS END WITH INITIAL BREAK CHARACTERS
|
||
14$: MOVB (R3)+,(R1)+
|
||
BNE 14$
|
||
DEFVAR VWLEN ;NUMBER OF BYTES IN A VOCABULARY WORD ENTRY
|
||
MOVB (R2)+,VWLEN ;BYTE FOLLOWS SIBREAKS
|
||
MOV R2,R0
|
||
JSR PC,GTAWRD ;GET NEXT WORD IN TABLE
|
||
DEFVAR VWORDS ;IT'S THE NUMBER OF WORD ENTRIES IN VOCABULARY
|
||
MOV R0,VWORDS
|
||
ADD #2,R2 ;MOVE TO NEXT WORD
|
||
DEFVAR VOCBEG ;THIS IS BEGINNING OF ACTUAL VOCABULARY
|
||
MOV R2,VOCBEG
|
||
BIT #1,R1 ;MAKE SURE PAGES START ON WORD BOUNDARY
|
||
BEQ 15$
|
||
INC R1
|
||
15$: DEFVAR PAGTAB ;PAGE INFORMATION TABLE
|
||
MOV R1,PAGTAB ;STARTS HERE
|
||
MOV R1,R2
|
||
NEG R2 ;CALCULATE NUMBER OF PAGES AVAILABLE
|
||
ADD MEMTOP,R2
|
||
ASH #-9.,R2
|
||
BIC #^C177,R2
|
||
MOV R2,BUFPGS ;SAVE NUMBER OF PAGES FOR EXTERNAL REFERENCE
|
||
ASL R2 ;CALCULATE NUMBER OF 4-BYTE TABLE ENTRIES
|
||
INC R2 ;PLUS ONE WORD FOR END-OF-TABLE MARKER
|
||
ASL R2
|
||
ADD R1,R2 ;ADD TO TABLE POINTER
|
||
DEFVAR PAGES ;PAGES THEMSELVES START AFTER TABLE
|
||
MOV R2,PAGES
|
||
NEG R2 ;RECALCULATE NUMBER OF PAGES (MAY BE ONE LESS)
|
||
ADD MEMTOP,R2
|
||
ASH #-9.,R2
|
||
BIC #^C177,R2
|
||
ASL R2 ;FIND END OF TABLE
|
||
ASL R2
|
||
ADD R1,R2
|
||
MOV #-1,(R2) ;SET MARKER
|
||
16$: MOV #376,(R1)+ ;INITIALIZE TABLE
|
||
CLR (R1)+
|
||
CMP R1,R2
|
||
BNE 16$
|
||
JSR PC,GETIME ;GET THE CURRENT TIME-OF-DAY
|
||
MOV TIME+2,RSEED ;USE IT TO INITIALIZE RANDOM NUMBER SEED
|
||
BR START1
|
||
.DSABL LSB
|
||
|
||
;RESTART EXECUTION HERE
|
||
RESTRT::CLR R0 ;REREAD ALL OF THE IMPURE STUFF
|
||
MOV #BUFFER,R1
|
||
MOV PURBOT,R2
|
||
JSR PC,GTBLKS
|
||
START1: MOV TOPSP,SP ;INITIALIZE OUR STACK POINTER
|
||
MOV OUTBUF,R5 ;INITIALIZE USER STACK POINTER
|
||
MOV OUTBUF,CHRPTR ;INITIALIZE OUTPUT CHARACTER POINTER
|
||
DEFVAR ZLOCS ;POINTER TO LOCALS
|
||
MOV R5,ZLOCS ;THEY WOULD START AT FIRST SLOT,
|
||
SUB #2,ZLOCS ;IF THERE WERE ANY
|
||
MOV #BUFFER+PSTART,R0 ;GET STARTING LOCATION
|
||
JSR PC,GTAWRD
|
||
JSR PC,BSPLTB ;SPLIT BLOCK & BYTE POINTERS
|
||
DEFVAR ZPC1 ;ZPC BLOCK-POINTER
|
||
DEFVAR ZPC2 ;ZPC BYTE-POINTER
|
||
MOV R0,ZPC1 ;INITIALIZE THEM
|
||
MOV R1,ZPC2
|
||
JSR PC,NEWZPC ;GET PAGE TO EXECUTE
|
||
|
||
;MAIN INSTRUCTION INTERPRETATION LOOP
|
||
.ENABL LSB
|
||
NXTINS::JSR PC,NXTBYT ;GET THE OPERATION BYTE
|
||
MOV R0,R3 ;SAVE A COPY
|
||
CMP R0,#200 ;IS IT A 2OP?
|
||
BLT 9$ ;YES
|
||
CMP R0,#260 ;NO, IS IT A 1OP?
|
||
BLT 12$ ;YES
|
||
CMP R0,#300 ;NO, IS IT A 0OP?
|
||
BLT 13$ ;YES
|
||
BIC #^C77,R0 ;NO, IT'S EXTENDED, GET THE OPCODE
|
||
ASL R0 ;MAKE IT A WORD OFFSET
|
||
MOV EXTOP(R0),R4 ;GET THE OPERATOR POINTER
|
||
BEQ 14$ ;NO SUCH OPERATION
|
||
JSR PC,NXTBYT ;GET THE ARGUMENT BYTE
|
||
MOV #4,R2 ;SPLIT IT INTO 4 2-BIT MODE BYTES
|
||
1$: SAVE 0
|
||
ASR R0
|
||
ASR R0
|
||
SOB R2,1$
|
||
MOV #4,R3 ;RETRIEVE THE 4 BYTES IN PROPER ORDER
|
||
DEFVAR ARGBLK,<.BLKW 5> ;ARGUMENT BLOCK FOR EXTENDED OPERATIONS
|
||
MOV #ARGBLK+2,R1 ;FIRST ARGUMENT SLOT
|
||
2$: RESTOR 0 ;GET NEXT MODE BYTE?
|
||
BIC #^C3,R0 ;CLEAR OFF UNWANTED BITS
|
||
CMP R0,#3 ;NO MORE ARGUMENTS?
|
||
BEQ 4$ ;YES, FLUSH ANY OTHER MODE BYTES
|
||
JSR PC,GETARG ;ELSE, GET THE NEXT ARGUMENT
|
||
MOV R0,(R1)+ ;SAVE IT IN ARGUMENT BLOCK
|
||
INC R2 ;REMEMBER NUMBER OF ARGS GOTTEN
|
||
3$: SOB R3,2$ ;LOOP FOR REST OF MODE BYTES
|
||
BR 5$
|
||
4$: DEC R3 ;DETERMINE NUMBER OF REMAINING MODE BYTES
|
||
ASL R3 ;WORD COUNT
|
||
ADD R3,SP ;FLUSH THEM
|
||
5$: MOV #ARGBLK,R0 ;POINTER GOES HERE FOR OPERATOR TO USE
|
||
MOV R2,(R0) ;SAVE NUMBER OF ARGS TO BE PASSED
|
||
CMP (R4),#NOP ;DOES OPERATOR WANT ARGBLK POINTER?
|
||
BEQ 15$ ;YES, CALL OPERATOR NOW
|
||
DEC R2 ;NO, IT WANTS ARGS IN REGISTERS
|
||
BLT 15$ ;NO ARGS, JUST CALL OPERATOR
|
||
BEQ 8$ ;1 ARG, GET IT
|
||
SUB #2,R2
|
||
BLT 7$ ;2 ARGS
|
||
BEQ 6$ ;3 ARGS
|
||
MOV ARGBLK+10,R3 ;ELSE, 4 ARGS, GET 4TH
|
||
6$: MOV ARGBLK+6,R2 ;GET 3RD
|
||
7$: MOV ARGBLK+4,R1 ;GET 2ND
|
||
8$: MOV ARGBLK+2,R0 ;GET FIRST ARG
|
||
BR 15$ ;AND CALL OPERATOR
|
||
9$: BIC #^C37,R0 ;2OP, EXTRACT OPERATION BITS
|
||
ASL R0 ;MAKE IT A WORD OFFSET
|
||
MOV EXTOP(R0),R4 ;FIND POINTER TO OPERATOR ROUTINE
|
||
BEQ 14$ ;NO SUCH OPERATION
|
||
MOV #1,R0 ;ASSUME FIRST ARG IS AN IMMEDIATE
|
||
BIT #100,R3 ;IS IT INSTEAD A VARIABLE?
|
||
BEQ 10$ ;NO
|
||
INC R0 ;YES, CHANGE MODE
|
||
10$: JSR PC,GETARG ;GET THE FIRST ARG
|
||
SAVE 0 ;SAVE IT
|
||
MOV #1,R0 ;ASSUME SECOND ARG IS AN IMMEDIATE
|
||
BIT #40,R3 ;IS IT INSTEAD A VARIABLE?
|
||
BEQ 11$ ;NO
|
||
INC R0 ;YES, CHANGE MODE
|
||
11$: JSR PC,GETARG ;GET THE SECOND ARG
|
||
MOV R0,R1 ;POSITION IT
|
||
RESTOR 0 ;RECOVER FIRST ARG
|
||
CMP (R4),#NOP ;DOES ROUTINE WANT ARGUMENT BLOCK?
|
||
BNE 15$ ;NO, GO CALL IT
|
||
MOV #ARGBLK+6,R2 ;YES, MOVE ARGS TO ARGBLK
|
||
MOV R1,-(R2)
|
||
MOV R0,-(R2)
|
||
MOV #2,-(R2) ;ALWAYS 2 ARGS
|
||
MOV R2,R0
|
||
BR 15$ ;NOW CALL OPERATOR
|
||
12$: BIC #^C17,R3 ;1OP, EXTRACT OPERATION BITS
|
||
ASL R3 ;MAKE IT A WORD OFFSET
|
||
MOV ONEOP(R3),R4 ;GET OPERATOR ROUTINE POINTER
|
||
BEQ 14$ ;ILLEGAL OPERATION
|
||
.REPT 4 ;EXTRACT MODE BITS
|
||
ASR R0
|
||
.ENDR
|
||
BIC #^C3,R0
|
||
JSR PC,GETARG ;GET THE ARGUMENT
|
||
BR 15$ ;AND CALL OPERATOR
|
||
13$: BIC #^C17,R0 ;0OP, EXTRACT OPERATION BITS
|
||
ASL R0 ;MAKE IT A WORD OFFSET
|
||
MOV ZEROOP(R0),R4 ;GET OPERATOR ROUTINE POINTER
|
||
BNE 15$ ;IT'S A LEGAL OPERATION
|
||
14$: FATAL <Illegal operation> ;OTHERWISE, COMPLAIN
|
||
15$: JSR PC,(R4) ;CALL THE OPERATOR ROUTINE
|
||
JMP NXTINS ;AND LOOP FOR NEXT INSTRUCTION
|
||
.DSABL LSB
|
||
.SBTTL PAGING ROUTINES
|
||
|
||
|
||
;NORMALIZE ZPC & GET PROPER PAGE
|
||
DEFVAR CURPAG ;CURRENT PAGE (WHERE ZPC IS) POINTER
|
||
DEFVAR CURBLK ;CURRENT BLOCK, USUALLY SAME AS ZPC1
|
||
DEFVAR CURTAB ;CURRENT PAGE TABLE POINTER +1
|
||
NEWZPC::SAVE 123
|
||
CLR R0 ;USE DOUBLE-WORD ARITHMETIC
|
||
MOV ZPC1,R1 ;GET BLOCK-POINTER
|
||
SWAB R1 ;POSITION IT
|
||
BIC #377,R1
|
||
ASL R1
|
||
ADC R0
|
||
MOV ZPC2,R3 ;GET BYTE-OFFSET
|
||
SXT R2 ;DOUBLE-WORDIFY IT (MIGHT BE NEGATIVE)
|
||
ADD R3,R1 ;ADD IT TO OTHER DOUBLE WORD
|
||
ADC R0
|
||
ADD R2,R0
|
||
MOV R1,R2
|
||
BIC #^C777,R2 ;EXTRACT BYTE-OFFSET
|
||
MOV R2,ZPC2 ;SAVE IT
|
||
ASH #-9.,R1 ;EXTRACT BLOCK-POINTER
|
||
BIC #^C177,R1
|
||
BIT #1,R0 ;TEST 17TH BIT
|
||
BEQ 1$ ;WAS 0
|
||
BIS #200,R1 ;WAS 1, SET PROPER BIT IN BLOCK-POINTER
|
||
1$: MOV R1,ZPC1 ;SAVE IT
|
||
CMP R1,CURBLK ;HAS IT CHANGED?
|
||
BEQ 5$ ;NO
|
||
MOV R1,CURBLK ;YES, REMEMBER NEW BLOCK
|
||
MOV CURTAB,R0 ;IS OLD PAGE IN PAGING SPACE?
|
||
BEQ 2$ ;NO
|
||
MOVB RTIME1,(R0)+ ;YES, STORE CURRENT REF TIME FOR OLD PAGE
|
||
MOV RTIME2,(R0)
|
||
2$: CMP R1,ENDLOD ;NEW PAGE ALREADY IN CORE?
|
||
BLT 3$ ;YES
|
||
MOV R1,R0 ;NO, GET NEW PAGE
|
||
JSR PC,GETPAG
|
||
MOV R0,R1
|
||
MOV LPTAB,R0 ;GET NEW PAGE TABLE POINTER
|
||
INC R0 ;POINT TO REF SLOT
|
||
MOV R0,CURTAB ;SAVE THIS POINTER FOR LATER
|
||
MOVB #-1,(R0)+ ;STORE HIGHEST RTIME TO KEEP PAGE FOR US
|
||
MOV #-1,(R0)
|
||
BR 4$
|
||
3$: ASH #9.,R1 ;CALCULATE PAGE ADDRESS
|
||
ADD #BUFFER,R1
|
||
CLR CURTAB ;CLEARING POINTER MEANS PAGE IS PRELOADED
|
||
4$: MOV R1,CURPAG ;UPDATE PAGE POINTER
|
||
5$: RESTOR 321
|
||
RTS PC ;AND RETURN
|
||
|
||
;GET THE PAGE WHOSE NUMBER IS IN R0, RETURN A POINTER TO IT IN R0
|
||
DEFVAR RTIME1 ;REFERENCE TIME, 1 1/2 WORDS USED
|
||
DEFVAR RTIME2
|
||
DEFVAR LPAGE ;LAST REFERENCED PAGE NUMBER
|
||
DEFVAR LPLOC ;AND ITS CORE LOCATION
|
||
DEFVAR LPTAB ;AND ITS TABLE POINTER
|
||
GETPAG::CMP R0,LPAGE ;IS THIS THE SAME PAGE AS LAST REFERENCED?
|
||
BNE 1$ ;NO
|
||
MOV LPLOC,R0 ;YES, WE ALREADY HAVE LOCATION
|
||
RTS PC ;RETURN IT
|
||
1$: MOV R0,LPAGE ;SAVE NEW PAGE NUMBER
|
||
SAVE 1
|
||
ADD #1,RTIME2 ;UPDATE REFERENCE TIME (COUNT)
|
||
ADC RTIME1
|
||
MOV PAGTAB,R1 ;PAGE INFORMATION TABLE
|
||
2$: CMPB R0,(R1)+ ;SEARCH FOR DESIRED BLOCK
|
||
BNE 4$ ;NOT IT
|
||
CMP R0,CURBLK ;FOUND IT, BUT IS IT THE CURRENT CODE PAGE?
|
||
BEQ 3$ ;YES, DON'T TOUCH REFERENCE TIME
|
||
MOVB RTIME1,(R1)+ ;NO, UPDATE ITS REFERENCE TIME
|
||
MOV RTIME2,(R1)+
|
||
SUB #3,R1 ;BACKUP TO BEGINNING OF TABLE ENTRY
|
||
3$: DEC R1 ;ONE MORE BYTE FOR GOOD MEASURE
|
||
MOV R1,LPTAB ;SAVE IT
|
||
SUB PAGTAB,R1 ;CALCULATE ADDRESS OF PAGE
|
||
ASH #7,R1
|
||
ADD PAGES,R1
|
||
BR 5$ ;AND RETURN PAGE POINTER
|
||
4$: ADD #3,R1 ;SKIP REFERENCE TIME
|
||
CMP (R1),#-1 ;END OF TABLE?
|
||
BNE 2$ ;NO, CONTINUE SEARCH
|
||
JSR PC,FINDPG ;YES, FIND A PAGE TO LOAD INTO
|
||
SAVE 0 ;PAGE POINTER
|
||
MOV R1,LPTAB ;SAVE PAGE TABLE POINTER
|
||
MOV LPAGE,R0 ;SAVE NEW BLOCK NUMBER
|
||
MOVB R0,(R1)+
|
||
MOVB RTIME1,(R1)+ ;AND CURRENT REF TIME
|
||
MOV RTIME2,(R1)
|
||
RESTOR 1 ;PAGE POINTER
|
||
JSR PC,GETBLK ;GET THE BLOCK
|
||
5$: MOV R1,R0 ;RETURN PAGE POINTER
|
||
MOV R0,LPLOC ;AND SAVE IT FOR LATER
|
||
RESTOR 1
|
||
RTS PC
|
||
|
||
;FIND A GOOD PAGE, RETURN PAGE POINTER IN R0 & PAGTAB POINTER IN R1
|
||
FINDPG::SAVE 23
|
||
MOV PAGTAB,R0
|
||
MOV #-1,R2 ;FAKE BEST-CASE REFERENCE COUNT
|
||
MOV R2,R3
|
||
INC R0 ;SKIP BLOCK NUMBER FOR NOW
|
||
1$: CMPB (R0)+,R2 ;IS THIS REF TIME WORSE THAN CURRENT WORST?
|
||
BHI 3$ ;NO
|
||
BLO 2$ ;YES
|
||
CMP (R0),R3 ;MAYBE, COMPARE LOW-ORDER WORDS, WORSE?
|
||
BHIS 3$ ;NO
|
||
2$: MOVB -1(R0),R2 ;YES, SAVE ITS REF COUNT
|
||
MOV (R0),R3
|
||
MOV R0,R1 ;AND LOCATION (+2)
|
||
3$: TST (R0)+ ;SKIP SECOND WORD
|
||
CMPB (R0)+,#-1 ;LOOP UNTIL END-OF-TABLE
|
||
BNE 1$
|
||
INC R2 ;WAS A PAGE REALLY FOUND?
|
||
BEQ 4$ ;NO, GROSS BUG!
|
||
TST -(R1) ;YES, CALCULATE CORE LOCATION OF PAGE
|
||
MOV R1,R0
|
||
SUB PAGTAB,R0
|
||
ASH #7,R0
|
||
ADD PAGES,R0
|
||
RESTOR 32
|
||
RTS PC
|
||
4$: FATAL <No free pages>
|
||
.SBTTL TERMINAL-SPECIFIC STUFF
|
||
|
||
|
||
.MACRO STRING STR ;CREATE A STRING & POINT TO IT
|
||
.SAVE
|
||
.PSECT STRING
|
||
$$$=.
|
||
.ASCII STR
|
||
.RESTOR
|
||
.WORD $$$
|
||
.ENDM STRING
|
||
|
||
|
||
.PSECT STRING
|
||
NULSTR: .ASCII <200> ;NULL STRING
|
||
|
||
.PSECT DATA ;TABLES OF TERMINAL COMMAND STRINGS
|
||
.NLIST BEX
|
||
|
||
;TABLE OF POINTERS FOR TERMINAL IN USE, OTHERS ARE FORMATTED SAME WAY
|
||
TRMINI: .WORD 0 ;INITIALIZE TERMINAL
|
||
TRMINS: .WORD 0 ;INITIALIZATION FOR SCORE LINE
|
||
TRMINT: .WORD 0 ;INITIALIZATION FOR TIME LINE
|
||
SAVPOS: .WORD 0 ;SAVE OLD POSITION & CHANGE ATTRIBUTES
|
||
SCRPOS: .WORD 0 ;GO TO SCORE POSITION
|
||
TIMPOS: .WORD 0 ;GO TO TIME POSITION
|
||
LOCPOS: .WORD 0 ;GO TO LOCATION POSITION
|
||
CLRROL: .WORD 0 ;CLEAR REST OF LINE
|
||
RETPOS: .WORD 0 ;RETURN TO OLD POSITION
|
||
TRMUNI: .WORD 0 ;UNINITIALIZATION STRING
|
||
|
||
;VT100 TABLE (P$TERM=1)
|
||
VT100: STRING ^"<15><233>/</<233>/[2;24r/<233>/[J/<233>/#6/<233>/[4m/<200>"
|
||
STRING ^"\Score: \<233>/[m/<0>"
|
||
STRING ^"\Time: \<233>/[m/<0>"
|
||
STRING ^"<233>/7/<233>/[4m/<200>"
|
||
STRING ^"<233>/[;8f/<200>"
|
||
STRING ^"<233>/[;7f/<200>"
|
||
STRING ^"/ /"
|
||
STRING ^"<233>/[K/<200>"
|
||
STRING ^"<233>/8/<15><200>"
|
||
STRING ^"<233>/7/<233>/[r/<233>/8/<233>/[?2l/<0>"
|
||
|
||
;VT52 TABLE (P$TERM=2)
|
||
VT52: STRING ^"<233>/H/<233>/J/<233>/Y/<55.><32.><200>"
|
||
NULSTR
|
||
NULSTR
|
||
NULSTR
|
||
STRING ^"<233>/H/<233>/K/<233>/Y/<32.><91.>/Score: /<200>"
|
||
STRING ^"<233>/H/<233>/K/<233>/Y/<32.><91.>/Time: /<200>"
|
||
STRING ^"<15>/[/<200>"
|
||
STRING ^"/]/<15><12><233>/K/<200>"
|
||
STRING ^"<233>/Y/<55.><32.><200>"
|
||
NULSTR
|
||
|
||
.LIST BEX
|
||
.PSECT CODE
|
||
|
||
;SELECT PROPER TERMINAL TABLE
|
||
SETERM: SAVE 12
|
||
MOV #TRMINI,R0
|
||
MOV #VT100,R1 ;ASSUME VT100 FIRST
|
||
CMP P$TERM,#1 ;CORRECT?
|
||
BEQ 1$ ;YES
|
||
MOV #VT52,R1 ;NO, MUST BE A VT52
|
||
1$: MOV #<VT100-TRMINI>/2,R2 ;LENGTH OF TABLE
|
||
2$: MOV (R1)+,(R0)+ ;TRANSFER PROPER TERMINAL TABLE TO GENERAL ONE
|
||
SOB R2,2$
|
||
RESTOR 21
|
||
MOV P$TERM,LINES ;INITIALIZE LINE COUNT (WORKS FOR EITHER VT!)
|
||
TST P$TSXF ;TSX SETUP NEEDED?
|
||
BEQ 3$ ;NO
|
||
MOV #35,R0 ;YES, SELECT TSX SINGLE-CHAR MODE
|
||
JSR PC,OUTCHR
|
||
MOV #'S,R0
|
||
JSR PC,OUTCHR
|
||
3$: RTS PC
|
||
.SBTTL RT-11 DEPENDENT STUFF
|
||
|
||
.IF NE RT11 ;USE THIS CODE ONLY FOR RT-11
|
||
|
||
.MCALL .PRINT,.TTYOUT,.TTYIN ;TERMINAL-RELATED CALLS
|
||
.MCALL .CSISPC,.LOOKUP,.READW,.ENTER ;FILE STUFF
|
||
.MCALL .WRITW,.CLOSE,.PURGE,.DELETE,.WRITE,.WAIT ;MORE FILE STUFF
|
||
.MCALL .DSTATUS,.SETTOP,.GTIM,.EXIT,.SERR,.QSET,.LOCK,.UNLOCK ;OTHER
|
||
|
||
|
||
GMCHAN= 5 ;GAME FILE CHANNEL NUMBER
|
||
SVCHAN= 2 ;SAVE FILE
|
||
PFCHAN= 3 ;PRINT FILE FOR SCRIPTING
|
||
CMCHAN= 4 ;COMMAND FILE
|
||
ERRBYT= 52 ;LOCATION OF ERROR BYTE
|
||
|
||
|
||
.ASECT
|
||
|
||
.=44 ;JOB STATUS WORD
|
||
.WORD 40000 ;ENABLE LOWERCASE INPUT
|
||
.WORD BUFFER ;SWAP USR OVER BEGINNING OF BUFFER
|
||
|
||
.=56 ;RSTS/E & TSX MEMORY REQUIREMENT
|
||
.WORD 34 ;ASK FOR 28K WORDS
|
||
|
||
.=400 ;EXTERNAL REFERENCE INFORMATION
|
||
.WORD BUFPGS ;POINT TO WORD FOR NUMBER OF BUFFER PAGES
|
||
.ASCII /Copyright (C) 1982, 1983 Infocom, Inc./ ;COPYRIGHT MESSAGE
|
||
.EVEN
|
||
|
||
.PSECT PARAM ;USER-SUPPLIED PARAMETERS
|
||
|
||
P$TERM::.WORD 0 ;TERMINAL TYPE
|
||
P$LINE::.WORD 0 ;NUMBER OF CHARACTERS ON A LINE, 0 MEANS ASK
|
||
P$PAGE::.WORD 0 ;LINES PER PAGE
|
||
P$TSXF::.WORD 0 ;NON-ZERO TO SET TSX SINGLE-CHAR MODE
|
||
.BLKW 9. ;FUTURE EXPANSION ROOM
|
||
;THE FOLLOWING ARE FOR INFOCOM USE ONLY
|
||
P$RAND::.WORD 0 ;NON-ZERO TO DISABLE RANDOMNESS
|
||
P$GAME::.WORD 0,0 ;GAME NAME (IN RAD50)
|
||
|
||
|
||
.PSECT DATA
|
||
|
||
BUFPGS::.WORD 0 ;NUMBER OF BUFFER PAGES
|
||
|
||
.PSECT CODE
|
||
|
||
;SYSTEM INITIALIZATION STUFF
|
||
DEFVAR QENTRY,<.BLKW 10.> ;ALLOW ROOM FOR XM MONITOR ELEMENT
|
||
SYSINI::.QSET #QENTRY,#1 ;ALLOCATE AN EXTRA QUEUE ELEMENT
|
||
.SERR ;TRAP ALL I/O ERRORS
|
||
RTS PC
|
||
|
||
;TEST FOR SCRIPTING & UPDATE FLAGS APPROPRIATELY
|
||
.ENABL LSB
|
||
DEFVAR PFNAME,<.RAD50 /LP ZIP LST/> ;DEFAULT PRINT FILE NAME
|
||
DEFVAR SCRIPT ;SCRIPT FLAG
|
||
DEFVAR PFOPEN ;PRINT FILE OPEN?
|
||
DEFVAR PFLOST ;PRINT FILE LOST AT SOME POINT?
|
||
DEFVAR SCRBUF ;CURRENT SCRIPT BUFFER
|
||
DEFVAR SCREND ;END OF BUFFER
|
||
DEFVAR SCRPTR ;CHARACTER POINTER
|
||
DEFVAR SCRBF1 ;FIRST SCRIPT BUFFER
|
||
DEFVAR SCRBF2 ;SECOND SCRIPT BUFFER
|
||
DEFVAR PFBLK ;PRINT FILE BLOCK
|
||
TSTSCR::TST PFLOST ;HAVE WE PREVIOUSLY LOST WITH PRINT FILE?
|
||
BNE 2$ ;YES, DON'T TRY AGAIN
|
||
MOV #BUFFER+PFLAGS,R0 ;GET FLAG WORD
|
||
JSR PC,GTAWRD
|
||
BIT #1,R0 ;SCRIPT FLAG SET?
|
||
BNE 1$ ;YES
|
||
CLR SCRIPT ;NO, CLEAR SCRIPT FLAG
|
||
RTS PC ;AND RETURN
|
||
1$: TST PFOPEN ;ALREADY OPEN?
|
||
BEQ 3$ ;NO, TRY TO OPEN IT
|
||
INC SCRIPT ;IF OPEN, JUST SET SCRIPT FLAG
|
||
2$: RTS PC ;AND RETURN
|
||
3$: SAVE 1
|
||
CMP BUFPGS,#4 ;ENOUGH PAGES FOR SCRIPT BUFFERS?
|
||
BLT 5$ ;NO
|
||
SUB #2,BUFPGS ;YES, TAKE TWO
|
||
MOV R5,R0 ;TOP OF USER STACK
|
||
MOV #PFNAME,R1 ;POINTER TO DEFAULT FILE NAME AND TYPE TABLE
|
||
JSR R5,GTFLNM ;GET THE FILE NAME
|
||
BR 7$ ;FAILURE
|
||
.ENTER #AREA,#PFCHAN,#PFNAME,#0 ;TRY TO CREATE THE FILE
|
||
BCS 6$ ;FAILURE
|
||
4$: INC PFOPEN ;SUCCESS, SET OPEN FLAG
|
||
INC SCRIPT ;AND SCRIPT FLAG
|
||
JSR PC,FINDPG ;FIND A PAGE FOR FIRST INPUT BUFFER
|
||
MOV R0,SCRBF1 ;FIRST BUFFER POINTER
|
||
MOV R0,SCRBUF ;SELECT THIS ONE
|
||
MOV R0,SCRPTR ;AND INITIAL CHARACTER POINTER
|
||
ADD #1000,R0
|
||
MOV R0,SCREND ;END OF BUFFER
|
||
MOV #177400,(R1)+ ;PROTECT THIS PAGE
|
||
MOV #-1,(R1)
|
||
JSR PC,FINDPG ;FIND A PAGE FOR SECOND INPUT BUFFER
|
||
MOV R0,SCRBF2 ;SECOND BUFFER POINTER
|
||
MOV #177400,(R1)+ ;PROTECT THIS PAGE
|
||
MOV #-1,(R1)
|
||
BR 8$ ;AND RETURN
|
||
5$: INFORM <Insufficient memory for SCRIPTing>
|
||
BR 7$
|
||
6$: INFORM <Unable to open SCRIPT file>
|
||
7$: INC PFLOST ;SET DEATH FLAG
|
||
8$: .UNLOCK ;RELEASE USR
|
||
RESTOR 1
|
||
RTS PC
|
||
.DSABL LSB
|
||
|
||
;STORE NEXT PRINT FILE BLOCK
|
||
.ENABL LSB
|
||
PUTPBK::.WAIT #PFCHAN ;WAIT FOR CURRENT OUTPUT TO COMPLETE
|
||
BCS 3$ ;OUTPUT ERROR
|
||
.WRITE #AREA,#PFCHAN,SCRBUF,#256.,PFBLK ;STORE THE NEXT BLOCK
|
||
BCS 2$ ;ERROR?
|
||
INC PFBLK ;NO, POINT TO NEXT BLOCK
|
||
MOV SCRBF1,R0 ;POINTER TO FIRST BUFFER
|
||
CMP SCRBUF,R0 ;WAS THIS FIRST BUFFER?
|
||
BNE 1$ ;NO, SELECT IT
|
||
MOV SCRBF2,R0 ;YES, SELECT SECOND BUFFER
|
||
1$: MOV R0,SCRBUF
|
||
MOV R0,SCRPTR ;CHARACTER POINTER
|
||
ADD #1000,R0
|
||
MOV R0,SCREND ;END OF THIS BUFFER
|
||
RTS PC
|
||
2$: TSTB @#ERRBYT ;END OF FILE?
|
||
BNE 3$ ;NO
|
||
INFORM <SCRIPT file full> ;YES, NOTIFY USER
|
||
BR 4$
|
||
3$: INFORM <SCRIPT file output error> ;GENERAL ERROR MESSAGE
|
||
4$: CLR SCRIPT ;ON ERROR, END SCRIPTING
|
||
INC PFLOST ;AND DISABLE IT PERMANENTLY
|
||
RTS PC
|
||
.DSABL LSB
|
||
|
||
|
||
.PSECT STRING
|
||
NMRMSG: .ASCII /**MORE**/<200> ;NORMAL MORE MESSAGE
|
||
VMRMSG: .ASCII <33>/[7m--More--/<33>/[m/<200> ;VT100 MORE MESSAGE
|
||
NOMORE: .ASCII <15>/ /<15><200> ;ERASE MORE MESSAGE
|
||
.PSECT CODE
|
||
|
||
;NEXT LINE - CHECK FOR END-OF-PAGE CONDITION
|
||
.ENABL LSB
|
||
DEFVAR LINES ;LINES USED ON SCREEN SINCE LAST INPUT
|
||
NXTLIN: INC LINES ;ONE MORE SCREEN LINE USED
|
||
CMP LINES,P$PAGE ;PAGE FULL?
|
||
BNE 3$ ;NOT YET
|
||
MOV #1,LINES ;YES, RESET COUNTER (ALLOWING FOR THIS LINE)
|
||
TST P$TERM ;STATUS LINE?
|
||
BEQ 1$ ;NO
|
||
ADD P$TERM,LINES ;YES, ALLOW FOR IT (1 OR 2 EXTRA LINES)
|
||
1$: SAVE 1234
|
||
JSR PC,OPUSL ;UPDATE STATUS LINE
|
||
RESTOR 4321
|
||
MOV #NMRMSG,R0 ;NORMAL MORE MESSAGE
|
||
CMP P$TERM,#1 ;VT100?
|
||
BNE 2$ ;NO, SHOW NORMAL MORE MESSAGE
|
||
MOV #VMRMSG,R0 ;SPECIAL VT100 MORE MESSAGE
|
||
2$: .PRINT
|
||
BIS #10000,@#44 ;DO SINGLE-CHARACTER INPUT
|
||
.TTYIN ;GET ONE
|
||
BIC #10000,@#44 ;IGNORE CHARACTER & RETURN TO NORMAL
|
||
.PRINT #NOMORE ;ERASE MORE MESSAGE
|
||
3$: RTS PC
|
||
.DSABL LSB
|
||
|
||
;PRINT THE OUTPUT BUFFER
|
||
LINOUT::JSR PC,NXTLIN ;ENTER HERE TO CHECK FOR END-OF-PAGE
|
||
BUFOUT::TST SCRIPT ;SCRIPT?
|
||
BEQ 4$ ;NO
|
||
SAVE 1
|
||
MOV OUTBUF,R1 ;YES, POINT TO STRING
|
||
1$: MOVB (R1)+,R0 ;GET NEXT CHARACTER
|
||
BEQ 2$ ;END OF STRING
|
||
CMPB R0,#200 ;200 BYTE ALSO ENDS STRING (NO CRLF)
|
||
BEQ 3$
|
||
JSR PC,SCRCHR ;SCRIPT THE CHARACTER
|
||
BR 1$ ;AND LOOP
|
||
2$: MOV #15,R0 ;QUEUE A CR
|
||
JSR PC,SCRCHR
|
||
MOVB #12,R0 ;AND A QUEUE
|
||
JSR PC,SCRCHR
|
||
3$: RESTOR 1
|
||
4$: .PRINT OUTBUF ;PRINT THE LINE
|
||
RTS PC
|
||
|
||
;PRINT A STRING
|
||
OUTSTR::.PRINT ;POINTER ALREADY IN R0
|
||
RTS PC
|
||
|
||
;PRINT A CHARACTER FROM R0
|
||
OUTCHR::.TTYOUT ;DO IT
|
||
RTS PC
|
||
|
||
;READ A CHARACTER INTO R0
|
||
INCHR:: CLR LINES ;RESET LINE COUNTER
|
||
TST P$TERM ;STATUS LINE?
|
||
BEQ 1$ ;NO
|
||
ADD P$TERM,LINES ;YES, ALLOW FOR IT (1 OR 2 EXTRA LINES)
|
||
1$: .TTYIN ;DO IT
|
||
RTS PC
|
||
|
||
;GET ALL THE MEMORY AVAILABLE
|
||
GETMEM::.SETTOP #-2 ;ASK FOR HIGHEST POSSIBLE ADDRESS
|
||
RTS PC ;R0 WILL CONTAIN HIGHEST ADDRESS GOTTEN
|
||
|
||
;OPEN THE GAME FILE
|
||
DEFVAR AREA,<.BLKW 5> ;EMT ARGUMENT BLOCK
|
||
DEFVAR GAMNAM,<.RAD50 /DK $GAME$IML/> ;GAME FILE NAME
|
||
OPNGAM::SAVE 1
|
||
MOV P$GAME,R1 ;GAME NAME SUPPLIED?
|
||
BEQ 1$ ;NO, GET ONE
|
||
MOV R1,GAMNAM+2 ;YES, USE IT
|
||
MOV P$GAME+2,GAMNAM+4
|
||
BR 2$
|
||
1$: MOV #BUFFER+400,R0 ;USE BUFFER AREA FOR CSI (IT'S STILL EMPTY)
|
||
MOV #GAMNAM,R1 ;GAME FILE NAME & TYPE TABLE
|
||
JSR R5,GTFLNM ;GET THE DESIRED FILE NAME
|
||
BR 4$ ;FAILURE
|
||
2$: .LOOKUP #AREA,#GMCHAN,#GAMNAM ;TRY TO OPEN THE FILE
|
||
BCS 3$ ;OPEN FAILED IF CARRY SET
|
||
MOV GAMNAM+2,R1 ;OK, NOW INITIALIZE FILE NAMES
|
||
MOV R1,PFNAME+2
|
||
MOV R1,SAVNAM+2
|
||
MOV R1,CMDNAM+2
|
||
MOV GAMNAM+4,R1
|
||
MOV R1,PFNAME+4
|
||
MOV R1,SAVNAM+4
|
||
MOV R1,CMDNAM+4
|
||
RESTOR 1
|
||
RTS PC
|
||
3$: CMP GAMNAM,#^RINT
|
||
BEQ 4$
|
||
MOV #^RINT,GAMNAM
|
||
BR 2$
|
||
4$: FATAL <Game file not found>
|
||
|
||
;GET A GAME FILE BLOCK, BLOCK NUMBER IN R0, CORE LOCATION IN R1
|
||
GETBLK::SAVE 2
|
||
MOV #1,R2 ;CALL GTBLKS FOR 1 BLOCK ONLY
|
||
JSR PC,GTBLKS
|
||
RESTOR 2
|
||
RTS PC
|
||
|
||
;GET A SERIES OF GAME FILE BLOCKS,
|
||
;FIRST BLOCK NUMBER IN R0, CORE LOCATION IN R1, NUMBER OF BLOCKS IN R2
|
||
GTBLKS::SAVE 023
|
||
MOV R0,R3
|
||
SWAB R2 ;CONVERT BLOCK COUNT TO WORD COUNT
|
||
.READW #AREA,#GMCHAN,R1,R2,R3 ;READ THE BLOCKS
|
||
BCS 1$ ;READ FAILED IF CARRY SET
|
||
RESTOR 320
|
||
RTS PC
|
||
1$: FATAL <Game file read error>
|
||
|
||
.PSECT STRING
|
||
FNMSTR::.ASCII /File name (current default is /<200> ;PROMPT STRING
|
||
.PSECT CODE
|
||
|
||
;GET THE FILE NAME DESIRED, SKIP ON SUCCESS,
|
||
;TOP OF USER STACK IN R0, DEFAULT FILE NAME POINTER IN R1
|
||
.ENABL LSB
|
||
GTFLNM::SAVE 134 ;SAVE FILE NAME POINTER FOR LATER
|
||
MOV SP,R3 ;SAVE CURRENT STACK-POINTER
|
||
MOV R0,R4 ;TOP OF USER STACK
|
||
SUB #78.,R4 ;PUT OUTPUT BLOCK ON TOP OF (UNDER) IT
|
||
.PRINT #FNMSTR ;PRINT PROMPT STRING
|
||
MOV (R1)+,R0 ;PRINT CURRENT FILE NAME DEFAULT
|
||
JSR PC,OUTR50 ;IT'S IN RAD50
|
||
.TTYOUT #': ;FOLLOW DEVICE WITH COLON
|
||
MOV (R1)+,R0
|
||
JSR PC,OUTR50
|
||
MOV (R1)+,R0
|
||
JSR PC,OUTR50
|
||
.TTYOUT #'. ;PRECEDE TYPE WITH DOT
|
||
MOV (R1),R0
|
||
JSR PC,OUTR50
|
||
.TTYOUT #') ;END OF PROMPT
|
||
.TTYOUT #40
|
||
.LOCK ;LOCK USR IN CORE
|
||
.CSISPC R4,R1,#0 ;GET A FILE NAME
|
||
MOV R3,SP ;FLUSH ANY SWITCHES TYPED
|
||
ADD #30.,R4 ;POINT TO FIRST INPUT FILE NAME
|
||
TST (R4) ;ANYTHING ENTERED?
|
||
BEQ 1$ ;NO, USE ALL DEFAULTS
|
||
SUB #6,R1 ;YES, BACK UP TO FILE DEVICE NAME
|
||
MOV (R4)+,(R1)+ ;GET DEVICE TYPED
|
||
TST (R4) ;ANY FILE NAME ENTERED?
|
||
BEQ 1$ ;NO, USE DEFAULTS
|
||
MOV (R4)+,(R1)+ ;YES, GET NAME AND TYPE
|
||
MOV (R4)+,(R1)+
|
||
MOV (R4),(R1)
|
||
1$: RESTOR 431
|
||
.DSTAT #AREA,R1 ;GET DEVICE STATUS
|
||
BCC 2$
|
||
INFORM <Illegal device specified> ;NO SUCH DEVICE
|
||
RTS R5
|
||
2$: TST AREA+4 ;HANDLER IN CORE?
|
||
BNE 3$ ;YES
|
||
INFORM <Handler not loaded> ;NO
|
||
RTS R5
|
||
3$: TST (R5)+ ;SKIP RETURN FOR SUCCESS
|
||
RTS R5
|
||
.DSABL LSB
|
||
|
||
;CREATE THE SAVE FILE, LENGTH IN R0, SKIP RETURN ON SUCCESS
|
||
.ENABL LSB
|
||
DEFVAR SAVNAM,<.RAD50 /DK ZIP ISV/> ;SAVE FILE NAME
|
||
NEWSFL::SAVE 12
|
||
MOV R0,R2 ;FILE LENGTH
|
||
MOV 4(SP),R0 ;TOP OF USER STACK
|
||
MOV #SAVNAM,R1 ;POINTER TO DEFAULT FILE NAME AND TYPE TABLE
|
||
JSR R5,GTFLNM ;GET THE FILE NAME
|
||
BR 3$ ;FAILURE
|
||
TST AREA ;MAKE SURE IT'S A FILE-STRUCTURED DEVICE
|
||
BPL 2$
|
||
.DELETE #AREA,#SVCHAN,#SAVNAM ;DELETE EXISTING FILE, IF ANY
|
||
.PURGE #SVCHAN ;JUST IN CASE...
|
||
.ENTER #AREA,#SVCHAN,#SAVNAM,R2 ;TRY TO CREATE THE FILE
|
||
BCS 1$ ;CREATE FAILED IF CARRY SET
|
||
TST (R5)+ ;SKIP ON SUCCESS
|
||
BR 3$
|
||
1$: CMPB @#ERRBYT,#1 ;NOT ENOUGH ROOM?
|
||
BNE 2$ ;NO, USE GENERAL MESSAGE
|
||
INFORM <Not enough room for SAVE file>
|
||
BR 3$
|
||
2$: INFORM <Unable to open SAVE file>
|
||
.PURGE #SVCHAN ;PURGE THE FILE ON ERROR
|
||
3$: RESTOR 21
|
||
.UNLOCK ;RELEASE USR
|
||
RTS R5 ;FAILURE RETURN IF NO SKIP
|
||
.DSABL LSB
|
||
|
||
;OPEN THE SAVE FILE, SKIP ON SUCCESS
|
||
.ENABL LSB
|
||
OPNSFL::SAVE 1
|
||
MOV 2(SP),R0 ;TOP OF USER STACK
|
||
MOV #SAVNAM,R1 ;SAVE FILE NAME & TYPE TABLE
|
||
JSR R5,GTFLNM ;GET THE DESIRED FILE NAME
|
||
BR 3$ ;FAILURE
|
||
.LOOKUP #AREA,#SVCHAN,#SAVNAM ;TRY TO OPEN THE FILE
|
||
BCS 1$ ;OPEN FAILED IF CARRY SET
|
||
TST (R5)+ ;SKIP RETURN
|
||
BR 3$
|
||
1$: CMPB @#ERRBYT,#1 ;FILE NOT FOUND?
|
||
BNE 2$ ;NO, USE GENERAL MESSAGE
|
||
INFORM <SAVE file not found> ;YES
|
||
BR 3$
|
||
2$: INFORM <Unable to open SAVE file>
|
||
.PURGE #SVCHAN ;PURGE THE FILE ON ERROR
|
||
3$: RESTOR 1
|
||
.UNLOCK ;RELEASE USR
|
||
RTS R5 ;RETURN WITHOUT SKIPPING FOR FAILURE
|
||
.DSABL LSB
|
||
|
||
;CLOSE THE SAVE FILE
|
||
CLSSFL::.CLOSE #SVCHAN
|
||
RTS PC
|
||
|
||
;OPEN THE COMMAND FILE, SET CMDBUF FLAG
|
||
DEFVAR CMDBUF ;COMMAND FILE BUFFER POINTER
|
||
DEFVAR CMDTAB ;PAGE TABLE POINTER
|
||
DEFVAR CMDEND ;END OF BUFFER POINTER
|
||
DEFVAR CMDNAM,<.RAD50 /DK ZIP COM/> ;COMMAND FILE NAME
|
||
DEFVAR CMDPTR ;COMMAND CHARACTER POINTER
|
||
DEFVAR CMDBLK ;FILE BLOCK NUMBER
|
||
.ENABL LSB
|
||
OPNCFL::CMP BUFPGS,#3 ;ENOUGH PAGES FOR BUFFER?
|
||
BGE 1$ ;YES
|
||
INFORM <Insufficient memory for command buffer> ;NO
|
||
RTS PC
|
||
1$: SAVE 1
|
||
MOV R5,R0 ;TOP OF USER STACK
|
||
MOV #CMDNAM,R1 ;COMMAND FILE NAME & TYPE TABLE
|
||
JSR R5,GTFLNM ;GET THE DESIRED FILE NAME
|
||
BR 3$ ;FAILURE
|
||
.LOOKUP #AREA,#CMCHAN,#CMDNAM ;TRY TO OPEN THE FILE
|
||
BCC 4$ ;OPEN FAILED IF CARRY SET
|
||
CMPB @#ERRBYT,#1 ;FILE NOT FOUND?
|
||
BEQ 2$ ;YES
|
||
.PURGE #CMCHAN ;NO, USE GENERAL MESSAGE
|
||
INFORM <Unable to open command file>
|
||
BR 3$
|
||
2$: INFORM <Command file not found>
|
||
3$: RESTOR 1
|
||
.UNLOCK ;RELEASE USR
|
||
RTS PC
|
||
4$: JSR PC,FINDPG ;FIND A PAGE FOR INPUT BUFFER
|
||
MOV R0,CMDBUF ;BUFFER POINTER
|
||
ADD #1000,R0
|
||
MOV R0,CMDEND ;END OF BUFFER
|
||
MOV R1,CMDTAB ;SAVE IT
|
||
MOV #177400,(R1)+ ;PROTECT THIS PAGE
|
||
MOV #-1,(R1)
|
||
DEC BUFPGS ;ONE LESS AVAILABLE PAGE
|
||
CLR CMDBLK ;START WITH BLOCK ZERO
|
||
RESTOR 1
|
||
.UNLOCK ;RELEASE USR
|
||
BR GETCBK ;GET THE BLOCK AND RETURN
|
||
.DSABL LSB
|
||
|
||
;GET NEXT COMMAND FILE BLOCK
|
||
GETCBK::.READW #AREA,#CMCHAN,CMDBUF,#256.,CMDBLK ;GET THE NEXT BLOCK
|
||
BCC 1$ ;CHECK FOR ERRORS
|
||
CLR CMDBUF ;ON ERROR, END COMMAND FILE INPUT
|
||
MOV CMDTAB,R0 ;FREE BUFFER PAGE
|
||
CLR (R0)+
|
||
CLR (R0)
|
||
INC BUFPGS ;ONE MORE PAGE NOW AVAILABLE
|
||
.PURGE #CMCHAN ;FLUSH CHANNEL
|
||
RTS PC ;AND RETURN
|
||
1$: INC CMDBLK ;IF NO ERROR, POINT TO NEXT BLOCK
|
||
MOV CMDBUF,CMDPTR ;AND RESET CHARACTER POINTER
|
||
RTS PC
|
||
|
||
;GET A SERIES OF SAVE FILE BLOCKS,
|
||
;FIRST BLOCK NUMBER IN R0, CORE LOCATION IN R1, NUMBER OF BLOCKS IN R2
|
||
GTSBKS::SAVE 023
|
||
MOV R0,R3
|
||
SWAB R2 ;CONVERT BLOCK COUNT TO WORD COUNT
|
||
.READW #AREA,#SVCHAN,R1,R2,R3 ;READ THE BLOCKS
|
||
BCS 1$ ;READ FAILED IF CARRY SET
|
||
RESTOR 320
|
||
RTS PC
|
||
1$: FATAL <SAVE file read error>
|
||
|
||
;WRITE OUT A SERIES OF SAVE FILE BLOCKS, SKIP ON SUCCESS,
|
||
;FIRST BLOCK NUMBER IN R0, CORE LOCATION IN R1, NUMBER OF BLOCKS IN R2
|
||
PTSBKS::SAVE 023
|
||
MOV R0,R3
|
||
SWAB R2 ;CONVERT BLOCK COUNT TO WORD COUNT
|
||
.WRITW #AREA,#SVCHAN,R1,R2,R3 ;WRITE THE BLOCKS
|
||
BCS 1$ ;WRITE FAILED IF CARRY SET
|
||
RESTOR 320
|
||
TST (R5)+ ;SKIP RETURN
|
||
RTS R5
|
||
1$: INFORM <SAVE file write error>
|
||
.PURGE #SVCHAN ;PURGE THE FILE ON WRITE ERROR
|
||
RTS R5 ;RETURN WITHOUT SKIPPING
|
||
|
||
;GET THE CURRENT TIME - USED FOR RANDOM NUMBER SEED
|
||
DEFVAR TIME,<.WORD 0,0> ;TIME IS TWO WORDS, ALWAYS INIT TO ZEROES
|
||
GETIME::TST P$RAND ;DISABLE RANDOMNESS?
|
||
BNE 1$ ;YES, DON'T GET TIME
|
||
.GTIM #AREA,#TIME ;NO, GET IT
|
||
1$: RTS PC
|
||
|
||
;FATAL ROUTINE - PRINT ERROR MESSAGE AND DIE
|
||
;STRING POINTER FOLLOWS CALL
|
||
FATALR::MOV #'?,R0 ;PRINT ERROR HEADER
|
||
JSR PC,OUTCHR
|
||
MOV GAMNAM+2,R0
|
||
JSR PC,OUTR50
|
||
MOV GAMNAM+4,R0
|
||
JSR PC,OUTR50
|
||
PRIN1 <-F->
|
||
.PRINT (R5) ;PRINT ERROR MESSAGE
|
||
FINISH::TST PFOPEN ;PRINT FILE OPEN?
|
||
BEQ 3$ ;NO
|
||
TST PFLOST ;PRINT FILE DIED?
|
||
BNE 2$ ;YES, JUST CLOSE IT
|
||
MOV SCRPTR,R0 ;GET SCRIPT POINTER
|
||
CMP R0,SCRBUF ;BEGINNING OF BUFFER?
|
||
BEQ 2$ ;YES
|
||
MOV SCREND,R1 ;NO, GET END OF BUFFER POINTER
|
||
1$: CLRB (R0)+ ;CLEAR NEXT CHARACTER POSITION
|
||
CMP R0,R1 ;END YET?
|
||
BNE 1$ ;NO
|
||
JSR PC,PUTPBK ;YES, STORE THE BLOCK
|
||
2$: .CLOSE #PFCHAN ;CLOSE THE FILE
|
||
3$: .EXIT ;AND DIE
|
||
|
||
;INFORMATIONAL ROUTINE - PRINT INFORMATIONAL MESSAGE
|
||
;STRING POINTER FOLLOWS CALL
|
||
INFRMR::MOV #'?,R0 ;PRINT INFORMATIONAL HEADER
|
||
JSR PC,OUTCHR
|
||
MOV GAMNAM+2,R0
|
||
JSR PC,OUTR50
|
||
MOV GAMNAM+4,R0
|
||
JSR PC,OUTR50
|
||
PRIN1 <-I->
|
||
.PRINT (R5)+ ;PRINT MESSAGE
|
||
RTS R5 ;AND RETURN
|
||
|
||
.ENDC
|
||
.SBTTL EXTENDED INSTRUCTION SET SIMULATION ROUTINES
|
||
|
||
|
||
;ALL ROUTINES TAKE ARGUMENTS ON STACK & RETURN RESULT ON STACK AFTER
|
||
;REMOVING CONSTANT ARGUMENT
|
||
|
||
.IF EQ EIS
|
||
|
||
;ARITHMETIC SHIFT (SINGLE WORD)
|
||
ASHSIM::SAVE 01
|
||
MOV 10(SP),R0 ;WORD TO SHIFT
|
||
MOV 6(SP),R1 ;NUMBER OF BITS TO SHIFT BY
|
||
BEQ 4$ ;NO SHIFT REQUIRED
|
||
BLT 2$ ;RIGHT SHIFT
|
||
1$: ASL R0 ;LEFT SHIFT SPECIFIED NUMBER OF TIMES
|
||
SOB R1,1$
|
||
BR 4$
|
||
2$: NEG R1
|
||
3$: ASR R0 ;RIGHT SHIFT SPECIFIED NUMBER OF TIMES
|
||
SOB R1,3$
|
||
4$: MOV R0,10(SP) ;REPLACE SHIFTED WORD
|
||
MOV 4(SP),6(SP) ;MOVE RETURN ADDRESS WHERE NUMBER ARGUMENT WAS
|
||
RESTOR 10
|
||
TST (SP)+ ;POP OFF OLD COPY OF RETURN ADDRESS
|
||
RTS PC
|
||
|
||
;MULTIPLY (SINGLE WORD ONLY)
|
||
MULSIM::SAVE 012
|
||
CLR R0 ;BUILD PRODUCT HERE
|
||
MOV 12(SP),R1 ;MULTIPLICAND
|
||
MOV 10(SP),R2 ;MULTIPLIER
|
||
1$: ASR R2 ;TEST CURRENT LOW ORDER BIT
|
||
BIC #100000,R2 ;CLEAR SIGN BIT JUST IN CASE...
|
||
BCC 2$ ;ZERO?
|
||
ADD R1,R0 ;YES, ADD PARTIAL PRODUCT
|
||
2$: ASL R1 ;MULTIPLY MULTIPLICAND BY 2
|
||
TST R2 ;ANY MULTIPLIER BITS LEFT?
|
||
BNE 1$ ;YES, LOOP
|
||
MOV R0,12(SP) ;RETURN PRODUCT IN MULTIPLICAND SLOT
|
||
MOV 6(SP),10(SP) ;SHIFT RETURN ADDRESS TO CLEAR MULTIPLIER SLOT
|
||
RESTOR 210
|
||
TST (SP)+ ;POP OFF OLD COPY OF RETURN ADDRESS
|
||
RTS PC
|
||
|
||
;DIVIDE (DOUBLE WORD)
|
||
DIVSIM::SAVE 012345
|
||
MOV 22(SP),R0 ;HIGH ORDER DIVIDEND WORD
|
||
MOV 20(SP),R1 ;LOW ORDER DIVIDEND WORD
|
||
CLR R2 ;HIGH ORDER SHIFTED DIVISOR WORD
|
||
MOV 16(SP),R3 ;LOW ORDER SHIFTED DIVISOR WORD
|
||
CLR R4 ;SHIFT COUNT
|
||
CLR R5 ;QUOTIENT BUILT HERE
|
||
1$: CMP R2,R0 ;COMPARE SHIFTED DIVISOR WITH DIVIDEND
|
||
BNE 2$
|
||
CMP R3,R1
|
||
2$: BHI 3$ ;DONE WHEN DIVISOR IS GREATER
|
||
INC R4 ;ELSE, INCREMENT SHIFT COUNTER
|
||
ASL R3 ;AND SHIFT DIVISOR
|
||
ROL R2
|
||
BR 1$ ;LOOP
|
||
3$: TST R4 ;ORIGINAL DIVISOR GREATER THAN DIVIDEND?
|
||
BEQ 8$ ;YES, RETURN 0 WITH DIVIDEND AS REMAINDER
|
||
4$: ASR R2 ;UNSHIFT DIVISOR ONE BIT
|
||
ROR R3
|
||
CMP R2,R0 ;COMPARE WITH REMAINING DIVIDEND
|
||
BNE 5$
|
||
CMP R3,R1
|
||
5$: BHI 6$ ;STILL GREATER
|
||
SUB R3,R1 ;ELSE, DECREASE DIVIDEND BY SHIFTED DIVISOR
|
||
SBC R0
|
||
SUB R2,R0
|
||
SEC ;AND SET CURRENT QUOTIENT BIT
|
||
BR 7$
|
||
6$: CLC ;RESET CURRENT QUOTIENT BIT
|
||
7$: ROL R5 ;SHIFT CURRENT BIT INTO QUOTIENT
|
||
SOB R4,4$ ;LOOP UNTIL DIVISOR COMPLETELY UNSHIFTED
|
||
8$: MOV R5,22(SP) ;SAVE QUOTIENT
|
||
MOV R1,20(SP) ;AND REMAINDER
|
||
MOV 14(SP),16(SP) ;SHIFT RETURN ADDRESS TO CLEAR DIVISOR SLOT
|
||
RESTOR 543210
|
||
TST (SP)+ ;POP OFF OLD COPY OF RETURN ADDRESS
|
||
RTS PC
|
||
|
||
.ENDC
|
||
.SBTTL BUFFER FOR DYNAMIC STORAGE
|
||
|
||
.PSECT BUFFER
|
||
|
||
|
||
BUFFER::
|
||
|
||
.END START
|