Jump to content

Open Club  ·  60 members

DASM
IGNORED

Higher Level Variable Abstraction


Andrew Davie

Recommended Posts

I've got some pretty interesting "higher-level" abstraction going in variable overlay usage.

By "variable overlay" I mean the re-use of zero page locations for transient variables, only needed in a local sense.

 

Here's some sample code...

 

    DEF checkPiecesBank
    SUBROUTINE

        VAR __x, 1
        VAR __bank, 1

    ; odd usage - switches between concurrent bank code

                ldx #15
.check          lda __bank
                sta SET_BANK_RAM
                ldy PieceSquare,x
                beq .nonehere

                stx __x

                jsr SAFE_GetPieceFromBoard
.fail           beq .fail
                cmp #-1
.fail2          beq .fail2

                ldx __x

.nonehere       dex
                bpl .check
                rts

 

So here, I needed two 1-byte zero-page variables, "__x" and "__bank". By convention, I add double-underscore to all variables which use a shared "overlay" area. Basically these two are defined as 1-byte variables at the start of the  "routine". A "routine" is defined using the "DEF" macro, which looks like this...

 

    MAC DEF               ; name of subroutine
BANK_{1}        SET _CURRENT_BANK         ; bank in which this subroutine resides
{1}                                     ; entry point
TEMPORARY_VAR SET Overlay
    ENDM

 

So, first this macro (DEF) defines a label which references the bank of the label. So we can easily switch banks based on names. Then it "instantiates" the label itself". The next line resets the "variable overlay" pointer to the start of the variable/overlay area. In this case, it's a buffer that's defined as the start of the shared/overlay variable area in zero page.

 

So back to the first bit of code, variables are defined using the "VAR" macro, which looks like this...

 

    ; Define a temporary variable for use in a subroutine
    ; Will allocate appropriate bytes, and also check for overflow of the available overlay buffer

    MAC VAR ; { name, size }
{1} SET TEMPORARY_VAR
TEMPORARY_VAR SET TEMPORARY_VAR + {2}

OVERLAY_DELTA SET TEMPORARY_VAR - Overlay
        IF OVERLAY_DELTA > MAXIMUM_REQUIRED_OVERLAY_SIZE
MAXIMUM_REQUIRED_OVERLAY_SIZE SET OVERLAY_DELTA
        ENDIF
        IF OVERLAY_DELTA > OVERLAY_SIZE
            ECHO "Temporary Variable", {1}, "overflow!"
            ERR
        ENDIF
        LIST ON
    ENDM

 

Now it may look complex, but it's pretty simple.

It is passed two parameters - the name of a variable, and the size of the variable.

 

It simply uses the variable overlay pointer to set the variable's address, and increments it by the variable size.

It then does some checks to make sure that we aren't using too many variables (or more particularly, bytes) and overflowing the overlay buffer.

 

that's it in a nutshell. 
Basically, define a subroutine using the DEF macro, and then define your temporary variables for use in that subroutine using the VAR macro. You can then use the variables as you wish, with the proviso of course that you need to be aware that those variables are transient and local to your subroutine and may get stomped on by any calls you do to routines which ALSO use transient/overlay variables.  Even so, it's super-handy to be able to just define local variables as you need them, right where you want to use them.

 

Here's some mockup code showing a typical usage....

    DEF SampleFunction
    SUBROUTINE

BUFSIZ = 10

    VAR __buffer, BUFSIZ
    VAR __ptr, 1

    ldx #BUFSIZ-1
    stx __ptr
    lda #0
.loop
    sta __buffer,x
    dex
    bpl .loop

; etc...

 

As a final note, the reason I have the "SUBROUTINE" line is that it "resets" the local labels (those starting with ".") at this point, which means I can re-use labels such as ".loop" and ".exit" and ".fail" in many subroutines without having to worry about coming up with new names. I know all labels are "local" to the subroutine. Highly recommended usage.

Edit: I would have put the "SUBROUTINE" inside the "DEF" macro, but it turns out that the macro code effectively does this already and exits the subroutine when the macro ends. So, it doesn't seem to work.

 

Edited by Andrew Davie
  • Like 2
Link to comment
Share on other sites

  • 3 weeks later...

An update to this. I am now using constructs like this in my code...

 

    DEF AddPiecePositionValue
    SUBROUTINE

        REFERENCED_BY AdjustMaterialPositionValue
        REFERENCED_BY DeletePiece
        VAR __pval3, 2
        VARIABLE_END AddPiecePositionValue

So, this is a subroutine called "AddPiecePositionValue"

At the start of each subroutine I have a "declaration block"

This block declares what routines call the subroutine, and then declares variables for the subroutine.

The variables "share" a common area of zeropage - the "overlay" area. The overlay area auto-adjusts to the correct size for the program.

 

Now what's happening?

First, "referenced_by" reserves space at the start of the overlay area for the subroutine doing the calling.

Let's have a look at "AdjustMaterialPositionValue"...

 

    DEF AdjustMaterialPositionalValue
    SUBROUTINE

    ; A move is about to be made, so  adjust material and positional values based on from/to and
    ; capture.

    ; First, nominate referencing subroutines so that local variables can be adjusted properly

        REFERENCED_BY alphaBeta
        REFERENCED_BY MakeMove
        REFERENCED_BY aiMoveIsSelected
        
        VAR __originalPiece, 1
        VAR __capturedPiece, 1

        VARIABLE_END AdjustMaterialPositionValue

 Mmh. Hey, now this is getting complex.

First it has three "REFERENCED_BY" declarations. What's happpening there?

Well, let's have a look at them...

 

    DEF alphaBeta

    ; Performs an alpha-beta search.
    ; The current 'level' is always considered in terms of maximising the evaluation
    ; To achieve minimisation for the opponent when being considered, the alpha/beta are negated
    ; and which is which is swapped between each ply

    ; pass...
    ; x = depthleft
    ; SET_BANK_RAM      --> current ply
    ; __alpha[2] = -alpha
    ; __beta[2] = -beta


        COMMON_VARS_ALPHABETA
        REFERENCED_BY selectmove
        VARIABLE_END alphaBeta

 

So, the first "alphaBeta" also has a referenced_by - it is called by "selectmove"

Let's go deeper...

 

    DEF selectmove
    SUBROUTINE
    
    ; x = depth to go to

;        bestMove = chess.Move.null()
;        bestValue = -99999
;        alpha = -100000
;        beta = 100000

        COMMON_VARS_ALPHABETA
        VARIABLE_END selectmove

OK, that's a bit different.

First, it has no "referenced_by", so this function isn't called by anything that uses shared/overlay variables.

But it does declare some variables in the macro "COMMON_VARS_ALPHABETA"

This is interesting - it defines some variables that are used across subroutines, but still in the overlay/temporary variable area.

How do we ensure that they don't get stomped on by other routines using the overlay area?

 

And that's what this is all about. Let's continue...

First the declaration of the shared variables is pretty simple...

 

    MAC COMMON_VARS_ALPHABETA

        VAR __bestMove, 1
        VAR __bestScore, 2
        VAR __alpha, 2
        VAR __beta, 2

    ENDM

Well, in my post above I explained how the VAR macro works. But basically here we are declaring/reserving variables in the overlay area - four of them... "__bestMove" 1 byte, "__bestScore" 2 bytes, "__alpha" 2 bytes, and "__beta" 2 bytes. They are auto-allocated space at the start of the overlay area because this is the first usage of VAR after the DEF macro. Remember, the DEF macro sets up everything for a subroutine.

Now, provided we do our COMMON_VARS_ALPHABETA call in the same place in our various routines that share those temporary variables, they will all have the same addresses in the overlay buffer and everything will work.  But that's not what this post is about. This post is about transient variables used only in a single routine, but making sure that transient variables are not stomped when you call a subroutine that also uses transient variables. And it's about efficiently allocating those variables in the overlay buffer so that minimum space is required and it all sizes automatically.

So, we've looked at "alphaBeta" - which was REFERENCED_BY'd in "AdjustMaterialPositionValue" - and at this point we have 4 variables declared, as above. Let's say that the address of "overlay" was $C0, then those variables are at $C0, $C1, $C3, $C5.  The next REFERENCED_BY is "MakeMove". Let's have a look at that one...

 

    DEF MakeMove
    SUBROUTINE

        REFERENCED_BY quiesce
        REFERENCED_BY alphaBeta
        VARIABLE_END MakeMove

OK, this is getting complex. So it seems. But not really!  I'm explaining in detail, but the summary/usage is easy.

So, anyway, "MakeMove" is referenced by "quiesce", and "alphaBeta" (already "done"). But first, let's look at quiesce...

 

    DEF quiesce
    SUBROUTINE

    ; We are at the lowest level of the tree search, so we want to only continue if there
    ; are captures in effect. Keep going until there are no captures.

    ; requriement: correct PLY bank already switched in
    ; --> savedBank too

        COMMON_VARS_ALPHABETA
        REFERENCED_BY alphaBeta
        VARIABLE_END quiesce


OK, there's that COMMON_VARS_ALPHABETA again. Note how it is the first VAR declaration in the subroutine. That is, the macro expands to the previously mentioned declaration of the 4 temporary variables. Because it is the first, the labels are given the same values. Now if we made some sort of mistake, and put another variable before the macro call, then the labels would end up with different values and we get an assembly error. I'll do that now just to show...

 

    DEF quiesce
    SUBROUTINE

    ; We are at the lowest level of the tree search, so we want to only continue if there
    ; are captures in effect. Keep going until there are no captures.

    ; requriement: correct PLY bank already switched in
    ; --> savedBank too

        VAR __forceError,1
        COMMON_VARS_ALPHABETA
        REFERENCED_BY alphaBeta
        VARIABLE_END quiesce

See I've declared "__forceError" - now let's assemble.... and we get the following errors...

 

BANK_FIXED.asm (1245): error: EQU: Value mismatch.
BANK_FIXED.asm (1245): error: EQU: Value mismatch.
BANK_FIXED.asm (1245): error: EQU: Value mismatch.
BANK_FIXED.asm (1245): error: EQU: Value mismatch.
BANK_FIXED.asm (1456): error: EQU: Value mismatch.
BANK_FIXED.asm (1456): error: EQU: Value mismatch.
BANK_FIXED.asm (1456): error: EQU: Value mismatch.
BANK_FIXED.asm (1456): error: EQU: Value mismatch.


Now that's pretty cool - we see each of the lines with the variable declarations at both points, showing that they don't have the same values. Which is exactly what we want - if they are shared between subroutines we want them to have the same address. So, firstly this method "locks" variables to an address and ensures you don't fuckup by putting them in the wrong place.

Now, back to what this is really about - and that's the transient variables.  Where were we... ? Looking at "quiesce" and we'd just talked about the COMMON_VARS_ALPHABETA declaration. So, just after that is the "REFERENCED_BY alphaBeta".  And now it's time to look closely at what that actually does. Here are the macros involved (a minor update to the VAR macro from above, too)....

 

    MAC VARIABLE_END ; {1}
VAREND_{1} = TEMPORARY_VAR
    ENDM


    MAC REFERENCED_BY ; {1}
        IF VAREND_{1} > TEMPORARY_VAR
TEMPORARY_VAR SET VAREND_{1}
        ENDIF
    ENDM



    ; Define a temporary variable for use in a subroutine
    ; Will allocate appropriate bytes, and also check for overflow of the available overlay buffer

    MAC VAR ; { name, size }
{1} = TEMPORARY_VAR
TEMPORARY_VAR SET TEMPORARY_VAR + TEMPORARY_OFFSET + {2}

OVERLAY_DELTA SET TEMPORARY_VAR - Overlay
        IF OVERLAY_DELTA > MAXIMUM_REQUIRED_OVERLAY_SIZE
MAXIMUM_REQUIRED_OVERLAY_SIZE SET OVERLAY_DELTA
        ENDIF
        IF OVERLAY_DELTA > OVERLAY_SIZE
            ECHO "Temporary Variable", {1}, "overflow!"
            ERR
        ENDIF
        LIST ON
    ENDM


Let's take them from the top. VARIABLE_END {name} is used at the end of every variable declaration block - even if you haven't declared a variable. That is, after all the REFERENCED_BY and COMMON_VAR stuff... and after the VAR stuff... then you put your VARIABLE_END.  And this simply sets a label with the function name that records the current position of the available byte in the overlay buffer. In other words, it's the address of the next free byte which is NOT used by this subroutine.  Now that becomes useful, because you can use it in the REFERENCED_BY macro to shift the current available byte in other subroutines so they don't stomp on variables used by this subroutine.

So, back to "quiesce" -- first it has its common variables, then it has the REFERENCED_BY declarations. After all of those (well, there's only one in this routine, but there can be many...).  well after those, then our temporary overlay "next free variable" pointer is pointing to the first unused byte that is not used by ANY of the referenced_by subroutines. That is, it takes into account all of the previous subroutines requirements. And all of those, in turn, take into account all of their previous subroutine requirements.  And in that way, we get automatic transient, easily declared and "impossible" to screw up use of shared zero page variables.

So, we're done with "quiesce" - in fact the variable declarations look like this in the listing...
 

      0  7e25					      DEF	quiesce
      1  7e25				   BANK_quiesce SET	_CURRENT_BANK
      2  7e25				   quiesce
      3  7e25				   TEMPORARY_VAR SET	Overlay
      4  7e25				   TEMPORARY_OFFSET SET	0
      5  7e25				   VAR_BOUNDARY_quiesce SET	TEMPORARY_OFFSET
      6  7e25				   FUNCTION_NAME SET	quiesce
      7  7e25					      SUBROUTINE
   1236  7e25					      SUBROUTINE
   1237  7e25
   1238  7e25							; We are at the lowest level of the tree search, so we want to only continue if there
   1239  7e25							; are captures in effect. Keep going until there are no captures.
   1240  7e25
   1241  7e25							; requriement: correct PLY bank already switched in
   1242  7e25							; --> savedBank too
   1243  7e25
      0  7e25					      COMMON_VARS_ALPHABETA
      1  7e25
      0  7e25					      VAR	__bestMove, 1
      1  7e25		       00 a0	   __bestMove =	TEMPORARY_VAR
      2  7e25				   TEMPORARY_VAR SET	TEMPORARY_VAR + TEMPORARY_OFFSET + 1
      3  7e25
      4  7e25				   OVERLAY_DELTA SET	TEMPORARY_VAR - Overlay
      5  7e25				  -	      IF	OVERLAY_DELTA > MAXIMUM_REQUIRED_OVERLAY_SIZE
      6  7e25				  -MAXIMUM_REQUIRED_OVERLAY_SIZE SET	OVERLAY_DELTA
      7  7e25					      ENDIF
      8  7e25				  -	      IF	OVERLAY_DELTA > OVERLAY_SIZE
      9  7e25				  -	      ECHO	"Temporary Variable", __bestMove, "overflow!"
     10  7e25				  -	      ERR
     11  7e25					      ENDIF
     12  7e25					      LIST	ON
      0  7e25					      VAR	__bestScore, 2
      1  7e25		       00 a1	   __bestScore =	TEMPORARY_VAR
      2  7e25				   TEMPORARY_VAR SET	TEMPORARY_VAR + TEMPORARY_OFFSET + 2
      3  7e25
      4  7e25				   OVERLAY_DELTA SET	TEMPORARY_VAR - Overlay
      5  7e25				  -	      IF	OVERLAY_DELTA > MAXIMUM_REQUIRED_OVERLAY_SIZE
      6  7e25				  -MAXIMUM_REQUIRED_OVERLAY_SIZE SET	OVERLAY_DELTA
      7  7e25					      ENDIF
      8  7e25				  -	      IF	OVERLAY_DELTA > OVERLAY_SIZE
      9  7e25				  -	      ECHO	"Temporary Variable", __bestScore, "overflow!"
     10  7e25				  -	      ERR
     11  7e25					      ENDIF
     12  7e25					      LIST	ON
      0  7e25					      VAR	__alpha, 2
      1  7e25		       00 a3	   __alpha    =	TEMPORARY_VAR
      2  7e25				   TEMPORARY_VAR SET	TEMPORARY_VAR + TEMPORARY_OFFSET + 2
      3  7e25
      4  7e25				   OVERLAY_DELTA SET	TEMPORARY_VAR - Overlay
      5  7e25				  -	      IF	OVERLAY_DELTA > MAXIMUM_REQUIRED_OVERLAY_SIZE
      6  7e25				  -MAXIMUM_REQUIRED_OVERLAY_SIZE SET	OVERLAY_DELTA
      7  7e25					      ENDIF
      8  7e25				  -	      IF	OVERLAY_DELTA > OVERLAY_SIZE
      9  7e25				  -	      ECHO	"Temporary Variable", __alpha, "overflow!"
     10  7e25				  -	      ERR
     11  7e25					      ENDIF
     12  7e25					      LIST	ON
      0  7e25					      VAR	__beta, 2
      1  7e25		       00 a5	   __beta     =	TEMPORARY_VAR
      2  7e25				   TEMPORARY_VAR SET	TEMPORARY_VAR + TEMPORARY_OFFSET + 2
      3  7e25
      4  7e25				   OVERLAY_DELTA SET	TEMPORARY_VAR - Overlay
      5  7e25				  -	      IF	OVERLAY_DELTA > MAXIMUM_REQUIRED_OVERLAY_SIZE
      6  7e25				  -MAXIMUM_REQUIRED_OVERLAY_SIZE SET	OVERLAY_DELTA
      7  7e25					      ENDIF
      8  7e25				  -	      IF	OVERLAY_DELTA > OVERLAY_SIZE
      9  7e25				  -	      ECHO	"Temporary Variable", __beta, "overflow!"
     10  7e25				  -	      ERR
     11  7e25					      ENDIF
     12  7e25					      LIST	ON
      6  7e25
      0  7e25					      REFERENCED_BY	alphaBeta
      1  7e25				  -	      IF	VAREND_alphaBeta > TEMPORARY_VAR
      2  7e25				  -TEMPORARY_VAR SET	VAREND_alphaBeta
      3  7e25					      ENDIF
      0  7e25					      VARIABLE_END	quiesce
      1  7e25		       00 a7	   VAREND_quiesce =	TEMPORARY_VAR
   1247  7e25

Interpreting all that, the variables are declared thusly;
 

      1  7e25		       00 a0	   __bestMove =	TEMPORARY_VAR
      1  7e25		       00 a1	   __bestScore =	TEMPORARY_VAR
      1  7e25		       00 a3	   __alpha    =	TEMPORARY_VAR
      1  7e25		       00 a5	   __beta     =	TEMPORARY_VAR

1  7e25		       00 a7	   VAREND_quiesce =	TEMPORARY_VAR


And we see that the first free byte in the "quiesce" routine is $A7.  In other words, 7 bytes in use.

Also, at this point, the maximum size of our overlay buffer is also 7 bytes. But let's continue. We're done with "quiesce" now back to...

uh... <scroll... scroll... scroll>... yes, let's bring that up again...

 

    DEF MakeMove
    SUBROUTINE

        REFERENCED_BY quiesce
        REFERENCED_BY alphaBeta
        VARIABLE_END MakeMove

So, we've done quiesce - and the first free byte in the overlay is $A7.  And we've declared all the temporary vars that it needed.  These just happened to include the common variables shared with "alphaBeta" via a macro call, but in any case we are now looking at "alphaBeta" again, and if you trace through all of that, you see that all it does is declare the variables again. The first free byte is still $A7, and the common variables are correctly defined with the same address.  We know what VARIABLE_END does - it just records that free variable address for each routine, so others can use it, right?  Rhetorical. Just making sure you're following.

OK, so all the way back to the first routine we were looking at.. "AdjustPiecePositionValue"...
 

    DEF AddPiecePositionValue
    SUBROUTINE

        REFERENCED_BY AdjustMaterialPositionValue
        REFERENCED_BY DeletePiece
        VAR __pval3, 2
        VARIABLE_END AddPiecePositionValue


We traced all the way down through the "REFERENCED_BY AdjustMaterialPositionValue" and it's got a couple of others there which will do exactly the same thing. If the free variable pointer is greater than the current value (after each of those REFERENCED_BY's) then it is adjusted. After all of them, we have (for the current subroutine) the pointer to free overlay memory.  So if we look at that subroutine again... there's only one thing left to describe (I think)...

And that is, that after the REFERENCED_BY declarations, you now can freely define the transient variables used just by this subroutine.  In this case, a two-byte variable called "__pval3".  In this case it happens to live at address...
 

      0  6020					      VAR	__pval3, 2
      1  6020		       00 a9	   __pval3    =	TEMPORARY_VAR

So there we go!  After automatically figuring out the variable requirements for the subroutines calling this one, the assembler has worked out that the temporary variable can safely be placed at address $A9.  But more to the point, it now says that this routine has effectively reserved variables in the overlay area from $A0-$AA (inclusive). That makes sure that a) none of the calling routine's variables (both shared, and transient) are stomped, and b) any subroutine that is referenced by this one (if any!) can know this simply by putting a "REFERENCED_BY AdjustMaterialPositionValue" in the declaration block as described.

Now it all seems very complex - and I guess it is - but usage is incredibly simple.

 

 

1) Declare subroutines using the DEF macro. This macro records (and makes available) the BANK of the label, and also sets up the various "internal" variables used for figuring out the overlay/transient variable allocations.

2) place common transients in macros, and instantiate them with the macro at the start of each subroutine.

3) Declare all subroutines that reference this one with a "REFERENCED_BY" statement

4) Declare local transient variables with the VAR macro

5) Terminate the declaration block with a "VARIABLES_END" macro.

 

If you stick to that, then you get incredible power and you'll basically never run out of zero page variables again.

 

As it happens, I needed 76 bytes of zero page for a graphics buffer (OMG WTF!!)  - which would normally be a killer. But I don't use that except when doing actual screen draw. So the majority of my variable usage shares this buffer, using the described overlay/transient methodology.

I really really really really like this system. I expect nobody else will actually use it - but at least now it is hopefully well-described and can give some others some ideas of the power of dasm and macros for this sort of memory management.



 

 

  • Like 1
Link to comment
Share on other sites

One other thing. I modified my local copy of DASM to explicitly tell me what variable/label values were changing - it was previously a nondescript/anonymous message that had no information...

INFO: Label '__pval3' changed from $00a0 to $00a9
INFO: Label 'VAREND_AddPiecePositionValue' changed from $00a2 to $00ab
INFO: Label '__originalPiece' changed from $00a0 to $00a7
INFO: Label '__capturedPiece' changed from $00a1 to $00a8
INFO: Label 'VAREND_AdjustMaterialPositionValue' changed from $00a2 to $00a9
INFO: Label 'VAREND_MakeMove' changed from $00a0 to $00a7

This is just showing the result of multiple passes "fixing" the transient variable locations as it "figures it all out".

Link to comment
Share on other sites

I should add... I didn't have to declare the common variables (twice, in this case). I could have just declared it the once in "alphaBeta". Because the other function has a "REFERENCED_BY alphaBeta" it will automatically "keep" those pre-existing variable declarations in the right place, and they can be used inside that function. But, to explicitly make it clear that the function uses them, I like to declare a "mirror" set inside each function.

  • Thanks 1
Link to comment
Share on other sites

  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...