PAGE STTL "--- X-OPS ---" ; ------ ; EQUAL? ; ------ ; IS [ARG1] = [ARG2] (OR [ARG3] OR [ARG4])? ZEQUAL: DEC NARGS ; DOUBLE-CHECK # ARGS LDA ARG1+LO ; FETCH LSB LDX ARG1+HI ; AND MSB OF [ARG1] CMP ARG2+LO ; TEST LSB OF [ARG2] BNE TRY2 ; NO GOOD, LOOK FOR ANOTHER ARG CPX ARG2+HI ; ELSE TRY MSB OF [ARG2] BEQ EQOK ; MATCHED! TRY2: DEC NARGS ; OUT OF ARGS YET? BEQ EQBAD ; YES, WE FAILED CMP ARG3+LO ; TRY LSB OF [ARG3] BNE TRY3 ; NO GOOD, LOOK FOR ANOTHER ARG CPX ARG3+HI ; HOW ABOUT MSB OF [ARG3]? BEQ EQOK ; YAY! TRY3: DEC NARGS ; OUT OF ARGS YET? BEQ EQBAD ; IF NOT ... CMP ARG4+LO ; TRY [ARG4] BNE EQBAD ; SORRY, CHUM CPX ARG4+HI ; MSB MATCHED? BNE EQBAD ; TOO BAD EQOK: JMP PREDS ; FINALLY MATCHED! EQBAD: JMP PREDF ; FAILURE (SNIFF!) ; ---------------------------- ; ICALL,ICALL1, ICALL2, IXCALL ; ---------------------------- ZICALL: ZICLL1: ZICLL2: ZIXCLL: LDA #1 ; SET FLAG FOR RETURNLESS CALL STA IRET BNE IENTR ; JMP OVER NORMAL SETTING ; ------------------- ; XCALL, CALL1, CALL2 ; ------------------- ZXCALL: ; DROP THROUGH ZCALL1: ; CALL RTN HANDLES ALL 4 KINDS ZCALL2: ; ---- ; CALL ; ---- ; BRANCH TO FUNCTION AT ([ARG1]*4), PASSING ; OPTIONAL PARAMETERS IN [ARG2]-[ARG4] ; ([ARG5]-[ARG8] FOR XCALL (EZIP)) ZCALL: LDA #0 STA IRET ; SET FLAG TO RETURN SOMETHING IENTR: LDA ARG1+LO ORA ARG1+HI ; IS CALL ADDRESS ZERO? BNE DOCALL ; NO, CONTINUE LDA IRET ; any ret value? BEQ Ij ; yes, so return a zero RTS ; otherwise, just end Ij: LDX #0 JMP PUTBYT ; ELSE RETURN THE ZERO IN [A] DOCALL: LDX OLDZSP+LO ; SAVE OLD STACK POINTER LDA OLDZSP+HI JSR PUSHXA LDA ZPCL ; AND LSB OF [ZPC] LDX IRET ; AND RETURN FLAG JSR PUSHXA ; ON THE Z-STACK LDX ZPCM ; SAVE MIDDLE 8 BITS LDA ZPCH ; AND TOP BIT OF [ZPC] JSR PUSHXA ; AS WELL ; FORM 16-BIT ADDRESS FROM [ARG1] LDA #0 ASL ARG1+LO ; MULTIPLY [ARG1] ROL ARG1+HI ; (BY 2) ROL A ; >BIT INTO [A] ASL ARG1+LO ; BY 4 (EZIP) ROL ARG1+HI ROL A STA ZPCH ; NEW >BIT OF [ZPC] LDA ARG1+HI ; GET NEW 0, just ignore! ORA ARG3+LO BEQ INTNF ; SAY NOT FOUND LDA NARGS ; IS THERE A RECORD SPEC? CMP #4 BEQ SET4 SETDEF: LDA #130 ; NO, SET DEFAULT STA ARG4+LO SET4: LDA ARG4+LO BEQ SETDEF ; GO BACK AND GET VALUE LDA #0 ; COMPARE BYTE OR WORD? ASL ARG4+LO ROL A ; PICK UP INDICATOR LSR ARG4+LO ; CLEAR FROM RECORD LENGTH STA TYPE ; BYTE (0) OR WORD (1) LDA TYPE ; SET FLAG BNE SETTBL LDA ARG1+LO ; IF ONLY BYTE, MOVE IT STA ARG1+HI ; TO FIRST BYTE CHECKED SETTBL: LDA ARG2+LO ; PICK UP TBL ADDR STA MPCL LDA ARG2+HI STA MPCM LDA #0 STA MPCH ; ONLY A WORD ADDR, SO IN 1ST 64K JSR VLDMPC INTLP: LDA MPCL ; HOLD START ADDR, MPC WILL BE A MESS STA VWCUR+0 LDA MPCM STA VWCUR+1 LDA MPCH STA VWCUR+2 JSR GETBYT ; GET 1ST BYTE CMP ARG1+HI ; DOES IT = THE VALUE LOOKING FOR? BNE INTNXT ; NO LDA TYPE BEQ INTFND ; ONLY COMPARING A BYTE SO FOUND! JSR GETBYT CMP ARG1+LO BEQ INTFND ; YES, FOUND IT INTNXT: LDA VWCUR+0 ; TO MOVE UP, JUST ADD CLC ; OFFSET FROM START OF THIS ADC ARG4+LO ; ENTRY STA MPCL BCC INEXT0 LDA VWCUR+1 ; PICK UP CARRY ADC #0 STA MPCM LDA VWCUR+2 ADC #0 STA MPCH JSR VLDMPC ; CROSSED PAGE SO RE-VALIDATE INEXT0: DEC ARG3+LO ; CHECKED ALL ENTRIES? BNE INTLP LDA ARG3+HI BEQ INTNF DEC ARG3+HI BNE INTLP INTNF: LDA #0 ; 0 = NOT FOUND STA VALUE+LO STA VALUE+HI JSR PUTVAL JMP PREDF ; FAILED! INTFND: LDA VWCUR+LO STA VALUE+LO ; AND SET TO RETURN THE VALUE LDA VWCUR+HI STA VALUE+HI JSR PUTVAL ; SEND IT BACK JMP PREDS ; AND SCREEM SUCCESS ; ---- ; BCOM ; ---- ; COMPLEMENT [ARG1] ZBCOM: LDA ARG1+LO EOR #$FF STA VALUE+LO LDA ARG1+HI EOR #$FF STA VALUE+HI JMP PUTVAL ; ----- ; COPYT ; ----- ZCOPYT: LDA ARG2+LO ; CHECK OUT WHAT'S TO BE DONE ORA ARG2+HI BNE ZC0 JMP CASE1 ; ZERO LENGTH BYTES OF SOURCE ZC0: LDA ARG3+HI CMP #$7F BCC CASE2 JMP CASE3 ; FORWARD COPY ; CASE2 - CHECK IF FORWARD OR BACKWARD COPY CASE2: LDA ARG1+HI ; IF SRC < DEST CMP ARG2+HI BCC CHK2 BEQ ZC1 JMP FRWRD ; NO ZC1: LDA ARG1+LO CMP ARG2+LO BEQ CHK2 BCS FRWRD ; NO CHK2: LDA ARG1+LO ; AND SRC + LENGTH > DEST CLC ADC ARG3+LO STA I+LO LDA ARG1+HI ADC ARG3+HI CMP ARG2+HI BCC FRWRD ; NO BNE BKWRD ; YES LDA I+LO CMP ARG2+LO BEQ FRWRD ; DEBUG, IF EQUAL REALLY LESS BCS BKWRD ; OVERLAPS SO DO BACKWARD COPY ; ELSE FALL THROUGH TO FORWARD COPY FRWRD: LDA #0 ; USE GETBYT CAUSE MAY BE STA MPCH ; BEYOND MAIN MEMORY LDA ARG1+HI STA MPCM LDA ARG1+LO STA MPCL JSR VLDMPC ; AND ALIGN TO CORRECT PAGE LDA ARG2+LO STA SPCL LDA ARG2+HI jsr SETPC ; get memory spot sta SPCH ; high part sty SPCBNK ; and the bank part LDA ARG3+LO STA J+LO LDA ARG3+HI STA J+HI FRLP: jsr DECJ bcc FRDUN ; CARRY CLEAR ON $FFFF jsr GETBYT jsr STASHB ; and save it jsr NEXTSPC ; and point to next one jmp FRLP FRDUN: rts BKWRD: LDA ARG3+LO ; DECR 1ST TO GET CORRECT OFFSET STA J+LO LDA ARG3+HI STA J+HI JSR DECJ LDA ARG1+LO ; SET TO END OF SOURCE & DEST. CLC ADC J+LO sta FPCL ; set up fetch pointer LDA ARG1+HI ADC J+HI jsr SETPC ; and get mem locations sta FPCH sty FPCBNK LDA ARG2+LO CLC ADC J+LO sta SPCL ; and now set up stash pointer LDA ARG2+HI ADC J+HI jsr SETPC ; and get me page/bank sta SPCH sty SPCBNK BKLP: jsr FETCHB ; get byte jsr STASHB ; and save it jsr PREVFPC ; going backwards jsr PREVSPC ; and here too jsr DECJ ; RETURNS CARRY CLEAR ON $FFFF bcs BKLP BKDUN: RTS ; ZERO LENGTH # OF BYTES OF SOURCE CASE1: LDA ARG1+LO STA SPCL ; set stash pointer LDA ARG1+HI jsr SETPC ; get page/bank sta SPCH sty SPCBNK LDA ARG3+LO ; SET UP COUNTER STA J+LO LDA ARG3+HI STA J+HI C1LP: jsr DECJ ; CARRY CLEAR WHEN J = $FFFF bcc C1DUN lda #0 jsr STASHB ; and zero it jsr NEXTSPC ; and point to next one jmp C1LP C1DUN: rts ; 2'S COMPLEMENT LENGTH (XOR + 1) THEN DO FORWARD COPY CASE3: LDA ARG3+LO EOR #$FF STA ARG3+LO LDA ARG3+HI EOR #$FF STA ARG3+HI INC ARG3+LO BNE GOFRWD INC ARG3+HI GOFRWD: JMP FRWRD ; --------- ; ASSIGNED? ; --------- ZASSND: LDA ARG1+LO ; COMPARE TO # OF OPTIONALS FROM LAST CALL CMP ASSVLU BCC DOYES ; IF LESS OR EQUAL, WAS ASSIGNED BEQ DOYES JMP PREDF DOYES: JMP PREDS ; ------------- ; LOGICAL SHIFT ; ------------- ; SHIFT ARG1, ARG2 BITS (LEFT IF ARG2 IS POS. RIGHT IF NEG.) ZSHIFT: LDA ARG1+LO ; SET UP FOR SHIFT STA VALUE+LO LDA ARG1+HI STA VALUE+HI LDA ARG2+LO ; IF NEGATIVE, SHIFT RIGHT CMP #$80 BCS SRIGHT ; SHIFT LEFT TAY ; COUNT SLP1: ASL VALUE+LO ROL VALUE+HI DEY BNE SLP1 JMP PUTVAL ; AND RETURN THE VALUE SRIGHT: EOR #$FF ; COMPLEMENT TAY SLP2: LSR VALUE+HI ; SHIFT ROR VALUE+LO DEY BPL SLP2 JMP PUTVAL ; ---------------- ; ARITHMETIC SHIFT ; ---------------- ; PROPAGATING SIGN BIT ON RIGHT SHIFT ZASHFT: LDA ARG2+LO ; IF NEGATIVE, SHIFT RIGHT CMP #$80 BCC ZSHIFT ; SAME AS LOGICAL SHIFT LDX ARG1+LO ; SET UP FOR SHIFT STX VALUE+LO LDX ARG1+HI STX VALUE+HI EOR #$FF ; COMPLEMENT COUNT TAY ASLP2: LDA ARG1+HI ASL A ; GET SIGN BIT ROR VALUE+HI ; SHIFT ROR VALUE+LO DEY BPL ASLP2 JMP PUTVAL ; -------- ; XPUSH ; -------- ZXPUSH: lda ARG2+LO ; get me the address of the LTABLE sta FPCL ; for munging with lda ARG2+HI ; this is page jsr SETPC ; get me actual page/bank sta FPCH ; set page sty FPCBNK ; and bank jsr FETCHB ; this is hi part of counter sta J+HI ; save it jsr NEXTFPC ; point to lo part jsr FETCHB ; get it sta J+LO ; thanx ora J+HI ; check for zero elements left bne ZXP0 ; yes, there is room at the inn jmp PREDF ; no room here! ZXP0: jsr FP2SP ; set up to stash back in beginning of LTABLE lda J+HI ; now the MSB sta K+HI ; and saved it lda J+LO ; save this sta K+LO ; save it ; ; now count this one and stash it into the table ; bne ZXP1 ; nope, dec okay dec J+HI ; decrement MSB ZXP1: dec J+LO ; and the LSB lda J+LO ; LSB first jsr STASHB ; saved it jsr PREVSPC ; point to MSB lda J+HI ; get it jsr STASHB ; saved it ; ; finally, we can save the arg into the stack ; asl K+LO ; make a word offset (*2) rol K+HI ; pick up carry maybe lda K+LO ; add in arg offset clc ; adding adc ARG2+LO ; figger offset sta SPCL ; this goes here for stashing lda K+HI ; now page adc ARG2+HI ; add in start of table jsr SETPC ; get me memory page sta SPCH ; page sty SPCBNK ; and bank lda ARG1+HI ; push MSB jsr STASHB ; saved jsr NEXTSPC ; point to next one lda ARG1+LO ; and now LSB jsr STASHB ; into the stack jmp PREDS ; show we worked good ;--------- ; ZFSTACK ;--------- ZFSTACK: dec NARGS ; how many args there? bne ZFS1 ; flush ARG2 stack ; ; pop from system stack ; lda ARG1+LO ; just add number to system counter clc ; adding adc ZSP+LO ; added sta ZSP+LO ; and saved lda ARG1+HI ; get hi part adc ZSP+HI ; add in hi part sta ZSP+HI ; save hi part rts ZFS1: lda ARG2+LO ; get LTABLE we are interested in sta FPCL ; set up FPC first lda ARG2+HI ; and page jsr SETPC ; tell me where sta FPCH ; save me where sty FPCBNK ; FPC all set jsr FP2SP ; have SPC point to stack too jsr FETCHB ; get MSB of counter sta J+HI ; save MSB jsr NEXTFPC ; point to LSB jsr FETCHB ; get LSB sta J+LO ; save LSB lda J+LO ; get LSB back clc ; get ready for add adc ARG1+LO ; add how many to get rid off sta J+LO ; save new counter lda J+HI ; get MSB adc ARG1+HI ; add MSB jsr STASHB ; save Msb of new counter jsr NEXTSPC ; point to LSB lda J+LO ; get lsb jsr STASHB ; okay, reset the counter rts ; ; no mouse stuff yet ; ZMINFO: ZMLIMIT: rts ZMENU: jmp PREDF ; no menu stuff either END