PAGE SBTTL "--- X-OPS ---" ; ---- ; CALL ; ---- ; ENTRY: [NARGS] = 0 GCALL: LDX #15 ; FILL THE ARG-TYPE LIST LDA #%11000000 ; WITH "NO MORE ARGS" BYTES GCL: STA CTYPES,X DEX BPL GCL LDA #4 STA ADEX ; INIT BYTE INDEX STA ADEX2 ; AND ARG BYTE COUNTER GCL0: JSR NEXTPC ; GRAB AN ARGUMENT BYTE STA ABYTE ; SAVE IT HERE JMP GCL2 ; SKIP OVER 1ST SHIFT GCL1: LDA ABYTE ASL A ASL A STA ABYTE GCL2: AND #%11000000 ; MASK GARBAGE CMP #%11000000 ; LAST ARGUMENT? BEQ GCL3 ; YES, TIME TO DECODE ARGS LDX NARGS ; ELSE ADD THIS ARGUMENT STA CTYPES,X ; TO THE ARG-TYPE LIST INC NARGS ; UPDATE # ARGUMENTS DEC ADEX ; THIS ARG BYTE EMPTY? BNE GCL1 ; NO, GET NEXT ARG LDA #4 ; ELSE RESET STA ADEX ; ARGUMENT INDEX DEC ADEX2 ; DONE 4 ARG BYTES? BNE GCL0 ; NO, GET ANOTHER ; [CTYPES] HAS LIST OF ARG TYPES ; [NARGS] HAS # ARGUMENTS GCL3: LDA #0 ; RESET THE STA ADEX ; ARGUMENT INDEX STA ADEX2 ; AND STORAGE INDEX LDA NARGS ; CONTINUE ONLY IF BNE GCL4 ; [NARGS] <> 0 ; *** ERROR #12: NO CALL ADDRESS *** LDA #12 JMP GERROR GCL4: LDX ADEX ; GET ARG INDEX CPX NARGS ; OUT OF ARGS YET? BEQ GCL8 ; YES IF [X] = [NARGS] INC ADEX ; ELSE UPDATE THE INDEX LDA CTYPES,X ; GET A TYPE BYTE BNE GCL5 JSR GETLNG ; 00 = LONG IMMEDIATE JMP GCL7 GCL5: CMP #%01000000 BNE GCL6 JSR GETSHT ; 01 = SHORT IMMEDIATE JMP GCL7 GCL6: JSR GETVAR ; ELSE GET VARIABLE ; ARGUMENT IS NOW IN [VALUE] GCL7: LDX ADEX2 ; GET STORAGE INDEX LDA VALUE+LO ; MOVE LSB OF VALUE STA CARGS,X ; INTO [CARGS] LDA VALUE+HI ; ALSO MOVE STA CARGS+1,X ; MSB INX INX ; UPDATE THE STX ADEX2 ; STORAGE INDEX BNE GCL4 ; LOOP BACK FOR ANOTHER ARGUMENT ; ARGUMENTS IN [CARGS], # ARGUMENTS IN [NARGS] GCL8: LDA CARGS+LO ; IS CALL ADDRESS ORA CARGS+HI ; ZERO? BNE DOCALL ; NO, CONTINUE JMP PUTBYT ; ELSE RETURN THE ZERO IN [A] DOCALL: LDX OLDGSP ; SAVE [OLDGSP] TXA JSR PSHXA LDX GPCL ; AND [GPC] LDA GPCH JSR PSHXA ;*** LDX GPC0 JSR PSHXA ;*** LDA CARGS+LO ; RESET [GPC] STA GPCL LDA CARGS+HI STA GPCH LDA #0 ;*** STA GPC0 ; ALL FUNCTIONS START ON WORD BOUNDRIES ;*** STA GPCFLG ; AND ANNOUNCE CHANGE JSR NEXTPC ; GET # LOCALS IN FUNCTION STA ADEX ; SAVE HERE FOR REFERENCE STA ADEX2 ; AND HERE FOR COUNTING BEQ CALL2 ; IF ZERO, JUMP AHEAD LDA #0 STA J+LO ; INIT LOOP INDEX CALL1: LDY J+LO LDX LOCALS,Y ; GET LSB OF LOCAL INTO [X] LDA LOCALS+1,Y ; GET MSB INTO [A] JSR PSHXA ; PUSH [X/A] JSR NEXTPC ; GET MSB OF NEW LOCAL LDY J+LO STA LOCALS+1,Y ; MOVE MSB TO [LOCALS] JSR NEXTPC ; GET LSB OF NEW LOCAL LDY J+LO STA LOCALS,Y ; STORE LSB INY INY STY J+LO ; UPDATE STORAGE INDEX DEC ADEX2 ; ANY MORE LOCALS? BNE CALL1 ; YES, LOOP BACK CALL2: DEC NARGS ; ANY ARGS LEFT? BEQ CALL4 ; NO, SCRAM NOW ; PASS UP TO 15 [CARGS] TO [LOCALS] LDX #0 ; INIT LOOP INDEX CALL3: LDA CARGS+2,X ; GET LSB OF ARGUMENT STA LOCALS,X ; ASSIGN TO A LOCAL LDA CARGS+3,X ; SAME FOR STA LOCALS+1,X ; MSB INX ; POINT TO THE INX ; NEXT ENTRIES DEC NARGS ; OUT OF ARGS YET? BNE CALL3 ; NO, KEEP LOOPING ; PUSH # LOCALS CALL4: LDX ADEX ; # LOCALS KEPT HERE TXA JSR PSHXA LDA GSP ; REMEMBER WHERE WE ARE STA OLDGSP JMP MLOOP ; BACK TO MAIN LOOP ; --- ; PUT ; --- ; SET ITEM [ARG2] IN WORD-TABLE [ARG1] EQUAL TO [ARG3] ;GPUT: ASL ARG2+LO ; WORD-ALIGN ; ROL ARG2+HI ; [ARG2] ; JSR PCALC ;*** GPUT: CLC JSR PCALC ; GET ADDRESS INTO [I] ;*** LDA ARG3+HI STA (I),Y ; [Y] = 0 INY BNE PUTLSB ; BRANCH ALWAYS ; ---- ; PUTB ; ---- ; SET ITEM [ARG2] IN BYTE-TABLE [ARG1] EQUAL TO [ARG3] ;GPUTB: JSR PCALC ;*** GPUTB: CLC LSR ARG2+HI ; DIVIDE BY TWO TO ADJUST FOR BYTE POINTING ROR ARG2+LO ; LEAVE BIT 0 IN CARRY FOR PCALC JSR PCALC ;*** PUTLSB: LDA ARG3+LO STA (I),Y RTS ; ------------------ ; CALC "PUT" ADDRESS ; ------------------ PCALC: LDY #0 ; FOR INDEXING ;*** BCC PCALC1 ; TAKE CARE OF CARRY FROM GPUTB INY ;*** PCALC1: LDA ARG2+LO ; ADD ITEM OFFSET CLC ; TO TABLE ADDRESS ADC ARG1+LO ; FIRST LSB STA I+LO LDA ARG2+HI ; THEN MSB ADC ARG1+HI ICENT: CMP GPURE ; IS CODE IN G-PRELOAD? (ENTRY FOR ICALC) BCC USEGP ; YES, OK TO CHANGE CMP ISTART ; IS IT BELOW THE I-FILE? BCC PURERR ; CAN'T CHANGE PURE CODE! CMP IPURE ; IS IT ABOVE THE I-PRELOAD? BCS PURERR ; YES, UNCHANGEABLE! ; POINT TO BYTE IN I-PRELOAD SEC SBC ISTART ; STRIP OF V-OFFSET ;*** ASL I+LO ; *2 ROL A **** CLC ADC ICODE+HI ; MAKE IT ABSOLUTE STA I+HI ;*** PCALC2: RTS ;*** ; RTS ; POINT TO BYTE IN G-PRELOAD ;*** USEGP: ASL I+LO ; * 2 FOR 512 BYTE PAGES ROL A ;*** CLC ADC GCODE ; CALC ABSOLUTE ADDR STA I+HI ; IN G-PRELOAD RTS ; *** ERROR #9: PURITY VIOLATION *** PURERR: LDA #9 JMP GERROR ; ------ ; RANDOM ; ------ ; RETURN A RANDOM VALUE BETWEEN 1 AND [ARG1] GRAND: LDA ARG1+LO ; MAKE [ARG1] STA ARG2+LO ; A DIVISOR LDA ARG1+HI STA ARG2+HI JSR DORAND ; GET RANDOM BYTES STX ARG1+LO ; INTO [A] & [X] AND #%01111111 ; MAKE IT A POSITIVE STA ARG1+HI ; DIVIDEND JSR DIVIDE ; SIGNED DIVISION LDA REMAIN+LO ; GRAB THE REMAINDER STA VALUE+LO LDA REMAIN+HI STA VALUE+HI JSR INCVAL ; INCREMENT IT JMP PUTVAL ; AND RETURN THE RESULT ;------------------------------------- ; GITER: INITIALIZE ITERATION TABLE AT ; WORD-ADDRESS ARG1 ;------------------------------------- GITER: LDA #00 ; SET ARG4=0 FOR ICALC STA ARG4+LO STA ARG4+HI LDA ARG1+HI ; MOVE ARG1 TO ARG3 STA ARG3+HI LDA ARG1+LO STA ARG3+LO JSR ICALC ; THIS WILL ALSO CHECK PURITY VIOLATIONS LDA (I),Y ; GET NUMBER OF ENTRIES IN TABLE STA ITICN INY TYA ; INIT ICOUNT Y=1 A=1 STA (I),Y INC ARG4+LO ; POINT TO FIRST WORD OF FIRST ENTRY GITER1: JSR ICALC LDA (I),Y ; HIGH BYTE OF ICON ADDRESS PHA ; SAVE INY ; =1 LDA (I),Y ; LOWBYTE OF ADDRESS TAX PLA JSR GETI ; GET ICON INFORMATION LDA #0 LDY #6 STA (I),Y ; SET NEGATE FOR POSITIVE DISPLAY INY ; =7 LDA #1 STA (I),Y ; SET FIRST ITERATION=1 INY ; =8 LDA BSET STA (I),Y ; SAVE BSET INY ; =9 LDA ITERS STA (I),Y ; SAVE # OF ITERS INY ; =10 LDA IX1 STA (I),Y ; SAVE ICON WIDTH INY ; =11 LDA IY1 STA (I),Y ; SAVE ICON HEIGHTH JSR NXTENT DEC ITICN BNE GITER1 RTS ;------------------------ ; GDUMP : NOT IMPLIMENTED ; RETURN 0 ;------------------------ GDUMP: JMP RET0 ;------------------------- ; GLOAD : NOT IMPLIMENTED ; RETURN 0 ;------------------------ GLOAD: JMP RET0 END