.TITLE ZPIC .IDENT /V1.0/ ; ++ ; This is the Z-machine handler for picture opcodes. ; (c) 2005 by Johnny Billquist ; ; History: ; ; V1.0 05-02-23 16:30 BQT Initial coding started. ; -- .INCLUDE /ZMAC/ FAKE=0 ; Fake Zork Zero pictures. .PSECT DATA,D,RW ; PICTAB: .IF NE FAKE .INCLUDE /ZZPIC/ .ENDC EPTAB: .WORD -1 ; .PSECT CODE,I,RO ; ; EXT:5 5 6 draw_picture picture-number y x ; ; PUTLCHR - Latin-1 in R1 ; NUMTXT - Number in R0 ; .ENABL LSB DRWPIC:: .INSTR "draw_picture",#3 .IF NE FAKE MOV (R2)+,R3 MOV ACTSCR,R1 MOV W.CX(R1),-(SP) MOV W.CY(R1),-(SP) MOV (R2)+,R0 BEQ 10$ MOV R0,W.CY(R1) 10$: MOV (R2),R0 BEQ 20$ MOV R0,W.CX(R1) 20$: CALL SCRCUR MOV #'A,R1 CALL PUTCHR MOV ACTSCR,R1 MOV (SP)+,W.CY(R1) MOV (SP)+,W.CX(R1) CALLR SCRCUR .IFF RETURN .ENDC ; ; EXT:6 6 6 picture_data picture-number array ?(label) ; .ENABL LSB PICDAT:: .INSTR "picture_data",#2 MOV (R2)+,R3 ; Get picture number. BNE 1$ ; Non-zero? MOV (R2),R0 .PUTWB R0,#EPTAB-PICTAB/6 ; Number of pictures. ADD #2,R0 .PUTWB R0,#0 ; Version of picture data. CALLR BTRUE ; Done. 1$: .IF NE FAKE MOV (R2),-(SP) ; Get address. MOV #PICTAB,R2 ; Get address of table. 10$: TST (R2) ; End of table? BPL 20$ ; No. TST (SP)+ ; Yes. Clean stack. .IFTF CALLR BFALSE ; No picture. .IFT 20$: CMP (R2)+,R3 ; Correct picture? BEQ 30$ ; Yes. ADD #4,R2 ; No. Next entry. BR 10$ ; Loop. ; ; Found correct picture. ; 30$: MOV (R2)+,R1 ; Get width. CALL GETSCL ; Get screen width. MUL R1,R0 DIV #320.,R0 ; Scale... TST R1 ; Remainder non-zero? BEQ 40$ INC R0 ; Yes. Round up. 40$: MOV (SP)+,R3 ; Get address to write to. ADD #2,R3 .PUTWB R3,R0 ; Save it. SUB #2,R3 MOV (R2),R1 ; Get height. CALL GETSLN ; Get lines on screen. MUL R1,R0 DIV #200.,R0 ; Scale... TST R1 BEQ 50$ INC R0 ; Round up. 50$: .PUTWB R3,R0 ; Save it. CALLR BTRUE ; Success. .ENDC ; ; EXT:28 1C 6 picture_table table ; .ENABL LSB PICTBL:: .INSTR "picture_table",#1 RETURN ; ; EXT:7 7 6 erase_picture picture-number y x ; .ENABL LSB ERPIC:: .INSTR "erase_picture",#3 RETURN ; .END .TITLE ZRSX - RSX specific code for ZEMU. .IDENT /V1.37/ ;++ ; ZRSX - The ZEMU RSX specific code. ; (c) 2000, 2001, 2002, 2004, 2005 by Johnny Billquist ; ; History: ; 00-07-30 BQT Initial coding started. ; Y1.0 00-08-26 21:00 BQT First release. ; Y1.1 00-09-04 23:00 BQT Added timeout functionality. ; Y1.2 00-09-07 19:00 BQT Improved timeout reader. ; Y1.3 00-09-08 19:45 BQT Improved the search for games. ; Code will now try to be smart if no dir was ; specified. It then looks first in current ; dir, and then in [INFOCOM]. ; Y1.4 00-09-09 18:30 BQT Bugfix. The last valid address in task was ; incorrectly deduced from .LIMIT, which ; won't handle if we installed the task ; with an increment in place... ; V1.5 00-09-16 12:00 BQT Changed ZEXIT to ABORT. ; Made version official. ; V1.6 00-10-07 13:00 BQT Changed default directory handling to accept ; devices and logical names. ; The same is now also true for SAVE/RESTORE ; filenames. ; V1.7 00-10-08 18:00 BQT Corrected code to work as multiuser task. ; V1.8 00-10-27 14:45 BQT Added scripring file. ; V1.9 00-12-04 13:00 BQT Added handling of CSI character. ; V1.10 00-12-29 00:30 BQT Changed read function to use ast, and read all. ; It will also detect ^C. ; Added exit AST. ; V1.11 00-12-30 04:30 BQT Added a call to INPEND from INPINI, since ; we can actually get two calls to INPEND in ; a row, where the second one is without timer. ; V1.12 01-01-04 23:00 BQT Bugfix. Terminal must be in full duplex for ; ZEMU to work. ; Added GIN$ to drop privilege once game file ; is opened. This allows us to play game files ; we are not allowed to read. ; V1.13 01-01-08 02:00 BQT Bugfix. After the default file names, ; we need to ensure we are on an even address. ; V1.14 01-02-19 03:00 BQT Added /ID switch. ; V1.15 01-02-26 15:30 BQT Added one more param to SAVOPN. ; V1.16 01-03-13 02:00 BQT Moved the attributes to set on terminal to ; r/w section, since RT: requires them there. ; V1.17 01-05-30 02:00 BQT Bugfix. If an error occured, the AST handler ; didn't issue a new read. ; V1.18 01-09-20 01:00 BQT Added /LI and /HE switches. ; V1.19 02-12-29 00:30 BQT Added check to truncate game names to 9 ; characters if longer. ; Improved random seed generator. ; V1.20 03-08-14 20:00 BQT Changed cache handling. ; V1.21 03-08-16 19:00 BQT Added games in region. ; V1.22 04-08-31 11:10 BQT Added GAMINI for initializations just before ; starting play. ; V1.23 05-05-03 22:00 BQT Added call to SCRZAP at ^L ; V1.24 05-05-24 12:15 BQT Changed terminal input to be unsolicited asts. ; V1.25 05-07-26 01:00 BQT Improved INPINI to always update cursor ; position. ; V1.26 05-08-01 15:00 BQT Added /CO switch to enable color cabability. ; V1.27 05-08-31 14:30 BQT Small improvements in HELP text. ; V1.28 06-01-31 21:00 BQT Changed output QIO to QIOW, since program ; might overwrite buffer on output. ; V1.29 06-04-26 16:00 BQT Bugfix. Size of game is in F.HIBK, not ; F.EFBK. The latter is where EOF is, for ; appending, and it can point beyond existing ; blocks. ; HIBK can also point beyond EFBK, but we ; don't care about that, since we don't ; play with the RSX EOF pointers in ZEMU games. ; HIBK is always the last actually allocated ; block for the file. ; V1.30 06-05-03 19:15 BQT Added debug printouts. ; V1.31 07-10-11 03:00 BQT Changed protection word for regions. ; V1.32 07-10-17 13:30 BQT Added dynamic check if fastmap is available. ; V1.33 07-11-08 00:30 BQT Added SST vectors. ; V1.34 08-09-04 16:30 BQT Changed INPINI calling sequence. ; V1.35 09-04-23 14:30 BQT Bugfix. When using large memory model, memory ; mapping was done without privs, meaning it ; failed when it shouldn't. ; V1.36 09-04-24 13:50 BQT Improved common region handling. ; If task have privileges, it now creates the ; region owned by [1,54], and with [RD,D,,] ; If task don't have privs, the region is ; created owned by the task uic, and with ; protection taken from the file, but only ; copying the read bits. ; V1.37 09-05-06 11:30 BQT Added full wildcard handling for listing ; games. ;-- SAVEXT=^RZSG ; This extension is used if DSAV don't have one. SCREXT=^RLOG ; Extension for transcriptions. DEFPGS=1024. ; Default small page size DEFMIN=2 ; Default minimum APRs for large cache RBSIZ=64. ; Size of rcv buffer. .MCALL GCMLB$, GCML$, CSI$, CSI$1, CSI$4 ; Command handling. .MCALL CSI$SW, CSI$SV, CSI$ND .MCALL EXIT$S, EXST$S, EXTK$S, DIR$, GTSK$C ; Task and general stuff .MCALL QIOW$S, QIOW$C, QIOW$ ; I/O .MCALL WTSE$, WTLO$, CLEF$, SETF$ ; Event flags. .MCALL MRKT$, CMKT$C, GTIM$C ; Time. .MCALL SREX$C ; Exit AST. .MCALL SVTK$S ; SST vectors for task .MCALL ENAR$S, DSAR$S, ASTX$S ; AST handling. .MCALL FCSMC$ ; File handling. .MCALL GIN$S ; General information .MCALL RDBDF$, WDBDF$, RDBBK$, WDBBK$ ; Memory handling .MCALL GMCX$S, CRRG$S, ATRG$S, CRAW$S, MAP$ .MCALL TFEA$S FCSMC$ D.RSX=100000 .MACRO TSTIO SB,ADDR,?LBL CMPB SB,#IS.SUC BEQ LBL MOV SB+2,-(SP) MOV SB,-(SP) JSR PC,ADDR LBL: .ENDM TSTIO .PSECT $DPB$.,RO,D ; The DPBs of $C forms are read only. FSRSZ$ 2 CSI$ RDBDF$ WDBDF$ .INCLUDE /ZMAC/ .SBTTL R/W data area. .PSECT DATA,D,RW GCM: GCMLB$ ,ZEM,,CMDLUN CSI: .BLKB C.SIZE ; ARGBLK: .BLKW 10. VERBLK: .BLKW 2 DATBLK: .BLKW 10 ; ; "Simple" structure to extract file protection info. ; RATBUF: .WORD 0,RATPRO ; 2 args. File and attribute buffer ptr. RATPRO: .BYTE -2,2 ; Attribute buffer. Attribute and length. .WORD FILPRO ; Pointer to where to place info. .BYTE 0,0 ; End of list. FILPRO: .WORD 0 ; File protection word, finally. ; ZRDB: RDBBK$ ZWDB: WDBBK$ ;' SFNAM: ; Search filename temp storage. TSKPAR: .BLKW 20 ; File descriptors. FDB: FDBDF$ FDRC$A FD.RWM FDBK$A ,512.,,DBEFN,DBISB FDOP$A DBLUN,CSI+C.DSDS,DFNAM SAVFDB: FDBDF$ FDRC$A FD.RWM FDBK$A ,512.,,SAVEFN,SAVISB FDOP$A SAVLUN,CSI+C.DSDS,DFNAM2 SCRFDB: FDBDF$ FDAT$A R.VAR,FD.CR FDRC$A FDOP$A SCRLUN,CSI+C.DSDS,DFNAM3 FDBF$A SCREFN ; Time information buffer. MFNAM: ; Match filename temp storage TMBUF: .BLKW 10 ; Area for GTIM$ directive. ; Parse information MASK: .WORD 0 ; Mask telling which switches are present. PGSIZ: .WORD DEFPGS ; Default page size MINAPR: .WORD DEFMIN ; Minimum # of APRs for large cache type. SYSFLG: .WORD 0 ; Flag to set if system game. MAPF: .WORD 0 ; Flag telling if we're using fastmap. ; ; Default file names... ; GAMSIZ==FDB+F.HIBK+2 ; Game file size DFNAM2: NMBLK$ ; Default game name with dir and all. ; Also used as default name for SAVE/RESTORE GAMR50==DFNAM2+N.FNAM ; Game name in R50 GAMID==GAMR50 ; Game ID info (junk info in save file) DFNAM3: NMBLK$ ; Default script file name. ; ; I/O status blocks. ; DBISB: .BLKW 2 SAVISB: .BLKW 2 IOSB: .BLKW 2 FNDCNT: .WORD 0 ; Counter for found files. FMTPTR: .WORD 0 ; ; Data area for .BLK macro arguments... ; BLK: .WORD 0 ; In RSX, blocks are 32 bit values. ; therefore we have leading zero. BPAGE:: .WORD 0 ; These values are written BADDR:: .WORD 0 ; by ZMAC macros... BCNT:: .WORD 0 ; Therefore they must exist. ; ; Different variables. ; FREEPT: .WORD 0 ; Pointer to free area on memory. END:: .WORD 0 ; Pointer to end of existing memory. ; BUF:: .BLKB 256. ; Small buffer to expand strings in. RBUF: .BLKB RBSIZ ; Small buffer for received chars. RBUFE: RBR: .WORD RBUF ; Rcv char read ptr. RBW: .WORD RBUF ; Rcv char write ptr. RBLEN: .WORD 0 ; Rcv char length. ; IAPR: .WORD 0 ; Mask of I-space aprs in use. DAPR: .WORD 0 ; Mask of D-space aprs in use. APRMSK: .WORD 0 ; Mask of free APRs. CHEFLG: .WORD 0 ; Flag for large cache blocks. ; GBUF: .BYTE TC.ACR,0,TC.NBR,0,TC.FDX,0,TC.PTH,0,TC.NEC,0 GBL2=.-GBUF ; The attributes above are restored at finish. .BYTE TC.ANI ATERM: .BYTE 0 .BYTE TC.SCP SCP: .BYTE 0 .BYTE TC.SFC SFC: .BYTE 0 .BYTE TC.TTP TTP: .BYTE 0 .BYTE TC.WID WID: .BYTE 0 .BYTE TC.AVO AVO: .BYTE 0 .BYTE TC.SFC SOFT: .BYTE 0 .BYTE TC.LPP LPP: .BYTE 0 GLEN=.-GBUF RGS: .WORD 0 ; Flag for color available. .EVEN ; ; The next three strings must be in R/W memory, because CSI$1 writes ; to them in order to compress them. ; DDIR: GAMDIR ; Default directory. DDIRL=.-DDIR DSAV: SAVDIR ; Default save name. DSAVL=.-DSAV DSCR: SCPDIR ; Default scripting name. DSCRL=.-DSCR ; .EVEN ; Specific attributes we want set. ; These *should* be possible to have ; read-only. Unfortunately, the RH: driver ; wants them writeable... SBUF: .BYTE TC.FDX,1 ; Full duplex. .BYTE TC.ACR,0 ; No wrap. .BYTE TC.PTH,1 ; Pass through .BYTE TC.NEC,1 ; No echo .BYTE TC.NBR,1 ; No broadcast SLEN=.-SBUF ; .SBTTL Readonly data. .PSECT CONST,D,RO ; ; Switches defined for RSX version: ; ; /BL:n limits the memory usage to n pages of cache. ; This limit is located at address CLIM. ; /DE:n sets the debug flag for what messages to write. ; /IN:n sets the interpreter ID. ; /ID tells ZEMU version. ; /HE will give a short help. ; /LI will list all available games. ; /LO lists local games ; /SY lists system games ; /MM forces ZEMU to use small cache buffer size. ; /PS:n sets the small cache page size ; /MA:n sets the minimum APRs required for large cache ; /CO will set color capability for games. ; SWTAB: CSI$SW BL,1,MASK,SET,,SWVAL CSI$SW DE,2,MASK,SET,,SWVAL2 CSI$SW IN,4,MASK,SET,,SWVAL3 CSI$SW ID,10,MASK,SET CSI$SW HE,20,MASK,SET CSI$SW LI,40,MASK,SET CSI$SW LO,140,MASK,SET CSI$SW SY,240,MASK,SET CSI$SW MM,400,MASK,SET CSI$SW PS,400,MASK,SET,,SWVAL4 CSI$SW MA,1000,MASK,SET,,SWVAL5 CSI$SW CO,1,RGS,SET CSI$ND SWVAL: CSI$SV DECIMAL,CLIM,2 CSI$ND SWVAL2: CSI$SV NUMERIC,DBGFLG,2 CSI$ND SWVAL3: CSI$SV DECIMAL,INTERP,2 CSI$ND SWVAL4: CSI$SV DECIMAL,PGSIZ,2 CSI$ND SWVAL5: CSI$SV DECIMAL,MINAPR,2 CSI$ND ; INFO:: .LIMIT ; Task memory information. ; DFNAM: NMBLK$ ,DAT,,SY,0 ; Default game name. .SBTTL Constant DPBs defined at compile time. NOTIM: CLEF$ CLKEFN WAITX: WTLO$ 0,30 ; TIIEFN ! CLKEFN SETIO: SETF$ TIIEFN CLRIO: CLEF$ TIIEFN DOMAP: MAP$ ZWDB READ: QIOW$ IO.ATA,INLUN,CMDEFN,,,, .SBTTL SST vector table SSTVEC: .WORD S.ODD .WORD S.MPRO .WORD S.BPT .WORD S.IOT .WORD S.INST .WORD S.EMT .WORD S.TRAP SSTLEN=.-SSTVEC .SBTTL Modifiable DPBs defined at compile time. .PSECT DPB,D,RW IO: QIOW$ IO.WLB,TILUN,TIEFN MARK: MRKT$ CLKEFN,,1 ; .PSECT TEXT,D,RO BADFN: .ASCIZ /Bad filename specified./<15><12> BADFMT: .ASCIZ /The specified file have bad format./<15><12> FNF: .ASCIZ /File not found./<15><12> FOE: .ASCIZ /File protected./<15><12> VERFMT: .ASCII /ZEMU %R%R%N(c) 2003 by Johnny Billquist.%N/ .ASCIZ /Built on %Y %2Z./ HLPFMT: .ASCII /ZEMU %R%R%N(c) 2003 by Johnny Billquist.%N/ .ASCII /Built on %Y %2Z.%N%N/ .ASCII "/IN:n - Set interpreter ID to n.%N" .ASCII "/BL:n - Set memory limit to n pages.%N" .ASCII "/MA:n - Set minimum APRs required for memory cache.%N" .ASCII "/PS:n - Set pagesize for small page model (implies /MM).%N" .ASCII "/MM - Force small page model.%N" .ASCII "/CO - Set color available bit for game.%N" .ASCII "/ID - Show ZEMU version.%N" .ASCII "/HE - Give this help message.%N" .ASCII "/LI - List all available games.%N" .ASCII "/LO - List local games.%N" .ASCII "/SY - List system games." .BYTE 0 ; End of text. LFMT: .ASCIZ /-- Local games --/ GFMT: .ASCIZ /-- System games --/ HFMT: .ASCIZ /Game Release Serial Inform Z-Machine/ FFMT: .ASCIZ /%9<%I%9> %6<%M%6> %6E %4E %D/ ; F.M1: .ASCIZ /%N----- A bug have occured -----%N/ F.ODD: .ASCIZ /Odd address trap./ F.MPRO: .ASCII /Memory protect error.%N/ .ASCIZ /SR1: %P SR2: %P SR0: %P/ F.BPT: .ASCIZ /Breakpoint/ F.IOT: .ASCIZ "I/O trap" F.INST: .ASCIZ /Reserved instruction/ F.EMT: .ASCIZ /EMT: %O/ F.TRAP: .ASCIZ /TRAP: %O/ F.SST: .ASCII /%NR0 %P%N/ .ASCII /R1 %P%N/ .ASCII /R2 %P%N/ .ASCII /R3 %P%N/ .ASCII /R4 %P%N/ .ASCII /R5 %P%N/ .ASCII /SP %P%N/ .ASCII /PC %P%N/ .ASCII /PS %P%N/ .ASCIZ /-- Aborting ZEMU. Please send an error report./ .PSECT $$DBTS,D,RO,GBL,SAV ; Let TKB fill in some info here... $DBTS:: .PSECT CODE,I,RO .SBTTL SST handlers ; .ENABL LSB S.ODD: CLR -(SP) MOV #F.ODD,-(SP) BR 10$ S.MPRO: MOV #6,-(SP) MOV #F.MPRO,-(SP) BR 10$ S.BPT: CLR -(SP) MOV #F.BPT,-(SP) BR 10$ S.IOT: CLR -(SP) MOV #F.IOT,-(SP) BR 10$ S.INST: CLR -(SP) MOV #F.INST,-(SP) BR 10$ S.EMT: MOV #2,-(SP) MOV #F.EMT,-(SP) BR 10$ S.TRAP: MOV #2,-(SP) MOV #F.TRAP,-(SP) 10$: MOV R0,IOBUF2 MOV #IOBUF2+2,R0 MOV R1,(R0)+ MOV R2,(R0)+ MOV R3,(R0)+ MOV R4,(R0)+ MOV R5,(R0)+ MOV #BUF,R0 MOV #F.M1,R1 CALL $EDMSG MOV (SP)+,R1 MOV (SP)+,R5 MOV SP,R2 CALL $EDMSG ADD R5,SP MOV SP,IOBUF2+14 MOV (SP)+,IOBUF2+16 MOV (SP)+,IOBUF2+20 MOV #F.SST,R1 MOV #IOBUF2,R2 CALL $EDMSG MOV #BUF,R1 SUB R1,R0 QIOW$S #IO.WLB,#TILUN,#TIEFN,,,, JMP ABORT .DSABL LSB .SBTTL ZMSG ; ; ZMSG shall print a message on the users terminal. The string ; will have a CRLF appended. ; The function is used on errors. ; ; In: R1 -> NUL-terminated string. ; 2(SP) - A list of arguments for the string. ; ; No registers should be changed. ; ; The formatting used is that of $EDMSG in RSX. ; ; The string formatting is kindof like printf() in C, in that ; special codes in the string are replaced by the arguments ; pointed at in the argument list. ; ; Special formatting characters are: ; ; %D - signed decimal. ; %O - signed octal. ; %M - unsigned octal with leading zeroes. ; %P - unsigned octal. ; %U - unsigned decimal. ; %B - unsigned octal byte. Argument is address of byte. ; ZMSG:: CALL $SAVAL ; Save registers. MOV #BUF,R0 ; Buffer in R0. MOV SP,R2 ; Argument block. ADD #20,R2 ; CALL $EDMSG ; Format message. SUB #BUF,R0 ; Get length. QIOW$S #IO.WLB,#CMDLUN,#CMDEFN,,,,<#BUF,R0,#40> RETURN ; Done. .SBTTL PUTTXT ; ; PUTTXT is the routine to write a text to the screen. ; ; In: R0 - Address of text. ; R1 - Length of text. ; ; Note that the text is NUL terminated. ; The NUL is not accounted for in the length, though. ; .ENABL LSB PUTTXT:: .DBG #D.RSX,<"[PUTTXT: Address = %M, count = %D. characters]">,R0,R1 MOV R0,IO+Q.IOPL MOV R1,IO+Q.IOPL+2 DIR$ #IO RETURN .SBTTL GETRND - Give us a random value. ; ; This routine can use any trick in the book, and return a ; good random number in R0. It is used to initialize the ; random number generator. Suggested good values are from ; a clock. Preferrably ms. or so. ; .ENABL LSB GETRND:: GTIM$C TMBUF,CODE MOV TMBUF+10,R1 ; Get minutes MUL #60.,R1 ; Convert into seconds. ADD TMBUF+12,R1 ; Add seconds. MUL TMBUF+16,R1 ; Convert into ticks. ADD TMBUF+14,R1 ; Add ticks. MOV R1,R0 ; Get result in R0. .DBG #D.RSX,<"GETRND: returning %M as seed]">,R0 RETURN .SBTTL INPINI - Initiate input. ; ; Initiating input means we'll start a timer if we need one. The ; actual reading is active all the time, through an AST (except at ; the start). ; ; In: TMO - Timeout. ; .ENABL LSB INPINI:: .DBG #D.RSX,<"[INPINI: timout = %D. tenths of a second]">,TMO CALL INPEND ; Just in case... TST TMO ; Any timeout? BEQ 10$ ; No. MOV R0,-(SP) ; Save registers. MOV R1,-(SP) MOV TMO,R0 ; Get timeout. MUL TMBUF+G.TICP,R0 ; Multiply by ticks/second. DIV #10.,R0 ; Divide for 1/10 seconds. MOV R0,MARK+M.KTMG ; Save magnitude. DIR$ #MARK ; Start timer. MOV (SP)+,R1 ; Restore registers. MOV (SP)+,R0 10$: CALLR MCUR ; Place cursor. .SBTTL INPEND - End input. ; ; Stop input. In this case, it just means stop the timer (if one exist). ; ; No arguments. ; No return values. ; .ENABL LSB INPEND:: .DBG #D.RSX,<"[INPEND: timer cancelled]"> CMKT$C CLKEFN,,CODE ; Cancel possible timer. DIR$ #NOTIM ; The timer event flag should be clear. RETURN .SBTTL RAST - Receive character AST. ; ; AST entered for each character read. ; ; Input is on stack. ; No return values are possible. ; ; All characters recevied are placed in the input queue, where they can ; be read later. We also set an event flag, to indicate that we have ; recevied characters. ; RAST: CMPB (SP),#3 ; ^C? BEQ 1$ CMPB (SP),#14 ; ^L? BEQ 2$ CMP RBLEN,#RBSIZ ; Buffer full? BHIS 100$ ; Yes. MOVB (SP)+,@RBW ; No. Save char. INC RBLEN ; Bump size. INC RBW ; Bump write pointer. CMP RBW,#RBUFE ; Wrap? BLO 10$ MOV #RBUF,RBW ; Yes. 10$: DIR$ #SETIO ; Mark that data is available. ASTX$S ; Done. 1$: JMP ABORT ; At ^C we abort. 2$: CALL SCRZAP ; At ^L we zap screen and return. 100$: TST (SP)+ ; Clear stack. ASTX$S .SBTTL CHARNE - Read one character from keyboard, with no echo. ; ; Out: Carry clear: R0 - character read. ; Carry set: We had timeout. ; .ENABL LSB CHARNE:: DIR$ #WAITX,CODE ; Wait for read or timer. TST RBLEN ; Check if anything available. BEQ 100$ ; No. Then timer must have finished. MOV RBR,R0 ; Yes. Get pointer. MOVB (R0)+,-(SP) ; Save char. CMP R0,#RBUFE ; End of buffer? BLO 10$ ; No. MOV #RBUF,R0 ; Yes. 10$: MOV R0,RBR ; Save new pointer. DSAR$S ; No ASTs here... DEC RBLEN ; Decrement length of buffer. BNE 20$ ; Not empty... DIR$ #CLRIO ; Empty. Clear EFN. 20$: ENAR$S ; Okay to get new ASTs... CLR R0 ; Get char back. BISB (SP)+,R0 ; Get char. .DBG #D.RSX,<"[CHARNE: returning char %O]">,R0 RETURN ; Tada! (Carry is 0 here) 100$: DIR$ #MARK ; Setup another timer. .DBG #D.RSX,<"CHARNE: returning timeout]"> SEC ; Mark timeout. RETURN ; Done. .SBTTL GAMINI ; ; GAMINI is a routine called just before the game play begins. ; Here any final preparations can be done before the main loop ; runs. ; GAMINI:: GIN$S #GI.UPD,#ARGBLK,#5 ; Reset UIC to that of terminal. GIN$S #GI.SPR,#0 ; Drop privileges. RETURN .SBTTL ZINIT ; ; ZINIT is the game initializing routine. It should somehow query ; the user about which game to play, look up, and open. ; ; Also process any possible switches... ; .ENABL LSB ZINIT:: FINIT$ ; Initialize FCS. SREX$C ABORT,,CODE ; Where to go if someone tries to abort us... SVTK$S #SSTVEC,#SSTLEN ; Setup vectors. MOV R3,VERBLK ; Save ZEMU version. MOV R4,VERBLK+2 MOV #$DBTS,R0 ; Copy date of build MOV #DATBLK,R1 ; to this place. MOV #10,R2 1111$: MOV (R0)+,(R1)+ SOB R2,1111$ ; ; First we'll create the default file name block for game files, ; in case a game file is given without a directory, and we ; might have a default directory to search. ; CSI$1 #CSI,#DDIR,#DDIRL ; Start by expanding the default dir. CSI$4 ,OUTPUT MOV #FDB,R0 ; The FDB we use. MOV #DFNAM2,R1 ; Filename block to fill in. MOV #CSI+C.DSDS,R2 ; Data set descriptor. MOV #DFNAM,R3 ; Default file name. BISB #FL.AEX,F.FLG(R0) ; Locial name expansion already done. CALL .PARSE ; Parse this. ; ; Now find out how much, if any, memory is preallocated. ; GTSK$C TSKPAR,CODE ; Get task parameters. BCC 1$ ; ; If GTSK$ fails, we're in serious trouble. How could it fail??? ; 101$: .MSG <"Could not find out task size."> EXIT$S ; 1$: MOV TSKPAR+G.TSTS,END ; Save end. MOV INFO+2,FREEPT ; Setup free pointer. .DBG #D.RSX,<"[ZINIT: FREEPT = END = %M]">,FREEPT ; ; The "main" loop to find a game to play. ; Start by reading a command. ; ZLOOP: GCML$ #GCM ; Get command (game name). BCC 10$ ; Ok? CMPB #GE.EOF,G.ERR(R0) ; No. EOF? BEQ 5$ ; Yes. .MSG <"Error reading command."> 5$: EXIT$S ; ; The next step is to initialize the parser. ; 10$: MOV #CSI,R0 ; Get CSI pointer. CLR C.SWAD(R0) ; No switches on command. CLR MASK CSI$1 ,GCM+G.CMLD+2,GCM+G.CMLD ; Parse line. BCC 20$ ; Worked? .MSG <"Unable to parse game name."> BR ZLOOP ; ; After that, we'll parse the game name. ; 20$: TST C.CMLD(R0) ; Empty line? BEQ ZLOOP ; Yes. BITB #CS.EQU,C.STAT(R0) ; Output specified? BNE 21$ ; Yes. CSI$4 ,OUTPUT,#SWTAB ; Get input filename. ; (silly of RSX to call a single ; file output...) BCC 30$ ; Ok? .MSG <"Bad format for game name."> BR ZLOOP 21$: .MSG <"You cannot specify an output file."> BR ZLOOP ; ; When we come this far, we make some sanity checks, and then ; we try to open the game file. ; 30$: BIT #10,MASK ; /ID given? BEQ 301$ ; No. MOV #BUF,R0 ; We'll do our own format here. MOV #VERFMT,R1 MOV #VERBLK,R2 CALL $EDMSG SUB #BUF,R0 QIOW$S #IO.WLB,#CMDLUN,#CMDEFN,,,,<#BUF,R0,#40> JMP ZLOOP 301$: BIT #20,MASK ; /HE given? BEQ 302$ ; No. MOV #BUF,R0 ; We'll do our own format here. MOV #HLPFMT,R1 MOV #VERBLK,R2 CALL $EDMSG SUB #BUF,R0 QIOW$S #IO.WLB,#CMDLUN,#CMDEFN,,,,<#BUF,R0,#40> JMP ZLOOP 302$: BIT #40,MASK ; /LI given? BEQ 303$ ; No. ; ; Here we shall list all available games... ; BIT #200,MASK ; /LO given? BNE 3020$ ; No. MOV #LFMT,FMTPTR ; Header line. MOV #DFNAM,R3 ; Default name. CALL DOLIST 3020$: BIT #100,MASK ; /SY given? BNE 3021$ ; No. MOV #GFMT,FMTPTR ; Header line. MOV #DFNAM2,R3 ; Default directory please. CLR CSI+C.DSDS ; Remove user specified deivce. CLR CSI+C.DSDS+4 ; Remove user specified directory. CALL DOLIST 3021$: JMP ZLOOP ; 303$: BITB #CS.NMF,C.STAT(R0) ; Filename specified? BNE 31$ ; Yes. .MSG <"No game name specified."> JMP ZLOOP 31$: BITB #CS.WLD,C.STAT(R0) ; Wildcard? BEQ 32$ ; No. .MSG <"Wildcard game names not supported."> JMP ZLOOP 32$: BITB #CS.MOR,C.STAT(R0) ; More filenames given? BEQ 33$ ; No. .MSG <"Only one game at a time, please."> JMP ZLOOP 33$: CMP C.FILD(R0),#9. ; More than 9 chars in filename? BLOS 34$ MOV #9.,C.FILD(R0) ; Yes. Truncate to 9 chars. 34$: MOV #DFNAM,FDB+F.DFNB ; Default filename block. CLR SYSFLG ; Clear system flag. OPNS$R #FDB,,,#FD.RWM,,,OPERR ; All ok. Open file. ; ; Once we have the game open, we make some additional sanity checks, ; in order to try making sure that this really is a game file. ; CMPB F.RTYP(R0),#R.FIX ; Fixed records? BNE 40$ ; No. Not a good game file. TSTB F.RATT(R0) ; No attributes, please... BNE 40$ ; We had some. CMP F.RSIZ(R0),#512. ; We expect 512 byte records. BEQ 50$ ; It was. All is good! ; ; Not a game file... ; 40$: CLOSE$ ; This wasn't a good file! .MSG <"That didn't look like a game file!"> JMP ZLOOP ; ; We have a game file. Now we'll just do some final setups, and ; then we're on the way to adventure! ; 50$: MOV #IO.RAT,R1 ; Read attributes MOV #2,R2 ; Additional params. MOV #RATBUF,R3 ; CALL .XQIO GIN$S #GI.SPR,#0 ; Drop privilege. ; ; Now we shall create a default name block for the save file name. ; ; Setup filename block for save file... ; MOV #SAVEXT,FDB+F.FNB+N.FTYP ; Default file extension... CLR FDB+F.FNB+N.FVER ; File version is 0. CLR FDB+F.FNB+N.DID ; Directory is current dir. CLR FDB+F.FNB+N.DID+2 CLR FDB+F.FNB+N.DID+4 MOV #"SY,FDB+F.FNB+N.DVNM ; Default device is SY0: CLR FDB+F.FNB+N.UNIT ; ; Now expand the default string, which combined with the just ; created default name will give us the default filename block ; to use in SAVE/RESTORE filenames. ; CSI$1 #CSI,#DSAV,#DSAVL ; Start by expanding the default dir. CSI$4 ,OUTPUT MOV #SAVFDB,R0 ; The FDB we use. MOV #DFNAM2,R1 ; Filename block to fill in. MOV #CSI+C.DSDS,R2 ; Data set descriptor. MOV #FDB+F.FNB,R3 ; Default file name is game name. BISB #FL.AEX,F.FLG(R0) ; Locial name expansion already done. CALL .PARSE ; Parse this. ; ; Now expand the default string, which combined with the just ; created default name will give us the default filename block ; to use in scripting filename. ; MOV #SCREXT,FDB+F.FNB+N.FTYP ; Default file extension... CSI$1 #CSI,#DSCR,#DSCRL ; Start by expanding the default dir. CSI$4 ,OUTPUT MOV #SAVFDB,R0 ; The FDB we use. MOV #DFNAM3,R1 ; Filename block to fill in. MOV #CSI+C.DSDS,R2 ; Data set descriptor. MOV #FDB+F.FNB,R3 ; Default file name is game name. BISB #FL.AEX,F.FLG(R0) ; Locial name expansion already done. CALL .PARSE ; Parse this. ; DIR$ #NOTIM ; Make sure the read timer flag isn't ; set. DIR$ #CLRIO ; Make sure read EFN is clear. QIOW$C SF.GMC,TILUN,CMDEFN,,IOSB,,,CODE ; Get terminal characteristics. TSTIO IOSB,IOERR QIOW$C SF.SMC,TILUN,CMDEFN,,IOSB,,,CODE ; Set some terminal chars... TSTIO IOSB,IOERR DIR$ #READ ; And setup read. ; RETURN ; Done? ; ; Open error. Perhaps we should try another default name? ; OPERR: BITB #CS.DIF,CSI+C.STAT ; Did we have an explicit dir? BNE 110$ ; Yes. No use in trying... ; ; If we didn't find game, let's try with default spec. ; MOV #DFNAM2,F.DFNB(R0) ; Default filename block. INC SYSFLG ; Trying system game. OPNS$R ,,,#FD.RWM,,,100$ ; Open file. RETURN ; All ok. ; 100$: ADD #2,SP ; Drop return address. 110$: ADD #2,SP CMPB F.ERR(R0),#IE.PRI BEQ 120$ .MSG <"Game file not found."> JMP ZLOOP 120$: .MSG <"Game file protected."> JMP ZLOOP .DSABL LSB ; ; Move a filename to a temp buffer, at the same time updating ; the FNB ; ; In: R2 - Pointer to dataset descriptor ; R3 - Default FNB. ; R1 - FNB. ; MOVNAM: CALL $SAVAL ; Save all registers. MOV #SFNAM,R0 ; Point at where to write filename. ADD #10,R2 ; Point at filename dataset. MOV (R2)+,R4 ; Get length of filename string. MOV (R2),R2 ; Get pointer to filename. TST R4 ; Any file string given? BNE 10$ ; Yes. Start copy. BIS #NB.SNM,N.STAT(R1) ; No. Then we assume wildcard. MOVB #'*,(R0)+ BR 20$ ; Done. 10$: CMPB (R2),#'* ; Copy filename. Wildcard chars? BEQ 15$ ; Yes. CMPB (R2),#'% BEQ 15$ ; Yes. BR 16$ ; No. 15$: BIS #NB.SNM,N.STAT(R1) ; Yes. Wildcard. Tell so. 16$: MOVB (R2)+,(R0)+ ; Copy. SOB R4,10$ ; Until all done. 20$: CLRB (R0) ; Mark end of filename. BIS #NB.SVR,N.STAT(R1) ; And always wildcard file version. BIT #NB.TYP,N.STAT(R1) ; Did we get explicit type? BNE 30$ ; Yes. MOV N.FTYP(R3),N.FTYP(R1) ; No. Copy default explicitly. 30$: RETURN ; ; Move R50 filename to temp storage. ; ; In: R1 - Pointer to R50 filename ; MOVNR5: CALL $SAVAL ; Save all registers. MOV #MFNAM,R0 ; Destination pointer. MOV R1,R5 ; Save pointer. MOV #3,R4 ; Loop count. 10$: MOV (R5)+,R1 ; Get word. CALL $C5TA ; Convert. SOB R4,10$ ; Repeat. CLRB (R0) ; Mark end of string. MOV #9.,R1 ; Loop count. 20$: CMPB -(R0),#' ; Space? BNE 30$ ; No. Done. CLRB (R0) ; Yes. Drop it. SOB R1,20$ ; Loop. 30$: RETURN ; Done. ; ; Match filenames. ; ; In: SFNAM - Search filename ; MFNAM - Match filename ; ; Out: CS - No match ; NAMMAT: CALL $SAVAL ; Save all registers. MOV #SFNAM,R0 ; Search filename. MOV #MFNAM,R1 ; Match filename. 10$: TSTB (R0) ; End of search filename? BEQ 100$ ; Yes. CMPB (R0),#'* ; Wildcard? BEQ 90$ ; Yes. CMPB (R0),#'% ; Any? BEQ 80$ ; Yes. CMPB (R0)+,(R1)+ ; Normal char. Match? BEQ 10$ ; Yes. Do next. 20$: SEC ; Not equal. Match failed. RETURN ; ; Match any one char. ; 80$: INC R0 ; Skip match char. TSTB (R1)+ ; Skip any char. BNE 10$ ; Do next. BR 20$ ; End of string. Failed. ; ; Match wild. ; 90$: INC R0 ; Skip match char. 91$: MOV R0,-(SP) ; Save pointers. MOV R1,-(SP) CALL 10$ ; And try match rest. BCC 99$ ; Match succeeded. Done. MOV (SP)+,R1 ; Restore pointer. MOV (SP)+,R0 TSTB (R1) ; End of string and no match? BEQ 20$ ; Yes. We fail. INC R1 ; No. Advance. BR 91$ 99$: ADD #4,SP ; Success. Clean stack. RETURN ; Carry is known clear here. ; ; Done. ; 100$: TSTB (R1) ; End of search string also? BNE 20$ ; No. Fail. RETURN ; Yes. Done. ; ; List existing games. ; ; Input: FMTPTR - List header to print ; R3 - Default name block ; DOLIST: CALL $SAVAL ; Save all registers. MOV #FDB,R0 ; FDB to use. MOV #FDB+F.FNB,R1 ; FNB to fill in. MOV #CSI+C.DSDS,R2 ; Data set descriptor. CLR FNDCNT ; Clear counter. BISB #FL.AEX,F.FLG(R0) ; Local name expansion already done. CALL .PARSE ; Parse this. CALL MOVNAM ; Move filename string, also ; setting flags in FNB. LLOOP: MOV #FDB,R0 MOV #FDB+F.FNB,R1 CALL .FIND ; Find file. BCC 10$ ; Okay... JMP 100$ ; Nothing found. Stop. 10$: ; We have a possible game found. Open it, verify attributes and ; contents of first part of memory. ADD #N.FNAM,R1 ; Point at filename. CALL MOVNR5 ; Move R50 filename. CALL NAMMAT ; Try to match names. BCS LLOOP ; Not a match. Try next. OPNS$R #FDB,,,#FD.RWM,,,300$ ; Open file. CMPB F.RTYP(R0),#R.FIX ; Check if file looks good... BNE 50$ TSTB F.RATT(R0) BNE 50$ CMP F.RSIZ(R0),#512. BNE 50$ ; Attributes are good... MOV #IOBUF,R1 ; Point at I/O buffer. MOV #1,BPAGE ; Read first block (BLK,,BPAGE) READ$ ,R1,#512.,#BLK,,,,200$ ; Read first block. WAIT$ ,,,200$ TSTB (R1) ; Check that type isn't 0. BEQ 50$ ; Bad. CMPB (R1),#8. ; Check that type isn't > 8 BHI 50$ ; Bad. MOV #ARGBLK,R2 ; Setup argument block. MOV #MFNAM,(R2)+ ; Game name MOV 2(R1),(R2) ; Second word is release. SWAB (R2)+ MOV R1,(R2) ; Point at serial number string. ADD #22,(R2)+ ; (12h) MOV R1,(R2) ; Point at inform version string. ADD #74,(R2)+ ; (3Ch) MOVB (R1),(R2)+ ; Z-machine version. TST FNDCNT ; Have we printed header_ BNE 20$ ; Yes. MOV FMTPTR,R1 ; No. Start with that. CALL ZMSG MOV #HFMT,R1 ; It's actually two lines... CALL ZMSG 20$: MOV #BUF,R0 ; Setup for $EDMSG MOV #FFMT,R1 MOV #ARGBLK,R2 CALL $EDMSG SUB #BUF,R0 ; Get length of lines. QIOW$S #IO.WLB,#CMDLUN,#CMDEFN,,,,<#BUF,R0,#40> ; Print it. INC FNDCNT ; Bump find counter. 50$: CLOSE$ #FDB ; Close file. ; BIT #NB.SNM,FDB+F.FNB+N.STAT ; Explicit name? ; BEQ 100$ ; Yes. Done. JMP LLOOP ; No. Search for next. 100$: RETURN ; Done. 200$: CLOSE$ ; Error. Close file. BR 400$ 300$: ADD #2,SP ; Drop return address. CMPB #IE.PRI,F.ERR(R0) ; Priv error? BNE 400$ JMP LLOOP ; Yes. Do next file. 400$: .MSG <"Really bad error occured."> EXIT$S .SBTTL ZBLK - Read a page from the game file into memory. ; ; In: BADDR - Address ; BPAGE - Page number ; BCNT - Block size ; .ENABL LSB ZBLK:: .DBG #D.RSX,<"[ZBLK: BADDR = %P, BPAGE = %D., BCNT = %D. bytes]">,BADDR,BPAGE,BCNT MOV R0,-(SP) ; Save R0. INC BPAGE ; Make info block bias. READ$ #FDB,BADDR,BCNT,#BLK,,,,10$ ; Issue read. WAIT$ ,,,10$ ; Wait for operation to complete. MOV (SP)+,R0 ; Restore R0. RETURN ; Done. ; 10$: .MSG <"I/O error while reading game file. Aborting..."> .MSG <"Error code is %B(%B).">,#FDB+F.ERR,#FDB+F.ERR+1 .MSG <"Block = %D,%D, size = %D.">,BLK,BLK+2,BCNT JMP ABORT .DSABL LSB .SBTTL Transcription game functions. ; ; SCROPN - Create a scripting file. ; ; In: R0 - Points at a filename to use. ; R1 - Length of filename. ; ; Out: Carry set - Failure. ; ; Filename is terminated by a NUL, which isn't included in the ; length. ; SCROPN:: MOV R0,CSI+C.CMLD+2 MOV R1,CSI+C.CMLD CSI$1 #CSI ; Initialize analyzer. BCS 100$ ; Fail. BITB #CS.EQU,C.STAT(R0) ; Found a '='? BNE 100$ ; Yes. Fail. CSI$4 ,OUTPUT BCS 100$ ; Fail. BITB #CS.WLD,C.STAT(R0) ; Wildcard? BNE 100$ ; Yes. BITB #CS.MOR,C.STAT(R0) ; ',' found? BNE 100$ ; Yes. OPEN$W #SCRFDB,,,,,,90$ RETURN ; Done. ; 90$: ADD #2,SP 100$: MOV #BADFN,R0 ; Bad file name message. CALL SCRTXT ; Tell it through the normal screen. SEC RETURN ; ; SCRBLK - Write a line to the script (log) file. ; ; In: R0 - Pointer to buffer. ; R1 - Length of buffer. ; ; The line is terminated by a NUL character, which isn't included ; in the length. ; SCRBLK:: MOV R0,-(SP) ; Save registers. MOV R2,-(SP) MOV R0,R2 ; Move address to R2. PUT$ #SCRFDB,R2,R1 ; Output line. MOV (SP)+,R2 ; Restore registers. MOV (SP)+,R0 RETURN ; ; SCRCLO - Close the script (log) file. ; SCRCLO:: MOV R0,-(SP) CLOSE$ #SCRFDB MOV (SP)+,R0 RETURN .SBTTL Save game functions. ; ; SAVOPN - Create a save file. ; ; In: R0 - Points at a filename to use. ; R1 - Length of filename. ; R2 - Flag for overwrite old or create new file. ; (1 = Write new file. ; 0 = Open old file to modify) ; ; Out: Carry set - Failure. ; ; Filename is terminated by a NUL, which isn't included in the ; length. ; SAVOPN:: MOV R0,CSI+C.CMLD+2 MOV R1,CSI+C.CMLD CSI$1 #CSI ; Initialize analyzer. BCS 100$ ; Fail. BITB #CS.EQU,C.STAT(R0) ; Found a '='? BNE 100$ ; Yes. Fail. CSI$4 ,OUTPUT BCS 100$ ; Fail. BITB #CS.WLD,C.STAT(R0) ; Wildcard? BNE 100$ ; Yes. BITB #CS.MOR,C.STAT(R0) ; ',' found? BNE 100$ ; Yes. MOV #SAVFDB,R0 MOVB #R.FIX,F.RTYP(R0) CLRB F.RATT(R0) MOV #512.,F.RSIZ(R0) TST R2 ; Overwrite file? BNE 10$ OPEN$U ,,,#FD.RWM,,,20$ ; Yes. Open for update. RETURN 20$: ADD #2,SP ; Error opening for update, try write. 10$: OPEN$W ,,,#FD.RWM,,,90$ ; No. Open for write. RETURN ; Done. ; 90$: ADD #2,SP ; Error. Drop return. 100$: MOV #BADFN,R0 ; Error message. CALL SCRTXT ; Write it through normal screen. SEC RETURN ; ; SAVBLK - Write a block to the save file. ; ; In: R0 - Pointer to a 512 byte buffer to write. ; SAVBLK:: MOV R0,-(SP) MOV R1,-(SP) MOV R0,R1 WRITE$ #SAVFDB,R1 WAIT$ MOV (SP)+,R1 MOV (SP)+,R0 RETURN ; ; SAVCLO - Close the save file. ; SAVCLO:: ; ; RESCLO - Close restore file. ; RESCLO:: MOV R0,-(SP) CLOSE$ #SAVFDB MOV (SP)+,R0 RETURN .SBTTL Restore game from file. ; ; RESOPN - Open file to restore from. ; ; In: R0 - Points to filename to open. ; R1 - Length of filename. ; ; Out: Carry set - Failure. ; ; Filename is terminated by a NUL, which isn't included in the ; length. ; RESOPN:: MOV R0,CSI+C.CMLD+2 MOV R1,CSI+C.CMLD CSI$1 #CSI ; Initialize analyzer. BCS 100$ ; Fail. BITB #CS.EQU,C.STAT(R0) ; Found a '='? BNE 100$ ; Yes. Fail. CSI$4 ,OUTPUT BCS 100$ ; Fail. BITB #CS.WLD,C.STAT(R0) ; Wildcard? BNE 100$ ; Yes. BITB #CS.MOR,C.STAT(R0) ; ',' found? BNE 100$ ; Yes. OPEN$R #SAVFDB,,,#FD.RWM,,,90$ CMPB F.RTYP(R0),#R.FIX BNE 200$ TSTB F.RATT(R0) BNE 200$ CMP F.RSIZ(R0),#512. BNE 200$ RETURN ; Done. ; 90$: ADD #2,SP ; Drop return address. CMPB F.ERR(R0),#IE.PRI ; Was it privilege violation? BEQ 91$ ; Yes. MOV #FNF,R0 ; No. The we failed to find file. BR 110$ 91$: MOV #FOE,R0 ; File was protected... BR 110$ 100$: MOV #BADFN,R0 ; Bad file name. 110$: CALL SCRTXT ; Print message. SEC ; Indicate failure. RETURN 200$: CLOSE$ MOV #BADFMT,R0 CALL SCRTXT SEC RETURN ; ; RESBLK - Read a block from restore file. ; ; In: R0 - Points at a data area to place next 512 byte block. ; RESBLK:: MOV R0,-(SP) MOV R1,-(SP) MOV R0,R1 READ$ #SAVFDB,R1 WAIT$ MOV (SP)+,R1 MOV (SP)+,R0 RETURN .SBTTL ZEXIT - Exit program. ; ; Do all eventual cleanup here. ; ; This is called from all over the place. ; One might argue that we could start over after getting here, ; but currently we are expected to return to the OS... ; .ENABL LSB ZEXIT:: .DBG #D.RSX,<"Entered ZEXIT]"> CLOSE$ #FDB ; Close game file. QIOW$C SF.SMC,TILUN,CMDEFN,,,,,CODE ; Restore terminal mode. EXIT$S ; Return to OS. .SBTTL ZALLOC - Allocate a page of memory. ; ; Other code makes the assumption that pages are allocated ; linear and sequential, so that you can call ZALLOC twice ; to get larger space. ; ; In: R0 - Bytes to allocate. ; Out: R0 - Address of memory. ; ; If carry is set, we failed the allocate. The game will never call ; this routine agan after this error, so the state we leave in ; don't matter at that time. ; .ENABL LSB ZALLOC:: .DBG #D.RSX,<"[ZALLOC: Requested size = %D. bytes]">,R0 INC R0 ; Round off to words. BIC #1,R0 MOV FREEPT,-(SP) ; Save pointer to memory. ADD R0,FREEPT ; Set new free pointer. BCS 20$ ; We wrapped. New alloc went over the top. CMP FREEPT,END ; Check if we are inside alloc mem. BLOS 10$ ; We are. All is ok. MOV FREEPT,R0 ; Get free pointer. SUB END,R0 ; Find out how much memory we miss. ADD #77,R0 ; Round up. BIC #77,R0 ADD R0,END ; This is the new end. BCS 20$ ; Overflow... ASH #-6,R0 ; Divide by 64. BIC #176000,R0 ; Mask off bits we know should be 0. EXTK$S R0 ; Extend task. BCS 20$ ; Error extending... 10$: CLC MOV (SP)+,R0 ; Get address of new memory block. .DBG #D.RSX,<"[ZALLOC: Memory allocated at %P]">,R0 RETURN 20$: TST (SP)+ ; Clean stack. .DBG #D.RSX,<"[ZALLOC failed to allocate more memory]"> SEC ; Mark error. RETURN .SBTTL GETSCL - Get screen width. ; ; Screen info routines. ; ; Get screen width. ; ; Out: R0 - Width of screen. ; .ENABL LSB GETSCL:: CLR R0 BISB WID,R0 .DBG #D.RSX,<"[GETSCL: returning %D. columns]">,R0 RETURN .SBTTL GETSLN - Get screen length. ; ; Get screen length. ; ; Out: R0 - Length of screen. ; .ENABL LSB GETSLN:: CLR R0 BISB LPP,R0 .DBG #D.RSX,<"[GETSLN: returning %D. lines]">,R0 RETURN .SBTTL GETSTP - Get screen type. ; ; Get screen type. ; ; Out: R0 - Screen type. ; .ENABL LSB GETSTP:: MOV #UNKT,R0 ; Default is unknown... CMPB TTP,#T.VT52 BNE 10$ MOV #VT52,R0 ; Type is VT52. 10$: CMPB TTP,#T.V100 BNE 20$ MOV #VT100,R0 20$: CMPB TTP,#T.V102 BNE 30$ MOV #VT102,R0 30$: CMPB TTP,#T.V2XX BNE 40$ MOV #VT200,R0 40$: .DBG #D.RSX,<"[GETSTP: returning terminal type %D.]">,R0 RETURN .DSABL LSB ; ; Get if we have text attributes. ; GETAVO:: TSTB AVO BEQ 10$ SEC 10$: RETURN ; ; Get if we have color. ; GETCOL:: TSTB RGS BEQ 10$ SEC 10$: RETURN ; ; Get if we have font 3. ; GETSOF:: TSTB SOFT BEQ 10$ SEC 10$: RETURN ; ; Error handlers. ; CODE: MOV (SP)+,R0 .MSG <"Directive error at PC=%P $DSW=%O">,R0,$DSW EXST$S #2 ; IOERR: MOV (SP)+,R0 MOV (SP)+,R1 MOV (SP)+,R2 .MSG <"I/O error at PC=%P IOSB=%O,%O">,R0,R1,R2 EXST$S #2 .SBTTL CACHE functions ; ; CHESIZ - Get size of cache page ; ; This routine is called before starting to allocate cache memory, ; and so we can use it for any preparatory work needed for cache memory ; allocation. ; ; Out: R0 - Size ; .ENABL LSB CHESIZ:: GIN$S #GI.SPR,#1 ; Gain privilege. BCS 1001$ ; Couldn't get privs. Use small cache. ; ; We have privileges. Let's fool around some. ; GIN$S #GI.DEF,#454 ; Set UIC to [1,54] MOV #^C1,FILPRO ; Change protection to SY:R only 1001$: JSR R5,.SAVR1 ; Save registers. TFEA$S #T4$FMP ; Do we have fastmap? CMPB $DSW,#IS.SET BNE 1000$ ; No. No fastmap. MOV #-1,MAPF ; Yes. Save fastmap function pointer. .DBG #D.MAP,<"Using FASTMAP"> 1000$: BIT #400,MASK BNE 1$ ; /MM or /PS TST SYSFLG BEQ 1$ ; Not system game. Don't use large cache MOV GAMSIZ,R1 ; Get game size. CLR R0 ASHC #9.,R0 SUB DYNHI,R1 SBC R0 ASHC #-6,R0 CMP R1,#8192./64. ; Game less than one page? BLO 1$ ; Too small game BR 2$ ; We'll try large cache size. 1$: JMP STDCHE ; User small (standard) cache size. 2$: ; ; First we need to find out which APRs are free... ; .DBG #D.MAP,<"WS.MAP: %P, WS.SIS: %P, WS.UDS: %P">,#WS.MAP,#WS.SIS,#WS.UDS SUB #193.*2,SP ; Make space on stack. MOV SP,R0 ; Save pointer GMCX$S R0 ; Get current mapping 10$: TST (R0) ; Search for end of list. BMI 100$ ; End found. .DBG #D.MAP,<"APR: %P, Siz: %P, Sts: %P">,W.NAPR-1(R0),W.NLEN(R0),W.NSTS(R0) BIT #WS.MAP,W.NSTS(R0) ; Window mapped? BEQ 90$ ; No. BIT #WS.SIS,W.NSTS(R0) ; Yes. Supervisor mode? BNE 90$ ; Yes. Ignore it. MOV #IAPR,R1 ; No. Assume I-space. BIT #WS.UDS,W.NSTS(R0) ; D-space? BEQ 20$ ; No. MOV #DAPR,R1 ; Yes. 20$: MOV #1,R2 ; Bitmask. MOVB W.NAPR(R0),R3 ; Get base apr. ASH R3,R2 ; Make APR mask. 30$: .DBG #D.MAP,<"Setting bit %P in %P (%P)">,R2,R1,W.NLEN(R0) BIS R2,(R1) ; Mark APR as used. ASL R2 ; Move mask to next apr. SUB #<8192./64.>,W.NLEN(R0) ; Step forward in window. BGT 30$ ; Repeat if window covers next APR. 90$: ADD #20,R0 ; Next window. BR 10$ 100$: ADD #193.*2,SP ; Remove info from stack. .DBG #D.MAP,<"ISPACE: %P, DSPACE: %P">,IAPR,DAPR ; ; Now we know what APRs we can use. If DAPR.NE.0 we have D-space, and ; we should analyze that mask, otherwise we should use I-space. ; MOV #WS.UDS,ZWDB+W.NSTS ; Assume we want D-space. MOV DAPR,R0 ; Get mask. BNE 110$ ; There was something. MOV IAPR,R0 ; Nothing. Use I-space. CLR ZWDB+W.NSTS ; We want I-space. 110$: COMB R0 ; Invert all bits. MOV R0,APRMSK ; Save APR mask. .DBG #D.MAP,<"APRMSK is %P">,R0 ; ; We now have an APR-mask which we can use if we want to. ; R0 have a one for each free APR. ; Let's just count how many free APRs we have. ; CLR R1 ; Count of free APRs. 120$: INC R1 ; Count one APR. MOV R0,R2 ; Get mask in R2. NEG R2 ; Negate it. BIC R2,R0 ; This is neat. Clear one bit in the mask. BNE 120$ ; And if there still are bits set, repeat. ; ; R1 now have number of free APRs to use. ; .DBG #D.MAP,<"%D free APRs">,R1 CMP R1,MINAPR ; How many APRs do we require? BHIS 121$ JMP STDCHE ; We have fewer. Let's use small bufs. 121$: ; ; We have now decided to use memory mapped game. ; MOV GAMSIZ,R1 ; Get game size. CLR R0 ASHC #9.,R0 ; Make into bytes. SUB DYNHI,R1 ; Drop dynamic memory. SBC R0 ASHC #-6,R0 ; Get size in 64B blocks. MOV R1,ZRDB+R.GSIZ ; Size of region. MOV GAMR50,ZRDB+R.GNAM ; Name of region. MOV GAMR50+2,ZRDB+R.GNAM+2 CLR ZRDB+R.GPAR ; Partition name CLR ZRDB+R.GPAR+2 MOV #,ZRDB+R.GSTS MOV FILPRO,R0 ; Get file protection. BIS #167346,R0 ; Remove: WO:WED,GR:WED,OW:WED,SY:WE MOV R0,ZRDB+R.GPRO ; Set as region prot. ATRG$S #ZRDB ; Try to attach. CMP #IS.SUC,$DSW ; Ok? BEQ 140$ ; Yes. We're happy. CMP #IE.PNS,$DSW ; Any other error than region don't ; exist? BNE 139$ ; Yes. Fail. BIS #RS.WRT,ZRDB+R.GSTS ; Not ok. Try to create with write. CRRG$S #ZRDB ; Create region. CMP #IS.SUC,$DSW ; Result ok? BEQ 140$ 139$: .DBG #D.MAP,<"Failed to attach. %P">,$DSW JMP STDCHE 140$: .DBG #D.MAP,<"Create region ok."> MOV ZRDB+R.GID,ZWDB+W.NRID ; Save region ID. ; Check for creation here as well, just in case we had two users ; try this at about the same time. BIT #RS.CRR,ZRDB+R.GSTS ; Did we create region? BEQ 200$ ; Nope. .DBG #D.MAP,<"We are responsible for filling the region."> ; ; Next we need to create atleast one window, and map it ; in order to copy the game file... ; MOV APRMSK,R0 ; Get APR-mask MOV #-1,R1 ; R1 will have base address. 141$: INC R1 ; Next APR. ASR R0 ; Shift mask. BCC 141$ ; If APR not free, repeat. ; ; R1 now holds a base APR to use. ; .DBG #D.MAP,<"We'll use APR %D for filling.">,R1 MOVB R1,ZWDB+W.NAPR ; Window base APR MOV #8192./64.,ZWDB+W.NSIZ ; Size of window. CLR ZWDB+W.NOFF ; Offset. CLR ZWDB+W.NLEN ; Length. BIS #,ZWDB+W.NSTS ; More flags. CRAW$S #ZWDB ; Create address window and map it. CMP #IS.SUC,$DSW ; Okay? BNE 210$ ; No. .DBG #D.MAP,<"Created window ok."> ; ; Let's start filling it in. ; MOV DYNHI,R0 ; Block #. ASH #-9.,R0 ; First block of static mem. MOV ZRDB+R.GSIZ,R1 ; Size to copy. MOV #8192./64.,R2 ; Window size. MOV ZWDB+W.NBAS,R3 ; Get base address. 150$: MOV R1,R4 ; Copy rest of data. CMP R4,R2 ; If window is smaller... BLOS 160$ ; ... MOV R2,R4 ; ...we shall copy window size. 160$: MOV R4,R5 ; Get size to copy in R5. ASH #6,R5 ; Make into bytes. .BLK R3,R0,R5 ; Read data. ADD R4,ZWDB+W.NOFF ; Move map ahead. CLR ZWDB+W.NLEN DIR$ #DOMAP ASH #-9.,R5 ; Make size in blocks. ADD R5,R0 ; Next block... SUB R4,R1 ; Decrement data we need to copy. BNE 150$ ; ; Now we have copied all data. ; 200$: ;CLOSE$ #FDB ; Close game file. (Cannot do b.c. save/restore) MOV #8192.,R0 ; Cache size. MOV #-1,CHEFLG ; Set flag. RETURN ; Done. ; 210$: .MSG <"Failed to create address window. %P">,$DSW ; ; Small buffer cache. ; STDCHE: MOV PGSIZ,R0 ; Cache size. CLR CHEFLG ; Clear flag. RETURN ; ; CHEALL - Cache allocate ; ; Out: CS - No more cache memory available. ; CC - R0 - Block id. ; R1 - Base address ; .ENABL LSB CHEALL:: TST CHEFLG ; Large cache size? BNE 10$ ; Yes. .ALLOC PGSIZ ; No. MOV R0,R1 ; Physical address is also ID. RETURN ; Carry is preserved from .ALLOC ; 10$: MOV #1,R0 ; Mask. CLR R1 ; Base APR .DBG #D.MAP,<"Looking for free APRs."> 20$: BIT R0,APRMSK ; Is this APR free? BNE 30$ ; Yes. ASL R0 ; No. Check next bit. INC R1 ; And that is a new APR. CMP R1,#10 ; Beyond APR 7? BLO 20$ ; No. Loop. .DBG #D.MAP,<"No APR free."> SEC ; No more APRs available. Indicate. RETURN ; Done. 30$: .DBG #D.MAP,<"APR %D taken.">,R1 BIC R0,APRMSK ; APR taken. MOVB R1,ZWDB+W.NAPR ; Setup WDB. MOV #<8192./64.>,ZWDB+W.NSIZ ; Size of window. CLR ZWDB+W.NOFF ; Offset. CLR ZWDB+W.NLEN ; Length. BIS #WS.MAP,ZWDB+W.NSTS ; Flags. ; CLR ZWDB+W.NSTS ; Flags. CRAW$S #ZWDB ; Create address window. CMP #IS.SUC,$DSW ; Did we succeed? BNE 40$ ; No. MOV ZWDB+W.NBAS,R1 ; Base address. MOVB ZWDB+W.NID,R0 ; Id. TST MAPF ; Are we using fastmap? BEQ 39$ ; No. MOVB ZWDB+W.NAPR,R0 ; Yes. Use a different type of ID then. ASH #3,R0 ; Move into correct place for fastmap. BIT #WS.UDS,ZWDB+W.NSTS ; Do we use D-space? BEQ 39$ ; No. BIS #100,R0 ; Yes. Indicate in ID. 39$: .DBG #D.MAP,<"CHEALL returns with %P/%P">,R0,R1 RETURN 40$: .MSG <"Failed to create address window. %P">,$DSW JMP ABORT ; ; CHEUPD - Cache update ; ; In: R0 - Block id. ; R2,R3 - Virtual address ; ; Out: R0 - Offset to virtual address from virtual base. ; R2,R3 - Virtual base address. ; .ENABL LSB CHEUPD:: MOV R3,-(SP) ; Save offset. TST CHEFLG ; What model? BNE 10$ ; Large... ; ; Small... ; (Block id is the same as the physical address of the page) ; ASHC #-9.,R2 ; Shift down address to page. .BLK R0,R3,PGSIZ ; Read in data. ASHC #9.,R2 ; Get base address. MOV (SP)+,R0 ; Get offset... SUB R3,R0 RETURN ; Done. ; ; Large... ; 10$: .DBG #D.MAP,<"CHEUPD: %P -- %P,,%P">,R0,R2,R3 SUB DYNHI,R3 ; Drop dynamic memory from offset. SBC R2 ASHC #-6,R2 ; Offset is in 64B blocks. BIC #7,R3 ; And must be aligned on 512B. TST MAPF ; Using fastmap? BEQ 20$ ; No. ; FASTMAP MOV R1,-(SP) ; Yes. Save R1. MOV R3,R1 ; R1 shall be offset. MOV ZRDB+R.GSIZ,R2 ; Get end of region. SUB #200,R2 ; This is the highest offset we use... CMP R1,R2 ; Are we past that? BLOS 15$ ; No. MOV R2,R1 ; Yes. Use high limit instead. 15$: MOV R1,-(SP) ; Save offset. IOT ; Fast map. CMP #IS.SUC,R0 ; Checkl result. BNE 30$ MOV (SP)+,R3 ; Restore offset. CLR R2 MOV (SP)+,R1 ; Restore R1. BR 25$ ; NORMAL MAP 20$: MOV R0,ZWDB+W.NID ; Id. MOV R3,ZWDB+W.NOFF ; Offset. CLR ZWDB+W.NLEN ; Length to map. DIR$ #DOMAP ; Map window. CMP #IS.SUC,$DSW ; Okay? BNE 40$ ; No. ; 25$: ASHC #6,R2 ; Get base address. ADD DYNHI,R3 ADC R2 MOV (SP)+,R0 ; Get offset. SUB R3,R0 ; Make relative. .DBG #D.MAP,<"RETURN: %P -- %P,,%P">,R0,R2,R3 RETURN 30$: .MSG <"FASTMAP failed. %P %P(%P)">,R0,R1,ZRDB+R.GSIZ JMP ABORT 40$: .MSG <"MAP$ failed. %P %P(%P)">,$DSW,R3,ZRDB+R.GSIZ JMP ABORT ; .END .NLIST ;+ ; ZMAC - Macros for ZEMU. ; (c) 2000 by Johnny Billquist ;- ; ; Setup defaults, just in case ZEMU.CND didn't define them. ; ; Default name for game files. .IF NDF GAMMAC .MACRO GAMDIR .ASCII /SY:.DAT/ .ENDM GAMDIR .ENDC ; Default name for save files. .IF NDF SAVMAC .MACRO SAVDIR .ASCII /SY:.ZSG;0/ .ENDM SAVDIR .ENDC ; Default name for script files. .IF NDF SCPMAC .MACRO SCPDIR .ASCII /SY:.LOG;0/ .ENDM SCPDIR .ENDC .IIF NDF DCSIZE DCSIZE=10. ; Default cache size. .IIF NDF GAMSTK GAMSTK=1024. ; Default game stack size. .IIF NDF DIID DIID=1 ; Default interpreter ID .IIF NDF DBUG DBUG=1 ; Debug included or not .IIF NDF EIS EIS=1 ; Use EIS .IIF NDF ESOB ESOB=0 ; Use emulated SOB .IIF NDF RSX RSX=0 ; Target is RSX system ; MAXVER=8. ; Max z-machine game version we handle. ; ; Terminal types. ; UNKT=0 ANSI=1 VT52=2 VT100=3 VT102=4 VT200=5 VT300=6 VT400=7 VT500=10 ; ; Debug options. ; D.INFO=1 ; Informational D.MEM=2 ; Memory related D.INST=4 ; Instruction related D.DEC=10 ; Instruction decoding related D.VAR=20 ; Variable related D.CACH=40 ; Cache related D.TRC=100 ; Trace D.MRF=200 ; Memory references D.STK=400 ; Stack use D.LOC=1000 ; Local variables D.PARS=2000 ; Parser D.MAP=4000 ; Memory mapping ; ; General macros. ; ; .BRK - Check for z-machine breakpoint. .MACRO .BRK HI,LO,?ADR .IF GT,DBUG CMP HI,ZBRK BNE ADR CMP LO,ZBRK+2 BNE ADR BPT ADR: .ENDC .ENDM .BRK ; .MSG - Output a text message. .MACRO .MSG TXT,ARG1,ARG2,ARG3,ARG4 .SAVE .PSECT TEXT,D,RO $$$=. .ASCIZ TXT .RESTORE MOV R1,-(SP) SUB #10,SP .IF NB ARG1 MOV ARG1,(SP) .ENDC .IF NB ARG2 MOV ARG2,2(SP) .ENDC .IF NB ARG3 MOV ARG3,4(SP) .ENDC .IF NB ARG4 MOV ARG4,6(SP) .ENDC MOV #$$$,R1 CALL ZMSG ADD #10,SP MOV (SP)+,R1 .ENDM .MSG ; .DBG - Output a conditional debug message. .MACRO .DBG WHEN,STR,ARG1,ARG2,ARG3,ARG4,?LBL .IF GT,DBUG BIT WHEN,DBGFLG BEQ LBL .MSG ,ARG1,ARG2,ARG3,ARG4 LBL: .ENDC .ENDM .DBG ; .INSTR - Setup handler for instruction, including doing some general ; maintenance at the start. .MACRO .INSTR name,args,?LBL,?FNAM .IF GT,DBUG .SAVE .PSECT TEXT,D,RO FNAM: .ASCIZ name .RESTORE BIT #D.INST,DBGFLG BEQ LBL MOV #FNAM,INAM CALL ISHOW LBL: .ENDC .IF NB args .CHKAC args .ENDC .ENDM .INSTR ; .BLK - Read data from gamefile to memory .MACRO .BLK ADDR,PAGE,CNT MOV PAGE,BPAGE MOV ADDR,BADDR .IF NB CNT MOV CNT,BCNT .IFF MOV #512.,BCNT .ENDC CALL ZBLK .ENDM .BLK ; .ALLOC - Allocate memory .MACRO .ALLOC SIZE .IF B SIZE MOV #512.,R0 .IFF MOV SIZE,R0 .ENDC CALL ZALLOC .ENDM .ALLOC ; .GETIB - Get byte from instruction stream .MACRO .GETIB DEST CALL ZGETIB .IF NB DEST MOV (SP)+,DEST .IFF MOV (SP)+,R0 .ENDC .ENDM .GETIB ; .GETIW - Get word from instruction stream .MACRO .GETIW DEST CALL ZGETIB SWAB (SP) CALL ZGETIB ADD (SP)+,(SP) .IF NB DEST MOV (SP)+,DEST .IFF MOV (SP)+,R0 .ENDC .ENDM .GETIW ; .GETBB - Get byte from byte-address .MACRO .GETBB ADDR,DEST MOV ADDR,-(SP) CALL ZGETBB .IF NB DEST MOV (SP)+,DEST .IFF MOV (SP)+,R0 .ENDC .ENDM .GETBB ; .GETWB - Get word from byte-address .MACRO .GETWB ADDR,DEST MOV ADDR,-(SP) CALL ZGETWB .IF NB DEST MOV (SP)+,DEST .IFF MOV (SP)+,R0 .ENDC .ENDM .GETWB ; .GETBW - Get byte from word-address .MACRO .GETBW ADDR,DEST MOV ADDR,-(SP) CALL ZGETBW .IF NB DEST MOV (SP)+,DEST .IFF MOV (SP)+,R0 .ENDC .ENDM .GETBW ; .GETWW - Get word from word address .MACRO .GETWW ADDR,DEST MOV ADDR,-(SP) CALL ZGETWW .IF NB DEST MOV (SP)+,DEST .IFF MOV (SP)+,R0 .ENDC .ENDM .GETWW ; .PUTBB - Put byte at byte-address .MACRO .PUTBB ADDR,VAL MOV ADDR,-(SP) MOV VAL,-(SP) CALL ZPUTBB .ENDM .PUTBB ; .PUTWB - Put word at byte-address .MACRO .PUTWB ADDR,VAL MOV ADDR,-(SP) MOV VAL,-(SP) CALL ZPUTWB .ENDM .PUTWB ; .PUTBW - Put byte at word-address .MACRO .PUTBW ADDR,VAL MOV ADDR,-(SP) MOV VAL,-(SP) CALL ZPUTBW .ENDM .PUTBW ; .PUTWW - Put word at word-address .MACRO .PUTWW ADDR,VAL MOV ADDR,-(SP) MOV VAL,-(SP) CALL ZPUTWW .ENDM .PUTWW ; .CHKAC - Check argument count of instruction .MACRO .CHKAC CNT,?LBL .IF GT,DBUG CMP R3,CNT BEQ LBL JMP BADFUN LBL: .ENDC .ENDM .CHKAC ; ; Macros to simulate some instructions we don't have if no EIS ; ; MUL .IF GT,EIS .MACRO MUL SRC,DST MOV SRC,-(SP) ; Save source. MOV DST,-(SP) ; Destination. CALL ZEMUL ; Do multiply. .NTYPE ARG1,DST ; Get destination register ARG2=ARG1 ; We have two destinations... .IF EQ ARG1&1 ; If dst is even register, ARG2=ARG1+1 ; the dst is actually 32 bits. .ENDC 012600+ARG1 ; Get high part of answer. 012600+ARG2 ; Get low part of answer. .ENDM MUL ; DIV .MACRO DIV SRC,DST .NTYPE ARG1,DST ; Get both destination registers. ARG2=ARG1+1 010046+ ; Push low part. 010046+ ; Push high part. MOV SRC,-(SP) ; Push source. CALL ZEDIV ; Do divide. TST (SP)+ ; Remove junk. 012600+ARG2 ; Save remainder. 012600+ARG1 ; Save quotient. .ENDM DIV ; ASH .MACRO ASH SRC,DST,?L1,?L2,?L3 MOV SRC,-(SP) ; Setup count in (SP) BMI L1 BEQ L3 L2: ASL DST DEC (SP) BNE L2 BR L3 L1: ASR DST INC (SP) BNE L1 L3: TST (SP)+ TST DST .ENDM ASH ; ASHC .MACRO ASHC SRC,DST,?L1,?L2,?L3 .NTYPE ARG1,DST ARG2=ARG1+1 SHL1=+ARG2 SHL2=+ARG1 SHR1=+ARG1 SHR2=+ARG2 MOV SRC,-(SP) BMI L1 BEQ L3 L2: SHL1 SHL2 DEC (SP) BNE L2 BR L3 L1: SHR1 SHR2 INC (SP) BNE L1 L3: TST (SP)+ TST DST .ENDM ASHC .ENDC ; Emulated SOB .IF GT,ESOB .MACRO SOB SRC,DST DEC SRC BNE DST .ENDM SOB .ENDC .LIST ; created at 09:47:23 on 01-NOV-00 .MACRO GAMDIR .ASCII "ZEMU$GAMES:.DAT;0" .ENDM GAMDIR GAMMAC = 1 .MACRO SAVDIR .ASCII "SYS$LOGIN:.ZSG;0" .ENDM SAVDIR SAVMAC = 1 .MACRO SCPDIR .ASCII "SY:.LOG;0" .ENDM SCPDIR SCPMAC = 1 DCSIZE = 10. GAMSTK = 1024. DIID = 1. DBUG = 0 EIS = 0 ESOB = 0 RSX = 0 FMAP = 1 .TITLE ZEMU .IDENT /V1.3/ ; ++ ; This is a Z-machine emulator. ; (c) 2000, 2004 by Johnny Billquist ; ; History: ; ; 00-07-19 BQT Initial coding started. ; Y1.0 00-08-26 21:00 BQT First release. ; V1.1 00-09-16 12:00 BQT Made official. ; V1.2 00-09-24 01:30 BQT Added code for non-EIS machines. ; V1.3 04-08-31 11:30 BQT Added call to GAMINI ; -- .INCLUDE /ZMAC/ ; .PSECT CODE,I,RO ; .ENABL LSB ; START:: CALL ZINIT CALL MEMINI CALL SCRINI CALL VARINI .GETBB #0 .DBG #D.INFO,<"We have a game. Version is %D.">,R0 .GETBB #1 .DBG #D.INFO,<"Flags are %P.">,R0 .GETWB #4 .DBG #D.INFO,<"High memory base is %M.">,R0 .GETWB #6 .DBG #D.INFO,<"Start address is %M.">,R0 .GETWB #10 .DBG #D.INFO,<"Dictionary is at %M.">,R0 .GETWB #12 .DBG #D.INFO,<"Object table is at %M.">,R0 .GETWB #14 .DBG #D.INFO,<"Global variables table is at %M.">,R0 .GETWB #16 .DBG #D.INFO,<"Static memory starts at %M.">,R0 .GETWB #30 .DBG #D.INFO,<"Abbreviations table is at %M.">,R0 .GETWB #32 .DBG #D.INFO,<"Length of file is %M.">,R0 CALL GAMINI CALL ZRUN ZEND:: CALL SCRRES CALL PRSTOP JMP ZEXIT .DSABL LSB ; .IF GT EIS ; ; Emulate PDP-11 MUL instruction. ; ; In: 4(SP) SRC ; 2(SP) DST ; ; Out: 4(SP) Low part ; 2(SP) High part. ; ZEMUL:: MOV R0,-(SP) ; Save registers. MOV R1,-(SP) MOV 6(SP),R0 ; The lower value is used as loop count CMP R0,10(SP) BLOS 10$ MOV 10(SP),6(SP) ; Other is lower. Exchange them. MOV R0,10(SP) 10$: CLR R0 ; Clear result. CLR R1 INC 6(SP) ; Setup loop counter +1. 20$: DEC 6(SP) ; Finished? BEQ 30$ ; Yes. ADD 10(SP),R0 ; Add one time. BCC 20$ ; No carry, do again. INC R1 ; When we have carry set, we bump high. BR 20$ ; Repeat. 30$: MOV R1,6(SP) ; Done. Save high part. MOV R0,10(SP) ; Save low part. MOV (SP)+,R1 ; Restore registers. MOV (SP)+,R0 RETURN ; Done. ; ; Emulate PDP-11 DIV instruction. ; ; In: 6(SP) High part ; 4(SP) Low part ; 2(SP) Dividend ; ; Out: 6(SP) Quotient ; 4(SP) Remainder ; 2(SP) Junk ; ZEDIV:: MOV R0,-(SP) ; Save registers. MOV R1,-(SP) MOV 12(SP),R0 ; Get low. MOV 10(SP),R1 ; Get high. MOV #-1,12(SP) ; Setup quotient. 10$: INC 12(SP) ; Count quotient. SUB 6(SP),R0 ; Count on. BCC 10$ ; Not done yet. SBC R1 ; High part changed. BCC 10$ ; Not done yet... ADD 6(SP),R0 ; Done. Restore remainder. MOV R0,10(SP) ; Save remainder. MOV (SP)+,R1 ; Restore registers. MOV (SP)+,R0 RETURN ; Done. ; .ENDC ; .END START .TITLE ZMEM .IDENT /V1.13/ ; ++ ; This is the virtual memory handler. ; (c) 2000, 2003 by Johnny Billquist ; ; History: ; ; 00-08-01 BQT Initial coding started. ; Y1.0 00-08-26 21:00 BQT First release. ; Y1.1 00-09-08 02:00 BQT Added initializing of random number. ; Y1.2 00-09-14 11:30 BQT Bugfix. The error message in BADVER didn't ; extract the game version number correctly. ; V1.3 00-09-16 12:00 BQT Changed all ZEXIT to ABORT. ; Make it more officially done. ; V1.4 00-09-20 22:00 BQT Added check for silly small screen width values. ; V1.5 00-09-22 01:00 BQT Added timeout of 3s. to game start warnings. ; V1.6 01-02-16 16:45 BQT Improved sanity check of games before trying ; to run them. ; V1.7 01-03-04 03:30 BQT Added initializing of memory cells to indicate ; that we adhere to standard 1.0 ; V1.8 01-03-04 04:30 BQT Changed initialization of flg2 to truly reflect ; font 3 capability. ; V1.9 03-01-23 02:30 BQT Added special RSX mode. ; V1.10 03-08-14 20:00 BQT Changed interface to OS routines to allow ; for different page sizes, and different ; memory models. ; V1.11 05-02-21 01:30 BQT Added V6/V7 address translation. ; V1.12 05-02-22 11:00 BQT Moved all screen stuff to ZSCREE.MAC. ; V1.13 05-07-26 01:00 BQT Bugfix in cache output. Tell correct number ; of pages acquired, and correct call to GETCH2. ; -- .INCLUDE /ZMAC/ .PSECT RECORD,RW,D,GBL,ABS,OVR ; .ASECT .=0 R.NEXT: .BLKW 1 ; Link to next entry. R.REF: .BLKW 1 ; Reference ID. R.ADDR: .BLKW 2 ; Physical base. R.BASE: .BLKW 1 ; Virtual address. R.SIZE=. R.MAX=10. .PSECT DATA,D,RW ; ZEROP:: .WORD 0 ; Here we'll get a pointer to ; where zero page is in physical mem. DYNHI:: .WORD 512. ; Initial dynamic high address ; is just after zero page. WRLIM:: .WORD 0 ; Initial limit for writable mem. CACHE:: .WORD 0 ; Linked list header for cache. R.BLK:: .BLKB R.MAX*R.SIZE ; The record cache. R.LEN:: .WORD 0 ; The size of a record. ; INTERP::.WORD DIID ; Interpreter number (Default mainframe) ; CLIM:: .WORD DCSIZE ; Limit on how much cache to allocate. DBGFLG::.WORD 0 ; Debugging flag. ; ZPC:: .WORD 0 ; The emulator PC. .WORD 0 ; .IF NE,DBUG ZBRK:: .WORD 0,0 ; Address in zmachine where to do BPT. FZPC:: .WORD 0,0 ; Address of last fetch. .ENDC ; ZVER:: .WORD 0 ; Game version. ZFLG1:: .WORD 0 ; Flag 1. ZFLG2:: .WORD 0 ; Flag 2. ZDICT:: .WORD 0 ; Dictionary address. ZOBJ:: .WORD 0 ; Object table address. ZVAR:: .WORD 0 ; Global variables address. ZABBR:: .WORD 0 ; Abbreviations address. ZTCPTR::.WORD 0 ; Address of terminating char list. ; OBJLEN::.WORD 0 ; Length of an object. OBJOFF::.WORD 0 ; Offset to start of objects. ; APACK:: .WORD 0 ; Pointer to function to calculate ; packed address. PPACK:: .WORD 0 ; Pointer to function to calculate ; text packed address. NXTPRO:: .WORD 0 ; Pointer to function to get prop adr. DORO:: .WORD 0 ; Pointer to function to remove obj. DOIO:: .WORD 0 ; Pointer to function to insert obj. ; STKTOP:: .WORD 0 ; Pointer to game stack top. ; PATAB: .WORD PADDR1 ; Version 1. .WORD PADDR1 ; V2 .WORD PADDR1 ; V3 .WORD PADDR4 ; V4 .WORD PADDR4 ; V5 .WORD PADDR6 ; V6 .WORD PADDR6 ; V7 .WORD PADDR8 ; V8 PPTAB: .WORD PADDR1 ; V1 .WORD PADDR1 ; V2 .WORD PADDR1 ; V3 .WORD PADDR4 ; V4 .WORD PADDR4 ; V5 .WORD PADRP6 ; V6 .WORD PADRP6 ; V7 .WORD PADDR8 ; V8 .PSECT CODE,I,RO ; ; MEMINI - Initialize the memory system. ; .ENABL LSB MEMINI:: ; ; Start by allocating a game stack. ; MOV #GAMSTK,R5 ; Size of game stack. .ALLOC R5 BCC 1$ JMP NODYN 1$: ADD R0,R5 ; Point at top of stack. MOV R5,STKTOP ; Save stack top. ; ; Now we need to read in zeropage. ; .ALLOC ; Get a page of memory. BCC 2$ JMP NODYN 2$: MOV R0,ZEROP ; Save a pointer to zero page. .BLK R0,#0 ; Read zeropage into it. ; ; Try to verify that is really is a game file. ; TSTB @ZEROP ; First byte should not be zero. BNE 9$ JMP NOGAM 9$: CMPB @ZEROP,#8. ; Even possible value? BLOS 999$ ; Yes. JMP NOGAM 999$: CMPB @ZEROP,#MAXVER ; And <= MAXVER. BLOS 99$ JMP BADVER 99$: ; ; Now we need to calculate the end of dynamic memory. ; .GETWB #16 ; Get end of dynamic mem. (Eh) MOV R0,WRLIM ; Save writable limit. ; ; Now read out important values. ; .GETBB #0 MOV R0,ZVER .GETBB #1 MOV R0,ZFLG1 .GETWB #20 ; (10h) MOV R0,ZFLG2 .GETWB #10 ; (8h) MOV R0,ZDICT .GETWB #12 ; (Ah) MOV R0,ZOBJ .GETWB #14 ; (Ch) SUB #32.,R0 ; Make address biased for local vars. MOV R0,ZVAR .GETWB #30 ; (18h) MOV R0,ZABBR ; ; Then we shall set some values according to this interpreter. ; CMP ZVER,#3 ; Version 3 or less game? BHI 10$ ; No. ; V3... 10$: MOV #14.,OBJLEN ; Length of objects. MOV #126.,OBJOFF ; Offset to start of objects. MOV #PCV4,NXTPRO MOV #DORO4,DORO MOV #DOIO4,DOIO MOV #6,ZWLEN 20$: CALL ZOPINI ; Initiate optab. ; ; Setup ASCII table. ; MOV #DECCH1,DECCHR ; Set old decode mode. MOV #ASCV1,ASCPTR ; Set old table. CMP ZVER,#1 ; Version 1? BEQ 90$ ; Yes. MOV #DECCH2,DECCHR ; No. Set middle decode mode. MOV #ASCV2,ASCPTR ; Set new table. CMP ZVER,#2 ; Version 2? BEQ 90$ ; Yes. MOV #DECCH3,DECCHR ; No. Set new decode model. CMP ZVER,#4 ; Version 4 or less? BLE 90$ ; Yes. .GETWB #64 ; No. Get table pointer. (34h) BEQ 80$ ; Zero means use standard table. ADD ZEROP,R0 ; We have a pointer. Point at physical. MOV R0,ASCPTR 80$: .GETWB #56 ; Terminating char tbl ptr. (2Eh) BEQ 90$ ADD ZEROP,R0 MOV R0,ZTCPTR 90$: MOV DECCHR,DECPTR ; ; Setup address unpacking functions. ; MOV ZVER,R0 ; Get game version. DEC R0 ; zero-bias. ASL R0 ; *2. MOV PATAB(R0),APACK ; Set up packed address trans. MOV PPTAB(R0),PPACK ; CALL GETRND MOV R0,SEED ; ; Now we'll allocate all the memory we need. ; MOV WRLIM,R1 ADD #777,R1 ; Round off to block. BIC #777,R1 MOV R1,DYNHI ; Save end of dynamic memory. SUB #1000,R1 ; Find out how much more we need to .ALLOC R1 ; allocate, and allocate that. BCC 40$ JMP NODYN ; ; Now initiate dynamic memory. ; 40$: CALL DYNINI ; ; Finally, allocate cache. ; CALLR CHEINI .DSABL LSB ; ; DYNINI - Setup game dynamic memory from file. ; DYNINI:: MOV ZEROP,R0 CLR R1 MOV DYNHI,R2 20$: MOV R2,R3 BPL 30$ MOV #<77*1000>,R3 30$: .BLK R0,R1,R3 ; The read in dynamic memory. SUB R3,R2 ; Count off... BEQ 40$ ; Done. ADD R3,R0 ; Not done. Step forward. ADD #77,R1 BR 20$ ; 40$: RETURN ; Done. ; ; VARINI - Initialize game variables. ; VARINI:: .PUTBB #1,ZFLG1 ; Setup flags. .PUTWB #20,ZFLG2 ; (10h) .PUTWB #62,#400 ; STD version. (1.0) (32h,100h) ; CMP ZVER,#3 ; ,R3 BR 100$ ; ; Done? ; 120$: CMP R3,#1 BLOS LOMEM ; CMP R3,#R.MAX ; BNE LO2MEM RETURN ; NODYN: .MSG <"We didn't get memory for dynamic data. Aborting..."> JMP ABORT NOMEM: .MSG <"We didn't get any pages for cache. Aborting..."> JMP ABORT BADVER: MOVB @ZEROP,R0 .MSG <"ZEMU only supports V1-V%D games. This looks like V%D.">,#MAXVER,R0 JMP ABORT NOGAM: .MSG <"This don't look like a Z-machine game at all."> JMP ABORT ; LOMEM: .MSG <"We have *very* little cache. The gaming will suffer."> ; BR 100$ ; ;LO2MEM: .MSG <"We are not fully stocked on cache. Expect high disk activity."> CHEDON: 100$: .MSG <"Press to continue."> MOV #100.,R3 CLR FPTR CALL GETCH2 CLR R3 CLC RETURN .DSABL LSB ; ; GETIB - Get next byte from instruction stream. ; ; Autoincrements PC. ; ; Returns byte in (SP). ; .ENABL LSB ZGETIB:: MOV (SP),-(SP) ; Create space on stack. MOV R0,-(SP) ; Save registers. MOV R2,-(SP) MOV R3,-(SP) MOV ZPC+2,R3 ; Get PC. MOV ZPC,R2 .BRK R2,R3 CALL ATRAN ; Translate address. .DBG #D.MEM,<"Reading from %P,,%P yields %B.">,ZPC,ZPC+2,R0 INC ZPC+2 ; Bump PC. BNE 10$ INC ZPC 10$: MOVB (R0),10(SP) ; Get byte. CLRB 11(SP) MOV (SP)+,R3 ; Restore registers. MOV (SP)+,R2 MOV (SP)+,R0 RETURN ; Done. .DSABL LSB ; ; GETBB - Get data byte by byte address. ; ; In: 2(SP) - Address ; Out: 2(SP) - Data ; .ENABL LSB ZGETBB:: MOV R0,-(SP) ; Save registers. MOV R2,-(SP) MOV R3,-(SP) MOV 10(SP),R3 ; Get address. CLR R2 ; Clear high part. GCOMB: CALL ATRAN ; Translate address. .DBG #D.MEM,<".GETBB from address %P yields %B.">,R3,R0 MOVB (R0),10(SP) ; Get data. CLRB 11(SP) MOV (SP)+,R3 ; Restore registers. MOV (SP)+,R2 MOV (SP)+,R0 RETURN ; Done. .DSABL LSB ; ; GETWB - Get data word by byte address. ; .ENABL LSB ZGETWB:: MOV R0,-(SP) ; Save registers. MOV R2,-(SP) MOV R3,-(SP) MOV 10(SP),R3 ; Get address. CLR R2 GCOMW: CALL ATRAN ; High byte. MOVB (R0),11(SP) INC R3 ; Low byte. BNE 10$ INC R2 10$: CALL ATRAN MOVB (R0),10(SP) .DBG #D.MEM,<".GETWB from address %P,,%P-1 yields %P.">,R2,R3,22(SP) MOV (SP)+,R3 ; Restore registers. MOV (SP)+,R2 MOV (SP)+,R0 RETURN ; Done. .DSABL LSB ; ; GETBW - Get data byte by word address. ; ; In: R0 - Address ; Out: R0 - Data ; ZGETBW:: MOV R0,-(SP) ; Save registers. MOV R2,-(SP) MOV R3,-(SP) MOV 10(SP),R3 ; Get address. CLR R2 ASHC #1,R2 ; Multiply address by 2. BR GCOMB ; And get byte. ; ; GETWW - Get data word by word address. ; ZGETWW:: MOV R0,-(SP) ; Save registers. MOV R2,-(SP) MOV R3,-(SP) MOV 10(SP),R3 ; Get address. CLR R2 ASHC #1,R2 ; Multiply address by 2. BR GCOMW ; and get word. ; ; PUTBB - Put data at address. ; ; In: 2(SP) - Byte ; 4(SP) - Address ; ; Out: Elements removed from stack. ; .ENABL LSB ZPUTBB:: MOV R0,-(SP) ; Save registers. MOV 6(SP),R0 ; Get address. MOV 2(SP),6(SP) ; Move return address. CMP R0,WRLIM ; Over limit? BHIS 10$ ; Yes. .DBG #D.MEM!D.MRF,<".PUTBB writes %P to %P.">,16(SP),R0 ADD ZEROP,R0 ; No. Get address. MOVB 4(SP),(R0) ; Write data. MOV (SP)+,R0 ; Restore R0. ADD #4,SP ; Clean up stack. RETURN ; Done. 10$: .MSG <"Write over limit. Addr = %P. Limit = %P.">,R0,WRLIM JMP ABORT .DSABL LSB ; ; PUTWB - Put word at byte address. ; ; In: 2(SP) - Byte ; 4(SP) - Address ; .ENABL LSB ZPUTWB:: MOV R0,-(SP) ; Save registers. MOV 6(SP),R0 ; Get address. MOV 2(SP),6(SP) ; Move return address. CMP R0,WRLIM ; Over limit? BHIS 10$ ; Yep. .DBG #D.MEM!D.MRF,<".PUTWB writes %P to %P.">,16(SP),R0 ADD ZEROP,R0 ; No. Get correct address. MOVB 5(SP),(R0)+ ; Write data. MOVB 4(SP),(R0) MOV (SP)+,R0 ; Restore registers. ADD #4,SP ; Clean up stack. RETURN ; Done. 10$: .MSG <"Write over limit. Addr = %P. Limit = %P.">,R0,WRLIM JMP ABORT .DSABL LSB ; ; PUTBW - Put byte at word address. ; ; In: 2(SP) - Byte ; 4(SP) - Address ; .ENABL LSB ZPUTBW:: MOV R0,-(SP) ; Save registers. MOV 6(SP),R0 ; Get address. MOV 2(SP),6(SP) ; Save return address. ASL R0 ; Multiply address. BCS 10$ ; Error. CMP R0,WRLIM ; Too high? BHIS 20$ ; Yes. .DBG #D.MEM,<".PUTBW writes %P to %P.">,16(SP),R0 ADD ZEROP,R0 ; No. Get physical address. MOVB 4(SP),(R0) ; Save byte. MOV (SP)+,R0 ; Restore registers. ADD #4,SP ; Clean up stack. RETURN ; Done. 10$: .MSG <"Write error. High address. 1,,%P. Limit = %P.">,R0,WRLIM JMP ABORT 20$: .MSG <"Write error. High address. 0,,%P. Limit - %P.">,R0,WRLIM JMP ABORT .DSABL LSB ; ; PUTWW - Put word at word address. ; ; In: 2(SP) - Byte ; 4(SP) - Address ; .ENABL LSB ZPUTWW:: MOV R0,-(SP) ; Save registers. MOV 6(SP),R0 ; Get address. MOV 2(SP),6(SP) ; Move return address. ASL R0 ; Multiply address. BCS 10$ ; Error... CMP R0,WRLIM ; Address too high? BHIS 20$ ; Yes. .DBG #D.MEM,<".PUTWW writes %P to %P.">,16(SP),R0 ADD ZEROP,R0 ; No. Get physical address. MOVB 5(SP),(R0)+ ; Save word. MOVB 4(SP),(R0) MOV (SP)+,R0 ; Restore registers. ADD #4,SP ; Clean up stack. RETURN ; Done. 10$: .MSG <"Write error. High address. 1,,%P. Limit = %P.">,R0,WRLIM JMP ABORT 20$: .MSG <"Write error. High address. 0,,%P. Limit = %P.">,R0,WRLIM JMP ABORT .DSABL LSB ; ; ATRAN - Address translation. ; ; In: R2,R3 - Address ; Out: R0 - Translated address. ; .ENABL LSB ATRAN:: TST R2 BNE 10$ CMP R3,DYNHI BHIS 10$ MOV R3,R0 ADD ZEROP,R0 RETURN ; ; The address is somewhere in dynamic memory. ; 10$: JSR R5,.SAVR1 ; Save R1-R5 MOV #CACHE,R5 ; Point at start of list. 11$: MOV (R5),R4 ; Point at next record. MOV R2,R1 ; Move requested address to R1,,R0 MOV R3,R0 ; (note reverse order or regs) SUB R.ADDR+2(R4),R0 ; Calculate difference. SBC R1 SUB R.ADDR(R4),R1 BNE 13$ ; Not in range. Try next... CMP R0,R.LEN BLO 20$ ; In range. We found it! 13$: TST (R4) ; Not in range. Do any more exist? BEQ 14$ ; No. MOV R4,R5 ; Yes. Move on. BR 11$ ; ; Record not found. We need to replace. ; 14$: MOV R.REF(R4),R0 ; Get our reference. CALL CHEUPD ; Cache update. MOV R2,R.ADDR(R4) ; Save new virtual base. MOV R3,R.ADDR+2(R4) ; ; Now we have a good record in (R4), while R5 points at previous in list. ; Let's link the new in. ; 20$: MOV (R4),(R5) ; Transfer link. MOV CACHE,(R4) ; Put entry first in list. MOV R4,CACHE ADD R.BASE(R4),R0 ; Add base and we're done. RETURN .DSABL LSB ; ; Packed address translations... ; ; In: R1 - Address. ; ; Out: R0,R1 - Address. ; PADDR1: CLR R0 ASHC #1,R0 RETURN ; PADDR4: CLR R0 ASHC #2,R0 RETURN ; PADDR6: CLR R0 ; Clear high word ASHC #2,R0 ; P * 4 MOV R0,-(SP) ; Save P MOV R1,-(SP) MOV ZEROP,R1 ; Get R_O MOV 50(R1),R1 ; (28h) SWAB R1 CLR R0 ; Calculate R_O * 8 ASHC #3,R0 ADD (SP)+,R1 ; Add P to R_O ADC R0 ADD (SP)+,R0 RETURN ; Done ; PADRP6: CLR R0 ; Clear high word ASHC #2,R0 ; P * 4 MOV R0,-(SP) ; Save P MOV R1,-(SP) MOV ZEROP,R1 ; Get S_O MOV 52(R1),R1 ; (2Ah) SWAB R1 CLR R0 ; Calculate S_O * 8 ASHC #3,R0 ADD (SP)+,R1 ; Add P to S_O ADC R0 ADD (SP)+,R0 RETURN ; Done ; PADDR8: CLR R0 ASHC #3,R0 RETURN ; .END .TITLE ZOBJ .IDENT /V1.4/ ; ++ ; This is the Z-machine handler for object opcodes. ; (c) 2000 by Johnny Billquist ; ; History: ; ; 00-07-19 BQT Initial coding started. ; Y1.0 00-08-26 21:00 BQT First release. ; Y1.1 00-08-30 04:00 BQT Bugfix in LOADB and LOADW. Address calc ; should be with 32 bit numbers. ; Y1.2 00-08-31 20:00 BQT Bugfix. The same goes for copy table. ; V1.3 00-09-16 12:00 BQT Changed ZEXIT to ABORT. ; Make it more officially done. ; V1.4 05-02-24 00:00 BQT Started adding V6 functions. ; -- .INCLUDE /ZMAC/ .PSECT CODE,I,RO ; ; Routine to read a property header. V1-V3. ; ; In: R0 - Address of property. ; ; Out: R0 - Address of property data. ; R2 - Size of property data. ; R3 - Number of property. ; PCV1:: .GETBB R0,R3 ; Get number INC R0 ; Point at data. MOV R3,R2 ; Get size. ASH #-5,R2 ; Size done. INC R2 BIC #^C37,R3 ; Number. RETURN ; ; Routine to read a property header for V4 and newer. ; ; See PCV1 for more info. ; PCV4:: .GETBB R0,R3 ; Get number. INC R0 ; Point at next byte. BIT #200,R3 ; Two bytes? BNE 10$ ; Yes. MOV R3,R2 ; No. ASH #-6,R2 ; Get size. INC R2 5$: BIC #^C77,R3 RETURN 10$: .GETBB R0,R2 ; Get size. INC R0 BIC #^C77,R2 ; Mask bits. BNE 5$ MOV #64.,R2 BR 5$ ; ; GPA - Get property list address. ; ; In: R0 - Object number. ; ; Out: R0 - Property address list start. ; GPA:: MOV R1,-(SP) ; Save registers. MOV R0,R1 ; Get object number in R1. MUL OBJLEN,R1 ; Multiply by length of objects. ADD ZOBJ,R1 ; Add start of object list. ADD OBJOFF,R1 ; Add offset past global props. SUB #2,R1 ; Backup. .GETWB R1,R0 ; Read address. MOV (SP)+,R1 ; Restore registers. RETURN ; ; FNDPRO - Find property. ; ; In: R0 - Address where property list start. ; R1 - Property number. ; ; Out: R0 - Address of property data. ; R1 - Size of property in bytes. ; FNDPRO:: MOV R2,-(SP) ; Save registers. MOV R3,-(SP) .GETBB R0,R2 ; Read byte. ADD R2,R0 ; Skip past description. INC R2 ; Descr is length*2 + 1 10$: ADD R2,R0 CALL @NXTPRO ; Get next prop. CMP R3,R1 ; No match? BHI 10$ ; Not yet... BEQ 30$ ; Match. ; ; We didn't find a matching prop. Let's give the address of global ; prop... ; MOV ZOBJ,R0 ; Get object address. DEC R1 ; Make prop # bias 0. ASL R1 ; Make prop # into offset. ADD R1,R0 ; Get prop address. MOV #2,R1 ; Size is word. SEC ; Indicate we have global prop. BR 100$ ; ; We found property. ; 30$: MOV R2,R1 ; Get size in R1. CLC ; Okay. 100$: MOV (SP)+,R3 ; Restore registers. MOV (SP)+,R2 RETURN ; Done. ; ; FNDOBJ - Find object. ; ; In: R0 - Object number. ; Out: R0 - Byte address of object. ; FNDOBJ:: MOV R1,-(SP) ; Save registers. MOV R0,R1 ; Get object # in R1. DEC R1 ; Objects start at 1. MUL OBJLEN,R1 ; Multiply by object size. ADD ZOBJ,R1 ; Add address of object table. ADD OBJOFF,R1 ; And skip default property list. MOV R1,R0 ; Save result. MOV (SP)+,R1 ; Restore registers. RETURN ; Done. ; ; FNDATR - Find attribute. ; ; In: R0 - Address of attributes. ; R1 - Attribute number. ; Out: R0 - Address of attribute byte. ; R1 - Attribute mask. ; FNDATR:: MOV R2,-(SP) ; Save registers. INC R1 ; Count attribs from 1. CLC ; Carry should be 0. MOV #200,R2 ; Get mask. 20$: DEC R1 ; Count off attribs. BEQ 30$ ; Done. We have the answer. RORB R2 ; Not done. Shift mask. BCC 20$ ; Mask not finished. Repeat. INC R0 ; Mask finished. Bump address. RORB R2 BR 20$ ; Do mask over again. 30$: MOV R2,R1 ; Get mask in R1. MOV (SP)+,R2 ; Restore registers. RETURN ; Done. ; ; Remove object. V1-V3 objects. ; ; In: R0 - Object. ; DORO3:: MOV R0,-(SP) ; Save registers. MOV R1,-(SP) MOV R2,-(SP) MOV R3,-(SP) CLR R3 MOV R0,R1 ; Save object number. CALL FNDOBJ ; Find object. ADD #5,R0 ; Address of sibling. .GETBB R0,R2 ; Get next sibling. DEC R0 ; Point at parent value. .GETBB R0,R3 ; Get parent object. .PUTBB R0,#0 ; Clear parent object. MOV R3,R0 ; Get parent obj in R0. BEQ 25$ ; We didn't have a parent. Done... CALL FNDOBJ ; Find object. INC R0 ; Adjust for child. 10$: ADD #5,R0 ; Get sibling (child) object. .GETBB R0,R3 ; Get next sibling. BEQ 30$ ; Ooops. None found. CMP R1,R3 ; Is the next us? BEQ 20$ ; Yes. MOV R3,R0 ; No. Go to next child. CALL FNDOBJ ; Get next object. BR 10$ ; And try again. ; ; We have found the object previous to ours. ; 20$: .PUTBB R0,R2 ; Link in the next object instead. 25$: MOV (SP)+,R3 ; Restore registers. MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 RETURN ; ; The child wasn't in the parents list... ; 30$: .MSG <"Fatal error. Child wasn't in parent list."> JMP BADFUN ; ; Insert object in another object in V1-V3. ; DOIO3:: CALL DORO3 ; Remove from current parent. MOV R0,-(SP) ; Save registers. MOV R1,-(SP) MOV R2,-(SP) MOV R3,-(SP) MOV R0,R2 ; Save object number. MOV R1,R0 ; Get parent. BEQ 10$ ; No new real parent... Hmmm... CALL FNDOBJ ; Find parent. ADD #6,R0 ; Point at child. .GETBB R0,R3 ; Get current first child. .PUTBB R0,R2 ; Save new first child. 10$: MOV R2,R0 ; Get new child. CALL FNDOBJ ; Find object. ADD #4,R0 ; Point at parent field. .PUTBB R0,R1 ; Set parent value. INC R0 ; Point at sibling value. .PUTBB R0,R3 ; Save sibling value. MOV (SP)+,R3 ; Restore registers. MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 RETURN ; ; Remove object. V4-V8 objects. ; ; In: R0 - Object. ; DORO4:: MOV R0,-(SP) ; Save registers. MOV R1,-(SP) MOV R2,-(SP) MOV R3,-(SP) MOV R0,R1 ; Save object number. CALL FNDOBJ ; Find object. ADD #8.,R0 ; Address of sibling. .GETWB R0,R2 ; Get next sibling. SUB #2,R0 ; Point at parent value. .GETWB R0,R3 ; Get parent object. .PUTWB R0,#0 ; Clear parent object. MOV R3,R0 ; Get parent obj in R0. BEQ 25$ ; We didn't have a parent. Done... CALL FNDOBJ ; Find object. ADD #2,R0 ; Adjust for child. 10$: ADD #8.,R0 ; Get sibling (child) object. .GETWB R0,R3 ; Get next sibling. BEQ 30$ ; Ooops. None found. CMP R1,R3 ; Is the next us? BEQ 20$ ; Yes. MOV R3,R0 ; No. Go to next child. CALL FNDOBJ ; Get next object. BR 10$ ; And try again. ; ; We have found the object previous to ours. ; 20$: .PUTWB R0,R2 ; Link in the next object instead. 25$: MOV (SP)+,R3 ; Restore registers. MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 RETURN ; ; The child wasn't in the parents list... ; 30$: .MSG <"Fatal error. Child wasn't in parent list."> JMP BADFUN ; ; Insert object in another object. V4-V8 objects. ; DOIO4:: CALL DORO4 ; Remove from current parent. MOV R0,-(SP) ; Save registers. MOV R1,-(SP) MOV R2,-(SP) MOV R3,-(SP) MOV R0,R2 ; Save object number. MOV R1,R0 ; Get parent. BEQ 10$ ; No new real parent... Hmmm... CALL FNDOBJ ; Find parent. ADD #10.,R0 ; Point at child. .GETWB R0,R3 ; Get current first child. .PUTWB R0,R2 ; Save new first child. 10$: MOV R2,R0 ; Get new child. CALL FNDOBJ ; Find object. ADD #6,R0 ; Point at parent field. .PUTWB R0,R1 ; Set parent value. ADD #2,R0 ; Point at sibling value. .PUTWB R0,R3 ; Save sibling value. MOV (SP)+,R3 ; Restore registers. MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 RETURN ; ; 2OP:11 B set_attr object attribute ; .ENABL LSB SATTR:: .INSTR "set_attr",#2 MOV (R2)+,R0 ; Get object. CALL FNDOBJ MOV (R2)+,R1 ; Get attribute. CALL FNDATR .GETBB R0,R2 ; Get attribute byte. BIS R1,R2 ; Set attribute. .PUTBB R0,R2 ; Save new attribute. RETURN .DSABL LSB ; ; 2OP:12 C clear_attr object attribute ; .ENABL LSB CATTR:: .INSTR "clear_attr",#2 MOV (R2)+,R0 ; Get object. CALL FNDOBJ MOV (R2)+,R1 ; Get attribute. CALL FNDATR .GETBB R0,R2 ; Get attribute byte. BIC R1,R2 ; Clear bit. .PUTBB R0,R2 ; Seave new attribute. RETURN .DSABL LSB ; ; 2OP:13 D store (variable) value ; .ENABL LSB STORE:: .INSTR "store",#2 MOV (R2)+,R0 ; Get variable. MOV (R2),R1 ; Get value. CALLR STOREV .DSABL LSB ; ; 2OP:14 E insert_obj object destination ; .ENABL LSB IOBJ:: .INSTR "insert_obj",#2 MOV (R2)+,R0 ; Get object. MOV (R2),R1 ; Get new parent. CALLR @DOIO ; And insert. .DSABL LSB ; ; 2OP:15 F loadw array word-index -> (result) ; LOADW - load a word. Address is arg0 + arg1*2 ; .ENABL LSB LOADW:: .INSTR "loadw",#2 MOV (R2),R3 ; Get base address. CLR R2 ; As a 32-bit number. ADD ARGS+2,R3 ; Add offset * 2 ADC R2 ADD ARGS+2,R3 ADC R2 CALL ATRAN ; Translate address. CLR -(SP) ; Create space on stack for result. MOVB (R0),1(SP) ; Get high byte. INC R3 ; Next address. BNE 10$ INC R2 10$: CALL ATRAN MOVB (R0),(SP) ; Get low byte. MOV (SP)+,R0 CALLR RESULT .DSABL LSB ; ; 2OP:16 10 loadb array byte-index -> (result) ; LOADB - Load a byte. Address is arg0+arg1. ; .ENABL LSB LOADB:: .INSTR "loadb",#2 MOV (R2),R3 ; Get base address. CLR R2 ; As a 32-bit number. ADD ARGS+2,R3 ; Get offset. ADC R2 CALL ATRAN MOVB (R0),R0 BIC #^C377,R0 CALLR RESULT .DSABL LSB ; ; 2OP:17 11 get_prop object property -> (result) ; .ENABL LSB GPROP:: .INSTR "get_prop",#2 MOV (R2)+,R0 ; Get object number. CALL GPA ; Get property list address. MOV (R2),R1 ; Get prop number. CALL FNDPRO ; Find property address. DEC R1 ; Size of one byte? BEQ 10$ ; Yes. DEC R1 ; Two bytes? BNE 30$ ; Error. .GETWB R0 ; Get data. CALLR RESULT ; 10$: .GETBB R0 ; Get data. CALLR RESULT ; We have the result. 30$: .MSG <"get_prop on data larger than 2 bytes!"> JMP BADFUN .DSABL LSB ; ; 2OP:18 12 get_prop_addr object property -> (result) ; .ENABL LSB GPROPA:: .INSTR "get_prop_addr",#2 MOV (R2)+,R0 ; Get object number. CALL GPA MOV (R2),R1 ; Get prop number. CALL FNDPRO ; Find property address. BCC 10$ ; Found it? CLR R0 ; No. Clear result. 10$: CALLR RESULT ; Give answer. .DSABL LSB ; ; 2OP:19 13 get_next_prop object property -> (result) ; .ENABL LSB GNPROP:: .INSTR "get_next_prop",#2 MOV (R2)+,R0 ; Get object. CALL GPA ; Get address of props. MOV (R2),R1 ; Get requested prop number. .GETBB R0,R2 ; Length of description. ADD R2,R0 ADD R2,R0 INC R0 TST R1 ; Is this the address we want? BEQ 100$ ; Yes. 30$: CALL @NXTPRO ; No. Get next prop. ADD R2,R0 ; Point at next property. CMP R3,R1 ; Check property number. BHI 30$ ; Still more to go? BEQ 100$ ; This was the correct entry. .MSG <"Tried next_prop on bad prop. Obj %D, P: %D">,ARGS,ARGS+2 JMP BADFUN 100$: CALL @NXTPRO ; Get number of next prop. MOV R3,R0 CALLR RESULT ; Done. .DSABL LSB ; ; 1OP:129 1 get_sibling object -> (result) ?(label) ; .ENABL LSB GSIB:: .INSTR "get_sibling",#1 MOV (R2),R0 ; Get object. CALL FNDOBJ CMP ZVER,#3 BHI 10$ ; V4 or later... ADD #5,R0 ; Sibling address. .GETBB R0 ; Get sibling. BR 20$ 10$: ADD #8.,R0 .GETWB R0 20$: CALL RESULT TST R0 BEQ 30$ JMP BTRUE 30$: JMP BFALSE .DSABL LSB ; ; 1OP:130 2 get_child object -> (result) ?(label) ; .ENABL LSB GCHLD:: .INSTR "get_child",#1 MOV (R2),R0 ; Get object. CALL FNDOBJ CMP ZVER,#3 BHI 10$ ; V4 or later... ADD #6,R0 ; Sibling address. .GETBB R0 ; Get child. BR 20$ 10$: ADD #10.,R0 .GETWB R0 20$: CALL RESULT TST R0 BEQ 30$ JMP BTRUE 30$: JMP BFALSE .DSABL LSB ; ; 1OP:131 3 get_parent object -> (result) ; .ENABL LSB GPAREN:: .INSTR "get_parent",#1 MOV (R2),R0 ; Get object. CALL FNDOBJ CMP ZVER,#3 BHI 10$ ; V4 or later... ADD #4,R0 ; Sibling address. .GETBB R0 ; Get parent. CALLR RESULT 10$: ADD #6,R0 .GETWB R0 CALLR RESULT .DSABL LSB ; ; 1OP:132 4 get_prop_len property-address -> (result) ; .ENABL LSB GPROPL:: .INSTR "get_prop_len",#1 MOV (R2),R0 ; Get property address. CMP ZVER,#3 ; Two different algorithms... BHI 10$ ; >V3 is more advanced. ; ; Get length of property in V1-V3. ; DEC R0 ; Address of length byte. .GETBB R0 ; Read byte. ASH #-5,R0 ; Shift down. INC R0 ; And adjust. CALLR RESULT ; That's the answer. ; ; Get property length in V4 and later. ; 10$: DEC R0 ; Backup. .GETBB R0 ; Get byte. BIT #200,R0 ; Is this a two-byte entry? BNE 20$ ; Yes. ASH #-6,R0 ; No. Size is in bit 6. INC R0 ; Adjust. CALLR RESULT 20$: BIC #^C77,R0 ; Size is 6 bits. BNE 30$ ; Size zero means 64. MOV #64.,R0 30$: CALLR RESULT .DSABL LSB ; ; 1OP:137 9 remove_obj object ; .ENABL LSB REMOBJ:: .INSTR "remove_obj",#1 MOV (R2),R0 ; Get object. CALLR @DORO .DSABL LSB ; ; 1OP:142 E load (variable) -> (result) ; Load value of variable. ; (This is silly. Why not just use a variable argument?) ; .ENABL LSB LOAD:: .INSTR "load",#1 MOV (R2),R0 ; Get variable number. CALL VARVAL ; Get value of variable. MOV R1,R0 CALLR RESULT ; Save value. .DSABL LSB ; ; 0OP:185 9 1 pop ; .ENABL LSB POP:: .INSTR "pop",#0 ADD #2,R5 ; Just drop from stack. RETURN .DSABL LSB ; ; EXT:21 15 6 pop_stack items stack ; .ENABL LSB POPSTK:: .INSTR "pop_stack" MOV (R2)+,R0 CMP R3,#1 ; System stack? BNE 10$ ; No. ADD R0,R5 ; Yes. Simple. Just add value*2 to ADD R0,R5 ; stack pointer. RETURN ; Done. 10$: MOV (R2),R1 ; User specified stack. Get address. .GETWB R1,R2 ; Read header word. ADD R0,R2 ; Add the freed words to free size. .PUTWB R1,R2 ; Save new header value. RETURN ; Done. ; ; VAR:225 1 storew array word-index value ; .ENABL LSB STOREW:: .INSTR "storew",#3 MOV (R2)+,R0 ; Get address of base. ADD (R2),R0 ; Add offset*2. BCS 10$ ADD (R2)+,R0 BCS 10$ .PUTWB R0,(R2) ; Write data to the resulting address. RETURN 10$: .MSG <"storew over write limit. %M+2*%M.">,ARGS,ARGS+2 JMP BADFUN .DSABL LSB ; ; VAR:226 2 storeb array byte-index value ; .ENABL LSB STOREB:: .INSTR "storeb",#3 MOV (R2)+,R0 ; Get base address. ADD (R2)+,R0 ; Add offset. BCS 10$ .PUTBB R0,(R2) ; And store value at this address. RETURN 10$: .MSG <"storeb over write limit. %M+%M.">,ARGS,ARGS+2 JMP BADFUN .DSABL LSB ; ; VAR:227 3 put_prop object property value ; .ENABL LSB PUTPRP:: .INSTR "put_prop",#3 MOV (R2)+,R0 ; Get object number. CALL GPA MOV (R2)+,R1 ; Get property number. CALL FNDPRO ; Find property. BCS 10$ ; Property not found. DEC R1 ; Size of one byte? BEQ 1$ ; Yes. DEC R1 ; Two bytes? BEQ 2$ ; Yes. ; .MSG <"Property size is bad: %D+2 bytes.">,R1 JMP BADFUN ; 1$: .PUTBB R0,(R2) RETURN 2$: .PUTWB R0,(R2) RETURN ; 10$: .MSG <"Property not found. %D.">,ARGS+2 JMP BADFUN .DSABL LSB ; ; VAR:232 8 push value ; .ENABL LSB PUSH:: .INSTR "push",#1 .DBG #D.STK,<"Pusing value on stack. SP = %P. Value is %D.">,R5,(R2) MOV (R2),-(R5) ; Very simple. RETURN .DSABL LSB ; ; EXT:24 18 6 push_stack value stack ?(label) ; .ENABL LSB PUSHUS:: .INSTR "push_stack",#2 MOV 2(R2),R0 ; Get stack. .GETWB R0,R1 ; Get free slots. BEQ 10$ ; Stack full... MOV R1,-(SP) ; Save free size. ASL R1 ; Multiply by 2. ADD R0,R1 ; Get address of free slot. .PUTWB R1,(R2) ; Save value. MOV (SP)+,R1 ; Get free size again. DEC R1 ; One less left. .PUTWB R0,R1 ; Save new free slots. CALLR BTRUE ; All good. 10$: CALLR BFALSE ; ; VAR:233 9 1 pull (variable) ; .ENABL LSB PULL1:: .INSTR "pull(1)",#1 MOV (R2),R0 ; Get variable where to store result. MOV (R5)+,R1 ; Get value to store. .DBG D.STK,<"Pulling from stack. SP = %P. Value is %D.">,R5,R1 CALLR STOREV ; Store result. .DSABL LSB ; ; VAR:233 9 6 pull stack -> (result) ; .ENABL LSB PULL2:: .INSTR "pull(6)" TST R3 ; User specified stack? BNE 10$ ; Yes. MOV (R5)+,R0 ; No. Very simple. Just pop value. CALLR RESULT ; Done. 10$: MOV (R2),R0 ; User specified stack. Get address. .GETWB R0,R1 ; Read free size. INC R1 ; Increment free size. .PUTWB R0,R1 ; Store new free size. ASL R1 ; *2 now gives offset to address of data. ADD R0,R1 ; Point at actual data. .GETWB R1,R0 ; Read data. 20$: CALLR RESULT .DSABL LSB ; ; VAR:253 1D 5 copy_table first second size ; ; A short note. Source might get into high memory, so we'll keep ; that in R2,R3. Destination however, must be in dynamic memory, ; so we can keep that in a specific register. ; .ENABL LSB CPYTAB:: .INSTR "copy_table",#3 MOV R4,-(SP) ; Save registers. MOV R5,-(SP) MOV 4(R2),R0 ; Length. BEQ CDON ; No length. Done. MOV R0,R4 ; Get length in R4. BPL 1$ ; If positive, we're good. NEG R4 ; If negative, invert it. 1$: MOV (R2)+,R3 ; Source. MOV (R2),R5 ; Destination... BEQ CLR ; No destination. Do a clear. TST R0 ; Check if forced up. BMI CUP ; Yes. CMP R5,R3 ; Check if need to copy up. BLO CUP ; dst < src - copy up. ; ; We know we shall copy down. ; R5 - destination ; R3 - source ; R4 - length ; ADD ZEROP,R5 ADD R4,R5 ; Point past end of tables. CLR R2 ADD R4,R3 ADC R2 ; ; Now we have the destination end physical address in R5, while the ; source virtual end is in R2,R3 ; R4 holds length. ; ; We shall copy down... We might have overlap, or not. ; Who cares, we do know that we don't have a negative overlap. ; CDN: SUB #1,R3 ; Next virtual address. SBC R2 CALL ATRAN ; Translate address. MOVB (R0),-(R5) ; Copy byte. SOB R4,CDN ; Loop. BR CDON ; Done. ; ; We know we shall copy up. ; R5 - destination ; R3 - source ; R4 - length ; CUP: ADD ZEROP,R5 ; Make to physical address. CLR R2 ; ; Now we have the destination physical address in R5, while the ; source virtual is in R2,R3 ; R4 holds length. ; ; We shall copy up... We might have overlap, or not. ; Who cares, we do know that we don't have a negative overlap. ; 10$: CALL ATRAN ; Translate address. MOVB (R0),(R5)+ ; Copy byte. INC R3 ; Next virtual address. BNE 20$ INC R2 20$: SOB R4,10$ ; Loop. BR CDON ; ; We shall clear memory. ; Address is actually in source. ; CLR: ADD ZEROP,R3 ; Make physical. 30$: CLRB (R3)+ ; Clear data. SOB R4,30$ ; Loop. CDON: MOV (SP)+,R5 ; Restore registers. MOV (SP)+,R4 RETURN ; .DSABL LSB ; .END .TITLE ZCTRL .IDENT /V1.5/ ; ++ ; This is the Z-machine code to handle control opcodes. ; (c) 2000 by Johnny Billquist ; ; History: ; ; 00-07-19 BQT Initial coding started. ; Y1.0 00-08-26 BQT First version working. ; Y1.1 00-08-29 23:30 BQT Added a return table. ; Y1.2 00-09-08 03:00 BQT Bugfix in stack frame. FP must be a relative ; address, otherwise save files are not indep. ; of game. ; V1.3 00-11-07 16:00 BQT Code is working. ; V1.4 05-02-21 00:45 BQT Added some error handling. ; V1.5 06-05-04 13:30 BQT Implemented VERIFY opcode. ; -- .INCLUDE /ZMAC/ ; .PSECT CONST,D,RO ; ; Table of return values used on stack for various things. ; RETTAB: .WORD RESULT ; Return a result R.RES==0 .WORD DONE ; Return without result R.DONE==2 .WORD RETTOP ; Return from top (main) routine R.TOP==4 .WORD IOINT ; Return from I/O interrupt R.INT==6 .WORD LININT ; Return from line count interrupt R.LIN==10 ; .PSECT CODE,I,RO ; ; GETBA - Get branch address. ; ; Out: R0 - Offset. ; R1 - Flags. ; GETBA: .GETIB R1 ; Get first byte. BIT #100,R1 ; Two-byte offset? BNE 10$ ; No. .GETIB ; Yes. Get next byte. SWAB R1 ; First byte is high. ADD R1,R0 ; Combine. BIC #140000,R0 ; Clear irrelevant bits. SWAB R1 ; Restore R1. BIT #40,R1 ; Negative? BEQ 30$ ; No. BIS #400,R1 ; Yes. Set flag. NEG R0 ; Make into positive. BIC #140000,R0 30$: RETURN 10$: MOV R1,R0 ; Save offset in R1. BIC #^C77,R0 ; Clear all but offset. RETURN ; Done. ; ; 2OP:10 A test_attr object attribute ?(label) ; .ENABL LSB TATTR:: .INSTR "test_attr",#2 MOV (R2)+,R0 ; Get object number. CALL FNDOBJ ; Find object. MOV (R2),R1 ; Get attribute number. CALL FNDATR ; Find bit. .GETBB R0 ; Get attribute byte. BIT R1,R0 ; Is bit set? BNE BTRUE ; Yes. BR BFALSE ; No. .DSABL LSB ; ; 2OP:1 1 je a b ?(label) ; JE shall jump-true if the first arg equals any of the rest. ; .ENABL LSB JE:: .INSTR "je" MOV (R2)+,R0 ; Get value to compare against. 10$: DEC R3 ; Count values left to check. BEQ BFALSE ; Nothing matched. We fail. CMP R0,(R2)+ ; Do next value match? BEQ BTRUE ; Yes. We succeed. BR 10$ ; Repeat. .DSABL LSB ; ; Conditional jump handlers. ; .ENABL LSB ; ; BTRUE is the place to go to when we have a TRUE condition. ; BFALSE is the place to go to when we have a FALSE condition. ; BTRUE:: CALL GETBA ; Get branch info. BIT #200,R1 ; Shall we branch? BEQ NOBR ; No. DOBR: SUB #2,R0 ; Yes. Offset should be - 2. BPL 5$ ; Did we get a negiative number? ADD #2,R0 ; Yes. Restore value. JMP DORET ; Do a return. 5$: .DBG #D.INST,<"Doing branch. Offsset is %O.">,R0 BIT #400,R1 ; Back? BEQ 10$ ; No. ADD #4,R0 ; Yes. Branch is actually 4 longer. SUB R0,ZPC+2 ; Substract from PC. SBC ZPC RETURN 10$: ADD R0,ZPC+2 ; Add to PC. ADC ZPC RETURN .DSABL LSB ; BFALSE:: CALL GETBA ; Get branch info. BIT #200,R1 ; Shall we branch? BEQ DOBR ; Yes. NOBR: RETURN ; No. Get next instr. ; ; 2OP:2 2 jl a b ?(label) ; JL shall jump if arg1 < arg2 ; .ENABL LSB JL:: .INSTR "jl",#2 CMP (R2),2(R2) BLT BTRUE BR BFALSE .DSABL LSB ; ; 2OP:3 3 jg a b ?(label) ; JG shall jump if arg1 > arg2 ; .ENABL LSB JG:: .INSTR "jg",#2 CMP (R2),2(R2) BGT 10$ JMP BFALSE 10$: JMP BTRUE .DSABL LSB ; ; 1OP:128 0 jz a ?(label) ; JZ shall jump of arg1 = 0 ; .ENABL LSB JZ:: .INSTR "jz",#1 TST (R2) BEQ BTRUE BR BFALSE .DSABL LSB ; ; 2OP:6 6 jin obj1 obj2 ?(label) ; Jump if obj arg1 is in obj arg2 - V1-V3 objects. ; .ENABL LSB JIN1:: .INSTR "jin",#2 MOV (R2)+,R0 ; Get object number. CALL FNDOBJ ; Find object address. ADD #4,R0 ; Add offset to parent. .GETBB R0 ; Read parent. CMP R0,(R2) ; Is parent arg2? BEQ 10$ JMP BFALSE ; No. 10$: JMP BTRUE ; Yes. .DSABL LSB ; ; 2OP:6 6 jin obj1 obj2 ?(label) ; Jump if obj arg1 is in obj arg2 - V4-V8 objects. ; .ENABL LSB JIN4:: .INSTR "jin",#2 MOV (R2)+,R0 ; Get object. CALL FNDOBJ ; Find object. ADD #6,R0 ; Point at parent field. .GETWB R0 ; Read parent. CMP R0,(R2) ; Is parent arg2? BEQ 10$ JMP BFALSE ; No. 10$: JMP BTRUE ; Yes. .DSABL LSB ; ; 2OP:28 1C 5/6 throw value stack-frame ; Throw. Restore frame pointer to where previous catch told us, ; and then do a return from that point, with the result given here. ; .ENABL LSB THROW:: .INSTR "throw",#2 MOV (R2)+,R0 ; Get return value. MOV STKTOP,R4 SUB (R2),R4 ; Set frame pointer. JMP DORET ; That's it! .DSABL LSB ; ; 1OP:139 B ret value ; .ENABL LSB RET:: .INSTR "ret",#1 MOV (R2),R0 ; Get return value. ; ; Do a return. The return value is given in R0. ; DORET: MOV R4,R5 ; Set SP to FP. .DBG #D.INST!D.STK,<"Doing RET. SP is %P.">,R5 ADD (R5),R5 ; Then drop locals. TST (R5)+ MOV STKTOP,R4 SUB (R5)+,R4 ; Restore old FP. MOV (R5)+,ZPC ; Restore old PC. MOV (R5)+,ZPC+2 MOV (R5)+,R1 ; Get continuation function. JMP @RETTAB(R1) ; And continue somewhere. .DSABL LSB ; ; 1OP:140 C jump ?(label) ; JUMP does an unconditional relative jump. ; .ENABL LSB JUMP:: .INSTR "jump",#1 MOV (R2),R0 ; Get offset. SUB #2,R0 ; - 2. BPL 10$ ; Positive. NEG R0 ; Negative. Make offset positive SUB R0,ZPC+2 ; Do jump. SBC ZPC RETURN 10$: ADD R0,ZPC+2 ; Do jump. ADC ZPC RETURN .DSABL LSB ; ; 0OP:176 0 rtrue ; .ENABL LSB RTRUE:: .INSTR "rtrue",#0 MOV #1,R0 JMP DORET ; ; 0OP:177 1 rfalse ; .ENABL LSB RFALSE:: .INSTR "rfalse",#0 CLR R0 JMP DORET ; ; 0OP:180 4 1/- nop ; .ENABL LSB ZNOP:: .INSTR "nop",#0 RETURN .DSABL LSB ; ; 0OP:184 8 ret_popped ; .ENABL LSB RETPOP:: .INSTR "ret_popped",#0 MOV (R5)+,R0 JMP DORET .DSABL LSB ; ; 0OP:186 A quit ; .ENABL LSB QUIT:: .INSTR "quit",#0 JMP ZEND .DSABL LSB ; ; 0OP:185 9 5/6 catch -> (result) ; ; Catch. Return frame pointer for later throw. ; .ENABL LSB CATCH:: .INSTR "catch",#0 MOV STKTOP,R0 SUB R4,R0 ; Get frame pointer. CALLR RESULT .DSABL LSB ; ; 0OP:189 D 3 verify ?(label) ; ; This opcode isn't as easy as it might look. ; We cannot use the normal memory access stuff to do the actual ; checksumming. Instead we must read the blocks from the file. ; .ENABL LSB VERIFY:: .INSTR "verify",#0 .GETWB #32,R1 ; Read game length BNE 10$ ; Length of zero is funny. JMP BTRUE ; So we are just happy. 10$: ; We have a length. Let's figure ; out actual length. CLR R0 ; High part. MOV #1,R2 ; Assume size is *2 CMP #3,ZVER ADC R2 ; If it's >V3 bump multiplier to 4 CMP #5,ZVER ADC R2 ; If it's >V5 bump multiplier to 8 ASHC R2,R0 ; Adjust size. SUB #100,R1 ; Adjust size. SBC R0 MOV R4,-(SP) ; Save registers. MOV R5,-(SP) CLR -(SP) ; Make room on stack for value. CLR R3 ; Block counter. MOV #IOBUF2+100,R4 ; Address where to start reading. MOV #700,R5 ; Count of chars left in buf. CLR R2 ; Initial checksum. 100$: .BLK #IOBUF2,R3 ; Get block. 110$: MOVB (R4)+,(SP) ; Save byte. ADD (SP),R2 ; Checksum. SUB #1,R1 ; Perform counting. SBC R0 BNE 120$ ; Not done yet. TST R1 BEQ 130$ ; We have done all. 120$: SOB R5,110$ ; And loop through block. INC R3 ; Next block. MOV #IOBUF2,R4 ; Pointer reset. MOV #1000,R5 ; Size reset. BR 100$ ; Loop. 130$: TST (SP)+ ; Clean stack. MOV (SP)+,R5 ; Yes. Restore registers. MOV (SP)+,R4 .GETWB #34 CMP R0,R2 ; Do checksum match? BNE 200$ JMP BTRUE ; Yes. 200$: JMP BFALSE ; No. .DSABL LSB ; ; 0OP:191 F 5/- piracy ?(label) ; .ENABL LSB PIRACY:: .INSTR "piracy",#0 JMP BTRUE .DSABL LSB ; ; 1OP:143 F 5 call_1n routine ; 2OP:26 1A 5 call_2n routine arg1 ; VAR:249 19 5 call_vn routine ...up to 3 args... ; VAR:250 1A 5 call_vn2 routine ...up to 7 args... ; ; CALL_VN and CALL_VN2 are handled the exact same way. ; .ENABL LSB CALVN2:: CALL1N:: CALL2N:: CALLVN:: .INSTR "calln" MOV #R.DONE,-(R5) ; Continuation address. JMP DOCALL ; Perform call. .DSABL LSB ; ; VAR:224 0 1 call routine ...up to 3 args... -> (result) ; 1OP:136 8 4 call_1s routine -> (result) ; 2OP:25 19 4 call_2s routine arg1 -> (result) ; VAR:224 0 4 call_vs routine ...up to 3 args... -> (result) ; VAR:236 C 4 call_vs2 routine ...up to 7 args... -> (result) ; ; This is the first instruction implemented, since it's the ; first instruction executed on ZORK1, which is our first ; test case. ; ; The plain CALL opcode existed until version 3, and the action ; is to save the old PC and frame pointer on the stack. ; Set a new PC, allocate local variables, and set them with ; the correct values. ; We'll also save the continuation routine which to call when ; the code does a RET. ; ; In version 4 and onward, we have several models of CALL, ; but they work the same way as the original call in most ; ways. Some variants throw away the result, and ; the routine entry cannot set initial values of ; local variables in version 5 and later, but the rest is the same. ; ; Stack frame (illustrated): ; ; +----+ ; | | CALL type (tells what kind of possible store on return) ; | | Old PC ; | | Old PC ; | | Old framepointer (relative to top of stack) ; : : ; : : Local variables ; : : ; | | Number of local variables*2 <- FP ; | | Number of arguments in call <- SP ; +----+ ; ; To throw away stack: ; SP <- FP - 2 ; ; To do a return: ; SP <- FP ; SP <- SP + (FP) ; FP <- (SP)+ ; PC <- (SP)+ ; PC <- (SP)+ ; TMP <- (SP)+ ; ; Then proceed to routine indicated by TMP ; .ENABL LSB CALVS2:: ZCALL:: CALL1S:: CALL2S:: CALLVS:: .INSTR "call" ; ; ; First, set up a continuation routine. ; MOV #R.RES,-(R5) ; Routine to store return val. ; ; Perform the actual call. ; Start with checking for call to address zero. ; DOCALL:: TST R3 ; Any arguments? BEQ 101$ ; No. It't as a call to 0. TST (R2) ; Call to address 0? BNE 1000$ 101$: CLR R0 ; Yes. Return 0. MOV (R5)+,R1 ; Get continuation routine. JMP @RETTAB(R1) ; Continue... ; ; Then save the current PC and FP. ; 1000$: MOV ZPC+2,-(R5) MOV ZPC,-(R5) MOV STKTOP,-(R5) SUB R4,(R5) ; ; Now find out the correct entry address. ; MOV (R2)+,R1 ; Get first argument (address) DEC R3 CALL @APACK ; Get actual address. MOV R0,ZPC ; High part. MOV R1,ZPC+2 ; Low part. ; ; Now find out the number of local variables. ; .GETIB ; That's the number! MOV R0,-(SP) ; Save number of locals. MOV R5,-(SP) ; Save pointer to top. ASL R0 ; * 2. SUB R0,R5 ; Create frame. MOV R0,-(R5) ; Save local size. MOV R5,R4 ; Set new frame pointer. .DBG #D.STK,<"Doing call. SP is now %P.">,R5 CLR -(R5) ; Default to no arguments ; ; Now we clear all variables. ; MOV (SP)+,R1 ; Point at top of locals. ASR R0 ; Get #. BEQ 8$ ; No variables exist... 1$: CLR -(R1) ; Clear variables. SOB R0,1$ CMP ZVER,#4 ; Version > 4? BHI 5$ ; Yes. ; ; In version 1-4 we now set initial values... ; MOV (SP),R0 ; Get count. 2$: .GETIW (R1)+ ; Get word. SOB R0,2$ ; Loop. ; ; We now have a local frame set up. Let's copy parameters. ; 5$: MOV (SP),R0 ; Get local vars. CMP R3,R0 ; Copy min(argc,loc#) BHIS 6$ MOV R3,R0 ; Actual args are fewer... 6$: TST R0 BEQ 8$ ; No args...? MOV R0,(R5) ; Save # of args. MOV R4,R1 ; No. Point at list. ADD #2,R1 7$: MOV (R2)+,(R1)+ ; Copy argument. SOB R0,7$ ; Loop. 8$: ADD #2,SP ; Drop stack. DONE: RETURN ; Fetch next instr. .DSABL LSB ; ; VAR:255 1F 5 check_arg_count argument-number ; ; Check argument count. ; The number of arguments are at -2(R4) ; *** Note. It checks that *atleast* this number of args are present. *** ; .ENABL LSB CKACNT:: .INSTR "check_arg_count",#1 CMP -2(R4),(R2) ; Checking... BGE 10$ JMP BFALSE 10$: JMP BTRUE .DSABL LSB ; .END .TITLE ZINTER .IDENT /V1.3/ ; ++ ; This is a Z-machine instruction interpreter. ; (c) 2000 by Johnny Billquist ; ; History: ; ; 00-07-19 BQT Initial coding started. ; Y1.0 00-08-26 21:00 BQT First release. ; V1.1 00-09-16 12:00 BQT Added ABORT function. Make this more official. ; V1.2 00-12-30 04:00 BQT Added a save of SP at start. ; V1.3 05-02-20 23:45 BQT Improved speed. ; -- .INCLUDE /ZMAC/ .PSECT DATA,D,RW ; ARGSZ=8. ; Number of possible arguments ARGC:: .WORD 0 ; Argument count. ARGS:: .BLKW ARGSZ ; Argument list. ARGSE: ; INSTR:: .WORD 0 ; Current instruction. ; SAVSP:: .WORD 0 ; Saved SP. ; .PSECT CONST,D,RO ; DECOD1: .WORD ARGSS ; First step of instr. decode. .WORD ARGSS ; Find out argument types... .WORD ARGSV .WORD ARGSV .WORD ARGVS .WORD ARGVS .WORD ARGVV .WORD ARGVV .WORD ARGL .WORD ARGS1 .WORD ARGV .WORD DO0OP .WORD ARGV2 .WORD ARGV2 .WORD ARGVAR .WORD ARGVAR ; .PSECT CODE,I,RO ; ; V6 return from main routine. ; RETTOP:: .MSG <"Return from top level illegal."> JMP ABORT ; ; Start running interpreter. ; ZRUN:: ; MOV SP,SAVSP ; Save code SP. MOV STKTOP,R5 ; Setup game SP. .GETWB #6 ; Get start PC. MOV R0,ZPC+2 CLR ZPC CMP ZVER,#6 ; Version = 6? BNE FETCH ; No. MOV #1,R3 ; No. This is a call function. MOV #ARGS,R2 ; Point at argument list. MOV R0,(R2) ; Save address as argument. MOV #R.TOP,-(R5) ; Save continuation routine. CALL DOCALL ; Start with a call. ; ; The main program loop. ; ; This code decodes instructions, arguments, and then dispatches ; to the correct code to handle that function. It is the functions ; that jump back to FETCH: to start the next instruction. ; ; Important! ; All instructions are called with the following: ; R5 - Game stackpointer. Must be kept, but some might push things ; R4 - Game framepointer. Must be kept. ; R3 - Argument count. May be discarded. ; R2 - Argument array pointer. May be discarded. ; ; Also, the current game PC is in ZPC,,ZPC+2 ; ; The most important functions to know about: ; VARVAL - Get variable value ; In: R0 - Variable number ; Out: R1 - Variabel value ; ; RESULT - Store a result from an instruction ; In: R0 - Value to store ; ; STOREV - Store a value in a variable ; In: R0 - Variable number ; R1 - Value ; ; ABORT - Abort game ; ; BFALSE - Branch instruction for which the test was false ; BTRUE - Branch instruction for which the test was true ; ; Other things, such as operating on the game stack, and performing calls ; is left out of here. Look at the code for something using the specific ; pieces of the system that is needed for inspiration. ; .ENABL LSB FETCH:: MOV #ARGS,R2 ; Point at start of argument list. CLR R3 ; R3 is argc. .IF NE DBUG MOV ZPC,FZPC MOV ZPC+2,FZPC+2 .ENDC .DBG #D.TRC,<"Addr: %P,,%P.">,ZPC,ZPC+2 .GETIB ; Get next instruction. .DBG #D.DEC,<"Instr: %O.">,R0 MOV R0,INSTR ; Save it. ASH #-3,R0 ; Get four high bits of instr. BIC #1,R0 ; And clear low bit. ; R0 is now high nybble * 2. JMP @DECOD1(R0) ; First step in decoding: ; Process arguments. ; ; Different argument types for instructions... ; ARGSS: CALL GETSA ; Small,Small CALL GETSA BR DO2OP ; Do 2OP instr. ARGSV: CALL GETSA ; Small,Var CALL GETVA BR DO2OP ; Do 2OP instr. ARGVS: CALL GETVA ; Var,Small CALL GETSA BR DO2OP ; Do 2OP instr. ARGVV: CALL GETVA ; Var,Var CALL GETVA BR DO2OP ; Do 2OP instr. ARGL: CALL GETLA ; Large BR DO1OP ; Do 1OP instr. ARGS1: CALL GETSA ; Small BR DO1OP ; Do 1OP instr. ARGV: CALL GETVA ; Var BR DO1OP ; Do 1OP instr. ; ARGV2: MOV #DO2OP,-(SP) ; Variable 2OP instr. BR GETVAR ARGVAR:: ; Variable instr. MOV #DOVAR,-(SP) .DSABL LSB ; ; Process a variable number of arguments. ; GETVAR: .GETIB R1 ; Get argument mask. SWAB R1 ; In high byte. BIS #377,R1 ; Set low bits. CMP INSTR,#236. ; Is instruction 8 arguments? BEQ 5$ ; Yes. CMP INSTR,#250. BNE 10$ ; No. Do simple. 5$: .GETIB ; Get next mask. BIC #377,R1 ; Clear low byte. BIS R0,R1 ; Set correct args. ; ; Process up to eight arguments... ; 10$: ASHC #2,R0 ; Shift stuff. BIS #3,R1 ; And mark up end. BIC #^C3,R0 ; Drop all but significant bits. ASL R0 ; Multiply type by 2. ADD R0,PC ; Branch to correct routine to handle. BR 20$ ; Large constant. BR 30$ ; Small constant. BR 40$ ; Variable. RETURN ; End of args. 20$: CALL GETLA ; Large constant. BR 10$ 30$: CALL GETSA ; Small constant. BR 10$ 40$: CALL GETVA ; Variable. BR 10$ ; ; Get large argument. ; GETLA: .GETIW (R2)+ ; Get word. INC R3 RETURN ; ; Get small argument. ; GETSA: .GETIB (R2)+ ; Get byte. INC R3 RETURN ; ; Get variable argument. ; GETVA: MOV R0,-(SP) ; Save R0. MOV R1,-(SP) INC R3 ; We got one more argument. .GETIB ; Get variable. CALL VARVAL ; Get variable value. MOV R1,(R2)+ ; Save value. MOV (SP)+,R1 MOV (SP)+,R0 ; Restore R0. RETURN ; Done. ; ; Function to handle each specific instruction type. ; DO2OP: MOV INSTR,R0 ; Restore instruction. BIC #^C37,R0 ; Get specific instr. MOV OP2FP,R1 ; And table with pointers. JMP DISPAT ; DO1OP: MOV INSTR,R0 ; Get instruction. BIC #^C17,R0 ; Mask out argument. MOV OP1FP,R1 ; Table to handlers. JMP DISPAT ; DO0OP: MOV INSTR,R0 ; Get instruction. BIC #^C17,R0 ; Mask out stuff. MOV OP0FP,R1 ; Table to handlers. JMP DISPAT ; DOVAR: MOV INSTR,R0 ; Get instruction. BIC #^C37,R0 ; Mask out stuff. MOV OPVFP,R1 ; Table to handlers. ; ; Dispatch routine. ; .ENABL LSB DISPAT: MOV #ARGS,R2 ; Point at args. MOV R3,ARGC ; Save argument count. .DBG #D.DEC,<"Argc: %D (%P,%P,%P).">,R3,(R2),2(R2),4(R2) ASL R0 ; Multiply instruction # by 2. ADD R1,R0 ; Point to dispatch address in table. EXECUT:: CALL @(R0) ; Jump to instruction handler. JMP FETCH .DSABL LSB ; ; Extended opcode. ; ; At this point, R2 should point at argument buffer, and R3 should be 0. ; .ENABL LSB EXTEND:: .INSTR "extended",#0 .GETIB ; Get next byte. .DBG #D.DEC,<"Instr: %O.">,R0 MOV R0,INSTR CALL GETVAR ; Get arguments. MOV #ARGS,R2 MOV R3,ARGC .DBG #D.DEC,<"Argc: %D (%P,%P,%P).">,R3,(R2),2(R2),4(R2) MOV INSTR,R0 ; Get instruction again. ASL R0 ; Multiply by 2. CALLR @EOPTAB(R0) ; Call correct function. .DSABL LSB ; ; VARVAL - Get value of variable. ; ; In: R0 - Variable. ; ; Out: R1 - Value. ; .ENABL LSB VARVAL:: MOV R0,-(SP) ; Save registers. CALL VARADR ; Get variable address. BCS 10$ ; "local" address? .GETWB R0,R1 ; No. Game address. Read word. BR 100$ ; Done. ; 10$: TST R0 ; Stack? BEQ 20$ ; Yes. MOV (R0),R1 ; No. Read local var. BR 100$ ; Done. ; 20$: MOV (R5)+,R1 ; POP stack. .DBG #D.STK,<"Popping stack. Stack is %P. Value is %D.">,R5,R1 100$: MOV (SP)+,R0 ; Restore variable. .DBG #D.VAR,<"Reading variable %D. Value is %D.">,R0,R1 RETURN ; Done. ; ; VARADR - Get the address of a variable. ; ; In: R0 - Variable number. ; Out: CC -> R0 - Address in game for variable. ; CS -> R0 - Address in interpreter memory for variable. ; If R0 is zero, we're talking about the stack. ; VARADR: ASL R0 ; Make variable numbers into offset. BEQ 41$ ; Top of stack. CMP R0,#32. ; Local variables? BLO 42$ ; Yup. ADD ZVAR,R0 ; Global variables. RETURN ; Done. 42$: ADD R4,R0 ; Add frame pointer. 41$: SEC ; Indicate location. RETURN ; Done. ; ; RESULT is a function to call if the instruction should store ; a value. ; ; In: R0 - Value to store. ; .ENABL LSB RESULT:: MOV R0,-(SP) MOV R1,-(SP) MOV R0,R1 ; Save value. .GETIB ; Get variable number. BR 1$ ; ; STOREV - Store a value in a variable. ; ; In: R0 - Variable ; R1 - Value. ; STOREV:: MOV R0,-(SP) MOV R1,-(SP) 1$: .DBG #D.VAR,<"Storing %D in variable %D.">,R1,R0 CALL VARADR ; Get address of variable. BCS 10$ ; Local stuff. .PUTWB R0,R1 ; Global variable. Write it. BR 30$ ; 10$: TST R0 ; Stack? BEQ 20$ ; Yes. .DBG #D.LOC,<"Saving to local var. %P. FP = %P. S = %O.">,R0,R4,(R4) MOV R1,(R0) ; No. Local var. Save value. BR 30$ ; 20$: .DBG #D.STK,<"Pushing on stack. SP = %P. Value is %D.">,R5,R1 MOV R1,-(R5) ; Stack. Push value. 30$: MOV (SP)+,R1 MOV (SP)+,R0 RETURN .DSABL LSB ; ; ABORT - Abort a game. ; ; This will reset the screen, and quit. ; ABORT:: CALL SCRRES ; Reset screen. CALL PRSTOP ; Stop scripting. JMP ZEXIT ; Exit. ; ; ISHOW - Show instruction ; .IF GT,DBUG .SAVE .PSECT DATA,D,RW INAM:: .WORD 0 ZADDR: .BLKB 12 ARGBLK: .WORD ZADDR .BLKW 20 IFMT: .ASCII /%I - %I(/ FMTST2: .BLKB 20 .RESTORE ; ISHOW:: CALL $SAVAL MOV FZPC,R0 MOV #ZADDR,R1 CALL 100$ MOV FZPC+2,R0 CALL 100$ CLRB (R1) MOV #ARGBLK+2,R0 MOV #FMTST2,R1 MOV INAM,(R0)+ TST R3 BEQ 20$ 10$: MOV (R2)+,(R0)+ MOVB #'%,(R1)+ MOVB #'D,(R1)+ MOVB #',,(R1)+ SOB R3,10$ DEC R1 20$: MOVB #'),(R1)+ CLRB (R1) MOV #BUF,R0 MOV #IFMT,R1 MOV #ARGBLK,R2 CALL $EDMSG MOV #BUF,R1 CALLR ZMSG ; 100$: JSR R5,$SAVRG MOV R0,R5 SWAB R5 CALL 110$ MOV R0,R5 ; 110$: MOV R5,R4 ASH #-4,R4 CALL 120$ MOV R5,R4 ; 120$: BIC #^C17,R4 CMP R4,#10. BLO 130$ ADD #7,R4 130$: ADD #'0,R4 MOVB R4,(R1)+ RETURN ; .ENDC ; .END .TITLE ZIO .IDENT /V1.20/ ; ++ ; This is the Z-machine routines for I/O instructions. ; (c) 2000 by Johnny Billquist ; ; History: ; ; 00-07-19 BQT Initial coding started. ; Y1.0 00-08-26 21:00 BQT First release. ; Y1.1 00-08-29 02:00 BQT Fixed bug in scan table. ; It is a branching instruction! ; Fixed bug in TKNIZE. The buffer address ; should be to physical mem, not virtual! ; Y1.2 00-09-05 01:00 BQT Added timeout functionality. ; Y1.3 00-09-06 03:00 BQT Added SAVE/RESTORE and RESTART opcode. ; Y1.4 00-09-06 20:00 BQT Added handling of terminating chars in input, ; and Latin-1. ; Y1.5 00-09-07 15:15 BQT Bugfix in GETCHR. When Latin-1 input was added ; timeout return broke. ; Y1.6 00-09-07 16:00 BQT Changed code to detect if screen was modified ; during GETSTR (through timer calls). ; Y1.7 00-09-15 02:00 BQT Don't echo a newline if input line wasn't ; terminated by a CR. Bugfix in DOSAVE and DOREST ; which didn't call INPINI/INPEND. Added VT200 ; special keys for function keys, based on what ; they do in Beyond Zork. ; V1.8 00-09-22 01:00 BQT Added timeout capability to GETCH2. ; V1.9 00-10-07 21:00 BQT Added newline output when restart. ; V1.10 00-11-07 14:00 BQT Moved SETCOL to ZSCREE.MAC. ; V1.11 00-12-29 03:00 BQT Changed semantics of CHARNE so that timeout ; gave carry set. This meant we had to change ; GETCHR do that timeout will return -1/-2. ; V1.12 00-12-30 04:30 BQT Changed restart and restore to also restore ; stack pointer to initial game value. ; Bugfix: V4 and later restore should not ; reset screens. ; V1.13 01-02-26 13:30 BQT Added parameters to save/restore in V5. ; V1.14 03-09-02 00:00 BQT Added some junk info in saved game format. ; V1.15 05-03-01 14:00 BQT Changed restart to re-initialize screen. ; V1.16 05-05-24 16:00 BQT Changed echo of input to use SCRECH instead ; of SCRCHR (which gobbles spaces on wrap). ; V1.17 05-07-26 01:00 BQT Bugfix in GET1. If no function pointer exist, ; don't call DOCALL at all. In the case of calls ; outside of game scope, the thing will barf ; if calling DOCALL/FETCH. ; (Typically in at startup) ; V1.18 05-10-25 01:00 BQT Added new Latin1 <-> ZSCII conversion. ; V1.19 07-11-06 21:30 BQT Bugfix. DOREST did a reset screen always. ; Also, cleaned up restore routines. ; V1.20 08-09-04 16:30 BQT Changed INPINI call. Moved most INPINI/INPEND ; to STRGET ; -- .INCLUDE /ZMAC/ ; .PSECT DATA,D,RW ; BLK: .WORD 0 ; FPTR:: .WORD 0 ; Function pointer for input interrupt TMO:: .WORD 0 ; Timeout value for input interrupt ; NLFLG: .WORD 0 ; FNAML==40 FNAM:: .BLKB FNAML ; .PSECT TEXT,D,RO ; DELSTR: .ASCIZ <8.>" "<8.> ; Delete string. CRSTR: .ASCIZ <13.><10.> ; CR string. ; SAVNAM: .ASCIZ /Save to file: / RESNAM: .ASCIZ /Restore from file: / BADFMT: .ASCIZ /Save file don't match game./<15><12> BADSAV: .ASCIZ /File isn't a ZEMU save file./<15><12> ; ESCTAB: .ASCIZ /p/ ; KP0 ; Different esc sequences, and the code .BYTE 145. ; they correspond to. .ASCIZ /q/ ; KP1 .BYTE 146. .ASCIZ /r/ ; KP2 .BYTE 147. .ASCIZ /s/ ; KP3 .BYTE 148. .ASCIZ /t/ ; KP4 .BYTE 149. .ASCIZ /u/ ; KP5 .BYTE 150. .ASCIZ /v/ ; KP6 .BYTE 151. .ASCIZ /w/ ; KP7 .BYTE 152. .ASCIZ /x/ ; KP8 .BYTE 153. .ASCIZ /y/ ; KP9 .BYTE 154. .ASCIZ /A/ ; Up .BYTE 129. .ASCIZ /B/ ; Down .BYTE 130. .ASCIZ /D/ ; Left .BYTE 131. .ASCIZ /C/ ; Right .BYTE 132. ; F1 (LOOK AROUND) .ASCIZ /P/ ; (PF1) .BYTE 133. .ASCIZ /6~/ ; (Next screen) .BYTE 133. ; F2 (INVENTORY) .ASCIZ /Q/ ; (PF2) .BYTE 134. .ASCIZ /1~/ ; (Find) .BYTE 134. ; F3 (STATUS) .ASCIZ /R/ ; (PF3) .BYTE 135. .ASCIZ /28~/ ; (Help) .BYTE 135. ; F4 (EXAMINE) .ASCIZ /S/ ; (PF4) .BYTE 136. .ASCIZ /4~/ ; (Select) .BYTE 136. ; F5 (TAKE ...) .ASCIZ /m/ ; (KP-) .BYTE 137. .ASCIZ /2~/ ; (Insert here) .BYTE 137. .ASCIZ /15~/ ; (F5) .BYTE 137. ; F6 (DROP ...) .ASCIZ /17~/ ; (F6) .BYTE 138. .ASCIZ /3~/ ; (Remove) .BYTE 138. ; F7 (ATTACK MONSTER) .ASCIZ /18~/ ; (F7) .BYTE 139. .ASCIZ /29~/ ; (Do) .BYTE 139. ; F8 (AGAIN) .ASCIZ /19~/ ; (F8) .BYTE 140. .ASCIZ /5~/ ; (Previous screen) .BYTE 140. ; F9 (UNDO) .ASCIZ /20~/ ; (F9) .BYTE 141. ; F10 (OOPS ...) .ASCIZ /21~/ ; (F10) .BYTE 142. .ASCIZ /23~/ ; F11 .BYTE 143. .ASCIZ /24~/ ; F12 .BYTE 144. .BYTE 0,0 ; End of table. ; LCTAB: .BYTE 0,1,2,3,4,5,6,7,10,11,12,13,14,15,16,17 .BYTE 20,21,22,23,24,25,26,27,30,31,32,33,34,35,36,37 .BYTE 40,41,42,43,44,45,46,47,50,51,52,53,54,55,56,57 .BYTE 60,61,62,63,64,65,66,67,70,71,72,73,74,75,76,77 .BYTE 100,141,142,143,144,145,146,147,150,151,152,153,154,155,156,157 .BYTE 160,161,162,163,164,165,166,167,170,171,172,133,134,135,136,137 .BYTE 140,141,142,143,144,145,146,147,150,151,152,153,154,155,156,157 .BYTE 160,161,162,163,164,165,166,167,170,171,172,173,174,175,176,177 .BYTE 200,201,202,203,204,205,206,207,210,211,212,213,214,215,216,217 .BYTE 220,221,222,223,224,225,226,227,230,231,232,233,234,235,233,234 .BYTE 235,241,242,243,244,245,246,244,245,251,252,253,254,255,256,251 .BYTE 252,253,254,255,256,265,266,267,270,271,265,266,267,270,271,277 .BYTE 300,301,302,303,277,300,301,302,303,311,311,313,313,315,316,317 .BYTE 315,316,317,323,323,325,325,327,330,327,330,333,334,334,336,337 .BYTE 340,341,342,343,344,345,346,347,350,351,352,353,354,355,356,357 .BYTE 360,361,362,363,364,365,366,367,370,371,372,373,374,375,376,377 ; .PSECT CODE,I,RO ; ; CVTLC - Convert ZSCII to lowercase. ; ; In: R1 - Character ; ; Out: R1 - Character ; CVTLC: BIC #^C377,R1 MOVB LCTAB(R1),R1 BIC #^C377,R1 RETURN ; ; GETCH2 - Get one character. ; ; In: R3 - Timeout value. ; Out: R3 - ZSCII character read. ; ; -2 means timeout abort (read, when plying game). ; -1 means timeout. ; GETCH2:: MOV R3,TMO CALL INPINI CALL GETCHR CALL INPEND RETURN ; ; GETCHR - Get one character, with translation for special keys. ; ; Out: R3 - ZSCII character. ; ; -2 means timeout abort (read, when playing game). ; -1 means timeout. ; GETCHR: CALL RESLIN ; Reset line count. MOV R0,-(SP) ; Save registers. MOV R1,-(SP) CALL GET1 ; Get character. 1$: CMPB R0,#33 ; ESC? BEQ 10$ ; Yes. Possible special handling. CMPB R0,#233 ; CSI? BEQ 10$ ; Yes. CMPB R0,#217 ; SS3? BEQ 10$ ; Yes. 2$: MOV R0,R1 ; Timeout? BMI 9$ ; Yes. CALL CL2Z ; No. Convert to ZSCII. 9$: MOV R1,R3 MOV (SP)+,R1 MOV (SP)+,R0 ; Restore registers. RETURN ; ; We received an ESC. If this is a VT52, or VT100 and better, we can do ; some tricks now... ; 10$: CMP SCRTYP,#VT52 ; VT52? BEQ 100$ ; Yes. CMP SCRTYP,#VT100 ; VT100 or better? BLO 2$ ; No. ; ; VT100 or better handling. ; 200$: MOV #ESCBF,R3 ; Set up pointer to buffer for saves. BIT #200,R0 ; Was it 8-bit ctrl? BNE 210$ ; Yes. CALL GET1 ; No. Read next. CMPB R0,#'[ ; CSI? BEQ 210$ ; Yes. CMPB R0,#'O ; SS3? BEQ 210$ ; Yes. BR 1$ ; Uh? What was this? ; ; We now have the first parts of an ESC sequence. Now we'll read until ; we get a letter. ; 210$: CALL GET1 ; Read... MOV R0,R1 ; Perhaps timeout... BMI 9$ ; Yes... MOVB R1,(R3)+ ; No. Save char in buffer. CMPB R1,#100 ; Termination? BLT 210$ ; No. CLRB (R3) ; Okay. Now we have it all. BR 1000$ ; ; VT52 ESC handling... ; 100$: MOV #ESCBF,R3 ; Place to save next characters... 110$: CALL GET1 ; Get one more char. MOV R0,R1 ; Timeout? BMI 9$ ; Yes. MOVB R1,(R3) ; No. Save char. CMPB R1,#'? ; Was it a '?' BEQ 110$ ; Yes. Go again. CLRB 1(R3) ; No. Mark end. ; ; We'll now try to find a matching entry to what we read in a table. ; 1000$: MOV #ESCTAB,R0 1010$: MOV #ESCBF,R3 ; Next entry. Point at string. 1020$: TSTB (R0) ; End of entry? BEQ 1030$ ; Yes. We might be done. CMPB (R0)+,(R3)+ ; Compare strings. BEQ 1020$ ; Equal. Continue. 1025$: TSTB (R0)+ ; Not equal. Find next entry. BNE 1025$ 1027$: TSTB (R0)+ ; End of entry. Any more entries? BNE 1010$ ; Yes. Continue. MOV #33,R3 ; No match. Give ESC back. MOV (SP)+,R1 MOV (SP)+,R0 RETURN 1030$: CMPB (R0)+,(R3)+ ; End of our string too? BNE 1027$ ; No. Do next entry. CLR R3 BISB (R0),R3 ; Get result. MOV (SP)+,R1 MOV (SP)+,R0 RETURN ; ; GET1 - Read one character. ; ; Out: R0 - Character. ; ; This routine also handles timeouts. ; If the underlying read function returns with carry set, that means we should ; call the routine whose address are in FPTR. If that routine then ; returns 1, GET1 should abort, and will return -2, otherwise ; we'll return -1 to indicate that we had a timeout, and *might* ; want to do some extra handling. ; .ENABL LSB GET1: MOV R1,-(SP) ; Save registers. MOV R2,-(SP) MOV R3,-(SP) CALL CHARNE ; Read character. BCC 100$ ; No timeout. MOV #ARGS,R2 ; Yes. Setup call. MOV FPTR,(R2) BEQ 10$ ; No function, skip things below. MOV #1,R3 MOV #R.INT,-(R5) ; Return handler. CALL DOCALL ; Perform call. JMP FETCH ; And start executing. ; ; I/O "interrupt" return. ; IOINT:: TST (SP)+ ; Drop return to fetch. TST R0 ; Check result. BEQ 10$ ; False means return -1. MOV #-2,R0 BR 100$ 10$: MOV #-1,R0 100$: MOV (SP)+,R3 ; Restore registers. MOV (SP)+,R2 MOV (SP)+,R1 RETURN .DSABL LSB ; ; ISPRIN - Is character printable? ; ; In: R3 - Character. ; ; Out: Carry set if character is printable. ; ISPRIN: CMPB R3,#40 BLO 10$ CMPB R3,#177 BLO 20$ CMPB R3,#155. BLO 10$ CMPB R3,#251. BLO 20$ ; 10$: CLC 20$: RETURN ; ; GETSTR - Get a string from the user. ; ; In: R0 - Address where to place next char. ; R1 - Address of start of buffer. ; R2 - Free space left in buffer. ; ; Out: R0 - updated. ; R1 - Terminating character. ; GETSTR:: CALL INPINI ; Initiate input processing. MOV R3,-(SP) ; Save registers. 10$: CALL RESMOD ; Clear screen flag. CLR NLFLG 11$: CALL GETCHR ; Read a character. CMP R3,#-2 ; Timeout? BEQ 999$ ; Yes. Finish. TST R3 BPL 12$ ; No. Reread? ; ; We had a timeout. Maybe we should redisplay input here... ; CALL ISMOD ; Did something got printed? BCC 11$ ; No. CLRB (R0) ; Yes. Mark end of buffer. MOV R0,-(SP) ; Save pointer. MOV R1,R0 ; Get start of buffer. CALL SCRTXT ; Output text. MOV (SP)+,R0 ; Restore pointer. BR 10$ ; ; We got a normal character. Let's handle it. ; 12$: CMPB R3,#13. ; CR? BEQ 100$ ; Yes. Finish. MOV R4,-(SP) ; Save R4. MOV ZTCPTR,R4 ; Check other terminators. BEQ 129$ ; None exist. 120$: TSTB (R4) ; End of table? BEQ 129$ ; Yes. CMPB R3,(R4)+ ; No. Is it a match? BNE 120$ ; No. Loop. MOV (SP)+,R4 ; Yes. Restore R4. BR 111$ ; No. Loop. 129$: MOV (SP)+,R4 ; Restore R4. CMPB R3,#127. ; DEL? BEQ 90$ ; Yes. CMPB R3,#8. BEQ 90$ CMPB R3,#25 ; ^U? BEQ 80$ ; Yes. TST R2 ; Any space left? BEQ 10$ ; No. Go again. CALL ISPRIN ; Printable? BCC 10$ ; No. MOVB R3,(R0)+ ; Yes. Save char. MOV R1,-(SP) ; Save R1. MOV R3,R1 CALL CZ2L ; Convert to Latin-1. CALL SCRECH ; echo character. MOV (SP)+,R1 ; Restore R1. DEC R2 ; Update values. BR 10$ ; ; ^U ; 80$: MOV R0,R3 ; Get size in R3. SUB R1,R3 BEQ 10$ ; Nothing to delete... MOV #DELSTR,R0 ; Point at delete string. ADD R3,R2 ; Number of additional characters in buf 81$: CALL SCRTXT ; Output delete string. SOB R3,81$ ; Repeat. MOV R1,R0 ; Set pointer. BR 10$ ; Done. ; ; Delete... ; 90$: CMP R0,R1 ; Are we at start? BEQ 10$ ; Yes. Go again. DEC R0 ; No. Back up. INC R2 MOV R0,-(SP) ; Save registers. MOV #DELSTR,R0 ; Output delete sequence. CALL SCRTXT MOV (SP)+,R0 ; Restore registers. BR 10$ ; ; End of line came. ; 100$: MOV R0,-(SP) MOV #CRSTR,R0 ; Now output a newline. CALL SCRTXT CALL FLUSH CALL INPEND ; Input done. MOV (SP)+,R0 INC NLFLG 111$: MOV R3,-(SP) ; Save terminating char. MOV R0,-(SP) ; Save final pointer. SUB R1,R0 ; Get length. BEQ 102$ MOV R1,R3 ; Get pointer in R3. 101$: MOVB (R3),R1 ; Convert all chars to lowercase. CALL PRNCHR CALL CVTLC MOVB R1,(R3)+ SOB R0,101$ 102$: TST NLFLG BEQ 103$ MOV #13.,R1 CALL PRNCHR 103$: MOV (SP)+,R0 ; Restore end pointer. MOV (SP)+,R1 ; Get terminating char. MOV (SP)+,R3 RETURN ; 999$: MOV R1,R0 ; Set pointer to start. CLR R1 ; Terminating char is nul. MOV (SP)+,R3 RETURN ; ; 1OP:135 7 print_addr byte-address-of-string ; .ENABL LSB PADDR:: .INSTR "print_addr",#1 MOV (R2),R3 ; Get address. CLR R2 BR PSTR .DSABL LSB ; ; 1OP:141 D print_paddr packed-address-of-string ; .ENABL LSB PRPADR:: .INSTR "print_paddr",#1 MOV (R2),R1 ; Get packed address. CALL @PPACK ; Calculate address. MOV R1,R3 ; Move answer into R2,R3 MOV R0,R2 .DSABL LSB ; ; Print a string from an address given in R2,R3 ; PSTR: CLR -(SP) ; Make room on stack for word. CALL ATRAN ; Translate address. MOVB (R0),1(SP) ; Save high byte. INC R3 ; Next address. BNE 20$ INC R2 20$: CALL ATRAN ; Translate address. MOVB (R0),(SP) MOV (SP)+,R1 ; Put together both bytes. INC R3 ; Next address. BNE 30$ INC R2 30$: CALL PUTZW ; Output packed text word. TST R1 ; Check if end of string. BPL PSTR ; No. RETURN ; ; 1OP:138 A print_obj object ; .ENABL LSB PROBJ:: .INSTR "print_obj",#1 MOV (R2),R0 ; Get object number. CALLR OBJTXT ; Get object text. .DSABL LSB ; ; 0OP:178 2 print ; .ENABL LSB PRINT:: .INSTR "print",#0 10$: .GETIW R1 ; Get word. CALL PUTZW ; Output it. TST R1 ; repeat until last word. BPL 10$ RETURN .DSABL LSB ; ; 0OP:179 3 print_ret ; .ENABL LSB PRINTR:: .INSTR "print_ret",#0 CALL PRINT ; Easy... :-) CALL NEWLIN CALLR RTRUE .DSABL LSB ; ; 0OP:181 5 1 save ?(label) ; .ENABL LSB SAVE1:: .INSTR "save(1)",#0 CALL DOSAVE TST R0 BNE 10$ JMP BFALSE ; Failed. 10$: JMP BTRUE ; Ok! .DSABL LSB ; ; 0OP:182 6 1 restore ?(label) ; .ENABL LSB REST1:: .INSTR "restore(1)",#0 CALL DOREST TST R0 BNE 10$ JMP BFALSE ; Failure. 10$: MOV SAVSP,SP ; Setup stack pointer. MOV #FETCH,-(SP) ; Push a return address. MOV #1,R3 ; Clear top window. MOV #ARGS,R2 MOV #-1,(R2) CALLR ERWIN JMP BTRUE ; Success in new context. .DSABL LSB ; ; Perform a game save. ; ; Out: R0 - Result of save. ; 0 - Fail. ; 1 - Success. ; DOSAVE: MOV ZEROP,R3 MOV 20(R3),-(SP) BICB #1,21(R3) MOV #SAVNAM,R0 ; Output prompt. CALL SCRTXT CLR TMO ; No timeout. MOV #FNAM,R0 ; Read filename. MOV R0,R1 MOV #FNAML-1,R2 CALL GETSTR ; Get string. CLRB (R0) ; Terminate file name. MOV R0,R1 MOV #FNAM,R0 ; Get pointer to file name. SUB R0,R1 ; Get length of file name. MOV #-1,R2 ; Indicate that we want a new file. CALL SAVOPN ; Create save file. BCC 1$ JMP 1000$ ; ; We now have a save file open. ; ; Let's put down the data we want to save. ; First is identification and game state. ; 1$: MOV #IOBUF,R0 ; Data to write. MOV #"ZE,(R0)+ ; Identifier. MOV #"MU,(R0)+ MOV ZVER,(R0)+ ; Game version. MOV ZDICT,(R0)+ ; Dictionary. MOV ZOBJ,(R0)+ ; Object table. MOV ZVAR,(R0)+ ; Variables. MOV WRLIM,(R0)+ ; Write limit. MOV ZPC,(R0)+ ; PC MOV ZPC+2,(R0)+ MOV STKTOP,(R0) ; Stack size. SUB R5,(R0)+ MOV STKTOP,(R0) ; Frame pointer. SUB R4,(R0)+ MOV GAMID,(R0)+ ; Save junk game info. MOV GAMID+2,(R0)+ MOV GAMID+4,(R0)+ MOV #IOBUF,R0 ; Point at buffer. CALL SAVBLK ; Save block. ; ; Next is game stack. ; MOV STKTOP,R3 ; Get top of stack. MOV #IOBUF,R0 ; Block pointer. MOV #1000/2,R1 ; Length of block in words. BR 20$ 10$: MOV -(R3),(R0)+ ; Save word. DEC R1 ; Full block? BNE 20$ ; No. MOV #IOBUF,R0 ; Yes... MOV #1000/2,R1 CALL SAVBLK ; Write out block. 20$: CMP R3,R5 ; Stack done? BNE 10$ ; No. ; ; Now we have to save all the differences from the original gamefile. ; SOFF=2 ; Start offset to check from. MOV #IOBUF,R0 MOV #1000/4,R1 CALL SAVBLK ; Save last piece of stack. MOV R4,-(SP) ; Save registers. MOV R5,-(SP) CLR BLK ; R2 shall hold block number. MOV ZEROP,R3 ; R3 points at current data. ADD #SOFF,R3 MOV WRLIM,R4 ; R4 counts off data to check. SUB #SOFF,R4 ASR R4 ; Count should be in words. MOV #IOBUF2,R5 ; Point at buffer for original data. .BLK R5,BLK ; Read one block. ADD #SOFF,R5 MOV #<1000-SOFF>/2,R2 ; Number of words per block. ; ; Here we have the following: ; R0 points to write buffer ; R1 holds doublewords left before write buffer is full. ; R2 holds words left in read buffer. ; R3 points at game memory we're currently checking. ; R4 holds the number of words of game memory left to check. ; R5 points at read buffer. ; 110$: CMP (R3),(R5)+ ; Data change? BEQ 120$ ; No. MOV R3,(R0) ; Yes. Save address. SUB ZEROP,(R0)+ MOV (R3),(R0)+ ; Save data. DEC R1 ; Left in this buffer. BNE 120$ ; Buffer not full. MOV #IOBUF,R0 ; Buffer full. MOV #1000/4,R1 CALL SAVBLK ; Write out buffer. 120$: ADD #2,R3 ; Next address. DEC R4 BEQ 130$ ; End of dynamic memory. SOB R2,110$ ; Next word in block. INC BLK ; Next block. MOV #IOBUF2,R5 ; Point at buffer for original data. .BLK R5,BLK ; Read one block. MOV #1000/2,R2 ; Number of words per block. BR 110$ ; Loop until all is done. ; 130$: CLR (R0) MOV #IOBUF,R0 ; Buffer full. CALL SAVBLK ; Write out buffer. ; ; All changes have been written. Now we're done. ; MOV (SP)+,R5 ; Restore registers. MOV (SP)+,R4 MOV #1,R0 ; Success. CALL SAVCLO BR 1010$ ; 1000$: CLR R0 1010$: MOV ZEROP,R3 MOV (SP)+,20(R3) RETURN ; ; DOREST - Do the actual game restore. ; ; Out: R0 - Result ; 0 - Fail. ; 2 - Success. ; DOREST: MOV ZEROP,R3 MOV 20(R3),-(SP) BICB #1,21(R3) MOV #RESNAM,R0 ; Output prompt. CALL SCRTXT CLR TMO ; No timeout. MOV #FNAM,R0 ; Read filename. MOV R0,R1 MOV #FNAML-1,R2 CALL GETSTR CLRB (R0) ; Terminate filename. MOV R0,R1 MOV #FNAM,R0 ; Get pointer to file name. SUB R0,R1 ; Get length of file name. CALL RESOPN ; Open save file. BCS 1000$ ; Fail. ; ; We now have a retore file open... ; ; Start by checking the data we want to restore. ; MOV #IOBUF,R0 ; Buffer to read to. CALL RESBLK ; Restore block. CMP #"ZE,(R0)+ ; Check contents. BNE 998$ CMP #"MU,(R0)+ BNE 998$ CMP ZVER,(R0)+ ; A save file. Our game? BNE 999$ CMP ZDICT,(R0)+ BNE 999$ CMP ZOBJ,(R0)+ BNE 999$ CMP ZVAR,(R0)+ BNE 999$ CMP WRLIM,(R0)+ BNE 999$ MOV (R0)+,ZPC ; Save file feels good. Let's use it. MOV (R0)+,ZPC+2 MOV (R0)+,R3 ; Get stack size. MOV STKTOP,R4 SUB (R0)+,R4 ; Get frame pointer. ; ; Now restore stack. ; MOV STKTOP,R5 ; Stack pointer. ASR R3 ; Get stack size in words. MOV #IOBUF,R0 ; Get stack... MOV #1000/2,R1 CALL RESBLK ; Read block. 20$: MOV (R0)+,-(R5) ; Push value. DEC R1 ; Count block. BNE 30$ ; Block not finished. MOV #IOBUF,R0 MOV #1000/2,R1 CALL RESBLK 30$: SOB R3,20$ ; Repeat until whole stack done. ; ; Now do the game area. ; CALL DYNINI ; Reset game area. CALL VARINI 90$: MOV #IOBUF,R0 ; Point at I/O buffer. MOV #1000/4,R1 ; Size of block. CALL RESBLK 100$: MOV (R0)+,R2 ; Point at word. BEQ 110$ ; Final marker... ADD ZEROP,R2 MOV (R0)+,(R2) ; Restore data. SOB R1,100$ ; Repeat for whole block. BR 90$ ; Next block. ; ; All done. ; 110$: CALL SCRVAR ; Setup screen variables. MOV #2,R0 CALL RESCLO BR 1010$ ; 998$: MOV #BADSAV,R0 BR 9990$ ; 999$: MOV #BADFMT,R0 9990$: CALL SCRTXT CALL RESCLO 1000$: CLR R0 1010$: MOV ZEROP,R3 MOV (SP)+,20(R3) RETURN ; ; 0OP:183 7 1 restart ; .ENABL LSB RSTART:: .INSTR "restart",#0 CALL DYNINI ; Reinitiate dynamic memory. CALL VARINI ; Setup variables. CALL SCRINI ; Initiate screen. MOV SAVSP,SP ; Reset SP. JMP ZRUN ; Start running. .DSABL LSB ; ; 0OP:187 B new_line ; .ENABL LSB NEWLIN:: .INSTR "new_line",#0 MOVB #13.,R1 CALL PUTCHR MOVB #10.,R1 CALLR PUTCHR .DSABL LSB ; ; 0OP:188 C 3 show_status ; .ENABL LSB SHOSTS:: .INSTR "show_status",#0 CALLR SCRSTS .DSABL LSB ; ; 0OP:181 5 4 save -> (result) ; .ENABL LSB SAVE4:: .INSTR "save(4)",#0 CALL DOSAVE CALLR RESULT .DSABL LSB ; ; 0OP:182 5 4 restore -> (result) ; .ENABL LSB REST4:: .INSTR "restore(4)",#0 CALL DOREST TST R0 BEQ 10$ MOV SAVSP,SP ; Setup stack pointer. MOV #FETCH,-(SP) ; Push return address. 10$: CALLR RESULT .DSABL LSB ; ; VAR:228 4 1 sread text parse ; .ENABL LSB SREAD1:: .INSTR "sread(1)",#2 CMP ZVER,#3 ; Version 3? BNE 1$ ; No. CALL SCRSTS ; Show status. MOV #ARGS,R2 1$: CLR TMO ; No timeout. MOV (R2),R3 ; Get argument. CLR R2 CALL ATRAN ; Translate address. MOV R0,-(SP) ; Save address. MOVB (R0)+,R2 ; Get allowed length. BIC #^C377,R2 DEC R2 MOV R0,R1 ; And start of buffer pointer. MOV R1,-(SP) ; Save string pointer. CALL GETSTR ; Get string. CLRB (R0) ; Set end byte. MOV (SP)+,R1 ; Get string pointer. MOV (SP)+,R0 ; Restore start pointer. ; ; Now we have a nul-terminated string. ; ; R0 holds the start of buffer, while R1 points at the string. ; MOV R4,-(SP) ; Save game frame pointer. MOV ARGS+2,R3 ; Parse address. MOV ZDICT,R2 ; Get dictionary. CLR R4 ; Flags... CALL PARSE ; Parse string. MOV (SP)+,R4 ; Restore frame pointer. RETURN .DSABL LSB ; ; VAR:229 5 print_char output-character-code ; .ENABL LSB PCHAR:: .INSTR "print_char",#1 MOV (R2),R1 CALLR PUTCHR .DSABL LSB ; ; VAR:230 6 print_num value ; .ENABL LSB PNUM:: .INSTR "print_num",#1 MOV (R2),R0 CALLR NUMTXT .DSABL LSB ; ; VAR:245 15 5/3 sound_effect number effect volume routine ; .ENABL LSB SOUND:: .INSTR "sound_effect" CMP (R2),#2 BLOS 10$ .MSG <"Special sound effects are not supported."> JMP BADFUN ; ; The only sound effect we have is the BEL. ; 10$: MOV #7,R1 CALLR SCRCHR .DSABL LSB ; ; VAR:228 4 sread text parse time routine ; ; Read in V4. Works almost like V1-V3, but we can have ; additional parameters... ; .ENABL LSB SREAD4:: .INSTR "sread(4)" CMP R3,#4 ; 4 args? BEQ 1$ ; Yup. CLR 6(R2) ; No. Clear function pointer. CMP R3,#3 ; 3 args? BEQ 1$ ; Yup. CLR 4(R2) ; No. Clear timeout. CMP R3,#2 ; 2 args? BEQ 1$ ; Yup. JMP BADFUN ; No. Bad function. 1$: MOV (R2)+,R3 ; Get argument. MOV (R2)+,-(SP) ; Parse buffer. MOV (R2)+,TMO ; Timeout. MOV (R2),FPTR ; Function pointer. CLR R2 CALL ATRAN ; Translate address. MOV R0,-(SP) ; Save address. MOVB (R0)+,R2 ; Get allowed length. BIC #^C377,R2 DEC R2 MOV R0,R1 ; And start of buffer pointer. MOV R1,-(SP) ; Save string pointer. CALL GETSTR ; Get string. CLRB (R0) ; Set end byte. MOV (SP)+,R1 ; Get string pointer. MOV (SP)+,R0 ; Restore start pointer. ; ; Now we have a nul-terminated string. ; ; R0 holds the start of buffer, while R1 points at the string. ; MOV (SP)+,R3 ; Parse address. MOV ZDICT,R2 ; Get dictionary. MOV R4,-(SP) ; Save frame pointer. CLR R4 ; Flags. CALL PARSE ; Parse string. MOV (SP)+,R4 ; Restore frame pointer. RETURN .DSABL LSB ; ; VAR:246 16 4 read_char 1 time routine -> (result) ; .ENABL LSB RCHAR:: .INSTR "read_char" CMP R3,#3 ; 3 args? BEQ 1$ ; Yes. CLR 4(R2) ; No. Clear function pointer. CMP R3,#2 ; 2 args? BEQ 1$ ; Yes. CLR 2(R2) ; No. Clear timeout. CMP R3,#1 ; 1 arg? BEQ 1$ ; Yes. JMP BADFUN ; Bad function. 1$: TST (R2)+ ; Skip first param. MOV (R2)+,TMO ; Timeout. MOV (R2),FPTR CALL INPINI 10$: CALL GETCHR CMP R3,#-1 ; Check result... BEQ 10$ ; If negative; go again. CALL INPEND MOV R3,R0 CALLR RESULT .DSABL LSB ; ; VAR:247 17 4 scan_table x table len form -> (result) ; ; Scan a table for a specified value. Return address of value, ; if found. ; .ENABL LSB SCANT:: .INSTR "scan_table" CMP R3,#4 ; 4 args? BEQ 10$ ; Yes. MOV #202,6(R2) ; No. Default arg 4 (82h) CMP R3,#3 ; 3 args? BEQ 10$ ; Yes. JMP BADFUN ; Baaaad. 10$: MOV 2(R2),R0 ; Address of table. MOV 6(R2),R1 ; Get form. BIT #200,R1 ; Word values? (80h) BEQ 100$ ; No. Byte values. BIC #200,R1 ; Clear flag. (80h) 20$: .GETWB R0,R3 ; Read value. CMP R3,(R2) ; Match? BEQ 200$ ; Yes. ADD R1,R0 ; No. Next entry. DEC 4(R2) ; Count entries. BNE 20$ ; And repeat. BR 190$ ; Done. 100$: .GETBB R0,R3 ; Get value. CMPB R3,(R2) ; Match? BEQ 200$ ; Yes. ADD R1,R0 ; No. Next entry. DEC 4(R2) ; Count entries. BNE 100$ ; Until done. 190$: CLR R0 ; Nothing found. Clear result. 200$: CALL RESULT TST R0 BEQ 210$ JMP BTRUE 210$: JMP BFALSE .DSABL LSB ; ; VAR:228 5 aread text parse time routine -> (result) ; Read a line from user in V5 and later. ; .ENABL LSB AREAD:: .INSTR "aread" CMP R3,#4 ; 4 arguments? BEQ 1$ ; Yes. CLR 6(R2) ; No. Clear routine pointer. CMP R3,#3 ; 3 arguments? BEQ 1$ ; Yes. CLR 4(R2) ; No. Clear timeout. CMP R3,#2 ; 2 arguments? BEQ 1$ ; Yes. CLR 2(R2) ; No. Clear parse buffer. CMP R3,#1 ; 1 argument? BEQ 1$ ; Yes. JMP BADFUN ; Can't deal with it. 1$: MOV (R2)+,R3 ; Get address of buffer. CLR -(SP) ; Make room on stack. MOV (R2)+,-(SP) ; Parse buffer. MOV (R2)+,TMO ; Timeout MOV (R2),FPTR CLR R2 CALL ATRAN MOV R0,-(SP) ; Save physical address. MOVB (R0)+,R2 ; Get max length. BIC #^C377,R2 MOV R0,R1 MOVB (R1)+,R0 ; Get current length. BIC #^C377,R0 ADD R1,R0 ; Point where to place next char. MOV R1,-(SP) ; Save address of start of input. CALL GETSTR CLRB (R0) ; Put in a nul char here (even if ; std says no) SUB (SP)+,R0 ; Calculate actual length read. MOV R0,R2 ; Save length in R2. MOV (SP)+,R0 ; Restore pointer to buffer. MOVB R2,1(R0) ; Save length read. MOV R1,2(SP) ; Save terminating char. MOV R0,R1 ; Let R1 point at start of input string. ADD #2,R1 ; ; Now we have a nul-terminated string. ; MOV (SP)+,R3 ; Parse address. BEQ 20$ MOV R4,-(SP) ; Save frame pointer. MOV ZDICT,R2 ; Get dictionary. CLR R4 ; Flags. CALL PARSE ; Parse string. MOV (SP)+,R4 20$: MOV (SP)+,R0 ; Get terminating char. CALLR RESULT .DSABL LSB ; ; VAR:251 1B 5 tokenise text parse dictionary flag ; .ENABL LSB TKNIZE:: .INSTR "tokenize" CMP R3,#4 ; 4 args? BEQ 1$ CLR 6(R2) ; No. Default flag. CMP R3,#3 ; 3 args? BEQ 1$ CLR 4(R2) ; No. Default dictionary. CMP R3,#2 ; 2 args? BEQ 1$ JMP BADFUN ; No. Baaaad. 1$: MOV (R2),R3 ; Start of buffer. CLR R2 ; We need to find physical address. CALL ATRAN MOV R0,R1 ; Start of string... INC R1 MOVB (R1)+,R3 ; Get length of string. ADD R1,R3 ; Find end of string. CLRB (R3) ; Put end marker there. MOV ARGS+2,R3 ; Parse buffer. MOV ARGS+4,R2 ; Dictionary. BNE 10$ ; We have one. MOV ZDICT,R2 ; None present. Get default. 10$: MOV R4,-(SP) ; Save frame pointer. MOV ARGS+6,R4 ; Flags. CALL PARSE ; Do the parsing. MOV (SP)+,R4 RETURN .DSABL LSB ; ; VAR:252 1C 5 encode_text zscii-text length from coded-text ; .ENABL LSB ENCTXT:: .INSTR "encode_text",#4 JMP BADFUN .DSABL LSB ; ; EXT:0 0 5 save table bytes name -> (result) ; .ENABL LSB SAVE2:: .INSTR "save(5)" TST R3 BNE 10$ CALL DOSAVE CALLR RESULT ; ; Do a save file. ; 10$: CALL FLUSH ; Flush buffer before we work on it. MOV (R2)+,-(SP) ; Save address. ADD ZEROP,(SP) ; Adjust address. MOV (R2)+,-(SP) ; Save bytecount. MOV (R2)+,R2 ; Get filename pointer. ADD ZEROP,R2 ; Adjust it. MOV #FNAM,R0 ; Destination pointer for filename. MOV #FNAML-1,R1 ; Max filename length. MOV R1,-(SP) ; Save that. CLR R3 ; Get filename length... BISB (R2)+,R3 20$: MOVB (R2)+,(R0)+ ; Copy byte. DEC R1 ; Check if exceeded total length. BEQ 30$ ; If so, we stop here. SOB R3,20$ ; If not, continue copy until all is copied. 30$: CLRB (R0) ; Set a NUL-terminator. SUB R1,(SP) ; Calculate actual length of filename. MOV (SP)+,R1 MOV #FNAM,R0 CLR R2 ; Indicate that it's okay to reuse old file. CALL SAVOPN ; Open file. BCS 100$ MOV (SP)+,R3 ; Get source length. MOV (SP)+,R2 ; Get source address. MOV #IOBUF,R0 ; Destination address. MOV #512.,R1 ; Destination length. 40$: MOVB (R2)+,(R0)+ ; Copy byte. DEC R3 ; Count bytes... BEQ 50$ ; Done? SOB R1,40$ ; Nope. Do whole block. MOV #IOBUF,R0 MOV #512.,R1 CALL SAVBLK ; Save block. BR 40$ ; ; All has been written, except the last block... ; 50$: MOV #IOBUF,R0 CALL SAVBLK CALL SAVCLO MOV ARGS+2,R0 ; Get byte count. CALLR RESULT 100$: ADD #4,SP ; Drop stack. CLR R0 CALLR RESULT .DSABL LSB ; ; EXT:1 1 5 restore table bytes name -> (result) ; .ENABL LSB REST2:: .INSTR "restore(5)" TST R3 BNE 20$ CALL DOREST TST R0 BEQ 10$ MOV SAVSP,SP ; Restore stack pointer. MOV #FETCH,-(SP) ; Save return address. 10$: CALLR RESULT ; ; Do a read file. ; 20$: CALL FLUSH ; Flush the buffer before we use it. MOV (R2)+,-(SP) ; Save address. ADD ZEROP,(SP) ; Adjust address. MOV (R2)+,-(SP) ; Save bytecount. MOV (R2)+,R2 ; Get filename pointer. ADD ZEROP,R2 ; Adjust it. MOV #FNAM,R0 ; Destination pointer for filename. MOV #FNAML-1,R1 ; Max filename length. MOV R1,-(SP) ; Save that. CLR R3 ; Get filename length... BISB (R2)+,R3 25$: MOVB (R2)+,(R0)+ ; Copy byte. DEC R1 ; Check if exceeded total length. BEQ 30$ ; If so, we stop here. SOB R3,25$ ; If not, continue copy until all is copied. 30$: CLRB (R0) ; Set a NUL-terminator. SUB R1,(SP) ; Calculate actual length of filename. MOV (SP)+,R1 MOV #FNAM,R0 CALL RESOPN ; Open file. BCS 100$ MOV (SP)+,R3 ; Get dst length. MOV (SP)+,R2 ; Get dst address. 40$: MOV #IOBUF,R0 ; Source address. MOV #512.,R1 ; Source length. CALL RESBLK ; Read block. 45$: MOVB (R0)+,(R2)+ ; Copy byte. DEC R3 ; Count bytes... BEQ 50$ ; Done? SOB R1,45$ ; Nope. Do whole block. BR 40$ ; Next block. ; ; All has been read. ; 50$: CALL RESCLO MOV ARGS+2,R0 ; Get byte count. CALLR RESULT 100$: ADD #4,SP ; Drop stack. CLR R0 CALLR RESULT .DSABL LSB ; ; EXT:9 9 5 save_undo -> (result) ; We don't support UNDO for now. Return -1. ; .ENABL LSB SUNDO:: .INSTR "save_undo",#0 MOV #-1,R0 CALLR RESULT .DSABL LSB ; ; EXT:10 A 5 restore_undo -> (result) ; We don't support UNDO for now. Return 0. ; .ENABL LSB RUNDO:: .INSTR "restore_undo",#0 CLR R0 CALLR RESULT .DSABL LSB ; .END .TITLE ZALU .IDENT /V1.5/ ; ++ ; This is the Z-machine handler for ALU opcodes. ; (c) 2000 by Johnny Billquist ; ; History: ; ; 00-07-19 BQT Initial coding started. ; Y1.0 00-08-14 BQT First release. ; Y1.1 00-09-01 04:00 BQT Bugfix. Random didn't work when argument was ; 1. For some reason, the DIV instr. don't work ; as expected when a divide by 1 is done. ; Y1.2 00-09-08 02:00 BQT Made SEED global. ; V1.3 00-09-17 21:00 BQT Improved random number algorithm. ; V1.4 03-01-22 17:30 BQT Removed special case for DIV with 1. ; Not sure where from I got that it didn't work. ; V1.5 05-02-21 00:30 BQT Improved code speed. ; -- .INCLUDE /ZMAC/ .PSECT DATA,D,RW ; SEED:: .WORD 0 ; Random seed. ; .PSECT CODE,I,RO ; ; 2OP:7 7 test bitmap flags ?(label) ; Jump if arg1 & arg2 = arg2 ; .ENABL LSB TEST:: .INSTR "test",#2 MOV (R2)+,R0 ; Get arguments. MOV (R2),R1 COM R0 ; Invert first argument. BIC R0,R1 ; And do a clear on second arg. ; (This means we'll do an AND). CMP R1,(R2) ; Is the result the same as arg2? BEQ 10$ JMP BFALSE ; No. 10$: JMP BTRUE ; Yes. .DSABL LSB ; ; 2OP:8 8 or a b -> (result) ; OR - arg0 ^ arg1 ; .ENABL LSB OR:: .INSTR "or",#2 MOV (R2)+,R0 ; Get arguments... BIS (R2),R0 ; and OR them. CALLR RESULT ; That's it. .DSABL LSB ; ; 2OP:9 9 and a b -> (result) ; ; AND - arg0 & arg1 ; .ENABL LSB AND:: .INSTR "and",#2 MOV (R2)+,R0 ; Get argument... COM (R2) ; The second we want inverted. BIC (R2),R0 ; That means a BIC becomes AND. CALLR RESULT ; That's it. .DSABL LSB ; ; 2OP:20 14 add a b -> (result) ; ; ADD - arg0 + arg1 ; .ENABL LSB ZADD:: .INSTR "add",#2 MOV (R2)+,R0 ; Get 1:st arg. ADD (R2),R0 ; Add second arg. CALLR RESULT ; That's it. .DSABL LSB ; ; 2OP:21 15 sub a b -> (result) ; SUB - arg0 - arg1 ; .ENABL LSB ZSUB:: .INSTR "sub",#2 MOV (R2)+,R0 ; Get 1:st arg. SUB (R2),R0 ; Substract second arg. CALLR RESULT ; That's it. .DSABL LSB ; ; 2OP:22 16 mul a b -> (result) ; MUL - arg0 * arg1 ; .ENABL LSB ZMUL:: .INSTR "mul",#2 MOV (R2)+,R1 ; Get 1:st arg. MUL (R2),R1 ; Multiply second arg. MOV R1,R0 CALLR RESULT ; That's it. .DSABL LSB ; ; 2OP:23 17 div a b -> (result) ; ; DIV - arg0 / arg1 ; .ENABL LSB ZDIV:: .INSTR "div",#2 MOV (R2)+,R1 ; Get 1:st arg. SXT R0 ; as a 32-bit signed value. DIV (R2),R0 ; Divide with second arg. CALLR RESULT ; That's it. .DSABL LSB ; ; 2OP:24 18 mod a b -> (result) ; MOD - arg0 % arg1 ; .ENABL LSB ZMOD:: .INSTR "mod",#2 MOV (R2)+,R1 ; Get 1:st arg. SXT R0 ; as a 32-bit signed value. DIV (R2),R0 ; Divide. MOV R1,R0 ; Get remainder. CALLR RESULT ; That's it. .DSABL LSB ; ; 1OP:133 5 inc (variable) ; .ENABL LSB ZINC:: .INSTR "inc",#1 MOV (R2),R0 ; Get variable number. CALL VARVAL ; Get value. INC R1 ; Increment it. CALLR STOREV ; That's it. .DSABL LSB ; ; 1OP:134 6 dec (variable) ; ; Decrement variable. ; .ENABL LSB ZDEC:: .INSTR "dec",#1 MOV (R2),R0 ; Get variable number. CALL VARVAL ; Get value. DEC R1 ; Decrement. CALLR STOREV ; That's it. .DSABL LSB ; ; 1OP:143 F 1/4 not value -> (result) ; VAR:248 18 5/6 not value -> (result) ; .ENABL LSB ZNOT:: .INSTR "not",#1 MOV (R2),R0 ; Get value. COM R0 ; Invert it. CALLR RESULT ; That's it. .DSABL LSB ; ; VAR:231 7 random range -> (result) ; ; Get a random value. If arg > 0 give a value between 1 and arg. ; If arg = 0, set seed to random start. ; If arg < 0, use that as random seed. ; .ENABL LSB RANDOM:: .INSTR "random",#1 MOV (R2),R0 ; Get range. BGT 10$ ; Usual stuff. BNE 5$ ; We have a seed. CALL GETRND ; No seed? Well, get one. 5$: MOV R0,SEED ; Save seed value. CLR R0 ; No result. CALLR RESULT ; That's it. ; ; Time to get a new random value. ; 10$: MOV SEED,R3 ; Silly algorithm. ADD #17.,R3 MUL #8197.,R3 MOV R3,SEED ; ; We now have the new seed created, and also this random number is in ; R3. We should now use this to create a good random number in the requested ; range. ; ; We cannot simply divide here, since unless the requested range is a ; power of two, we'll get a non-uniform spread. ; ; If we were to use FP, the algorithm would be: ; seed/MAXINT+1 * range. ; ; Now we shall avoid FP, and we'll do it the other way around... ; (seed * range) / MAXINT+1. ; ; Since we cannot in any good way represent MAXINT+1, we'll play ; that MAXINT is only a fourth what it really is, and see that ; 0 <= seed < MAXINT ; CMP R0,#1 ; Only one possible value? BEQ 11$ ; Yes. BIC #140000,R3 ; No. Set seed condition. MUL R3,R0 ; Multiply with range. DIV #40000,R0 ; Divide by MAXINT. INC R0 ; Result should be 1-range. 11$: CALLR RESULT ; That's it. .DSABL LSB ; ; EXT:2 2 5 log_shift number places -> (result) ; Do a logic shift of arg1 by arg2 places. If arg2 is ; negative, shift is to the right, otherwise to the left. ; .ENABL LSB LOGSFT:: .INSTR "log_shift",#2 CLR R0 ; Clear high 16 bits. MOV (R2)+,R1 ; Number ASHC (R2),R0 ; Shift 32 bits, to insure ; no sign trick goes on. MOV R1,R0 ; Get result in R0. CALLR RESULT ; Done. .DSABL LSB ; ; EXT:3 3 5/- art_shift number places -> (result) ; ; Do an arithmetic shift of arg1 by arg2 places. ; If arg2 is negative, shift is to the right, otherwise ; to the left. ; .ENABL LSB ARTSFT:: .INSTR "art_shift",#2 MOV (R2)+,R0 ; Get number. ASH (R2),R0 ; Do the shift. CALLR RESULT ; Done. .DSABL LSB ; ; 2OP:4 4 dec_chk (variable) value ?(label) ; ; Decrement (arg1) and check if less than arg2. ; .ENABL LSB DECCHK:: .INSTR "dec_chk",#2 MOV (R2)+,R0 ; Get variable. CALL VARVAL ; Get value. DEC R1 ; Decrement. CALL STOREV ; Save new value. CMP R1,(R2) ; Check. BLT 10$ JMP BFALSE 10$: JMP BTRUE .DSABL LSB ; ; 2OP:5 5 inc_chk (variable) value ?(label) ; Increment (arg1) and check if greater than arg2. ; .ENABL LSB INCCHK:: .INSTR "inc_chk",#2 MOV (R2)+,R0 ; Get variable. CALL VARVAL ; Get value. INC R1 ; Increment. CALL STOREV ; Save new value. CMP R1,(R2) ; Check. BGT 10$ JMP BFALSE 10$: JMP BTRUE .DSABL LSB ; .END .TITLE ZOPTAB .IDENT /V1.6/ ; ++ ; This is the Z-machine opcode tables and functions. ; (c) 2000 by Johnny Billquist ; ; History: ; ; 00-07-19 BQT Initial coding started. ; Y1.0 00-08-26 21:00 BQT First release. ; Y1.1 00-09-11 14:00 BQT Bugfix. Two references to NOT should have been ; ZNOT. ; V1.2 00-09-16 12:00 BQT Changed ZEXIT to ABORT. ; Make it more officially done. ; V1.3 01-02-26 12:30 BQT Added print_unicode and check_unicode. ; V1.4 05-02-23 16:00 BQT Started adding V6 opcodes. ; V1.5 07-10-01 23:00 BQT Bugfix. V7 and V8 games are actually using ; the same opcodes as V5, not V6. ; V1.6 09-05-13 23:00 BQT Bugfix. The opcode for scroll_window ; and read_mouse were exchanged. ; -- .INCLUDE /ZMAC/ .IIF GT MAXVER-8. .ERROR MAXVER ; Can't handle game version .PSECT DATA,D,RW ; OP2FP:: .WORD OP2F1 OP1FP:: .WORD OP1F1 OP0FP:: .WORD OP0F1 OPVFP:: .WORD VOPF1 ; .PSECT CONST,D,RO ; OP2FL: .WORD OP2F1 ; V1 .WORD OP2F1 ; V2 .WORD OP2F1 ; V3 .WORD OP2F4 ; V4 .WORD OP2F5 ; V5 .WORD OP2F5 ; V6 .WORD OP2F5 ; V7 .WORD OP2F5 ; V8 ; OP1FL: .WORD OP1F1 ; V1 .WORD OP1F1 ; V2 .WORD OP1F1 ; V3 .WORD OP1F4 ; V4 .WORD OP1F5 ; V5 .WORD OP1F5 ; V6 .WORD OP1F5 ; V7 .WORD OP1F5 ; V8 ; OP0FL: .WORD OP0F1 ; V1 .WORD OP0F1 ; V2 .WORD OP0F3 ; V3 .WORD OP0F4 ; V4 .WORD OP0F5 ; V5 .WORD OP0F5 ; V6 .WORD OP0F5 ; V7 .WORD OP0F5 ; V8 ; VOPFL: .WORD VOPF1 ; V1 .WORD VOPF1 ; V2 .WORD VOPF3 ; V3 .WORD VOPF4 ; V4 .WORD VOPF5 ; V5 .WORD VOPF6 ; V6 .WORD VOPF5 ; V7 .WORD VOPF5 ; V8 ; ; Opcode tables... ; OP2F1: .WORD BADFUN ; 0 .WORD JE ; 1 .WORD JL ; 2 .WORD JG ; 3 .WORD DECCHK ; 4 .WORD INCCHK ; 5 .WORD JIN1 ; 6 .WORD TEST ; 7 .WORD OR ; 8 .WORD AND ; 9 .WORD TATTR ; 10 .WORD SATTR ; 11 .WORD CATTR ; 12 .WORD STORE ; 13 .WORD IOBJ ; 14 .WORD LOADW ; 15 .WORD LOADB ; 16 .WORD GPROP ; 17 .WORD GPROPA ; 18 .WORD GNPROP ; 19 .WORD ZADD ; 20 .WORD ZSUB ; 21 .WORD ZMUL ; 22 .WORD ZDIV ; 23 .WORD ZMOD ; 24 .WORD BADFUN ; 25 .WORD BADFUN ; 26 .WORD BADFUN ; 27 .WORD BADFUN ; 28 .WORD BADFUN ; 29 .WORD BADFUN ; 30 .WORD BADFUN ; 31 ; OP2F4: .WORD BADFUN ; 0 .WORD JE ; 1 .WORD JL ; 2 .WORD JG ; 3 .WORD DECCHK ; 4 .WORD INCCHK ; 5 .WORD JIN4 ; 6 .WORD TEST ; 7 .WORD OR ; 8 .WORD AND ; 9 .WORD TATTR ; 10 .WORD SATTR ; 11 .WORD CATTR ; 12 .WORD STORE ; 13 .WORD IOBJ ; 14 .WORD LOADW ; 15 .WORD LOADB ; 16 .WORD GPROP ; 17 .WORD GPROPA ; 18 .WORD GNPROP ; 19 .WORD ZADD ; 20 .WORD ZSUB ; 21 .WORD ZMUL ; 22 .WORD ZDIV ; 23 .WORD ZMOD ; 24 .WORD CALL2S ; 25 .WORD BADFUN ; 26 .WORD BADFUN ; 27 .WORD BADFUN ; 28 .WORD BADFUN ; 29 .WORD BADFUN ; 30 .WORD BADFUN ; 31 ; OP2F5: .WORD BADFUN ; 0 .WORD JE ; 1 .WORD JL ; 2 .WORD JG ; 3 .WORD DECCHK ; 4 .WORD INCCHK ; 5 .WORD JIN4 ; 6 .WORD TEST ; 7 .WORD OR ; 8 .WORD AND ; 9 .WORD TATTR ; 10 .WORD SATTR ; 11 .WORD CATTR ; 12 .WORD STORE ; 13 .WORD IOBJ ; 14 .WORD LOADW ; 15 .WORD LOADB ; 16 .WORD GPROP ; 17 .WORD GPROPA ; 18 .WORD GNPROP ; 19 .WORD ZADD ; 20 .WORD ZSUB ; 21 .WORD ZMUL ; 22 .WORD ZDIV ; 23 .WORD ZMOD ; 24 .WORD CALL2S ; 25 .WORD CALL2N ; 26 .WORD SETCOL ; 27 .WORD THROW ; 28 .WORD BADFUN ; 29 .WORD BADFUN ; 30 .WORD BADFUN ; 31 ; OP1F1: .WORD JZ ; 0 .WORD GSIB ; 1 .WORD GCHLD ; 2 .WORD GPAREN ; 3 .WORD GPROPL ; 4 .WORD ZINC ; 5 .WORD ZDEC ; 6 .WORD PADDR ; 7 .WORD BADFUN ; 8 .WORD REMOBJ ; 9 .WORD PROBJ ; 10 .WORD RET ; 11 .WORD JUMP ; 12 .WORD PRPADR ; 13 .WORD LOAD ; 14 .WORD ZNOT ; 15 OP1F4: .WORD JZ ; 0 .WORD GSIB ; 1 .WORD GCHLD ; 2 .WORD GPAREN ; 3 .WORD GPROPL ; 4 .WORD ZINC ; 5 .WORD ZDEC ; 6 .WORD PADDR ; 7 .WORD CALL1S ; 8 .WORD REMOBJ ; 9 .WORD PROBJ ; 10 .WORD RET ; 11 .WORD JUMP ; 12 .WORD PRPADR ; 13 .WORD LOAD ; 14 .WORD ZNOT ; 15 OP1F5: .WORD JZ ; 0 .WORD GSIB ; 1 .WORD GCHLD ; 2 .WORD GPAREN ; 3 .WORD GPROPL ; 4 .WORD ZINC ; 5 .WORD ZDEC ; 6 .WORD PADDR ; 7 .WORD CALL1S ; 8 .WORD REMOBJ ; 9 .WORD PROBJ ; 10 .WORD RET ; 11 .WORD JUMP ; 12 .WORD PRPADR ; 13 .WORD LOAD ; 14 .WORD CALL1N ; 15 ; OP0F1: .WORD RTRUE ; 0 .WORD RFALSE ; 1 .WORD PRINT ; 2 .WORD PRINTR ; 3 .WORD ZNOP ; 4 .WORD SAVE1 ; 5 .WORD REST1 ; 6 .WORD RSTART ; 7 .WORD RETPOP ; 8 .WORD POP ; 9 .WORD QUIT ; 10 .WORD NEWLIN ; 11 .WORD BADFUN ; 12 .WORD BADFUN ; 13 .WORD BADFUN ; 14 .WORD BADFUN ; 15 OP0F3: .WORD RTRUE ; 0 .WORD RFALSE ; 1 .WORD PRINT ; 2 .WORD PRINTR ; 3 .WORD ZNOP ; 4 .WORD SAVE1 ; 5 .WORD REST1 ; 6 .WORD RSTART ; 7 .WORD RETPOP ; 8 .WORD POP ; 9 .WORD QUIT ; 10 .WORD NEWLIN ; 11 .WORD SHOSTS ; 12 .WORD VERIFY ; 13 .WORD BADFUN ; 14 .WORD BADFUN ; 15 OP0F4: .WORD RTRUE ; 0 .WORD RFALSE ; 1 .WORD PRINT ; 2 .WORD PRINTR ; 3 .WORD ZNOP ; 4 .WORD SAVE4 ; 5 .WORD REST4 ; 6 .WORD RSTART ; 7 .WORD RETPOP ; 8 .WORD POP ; 9 .WORD QUIT ; 10 .WORD NEWLIN ; 11 .WORD BADFUN ; 12 .WORD VERIFY ; 13 .WORD BADFUN ; 14 .WORD BADFUN ; 15 OP0F5: .WORD RTRUE ; 0 .WORD RFALSE ; 1 .WORD PRINT ; 2 .WORD PRINTR ; 3 .WORD ZNOP ; 4 .WORD BADFUN ; 5 .WORD BADFUN ; 6 .WORD RSTART ; 7 .WORD RETPOP ; 8 .WORD CATCH ; 9 .WORD QUIT ; 10 .WORD NEWLIN ; 11 .WORD BADFUN ; 12 .WORD VERIFY ; 13 .WORD EXTEND ; 14 .WORD PIRACY ; 15 ; VOPF1: .WORD ZCALL ; 0 .WORD STOREW ; 1 .WORD STOREB ; 2 .WORD PUTPRP ; 3 .WORD SREAD1 ; 4 .WORD PCHAR ; 5 .WORD PNUM ; 6 .WORD RANDOM ; 7 .WORD PUSH ; 8 .WORD PULL1 ; 9 .WORD BADFUN ; 10 .WORD BADFUN ; 11 .WORD BADFUN ; 12 .WORD BADFUN ; 13 .WORD BADFUN ; 14 .WORD BADFUN ; 15 .WORD BADFUN ; 16 .WORD BADFUN ; 17 .WORD BADFUN ; 18 .WORD BADFUN ; 19 .WORD BADFUN ; 20 .WORD BADFUN ; 21 .WORD BADFUN ; 22 .WORD BADFUN ; 23 .WORD BADFUN ; 24 .WORD BADFUN ; 25 .WORD BADFUN ; 26 .WORD BADFUN ; 27 .WORD BADFUN ; 28 .WORD BADFUN ; 29 .WORD BADFUN ; 30 .WORD BADFUN ; 31 VOPF3: .WORD ZCALL ; 0 .WORD STOREW ; 1 .WORD STOREB ; 2 .WORD PUTPRP ; 3 .WORD SREAD1 ; 4 .WORD PCHAR ; 5 .WORD PNUM ; 6 .WORD RANDOM ; 7 .WORD PUSH ; 8 .WORD PULL1 ; 9 .WORD SPLITW ; 10 .WORD SETW ; 11 .WORD BADFUN ; 12 .WORD BADFUN ; 13 .WORD BADFUN ; 14 .WORD BADFUN ; 15 .WORD BADFUN ; 16 .WORD BADFUN ; 17 .WORD BADFUN ; 18 .WORD OUTSTR ; 19 .WORD INSTRN ; 20 .WORD SOUND ; 21 .WORD BADFUN ; 22 .WORD BADFUN ; 23 .WORD BADFUN ; 24 .WORD BADFUN ; 25 .WORD BADFUN ; 26 .WORD BADFUN ; 27 .WORD BADFUN ; 28 .WORD BADFUN ; 29 .WORD BADFUN ; 30 .WORD BADFUN ; 31 VOPF4: .WORD CALLVS ; 0 .WORD STOREW ; 1 .WORD STOREB ; 2 .WORD PUTPRP ; 3 .WORD SREAD4 ; 4 .WORD PCHAR ; 5 .WORD PNUM ; 6 .WORD RANDOM ; 7 .WORD PUSH ; 8 .WORD PULL1 ; 9 .WORD SPLITW ; 10 .WORD SETW ; 11 .WORD CALVS2 ; 12 .WORD ERWIN ; 13 .WORD ERLINE ; 14 .WORD SETCUR ; 15 .WORD GETCUR ; 16 .WORD STSTY ; 17 .WORD BMODE ; 18 .WORD OUTSTR ; 19 .WORD INSTRN ; 20 .WORD SOUND ; 21 .WORD RCHAR ; 22 .WORD SCANT ; 23 .WORD BADFUN ; 24 .WORD BADFUN ; 25 .WORD BADFUN ; 26 .WORD BADFUN ; 27 .WORD BADFUN ; 28 .WORD BADFUN ; 29 .WORD BADFUN ; 30 .WORD BADFUN ; 31 VOPF5: .WORD CALLVS ; 0 .WORD STOREW ; 1 .WORD STOREB ; 2 .WORD PUTPRP ; 3 .WORD AREAD ; 4 .WORD PCHAR ; 5 .WORD PNUM ; 6 .WORD RANDOM ; 7 .WORD PUSH ; 8 .WORD PULL1 ; 9 .WORD SPLITW ; 10 .WORD SETW ; 11 .WORD CALVS2 ; 12 .WORD ERWIN ; 13 .WORD ERLINE ; 14 .WORD SETCUR ; 15 .WORD GETCUR ; 16 .WORD STSTY ; 17 .WORD BMODE ; 18 .WORD OUTST2 ; 19 .WORD INSTRN ; 20 .WORD SOUND ; 21 .WORD RCHAR ; 22 .WORD SCANT ; 23 .WORD ZNOT ; 24 .WORD CALLVN ; 25 .WORD CALVN2 ; 26 .WORD TKNIZE ; 27 .WORD ENCTXT ; 28 .WORD CPYTAB ; 29 .WORD PRTAB ; 30 .WORD CKACNT ; 31 VOPF6: .WORD CALLVS ; 0 .WORD STOREW ; 1 .WORD STOREB ; 2 .WORD PUTPRP ; 3 .WORD AREAD ; 4 .WORD PCHAR ; 5 .WORD PNUM ; 6 .WORD RANDOM ; 7 .WORD PUSH ; 8 .WORD PULL2 ; 9 .WORD SPLITW ; 10 .WORD SETW ; 11 .WORD CALVS2 ; 12 .WORD ERWIN ; 13 .WORD ERLIN2 ; 14 .WORD SETCU2 ; 15 .WORD GETCUR ; 16 .WORD STSTY ; 17 .WORD BMODE ; 18 .WORD OUTST3 ; 19 .WORD INSTRN ; 20 .WORD SOUND ; 21 .WORD RCHAR ; 22 .WORD SCANT ; 23 .WORD ZNOT ; 24 .WORD CALLVN ; 25 .WORD CALVN2 ; 26 .WORD TKNIZE ; 27 .WORD ENCTXT ; 28 .WORD CPYTAB ; 29 .WORD PRTAB ; 30 .WORD CKACNT ; 31 ; EOPTAB:: .WORD SAVE2 ; 0 .WORD REST2 ; 1 .WORD LOGSFT ; 2 .WORD ARTSFT ; 3 .WORD SETFNT ; 4 .WORD DRWPIC ; 5 .WORD PICDAT ; 6 .WORD ERPIC ; 7 .WORD WINMAR ; 8 .WORD SUNDO ; 9 .WORD RUNDO ; 10 .WORD PUNICD ; 11 .WORD CUNICD ; 12 .WORD BADF2 ; 13 .WORD BADF2 ; 14 .WORD BADF2 ; 15 .WORD WINMOV ; 16 .WORD WINSIZ ; 17 .WORD WINSTY ; 18 .WORD GWINPR ; 19 .WORD SCROLL ; 20 .WORD POPSTK ; 21 .WORD BADF2 ; 22 .WORD MOUWIN ; 23 .WORD PUSHUS ; 24 .WORD PWINPR ; 25 .WORD BADF2 ; 26 .WORD BADF2 ; 27 .WORD PICTBL ; 28 .WORD BADF2 ; 29 .WORD BADF2 ; 30 .WORD BADF2 ; 31 .REPT 256.-32. .WORD BADF2 .ENDR ; .PSECT CODE,I,RO ; ZOPINI:: MOV ZVER,R1 ; Get game version. DEC R1 ; Make zero-bias. ASL R1 MOV OP2FL(R1),OP2FP MOV OP1FL(R1),OP1FP MOV OP0FL(R1),OP0FP MOV VOPFL(R1),OPVFP RETURN ; BADFUN:: .MSG <"Stop at %P,,%P. Bad opcode: %O.">,ZPC,ZPC+2,INSTR .MSG <"Game is V%D.">,ZVER BF2: MOV #ARGS,R2 MOV ARGC,R3 BEQ NOARGS .MSG <"%D arguments.">,R3 ALOOP: .MSG <"Argument: %M.">,(R2)+ SOB R3,ALOOP NOARGS: CALL ABORT ; BADF2:: .MSG <"Bad extended opcode: %O.">,INSTR JMP BF2 ; .END .TITLE ZPARSE .IDENT /V1.3/ ; ++ ; This is the Z-machine parser. ; (c) 2000 by Johnny Billquist ; ; History: ; ; 00-08-01 BQT Initial coding started. ; Y1.0 00-08-26 21:00 BQT First release. ; Y1.1 00-08-30 02:00 BQT Bugfix. If flag is set, the parser ; should skip entry if word in unknown. ; Y1.2 00-09-01 04:30 BQT Added parsing of ASCII characters. ; V1.3 00-11-07 16:00 BQT Code is working. ; -- .INCLUDE /ZMAC/ .PSECT DATA,D,RW ; SEPTBL: .BLKB 100 ; Separator table. ; WRDLEN: .WORD 0 ; Length of each word entry. WRDCNT: .WORD 0 ; Number of words in dictionary. WRDTAB: .WORD 0 ; Pointer to start of dictionary. WRDLIM: .WORD 0 ; Limit on # of words. ; WORD: .BLKB 10. ; Current word. WRDEND: ZWORD: .BLKB 18. ; Current word in ZSCII. CURLEN: .WORD 0 ; Length of current word. ZWLEN:: .WORD 0 ; Length of words in WORDS. CURWRD: .WORD 0 ; Current number of words. FLAGS: .WORD 0 ; Parse flags. ; STRPTR: .WORD 0 ; Pointer to start of string. ; .PSECT CODE,I,RO ; ; PARSE ; ; Parse a string. ; Do lexical analysis, and build the parse tree. ; ; In: R0 - Address of input buffer. ; R1 - Address of input string. ; R2 - Address of dictionary table. ; R3 - Parse buffer. ; R4 - Flags. ; PARSE:: MOV R4,FLAGS ; Save flags. MOV R5,-(SP) ; Save registers. MOV R0,STRPTR ; Save string pointer. ; ; First set up the basic parser info. ; MOV #SEPTBL,R4 .GETBB R2,R5 ; Get size of separator table. MOVB R5,(R4)+ INC R2 MOV R3,-(SP) 10$: .GETBB R2,R3 ; Copy all separators. MOVB R3,(R4)+ INC R2 SOB R5,10$ MOV (SP)+,R3 .GETBB R2,WRDLEN ; Get word length. INC R2 .GETWB R2,WRDCNT ; Get word count. ADD #2,R2 MOV R2,WRDTAB ; Save pointer to word table. ; ; Now we have all the dictionary info we need. R2 can now be ; destroyed. ; .GETBB R3,WRDLIM ; Limit on words. INC R3 MOV R3,-(SP) ; Save pointer to word count. INC R3 CLR CURWRD ; Number of words done. ; 100$: MOV #1,CURLEN CLR R2 ; Get next character. BISB (R1)+,R2 BNE 110$ ; We got something. 101$: MOV (SP)+,R3 ; Nothing more. .PUTBB R3,CURWRD ; Save actual number of words done. MOV (SP)+,R5 ; Restore registers. RETURN ; ; We have a character. ; 110$: CMP R2,#' ; Space? BEQ 100$ ; Yes. Next char please. ; ; We have the beginning of a word. ; MOV R1,-(SP) ; Save pointer to start of word. DEC (SP) ; (um, start was at previous char.) MOV #WORD,R5 ; Point at place for word. MOVB R2,(R5)+ ; Copy char. CALL ISSEP ; Is it a separator? BCS 200$ ; Yes. That's our word. ; ; The word is not a separator. Let's start copying. ; 120$: CLR R2 ; Get next char. BISB (R1),R2 BEQ 200$ ; End of string. CALL ISSEP ; Separator? BCS 200$ ; Yes. CMP R2,#' ; Space? BEQ 200$ ; Yes. CMP R5,#WRDEND-1 ; Buffer full? BGE 130$ ; Yes. MOVB R2,(R5)+ ; No. Store it. 130$: INC R1 ; Point at next char. INC CURLEN BR 120$ ; And repeat. ; ; We now have a word. ; 200$: CLRB (R5) ; Set end of word mark. ; ; Now we'll ZSCIIfy it. ; MOV R0,-(SP) ; Save register. MOV ZWLEN,R0 ; Get length of words. ASR R0 ADD ZWLEN,R0 MOV #WORD,R4 ; Ascii for word. MOV #ZWORD,R5 ; Buffer where to place zscii. 300$: CLR R2 ; Get char. BISB (R4)+,R2 BEQ 310$ ; End of buffer? CALL ZSCII ; No. Convert to ZSCII. SOB R0,300$ ; Loop until space runs out. BR 315$ ; Space ran out. 310$: MOVB #5,(R5)+ ; Space left. Fill with filler. SOB R0,310$ ; Loop. ; ; And then pack it. ; 315$: MOV ZWLEN,R5 ; Word length. ASR R5 ADD ZWLEN,R5 CLRB ZWORD(R5) ; Set end of word mark. MOV (SP)+,R0 ; Restore R0. MOV #ZWORD,R4 ; Source. MOV #ZWORD,R5 ; Destination. 320$: CLR R2 ; Setup word. BISB (R4)+,R2 ; No. Get char. ASH #5,R2 ; Shift upwards. BISB (R4)+,R2 ; No. Get next char. ASH #5,R2 ; Shift upwards. BISB (R4)+,R2 ; No. Get char. SWAB R2 MOV R2,(R5)+ ; Save word. TSTB (R4) ; More to come? BNE 320$ ; Loop. ; BIS #200,-(R5) ; Set flag on last word. ; ; We now have a correct ZSCII word in ZWORD, along with the plain ; word in WORD. ; ; We now need to find the word in the dectionary. ; CALL FNDWRD ; ; At this point we have the following information: ; R0 - Points at start of input buffer. ; R1 - Points at next word in input buffer. ; R2 - Address of word in dictionary (or 0 if no match). ; R3 - Address where in parse buffer to place result. ; (SP) - Address of start of word. ; ; Start by setting up the parse info. ; TST R2 ; Did we succeed? BNE 400$ ; Yes. TST FLAGS ; No. Should we include unknown words? BEQ 400$ ; Yes. ADD #2,SP ; No. Clean up stack. ADD #4,R3 ; Skip to next entry. BR 499$ ; Do next word. ; 400$: .PUTWB R3,R2 ; Byte address in dictionary. ADD #2,R3 .PUTBB R3,CURLEN ; Word length. INC R3 MOV (SP)+,R4 ; Get pointer to start of string. SUB R0,R4 ; Make pointer relative to start of buf. .PUTBB R3,R4 ; Save pointer. INC R3 ; ; That's all, folks! ; 499$: INC CURWRD ; Number of words done. DEC WRDLIM ; Max # of words left to do. BEQ 500$ ; Done? JMP 100$ ; No. Next word. 500$: JMP 101$ ; Yes. ; ; ISSEP - Check if a character is a separator. ; ; In: R2 - Character. ; ; Out: Carry set means character was a separator. ; ISSEP:: MOV R0,-(SP) ; Save registers. MOV R1,-(SP) MOV #SEPTBL,R0 ; Point at separator table. MOVB (R0)+,R1 ; Get length of table. 10$: CMPB R2,(R0)+ ; Separator match? BEQ 20$ ; Yes. SOB R1,10$ ; No. Check next. CLC ; No match found. BR 30$ 20$: SEC ; Match found. 30$: MOV (SP)+,R1 ; Restore registers. MOV (SP)+,R0 RETURN ; ; ZSCII - Convert a character to ZSCII character(s). ; ; In: R2 - Character. ; R5 - Buffer where to placed converted character(s). ; ; Out: R5 updated. ; ZSCII: MOV R0,-(SP) ; Save registers. MOV R1,-(SP) MOV ASCPTR,R0 ; Get ASCII table. MOV #26.,R1 ; We have 26 possible chars to look at. 10$: CMPB R2,(R0)+ ; Match? BEQ 30$ ; Yes. Done. SOB R1,10$ ; No. Try next. MOVB #5,(R5)+ ; If we didn't find it, try table 2. MOV #26.,R1 ADD R1,R0 20$: CMPB R2,(R0)+ ; Match? BEQ 30$ ; Yes. SOB R1,20$ ; No. Try next. MOVB #6,(R5)+ ; No match found. Indicate ASCII coming. MOV R2,-(SP) ; Put it in as ascii. ASH #-5,R2 ; First three high bits. BIC #^C7,R2 MOVB R2,(R5)+ MOV (SP)+,R1 ; And then five low bits. BIC #^C37,R1 BR 35$ 30$: NEG R1 ADD #32.,R1 35$: MOVB R1,(R5)+ MOV (SP)+,R1 MOV (SP)+,R0 RETURN ; ; FNDWRD - Find a word in the dictionary. ; ; In: ZWORD - The ZSCII word. ; WRDTAB - Pointer to the dictionary. ; WRDCNT - Number of words in dictionary. ; WRDLEN - Length of one word in dictionary. ; ; Out: R2 - Address of dictionary entry, or 0 if not found. ; ; If WRDCNT is a negative value, we need to search through to ; dictionary in a linear fashion. ; FNDWRD: MOV R0,-(SP) ; Save registers... MOV R1,-(SP) MOV R3,-(SP) MOV R4,-(SP) MOV R5,-(SP) CLR R0 ; First entry. MOV WRDCNT,R1 ; Last entry. BPL 10$ ; If positive, we have a sorted dict. ; ; Dictionary is unsorted. We'll have to run trough it linear. ; NEG R1 ; Actual dictionary length. 1$: MOV R0,R3 ; Point at entry to check. MUL WRDLEN,R3 ADD WRDTAB,R3 MOV ZWLEN,R2 ; Number of bytes to compare. ASR R2 ; Make that words. MOV #ZWORD,R4 ; Word to compare against. 2$: .GETWB R3,R5 ; Read word. ADD #2,R3 ; Next byte. CMP (R4)+,R5 ; Compare. BNE 3$ ; Not equal. Search on. SOB R2,2$ ; Repeat. SUB ZWLEN,R3 ; Found. R3 now points past word in MOV R3,R2 ; dictionary, so back up. BR 200$ ; Done. 3$: INC R0 ; Not correct entry. SOB R1,1$ ; Try again. BR 100$ ; We fail. ; ; Sorted dictionary. We can use a binary search through it... ; 10$: MOV R1,R3 ; Let R3 be in the middle of R0,R1 SUB R0,R3 ASR R3 ADD R0,R3 MUL WRDLEN,R3 ; Now make R3 into a proper address. ADD WRDTAB,R3 MOV ZWLEN,R2 ; R2 is word length. MOV #ZWORD,R4 ; And R4 points at "our" word. 20$: .GETBB R3,R5 ; Try to match words... INC R3 CMPB (R4)+,R5 BHI 30$ ; If higher, then we should search upper BLO 40$ ; If lower, we should search low SOB R2,20$ ; Match means we continue to check. SUB ZWLEN,R3 ; We found a match. R3 holds address MOV R3,R2 ; past word in dictionary entry. BR 200$ ; R2 is now correct. ; ; Search upper half. Move lower limit to just checked entry. ; 30$: MOV R1,R2 SUB R0,R2 ASR R2 BEQ 100$ ADD R2,R0 BR 10$ ; ; Search lower half. Move upper limit to just checked entry. ; 40$: MOV R1,R2 SUB R0,R2 ASR R2 BEQ 100$ SUB R2,R1 BR 10$ ; ; Finished... ; 100$: CLR R2 200$: .ENABL LSB .DBG #D.PARS,<"Parse word results in %D.">,R2 MOV (SP)+,R5 MOV (SP)+,R4 MOV (SP)+,R3 MOV (SP)+,R1 MOV (SP)+,R0 RETURN .DSABL LSB ; .END .TITLE ZSCREEN .IDENT /V1.35/ ; ++ ; This is the Z-machine screen handling. ; (c) 2000, 2003 by Johnny Billquist ; ; History: ; ; 00-08-01 BQT Initial coding started. ; Y1.0 00-08-26 21:00 BQT First release. ; Y1.1 00-08-29 14:30 BQT Modified more processing. ; Y1.2 00-09-01 05:00 BQT Beyond Zork have a bug, that in atleast one ; room, print table is used to print one too ; many lines. Since that last list is also ; at the bottom of screen 1, a workaround ; has been implemented whereby print_table ; aren't allowed to print at the bottom ; line of a screen. ; Y1.3 00-09-07 15:30 BQT Added screen modified information. ; Y1.4 00-09-11 19:15 BQT Bugfix in SCRSTS. The score was not correcly ; detecting what game type it was. ; V1.5 00-09-16 12:00 BQT Changed ZEXIT to ABORT. Added a flag to tell ; that the screen has been initiated. ; Made version officially done. ; V1.6 00-09-17 20:00 BQT Found the actual bug I worked around in Y1.2. ; print_table strings can hold control characters, ; which we should replace with spaces! ; V1.7 00-09-22 01:00 BQT Added a check for zero length buffer in FLUSH. ; Added zero timeout for more prompt. ; V1.8 00-09-24 01:30 BQT Added handling of narrow screens in SCRSTS. ; V1.9 00-10-10 01:40 BQT Bugfix in set window. In V3, the cursor position ; should always move to top left if screen 1 is ; selected. Also, the clear screen function didn't ; clear the bottom line if screen 1 was selected. ; V1.10 00-10-12 02:30 BQT When we change window, the text attributes ; appearantly should be cleared. ; V1.11 00-11-07 14:00 BQT Moved SETCOL from ZIO. ; Added color capabilities. ; V1.12 00-12-05 15:30 BQT Bugfix. We need to flush the buffer when we ; change screen. ; V1.13 00-12-29 04:00 BQT Bugfix. When doing a more prompt, we should ; reset the SCRPTR variable, in case ABORT ; is called. ; V1.14 01-01-04 23:00 BQT Bugfix. The scripting function should ; only script when screen 0 is selected. ; V1.15 01-02-26 12:30 BQT Added print_unicode and check_unicode. ; V1.16 01-03-04 03:30 BQT Changed set_font to always allow font 3 if ; VT200 or better. ; V1.17 01-03-04 04:30 BQT Changed more-handling. It now triggers ; at the newline instead of just getting ; to the last line. This allows us to ; get a prompt on the last line without ; a more prompt. ; Changed set_font again. We now let flg2 ; reflect wether we have font 3 or not. ; V1.18 01-03-06 01:00 BQT Bugfix to V1.17 newline handling. ; V1.19 03-01-25 19:00 BQT Bugfix. Wrapping and full-screen DELLIN ; didn't handle if we were at start of ; buffer. ; V1.20 03-01-27 15:00 BQT Added handling of backspace wrap. ; V1.21 03-08-17 11:30 BQT Bugfix in more handling. If we only had one ; line in buffer, MORE garbled. ; V1.22 05-02-21 17:00 BQT Modified code for better reading. ; V1.23 05-02-23 16:00 BQT Started adding new V6 functions. ; V1.24 05-03-07 14:00 BQT Changed screen handling to be much more ; efficient. ; V1.25 05-05-03 22:00 BQT Added SCRZAP ; V1.26 05-05-24 16:00 BQT Added SCRECH for terminal output without space ; gobble. ; V1.27 05-07-25 16:00 BQT Changed move_cursor to not have boundary checks. ; ZOKOBAN is buggy, and we'll allow it. ; V1.28 05-10-25 01:00 BQT Added new Latin-1 <-> ZSCII conversion. ; V1.29 07-11-06 20:30 BQT Bugfix in DELLN2, where we didn't check for ; # of del chr = 0. ; Removed scrolling when split screen. ; V1.30 07-11-11 19:00 BQT Added scrolling on split screen again. ; However, only of text should move down. ; V1.31 07-11-21 18:30 BQT Added check that LF don't get inserted ; if bottom of anything but screen 0. ; V1.32 08-02-26 22:30 BQT Bugfix. Output stream 3 takes a table ; argument in V3 and V4 games as well. ; V1.33 09-04-16 20:30 BQT Bugfix. split_window should not change active ; window. ; V1.34 09-05-13 14:30 BQT Bugfix. In V6, set_cursor can have only one ; argument, and that is valid. ; V1.35 09-05-14 16:00 BQT Bugfix. window_margin was buggy. ; Also did small improvements in output code. ; -- .INCLUDE /ZMAC/ .ASECT ; ; Screen information block. ; .=0 SI: W.WY: .BLKW 1 ; Window Y position W.WX: .BLKW 1 ; Window X position W.YS: .BLKW 1 ; Window Y size W.XS: .BLKW 1 ; Window X size W.CY:: .BLKW 1 ; Cursor Y position W.CX:: .BLKW 1 ; Cursor X position W.LM: .BLKW 1 ; Window left margin W.RM: .BLKW 1 ; Window right margin W.NLI: .BLKW 1 ; Window newline interrupt routine W.NLC: .BLKW 1 ; Window newline interrupt count W.STY: .BLKW 1 ; Window text style W.FCOL: .BLKB 1 ; Window foreground color data W.BCOL: .BLKB 1 ; Window foreground color data W.FONT: .BLKW 1 ; Font number W.FS: .BLKW 1 ; Font size W.ATTR: .BLKW 1 ; Attribute W.LC: .BLKW 1 ; Line count PROC: .BLKW 1 ; Pointer to processing routine at scr. FLAGS: .BLKW 1 ; Local flags. SILEN: WA.WRP=1 ; Style wrap WA.SCR=2 ; Style scroll WA.ST2=4 ; Style to stream 2 WA.BUF=10 ; Style buffering MOD=1 ; Screen is modified. NOMOR=2 ; Perform more processing. SPCGOB=4 ; Gobble spaces. ; .PSECT DATA,D,RW ; ; The screen. ; =========== ; ; The screen is described with a coordinate system with origo at the top left, ; which is (1,1). ; ; SCRBOT is the bottom line on screen. ; SCRWID is the total width of the screen. ; SCRTOP is the top line usable on the screen. In V3 this is 2, otherwise 1. ; SCRLEN is the length usable on the screen. ; SCRTYP is the terminal type. ; SCRBOT: .WORD 0 ; Screen bottom line. SCRWID: .WORD 0 ; Screen width. SCRTOP: .WORD 0 ; Top of screen line. SCRLEN: .WORD 0 ; Length of screen. SCRTYP:: .WORD 0 ; Screen type. ; ; Now some tricky information. We keep both the wanted and actual ; positions around. Whenever we do something that actually modifies ; the screen, we first check if the wanted and actual match, otherwise ; we update the screen and actual values to the wanted. ; A.CY: .WORD 0 ; Actual cursor Y A.CX: .WORD 0 ; Actual cursor X A.RT: .WORD 0 ; Actual region top A.RB: .WORD 0 ; Actual region bottom A.FONT: .WORD 1 ; Actual font A.ATTR: .WORD 0 ; Actual attributes A.FCOL: .WORD 1 ; Actual foreground color A.BCOL: .WORD 1 ; Actual background color ; R.CY: .WORD 0 ; Requested cursor Y R.CX: .WORD 0 ; Requested cursor X R.RT: .WORD 0 ; Requested region top R.RB: .WORD 0 ; Requested region bottom R.FONT: .WORD 1 ; Requested font R.ATTR: .WORD 0 ; Requested attributes R.FCOL: .WORD 1 ; Requested foreground color R.BCOL: .WORD 1 ; Requested background color ; MWINPT: .WORD 1 ; Mouse window ; SCR0: .BLKB SILEN ; Screen 0 info. (lower) SCR1: .BLKB SILEN ; Screen 1 info. (upper) SCR2: .BLKB SILEN SCR3: .BLKB SILEN SCR4: .BLKB SILEN SCR5: .BLKB SILEN SCR6: .BLKB SILEN SCR7: .BLKB SILEN ; OSTFLG: .BYTE 0,1,0,0,0,0 ; Output stream flags. ; ACTSCR:: .WORD 0 ; Current active screen. INIDON: .WORD 0 ; Flag that INIT is done. ; CBUF: .BLKB 400 ; Buffer for temporary control strings. ; ; Some buffers. ; Note that these buffers double up for various duties, which do not ; overlap. However, IOBUF and IOBUF2 must be 1000(8) bytes each. ; .BYTE 0,10. ; Fake a newline before scrbuf... IOBUF:: ; Buffer for save/restore. SCRBUF:: .BLKB 1000 ; Output buffer for screen. SCREND: ; Address of end of screen buffer. ESCBF:: ; Input ESC handling buffer. IOBUF2:: ; Buffer for save. .BLKB 1000 DELBUF: ; Where to place deleted chars at wrap. ; SCRPTR:: .WORD SCRBUF ; Pointer into screen buffer. ; ST3BUF: .WORD 0 ; Buffer pointer for stream 3. ST3PTR: .WORD 0 ; Current pointer for stream 3. ; BUFFLG: .WORD 0 ; Flag for internal buffer write. BUFPTR: .WORD 0 ; Pointer to internal buffer. ; TFLG: .WORD 0 ; Pointer to transcript flag. ; .PSECT CONST,D,RO ; .MACRO TFUN TYP FINI=0 .WORD TYP'INI FRES=2 .WORD TYP'RES FCS=4 .WORD TYP'CS FCL=6 .WORD TYP'CL FCUR=10 .WORD TYP'CUR FSPL=12 .WORD TYP'SPL FATR=14 .WORD TYP'ATR FSTS=16 .WORD TYP'STS FFS=20 .WORD TYP'FS FCOL=22 .WORD TYP'COL FIND=24 .WORD TYP'IND FSCR=26 .WORD TYP'SCR FEND=30 .ENDM TFUN ; FUNTAB: .WORD UNKFUN .WORD ANSFUN .WORD V52FUN .WORD V10FUN .WORD V12FUN .WORD V20FUN .WORD V30FUN .WORD V40FUN .WORD V50FUN ; UNKFUN: TFUN UNK V52FUN: TFUN V52 ANSFUN: TFUN ANS V10FUN: TFUN V10 V12FUN: TFUN V12 V20FUN: TFUN V20 V30FUN: TFUN V30 V40FUN: TFUN V40 V50FUN: TFUN V50 ; ; Table of more prompts for different terminals. ; This table holds two entries, each consist of one length ; and one pointer field, for each terminal type. ; See ZMAC for different terminal types. ; MORTAB: .WORD UM1L,UM1,UM2L,UM2 ; Unknown .WORD AM1L,AM1,AM2L,AM2 ; ANSI .WORD UM1L,UM1,UM2L,UM2 ; VT52 .WORD VTM1L,VTM1,VTM2L,VTM2 ; VT100 .WORD VTM1L,VTM1,VTM2L,VTM2 ; VT102 .WORD VTM1L,VTM1,VTM2L,VTM2 ; VT200 .WORD VTM1L,VTM1,VTM2L,VTM2 ; VT300 .WORD VTM1L,VTM1,VTM2L,VTM2 ; VT400 .WORD VTM1L,VTM1,VTM2L,VTM2 ; VT500 ; ; The color tables... ; FCTAB: .WORD 39.,30.,31.,32.,33.,34.,35.,36.,37. BCTAB: .WORD 49.,40.,41.,42.,43.,44.,45.,46.,47. ; .PSECT TEXT,D,RO ; ; Unknown... ; UM1: .ASCIZ /[More]/ UM1L=.-UM1-1 UM2: .ASCIZ <15>/ /<15> UM2L=.-UM2-1 ; ; ANSI ; AM1: .ASCIZ /[More]/ AM1L=.-AM1-1 AM2: .ASCIZ <15><33>/[K/ AM2L=.-AM2-1 ; ; VT-series. ; VTM1: .ASCIZ <33>/7/<33>/[0;7m[More]/ VTM1L=.-VTM1-1 VTM2: .ASCIZ <33>/8/<33>/[K/ VTM2L=.-VTM2-1 ; TMBUF: .ASCIZ /Time: / SCOTXT: .ASCIZ /Score: / MOVTXT: .ASCIZ /Moves: / ; ; Sequence to initialize VT100. ; . Turn off wrapping. ; . Clear whole screen. ; . Set application keypad. ; V20INT: .ASCII <33>/)w/ ; Set 94 char user font "w" as G1. V10INT: .ASCIZ <33>/[?7l/<33>/[2J/<33>/=/<33>/[r/ V52INT: .ASCIZ <33>/H/<33>/J/ ; ; Sequence to reset VT100. ; . Clear scrolling region. ; . Set numeric keypad. ; . Turn off all attributes. ; V10RET: .ASCIZ <33>/[m/<33>/[J/<33>/[r/<33>/>/ ; ; Clear screen texts: ; V52CST: .ASCIZ <33>/H/<33>/J/ ; ; Clear line texts: ; V52CLT: .ASCIZ <33>/K/ V10CLT: .ASCIZ <33>/[K/ ; ; Status line strings. ; V52STT: .ASCIZ <33>/Y / V10STT: .ASCIZ <33>/7/<33>/[H/<33>/[0;7m/ V11STT: .ASCIZ <33>/8/ ; .PSECT DATA,D,RW ; PFTAB: PFINI: .WORD 0 PFRES: .WORD 0 PFCS: .WORD 0 PFCL: .WORD 0 PFCUR: .WORD 0 PFSPL: .WORD 0 PFATR: .WORD 0 PFSTS: .WORD 0 PFFS: .WORD 0 PFCOL: .WORD 0 PFIND: .WORD 0 PFSCR: .WORD 0 .IIF NE .-PFTAB-FEND .ERROR ; Function table missing data. ; .PSECT CODE,I,RO ; ; Initiate screen handling. ; .ENABL LSB SCRINI:: ; ; First thing is to find out some screen information. ; CALL GETSLN ; Get screen length. MOV R0,SCRBOT ; Save bottom position. MOV R0,A.RB ; Save region bottom. MOV R0,R.RB CALL GETSCL ; Get screen width. CMP R0,#20. ; < 20? BHIS 1$ ; No. MOV #80.,R0 ; Yes. Set it to 80. 1$: MOV R0,SCRWID CALL GETSTP ; Get screen type. MOV R0,SCRTYP ; MOV #1,SCRTOP ; Default top line is 1. CMP ZVER,#3 ; Version 3? BNE 2$ ; No. INC SCRTOP ; Yes. Top line is 2. 2$: MOV SCRBOT,SCRLEN ; Length is bottom... SUB SCRTOP,SCRLEN ; -top... INC SCRLEN ; +1. ; MOV SCRTYP,R0 ; Get screen type. ASL R0 ; *2 MOV FUNTAB(R0),R0 ; Get pointer to correct function tbl. MOV #PFTAB,R1 ; Where to put functions. MOV #FEND/2,R2 ; # of words to copy. 4$: MOV (R0)+,(R1)+ ; Copy correct function table. SOB R2,4$ ; ; Screen initialization. ; MOV #SCR7+SILEN,R0 ; Setup screens. MOV #10,R1 ; A total of 8 screens... 40$: SUB #SILEN,R0 ; Do next (previous) screen. CALL SCRSET SOB R1,40$ ; And repeat. ; ; At this point, R0 points to screen 0, which we will setup ; with more specific data, since it originally will hold the ; whole physical screen. ; MOV R0,ACTSCR ; Initial screen selected. ; MOV SCRTOP,W.WY(R0) ; Top of screen. MOV SCRLEN,W.YS(R0) ; Size. MOV W.YS(R0),W.LC(R0) ; Get line count. MOV SCRWID,W.XS(R0) ; Width. BIS #WA.SCR!WA.ST2,W.ATTR(R0) ; Set attributes. ; CMP ZVER,#6 ; BEQ 41$ BIS #WA.WRP,W.ATTR(R0) ; Other than v6 defaults to wrap. 41$: CMP ZVER,#4 ; In V1-V4 the cursor start at bottom. BHI 42$ MOV W.YS(R0),W.CY(R0) ; Cursor at bottom. 42$: ADD #SILEN,R0 ; Setup screen 1. MOV SCRWID,W.XS(R0) ; Width. ; ; We need to do more: ; Clear screen. ; Place cursor. ; Setup pointers. ; MOV #CBUF,R1 MOV ACTSCR,R3 CALL @PFINI ; Do terminal init. CLRB (R1) MOV #CBUF,R0 SUB R0,R1 CALL PUTTXT ; Output init string. ; MOV #1,A.RT ; We know that the scroll region have MOV #1,R.RT ; been reset... CALL SCRSPL ; Split screen. CALL SCRCUR ; Move cursor. CALL SCRCOL ; Set color. CALL SCRFS ; Select font. CALL SCRATR ; Set attributes. MOV #1,INIDON ; Mark that init is done. ; ; Setup screen related game variables. ; This function is also called after restore, which means ; it can deal with screen resize stuff between save and restore. ; SCRVAR:: .PUTBB #40,SCRBOT ; Save lines. (20h) .PUTBB #41,SCRWID ; Save columns. (21h) CMP ZVER,#5 ; V3... 20$: BIS #224,R0 ; Bold and timed input available. CALL GETAVO BCC 21$ BIS #10,R0 ; Italic. 21$: CALL GETCOL BCC 22$ BIS #1,R0 ; Color. 22$: BIC #42,R0 ; no picture, no sound BIC #660,R1 ; No mouse, sound, menus. CMP ZVER,#5 ; If V5, we might have pictures. BNE 221$ ; Not. V5. No pictures. CALL GETSOF BCS 23$ 221$: BIC #10,R1 ; No pictures. 23$: 30$: MOV R0,ZFLG1 ; Set flags 1. MOV R1,ZFLG2 ; RETURN .DSABL LSB ; ; SCRSET - Setup screen ; ; In: R0 - Screen base pointer. ; SCRSET: CALL $SAVAL ; Set default screen values... MOV #1,W.WY(R0) ; Orgin is (1,1) MOV #1,W.WX(R0) CLR W.YS(R0) ; Size is (0,0) CLR W.XS(R0) MOV #1,W.CY(R0) ; Cursor is at (1,1) MOV #1,W.CX(R0) CLR W.LM(R0) ; Margins is 0 CLR W.RM(R0) CLR W.NLI(R0) ; No interrupt stuff. CLR W.NLC(R0) CLR W.STY(R0) ; Style is 0. MOV #401,W.FCOL(R0) ; Colors are 1/1 (101h) MOV #1,W.FONT(R0) ; Font is #1. MOV #401,W.FS(R0) ; Font size is 1/1 (101h) MOV #WA.BUF,W.ATTR(R0) ; All windows are buffered. CLR W.LC(R0) ; Line count starts at 0. MOV #NORM,PROC(R0) ; Normal processing. CLR FLAGS(R0) RETURN ; ; Init screen for unknown. ; For all INIT functions, the following holds true: ; R0 - Free to use. ; R1 - Points at buffer where to place data to reset screen. ; R2 - Free to use. ; R3 - Pointer to active screen. ; ; At the end, R1 should point past the init string to be printed. ; UNKINI: MOV ZFLG1,R0 ; Get flags. CMP ZVER,#3 ; V1-V3? BHI 10$ ; No. BIC #6,R0 ; Yes. No status line. No split screen. BR 20$ 10$: BIC #34,R0 ; No bold, italc, fixed space. 20$: MOV R0,ZFLG1 .PUTBB #1,R0 MOV #1,A.CY MOV #1,A.CX RETURN ; V52INI: MOV ZFLG1,R0 ; Get flags. CMP ZVER,#3 ; V1-V3? BHI 10$ ; No. BIC #6,R0 ; Yes. No status line. No split screen. BR 20$ 10$: BIC #34,R0 ; No bold, italic, fixed space. 20$: MOV R0,ZFLG1 .PUTBB #1,R0 MOV #1,A.CY MOV #1,A.CX MOV #V52INT,R0 ; VT52 init string. ; ; CPYSTR - Copy a string. ; ; In: R0 -> NUL-terminated source string. ; R1 -> Destination ; ; Out: R1 -> NUL-char in destination. ; ; R0 destroyed. ; CPYSTR: MOVB (R0)+,(R1)+ ; Copy byte. BNE CPYSTR ; until NUL. DEC R1 ; Backup before NUL. RETURN ; Done. ; ANSINI: .MSG <"ANSI screen support not done yet."> JMP ABORT ; ; V20INI: V30INI: V40INI: V50INI: MOV #V20INT,R0 MOV #1,A.CY MOV #1,A.CX CALLR CPYSTR V10INI: V12INI: MOV #V10INT,R0 MOV #1,A.CY MOV #1,A.CX CALLR CPYSTR ; ; SCRRES - Reset screen. ; ; This function is called at game end. ; SCRRES:: TST INIDON ; Have we done init? BNE 10$ ; Yes. RETURN ; No. 10$: CALL FLUSH MOV #CBUF,R1 ; Buffer for string. MOV ACTSCR,R3 ; active screen in R3. CALL @PFRES ; Reset screen. ; MOVB #12,(R1)+ ; And output an LF. CLRB (R1) MOV #CBUF,R0 SUB R0,R1 CALLR PUTTXT ; ; Reset handlers. ; UNKRES: V52RES: RETURN ; ANSRES: .MSG <"Ansi screen handler not done yet."> RETURN ; V10RES: V12RES: V20RES: V30RES: V40RES: V50RES: MOV #V10RET,R0 CALL CPYSTR MOV #1,A.CY MOV #1,A.CX CALLR DOCUR ; Move cursor back. ; ; Screen ZAP. ; This will cause ZEMU to setup the terminal anew. ; (Useful if attributes and stuff have been lost. ; This function is probably something you'd call ; upon the user pressing a certain key or so.) ; SCRZAP:: MOV R0,-(SP) MOV #-1,R0 MOV R0,A.CY ; Actual cursor Y MOV R0,A.CX ; Actual cursor X MOV R0,A.RT ; Actual region top MOV R0,A.RB ; Actual region bottom MOV R0,A.FONT ; Actual font MOV R0,A.ATTR ; Actual attributes MOV R0,A.FCOL ; Actual foreground color MOV R0,A.BCOL ; Actual background color MOV (SP)+,R0 RETURN ; ; Clear screen. ; SCRCS: MOV #CBUF,R1 ; Buffer for string. MOV ACTSCR,R3 ; Active screen. CALL DOCOL ; Set color. CALL @PFCS ; Perform screen clear. CLRB (R1) MOV #CBUF,R0 CALLR SCRTXT ; Print through control output. ; UNKCS: MOVB #14,(R1)+ ; FF for unknown. RETURN ; V52CS: MOV #1,A.CX ; Actual cursor position now. MOV #1,A.CY MOV #V52CST,R0 ; String to clear screen. CALLR CPYSTR ; ANSCS: V10CS: V12CS: V20CS: V30CS: V40CS: V50CS: MOV W.WY(R3),R0 ; Get top line. ADD W.YS(R3),R0 ; Add size. CMPB R0,SCRBOT ; Does screen go to bottom? BGE 10$ ; Yes. MOVB #33,(R1)+ ; No. We assume it goes to top then. MOVB #'[,(R1)+ ; So we go to bottom. MOV R0,A.CY CALL NUMSTR MOVB #';,(R1)+ MOVB #'1,(R1)+ MOVB #'H,(R1)+ MOVB #33,(R1)+ ; Clear from top to current. MOVB #'[,(R1)+ MOVB #'1,(R1)+ BR 20$ ; 10$: MOVB #33,(R1)+ ; Move to top of screen. MOVB #'[,(R1)+ MOV W.WY(R3),R0 MOV R0,A.CY CALL NUMSTR MOVB #';,(R1)+ MOVB #'1,(R1)+ MOVB #'H,(R1)+ MOVB #33,(R1)+ ; Yes. Easy to clear that one. MOVB #'[,(R1)+ 20$: MOVB #'J,(R1)+ MOV #1,A.CX ; Reflect true cursor position. RETURN ; ; Scroll screen (for resize) ; ; In: R2 - # of lines to scroll ; ; Negative lines means downwards. (R2 is delta of size of window 0) ; SCRSCR: TST R2 ; Any change? BNE 10$ ; Yes. RETURN ; No. Done. 10$: CALL $SAVAL MOV ACTSCR,R3 ; Get active screen. CALL SCRSPL ; Perform screen split. CALL SCRCOL ; Set colors. MOV A.CY,R.CY ; Make sure cursor don't move. MOV A.CX,R.CX ; (because we don't know where yet) MOV #CBUF,R1 ; Buffer for string. CALL DOCUR ; Move cursor and scroll region. CALL DOCOL ; Setup color. CALL @PFSCR ; Perform screen scroll CLRB (R1) MOV #CBUF,R0 CALLR SCRTXT ; Print through control output. ; UNKSCR: V52SCR: RETURN ; Cannot do. ; ANSSCR: V10SCR: V12SCR: V20SCR: V30SCR: V40SCR: V50SCR: MOVB #33,(R1)+ ; Scrolling down. Move cursor... MOVB #'[,(R1)+ MOV W.WY(R3),R0 TST R2 ; Up or down? BPL 100$ ; Up... MOV R0,A.CY ; Down. Cursor should be at top. MOV #1,A.CX CALL NUMSTR MOVB #'H,(R1)+ NEG R2 10$: MOVB #33,(R1)+ ; Inser correct number of RI. MOVB #'M,(R1)+ SOB R2,10$ RETURN ; Done. 100$: ADD W.YS(R3),R0 ; Cursor should be at bottom... DEC R0 MOV R0,A.CY ; Save cursor pos. MOV #1,A.CX CALL NUMSTR ; And move... MOVB #'H,(R1)+ 110$: MOVB #12,(R1)+ ; Then insert correct number of LF. SOB R2,110$ RETURN ; ; Clear line. ; SCRCL: MOV #CBUF,R1 ; String buffer. MOV ACTSCR,R3 ; Active screen. CALL DOCUR ; Move cursor. CALL DOCOL CALL @PFCL ; Call correct function. CLRB (R1) MOV #CBUF,R0 CALLR SCRTXT ; Print through control function. ; UNKCL: RETURN ; Q: Can we do this? ; V52CL: MOV #V52CLT,R0 CALLR CPYSTR ; ANSCL: V10CL: V12CL: V20CL: V30CL: V40CL: V50CL: MOV #V10CLT,R0 CALLR CPYSTR ; ; Move cursor to correction position for active screen. ; SCRCUR:: MOV R3,-(SP) ; Save R3 MOV ACTSCR,R3 ; Get active screen. MOV W.WY(R3),R.CY ; Get new cursor Y. ADD W.CY(R3),R.CY DEC R.CY MOV W.WX(R3),R.CX ; Get new cursor X. ADD W.CX(R3),R.CX DEC R.CX BIC #SPCGOB,FLAGS(R3) ; Don't gobble any more spaces. MOV (SP)+,R3 RETURN ; No. So we do nothing. ; ; Normal character processing. ; Update the cursor depending on character, and possibly insert char. ; ; This will also mean moving the cursor, and setting attributes, if ; neccesary. ; ; In: R0 - Character ; R1 -> Buffer ; R3 -> Active screen ; ; Out: Carry set - Cursor at right margin. No character effect. ; Carry clear - all ok. ; ; R1 updated. ; NORM: JSR R5,$SAVRG ; Save R3-R5 CMPB R0,#' ; Control character? BLO 10$ ; Yes. MOV W.XS(R3),R4 ; No. Find right margin of window. SUB W.RM(R3),R4 CMP R.CX,R4 ; Have we passed right margin? BLOS 1$ ; No. SEC ; Yes. Error return. RETURN 1$: MOV R0,-(SP) CALL DOCUR ; Move cursor. CALL DOATR ; Set text attributes. CALL DOFS ; Select font. CALL DOCOL ; Select color. MOV (SP)+,R0 MOVB R0,(R1)+ ; Save character. INC A.CX ; Bump cursor address. INC R.CX INC W.CX(R3) BIS #MOD,FLAGS(R3) CLC ; Success. RETURN ; Done. 10$: CMPB R0,#13. ; CR? BEQ 113$ CMPB R0,#8. ; BS? BEQ 108$ SEC ; All else is not handled. RETURN 108$: MOV W.LM(R3),R4 ; Get left margin. INC R4 CMP W.CX(R3),R4 ; At BS we check for left margin. BLOS 1081$ DEC R.CX ; And if not, the requested pos change. DEC W.CX(R3) CLC RETURN 1081$: DEC W.CY(R3) ; We were at left margin... DEC R.CY ; Move up one line. MOV W.XS(R3),W.CX(R3) ; Set cursor at right margin. SUB W.RM(R3),W.CX(R3) MOV W.WX(R3),R.CX ADD W.CX(R3),R.CX DEC R.CX RETURN 113$: MOV W.LM(R3),W.CX(R3) ; At CR we move to left margin. INC W.CX(R3) MOV W.WX(R3),R.CX ; Requested X pos is window left pos. ADD W.LM(R3),R.CX ; plus margin. RETURN ; ; Move cursor and flush output. ; MCUR:: CALL $SAVAL MOV SCRPTR,R1 MOV ACTSCR,R3 CALL DOCUR MOV R1,SCRPTR CALLR FLUSH ; ; Do actual cursor movement. ; ; In: R1 -> Buffer ; R3 -> Active screen ; DOCUR:: JSR R5,$SAVRG ; Save R3-R5 ; CMP R.RT,A.RT ; Start with the screen splitting. BNE 10$ ; Changed... CMP R.RB,A.RB BNE 10$ ; Changed... BR 20$ ; No change. 10$: MOV R.RT,A.RT ; Do screen splitting. MOV R.RB,A.RB CMP R.RT,R.RB ; Same line? BGE 20$ ; Yes. Do nothing. CALL @PFSPL ; 20$: CMP A.CY,R.CY ; Are we on same line? BNE 100$ ; No. Let's do the full monty for now. ; ; New cursor position is on same line. ; Let's see if we can do some smart stuff. ; MOV R.CX,R5 ; Get requested X MOV A.CX,R4 ; Get actual X CMP R5,R4 ; Get X backup delta BNE 30$ ; No change? RETURN ; They were equal. Nothing to do. 30$: CMP R5,#1 ; Left margin? BNE 40$ ; No. MOVB #13.,(R1)+ ; Yes. This is easy... :-) MOV R5,A.CX ; Save new position. RETURN 40$: SUB R4,R5 ; Get X delta. CMP R4,SCRWID ; On screen edge right now? BLOS 50$ ; No. DEC A.CX ; Yes. Move cursor inside. INC R5 ; Backing up. Do one less. BNE 50$ RETURN ; Yes. Do nothing. 50$: INC R5 ; Do we backup one char? BEQ 60$ ; Yes. INC R5 ; Backup 2 chars? BNE 70$ ; No. MOVB #8.,(R1)+ ; Back two chars. 60$: MOVB #8.,(R1)+ ; Back one char. MOV R.CX,A.CX RETURN 70$: CALLR @PFIND ; Do indentation. ; 100$: MOV R.CY,A.CY ; Save new position MOV R.CX,A.CX CALLR @PFCUR ; Do full cursor movement. ; ; Functions to perform actual cursor placement... ; UNKIND: UNKCUR: RETURN ; Q: Can we do this? ; V52IND: V52CUR: MOVB #33,(R1)+ ; VT52: ESC Y line col MOVB #'Y,(R1)+ ; line and col are binary, with MOV R.CY,R0 ; Get current cursor Y. MOV R0,A.CY ADD #37,R0 ; Adjust for 1-bias coordinate, and ; make into code. MOVB R0,(R1)+ MOV R.CX,R0 ; Get current cursor X. MOV R0,A.CX ADD #37,R0 ; Adjust for 1-bias coordinate, and ; make into code. MOVB R0,(R1)+ RETURN ; ANSCUR: V10CUR: V12CUR: V20CUR: V30CUR: V40CUR: V50CUR: MOVB #33,(R1)+ ; ANSI: CSI line ; col H MOVB #'[,(R1)+ ; line and column are in ascii. MOV R.CY,R0 ; Get line. MOV R0,A.CY CALL NUMSTR MOVB #';,(R1)+ MOV R.CX,R0 ; Get column. MOV R0,A.CX CALL NUMSTR MOVB #'H,(R1)+ RETURN ; ; Indent functions. ; ANSIND: V10IND: V12IND: V20IND: V30IND: V40IND: V50IND: MOVB #'C,-(SP) MOV R.CX,R0 SUB A.CX,R0 BPL 10$ NEG R0 INC (SP) 10$: MOVB #33,(R1)+ MOVB #'[,(R1)+ CALL NUMSTR MOVB (SP)+,(R1)+ MOV R.CX,A.CX RETURN ; ; Split screen. Set scrolling region to current screen. ; SCRSPL: MOV R3,-(SP) MOV ACTSCR,R3 CMP R3,#SCR0 ; Only for screen 0. BNE 10$ MOV W.WY(R3),R.RT MOV R.RT,R.RB ADD W.YS(R3),R.RB DEC R.RB 10$: MOV (SP)+,R3 RETURN ; UNKSPL: V52SPL: RETURN ; Q: Can we do this? ; ANSSPL: V10SPL: V12SPL: V20SPL: V30SPL: V40SPL: V50SPL: MOVB #33,(R1)+ ; ANSI: CSI top ; bottom r MOVB #'[,(R1)+ ; where top and botttom are in MOV R.RT,R0 CALL NUMSTR MOVB #';,(R1)+ MOV R.RB,R0 CALL NUMSTR MOVB #'r,(R1)+ MOV #1,A.CY ; This function have now moved MOV #1,A.CX ; the cursor. RETURN ; ; Set attributes according to current screen. ; SCRATR: MOV R3,-(SP) MOV ACTSCR,R3 MOV W.STY(R3),R.ATTR MOV (SP)+,R3 RETURN ; ; A trick here is that OLDATR will hold the current attributes ; when the terminal dependant code is called, and thus one ; can check and do only the change stuff. ; DOATR: CMP R.ATTR,A.ATTR ; Change? BNE 10$ RETURN ; No. 10$: CALL @PFATR ; Yes. Perform. MOV R.ATTR,A.ATTR ; Save new. RETURN ; UNKATR: V52ATR: RETURN ; Q: We can't do this. ; ANSATR: V10ATR: V12ATR: V20ATR: V30ATR: V40ATR: V50ATR: MOVB #33,(R1)+ ; Start with CSI. MOVB #'[,(R1)+ MOV A.ATTR,R0 ; Get current attribs. BIC R.ATTR,R0 ; Have any been removed? BEQ 5$ ; No. MOVB #'0,(R1)+ ; Yes. Then start by clearing. MOVB #';,(R1)+ MOV R.ATTR,R0 ; And get what should be set. MOV #1,A.BCOL ; This resets colors... MOV #1,A.FCOL MOV #DOCOL,-(SP) ; We should append colors at the end. BR 6$ 5$: MOV R.ATTR,R0 ; No attrib was removed. See which was BIC A.ATTR,R0 ; added... 6$: BIT #1,R0 ; Reverse video? BEQ 10$ ; No. MOVB #'7,(R1)+ MOVB #';,(R1)+ ; Yes. 10$: BIT #2,R0 ; Bold? BEQ 20$ ; No. MOVB #'1,(R1)+ MOVB #';,(R1)+ ; Yes. 20$: BIT #4,R0 ; Italic? BEQ 30$ ; No. MOVB #'4,(R1)+ ; (use underline) MOVB #';,(R1)+ ; Yes. 30$: CMPB -(R1),#'; ; Do we have anything? BNE 40$ ; No. MOVB #'m,(R1)+ ; Done. RETURN ; (We also have 10; fixed pitch) 40$: DEC R1 ; Nothing to print. Back one more. RETURN ; ; Show status line. ; This function is only used in V1-V3 games... ; SCRSTS:: CMP SCRWID,#40. ; Check screen width. BHIS 10$ ; We don't like too narrow stuff. RETURN 10$: MOV #CBUF,R1 ; Buffer. MOV ACTSCR,R3 ; Active screen. CALL @PFSTS ; Call function. MOV R1,-(SP) ; Find out position for eol. ADD SCRWID,(SP) MOV (SP),-(SP) ; Find out position for last field. SUB #12.,(SP) MOV (SP),-(SP) ; Find out position for first field. SUB #12.,(SP) MOVB #' ,(R1)+ ; Start with a space. MOV #1,BUFFLG ; Set flag for printing to buffer. MOV R1,BUFPTR ; Save pointer. MOV #20,R0 ; Get 1:st global variable value. CALL VARVAL MOV R1,R0 ; Move value into R0. CALL OBJTXT ; Insert the object text. CMP ZVER,#3 ; V3 game? BLT SCRGAM ; No. Then it's a score game. BIT #2,ZFLG1 ; Bit set for time game? BEQ SCRGAM ; No. Score game. TST (SP)+ ; Time game. Drop first field pos. CALL FILL ; Fill to last field. MOV #TMBUF,R0 ; String to insert here. CALL CPTXT MOV #21,R0 ; Get value of second global. CALL VARVAL MOV R1,R0 ; Value in R0, and pointer in R1. CMP R0,#10. ; If value is less than 10, we'd BHIS 30$ ; like to have a preceding '0', MOVB #'0,@BUFPTR ; since hours look better that way. INC BUFPTR 30$: CALL NUMTXT MOVB #':,@BUFPTR ; Separate hours from minutes. INC BUFPTR MOV #22,R0 ; But minutes live in the third global. CALL VARVAL MOV R1,R0 CMP R0,#10. BHIS 40$ MOVB #'0,@BUFPTR INC BUFPTR 40$: CALL NUMTXT BR EOS ; Round things off. ; SCRGAM: CALL FILL ; Fill out to first pos. MOV #SCOTXT,R0 ; Score game. Score text. CALL CPTXT MOV #21,R0 ; which is located in second global. CALL VARVAL MOV R1,R0 CALL NUMTXT CALL FILL ; Fill out to last field. MOV #MOVTXT,R0 ; Move text. CALL CPTXT MOV #22,R0 ; which is located in third global. CALL VARVAL MOV R1,R0 CALL NUMTXT EOS: CALL FILL ; Fill to end of line. MOV BUFPTR,R1 CALL @(SP)+ ; Call back to screen dependant stuff. CLRB (R1) ; Done. CLR BUFFLG MOV #CBUF,R0 SUB R0,R1 CALLR PUTTXT ; Print directly. ; CPTXT: MOV BUFPTR,R1 CALL CPYSTR MOV R1,BUFPTR RETURN ; FILL: CMP BUFPTR,2(SP) ; Check if we already passed pos. BLO 10$ ; No... MOV 2(SP),BUFPTR ; Yes. Backup. SUB #4,BUFPTR MOVB #'.,@BUFPTR INC BUFPTR MOVB #'.,@BUFPTR INC BUFPTR MOVB #'.,@BUFPTR INC BUFPTR 10$: MOVB #' ,@BUFPTR ; Fill buffer until position, INC BUFPTR CMP BUFPTR,2(SP) ; which is given at 2(SP). BNE FILL MOV (SP)+,(SP) ; Remove position from stack. RETURN ; UNKSTS: ADD #2,SP ; Reject. RETURN ; V52STS: MOV #V52STT,R0 CALL CPYSTR CALL @(SP)+ MOV #1,A.CY MOV SCRWID,A.CX RETURN ; ANSSTS: V10STS: V12STS: V20STS: V30STS: V40STS: V50STS: MOV #V10STT,R0 CALL CPYSTR CALL @(SP)+ ; Callback. MOV #V11STT,R0 CALLR CPYSTR ; ; Font selection for screen. ; SCRFS: MOV R3,-(SP) MOV ACTSCR,R3 ; Active screen. MOV W.FONT(R3),R.FONT MOV (SP)+,R3 RETURN ; DOFS: CMP R.FONT,A.FONT BNE 10$ RETURN 10$: MOV R.FONT,A.FONT CALLR @PFFS ; Call function. ; UNKFS: V52FS: ANSFS: V10FS: V12FS: RETURN ; None of these can do fonts. ; V20FS: V30FS: V40FS: V50FS: CMP R.FONT,#3 ; Char font? BEQ 10$ ; Yes. MOVB #15.,(R1)+ ; G1 to GL. RETURN 10$: MOVB #14.,(R1)+ ; G2 to GL. RETURN ; ; SCRCOL - Set screen color. ; SCRCOL: MOV R3,-(SP) MOV ACTSCR,R3 ; Active screen. MOVB W.FCOL(R3),R.FCOL MOVB W.BCOL(R3),R.BCOL MOV (SP)+,R3 RETURN ; DOCOL: CMPB R.FCOL,A.FCOL BNE 10$ CMPB R.BCOL,A.BCOL BNE 10$ RETURN 10$: MOV R.FCOL,A.FCOL MOV R.BCOL,A.BCOL CALLR @PFCOL ; Call function. ; UNKCOL: V52COL: RETURN ; ANSCOL: V10COL: V12COL: V20COL: V30COL: V40COL: V50COL: MOVB #33,(R1)+ MOVB #'[,(R1)+ MOVB R.FCOL,R0 DEC R0 ASL R0 MOV FCTAB(R0),R0 CALL NUMSTR MOVB #';,(R1)+ MOVB R.BCOL,R0 DEC R0 ASL R0 MOV BCTAB(R0),R0 CALL NUMSTR MOVB #'m,(R1)+ RETURN ; ; NUMSTR - Make number to a string. ; ; In: R0 - Number. ; R1 - Pointer to buffer. ; NUMSTR: MOV R2,-(SP) MOV #30$,-(SP) MOV R1,R2 10$: MOV R0,R1 BNE 20$ RETURN 20$: CLR R0 DIV #10.,R0 ADD #'0,R1 MOVB R1,-(SP) CALL 10$ MOVB (SP)+,(R2)+ RETURN 30$: CLRB (R2) MOV R2,R1 MOV (SP)+,R2 RETURN ; ; RESLIN - Reset the screen line count. ; RESLIN:: MOV R3,-(SP) MOV ACTSCR,R3 MOV W.YS(R3),W.LC(R3) ; Setup line count as size. MOV (SP)+,R3 CALLR MCUR ; Move cursor and flush. ; ; EXT:12 C 5/* check_unicode char-number -> (result) ; .ENABL LSB CUNICD:: .INSTR "check_unicode",#1 MOV (R2),R1 ; Get character. CLR R0 ; Default answer. CMP R1,#400 BHIS 10$ MOV #3,R0 ; Latin-1 character. All is possible. 10$: CALLR RESULT ; ; EXT:11 B 5/* print_unicode char-number ; .ENABL LSB PUNICD:: .INSTR "print_unicode",#1 MOV (R2),R1 ; Get character. CMP R1,#400 BLO PUTLCHR ; Normal Latin-1. MOVB #'?,R1 ; Unknown char. BR PUTLCHR .DSABL LSB ; ; PUTCHR - Output a ZSCII character to currently selected streams. ; ; In: R1 - ZSCII Character. ; ; R1 destroyed. ; PUTCHR:: TST BUFFLG ; Are we writing internally? ; (This is just used by the V3 status ; line) BEQ 10$ ; No. CALLR PUTLCHR ; Yes. Write to internal only. ; ; No ZEMU-internall stuff going on. Let's do what any sane interpreter would... ; 10$: TSTB OSTFLG+3 ; Stream 3 on? BEQ 20$ ; No. CALLR PUTLCHR ; Yes. Only write to stream 3. ; ; Stream 3 not active. The others can be working in parallell. ; 20$: CALL CZ2L ; Convert. ; Fall through... ; ; PUTLCHR - Output a Latin-1 character to currently selected streams. ; ; In: R1 - Latin-1 character. ; PUTLCHR: JSR R2,$SAVVR 10$: TST BUFFLG ; Are we writing internally? ; (This is just used by the V3 status ; line) BEQ 20$ ; No. ; ; Print to internal buffer. ; ; In: R1 - character. ; CMPB R1,#10. ; LF? BEQ 11$ ; Yes. MOVB R1,@BUFPTR ; No. Save char. INC BUFPTR ; Bump pointer. 11$: RETURN ; ; No ZEMU-internall stuff going on. Let's do what any sane interpreter would... ; 20$: TSTB OSTFLG+3 ; Stream 3 on? BEQ 30$ ; No. ; ; Write to stream 3. ; .PUTBB ST3PTR,R1 ; Write byte. INC ST3PTR ; Increment pointer. RETURN ; Done. ; ; Stream 3 not active. The others can be working in parallell. ; 30$: CMP ACTSCR,#SCR0 ; At screen 0? BNE 40$ ; If not, skip check for transcipt. CALL PRNCHR ; Perform possible transcript. 40$: TSTB OSTFLG+1 ; Stream 1 active? BEQ 50$ ; No. CALL SCRCHR ; Yes. Output character. 50$: RETURN ; Done. ; ; RESMOD - Reset screen modified flag. ; RESMOD:: MOV R3,-(SP) MOV ACTSCR,R3 BIC #MOD,FLAGS(R3) MOV (SP)+,R3 RETURN ; ; ISMOD - Check if screen has been modified. ; ; Out: CS - Screen has been modified. ; ISMOD:: MOV R0,-(SP) MOV ACTSCR,R0 BIT #MOD,FLAGS(R0) BEQ 10$ SEC BR 20$ 10$: CLC 20$: MOV (SP)+,R0 RETURN ; ; SCRCHR - Write a character to the currently selected screen. ; ; In: R1 - Character. ; SCRCHR:: CALL $SAVAL MOV R1,R0 MOV SCRPTR,R1 ; Get pointer to buffer. MOV ACTSCR,R3 ; Get active screen. CALL SCRCH2 ; Insert character. MOV R1,SCRPTR ; Save new pointer. RETURN ; ; SCRECH - Write a character to the currently selected screen. ; Special version for output where we don't want any space gobbling. ; ; In: R1 - Character. ; SCRECH:: CALL $SAVAL MOV R1,R0 MOV SCRPTR,R1 ; Get pointer to buffer. MOV ACTSCR,R3 ; Get active screen. MOV W.ATTR(R3),-(SP) ; Save current attributes. MOV #WA.WRP,W.ATTR(R3) ; Set style to only wrap, no buffer... CALL SCRCH2 ; Insert character. MOV R1,SCRPTR ; Save new pointer. MOV (SP)+,W.ATTR(R3) ; Restore attributes. RETURN ; ; Put the character in buffer. ; R0 - Character ; R1 -> Buffer ; R3 - Active screen ; ; R1 is updated. R3 is preserved. ; R0 is destroyed. ; SCRCH2: CMP R1,#SCREND ; Are we at end of buffer? BLO 10$ ; No. ; ; We have filled the buffer. We need to flush it. ; MOV R0,-(SP) ; Save character. CALL DELLN1 ; Do only up to last newline. SUB R0,R1 ; Get length. CALL PUTTXT ; Flush buffer. MOV R0,R1 ; Now let R1 point to start of buf. CALL @(SP)+ ; And restore line. MOV (SP)+,R0 ; Restore character. ; ; Time to insert a new character in the buffer. At this point we know ; that we have room for the character. ; 10$: CMPB R0,#' ; Space? BNE 11$ ; No. BIT #SPCGOB,FLAGS(R3) ; Should we gobble them? BEQ 11$ ; No. RETURN ; Yes. So we do nothing. 11$: BIC #SPCGOB,FLAGS(R3) ; No more gobbling... CALL @PROC(R3) ; Processing of character. BCS 20$ ; Processing went bad. Let's figure ; out why... RETURN ; All went fine. We're done. 20$: CMPB R0,#' ; Was it a printing char? BLO CTRL ; No. Special characters... ; ; Processing of printing char failed. It must have been a full line. ; We can then do one of two things... ; BIT #WA.WRP,W.ATTR(R3) ; Wrapping on? BNE 30$ ; Yes. RETURN ; No wrapping. Drop it. ; 30$: BIT #WA.BUF,W.ATTR(R3) ; Buffering? BNE 40$ ; Yes. ; ; Wrapping, but no buffering. Insert a newline, and then char. ; 35$: MOVB R0,-(SP) ; Save char. MOVB #13.,R0 ; CR CALL SCRCH2 MOVB #10.,R0 ; LF CALL SCRCH2 MOVB (SP)+,R0 ; And char again. CALLR SCRCH2 ; ; New line, and buffering. Back up and play. ; 40$: MOVB R0,(R1)+ ; Insert char. CLR R0 ; Char counter. MOV #DELBUF,R2 ; Point at delete buffer. 41$: CMP R1,#SCRBUF ; Beginning of buffer. BNE 42$ ; No. ADD R0,R1 ; Yes. Restore regs. MOVB -(R1),R0 ; Get char back. BR 35$ ; No helping it. Act as no buffering. 42$: INC R0 ; Count chars. MOVB -(R1),-(R2) ; Copy out char. CMPB (R1),#' ; Space? BNE 41$ ; No. Continue. DEC R0 ; One less char. INC R2 ; Skip space. MOV R0,-(SP) ; Save count. MOV R2,-(SP) ; Save delete pointer. ; ; This is tricky. We have now actually removed inserted characters. ; This means our calculated X position is wrong. ; We have a very hard time to figure out the correct value as well, ; since we don't know which of the backed/up characters actually ; were printing chars. ; The simple solution for now is to force in a CR, set position to 1, ; and then do the normal CR. If we actually do want to end up at the ; left edge, we're already done. Otherwise, we'll indent to the right ; position now. ; MOV #13.,R0 ; Output newline. MOVB R0,(R1)+ MOV #1,A.CX CALL SCRCH2 ; Tricky. We inserted CR, and now we MOV #10.,R0 ; requested LF... CALL SCRCH2 TST 2(SP) ; Delete count... BNE 44$ ; Something in there? BIS #SPCGOB,FLAGS(R3) ; Nothing deleted. We might have ; more spaces coming. Gobble them... ADD #4,SP RETURN 44$: MOVB @(SP),R0 ; Get deleted char. INC (SP) CALL SCRCH2 ; Insert again. DEC 2(SP) BNE 44$ ; Repeat for all chars. ADD #4,SP RETURN ; Done. ; ; Special characters... ; CTRL: CMPB R0,#10. ; LF? BEQ 110$ CMPB R0,#33 ; ESC? BEQ 133$ MOVB R0,(R1)+ ; We just insert unknowns. RETURN ; Nothing to care about... ; ; Handle esc. ; 133$: MOVB R0,(R1)+ ; Insert ESC. MOV #ESCH,PROC(R3) ; Continuation routine. RETURN ; Done. ; ; Handle LF. ; 110$: CMP R3,#SCR0 ; Screen 0? BNE 11010$ ; No. Don't... CMP W.LC(R3),#-999. ; Should we process "more"? BEQ 11010$ ; No. BIT #NOMOR,FLAGS(R3) BNE 11010$ CMP W.YS(R3),#3 BLOS 11010$ ; ; We have more processing. Let's count lines. ; DEC W.LC(R3) ; Count lines. BGT 11010$ ; Not a full screen. Done. ; ; We're about to print a full screen. Lets so some more processing... ; First we must remove the last line we have printed, since we are ; about to print a more-prompt instead. ; CALL DELLN2 ; Delete to previous newline. ; ; We now have deleted the last line... ; The next thing is to flush the current buffer. ; MOV R0,SCRPTR SUB R0,R1 ; Calculate length. CALL PUTTXT ; Print it. ; ; We have a full screen. Let's do some "more" stuff... ; MOV R3,-(SP) MOV R4,-(SP) MOV SCRTYP,R4 ASH #3,R4 ADD #MORTAB,R4 ; Now R4 points at more prompt table. MOV (R4)+,R1 ; Get first prompt string. MOV (R4)+,R0 CALL PUTTXT ; Output it. CLR R3 ; No timeout. MOV A.CX,-(SP) MOV R.CX,A.CX CALL GETCH2 ; Get a character. MOV (SP)+,A.CX MOV (R4)+,R1 ; Second prompt string. MOV (R4)+,R0 CALL PUTTXT ; Output it. MOV (SP)+,R4 ; Restore registers. MOV (SP)+,R3 MOV W.YS(R3),W.LC(R3) ; Reset line count to number of lines SUB #2,W.LC(R3) ; and setup for overlap... ; ; We now have to retrieve that last line we deleted... ; MOV #SCRBUF,R1 ; Point at start of buffer. CALL @(SP)+ ; Insert characters back. ; 11010$: TST W.NLC(R3) ; Do we have interrupt line count? BEQ NEWLIN ; No. DEC W.NLC(R3) ; Yes. Decrement it. BNE NEWLIN ; Until done. ; ; %%% The interrupt line count is still untested... ; MOV #1,W.CX(R3) ; Setup X pos MOV R1,-(SP) MOV R3,-(SP) MOV #ARGS,R2 ; Point at argument buffer. MOV W.NLI(R3),(R2) ; Save address. MOV #1,R3 ; One argument. MOV #R.LIN,-(R5) ; Resturn handler. CALL DOCALL ; Perform call. JMP FETCH ; And start executing. ; ; A plain, normal linefeed. ; NEWLIN: CALL DOCUR ; Update cursor position. CALL DOCOL ; Update colors. This is important ; here, since a scroll means a new line ; appears, which should have the right ; background color. MOVB #10.,(R1)+ ; Insert linefeed. CMP W.CY(R3),W.YS(R3) ; At bottom of window? BEQ 10$ ; Yes. INC W.CY(R3) ; No. Update pos. INC R.CY INC A.CY RETURN ; Done. 10$: CMP R3,#SCR0 ; Bottom of screen. Screen 0? BEQ 20$ ; Yes. DEC R1 ; No. If so, we don't allow LFs ; at the bottom. Leave cursor in place. 20$: RETURN ; Done. ; ; Interrupt return entry point for newline interrupts. ; LININT:: TST (SP)+ ; Drop return to fetch. MOV (SP)+,R3 ; Restore registers. MOV (SP)+,R1 BR NEWLIN ; And continue. ; ESCH: MOVB R0,(R1)+ ; Save char. CMPB R0,#'[ ; CSI? BEQ 1$ ; Yes. MOV #NORM,PROC(R3) ; Nothing special. Go back to normal. CLC RETURN 1$: MOV #CSI,PROC(R3) ; Do CSI processing. CLC RETURN ; CSI: MOVB R0,(R1)+ ; Save char. CMPB R0,#100 ; Alpha? BLT 10$ ; No. MOV #NORM,PROC(R3) ; Yes. Go back to normal processing. 10$: CLC RETURN ; ; The DELLNx routines are called as co-routines two times. ; The first call should have R1 pointing past the buffer to ; do the delete in. ; At the first return, the last line will be deleted from the buffer. ; R1 will point past the buffer, which will be NUL-terminated. ; R0 will point at SCRBUF ; ; At the second call, R1 should point at where the previously deleted ; line should be placed (SCRBUF). ; At return, the co-routine have exited with the registers as follows: ; R1 points past the screen buffer (as given by R1 in). ; ; R0 and R2 are destroyed by these routines. ; ; DELLN1 - Delete a buffer up to the last newline. ; Leave that previous newline in the buffer. Call back as ; a co-routine that allow some processing to be done, ; and finally reinsert all deleted characters. ; ; In: R1 - Buffer to delete in. ; ; R0 is destroyed. R1 is updated. ; ; If no newline was found, delete nothing. ; DELLN1: SUB #6,SP ; Make room on stack. MOV 6(SP),(SP) ; Move down return address. CLR R2 ; Clear count. MOV #SCRBUF,R0 ; Point at head. 10$: CMP R1,R0 ; Start of buffer? BEQ 20$ INC R2 ; Count chars. CMPB -(R1),#10. ; LF? BNE 10$ ; No. Keep looking. INC R1 ; LF found. Move over it. DEC R2 ; Count one less. BNE 30$ ; Something was deleted... 20$: ADD R2,R1 ; Nothing deleted. Simplify! CLRB (R1) ; Mark end. CALL @(SP)+ ; Call back. BR 40$ ; Done. 30$: MOVB (R1),2(SP) ; Save first char. MOV R2,4(SP) ; Save count. MOV R1,6(SP) ; Save pointer. CLRB (R1) ; Mark end. CALL @(SP)+ ; Call back. MOV 6(SP),R0 ; Get pointer to buffer. MOVB 2(SP),(R0) ; Restore first char. MOV 4(SP),R2 ; Length. BEQ 40$ ; No length. 35$: MOVB (R0)+,(R1)+ ; Copy... SOB R2,35$ 40$: MOV (SP),6(SP) ; Move up return. ADD #6,SP RETURN ; Done. ; ; DELLN2 - Delete a buffer up to the last newline. ; Leave that previous newline in the buffer. Call back as ; a co-routine that allow some processing to be done, ; and finally reinsert all deleted characters. ; ; In: R1 - Buffer to delete in. ; ; R0 is destroyed. R1 is updated. ; ; If no newline was found, delete to start of buffer. ; DELLN2: SUB #6,SP MOV 6(SP),(SP) ; Make space on stack. CLR R2 ; Counter... MOV #SCRBUF,R0 10$: CMP R1,R0 ; Start of buffer? BEQ 15$ ; Yes. INC R2 ; No. Count... CMPB -(R1),#10. ; LF? BNE 10$ ; No. Loop. INC R1 ; Yes. Include LF. DEC R2 BNE 15$ ; Deleted something... CLRB (R1) ; Deleted nothing. Mark end. CALL @(SP)+ ; Callback. BR 40$ ; Done. 15$: MOVB (R1),2(SP) ; Save deleted char. MOV R2,4(SP) ; Save count. MOV R1,6(SP) ; Save pointer. CLRB (R1) ; Mark end of string. CALL @(SP)+ ; Callback. MOV 6(SP),R0 ; Point at delete buffer. MOVB 2(SP),(R0) ; Restore deleted char. MOV 4(SP),R2 ; Counter. BEQ 40$ ; Nothing to restore. 20$: MOVB (R0)+,(R1)+ ; Copy string. SOB R2,20$ 40$: MOV (SP),6(SP) ; Clear stack. ADD #6,SP RETURN ; ; SCRTXT - Output a screen text. ; This routine does not take streams into consideration, but instead ; always does the printing to the screen. ; ; In: R0 - Pointer to text. NUL terminated. ; SCRTXT:: MOV R0,-(SP) MOV R1,-(SP) 10$: MOVB (R0)+,R1 BEQ 20$ BPL 15$ BIC #^C177,R1 MOVB ZSCII(R1),R1 15$: CALL SCRECH BR 10$ 20$: MOV (SP)+,R1 MOV (SP)+,R0 RETURN ; ; FLUSH - Flush the buffer. ; FLUSH:: MOV R0,-(SP) ; Save registers. MOV R1,-(SP) MOV #SCRBUF,R0 ; Point at buffer start. MOV SCRPTR,R1 ; Point at current position. CLRB (R1) ; Set end marker. SUB R0,R1 ; Get length. BEQ 10$ ; Nothing in there... MOV R0,SCRPTR ; Reset current position. CALL PUTTXT ; Really write buffer out. 10$: MOV (SP)+,R1 ; Restore registers. MOV (SP)+,R0 RETURN ; ; VAR:237 D 4 erase_window window ; ; -1 means whole screen, and collapse window 1. ; 0,1 are the two windows. ; In V6 we have 8 windows... ; .ENABL LSB ERWIN:: .INSTR "erase_window",#1 CMP (R2),#-1 ; Special ops... BEQ 100$ ; Yes. MOV ACTSCR,-(SP) ; No. Save current window... MOV (R2),R0 ; Get window to erase. CALL GWIN ; Get pointer to structure. MOV #1,W.CY(R3) ; Reset line on that window. CMP ZVER,#5 ; In V1-V4, window 0 moves cursor BHIS 20$ ; to bottom instead... TST R0 BNE 20$ MOV W.YS(R3),W.CY(R3) 20$: MOV #1,W.CX(R3) ; Column is always 1. MOV W.YS(R3),W.LC(R3) ; Clear line count. MOV R3,ACTSCR ; Save active screen for SCRCS. CALL SCRCS MOV (SP)+,ACTSCR ; Restore active screen. CALLR SCRCUR ; ; erase_window -1 have special meaning... ; 100$: MOV #SCR0,R0 ; Screen 0. MOV #SCR1,R1 ; Screen 1. MOV SCRTOP,W.WY(R0) ; Window 0 top at "top". MOV SCRLEN,W.YS(R0) ; Get new length. CLR W.YS(R1) ; Collapse screen 1. MOV #1,W.CY(R0) ; Move cursor to top of window. CMP ZVER,#5 BHIS 110$ MOV W.YS(R0),W.CY(R0) ; JMP BADFUN ; 1$: MOV (R2)+,R0 ; Find out which stream, and func. BMI 10$ ; Turn off... TSTB OSTFLG(R0) ; Already on? BEQ 9$ ; No. .MSG <"Turning on stream %D, already on.">,R0 9$: MOVB #1,OSTFLG(R0) ; Turn on. CMP R0,#3 ; #3? BNE 2$ ; No. MOV (R2),ST3BUF ; Yes. Save pointers. MOV (R2),ST3PTR ADD #2,ST3PTR RETURN 2$: CMP R0,#2 ; Transcript? BNE 3$ ; No. BISB #1,@TFLG ; Yes. Set flag. 3$: RETURN ; 10$: NEG R0 ; Get stream number. TSTB OSTFLG(R0) ; Already off? BNE 19$ .MSG <"Turning off stream %D, already off.">,R0 19$: CLRB OSTFLG(R0) ; Turn off stream. CMP R0,#3 ; #3? BNE 20$ ; No. MOV ST3PTR,R1 ; Yes. Find out how much written, SUB ST3BUF,R1 ; and store that at start of buffer. SUB #2,R1 .PUTWB ST3BUF,R1 .PUTWB #60,R1 ; (30h) RETURN 20$: CMP R0,#2 ; Transcripting? BNE 21$ ; No. BICB #1,@TFLG ; Yes. Turn off. 21$: RETURN .DSABL LSB ; ; EXT:4 4 5 set_font font -> (result) ; .ENABL LSB SETFNT:: .INSTR "set_font",#1 CMP (R2),#1 ; Selecting font 1 is always good... BEQ 10$ BIT #10,ZFLG2 ; Font 3 available? BEQ 20$ ; No. CMP (R2),#3 ; Yes. Did we ask for font 3? BEQ 10$ ; Yes. We can do that... 20$: CLR R0 ; Can't do requested font... CALLR RESULT 10$: MOV ACTSCR,R0 ; Get active screen. MOV W.FONT(R0),-(SP) ; Save old font. MOV (R2),W.FONT(R0) ; Set new font. CALL SCRFS ; Output control for this. MOV (SP)+,R0 ; Get old font again. CALLR RESULT ; And answer. .DSABL LSB ; ; VAR:234 A 3 split_window lines ; Screen 1 will have the size specified as argument. ; .ENABL LSB SPLITW:: .INSTR "split_window",#1 MOV (R2),R2 ; Get split line. MOV #SCR0,R0 ; Get both screens. MOV #SCR1,R1 ; MOV R0,ACTSCR ; We shouldn't do this...? ; ; Start by setting up window 1. ; MOV W.YS(R1),-(SP) ; Save old size. MOV SCRTOP,W.WY(R1) ; Setup w1 pos. MOV #1,W.WX(R1) MOV R2,W.YS(R1) ; Setup w1 size MOV SCRWID,W.XS(R1) MOV R2,W.LC(R1) ; Line count MOV #1,W.CY(R1) ; Cursor pos. MOV #1,W.CX(R1) BIS #NOMOR,FLAGS(R1) CLR W.STY(R1) ; ; Window 1 done. ; ; Next we fiddle with window 0. ; This is trickier. If W0 is moving down because W1 grew, we might ; consider scrolling the screen down as well. But no more than what ; it takes to move the cursor to the bottom line. ; SUB (SP)+,R2 ; Get size change. MOV W.WY(R0),-(SP) ; Save new Y pos. ADD R2,(SP) MOV W.YS(R0),-(SP) ; Save new Y size. SUB R2,(SP) TST R2 ; Was window enlarged? BMI 2$ ; Yes. SUB R2,W.LC(R0) ; No. Adjust current line count. CMP W.CY(R0),(SP) ; Is cursor outside of window now? BLOS 1$ ; No. SUB W.CY(R0),R2 ; Yes. Adjust size adjustment. ADD (SP),R2 MOV (SP),W.CY(R0) ; Set cursor Y to last line. ; ; Now we have adjusted cursor because of shrunk window. ; R2 is now the amount to scroll down. ; 1$: NEG R2 CALL SCRSCR ; Scroll. BR 3$ ; ; W0 was grown. We just adjust the cursor position. ; 2$: SUB R2,W.CY(R0) ; New relative cursor. ; ; Done with the size and position stuff. ; Do final play. ; 3$: MOV (SP)+,W.YS(R0) ; Set new size. MOV (SP)+,W.WY(R0) CLR W.STY(R0) ; Reset style. CALL SCRSPL ; Split screen. CALL SCRATR ; Set text attributes. CALL SCRCOL ; Set color. CALL SCRFS ; Select font. CMP ZVER,#3 ; V3 game? BNE 10$ ; No. MOV #SCR1,ACTSCR ; Yes. Screen 1? CALL SCRCS ; Yes. Clear screen. MOV #SCR0,ACTSCR 10$: CALLR SCRCUR ; Move cursor. .DSABL LSB ; ; VAR:235 B 3 set_window window ; .ENABL LSB SETW:: .INSTR "set_window",#1 MOV (R2),R0 ; Get window number. CALL GWIN ; Get window structure. CMP R3,#SCR1 ; Screen 1? BNE 10$ ; No. CMP ZVER,#6 ; Yes. Is this V6? BEQ 10$ ; No. MOV #1,W.CY(R3) ; Yes. Reset position. MOV #1,W.CX(R3) SETW2: 10$: MOV R3,ACTSCR ; Save new screen. ; CLR W.STY(R3) ; Clear attributes. CALL SCRATR ; Set attributes. CALL SCRFS ; Select font. CALL SCRCOL ; Set color. CALL SCRSPL ; Set region. CALLR SCRCUR ; Move cursor. ; MOV SCRPTR,R1 ; CALL DOCUR ; Actually place cursor. ; MOV R1,SCRPTR ; CALLR FLUSH ; And flush this. .DSABL LSB ; ; VAR:243 13 3 output_stream number ; VAR:243 13 5 output_stream number table ; ; *** Note. The Z-spec is wrong here. ; In version 3 & 4, output_stream to stream #3 ; also takes a table argument (how could it work ; otherwise?) ; .ENABL LSB OUTSTR:: OUTST2:: .INSTR "output_stream" 10$: MOV (R2)+,R0 ; Find out which stream, and func. BMI 100$ ; Turn off... TSTB OSTFLG(R0) ; Already on? BEQ 20$ ; No. .MSG <"Turning on stream %D, already on.">,R0 20$: MOVB #1,OSTFLG(R0) ; Turn on. ; CMP ZVER,#3 ; ,R0 110$: CLRB OSTFLG(R0) ; Turn off stream. ; CMP ZVER,#3 ; Text ; ; New line... ; 10$: MOV ACTSCR,R0 INC W.CY(R0) ; Bump line. MOV (SP),W.CX(R0) ; Resore column. CALL SCRCUR ; Move cursor. 20$: MOV 2(SP),-(SP) ; Get column count. 30$: CALL ATRAN INC R3 BNE 31$ INC R2 31$: MOVB (R0),R1 ; Get character. BPL 35$ ; Positive is good. BIC #^C177,R1 MOVB ZSCII(R1),R1 ; Get actual character. 35$: CMPB R1,#32. ; Is it a control char? BHIS 36$ ; No. MOVB #' ,R1 ; Yes. Replace with space. 36$: CALL SCRCHR ; Output it. DEC (SP) ; Loop. BNE 30$ ADD #2,SP ; Drop loop counter. ADD 6(SP),R3 ; Skip... ADC R2 DEC 4(SP) ; Next line. BNE 10$ ADD #10,SP ; Drop stack. RETURN ; Done. .DSABL LSB ; ; 2OP:27 1B 5 set_colour foreground background ; 2OP:27 1B 6 set_colour foreground background window ; .ENABL LSB SETCOL:: .INSTR <"set_color"> CMP R3,#3 ; 3 args? BEQ 1$ MOV #-3,4(R2) ; No. Default window. CMP R3,#2 ; 2 args? BEQ 1$ JMP BADFUN ; No. Baaaaaad. 1$: MOV 4(R2),R0 CALL GWIN ; Get window structure. MOV (R2)+,R1 ; Get foreground color. BEQ 10$ ; No change. CMP R1,#2 BGE 5$ MOV #1,R1 ; Use default. 5$: MOVB R1,W.FCOL(R3) 10$: MOV (R2)+,R1 BEQ 20$ CMP R1,#2 BGE 15$ MOV #1,R1 15$: MOVB R1,W.BCOL(R3) 20$: CALLR SCRCOL .DSABL LSB ; ; EXT:23 17 6 mouse_window window ; .ENABL LSB MOUWIN:: .INSTR "mouse_window",#1 MOV (R2),MWINPT ; Save mouse window. RETURN ; ; Get requested window. ; In: R0 - window number. ; ; Out: R3 -> window structure. ; GWIN: CMP R0,#-3 ; -3 means current window. BNE 10$ MOV ACTSCR,R3 RETURN 10$: MOV #SILEN,R3 MUL R0,R3 ADD #SCR0,R3 RETURN ; ; EXT:8 8 6 set_margins left right window ; .ENABL LSB WINMAR:: .INSTR <"set_margins"> MOV 4(R2),R0 ; Get window. CMP R3,#3 ; 3 args? BEQ 10$ ; Yes. MOV #-3,R0 ; No. Default window. CMP R3,#2 BEQ 10$ ; 2 args? JMP BADFUN ; No. Baaaad. 10$: CALL GWIN MOV (R2)+,W.LM(R3) MOV (R2),W.RM(R3) CMP W.CX(R3),W.LM(R3) ; Outside margins? BLOS 20$ ; Yes. CMP W.CX(R3),W.RM(R3) BHIS 20$ ; Yes. RETURN ; No. Done. 20$: MOV W.LM(R3),W.CX(R3) ; Outside margins. Move to left margin. INC W.CX(R3) CALLR SCRCUR ; And move actual cursor. ; ; EXT:16 10 6 move_window window y x ; .ENABL LSB WINMOV:: .INSTR "move_window",#3 MOV (R2)+,R0 ; Get window number. CALL GWIN ; Point at structure. MOV (R2)+,W.WY(R3) ; Set window coordinates. MOV (R2),W.WX(R3) CALLR SCRCUR ; Move cursor, since window moved. ; ; EXT:17 11 6 window_size window y x ; .ENABL LSB WINSIZ:: .INSTR "window_size",#3 MOV (R2)+,R0 CALL GWIN MOV (R2)+,W.YS(R3) MOV (R2),W.XS(R3) MOV W.YS(R3),W.LC(R3) RETURN ; ; EXT:18 12 6 window_style window flags operation ; .ENABL LSB WINSTY:: .INSTR "window_style",#3 MOV (R2)+,R0 CALL GWIN MOV (R2)+,R1 DEC R1 BLT 10$ BEQ 20$ DEC R1 BEQ 30$ MOV (R2),R2 XOR R2,W.ATTR(R3) RETURN 10$: MOV (R2),W.ATTR(R3) RETURN 20$: BIS (R2),W.ATTR(R3) RETURN 30$: BIC (R2),W.ATTR(R3) RETURN ; ; EXT:19 13 6 get_wind_prop window property-number -> (result) ; .ENABL LSB GWINPR:: .INSTR "get_wind_prop",#2 MOV (R2)+,R0 CALL GWIN MOV (R2),R2 ASL R2 ADD R2,R3 ; Hey, on a VAX we would have MOV (R3),R0 ; MOVW (R3)[R2],R0 CALLR RESULT ; ; EXT:25 19 6 put_wind_prop window property-number value ; .ENABL LSB PWINPR:: .INSTR "put_wind_prop",#3 MOV (R2)+,R0 CALL GWIN MOV (R2)+,R1 ASL R1 ADD R1,R3 MOV (R2),(R3) RETURN ; ; EXT:20 14 6 scroll_window window pixels ; SCROLL:: .INSTR "scroll_window",#2 MOV ACTSCR,-(SP) ; Save active screen. MOV (R2)+,R0 ; Get window #. CALL GWIN ; Point to structure. CALL SETW2 ; Select window. MOV (R2),R2 ; Get scroll amount. CALL SCRSCR ; Perform scroll. MOV (SP)+,R3 ; Get old active screen. CALLR SETW2 ; Restore it. ; .END .TITLE ZTEXT .IDENT /V1.3/ ; ++ ; This is the Z-machine routines for text packing/unpacking. ; (c) 2000 by Johnny Billquist ; ; History: ; ; 00-07-19 BQT Initial coding started. ; Y1.0 00-08-26 21:00 BQT First release. ; V1.1 00-11-07 16:00 BQT Code is working. ; V1.2 05-08-01 16:00 BQT Small optimization done. ; V1.3 05-10-25 01:00 BQT Added ZSCII conversion functions, and ; uppercase of ZSCII table. ; -- .INCLUDE /ZMAC/ ; .PSECT DATA,D,RW ; DECCHR::.WORD 0 ; The correct decode pointer. DECPTR::.WORD 0 ; The current decode pointer. ASCPTR::.WORD ASCV1 ; The correct ASCII table. ; CTAB: .WORD 0 ; Current table. OTAB: .WORD 0 ; Old table. STATE: .WORD 0 ; State of translation. ; .PSECT TEXT,D,RO ; ; The ASCII tables for different versions... ; ASCV1:: .ASCII /abcdefghijklmnopqrstuvwxyz/ .ASCII /ABCDEFGHIJKLMNOPQRSTUVWXYZ/ .ASCII / 0123456789.,!?_#'"/<57>/\<-:()/ ASCV2:: .ASCII /abcdefghijklmnopqrstuvwxyz/ .ASCII /ABCDEFGHIJKLMNOPQRSTUVWXYZ/ .ASCII / 0123456789.,!?_#'"/<57>/\-:()/ ; .PSECT DATA,D,RW ; ; ZSCII to Latin-1 conversion for top half of 128 codes... ; ZSCII:: .BYTE 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 .BYTE 344,366,374,304,326,334 ; Diaresis .BYTE 337,273,253 ; sz, quotes. .BYTE 353,357,377,313,317 ; More diaresis .BYTE 341,351,355,363,372,375,301,311,315,323,332,335 ; Acute .BYTE 340,350,354,362,371,300,310,314,322,331 ; Grave .BYTE 342,352,356,364,373,302,312,316,324,333 ; Circumflex .BYTE 345,305 ; Aring .BYTE 370,330 ; Oslash .BYTE 343,361,365,303,321,325 ; Tilde .BYTE 346,306 ; AE .BYTE 347,307 ; ccedille .BYTE 376,360,336,320 ; Icelandic chars. .BYTE 243 ; Pound. .BYTE 366,326 ; oe .BYTE 241,277 ; ! ? .BYTE 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 .BYTE 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ; .PSECT CODE,I,RO ; ; CZ2L - Convert ZSCII to Latin-1 ; ; In: R1 - Character ; ; Out: R1 - Character ; CZ2L:: TSTB R1 ; ASCII char? BPL 10$ ; Yes. Same same. BIC #^C177,R1 ; No. Mask low bits. MOVB ZSCII(R1),R1 ; Take conversion. 10$: RETURN ; Done. ; ; CL2Z - Convert Latin-1 to ZSCII ; ; In: R1 - Character ; ; Out: R1 - Character ; CL2Z:: TSTB R1 ; ASCII char? BPL 100$ ; Yes. MOV R0,-(SP) ; No. Save registers MOV R2,-(SP) MOV #ZSCII,R0 ; Point at table. MOV #200,R2 ; Count. 10$: CMPB R1,(R0)+ ; Match? BEQ 20$ ; Yes. SOB R2,10$ ; No. Loop. 20$: MOV #400,R1 ; Match found. We now know offset. SUB R2,R1 ; And that offset is the answer. MOV (SP)+,R2 ; Restore registers MOV (SP)+,R0 100$: RETURN ; ; OBJTXT - Print the text for an object. ; ; In: R0 - Object number. ; OBJTXT:: MOV R0,-(SP) ; Save register. MOV R1,-(SP) INC R0 ; Point to the following object. CALL FNDOBJ ; Find object. SUB #2,R0 ; Point at object properties. .GETWB R0 ; Get address of properties. DEC R0 ; Point at name string. 10$: ADD #2,R0 ; Next word. .GETWB R0,R1 ; Get data. CALL PUTZW ; Print it. TST R1 ; End of data? BPL 10$ ; No. MOV (SP)+,R1 ; Restore registers. MOV (SP)+,R0 RETURN ; Done. ; ; NUMTXT - Print a number. ; ; In: R0 - Number. ; NUMTXT:: MOV R0,-(SP) ; Save registers. MOV R1,-(SP) MOV R2,-(SP) CLR R2 MOV R0,R1 ; Check number. BPL 10$ ; Negative? MOVB #'-,R1 ; Yes. Put in a '-' CALL PUTCHR MOV R0,R1 NEG R1 ; And change sign. 10$: CLR R0 ; Do a divide. DIV #10.,R0 ADD #'0,R1 ; Make remainder into ASCII form. MOVB R1,-(SP) ; And save digit. INC R2 ; Count digits. MOV R0,R1 ; Get result in R3. BNE 10$ ; And repeat until result is 0. 20$: MOVB (SP)+,R1 ; Now get all digits back. CALL PUTCHR ; And print them. SOB R2,20$ MOV (SP)+,R2 ; Restore registers. MOV (SP)+,R1 MOV (SP)+,R0 RETURN ; ; PUTZW - Output a word with packed characters. ; ; In: R1 - Word. ; ; If the high bit is set on the word, the state machine shall ; be reset. ; PUTZW:: MOV R1,-(SP) ; Save registers. ASH #-10.,R1 ; Get first char. CALL PUTZB ; Output byte. MOV (SP),R1 ; Get word again. ASH #-5,R1 ; Next char. CALL PUTZB MOV (SP),R1 CALL PUTZB MOV (SP)+,R1 ; Restore register. BPL 10$ ; No reset. MOV DECCHR,DECPTR CLR OTAB CLR CTAB CLR STATE 10$: RETURN ; ; Output a single packed character. ; ; In: R1 - Character in low five bits. ; ; R1 is destroyed. ; PUTZB: BIC #^C37,R1 ; Mask away unwanted bits. CALLR @DECPTR ; Jump to correct decode function. ; ; DECCH1 - Decode one ZASCII character according to V1. ; ; In: R1 - Char in 5 low bits. ; ; R1 is destroyed. ; DECCH1:: TST STATE ; Flag set? BGT SPC1 ; Yes. First part. BLT SPC2 ; Yes. Low part. TST R1 ; No. Check this char. BEQ SPCHR ; Space. DEC R1 ; Newline? BEQ NLCHR ; Yup. DEC R1 ; Next set? BEQ NXSET DEC R1 ; Previous set? BEQ PRSET DEC R1 ; Next set lock? BEQ NXSETL DEC R1 ; Previous set lock? BEQ PRSETL DEC R1 ; A normal char? BNE NCHR ; Yes. ; ; Possibly a multichar... ; CMP CTAB,#52. ; Are we using A2? BNE NCHR ; No. MOV #1,STATE ; Yes. Set multibyte flag. RETURN ; ; DECCH2 - Decode one ZASCII character according to V2. ; ; In: R1 - Char in 5 low bits. ; ; R1 is destroyed. ; DECCH2:: TST STATE ; Flag set? BGT SPC1 ; Yes. First part. BLT SPC2 ; Yes. Low part. TST R1 ; No. Check this char. BEQ SPCHR ; Space. DEC R1 ; Abbreviation? BEQ 10$ ; Yup. DEC R1 ; Next set? BEQ NXSET DEC R1 ; Previous set? BEQ PRSET DEC R1 ; Next set lock? BEQ NXSETL DEC R1 ; Previous set lock? BEQ PRSETL DEC R1 ; A normal char? CMP R1,#1 ; Maybe... BGT NCHR ; Yes. ; ; Possibly a special char. It depends on if A2 is selected. ; CMP CTAB,#52. ; Are we using A2? BNE NCHR ; No. ; ; Now we now it is special. We have A2, and the character is 0 or 1. ; TST R1 ; Which character? BNE NLCHR ; 1 means newline. ; ; Character 0 means we have a multibyte. ; MOV #1,STATE ; Yes. Set flag. RETURN ; ; Abbreviation. ; 10$: MOV #ABBR1,DECPTR ; Setup pointer to abbreviations. RETURN ; And continue. ; ; Handle multibyte char. ; SPC1: ASH #5,R1 ; Shift up. BIS #100000,R1 ; Set flag. MOV R1,STATE ; First part of long byte. RETURN SPC2: BIS STATE,R1 ; Low part of long byte. CLR STATE ; Clear flag. BIC #^C377,R1 ; Clear unwanted bits. CALL PUTCHR ; Write char. MOV OTAB,CTAB RETURN ; ; A "normal" char. ; NCHR: ADD CTAB,R1 ADD ASCPTR,R1 MOVB (R1),R1 BR CHRDON ; ; Space. ; SPCHR: MOVB #' ,R1 BR CHRDON ; ; Newline. ; NLCHR: MOVB #13.,R1 CALL PUTCHR MOVB #10.,R1 BR CHRDON ; ; Next charset. ; NXSET: ADD #26.,CTAB CMP #78.,CTAB BNE 10$ CLR CTAB 10$: RETURN ; ; Prev charset. ; PRSET: SUB #26.,CTAB BPL 10$ MOV #52.,CTAB 10$: RETURN ; ; Next charset lock. ; NXSETL: ADD #26.,OTAB CMP #72.,OTAB BNE 10$ CLR OTAB 10$: MOV OTAB,CTAB RETURN ; ; Prev. charset lock. ; PRSETL: SUB #26.,OTAB BPL 10$ MOV #52.,OTAB 10$: MOV OTAB,CTAB RETURN ; ; Done with this char. ; CHRDON: CALL PUTCHR ; Output char. MOV OTAB,CTAB ; Reset char table. RETURN ; Done. ; ; DECCH3 - Decode one ZASCII character according to V3. ; ; In: R1 - Char in low 5 bits. ; ; R1 destroyed. ; DECCH3:: TST STATE ; Flag set? BGT SPC1 ; Yes. First part. BLT SPC2 ; Yes. Low part. TST R1 ; No. Check this char. BEQ SPCHR ; Space. DEC R1 ; Abbreviation? BEQ 10$ ; Yup. DEC R1 BEQ 20$ ; Yup. DEC R1 BEQ 30$ ; Yup. DEC R1 ; Next set? BEQ NXSET DEC R1 ; Previous set? BEQ PRSET DEC R1 ; A normal char? CMP R1,#1 ; Maybe... BGT NCHR ; Yes. ; ; Possibly a special char. It depends on if A2 is selected. ; CMP CTAB,#52. ; Are we using A2? BNE NCHR ; No. ; ; Now we now it is special. We have A2, and the character is 0 or 1. ; TST R1 ; Which character? BNE NLCHR ; 1 means newline. ; ; Character 0 means we have a multibyte. ; MOV #1,STATE ; Yes. Set flag. RETURN ; ; Abbreviation. ; 10$: MOV #ABBR1,DECPTR ; Setup pointer to abbreviations. RETURN 20$: MOV #ABBR2,DECPTR RETURN 30$: MOV #ABBR3,DECPTR RETURN ; ; Handle abbreviations. ; ABBR3: MOV R0,-(SP) ; Save registers. MOV #128.,R0 BR ABBREV ABBR2: MOV R0,-(SP) ; Save registers. MOV #64.,R0 BR ABBREV ABBR1: MOV R0,-(SP) ; Save registers. CLR R0 ABBREV: ASL R1 ; Get abbreviation number * 2. ADD R1,R0 ; Add table offset. ADD ZABBR,R0 ; Add offset to abbreviation table. .GETWB R0 ; Get word at word address. MOV DECCHR,DECPTR ; Reset state machine. CLR CTAB CLR OTAB 10$: .GETWW R0,R1 ; Copy data. CALL PUTZW ; Output data. INC R0 ; And bump address. TST R1 ; End of string? BPL 10$ ; No. Go on. MOV (SP)+,R0 ; Restore register. RETURN ; And now continue. ; .END .TITLE ZPRINT .IDENT /V1.3/ ; ++ ; This is the Z-machine emulator printer routines. ; (c) 2000 by Johnny Billquist ; ; History: ; ; X1.0 00-10-27 23:00 BQT Initial coding started. ; V1.1 00-11-03 16:15 BQT Added error checks after calls. ; V1.2 05-02-22 23:15 BQT Rewrote code for better and tidier handling. ; V1.3 08-09-04 16:30 BQT Changed GETSCR calling setup. ; -- .INCLUDE /ZMAC/ ; .PSECT DATA,D,RW ; PRBUF: .BLKB 80. PREND: .WORD 0 PRPTR: .WORD PRBUF ; PRFLG: .WORD 0 ; Script flags. ; .PSECT TEXT,D,RO ; QNAM: .ASCIZ /Transcript to file: / FAIL: .ASCIZ /Transcript failed./<15><12> ABOTXT: .ASCIZ /Transcript aborted./<15><12> ; .PSECT CODE,I,RO ; ; PRNCHR - Print character. ; ; In: R1 - Character to print. ; PRNCHR:: JSR R2,$SAVVR ; Save registers. MOV ZEROP,R0 ; Check flag. BIT #400,20(R0) ; Transcript on? (100h,10h) BNE 1$ ; Yes. RETURN ; No. 1$: ; CMP OLDFON,#1 ; If font isn't 1, we don't print... ; BNE 25$ BIT #1,PRFLG ; Do we have a file open? BNE 10$ ; Yes. CALL PRNOPN ; No. Open file. BCC 10$ ; Worked fine... 5$: RETURN ; Ummm... Bad. Drop it. ; ; Time to put character in buffer, and work from there. ; 10$: MOV PRPTR,R2 ; Get pointer. CMPB R1,#15 ; Check if printable... BNE 20$ ; ; We have a CR. Let's print the line we have. ; CLR -(SP) ; To fake the same as wrap, we push a 0 ; for residual string. BR 35$ ; And continue there. ; 20$: CMPB R1,#12 ; LF? BEQ 5$ ; Yes. Just drop it. ; ; Now we have a plain char to print. ; CMPB R1,#' ; Space? BNE 21$ ; No. BIT #2,PRFLG ; Yes. Are we gobbling? BNE 5$ ; Yes. Ignore char. 21$: BIC #2,PRFLG ; No. Clear gobble. MOVB R1,(R2)+ ; Save it in buffer. CMP R2,#PREND ; Do we have a full buffer? BLOS 40$ ; No. Proceed. ; ; We have a full buffer. We should wrap. ; BIS #2,PRFLG ; Assume we want to gobble. CLR R0 ; Count how many saved. 30$: INC R0 ; Bump count. MOVB -(R2),-(SP) ; Save one more. CMPB (R2),#40 ; Space? BNE 30$ ; No. Repeat. DEC R0 ; Yes. Remove space from count. MOV R0,(SP) ; Save count. 35$: CLRB (R2) ; Mark end of buffer. MOV #PRBUF,R0 ; Get start of buffer. SUB R0,R2 ; And length. MOV R2,R1 ; Setup length in R1. CALL SCRBLK ; Put scripting text. BCS 90$ ; Error... MOV R0,R2 ; Pointer in R2. MOV (SP)+,R0 ; Get count back. BEQ 40$ BIC #2,PRFLG ; We have chars carry over. No gobble. 37$: MOVB (SP)+,(R2)+ ; Restore text. SOB R0,37$ ; Repeat for all characters. ; 40$: MOV R2,PRPTR ; Save new pointer. RETURN ; ; Scripting failed... ; 90$: MOV (SP)+,R0 ; Restore stack... ASL R0 ADD R0,SP CALL SCRCLO ; Close file. BIC #1,PRFLG ; Clear open flag. MOV #ABOTXT,R0 ; Error message. CALL SCRTXT ; Print message. MOV ZEROP,R0 ; Clear scripting flag. BIC #400,20(R0) ; (100h,10h) RETURN ; ; PRNOPN - Open transcript file. ; ; R0 - Zero page. ; PRNOPN: JSR R2,$SAVVR ; Save registers. BIC #400,20(R0) ; Clear script flag. (100h,10h) MOV #QNAM,R0 ; Prompt... CALL SCRTXT CLR TMO ; No timeout. MOV #FNAM,R0 ; Read filename. MOV R0,R1 MOV #FNAML-1,R2 CALL GETSTR CLRB (R0) ; Terminate filename. MOV R0,R1 MOV #FNAM,R0 ; Get pointer to filename. SUB R0,R1 ; Get length of filename. CALL SCROPN ; Open scripting file. BCS 10$ ; Fail. BIS #1,PRFLG ; Success. Indicate that file is open. MOV ZEROP,R2 BIS #400,20(R2) ; Restore script flag. (100h,10h) RETURN ; ; Open failed. ; 10$: MOV #FAIL,R0 CALL SCRTXT ; Print message. SEC RETURN ; ; PRSTOP - Stop transcription and close file. ; PRSTOP:: BIT #1,PRFLG ; Are we transcribing? BNE 1$ ; Yes. RETURN ; No. ; 1$: BIC #1,PRFLG ; Clear open flag. MOV PRPTR,R1 ; Yes. Get pointer. CLRB (R1) MOV #PRBUF,R0 SUB R0,R1 BEQ 10$ ; Buffer was empty. CALL SCRBLK ; Something in there. Flush it. 10$: CALLR SCRCLO ; Close file. ; .END .MCALL .MODULE .MODULE ZRTLIB,RELEASE=X00,VERSION=02,COMMENT=,AUDIT=NO ;+ ; ; Copyright (C) 2000 by Megan Gentry ; Framingham, Massachussetts ; All Rights Reserved ; Commercial Use and Distribution Prohibited ; ; This software was developed for use with the Z-machine emulator by ; Johnny Billquist. In this context, rights are hereby granted by ; the author for the software to be freely copied and used in its ; entirety for any non-commercial purpose so long as the above ; copyright notice and these comments are preserved. ; ; The author has used best efforts in the research, design, development ; and testing of this software. The author makes no warranty of any ; kind, expressed or implied, with regard to this software and its ; suitability for a given application. The author shall not be liable ; in any event for incidental or consequential damages in connection ; with, or arising out of, the use or performance of this software. Use ; of this software constitutes acceptance of these terms. ; ; The author is committed to making a best effort at fixing any errors ; found in the software and welcomes any reports of problems, comments, ; or suggestions regarding the software at . ; ;- .SBTTL Abstract and Edit History ;+ ; ; ZEDMSG ; This routine is the RT-11 replacement for the RSX routine ; which expands a string to be printed using formatting ; characters ala U*x printf(). ; ; History: ; ; (00) 22-Aug-2000 Megan Gentry ; Initial coding ; ; (01) 23-Aug-2000 Megan Gentry ; o Added code to $EDMSG to properly check for the end of the ; format string and to add a final NUL to the end of the ; output string. ; o Added line to specify CODE psect in front of all routines ; o Down-sized some code relating to sign extension ; o Down-sized some code relating to NUL termination ; ; (02) edit reason lost ; ; (03) 30-Apr-2006 Johnny Billquist ; Added $SAVVR ; ;-- .SBTTL $EDMSG - Edit a message string (like printf) ;+ ; ; $EDMSG ; Like printf() in U*x, this routine builds a printable string ; in an output buffer based on an input string which contains ; formatting information. ; ; Input: ; R0 -> Output buffer ; R1 -> Input buffer ; R2 -> List of single-word arguments to be printed ; ; Output: ; R0 -> Byte beyond buffer ; R1 = undefined ; R2 = undefined ; ; Notes: ; Conversion control is based on the following characters: ; ; %D - signed decimal. ; %O - signed octal. ; %M - unsigned decimal. ; %P - unsigned octal. ; %U - unsigned decimal. ; %B - unsigned octal byte. Argument is address of byte. ; %% - Passes a single '%' to the output string ; ;- .PSECT CODE,I,RO .ENABL LSB $EDMSG:: MOV R1,-(SP) ;Save some registers MOV R2,-(SP) ; ... MOV R3,-(SP) ; ... 10$: TSTB @R1 ;At end of formatting string? BEQ 80$ ;Yep... all done CMPB @R1,#'% ;Is this beginning of conversion? BEQ 30$ ;Yep... 20$: MOVB (R1)+,(R0)+ ;Nope, move character to output BNE 10$ ;Haven't reached EOS yet, continue BR 80$ ;We're all done... 30$: INC R1 ;Bump pointer to conversion character CMPB @R1,#'% ;Is it an escape for the '%' char? BEQ 20$ ;Yep... 40$: MOV #$EDCTB,R3 ;R3 -> Conversion table 50$: TSTB @R3 ;End of table? BNE 60$ ;Nope... DEC R1 ;Back up to escape character BR 20$ ;Now treat it as non-special 60$: CMPB @R1,@R3 ;Does it match this special character? BEQ 70$ ;Yes... ADD #4,R3 ;Nope, on to next entry... BR 50$ 70$: CALL @2(R3) ;Do the conversion INC R1 ;Bump pointer past conversion char BR 10$ 80$: CLRB @R0 ;Ensure string is NUL-terminated MOV (SP)+,R3 ;Restore previously saved registers MOV (SP)+,R2 ; ... MOV (SP)+,R1 ; ... RETURN .DSABL LSB .PSECT DATA,D,RW $EDCTB: .WORD 'D, $EDSDE ;Signed decimal .WORD 'O, $EDSOC ;Signed octal .WORD 'M, $EDUDE ;Unsigned decimal .WORD 'P, $EDUOC ;Unsigned octal .WORD 'U, $EDUDE ;Unsigned decimal .WORD 'B, $EDUOB ;Unsigned octal, byte .WORD 0 ; ** Table Fence ** .SBTTL $EDSDE - Signed Decimal .PSECT CODE,I,RO $EDSDE: MOV R1,-(SP) ;Save pointer to format string MOV (R2)+,R1 ;R1 = Number to convert BPL 10$ ;If plus... go do it MOVB #'-,(R0)+ ;If minus, put a '-' to output buffer NEG R1 ; and negate the value 10$: CALL $EDDEC ;Go do the conversion MOV (SP)+,R1 ;Restore pointer to format string RETURN .SBTTL $EDSOC - Signed Octal .PSECT CODE,I,RO $EDSOC: MOV R1,-(SP) ;Save pointer to format string MOV (R2)+,R1 ;R1 = Number to convert BPL 10$ ;If plus... go do it MOVB #'-,(R0)+ ;If minus, put a '-' to output buffer NEG R1 ; and negate the value 10$: CALL $EDOCT ;Go do the conversion MOV (SP)+,R1 ;Restore pointer to format string RETURN .SBTTL $EDUDE - Unsigned Decimal .PSECT CODE,I,RO $EDUDE: MOV R1,-(SP) ;Save pointer to format string MOV (R2)+,R1 ;R1 = Number to convert CALL $EDDEC ;Go do it... MOV (SP)+,R1 ;Restore pointer to format string RETURN .SBTTL $EDUOC - Unsigned Octal .PSECT CODE,I,RO $EDUOC: MOV R1,-(SP) ;Save pointer to format string MOV (R2)+,R1 ;R1 = Number to convert CALL $EDOCT ;Go do it... MOV (SP)+,R1 ;Restore pointer to format string RETURN .SBTTL $EDUOZ - Unsigned Octal, Leading Zeroes .PSECT CODE,I,RO $EDUOZ: MOV R1,-(SP) ;Save pointer to format string MOV R0,-(SP) ;Save current output pointer MOV @R2,R1 ;R1 = Number to convert CALL $EDOCT ;Do the conversion MOV R0,R1 ;Determine length of conversion SUB @SP,R1 ; ... MOV (SP)+,R0 ;Restore pointer to output string NEG R1 ;Determine count of leading zeroes ADD #6,R1 ;R1 = Count of leading zeroes required BEQ 20$ ;If none required... 10$: MOVB #'0,(R0)+ ;Output a leading zero... DEC R1 ;More to do? BGT 10$ ;Yep... 20$: MOV (R2)+,R1 ;R1 = Number to convert CALL $EDOCT ;Do the real conversion MOV (SP)+,R1 ;Restore pointer to format string RETURN .SBTTL $EDUOB - Unsigned Octal, Byte .PSECT CODE,I,RO $EDUOB: MOV R1,-(SP) ;Save pointer to format string MOV (R2)+,R1 ;R1 -> Byte to convert MOVB @R1,R1 ;R1 = Byte to convert BIC #^C<377>,R1 ;Discard any sign extension CALL $EDOCT ;Do the conversion MOV (SP)+,R1 ;Restore pointer to format string RETURN .SBTTL $EDOCT - Binary to Octal conversion .PSECT CODE,I,RO $EDOCT: MOV R1,-(SP) ;Save the current value BIC #^C<7>,@SP ;Isolate an octal digit's worth ADD #'0,@SP ;Make it printable ROR R1 ;Shift right (don't replicate MSB) ASR R1 ; for next ASR R1 ; octal digit BEQ 10$ ;If all done converting... CALL $EDOCT ;More to do... 10$: MOVB (SP)+,(R0)+ ;Store a character RETURN ; ! Recurse ! - unwind stack .SBTTL $EDDEC - Binary to Decimal conversion .PSECT CODE,I,RO $EDDEC: MOV R1,-(SP) ;Make a copy of the number CLR R1 ;Crude divide by 10. 10$: INC R1 ; ... SUB #10.,@SP ; ... BHIS 10$ ; ... ADD #10.+'0,@SP ;Make the digit printable DEC R1 ;Correct the quotient BEQ 20$ ;If all done converting... CALL $EDDEC ;More to do... 20$: MOVB (SP)+,(R0)+ ;Store a character RETURN ; ! Recurse ! - unwind stack .SBTTL $SAVAL - Saves all registers (coroutine) $SAVAL:: MOV R0,-(SP) ;Save all the registers MOV R1,-(SP) ; ... MOV R2,-(SP) ; ... MOV R3,-(SP) ; ... MOV R4,-(SP) ; ... MOV R5,-(SP) ; ... CALL @14(SP) ;Co-routine back to our caller MOV (SP)+,R5 ;*C* Restore the registers MOV (SP)+,R4 ;*C* (preserving C-bit) MOV (SP)+,R3 ;*C* ... MOV (SP)+,R2 ;*C* ... MOV (SP)+,R1 ;*C* ... MOV (SP)+,R0 ;*C* ... DEC (SP)+ ;*C* Don't return to our caller RETURN ;*C* rather to our caller's caller .SBTTL .SAVR1 - Saves R1-R5 (coroutine) .SAVR1:: MOV R4,-(SP) ;Save all the registers MOV R3,-(SP) ; ... MOV R2,-(SP) ; ... MOV R1,-(SP) ; ... MOV R5,-(SP) ; Push return address. MOV 12(SP),R5 ; Get old R5. CALL @(SP)+ ; Co-routine back to caller. MOV (SP)+,R1 ;*C* Restore the registers MOV (SP)+,R2 ;*C* (preserving C-bit) MOV (SP)+,R3 ;*C* ... MOV (SP)+,R4 ;*C* ... MOV (SP)+,R5 ;*C* ... RETURN ;*C* .SBTTL $SAVVR - Saves R0-R2 (coroutine) $SAVVR:: MOV R1,-(SP) ;Save all the registers MOV R0,-(SP) ; ... MOV R2,-(SP) ; Push return address. MOV 6(SP),R2 ; Get old R2. CALL @(SP)+ ; Co-routine back to caller. MOV (SP)+,R0 ;*C* Restore the registers MOV (SP)+,R1 ;*C* (preserving C-bit) MOV (SP)+,R2 ;*C* ... RETURN ;*C* .END .MCALL .MODULE .MODULE ZRT,RELEASE=X00,VERSION=21,COMMENT=,AUDIT=NO ;+ ; ; Copyright (c) 2000 by Megan Gentry ; Framingham, Massachussetts ; All Rights Reserved ; Commercial Use and Distribution Prohibited ; ; This software was developed for use with the Z-machine emulator by ; Johnny Billquist. In this context, rights are hereby granted by ; the author for the software to be freely copied and used in its ; entirety for any non-commercial purpose so long as the above ; copyright notice and these comments are preserved. ; ; The author has used best efforts in the research, design, development ; and testing of this software. The author makes no warranty of any ; kind, expressed or implied, with regard to this software and its ; suitability for a given application. The author shall not be liable ; in any event for incidental or consequential damages in connection ; with, or arising out of, the use or performance of this software. Use ; of this software constitutes acceptance of these terms. ; ; The author is committed to making a best effort at fixing any errors ; found in the software and welcomes any reports of problems, comments, ; or suggestions regarding the software at . ; ;- .SBTTL Abstract and Edit History ;+ ; ; ZRT ; This module implements the support routines used by the ; Z-emulator in a manner specific to the RT-11 operating ; system. It is modelled after the ZRSX module. ; ; Portions Copyright (c) 2000 by Johnny Billquist ; ; Edit History: ; Note that several of the RSX-specific library routines have ; had RT-11 equivalents written. These can be found in module ; ZRTLIB.MAC ; ; (00) 10-Aug-2000 Megan Gentry ; Initial RT-11 related coding ; ; (01) 29-Aug-2000 Megan Gentry ; o RT-ified several routines, including ZMSG, PUTTXT, GETRND, ; CHARNE, ZEXIT, ZALLOC. Still some questions about aspects ; of some of the routines. ; ; (02) 30-Aug-2000 Megan Gentry ; o Completed conditionalization of code so it should be ; buildable on RSX... RT still needs some work. ; ; (03) 06-Sep-2000 Megan Gentry ; o Added printout of program name, commented out ; o Adding code to ZINIT to parse file name string and ; process options ; ; (04) 07-Sep-2000 Megan Gentry ; o Added code to determine and report a non-scope (unknown) ; vs. a scope (vt100) terminal. Added option which allows ; specification of a terminal type. ; ; (05) 10-Sep-2000 Megan Gentry ; o Added code to match new routines in ZRSX which handle ; terminal input timeout ; ; (06) 13-Sep-2000 Megan Gentry ; o Added code to match new routines in ZRSX which handle ; game save/restore ; ; (07) 14-Sep-2000 Megan Gentry ; o ZALLOC was returning pointer to top of allocated memory, ; not to the start of the allocated region. ; o In ZBLK, the amount to read is specified in bytes, but ; RT uses words. ; o In INPINI, wasn't correctly checking for 0 timeout. ; o In INPINI, MUL uses two registers, which affected the check ; for the system clock frequency. It also was taking the ; low-order timeout value from the wrong place. Converted to ; using single-precision inline code. ; o In INPINI, option processing code was not correctly using ; the option count (it was referring to the wrong register) ; and instead of branching back for the next option, it ; branched back to prompt again for a command. ; ; (08) 15-Sep-2000 Megan Gentry ; o Recoded timer and character input routines to match what ; is in ZRSX. ; o Added code to allocate space for multiple queue elements ; so disk I/O can occur while a timer is active. ; o Added code to ensure that PAR1 space cannot be allocated ; ; (09) 16-Sep-2000 Megan Gentry ; o Changes due to comments from Johnny Billquist -- SAVE/ ; RESTORE code doesn't need to add s to filename strings, ; they're already there. New method of aborting, calling ; ABORT before calling ZEXIT ; o Reduced code a little by having RESCLO call SAVCLO, since ; they do the exact same thing... ; ; (10) 18-Sep-2000 Megan Gentry ; o Modifications to random number routine -- using generator ; algorithm specified in Knuth, Vol.II (with some values ; which follow the rules, but may not produce a great random ; number sequence). ; o Added seed value for random number generator as a command ; line option (/S:value). ; ; (11) 19-Sep-2000 Megan Gentry ; o Modifications to SAVBLK and RESBLK. Neither was specifying ; the block number (RTSBLK) to be used for the write. ; o My misunderstanding of the purpose of GETRND had me write ; a full random-number generator, when all that was needed ; was a seed value for a generator in the ZEMU common code. ; This has been corrected. ; ; (12) 20-Sep-2000 Megan Gentry ; o Corrected assembly problems when DBUG was enabled ; o Added new debug flags for tracing entry to the RT ; routines and for the timeout routine. ; o Extended debug/trace messages ; ; (13) 21-Sep-2000 Megan Gentry ; o ZMSG routine was using an incorrect offset for getting ; at stacked values due to differences in the $SAVAL ; routines (RT vs. RSX). Problem found by JB. ; o Added code at PUTTXT to ignore zero or negative length ; strings. ; o Recoded GETSLN so that it won't return a zero value ; o Added entries to RTTTTB only to find that the offset into ; the table returned the same value, so the routine GETSTP ; can be much simpler. ; ; (14) 22-Sep-2000 Megan Gentry ; o Recoded GETSCL and GETSTP routines so that they work ; correctly in the virtual environment of vrun/vbgexe by ; using .PEEK to get to the actual structures in low ; memory. ; ; (15) 18-Oct-2000 Megan Gentry ; o Conditionalized default terminal type ; ; (16) 30-Oct-2000 Megan Gentry ; o Johnny's been busy again... had to add support for logging ; (scripting). ; ; (17) 01-Nov-2000 Megan Gentry ; o Finally got to test scripting, had a few bugs to fix. ; ; (18) 02-Nov-2000 Megan Gentry ; o Coding changes to scripting routines so that once a write ; failure has occurred, the script is closed and a flag set ; so that future calls to SCRBLK are ignored until a new ; file has been opened. ; ; (19) 17-Aug-2003 Johnny Billquist ; o Added CHESIZ, CHEALL and CHEUPD for a more general cache ; handling. ; ; (20) 30-Apr-2006 Johnny Billquist ; o Added some more missing stuff for the current version to build. ; ; (21) 04-Sep-2008 Johnny Billquist ; o Changed calling sequence for INPINI ;-- .INCLUDE /ZMAC/ ;Z-Machine definitions D.RTRC =: 100000 ;RT subroutine trace INTVER == 103 ; Interpreter version "C" .SBTTL RT-11 System Macro Declarations ; List the RT-11 programmed requests we'll be using .MCALL .GTLIN .TTYIN .PRINT ;Terminal I/O .MCALL .RCTRL .TTINR .MCALL .CSISP ;Filespec parsing .MCALL .ENTER .LOOKU .CLOSE ;File access .MCALL .READW .WRITW .MCALL .SETTO ;Program size .MCALL .GVAL ;System information .MCALL .PEEK .MCALL .GTIM .DATE ;Date/time information .MCALL .MRKT .CMKT ;Timer control .MCALL .EXIT .QSET ;Job control ; Now declare and invoke the structure definitions .LIBRARY /SY:SYSTEM.MLB/ ; Configuration word 1 .MCALL .CF1DF .CF1DF ; .CSI returned information .MCALL .CSIDF .CSIDF ; .CSTAT information block .MCALL .CSTDF .CSTDF ; RT-11 Internal Date .MCALL .DATDF .DATDF ; File specification DBLK (returned by CSI) .MCALL .DBKDF .DBKDF ; Default file extensions (for CSI) .MCALL .DFXDF .DFXDF ; .SDTTM date/time block .MCALL .DTMDF .TIMDF .DTMDF .TIMDF ; EMT error codes .MCALL .ERRDF .ERRDF ; RT-11 RMON Fixed Offset Area .MCALL .FIXDF .FIXDF ; .GTJB returned information block .MCALL .GTJDF .GTJDF ; Job Status Word .MCALL .JSWDF .JSWDF ; Queue element layout .MCALL .QELDF .QELDF ; RT-11 System Communications Area .MCALL .SYCDF .SYCDF ; Terminal Configuration .MCALL .TCFDF .TTCDF .TCFDF .TTCDF ; Miscellaneous definitions RTTID ==: 1 ;Read timer ID RTQELN ==: 1+1+1+1 ;Number of extra Qelements needed ; timer, game file read, save/restore ; and scripting RTGCHN ==: 10 ;Channel for game file RTSCHN ==: 11 ;Channel for game save/restore RTLCHN ==: 12 ;Channel for scripting (log) file .SBTTL Locally-defined macros ; Define some locally needed structures .MCALL .DSECT .DS .DSECT ;Option table entry .DS SW.OCH,,B ;Option character .DS SW.OFG,,B ;Option flags .DS SW.OAD ;Option value address .DS SW.ODF ;Option default value .DS SW.ESZ,0 .MCALL .BSECT .BS .BSECT .BS SW$FLG ;Option is flag only (0 = value) .BS SW$DEF ;Option has a default value .BS SW$REQ ;Option requires value .BS SW$FIL ;Option is file-oriented ; The following macro is used to specify the options which are ; supported by this program. .MACRO SWDEF CHAR,FLAGS,LABEL,DEFALT $$$ = . .BYTE ''CHAR .BYTE .WORD LABEL .IF NB DEFALT .WORD DEFALT . = <$$$ + SW.OFG> .BYTE !SW$DEF .IFF ;NB DEFALT .WORD 0 . = <$$$ + SW.OFG> .BYTE & <-SW$DEF> .ENDC ;NB DEFALT . = <$$$ + SW.ESZ> .ENDM ;SWDEF .SBTTL Impure data area (RT-11 specific) .PSECT DATA,D,RW RTNAME: .ASCII |ZEMU/RT | ; : Identification string .NLCSI TYPE=I,PART=RLSVER ; : Version .ASCIZ / / RTFNMP: .ASCII /Game filename? /<200> ; : File name prompt .EVEN GAMID:: ; Junk game identification in save file RTIBUF: .BLKB 132. ; : Input buffer RTSPSV: .BLKW ; : SP storage ; Define the options (switches) we recognize ; *** Begin Critical Ordering *** RTSWTB: SWDEF B,,CLIM ; /B:n (number of cache pages) SWDEF D,,DBGFLG ; /D:n (debug flag) SWDEF I,,INTERP ; /I:n (force interpreter level) SWDEF S,,RTOPTS ; /S:n (set random number seed) SWDEF T,,RTOPTT ; /T:n (terminal type) .WORD 0 ; ** Table Fence ** ; *** End Critical Ordering *** RTAREA: .BLKW 10. ; : Area for RT programmed requests RTDTBK: .BLKW ; : Date word RTTMBK: .BLKB TIM.SZ ; : Time block .SBTTL Impure data area - common to all supported OSes .PSECT DATA,D,RW ; Data area for .BLK macro arguments... (used by all flavors of module) ; ** NOTE ** In RT-11, blocks are 16-bit values. BPAGE:: .WORD 0 ; These values are written BADDR:: .WORD 0 ; by ZMAC macros... BCNT:: .WORD 0 ; Therefore they must exist. INFO:: .LIMIT ; : Image limits, link-time FREEPT: .BLKW ; : Highest address in use (run-time) END: .WORD 0 ; : Highest address allocated (run-time) BUF:: .BLKB 256. ; : Space for expanding strings .SBTTL ZMSG - Prints a message at the user's terminal ;+ ; ; ZMSG shall print a message on the users terminal. The string ; will have a CRLF appended. ; The function is used on errors. ; ; In: R1 -> NUL-terminated string. ; 2(SP) - A list of arguments for the string. ; ; No registers should be changed. ; ; The formatting used is that of $EDMSG in RSX. ; ; The string formatting is kindof like printf() in C, in that ; special codes in the string are replaced by the arguments ; pointed at in the argument list. ; ; Special formatting characters are: ; ; %D - signed decimal. ; %O - signed octal. ; %M - unsigned octal with leading zeroes. ; %P - unsigned octal. ; %U - unsigned decimal. ; %B - unsigned octal byte. Argument is address of byte. ; ;- .PSECT CODE,I,RO .ENABL LSB ZMSG:: ;;;; ** NOTE ** Cannot do this without causing an endless loop ;;; .DBG #D.RTRC,<"[Entered ZMSG]"> CALL $SAVAL ; Save registers. MOV #BUF,R0 ; Buffer in R0. MOV SP,R2 ; Argument block. ADD #22,R2 ; account for saved registers CALL $EDMSG ; Format message. .PRINT #BUF ;Print the string with RETURN ; Done. .DSABL LSB .SBTTL PUTTXT - Writes text to the screen ;+ ; ; PUTTXT is the routine to write a text to the screen. ; ; In: R0 - Address of text. ; R1 - Length of text. ; ; Note that the text is NUL terminated. ; The NUL is not accounted for in the length, though. ; ;- .PSECT CODE,I,RO .ENABL LSB PUTTXT:: .DBG #D.RTRC,<"[PUTTXT: Address = %P, count = %D. characters]">,R0,R1 TST R1 ;Anything to print? BEQ 10$ ;Nope... BMI 10$ ;Negative strings lengths are absurd MOV R0,-(SP) ;Copy the string start pointer ADD R1,R0 ;Add length, now points to end MOVB #200,@R0 ;Flag to terminate without MOV @SP,R0 ;Restore pointer to string .PRINT ;Print the string MOV (SP)+,R0 ;Restore pointer to string 10$: RETURN .DSABL LSB .SBTTL GETRND - Get a random value ;+ ; ; GETRND ; Returns a 16-bit random value to be used as a seed to the ; random number generator. ; ; Call: ; none ; ; Return: ; R0 = 16-bit random value ; ; Notes: ; o The seed value can be specified by an option (/S:seed) and ; will be used without modification. This is useful when ; attempting to debug the random number generator. ; o If not otherwise specified, this routine will return the ; lo-order 16 bit RT-11 time value, which is a monotonically ; increasing value indicating the number of clock ticks which ; have occurred since midnight. The lo-order value wraps ; every 18 minutes. ; ;- .PSECT CODE,I,RO .ENABL LSB GETRND:: MOV RTOPTS,R0 ;Was a seed specified via option? BNE 10$ ;Yep... use it... .GTIM #RTAREA,#RTTMBK ;Get the RT-11 time MOV RTTMBK+TIM.LO,R0 ; and return the lo-order 16 bits 10$: .DBG #D.RTRC,<"[GETRND: returning %P as seed]">,R0 RETURN .DSABL LSB .PSECT DATA,D,RW RTOPTS: .WORD 0 ; : Random number seed .SBTTL INPINI - Input read timer initialization ;+ ; ; INPINI ; Sets a timer for terminal input ; ; Call: ; TMO = timeout, in 1/10s of a second ; ; Return: ; none, registers preserved ; ; Errors: ; none ; ;- .PSECT CODE,I,RO .ENABL LSB INPINI:: .DBG #D.RTRC,<"[INPINI: timeout = %D. tenths of a second]">,R0 MOV R0,-(SP) ;Save some registers for awhile MOV R1,-(SP) ; ... CLR RTRTEN ;Disable the repeating interval timer .CMKT #RTAREA,#RTTID ;Cancel any outstanding read timer CLR RTRTFG ;Reset the read timer flag .GVAL #RTAREA,#$CNFG1 ;Get configuration word 1 MOV R0,R1 ;Save it for later MOV TMO,R0 ;R0 = Specified timeout BEQ 20$ ;No timeout... ASL R0 ;Convert tenths to ticks (assume 60hz) MOV R0,-(SP) ; using ASL R0 ; inline ADD (SP)+,R0 ; code BIT #CLK50$,R1 ;Does system have a 50-hz clock? BEQ 10$ ;Nope... SUB TMO,R0 ;Yes, adjust ticks for 50-hz clock 10$: CLR RTRTBK ;Set read timer hi-order MOV R0,RTRTBK+2 ; and lo-order timeout value CLR RTRTFG ;Reset the timeout flag MOV SP,RTRTEN ;Enable the repeating interval timer .MRKT #RTAREA,#RTRTBK,#RTRTCR,#RTTID ;Post the timeout BCC 20$ ;success... .MSG <"No queue element available for timer"> 20$: MOV (SP)+,R1 ;Restore previously saved registers MOV (SP)+,R0 ; ... RETURN .DSABL LSB .PSECT DATA,D,RW RTRTFG: .BLKW ; : Read timeout flag RTRTEN: .BLKW ; : Read timer enable RTRTBK: .BLKW 2 ; : Read timeout timer block .SBTTL INPEND - Cancel read timer ;+ ; ; INPEND ; Cancels any outstanding timer for terminal input ; ; Call: ; none ; ; Return: ; none ; ; Errors: ; none, registers preserved ; ; Notes: ; o The only possible error from .CMKT is ignored since the ; result is the same as if there is no error. ; ;- .PSECT CODE,I,RO .ENABL LSB INPEND:: .DBG #D.RTRC,<"[INPEND: timer cancelled]"> MOV R0,-(SP) ;Save some registers for awhile CLR RTRTEN ;Disable the repeating interval timer .CMKT #RTAREA,#RTTID ;Cancel any outstanding read timer CLR RTRTFG ;Reset read timer timeout flag MOV (SP)+,R0 ;Restore previously saved register RETURN .DSABL LSB .SBTTL RTRTCR - Read timer completion routine ;+ ; ; RTRTCR ; This completion routine is entered upon input read timer timeout. ; ; Entered with: ; R0 = Timer ID ; ; Implicit Output: ; timer timeout flag is set ; ; Notes: ; o Registers are preserved (they must be, since this is a ; completion routine. ; ;- .PSECT CODE,I,RO .ENABL LSB RTRTCR: .DBG #D.RTRC,<"[!!Timeout has occurred!!]"> MOV SP,RTRTFG ;Set the timeout flag RETURN .DSABL LSB .SBTTL CHARNE - Read a character from keyboard, no echo ;+ ; ; CHARNE ; Read one character from keyboard, with no echo. ; ; Returns: ; R0 = Character ; ; Notes: ; o In RT-11, the key is converted into the sequence ; . This happens even when the terminal is in ; special mode. ; ; o In order to return only one character, this routine will ; discard any which immediately follows a . It ; will, however, pass a for which the previous character ; was NOT a . ; ;- .PSECT CODE,I,RO .ENABL LSB CHARNE:: BR 20$ ;Try at least once for character... 10$: TST RTRTFG ;Did the read timer time-out? BEQ 20$ ;Nope... CLR RTRTFG ;Yes, consume the timeout TST RTRTEN ;Is the timer still enabled? BEQ 20$ ;No... .MRKT #RTAREA,#RTRTBK,#RTRTCR,#RTTID ;Post a new timer BCC 15$ ;Success... .MSG <"No queue element available for timer"> 15$: CLR R0 ;Return a .DBG #D.RTRC,<"[CHARNE: Returning timeout]"> SEC ; with carry set BR 40$ 20$: .TTINR ;Try for a character BCS 10$ ;None available yet... CMPB R0,#<^o12> ;Is it a ? BNE 30$ ;Nope... CMPB RTLCHR,#<^o15> ;Yes, Was previous character a ? BNE 30$ ;Nope, so pass this MOVB R0,RTLCHR ;Yes, so save this as last character BR 10$ ; and go try again 30$: MOVB R0,RTLCHR ;Save this as new last character .DBG #D.RTRC,<"[CHARNE: returning character %O]">,R0 CLC ; which we return with carry clear 40$: RETURN .DSABL LSB .PSECT DATA,D,RW RTLCHR: .BYTE 0 ; : Last character received .EVEN .SBTTL ZINIT - Initialization routine ;+ ; ; ZINIT ; This is the game initialization routine. It queries the ; user for the name of a game file (repeating until valid) ; and processes any options. ; ; Notes: ; o RT-11 provides a single queue element, typically used ; for I/O. Since the timer consumes a queue element, this ; would prevent doing any I/O while a read timer is active. ; We need to allocate space for a couple of queue elements ; and let RT know about them (.QSET) ; ; o Ensure that no part of allocated space can exist in PAR1 ; so that qelements and I/O buffers are all out of PAR1 ; ;- .PSECT CODE,I,RO .ENABL LSB ZINIT:: .IF NE DBUG ; BIS #D.RTRC,DBGFLG ;Set flag to trace RT routines .ENDC ;NE DBUG MOV INFO+2,FREEPT ;Save pointer to free memory MOV INFO+2,END ; for memory allocation .DBG #D.RTRC,<"[ZINIT: FREEPT = END = %P]">,FREEPT ; ** ACTION ** This check need only be done for XM-like monitors MOV #<^o40000>,R0 ;R0 = Address beyond PAR1 space CMP INFO+2,R0 ;Does program reside in all of PAR1? BHIS 20$ ;Yes... .SETTO ;Nope, reserve rest of PAR1 CMP R0,#<^o40000> ;Were we able to? BEQ 10$ ;Yep... .MSG <"Insufficient memory"> ;Nope... we've got problems CALL ABORT ;Do some screen cleanup first JMP ZEXIT 10$: MOV R0,FREEPT ;Save pointer to free memory MOV R0,END ; for memory allocation .DBG #D.RTRC,<"[ZINIT: FREEPT = END = %P]">,FREEPT 20$: MOV #,R0 ;R0 = Space needed for extra Qelements CALL ZALLOC ;Allocate the space BCC 30$ ;Success... .MSG <"Insufficient space for extra Qelements"> CALL ABORT ;Do some screen cleanup first JMP ZEXIT 30$: MOV R0,RTQELM ;Save pointer to Qelement space .QSET R0,#RTQELN ;Tell RT about extra Qelement space .DBG #D.RTRC,<"[ZINIT: Qelement space at %P, size = %D. bytes]">,RTQELM,# .PRINT #RTNAME ;Announce ourself 40$: .GTLIN #RTIBUF,#RTFNMP ;Prompt the user for a game file BCC 50$ ;We got a response... .MSG <"Line too long"> BR 40$ 50$: TSTB RTIBUF ;Was there any real text? BEQ 40$ ;Nope, go reprompt ; ** ACTION ** Here we could do a scan of the input string for any ; wildcard characters and reject it if we find any... MOV SP,RTSPSV ;Save the stack pointer .CSISP #RTGSPC,#RTDTYP,#RTIBUF ;Parse the string and options BCC 60$ ;It parsed successfully... CALL RTCSIE ;Report what was wrong MOV RTSPSV,SP ;Restore the stack pointer BR 40$ 60$: MOV (SP)+,R1 ;R1 = Count of options to process BEQ 150$ ;There are none... ; Here we process the options which are on the stack 70$: MOV (SP)+,R0 ;Get an option and its flags MOV #RTSWTB,R2 ;R2 -> Table of options 80$: TSTB @R2 ;End of option processing table? BNE 90$ ;Nope... MOV RTSPSV,SP ;Restore stack pointer .MSG <"Invalid option"> BR 40$ 90$: CMPB R0,@R2 ;Does option match this entry? BEQ 100$ ;Yep... ADD #SW.ESZ,R2 ;Nope, on to next entry BR 80$ 100$: BITB #SW$DEF,SW.OFG(R2) ;Does option have a default value? BEQ 110$ ;Nope... MOV SW.ODF(R2),@SW.OAD(R2) ;Yes, set the default value 110$: TST R0 ;Did option come with value? BPL 120$ ;Nope... MOV (SP)+,@SW.OAD(R2) ;Yes, use the specified value BR 140$ ; and go check for another option 120$: BITB #SW$REQ,SW.OFG(R2) ;No, does it require one? BEQ 130$ ;Nope... .MSG <"Option value not specified"> MOV RTSPSV,SP BR 40$ 130$: MOV #1,@SW.OAD(R2) ;At least set the option non-zero 140$: DEC R1 ;More options to process? BGT 70$ ;Yep... ; Okay, options are processed and we know the name of the ; file. Let's open it and get this show on the road... 150$: .LOOKU #RTAREA,#RTGCHN,#RTISPC ;Open the file BCC 160$ ;Got it... CALL RTLOOE ;Failed... report why JMP 40$ 160$: MOV R0,RTGFSZ ;Save size of game file CALL INPEND ;Ensure the timer is not running BIS #,@#$JSW ;Set TT lower case, ; special mode and inhibit IO wait .RCTRL ;Make it take affect RETURN .DSABL LSB .PSECT DATA,D,RW RTQELM: .BLKW ; : Pointer to extra Qelement space RTGSPC: .BLKW ; : RT Game filespecs (from CSI) RTISPC = ; : First input file spec RTDTYP: .RAD50 /DAT/ ; : Default input file type .WORD 0,0,0 ; : Default output file types (none) RTGFSZ: .BLKW ; : Size of game file in blocks GAMINI:: RETURN .SBTTL ZBLK - Read a page from game file to memory ;+ ; ; ZBLK ; Reads some amount of the game file from disk into memory. ; ; Call: ; BADDR -> Where to put data read from file ; BPAGE = Block number to read ; BCNT = Byte count ; ; Returns: ; none ; ; Errors: ; o Any read errors are reported, and result in program ; termination ; ; Notes: ; o Since RT does reads in units of words, the specified ; byte count has to be rounded up to an even number of ; bytes and then converted to words. ; ;- .PSECT CODE,I,RO .ENABL LSB ZBLK:: .DBG #D.RTRC,<"[ZBLK: BADDR = %P, BPAGE = %D., BCNT = %D. bytes]">,BADDR,BPAGE,BCNT MOV R0,-(SP) ;Save a few registers for awhile MOV R1,-(SP) ; ... MOV BCNT,R1 ;R1 = Count of bytes INC R1 ;Convert to number of words ASR R1 ; rounded up to a word boundary .READW #RTAREA,#RTGCHN,BADDR,R1,BPAGE ;Synchronous read BCS 10$ ; In case of any errors... MOV (SP)+,R1 ;Restore previously saved registers MOV (SP)+,R0 ; ... RETURN 10$: .MSG <"Read error %B on block %U(%U) of game file">,@#$ERRBY,BPAGE,RTGFSZ .MSG <"Execution terminated"> CALL ABORT ;Do some screen cleanup first JMP ZEXIT .DSABL LSB .SBTTL SAVOPN - Create a game save file ;+ ; ; SAVOPN ; Create a file and open a channel to it for use in ; saving the status of a game. ; ; Call: ; R0 -> Filename ; R1 = length of filename ; ; Return: ; C-bit = 0, file is open on channel RTSCHN ; C-bit = 1, file could not be opened ; RTSBLK initialized to zero ; ; Note: ; No options are processed for the save/restore file ; ;- .PSECT CODE,I,RO .ENABL LSB SAVOPN:: .DBG #D.RTRC,<"[SAVOPN: Filename string at %P, length = %D. characters]">,R0,R1 MOV R0,-(SP) ;Save some registers for awhile MOV R1,-(SP) ; ... MOV R2,-(SP) ; ... MOV R0,R1 ;Save pointer to filename MOV SP,RTSPSV ;Save the stack pointer .CSISP #RTSSPC,#RTSTYP,R1 ;Parse the filename MOV RTSPSV,SP ;*C* Restore stack pointer BCC 10$ ;No errors... CALL RTCSIE ;Report what was wrong BR 30$ 10$: .ENTER #RTAREA,#RTSCHN,#RTOSPC,#-1 ;Try to create the file BCC 20$ ;Success... CALL RTENTE ;Report what was wrong BR 30$ 20$: CLR RTSBLK ;Start with block 0 CLC ;Return success (Carry reset) BR 40$ 30$: SEC ;Return failure (Carry set) 40$: MOV (SP)+,R2 ;Restore previously saved registers MOV (SP)+,R1 ; ... MOV (SP)+,R0 ; ... RETURN .DSABL LSB .PSECT DATA,D,RW RTSSPC: .BLKW ; : Parsed filespecs (from CSI) RTOSPC = ; : File spec for game save/restore ; Note, input file spec is used for input on RESxxx, and output file ; spec on SAVxxx RTSTYP: .RAD50 /ZSG/ ; : Default input file type .WORD 0,0,0 ; : Default output file types (none) RTSBLK: .BLKW ; : Save/restore block number .SBTTL SAVBLK - Write a block to the save file ;+ ; ; SAVBLK ; Write a block of data to the game save file ; ; Call: ; R0 -> 512-byte block to write ; ; Return: ; registers preserved ; RTSBLK updated ; ; Errors: ; possible, but not yet checked. ; ;- .PSECT CODE,I,RO .ENABL LSB SAVBLK:: .DBG #D.RTRC,<"[SAVBLK: buffer = %P, block = %D.]">,R0,RTSBLK MOV R0,-(SP) ;Save some registers for awhile MOV R1,-(SP) ; ... MOV R0,R1 ;Save pointer to filename .WRITW #RTAREA,#RTSCHN,R1,#256.,RTSBLK ;Write a block of data INC RTSBLK ;On to next block MOV (SP)+,R1 ;Restore previously saved registers MOV (SP)+,R0 ; ... RETURN .DSABL LSB .SBTTL SAVCLO - Close the game save file ;+ ; ; SAVCLO ; Close the game save file... ; ; Call: ; none ; ; Return: ; registers preserved ; ; Errors: ; possible, but not yet checked. ; ;- .PSECT CODE,I,RO .ENABL LSB SAVCLO:: .DBG #D.RTRC,<"[Entered SAVCLO]"> MOV R0,-(SP) ;Save some registers for awhile .CLOSE #RTSCHN ;Close the game save channel MOV (SP)+,R0 ;Restore previously saved register RETURN .DSABL LSB .SBTTL RESOPN - Open a game save file ;+ ; ; RESOPN ; Open a channel to a game save file in preparation ; to restore a game state. ; ; Call: ; R0 -> Filename ; R1 = length of filename ; ; Return: ; C-bit = 0, file is open on channel RTSCHN ; C-bit = 1, file could not be opened ; RTSBLK initialized to zero ; ; Note: ; No options are processed for the save/restore file ; ;- .PSECT CODE,I,RO .ENABL LSB RESOPN:: .DBG #D.RTRC,<"[RESOPN: Filename string at %P, length = %D. characters]">,R0,R1 MOV R0,-(SP) ;Save some registers for awhile MOV R1,-(SP) ; ... MOV R2,-(SP) ; ... MOV R0,R1 ;Save pointer to filename MOV SP,RTSPSV ;Save the stack pointer .CSISP #RTSSPC,#RTSTYP,R1 ;Parse the filename MOV RTSPSV,SP ;*C* Restore stack pointer BCC 10$ ;No errors... CALL RTCSIE ;Report what was wrong BR 30$ 10$: .LOOKU #RTAREA,#RTSCHN,#RTOSPC ;Try to open the file BCC 20$ ;Success... CALL RTLOOE ;Report what was wrong BR 30$ 20$: CLR RTSBLK ;Start with block 0 CLC ;Return success (Carry reset) BR 40$ 30$: SEC ;Return failure (Carry set) 40$: MOV (SP)+,R2 ;Restore previously saved registers MOV (SP)+,R1 ; ... MOV (SP)+,R0 ; ... RETURN .DSABL LSB .SBTTL RESBLK - Read a block from game save file ;+ ; ; RESBLK ; Read a block of data from the game save file ; ; Call: ; R0 -> 512-byte block to read ; ; Return: ; registers preserved ; RTSBLK updated ; ; Errors: ; possible, but not yet checked. ; ;- .PSECT CODE,I,RO .ENABL LSB RESBLK:: .DBG #D.RTRC,<"[RESBLK: buffer = %P, block = %D.]">,R0,RTSBLK MOV R0,-(SP) ;Save some registers for awhile MOV R1,-(SP) ; ... MOV R0,R1 ;Save pointer to filename .READW #RTAREA,#RTSCHN,R1,#256.,RTSBLK ;Read a block of data INC RTSBLK ;On to next block MOV (SP)+,R1 ;Restore previously saved registers MOV (SP)+,R0 ; ... RETURN .DSABL LSB .SBTTL RESCLO - Close the game save file ;+ ; ; RESCLO ; Close the game save file... ; ; Call: ; none ; ; Return: ; registers preserved ; ; Errors: ; possible, but not yet checked. ; ;- .PSECT CODE,I,RO .ENABL LSB RESCLO:: .DBG #D.RTRC,<"[Entered RESCLO]"> CALLR SAVCLO ;It does exactly the same thing... .DSABL LSB .SBTTL SCROPN - Open a scripting (log) file for output ;+ ; ; SCROPN ; Create a file and open a channel to it for use in ; logging the events in a game (a script) ; ; Call: ; R0 -> Filename, NUL-terminated ; R1 = length of filename, not including the NUL ; ; Return: ; C-bit = 0, file is open on channel RTLCHN ; C-bit = 1, file could not be opened ; RTLBLK initialized to zero ; ; Note: ; o No options are processed for the logging file ; o If a scripting file is open and another request comes in, ; the old file is closed. ; ;- .PSECT CODE,I,RO .ENABL LSB SCROPN:: .DBG #D.RTRC,<"[SCROPN: Filename string at %P, length = %D. characters]">,R0,R1 TST RTLOFG ;Is a scripting file already open? BNE 10$ ;Nope... CALL SCRCLO ;Yes, first close it 10$: MOV R0,-(SP) ;Save some registers for awhile MOV R1,-(SP) ; ... MOV R2,-(SP) ; ... MOV R0,R1 ;Save pointer to filename MOV SP,RTSPSV ;Save the stack pointer .CSISP #RTSSPC,#RTLTYP,R1 ;Parse the filename MOV RTSPSV,SP ;*C* Restore stack pointer BCC 20$ ;No errors... CALL RTCSIE ;Report what was wrong BR 40$ 20$: .ENTER #RTAREA,#RTLCHN,#RTOSPC,#-1 ;Try to create the file BCC 30$ ;Success... CALL RTENTE ;Report what was wrong BR 40$ 30$: CLR RTLBLK ;Start with block 0, MOV #RTLBF,RTLBP ; initialize buffer pointer CLR RTLCFG ; reset the dirty buffer flag CLR RTLOFG ; and flag file as available (open) CLC ;Return success (Carry reset) BR 50$ ;*C* 40$: SEC ;Return failure (Carry set) 50$: MOV (SP)+,R2 ;*C* Restore previously saved regs MOV (SP)+,R1 ;*C* ... MOV (SP)+,R0 ;*C* ... RETURN .DSABL LSB .PSECT DATA,D,RW ; Note, input file spec is used for output in SCRxxx routines RTLTYP: .RAD50 /LOG/ ; : Default input file type .WORD 0,0,0 ; : Default output file types (none) RTLBLK: .BLKW ; : Scripting (log) block number RTLBP: .BLKW ; : Scripting (log) buffer pointer RTLCFG: .BLKW ; : Scripting (log) dirty buffer flag RTLOFG: .WORD . ; ; Scripting (log) file open RTLBF: .BLKB 512. ; : Scripting (log) buffer RTLBFE = . .SBTTL SCRBLK - Write a line to the scripting file ;+ ; ; SCRBLK ; Write a line of text to the scripting (log) file ; ; Call: ; R0 -> String to output to log file, NUL terminated ; R1 = Length of string, not including NUL ; ; Return: ; registers preserved ; RTLBLK updated ; ; Errors: ; On any write errors, the file is closed and marked as ; unavailable. ; ;- .PSECT CODE,I,RO ; ** ACTION ** If a write fails and it is because we have reached ; end of file, we could close out the old file, reopen ; it, open a new copy which is slightly larger, copy ; all the data out of the old file to the new one, and ; continue logging. .ENABL LSB SCRBLK:: .DBG #D.RTRC,<"[SCRBLK: buffer = %P, length = %D.]">,R0,R1 TST RTLOFG ;Is the file still available? BNE 30$ ;Nope... MOV R0,-(SP) ;Save some registers for awhile MOV R1,-(SP) ; ... MOV R2,-(SP) ; ... MOV R0,R1 ;R1 -> String to be logged MOV RTLBP,R2 ;R2 -> Current position in buffer CALL 50$ ;Log the string BCS 10$ ;In case of write error MOV #RTCR,R1 ;R1 -> String to be logged () CALL 50$ ;Log the string BCS 10$ ;In case of write error MOV R2,RTLBP ;Keep track of updated buffer pointer BR 20$ 10$: CALL SCRCLO ;Close the file on any errors 20$: MOV (SP)+,R2 ;Restore previously saved registers MOV (SP)+,R1 ; ... MOV (SP)+,R0 ; ... CLC ;*C* BR 40$ ;*C* 30$: SEC ;*C* 40$: RETURN ;*C* ; The following subroutine moves the characters of a nul-terminated ; string to the log file buffer, writing a block of data when the ; buffer fills. After it has written a block, it resets the buffer ; pointer to the beginning of the block, but keeps track of the fact ; that the buffer is 'dirty'. When all the characters have been ; copied to the buffer, the remainder of the buffer is filled with ; nulls and the block is written. 50$: TSTB @R1 ;End of string? BEQ 60$ ;Yep... MOVB (R1)+,(R2)+ ;Not yet... move a character CMP R2,#RTLBFE ;Have we filled a block? BLO 50$ ;Not yet... .WRITW #RTAREA,#RTLCHN,#RTLBF,#256.,RTLBLK ;Write a block of data BCS 90$ ;*C* In case of error... INC RTLBLK ;Bump the block number, MOV #RTLBF,R2 ; reset buffer pointer, MOV SP,RTLCFG ; set the 'dirty buffer' flag BR 50$ ; and continue where we left off 60$: TST RTLCFG ;Is the buffer dirty? BEQ 80$ ;Nope... MOV R2,-(SP) ;Save current buffer position MOV R2,R0 ;Set to determine how full buffer is SUB #RTLBF,R0 ;R0 = Count of characters in buffer NEG R0 ;Set to determine count of dirty bytes ADD #512.,R0 ;R0 = Count of bytes to clean 70$: CLRB (R2)+ ;Clean a byte DEC R0 ;More to do? BGT 70$ ;Yep... MOV (SP)+,R2 ;All done, restore pointer CLR RTLCFG ;Reset the 'dirty buffer' flag 80$: .WRITW #RTAREA,#RTLCHN,#RTLBF,#256.,RTLBLK ;Ensure all data to be ; logged has been written ;;; BCS 90$ ;*C* In case of error... 90$: RETURN ;*C* .DSABL LSB .PSECT DATA,D,RW RTCR: .ASCII <15><12><0> ; .EVEN .SBTTL SCRCLO - Close the script (log) file ;+ ; ; SCRCLO ; Close the script (log) file ; ; Call: ; none ; ; Return: ; registers preserved ; ; Errors: ; possible, but not yet checked. ; ;- .PSECT CODE,I,RO .ENABL LSB SCRCLO:: .DBG #D.RTRC,<"[Entered SCRCLO]"> MOV R0,-(SP) ;Save some registers for awhile .CLOSE #RTLCHN ;Close the script (log) file MOV SP,RTLOFG ; and flag file as unavailable MOV (SP)+,R0 ;Restore previously saved register RETURN .DSABL LSB .SBTTL RTCSIE - Report various CSI errors ;+ ; ; RTCSIE ; This routine is called after a CSI error in order to ; report what the problem was with the string. ; ; Call: ; none ; ; Return: ; none ; ; Errors: ; none ; ;- .PSECT CODE,I,RO .ENABL LSB RTCSIE: MOV R0,-(SP) ;Save R0 for awhile MOVB @#$ERRBY,R0 ;Get the error byte BNE 10$ ;Not error 0 .MSG <"Invalid file specification"> BR 30$ 10$: CMPB R0,#1 ;Is it due to a device? BNE 20$ ;Nope... .MSG <"Specified device is unavailable"> BR 30$ ; ** NOTE ** ; We should never get to this code 20$: .MSG <"Unexpected error from CSI"> 30$: MOV (SP)+,R0 ;Restore R0 RETURN .DSABL LSB .SBTTL RTENTE - Report various .ENTER errors ;+ ; ; RTENTE ; This routine is called after a .ENTER error in order to ; report what the problem was. ; ; Call: ; none ; ; Return: ; none ; ; Errors: ; none ; ;- .PSECT CODE,I,RO .ENABL LSB RTENTE: MOV R0,-(SP) ;Save R0 for awhile MOVB @#$ERRBY,R0 ;Get the error byte BNE 10$ ;Not error 0 .MSG <"Channel is in use"> BR 70$ 10$: CMPB R0,#1 ;Insufficient space on volume? BNE 20$ ;Nope... .MSG <"Insufficient space on volume"> BR 70$ 20$: CMPB R0,#2 ;Non-shareable device? BNE 30$ ;Nope... .MSG <"Non-shareable device already in use"> BR 70$ 30$: CMPB R0,#3 ;Protected file BNE 40$ ;Nope... .MSG <"Protected file already exists"> BR 70$ 40$: CMPB R0,#4 ;FSN not found? BNE 50$ ;Nope... .MSG <"File sequence number not found"> BR 70$ 50$: CMPB R0,#5 ;FSN invalid or name is null BNE 60$ ;Nope... .MSG <"Invalid file sequence number, or filename is null"> BR 70$ ; ** NOTE ** ; We should never get to this code 60$: .MSG <"Unexpected error from .ENTER"> 70$: MOV (SP)+,R0 ;Restore R0 RETURN .DSABL LSB .SBTTL RTLOOE - Report various .LOOKUP errors ;+ ; ; RTLOOE ; This routine is called after a .LOOKUP error in order to ; report what the problem was. ; ; Call: ; none ; ; Return: ; none ; ; Errors: ; none ; ;- .PSECT CODE,I,RO .ENABL LSB RTLOOE: MOV R0,-(SP) ;Save R0 for awhile MOVB @#$ERRBY,R0 ;Get the error byte BNE 10$ ;Not error 0 .MSG <"Channel is in use"> BR 50$ 10$: CMPB R0,#1 ;Was the file found? BNE 20$ ;Nope... .MSG <"File not found"> BR 50$ 20$: CMPB R0,#2 ;Non-shareable device? BNE 30$ ;Nope... .MSG <"File already open on non-shareable device"> BR 50$ 30$: CMPB R0,#5 ;Was it an invalid argument? BNE 40$ ;Nope... .MSG <"Invalid argument"> BR 50$ ; ** NOTE ** We should never get to this code 40$: .MSG <"Unexpected error from .LOOKUP"> 50$: MOV (SP)+,R0 ;Restore R0 RETURN .DSABL LSB .SBTTL ZEXIT - Exits program ;+ ; ; ZEXIT - Exit program. ; ; Do all eventual cleanup here. ; ; This is called from all over the place. ; One might argue that we could start over after getting here, ; but currently we are expected to return to the OS... ; ;- .PSECT CODE,I,RO .ENABL LSB ZEXIT:: .DBG #D.RTRC,<"[Entered ZEXIT]"> ; ** ACTION ** If we ever have the code fetch/release handlers for ; the game file or save/restore file, we'll need to ; do the release here... CALL INPEND ;Turn off any read timer .CLOSE #RTSCHN ;Close channel to save/restore file .CLOSE #RTGCHN ;Close channel to game file .EXIT .DSABL LSB .SBTTL ZALLOC - Allocate memory ;+ ; ; ZALLOC ; Allocate additional memory (extend the program-available ; space). ; ; Call: ; R0 = Number of bytes to allocate ; ; Return: ; R0 -> Allocated memory ; ; Errors: ; C-bit = 1, unable to extend program ; ; Notes: ; If this routine returns an allocation failure (carry set), ; it will not be called again. ; ;- .PSECT CODE,I,RO .ENABL LSB ZALLOC:: .DBG #D.RTRC,<"[ZALLOC: Requested size = %D. bytes]">,R0 INC R0 ;Round up to an even number BIC #1,R0 ; of bytes (so we allocate full words) ADD FREEPT,R0 ;R0 = New desired high limit BCS 30$ ;In case it wraps ! MOV R0,-(SP) ;Save address we are asking for .SETTO ;'Please, Sir, may I have some more?' CMP R0,(SP)+ ;Did we get what we asked for? BLO 20$ ;Nope... MOV FREEPT,-(SP) ;Save old high limit... MOV R0,FREEPT ;Set new program high limit MOV R0,END ; ... .DBG #D.RTRC,<"[ZALLOC: FREEPT = END = %P]">,FREEPT MOV (SP)+,R0 ;R0 -> Allocated memory .DBG #D.RTRC,<"[ZALLOC: Memory allocated at %P]">,R0 CLC ;Return success (Carry=0) BR 30$ 20$: .DBG #D.RTRC,<"[ZALLOC: Insufficient memory]"> SEC ;Return failure (Carry=1) 30$: RETURN .DSABL LSB .SBTTL CHESIZ - Get cache page size ;+ ; ; CHESIZ ; Get the cache page size. ; ; Call: ; None ; ; Return: ; R0 -> Cache page size (in bytes) ; ; Errors: ; None ; ; Notes: ; The routine is called before starting to allocate cache, ; and can be used to do preparatory work before calls to ; CHEALL is done. ; ;- .PSECT CODE,I,RO .ENABL LSB CHESIZ:: MOV #512.,R0 ; We have a simple cache model. RETURN .DSABL LSB .SBTTL CHEALL - Allocate a cache page. ;+ ; ; CHEALL ; Allocate a cache page. ; ; Call: ; None ; ; Return: ; R0 -> Cache page identifier (used in CHEUPD) ; R1 -> Cache page address ; ; Errors: ; C-bit = 1, Not able to allocate a cache page. ; ; Notes: ; If this routine returns with carry set, it will not ; be called again. Game will start if it have succeeded ; atleast once. Otherwise program will abort with a message. ; ;- .PSECT CODE,I,RO .ENABL LSB CHEALL:: .ALLOC ; .ALLOC defaults to 512 bytes. MOV R0,R1 ; ID and address are the same. RETURN ; C-bit was preserved from .ALLOC .DSABL LSB .SBTTL CHEUPD - Update cache page ;+ ; ; CHEUPD ; Update cache page. Reads in the requested page from ; disk. ; ; Call: ; R0 -> Cache page identified ; R2,R3 -> Virtual address requested ; ; Return: ; R0 -> Relative address within cache page ; R2,R3 -> Virtual base address of page ; ; Errors: ; None ; ; Notes: ; The requested block is calculated and read in from disk. ; ;- .PSECT CODE,I,RO .ENABL LSB CHEUPD:: MOV R3,-(SP) ; Save address for offset calc. ASHC #-9.,R2 ; Calculate block #. .BLK R0,R3 ; Read in block (default is 512 bytes) ASHC #9.,R2 ; Get base address of page. MOV (SP)+,R0 ; Get virtual address. SUB R3,R0 ; Calculate offset from page start. RETURN .DSABL LSB .SBTTL GETSCL - Return screen width (columns) ;+ ; ; GETSCL ; Return screen width (number of columns) ; ; Call: ; none ; ; Returns: ; R0 = Screen width (columns) ; ; Errors: ; none ; ; Notes: ; RT-11 does not maintain much information on the type of ; terminals attached. It would take a fair amount of code ; to properly determine that, so we don't attempt to (yet). ; For the time-being, we'll have to use the current width ; setting (via SET TT WIDTH=n). ; ;- .PSECT CODE,I,RO .ENABL LSB GETSCL:: ; ** ACTION ** Maybe ZINIT should somehow determine what kind of ; terminal we're running on and build a table of this ; info... .GVAL #RTAREA,#$TCFIG ;Get address of terminal config info ;;; BIT #VRUNV$,@#$JSW ;Are we running virtually? ;;; BEQ 10$ ;Nope... MOV R0,-(SP) ;Yes, stack the address ; ** NOTE ** PEEK doesn't allow odd addresses. It is fortunate that ; the terminal width is the low byte of the word. ADD #$TTWID,@SP ; and build address of width info .PEEK #RTAREA,(SP)+ ;Get terminal width from low memory BR 20$ ;Join common code 10$: MOVB $TTWID(R0),R0 ;Nope, use the setting 20$: BIC #^C<377>,R0 ; (avoiding sign-extension) BNE 30$ ;Non-zero is okay... MOV #80.,R0 ;Default to standard DEC screen width 30$: .DBG #D.RTRC,<"[GETSCL: returning %D. columns]">,R0 RETURN .DSABL LSB .SBTTL GETSLN - Return screen length (lines) dbug = 1 ;+ ; ; GETSLN ; Return the screen length (number of lines) ; ; Call: ; none ; ; Return: ; R0 = Number of lines ; ; Errors: ; none ; ; Notes: ; RT-11 does not maintain much information on the type of ; terminals attached. It would take a fair amount of code ; to properly determine that, so we don't attempt to. At ; this time, we simply return the length of a standard ; DEC VT100 (and many other model video terminals) length ; of 24. ; ;- ; ** ACTION ** If not a scope-type terminal, what would be a reasonable ; value to return here? .PSECT CODE,I,RO .ENABL LSB GETSLN:: MOV #24.,R0 ;Default to VT100 screen length .DBG #D.RTRC,<"[GETSLN: returning %D. lines]">,R0 RETURN .DSABL LSB .SBTTL GETSTP - Return terminal type ;+ ; ; GETSTP ; Return a value indicating the terminal type. ; ; Call: ; none ; ; Return: ; R0 = Terminal type code ; ; Errors: ; none ; ; Notes: ; o RT-11 does not maintain much information on the type of ; terminals attached. It would take a fair amount of code ; to properly determine that, so we don't attempt to (yet). ; If the terminal is set SCOPE, we return VT100 as the type. ; If the terminal is set NOSCOPE, we return unknown. ; ; This can be over-ridden by the /T:n option on the command ; line. ; ;- .PSECT CODE,I,RO RTTTMX =: VT500 ;Must be last terminal type definition ; (found in VMAC) .IIF NDF TERMDF TERMDF = VT100 .ENABL LSB GETSTP:: MOV RTOPTT,R0 ;Was terminal type specified? BEQ 10$ ;Nope...(or was specified as zero) CMP R0,#RTTTMX ;Yes, is it within range? BLOS 50$ ;Yes... 10$: .GVAL #RTAREA,#$TCFIG ;Get pointer to terminal config info ;;; BIT #VRUNV$,@#$JSW ;Are we running virtually? ;;; BEQ 20$ ;Nope... MOV R0,-(SP) ;Stack the address ; ** ACTION ** This may not work on earlier versions .PEEK #RTAREA,(SP)+ ;Get terminal config from low memory BR 30$ 20$: MOV @R0,R0 ;R0 = Terminal config word 30$: BIT #BKSP$,R0 ;Are we set SCOPE? BNE 40$ ;Yep... MOV #UNKT,R0 ;No, return unknown type BR 50$ 40$: MOV #TERMDF,R0 ;Default to desired terminal type 50$: .DBG #D.RTRC,<"[GETSTP: returning terminal type %D.]">,R0 RETURN .DSABL LSB .PSECT DATA,D,RW RTOPTT: .BLKW ; : Terminal type option DBUG = 0 ; In case we are doing partial debug ;+ ; Missing routines added by Johnny Billquist for ZEMU/RT to just ; compile and run. ;- .PSECT CODE GETAVO:: GETSOF:: GETCOL:: CLC RETURN .END .;.MODULE ZEMU,RELEASE=Y01,VERSION=17,COMMENT= .;+ .; .; Copyright (c) 2000 by Megan Gentry .; Framingham, Massachussetts .; All Rights Reserved .; Commercial use and Distribution Prohibited .; .; This software was developed for use with the Z-machine emulator by .; Johnny Billquist. In this context, rights are hereby granted by .; the author for the software to be freely copied and used in its .; entirety for any non-commercial purpose so long as the above .; copyright notice and these comments are preserved. .; .; The author has used best efforts in the research, design, development .; and testing of this software. The author makes no warranty of any .; kind, expressed or implied, with regard to this software and its .; suitability for a given application. The author shall not be liable .; in any event for incidental or consequential damages in connection .; with, or arising out of, the use or performance of this software. Use .; of this software constitutes acceptance of these terms. .; .; The author is committed to making a best effort at fixing any errors .; found in the software and welcomes any reports of problems, comments, .; or suggestions regarding the software at . .; .;- .;+ .; .; Portions Copyright (c) 2000 by Johnny Billquist .; .; Abstract: .; This command procedure is designed to build the Z-Machine .; Emulator, ZEMU, on either RT or RSX. .; .; Invocation: .; RT: IND ZEMU.CMD [option [option...]] [ [...]] .; RSX: @ZEMU [option [option...]] [ [...]] .; .; Where 'option' is one or more of the following: .; .; ALL causes all modules to be built .; .; NOALL disables the second-pass build of any missing required .; modules (disables the link phase if any required modules .; are unavailable) .; .; CONFIG executes only that portion of the command procedure which .; queries the user for configuration parameters. A .; configuration file is produced and no build is performed. .; .; NOCONFIG inhibits use of an existing configuration file .; .; EXPRESS performs an express build without asking the question .; .; FCSFSL (RSX) causes FCSFSL library to be used .; .; FCSRES (RSX) causes FCSRES library to be used .; .; ID (RSX) Link as a separate I/D task .; .; NOID (RSX) Link task without separated I/D .; .; LINK (default) requests executable to be built if possible .; .; NOLINK prevents an executable from being produced .; .; LIST (default) produces listing files .; .; NOLIST does not produce listing files .; .; MULTI (RSX) builds an image which reduces the amount of memory .; used by having only one copy of the RO psect regardless .; of the number of users using the program. .; .; Notes: .; This procedure is designed to be used by someone who simply .; wants the executable (express build), or by someone who is .; doing development/maintenance and needs to build an executable .; using a new source module without having to rebuild all the .; other modules. .; .; When 'express build' is selected (the default), all required .; object modules are built, the executable is built, and then .; all the object modules are deleted. .; .; If 'express build' is rejected, the procedure asks whether .; the user wishes to configure ZEMU. If so, various questions .; are asked about how ZEMU should be built and a configuration .; file reflecting these responses is created. .; .; The user is then asked if they wish to retain the object .; modules, whether they wish to obtain listing files (and if they .; wish a cross reference) and whether they wish a map file. If .; the appropriate devices have not been assigned on RT, the user .; will be queried about them as well. .; .; If any options or module names are specified on the command line .; which invokes the procedure, 'express build' is defaulted to .; and it is assumed that the user has made the appropriate .; assignments so that full commands with all outputs can be specified. .; .; If any modules required to build an executable are missing, they .; will be automatically built. .; .;- .;+ .; .; Edit History: .; .; (01/00) 26-Sep-2000 Megan Gentry .; Initial development .; .; (01/01) 27-Sep-2000 Megan Gentry .; Adding support RSX and the stubs for support under RSTS (and .; other PDP-11 OSes .; .; (01/02) 28-Sep-2000 Megan Gentry .; o Added code to allow user to obtain listing and/or map files .; o Added code to discard the .OBJs when done .; o Rolled in portions of ZEMURSX.CMD .; .; (01/03) 29-Sep-2000 Megan Gentry .; o Added changes relating to RSX due to review by Johnny Billquist .; Different commands for MCR vs. DCL .; o For express build on RT, defaults SRC, OBJ, etc, to DK .; .; (01/04) 02-Oct-2000 Megan Gentry .; o Added some consistency in label names .; o Added support for multiple RSX CLIs by simply saving the .; CLI at the beginning and forcing DCL (to make things .; more consistent) and then restoring the CLI at the end. .; .; (01/05) 02-Oct-2000 Megan Gentry .; o Code review revealed flaw in RSX-related assembly commands. .; .; (01/06) 03-Oct-2000 Megan Gentry .; o Changes due to testing on RSX by Johnny Billquist .; .; (01/07) 04-Oct-2000 Megan Gentry .; o More changes due to testing on RSX .; .; (01/08) 05-Oct-2000 Megan Gentry .; o Yet more changes, suggestions from Johnny Billquist .; o Added code for RT expert build to detect when a MAP or .; LST device is assigned to null and to disable those .; options to make the build faster. .; o Added NOLINK and NOALL as command line options .; .; (01/09) 12-Oct-2000 Megan Gentry .; o Adding support for creation of a conditional file based .; on responses from the user .; o Added information provided by responding with an .; at many prompts .; o Allow production of a configuration file without doing .; a build .; .; (01/10) 20-Oct-2000 Megan Gentry .; o Changed global symbols to local ones (mostly). Tried to .; standardize names .; .; (01/11) 23-Oct-2000 Megan Gentry .; o Corrected some problems with the RSX build .; o Added code to detect a pre-existing configuration file .; and to give the user the option of using it, setting .; new configuration parameters, or ignoring it. .; o Finally got multiple module expert build working .; .; (01/12) 25-Oct-2000 Megan Gentry .; o Fixed defaults for FCSFSL vs. FCSRES for express build .; .; (01/13) 26-Oct-2000 Megan Gentry .; o EXPRESS option, some documentation .; .; (01/14) 30-Oct-2000 Megan Gentry .; o Added support for new functionality in ZEMU -- scripting files. .; .; (01/15) 31-Nov-2000 Megan Gentry .; o Corrected code (again) which handles building missing modules. .; .; (01/16) 01-NOV-2000 Megan Gentry .; o Incorporated fixes from Johnny -- removed comments which .; include apostrophes since the RSX version of IND attempts .; to do a substitution. .; o Incorporated changes from Johnny -- changes to the build procedure .; for RSX so that the new scripting feature is included. .; .; (01/17) 01-Nov-2000 Megan Gentry .; o Added some RSX-specific options, FCSRES and FCSFSL so that .; an expert build on RSX can specify something other than the .; default. Also, ID vs NOID to enable (default) or disable .; linking as an ID executable. Also, MULTI to enable multi- .; user image (one copy of read-only PSECT). .; o Fixed procedure on RSX so that all errors will exit through .; a common point which restores the original CLI .; .;- .;+ .; .; To Be Done: .; o Mechanism for specifying program name .; .; o Mechanism for specifying definition file .; .; o Mechanism for specifying link-time libraries, and maybe .; invocation of command procedure which would build them .; when needed. .; .; o add code to remove options from parameter string once .; processed. .; .; o Options need to be somehow signified by '-' or '/' .; or something since smaller option names have an increased .; chance of being a substring of a module name. eg. 'OBJ' .; would be found in a string requesting the module ZOBJ .; .; or .; .; There needs to be a smarter parsing algorithm for options. .; .;- .; This is the initialization phase of the procedure .Enable Substitution,TimeOut,Global .Enable Escape .Disable Lowercase .SETF OS$IAS .SETF OS$RST .SETF OS$RSX .SETF OS$RMP .SETF OS$RT .SETF OS$VMS .IF EQ 3 .SETT OS$IAS .IF EQ 4 .SETT OS$RST .IF EQ 0 .OR .IF EQ 1 .SETT OS$RSX .IF EQ 2 .OR .IF EQ 6 .SETT OS$RSX .IF EQ 6 .SETT OS$RMP .IF EQ 7 .OR .IF EQ 10 .SETT OS$RT .IF EQ 5 .SETT OS$VMS .IFT OS$RSX .OR .IFT OS$RT .GOTO OSOKAY ; ; Unsupported operating system .EXIT .OSOKAY: .IFT OS$RT .Disable Octal,Prefix .IFT OS$RSX .Enable Decimal .; If the command line which invoked this procedure contains any .; parameters whatsoever, we assume that the user wants an expert .; build which will perform a build without any query. .SETF EXPERT .IF P1 NE "" .SETT EXPERT .; Get all parameters in one symbol .SETS PARAMS "" .TEST COMMAN .SETN STREND .TEST COMMAN " " .IF NE 0 .SETS PARAMS COMMAN[+1:'STREND'] .; Parse the parameters for recognized options .SETT OP$ALL .IFT EXPERT .SETF OP$ALL .TEST "'PARAMS'" "ALL" .IF NE 0 .SETT OP$ALL .TEST "'PARAMS'" "NOALL" .IF NE 0 .SETF OP$ALL .SETT OP$LNK .TEST "'PARAMS'" "LINK" .IF NE 0 .SETT OP$LNK .TEST "'PARAMS'" "NOLINK" .IF NE 0 .SETF OP$LNK .SETF OP$NCF .SETF OP$CFG .TEST "'PARAMS'" "NOCONFIG" .IF NE 0 .SETT OP$NCF .IFF OP$NCF .TEST "'PARAMS'" "CONFIG" .IFF OP$NCF .IF NE 0 .SETT OP$CFG .SETF EXPRES .TEST "'PARAMS'" "EXPRESS" .IF NE 0 .SETT EXPRES .IFT EXPRES .SETF EXPERT .SETF OP$FSL .TEST "'PARAMS'" "FCSFSL" .IF NE 0 .SETT OP$FSL .SETF OP$RES .TEST "'PARAMS'" "FCSRES" .IF NE 0 .SETT OP$RES .IFT OP$RES .AND .IFT OP$FSL ; .IFT OP$RES .AND .IFT OP$FSL ; Conflicting options FCSRES and FCSFSL .IFT OP$RES .AND .IFT OP$FSL .GOTO REPDON .SETF OP$NID .SETF OP$ID .TEST "'PARAMS'" "NOID" .IF NE 0 .SETT OP$NID .IFF OP$NID .TEST "'PARAMS'" "ID" .IFF OP$NID .IF NE 0 .SETT OP$ID .SETT OP$LST .TEST "'PARAMS'" "LIST" .IF NE 0 .SETT OP$LST .TEST "'PARAMS'" "NOLIST" .IF NE 0 .SETF OP$LST .SETF OP$MUL .TEST "'PARAMS'" "MULTI" .IF NE 0 .SETT OP$MUL .SETN $Error 0 .SETS STARS "****************************************************************" .; List the names of the source modules which comprise this program .SETS FI$SRC "ZEMU ZALU ZCTRL ZINTER ZIO ZMEM" .SETS FI$SRC "'FI$SRC' ZOBJ ZOPTAB ZPARSE ZPRINT ZSCREE ZPIC ZTEXT" .IFT OS$RSX .SETS FI$SRC "'FI$SRC' ZRSX" .IFT OS$RT .SETS FI$SRC "'FI$SRC' ZRT ZRTLIB" .; If we are running under RSX, then change our CLI to DCL so that we .; can use a common set of commands... we'll restore the CLI when it .; comes time to exit .IFF OS$RSX .GOTO NOCLI1 .SETS OP$CLI "''" MCR SET /CLI=TI:DCL .NOCLI1: .SETF FG$OBJ .SETF FG$LST .SETF FG$CRF .SETF FG$MAP .; For most RSX systems, default to FCSRES .SETT FG$RES .SETF FG$FSL .; For RSX-11M+, default to FCSFSL .IFT OS$RMP .SETF FG$RES .IFT OS$RMP .SETT FG$FSL .SETS CRSW "" .SETS IDSW "" .IFT FG$FSL .SETS IDSW "/ID" .SETS MUSW "" .GOSUB CHKLOG .IFT EXPERT .GOTO INOQ .IFT EXPRES .GOTO IFAST2 ; ; 'STARS' ; Build Procedure for ZEMU, The Z-Machine Emulator ; 'STARS' .Q1: ; .Ask [] EXPRES Do you wish to perform an express build of ZEMU .IFF .GOTO A1 ; ; If you select YES, this command procedure will build an executable ; copy of ZEMU appropriate for this system, using all defaults. If ; you select NO, you will be prompted for additional information ; before an executable is built. .GOTO Q1 .A1: .IFF EXPRES .GOTO IFAST1 .GOTO IFAST2 .; Here we do setup for an expert-mode build, in which the user wants .; specific modules built. .INOQ: .IFT OP$CFG .GOTO CONFIG .SETT FG$OBJ .SETT FG$LST .SETT FG$CRF .SETT FG$MAP .; Pick up any expert settings which may override defaults .IFF OP$LST .SETF FG$LST .IFF FG$LST .SETF FG$CRF .IFT OP$RES .SETT FG$RES .IFT OP$RES .SETF FG$FSL .IFT OP$FSL .SETF FG$RES .IFT OP$FSL .SETT FG$FSL .IFT OP$NID .SETS IDSW "" .IFT OP$ID .SETS IDSW "/ID" .IFT OP$MUL .SETS MUSW "/MU" .GOTO IFAST2 .IFAST1: .GOSUB CHKCND .IF FI$CND EQ "" .GOTO Q2 .Q2B: ; .ASK [] ANS Do you wish to use the existing configuration file .IFF .GOTO A2B ; ; An existing configuration file (possibly from a prior build) ; has been detected. You may select YES to use it unmodified, ; or NO if you wish to be given the option of specifying the ; configuration parameters. .GOTO Q2B .A2B: .IFT ANS .GOTO USECFG .SETT OP$NCF .Q2: ; .ASK [] ANS Do you wish to configure ZEMU .IFF .GOTO A2 ; ; If you answer YES you will be prompted for various ZEMU ; configuration parameters which will be placed in the file ; ZEMU.CND and used to build the executable. If you answer ; NO the defaults will be used. .GOTO Q2 .A2: .IFF ANS .GOTO NOCONF ; ; Help is available for these questions. Respond with ; an character (and hit ) and you will ; receive an explanation of the question and the responses. .CONFIG: .Q3: .SETS CF$GAM "" .IFF OS$RSX .GOTO A3 ; .SETS DF$GAM "LB:''" .IFT OS$RMP .SETS DF$GAM "LB:''" .ASKS [::"'DF$GAM'"] CF$GAM What is the location of the default game file directory .IFF .GOTO A3 ; ; This parameter allows one to specify a directory which will ; be the default directory which ZEMU will search for a specified ; game. .GOTO Q3 .A3: .Q4: .SETS CF$SAV "" .IFF OS$RSX .GOTO A4 .SETS DF$SAV "SY:.ZSG;0" .IFT OS$RMP .SETS DF$SAV "SYS$LOGIN:.ZSG;0" .ASKS [::"'DF$SAV'"] CF$SAV What is the default location and file type for saved games .IFF .GOTO A4 ; ; This parameter allows one to specify the default location and ; file type for saved games. .GOTO Q4 .A4: .Q4B: .SETS CF$SCP "" .IFF OS$RSX .GOTO A4B .SETS DF$SCP "SY:.LOG;0" .IFT OS$RMP .SETS DF$SCP "SYS$LOGIN:.LOG;0" .ASKS [::"'DF$SCP'"] CF$SCP What is the default location and file type for game script files (logs) .IFF .GOTO A4B ; ; This parameter allows one to specify the default location and ; file type for any script files. .GOTO Q4B .A4B: .Q5: ; .ASKN [2.:128.:128.] CF$CSZ What is the default cache size in pages .IFF .GOTO A5 ; ; This paramter selects the number of cache pages which the emulator ; will attempt to obtain from available memory. The larger the cache, ; the better the performance will be. .GOTO Q5 .A5: .Q6: ; .ASKN [512.:16384.:1024.] CF$SSZ What is the default size of the game stack .IFF .GOTO A6 ; ; Johnny - what can I say here? .GOTO Q6 .A6: .Q7: ; .ASKN [1:11.:1.] CF$IID What interpreter ID should be used .IFF .GOTO A7 ; ; This parameter establishes the value which is used by ; the ZEMU emulator to identify itself. ; ; 1 DECsystem-20 5 Atari ST 9 Apple IIc ; 2 Apple IIe 6 IBM PC 10 Apple IIgs ; 3 Macintosh 7 Commodore 128 11 Tandy Color ; 4 Amiga 8 Commodore 64 .GOTO Q7 .A7: .Q8: .SETN CF$TID 0 .IFF OS$RT .GOTO A8 ; .ASKN [0:8.:3] CF$TID What is the default terminal type .IFF .GOTO A8 ; ; This parameter sets the terminal type which will be used by ; ZEMU when the RT-11 console is SET SCOPE. The options are: ; ; 0 = Unknown ; 1 = VT52 5 = VT200 ; 2 = ANSI 6 = VT300 ; 3 = VT100 7 = VT400 ; 4 = VT102 8 = VT500 ; ; When the RT-11 console is SET NOSCOPE, type UNKNOWN will ; always be used. .GOTO Q8 .A8: .Q9: ; .ASK [] CF$EIS Do you wish to build ZEMU using EIS instructions .IFF .GOTO A9 ; ; If you answer YES the ZEMU emulator will be built using the ; EIS instructions. This can result in a performance increase, ; but results in an executable which can only be used on those ; PDP-11s which have the EIS instruction set. ; ; If you answer NO the ZEMU emulator will be built using those ; instructions which are available on all PDP-11s. This will ; result in an executable which can be used on any PDP-11, but ; one which will run more slowly. .GOTO Q9 .A9: .Q10: .SETF CF$ESO .IFT CF$EIS ; .IFT CF$EIS .ASK [] CF$ESO Do you wish to build ZEMU using an emulated SOB instruction .IFF .GOTO A10 ; ; On some PDP-11 machines, a DEC/BNE pair of instructions are ; actually faster than the EIS instruction SOB. ; ; If you answer YES the SOB will be emulated using DEC/BNE. ; If you answer NO, the true EIS SOB instruction will be used. .GOTO Q10 .A10: .Q11: ; .ASK [] CF$ZDB Do you wish to include debugging code .IFF .GOTO A11 ; ; The ZEMU emulator can be built with code which allows debugging. ; The code, although included, is not normally operative until ; selected through a command line option. ; ; If you answer YES the ZEMU emulator will be built with the ; debugging code included. This will result in a larger ; executable and a marginal affect to performance. It might ; also prevent larger games from being used. ; ; If you anwer NO the ZEMU emulator will be built without the ; debugging code included. This will result in a smaller ; executable. .GOTO Q11 .A11: .; Questions have been answered, now produce the file .OPEN #1 'L$SRC'ZEMU.CND .DATA #1 ; created at '