Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP Posting-Version: version B 2.10.2 9/17/84; site uvicctr.UUCP Path: utzoo!watmath!clyde!burl!ulysses!mhuxr!ihnp4!houxm!vax135!cornell!uw-beaver!ssc-vax!uvicctr!collinge From: collinge@uvicctr.UUCP (Doug Collinge) Newsgroups: net.sources Subject: Parameter mechanism for 6502 FIGForth Message-ID: <125@uvicctr.UUCP> Date: Tue, 21-May-85 02:20:06 EDT Article-I.D.: uvicctr.125 Posted: Tue May 21 02:20:06 1985 Date-Received: Fri, 24-May-85 01:57:47 EDT Distribution: net Organization: University of Victoria, Victoria B.C. Canada Lines: 328 : This is a shar archive. Extract with sh, not csh. echo x - letter cat > letter << '!Funky!Stuff!' Some people on net.lang.forth were excited by a feature of NEON that seemed old hat to me. This sharchive contains code that will run on 6502 FIGForth (and maybe others) that gives the parameter mechanism of NEON. The runtime stuff is written in 6502 for speed but you could recode it in anything else if you could only understand it... It sure makes writing and reading Forth a lot easier. In NEON you say: : HUMPTY { A B C / D E } ... ; In PROC you say: PROC DUMPTY P( A B C ) L( D E ) ... ; The small runtime overhead is generally less than the overhead incurred when using the Forth stack manipulation words like DUP and OVER. This code was written by Doug Collinge and David Harris about three years ago and has been in light, trouble-free use since then. No known problems but drop me a line if anything should show up... If you manage to make this work please send me mail about it - in fact send me mail anyway. Feel free to do anything you like with this code. If you make some money with it be sure to give us a kickback. Doug Collinge School of Music, University of Victoria, PO Box 1700, Victoria, B.C., Canada, V8W 2Y2 decvax!nrl-css!uvicctr!collinge decvax!uw-beaver!uvicctr!collinge ubc-vision!uvicctr!collinge !Funky!Stuff! echo x - procdoc cat > procdoc << '!Funky!Stuff!' Here is the documentation for CASES and PROC, such as it is. CASES: CASES is a pretty standard case construct. Use as follows: x CASES ( Takes x off the stack and selects a case ) n CASE ( This Forth code is evaluated iff x=n ) ESAC ( This Forth code is evaluated iff x ^= n ) n CASE ( This Forth code can never be evaluated ) m CASE ( This Forth code is evaluated iff x=m ) ESAC ( This Forth code is evaluated iff no cases were selected ) SESAC ( This Forth code is evaluated after any selected case or ) ( if no cases were selected ) Where: x, n, m are Forth code that evaluates to a single value on the stack. "R" may be used anywhere between CASES and SESAC to get the value of x, which is stored on the return stack. Some words in CASES have been coded in 6502 for speed. They may easily be replaced with their Forth equivalents. PROCS: PROCS is a wordset that gives parameters and local variables to Forth definitions. Use as follows: PROC BILLY-BOB P( A B ) L( C D ) A B + C ! A B - D ! C @ D @ * RETURN 5 3 BILLY-BOB . 16 OK This definition expects two numbers on the stack and stacks the product of their sum and difference. The words within P( ) define constants which can be used within the definition to refer to the items on the stack at the time the definition is evaluated. The order in which they appear is the order of the items on the stack with the last word referring to the topmost (most accessible) item. In the example, "A" refers to 5 and "B" refers to 3. The words within L( ) are defined as local variables which can be stored into or fetched from. These are not true variables - "!" or "@" MUST follow the variable name and are decoded at compile time. This is to prevent addressing the stack and speeds things up a bit. In the example "C" and"D" refer to local variables. Anything left on the stack when RETURN is encountered is what is returned by the definition. In the example "C @ D @ *" leaves 16 on the stack and 16 is returned by "BILLY-BOB". Either or both of P( ) and L( ) may be omitted. If both are omitted the definition is equivalent to a colon definition. A small fixed overhead is incurred when entering and leaving a PROC definition. This overhead is usually less than the overhead involved in normal Forth stack manipulation using "SWAP", "DUP", "ROT", etc. The resulting code is far easier to write and read. UNDER THE HOOD: The code is pretty gory. It will be incomprehensible to anyone but Forth gurus. "PROC" compiles a normal header with a CFA determined by whether L( ) is present. The CFA is left blank and is later filled in by RETURN. The CFA code makes use of a pointer called the stack frame "SF", which is pushed on the return stack on entry. SF is then set to the value of the stack pointer, "SP". If L( ) is present the CFA code adjusts the SP to make enough room for the local variables. The number of bytes to reserve is given in a postbyte of the CFA. "P(" reads words out of the input and generates immediate words into the dictionary. These words compile a reference to code that makes reference into the stack relative to SF and independent of SP. There are several runtime words predefined so that a reference to the top four items on the stack takes only two bytes. If there are more than four parameters on the stack it takes three bytes: two for the reference and a byte giving the offset from SF. "L(" is similar to "P(" but generates immediate words that look in the input for "!" or "@". When one of these words is executed at compile time is looks at the next word. If it is "!" it compiles a reference to runtime code that stores the top of the stack to the stack relative to SF. If it sees "@" it compiles a reference to code that fetches from the stack relative to SF. The immediate words compiled into the dictionary by P( and L( do not take up space after the definition is closed. They are compressed out by RETURN. RETURN also determines which CFA code to use and plugs in the correct reference. It compiles a reference to code which moves the items above the SF down to below the first parameter, thus eliminating all parameters and local variable space on the stack. It then unstacks the previous stack frame and stores it in SF. !Funky!Stuff! echo x - procs cat > procs << '!Funky!Stuff!' ( DJC CASES ) HEX ASSEMBLER CODE R=IF ( BRANCHES IF R = STACK ) XSAVE STX, TSX, TXA, TAY, XSAVE LDX, INX, INX, 101 ,Y LDA, BOT 2 - CMP, 0= NOT IF, 0 # LDY, ' BRANCH JMP, ENDIF, 102 ,Y LDA, BOT 1 - CMP, 0= NOT IF, 0 # LDY, ' BRANCH JMP, ENDIF, ' 0BRANCH 8 + JMP, CODE RDROP PLA, PLA, NEXT JMP, ( DROP A WORD FROM R STACK) ( ..DJC CASES ) FORTH DECIMAL : CASES 5 COMPILE >R 0 ; IMMEDIATE : CASE COMPILE R=IF HERE 0 , 2 ; IMMEDIATE : ESAC COMPILE BRANCH ROT , [COMPILE] ENDIF HERE 2 - ; IMMEDIATE : SESAC ?COMP BEGIN DUP WHILE DUP @ SWAP HERE OVER - SWAP ! REPEAT DROP 5 ?PAIRS COMPILE RDROP ; IMMEDIATE ;S ( DJC PROC: NLOCALS,NPARMS,PROC ) HEX 00FC CONSTANT SF ( STACK FRAME POINTER) 0 VARIABLE NLOCALS ( NUMBER OF LOCAL VARIABLES) 0 VARIABLE NPARMS ( NUMBER OF PARMS DEFINED ) : DUMMY ; ' DUMMY CFA @ FORGET DUMMY CONSTANT DOCOL : PROC ( HEADER FOR THIS KIND OF DEFINITION) ?EXEC !CSP CURRENT @ CONTEXT ! 0 NPARMS ! 0 NLOCALS ! ( INIT COUNTS ) HERE ( SAVE PROC'S NFA TO RESET LATEST IN RETURN) CREATE -2 ALLOT DOCOL , HERE HERE ( PFA ADDR , CODE START ) ] ( ENTER COMPILE MODE) ; IMMEDIATE ( DJC PROC: PROLOGUES ) ASSEMBLER : INC16, ( MACRO TO INCREMENT 16 BITS WORD BY 1 ) >R R ASSEMBLER INC, 0= IF, R> 1+ INC, ENDIF, ; CODE (PROC) ( FOR PROCS WITHOUT LOCALS ) SF LDA, PHA, ( PUSH STACK FRAME ) SF STX, SF 1+ STY, ( ESABLISH STACK FRAME ) DOCOL JMP, ( GOTO REGULAR PROLOGUE ) CODE (PROCL) ( FOR PROCS WITH LOCALS; INLINE LOCS SIZE BYTE ) SF LDA, PHA, SF 1+ STY, ( PUSH STACK FRAME & ZERO HI OF SF ) SEC, TXA, 2 # LDY, W )Y SBC, TAX, ( MAKE SPACE FOR LOCALS ) SF STX, ( ESTABLISH STACK FRAME ) W INC16, 0 # LDY, DOCOL JMP, ( GET PAST INLINE BYTE ) ( DJC PROC: ) HEX ASSEMBLER 0 VARIABLE (PN@)S 8 ALLOT ( VECTOR TO SAVE ADDRS OF 'S ) CODE (PN@) ( RUNTIME VERB TO LOAD RELATIVE TO SF) IP )Y LDA, IP INC16, TAY, HERE (PN@)S ! ( FIRST ONE HAS Y ALREADY 0 ) DEX, DEX, ( MAKE ROOM ON STACK ) SF )Y LDA, BOT STA, INY, SF )Y LDA, BOT 1+ STA, NEXT JMP, ( TO SAVE TIME AND SPACE SOME PARM RUNTIMES ARE BUILT IN ) HERE (PN@)S 2 + ! 2 # LDY, (PN@)S @ JMP, HERE (PN@)S 4 + ! 4 # LDY, (PN@)S @ JMP, HERE (PN@)S 6 + ! 6 # LDY, (PN@)S @ JMP, HERE (PN@)S 8 + ! 8 # LDY, (PN@)S @ JMP, ( DJC PROC: PARMN ) FORTH DECIMAL : PARMN ( CALLED AT COMPILE TIME TO COMPILE RUN VERB) NLOCALS @ NPARMS @ + SWAP - DUP + DUP 8 > 0= IF (PN@)S + , ELSE COMPILE (PN@) C, ENDIF ; ( DJC PROC: ) HEX ASSEMBLER 0 VARIABLE (PN!)S 8 ALLOT ( VECTOR TO SAVE ADDRS OF 'S ) CODE (PN!) ( RUNTIME VERB TO STORE RELATIVE TO SF) IP )Y LDA, IP INC16, TAY, HERE (PN!)S ! ( FIRST ONE HAS Y ALREADY 0 ) BOT LDA, SF )Y STA, BOT 1+ LDA, INY, SF )Y STA, INX, INX, NEXT JMP, ( TO SAVE TIME AND SPACE SOME PARM RUNTIMES ARE BUILT IN ) HERE (PN!)S 2 + ! 2 # LDY, (PN!)S @ JMP, HERE (PN!)S 4 + ! 4 # LDY, (PN!)S @ JMP, HERE (PN!)S 6 + ! 6 # LDY, (PN!)S @ JMP, HERE (PN!)S 8 + ! 8 # LDY, (PN!)S @ JMP, ( DJC PROC: LOCALN ) FORTH HEX : LOCERR ." @ OR ! AFTER LOCAL!" QUIT ; : LOCALN ( CALLED AT COMPILE TIME TO COMPILE RUN VERB) NLOCALS @ SWAP - DUP + BL WORD HERE C@ 1 = 0= IF LOCERR ENDIF HERE 1+ C@ CASES 40 ( @ ) CASE DUP 8 > 0= IF (PN@)S + , ELSE COMPILE (PN@)S C, ENDIF ESAC 21 ( ! ) CASE DUP 8 > 0= IF (PN!)S + , ELSE COMPILE (PN!)S C, ENDIF ESAC LOCERR SESAC ; ( DJC PROC: P( ) FORTH HEX : P( ( CREATE A SEQUENCE OF PARM VERBS ) BEGIN CREATE LATEST C@ 1F AND 1 = ( CHECK FOR ONE CHAR ) LATEST 1+ C@ 7F AND 29 = AND 0= WHILE ( STOP IF CLS PAREN) -2 ALLOT DOCOL , ( MAKE A COLON DEF) COMPILE LIT NPARMS @ 1+ DUP NPARMS ! , ( MAKE PARM# AVAIL) COMPILE PARMN COMPILE ;S SMUDGE IMMEDIATE ( COMP IN PARMN) REPEAT LATEST DP ! LATEST PFA LFA @ CURRENT @ ! ( FORGET CLS) DROP HERE ( REMEMBER START OF PROC BODY FOR RETURN) ; IMMEDIATE ( DJC PROC: L( ) FORTH HEX : L( ( CREATE A SEQUENCE OF LOCAL VERBS ) BEGIN CREATE LATEST 1+ C@ A9 = 0= WHILE ( STOP IF CLS PAREN) -2 ALLOT DOCOL , ( MAKE A COLON DEF) COMPILE LIT NLOCALS @ 1+ DUP NLOCALS ! , ( MAKE LOCAL# AVAIL) COMPILE LOCALN COMPILE ;S SMUDGE IMMEDIATE ( COMP IN PARMN) REPEAT LATEST DP ! LATEST PFA LFA @ CURRENT @ ! ( FORGET CLS) DROP HERE ( REMEMBER START OF PROC BODY FOR RETURN) ; IMMEDIATE ( DJC PROC:RETURNS) HEX ASSEMBLER CODE (RETRN) ( PUSH WHAT REMAINS ON STACK BELOW PARMS) XSAVE STX, IP )Y LDA, CLC, SF ADC, TAX, SF LDY, ( FIND WHERE) BEGIN, DEY, XSAVE CPY, CS WHILE, ( MOVE BYTES) DEX, 0 ,Y LDA, 0 ,X STA, CS NOT ENDREP, ( FORCED BRANCH) PLA, IP STA, PLA, IP 1+ STA, ( CODE FOR ; ) PLA, SF STA, NEXT JMP, ( RESTORE STACK FRAME & CONTINUE) ( DJC PROC: RETURN ) DECIMAL FORTH : RETURN ( EXPECTS PFA OF PROC, ADDR OF CODE BODY ) ( PLUG IN PROPER PROLOGUE INTO PROC'S CFA ) OVER CFA ( GET CFA OF PROC ) NLOCALS @ IF ( THERE ARE LOCALS THEN USE PROCL ) ' (PROCL) SWAP ! ( PLUG IN NEW CFA ) SWAP DUP NLOCALS @ DUP + SWAP C! 1+ SWAP ( INLINE FOR PROCL) ELSE ( NO LOCALS ) NPARMS @ IF ( PARMS: USE PROC ) ' (PROC) SWAP ! ELSE ( NO LOCS, NO PARMS: USE : ) DOCOL SWAP ! ENDIF ENDIF ( DJC PROC: RETURN ) DECIMAL FORTH ( GENERATES PROPER EPILOGUE AND RELOCATES PROC'S BODY ) NLOCALS @ NPARMS @ + -DUP 0= IF ( NO PARMS, NO LOCALS: USE ;S ) DROP DROP COMPILE ;S ELSE ( MUST USE RETURN AND SQUISH UP BODY OF CODE ) COMPILE (RETRN) DUP + C, ( INLINE IS BYTES TO DEALLOCATE ) OVER OVER SWAP OVER HERE SWAP - CMOVE ( SQUISH UP CODE ) - ALLOT ( FIX UP DICT POINTER ) CURRENT @ ! ( SAVE AS LATEST ) ENDIF [COMPILE] [ ( GET OUT OF COMPILE MODE ) SMUDGE ; IMMEDIATE ;S ( DJC PROC: EXAMPLE ) FORTH DECIMAL PROC BOB P( A B ) ( TAKES PARMS A & B ON STACK ) A . ." + " B . ." = " A B + . CR RETURN ( NOTHING'S ON STACK SO RETURN NOTHING ) ( JUST TRY TO DO THE FOLLOWING WITHOUT PROC! ) PROC TIM P( A B ) L( X Y ) ( LOCAL VARIABLES X & Y ) A B + X ! A B - Y ! ( STORE TO LOCALS ) X @ Y @ * ( FETCH FROM LOCALS ) RETURN ( RETURN WHAT'S ON STACK ) ;S LOCAL VARIABLES ARE SPECIAL. THEY ARE NOT REGULAR VARIABLES. LOC VARS MUST BE FOLLOWED IMMEDIATLY BY EITHER @ OR !. THEY ARE STORED ON THE STACK AND DISAPPEAR WHEN THE PROC HAS FINISHED. !Funky!Stuff! exit 0 -- Doug Collinge School of Music, University of Victoria, PO Box 1700, Victoria, B.C., Canada, V8W 2Y2 decvax!nrl-css!uvicctr!collinge decvax!uw-beaver!uvicctr!collinge ubc-vision!uvicctr!collinge