SjASMPlus 1.07 Documentation [31.05.2007]


1. Introduction
1. License
2. What is it?
3. Main Features
4. Authors
5. Feedback
6. What's new?
2. Where to get and how to use
1. Packages
2. Command line
3. Source file format
3. Labels
1. Labels
2. Local labels
3. @ Labels
4. Temporary labels
4. Constants, expressions and other features
1. Numeric constants
2. Character and string constants
3. Expressions
4. Assembly language
5. Fake instructions
6. Real device emulation mode
7. Predefined defines
5. Pseudo-ops (aka Pseudo-instructions, Directives etc)
1. Simple example of usage
2. Almost complete list
3. Conditional assembly
4. Macro's
6. Structures
1. What is it?
2. Using
3. Instructions
4. Examples
7. Lua scripting
1. Why?
2. How to use?
3. SjASMPlus binded functions
4. Third-party embedded library(ies)
5. Example

Chapter 1. Introduction

1. License

SjASMPlus licensed under BSD license.

2. What is it?

SjASMPlus is Z80 Assembly Language Cross Compiler. It is available for Win32, DOS and FreeBSD(mainly 5.x) systems. It is based on SjASM source code by Sjoerd Mastijn (http://xl2s.tk)

3. Main Features

  • Z80/R800 documented and undocumented opcodes support

  • Very fast compilation: 1 million lines by 2-3 seconds on modern computer

  • Code inlining through colon (LD A,C:INC A:PUSH AF:IFDEF FX:LD A,D:ENDIF…)

  • Structures to define data structures in memory more easily (use STRUCT pseudo-op)

  • Conditional assembly

  • Macro definitions

  • Local labels

  • User’s messages

  • Temporary labels

  • Special mode

  • Defines and array of defines

  • Fake instructions as LD HL,DE (LD H,D:LD L,E) and more

  • Source and binary file inclusion

  • Multiline block comments

  • Multi file output and file updating

4. Authors

Special thanks to Sjoerd Mastijn, the author of SjASM.

Aprisobal - main programming, documentation, etc.

Thanks to:

  • Kurles/HS/CPU - additional programming;

  • Krystian Wlosek <kwlosek(at)gmail.com> - additional programming, Linux;

  • Ric Horne <Ric.Hohne@eads-ts.com> - bug fix patches.

And big thanks to all people, who helped me in development of the compiler!

5. Feedback

WWW: http://sjasmplus.sourceforge.net

E-Mail: aprisobal(at)tut.by or aprisobal(at)gmail.com

6. What's new?

31.05.2006 - 1.07 RC5bf
- Applied bugfix patches by Ric Hohne.
- Important bugfix of memory leak.
- Bugfix of strange crashes at several machines.
- Added yet another sample for built-in LUA engine. See end of this file.
- Added sources of CosmoCubes demo to the "examples" directory.
13.05.2006 - 1.07 RC5
- ALIGN has new optional parameter.
- Corrected bug of RAM sizing.
- Corrected bug of structures naming.
02.12.2006 - 1.07 RC4bf
- Corrected important bug in code generation functions of SjASMPlus.
28.11.2006 - 1.07 RC4
- Corrected bug with SAVEBIN, SAVETRD and possible SAVESNA.
- Add Makefile to build under Linux, FreeBSD etc.
12.10.2006 - 1.07 RC3
- SAVESNA can save 48kb snapshots
- Corrected DEFINE's bug.
- Corrected bug of incorrect line numbering.
28.09.2006 - 1.07 RC2
- SAVESNA works and with device ZXSPECTRUM48
- Added new device PENTAGON128
- In ZXSPECTRUM48 device and others attributes has black ink and white paper by default.
23.09.2006 - 1.07 RC1bf
- Corrected bug with _ERRORS and _WARNINGS constants
- Added error message, when SHELLEXEC program execution failed
17.09.2006 - 1.07 RC1
- 3-pass design 
- built-in Lua scripting engine 
- changed command line keys 
- documentation converted to HTML. 
- added new directives: DEVICE, SLOT, SHELLEXEC 
- added predefined constanst: _SJASMPLUS=1, _ERRORS and other 
- changed output log format. 
- and many many more.

Old SjASMPlus 1.06 log was removed.

Chapter 2. Where to get and how to use

1. Packages

You can grab last binaries and sources SourceForge project page: http://sourceforge.net/projects/sjasmplus/

Win32 package has:

  • sjasmplus.exe - the Win32 executable. This is out compiler and we will use it.

  • examples directory - some examples of use

  • documentation directory - documentation in various formats

DOS and FreeBSD versions has same files in their packages. Linux version you can compile using Makefile from sources package.

2. Command line

Usage:

sjasmplus [options] sourcefile(s)

Option flags as follows:

  --help                   Help information
  -i<path> or -I<path> or --inc=<path>
                           Include path
  --lst=<filename>         Save listing to <filename>
  --lstlab                 Enable label table in listing
  --sym=<filename>         Save symbols list to <filename>
  --exp=<filename>         Save exports to <filename> (see EXPORT pseudo-op)
 By output format (you can use it all in some time):
  --raw=<filename>         Save all output to <filename> ignoring OUTPUT pseudo-ops
  Note: use OUTPUT,LUA/ENDLUA and other pseudo-ops to control output
 Logging:
  --nologo                 Do not show startup message
  --msg=error              Show only error messages
  --msg=all                Show all messages (by default)
  --fullpath               Show full path to error file
 Other:
  --reversepop             Enable reverse POP order (as in base SjASM version)
  --dirbol                 Enable processing directives from the beginning of line
  --dos866                 Encode from Windows codepage to DOS 866 (Cyrillic)

3. Source file format

Lines in the source file should have the following form:

Label Operator Operand Comment

All fields are optional. Lines without label should start with whitespace. Operators and operands can be inlined:

      Operator Operand:Operator Operand:Operator Operand... Comment

Comments should start with ';' or '//'. Comment blocks start with '/*' and end with '*/'.

Example 2.1. 

; comment
// comment
 ld /* comment */ a,80
/*
 comment
*/
 ld /*
 but this won't be ld a,3!
 */ a,3


Chapter 3. Labels

1. Labels

Labels are case-sensitive and may be of any reasonable length, that is: up to about 70 characters. Label definitions should start on the beginning of a line, but don't have to be followed by a colon ':'. Generally labels should start with a letter or a underscore ('_'), the following characters may be chosen from letters, numbers and the following special symbols: '_', '.', '!', '?', '#' and '@'. Note that the '.' has special meaning, as it is used between module names, labels and local labels. The following are all legal and distinct labels:

Kip
KIP
Kip@@
MAIN.loop?

It is possible to use mnemonics, pseudo-ops and register names as labels but it is not advised to do so. Also note that the identifiers defined with the DEFINE pseudo-op use another name space.

2. Local labels

When there is a module definition (see module pseudo-op) all labels (except those starting with a '@') are local to that module. To use a label from outside the module use modulename.labelname, in this example: 'vdp.Cls' Labels starting with a '.' are also local to the previous non-local label.

Example 3.1. 

MODULE main
Main:                           ; main.Main
        CALL SetScreen          ; SetScreen
        CALL vdp.Cls            ; vdp.Cls
.loop:                          ; main.Main.loop
        LD A,(.event)           ; main.Main.event
        CALL ProcesEvent        ; label not found: main.ProcesEvent
        DJNZ .loop              ; main.Main.loop

    MODULE vdp
@SetScreen:               ; SetScreen
.loop                     ; vdp.SetScreen.loop
        RET
Cls:                      ; vdp.Cls
.loop                     ; vdp.Cls.loop
        DJNZ .loop        ; vdp.Cls.loop
        RET

    ENDMODULE
Main.event                ; main.Main.event
    BYTE 0


3. @ Labels

Labels starting with a '@' are not touched by the label processing and used 'as-is'. See 'SetScreen' in the previous example code.

Example 3.2. 

    MODULE xxx
Label      ; xxx.Label
.Local     ; xxx.Label.Local
@Label     ; Label
.Local     ; xxx.Label.Local => duplicate label error
@Label2    ; Label2
.Local     ; xxx.Label2.Local
@yyy.Local ; yyy.Local
yyy.Local  ; xxx.yyy.Local


4. Temporary labels

To keep the number of used labels reasonable it is possible to use numbers as labels. These labels can only be used as labels to jump to. To jump to these labels, use the number followed by an 'F' for forward branches or a 'B' for backward branches. Temporary labels should not be used within macro's.

Example 3.3. 

        ADD A,E
        JR NC,1F
        INC D
1       LD E,A
2       LD B,4
        LD A,(DE)
        OUT (152),A
        DJNZ 2B


Chapter 4. Constants, expressions and other features

1. Numeric constants

Numeric constants should always start with a digit or $, # or %. The following formats are supported:

12     decimal
12d    decimal
0ch    hexadecimal
0xc    hexadecimal
$c     hexadecimal
#c     hexadecimal
1100b  binary
%1100  binary
14q    octal
14o    octal

2. Character and string constants

Character constants are characters surrounded by single quotes. It is possible to use double quotes in some cases, but in general it is better to use single quotes. String constants are characters surrounded by double quotes. The following escape sequences are recognized:

\\ 92
\? 63
\' 39
\" 34
\A 7
\B 8
\D 127
\E 27
\F 12
\N 10
\R 13
\T 9
\V 11

Example 4.1. 

    BYTE "stringconstant"  ;
    BYTE 'stringconstant'  ;with single quotes escape sequences above (\N,\T..) will not work
    LD HL,'hl'
    LD HL,"hl" ; :(
    LD A,"7"   ; :(
    LD A,'8'   ; :)
    LD A,'\E'
    LD A,'"'
    LD A,"'"


3. Expressions

Expressions are evaluated in 32 bits in this version of SjASMPlus.

'$' represents the current program counter. '$$' represents the current page in the current slot in the real device emulation mode.

It is possible to use parenthesis '(' and ')' to override the precedence of the operators. The following operators may be used in expressions:

!     !x       logical not
~     ~x       complement
+     +x       does absolutely nothing :)
-     -x       minus
low   low x    low 8 bits of 16 bit value
high  high x   high 8 bits of 16 bit value
not   not x    logical not

*     x*y      multiplication
/     x/y      division
%     x%y      modulo
mod   x mod y  modulo

+     x+y      addition
-     x-y      subtraction

<<    x<<y     shift left
>>    x>>y     shift right signed
>>>   x>>>y    shift right unsigned
shl   x shl y  shift left
shr   x shr y  shift right signed

<?    x<?y     minimum
>?    x>?y     maximum

<     x<y      less than
>     x>y      greater than
<=    x<=y     equal or less than
>=    x>=y     equal or greater than

=     x=y      equal
==    x==y     equal
!=    x!=y     not equal

&     x&y      bitwise and
and   x and y  bitwise and

^     x^y      bitwise xor
xor   x xor y  bitwise xor

|     x|y      bitwise or
or    x or y   bitwise or

&&    x&&y     logical and

||    x||y     logical or

4. Assembly language

This version only accepts Z80 mnemonics. There are some additions to what I think is standard Z80:

  • '[' and ']' can be used in stead of '(' and ')' for indirections. So LD A,[HL] is the same as LD A,(HL).

  • IN F,(C) and OUT (C),0 and SLL/SLI can be used.

  • IXL (or LX, XL), IYL (or LY, YL), IXH (or HX, XH) and IYH (or HY, YH) registers are supported.

  • Can write code throught colon: ORG 100h:LD A,10:LD B,10:SUB B:RET:IFDEF AA:.....

  • JP HL, JP IX and JP IY may be used instead of JP (HL), etc.

  • EX AF,AF or EX AF or EXA may be used instead of EX AF,AF'.

  • R800's MULUB and MULUW are recognised (but won't work on Z80, of course:)

  • RLC, RRC, RL, RR, SLA, SRA, SLL (SLI), RES, SET undocumented instructions added.

    SET 4,(IX+4),C ; (aka LD C,SET 4,(IX+4)) is LD C,(IX+4) / SET 4,C / LD (IX+4),C
    RRC (IY),A     ; (aka LD A,RRC (IY+0))   is LD A,(IY)   / RRC A   / LD (IY),A
  • PUSH and POP can take register lists:

    PUSH AF,BC  ; push af / push bc
    POP  AF,BC  ; pop  af / pop  bc
  • and all other commands support this.

    LD A,B,B,D,D,H 
   /* this is:
     LD A,B
     LD B,D
     LD D,H
   */
   ;or you can write  LD A,B:LD B,D:LD D,H

5. Fake instructions

Of course the Z80 is only an 8 bit cpu, but sometimes ld hl,de would be nice. SjASMPlus now 'fakes' some instructions like that. This improves the readability of the source, but it might not be the fastest way to get the result. Also possibly some 'new' load instructions do affect the flags in ways you wouldn't expect. Anyway, here's the list:

  rl bc
  rl de
  rl hl
  rr bc
  rr de
  rr hl
  sla bc
  sla de
  sla hl
  sll bc
  sll de
  sll hl
  sli bc
  sli de
  sli hl
  sra bc
  sra de
  sra hl
  srl bc
  srl de
  srl hl

  ld bc,bc
  ld bc,de
  ld bc,hl
  ld bc,ix
  ld bc,iy
  ld bc,(hl)
  ld bc,(ix+nn)
  ld bc,(iy+nn)

  ld de,bc
  ld de,de
  ld de,hl
  ld de,ix
  ld de,iy
  ld de,(hl)
  ld de,(ix+nn)
  ld de,(iy+nn)

  ld hl,bc
  ld hl,de
  ld hl,hl
  ld hl,ix
  ld hl,iy
  ld hl,(ix+nn)
  ld hl,(iy+nn)

  ld ix,bc
  ld ix,de
  ld ix,hl
  ld ix,ix
  ld ix,iy

  ld iy,bc
  ld iy,de
  ld iy,hl
  ld iy,ix
  ld iy,iy

  ld (hl),bc
  ld (hl),de

  ld (ix+nn),bc
  ld (ix+nn),de
  ld (ix+nn),hl

  ld (iy+nn),bc
  ld (iy+nn),de
  ld (iy+nn),hl

  ldi bc,(hl)
  ldi bc,(ix+nn)
  ldi bc,(iy+nn)

  ldi de,(hl)
  ldi de,(ix+nn)
  ldi de,(iy+nn)

  ldi hl,(ix+nn)
  ldi hl,(iy+nn)

  ldi (hl),bc
  ldi (hl),de

  ldi (ix+nn),bc
  ldi (ix+nn),de
  ldi (ix+nn),hl

  ldi (iy+nn),bc
  ldi (iy+nn),de
  ldi (iy+nn),hl

  ldi a,(bc)
  ldi a,(de)
  ldi a,(hl)
  ldi b,(hl)
  ldi c,(hl)
  ldi d,(hl)
  ldi e,(hl)
  ldi h,(hl)
  ldi l,(hl)
  ldi a,(ix+nn)
  ldi b,(ix+nn)
  ldi c,(ix+nn)
  ldi d,(ix+nn)
  ldi e,(ix+nn)
  ldi h,(ix+nn)
  ldi l,(ix+nn)
  ldi a,(iy+nn)
  ldi b,(iy+nn)
  ldi c,(iy+nn)
  ldi d,(iy+nn)
  ldi e,(iy+nn)
  ldi h,(iy+nn)
  ldi l,(iy+nn)

  ldd a,(bc)
  ldd a,(de)
  ldd a,(hl)
  ldd b,(hl)
  ldd c,(hl)
  ldd d,(hl)
  ldd e,(hl)
  ldd h,(hl)
  ldd l,(hl)
  ldd a,(ix+nn)
  ldd b,(ix+nn)
  ldd c,(ix+nn)
  ldd d,(ix+nn)
  ldd e,(ix+nn)
  ldd h,(ix+nn)
  ldd l,(ix+nn)
  ldd a,(iy+nn)
  ldd b,(iy+nn)
  ldd c,(iy+nn)
  ldd d,(iy+nn)
  ldd e,(iy+nn)
  ldd h,(iy+nn)
  ldd l,(iy+nn)

  ldi (bc),a
  ldi (de),a
  ldi (hl),a
  ldi (hl),b
  ldi (hl),c
  ldi (hl),d
  ldi (hl),e
  ldi (hl),h
  ldi (hl),l
  ldi (ix+nn),a
  ldi (ix+nn),b
  ldi (ix+nn),c
  ldi (ix+nn),d
  ldi (ix+nn),e
  ldi (ix+nn),h
  ldi (ix+nn),l
  ldi (iy+nn),a
  ldi (iy+nn),b
  ldi (iy+nn),c
  ldi (iy+nn),d
  ldi (iy+nn),e
  ldi (iy+nn),h
  ldi (iy+nn),l
   
  ldd (bc),a
  ldd (de),a
  ldd (hl),a
  ldd (hl),b
  ldd (hl),c
  ldd (hl),d
  ldd (hl),e
  ldd (hl),h
  ldd (hl),l
  ldd (ix+nn),a
  ldd (ix+nn),b
  ldd (ix+nn),c
  ldd (ix+nn),d
  ldd (ix+nn),e
  ldd (ix+nn),h
  ldd (ix+nn),l
  ldd (iy+nn),a
  ldd (iy+nn),b
  ldd (iy+nn),c
  ldd (iy+nn),d
  ldd (iy+nn),e
  ldd (iy+nn),h
  ldd (iy+nn),l

  ldi (hl),nn
  ldi (ix+nn),nn
  ldi (iy+nn),nn

  ldd (hl),nn
  ldd (ix+nn),nn
  ldd (iy+nn),nn

  sub hl,bc
  sub hl,de
  sub hl,hl
  sub hl,sp

ldi increases the data pointer after the data access, so LDI A,(HL) is the same as LD A,(HL):INC HL. likewise, LDD A,(DE) is LD A,(DE):DEC DE.

6. Real device emulation mode

To enable this mode you must use pseudo-op DEVICE.

In this mode the compiler compiling program to virtual memory (as at MSX's WB-ASS2, ZX-Spectrum's GENS, ZEUS, ALASM etc). After this all you can use new pseudo-ops as SAVEBIN, SAVEHOB, SAVETRD, PAGE, SLOT, LABELSLIST and use special functions in Lua scripts.

Example 4.2. 

    DEVICE ZXSPECTRUM128
    ;in this device, SLOT 3 enables to current by default.    

    ORG 32768
StartProg:
    JP $

    DEVICE NONE
    ;do something, if you don't want to corrupt virtual
    ;memory with other code, for example, loader of code.
    ;...code...

    ;return to our virtual device:
    DEVICE ZXSPECTRUM128

    SAVESNA "snapshotname.sna",StartProg
 


Predefined devices:

NONE

Disable real device emulation mode. By default.

ZXSPECTRUM48

Has 4 slots (0-3) with size 4000h, 4 pages (0-3) with size 4000h. Slot 3 (it from 0C000h) enables to current by default.

ZXSPECTRUM128

Same as ZXSPECTRUM48, but have 8 pages (0-7) with size 4000h.

PENTAGON128

Same as ZXSPECTRUM128

SCORPION256

Same as ZXSPECTRUM48, but have 16 pages (0-15) with size 4000h.

ATMTURBO512

Same as ZXSPECTRUM48, but have 32 pages (0-31) with size 4000h.

PENTAGON1024

Same as ZXSPECTRUM48, but have 64 pages (0-63) with size 4000h.

If you want to see other devices you must write to us. See Feedback chapter.

7. Predefined defines

SjASMPlus has predefined defines.

_SJASMPLUS = 1

Example 4.3. 

   IFDEF _SJASMPLUS
     ;code for sjasmplus
   ELSE
     ;code for other compiler
   ENDIF


_VERSION = "version"

Example 4.4. 

   IF _VERSION = "1.07"
     ;code for 1.07
   ELSE
     ;code for other version
   ENDIF


_RELEASE = "releasename"

Example 4.5. 

   IF _RELEASE = "RC1"
     ;code for Release Candidate 1
   ELSE
     ;code for other version
   ENDIF


_ERRORS = <number>

Number of errors.

_WARNINGS = <number>

Number of warnings.

Chapter 5. Pseudo-ops (aka Pseudo-instructions, Directives etc)

1. Simple example of usage

     .SOMEPSEUDOOP ;or 
     SOMEPSEUDOOP  ;or
     somepseudoop

2. Almost complete list

.<expression> <code>

Repeat <code> <expression> once. Doesn't work in the beginning of line.

Example 5.1. 

 .3        INC A    ;will be compiled to INC A:INC A:INC A
len        EQU 10 
 .(12-len) BYTE 0   ;will be compiled to BYTE 0,0


ABYTE <offset> <bytes>

Defines a byte or a string of bytes. The offset is added to each of the following bytes.

Example 5.2. 

    ABYTE 2 4,9    ; Same as BYTE 6,11
    ABYTE 3 "ABC"  ; Same as BYTE "DEF"


ABYTEC <offset> <bytes>

Defines a byte or a string of bytes, where the last byte of the string will have bit 7 set. The offset is added to each of the following bytes.

Example 5.3. 

    ABYTEC 0 "KIP"        ; Same as BYTE "KI",'P'|128
    ABYTEC 1 "ABC",0,"DE" ; Same as BYTE "BC",'D'|128,1,'E','F'|128


ABYTEZ <offset> <bytes>

Defines a byte or a string of bytes, followed by a zero. The offset is added to each of the following bytes.

Example 5.4. 

    ABYTEZ 0 "KIP"        ; Same as BYTE "KIP",0


ALIGN <2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384 or 32768>, <byte>

Align fills zero or more byte with <byte> until the new address modulo <expression> equals zero.

Example 5.5. 

    ALIGN         ; => ALIGN 4 - simply align by 4
    ALIGN 2       ; by 2
    ALIGN 2,0       ; + fills memory by zero


ASSERT <expression>

An 'assertion failed' error is issued if the expression evaluates to zero.

Example 5.6. 

STACKPOINTER=0D500H
    ASSERT END_OF_PROGRAM < STACKPOINTER
END_OF_PROGRAM
    END


BINARY <filename>[,offset[,length]]

Synonym of INCBIN.

BLOCK <length>[,<fill byte>]

Defines space. Has to be followed by the number of byte to reserve, optionally followed by the value to fill these bytes with.

Example 5.7. 

    BLOCK 500     ; define a block of 500 bytes of zero
    BLOCK 500,0   ; define a block of 500 bytes of zero
    BLOCK 400,-1  ; define a block of 400 bytes of 255


BYTE <bytes>

Defines a byte or a string of bytes. Each value should be between -129 and 256.

Example 5.8. 

    BYTE 0x56
    BYTE 1,-78,'@'
    BYTE "Format C:? ",0h


DB

Synonym of BYTE.

DC

Same as BYTE, but every last character of a string will have bit 7 set.

Example 5.9. 

    DC "kip" ; same as BYTE "ki",'p'|128


DD

Synonym of DWORD.

DEFARRAY <id> <replacements>

Array of DEFINEs

Example 5.10. 

    DEFARRAY myarray 10*20,"A",20,</D,40>,50,70
CNT DEFL 0 ;or CNT=0
    DUP 6
    DISPLAY myarray[CNT]
CNT DEFL CNT+1 ;or CNT=CNT+1
    EDUP


DEPHASE

Synonym of ENT.

DEFB

Synonym of BYTE.

DEFD

Synonym of DWORD.

DEFDEVICE <deviceid>

Sorry, not available yet. If you want to see new device in SjASMPlus, please, write us.

DEFINE <id> <replacement>

The identifier <id> will be replaced with the <replacement>. The replacement could be omitted, in such case it is still possible to check if the identifier was defined with IFDEF or IFNDEF.

Example 5.11. 

    DEFINE str_honderd "Honderd"
    BYTE str_honderd,0             ; BYTE "Honderd",0


DEFM

Synonym of BYTE.

DEFS

Synonym of BLOCK.

DEFW

Synonym of WORD.

DEVICE <deviceid>

Enables real device emulation mode by it identifier.

Predefined devices' identifiers list:

 NONE ; off real device emulation mode
 ZXSPECTRUM48 ; ZX-Spectrum 48
 ZXSPECTRUM128 ; ZX-Spectrum 128
 SCORPION256 ; Scorpion 256 - exUSSR clone of ZX-Spectrum 128
 ATMTURBO512 ; ATM-Turbo 512 - exUSSR clone of ZX-Spectrum 128

 ;disable:
   DEVICE NONE
 ;enable:
   DEVICE ZXSPECTRUM128
DISP <address>

Set the address in which the part of code should work. PHASE and TEXTAREA are synonyms of DISP. ENT is restore current address. UNPHASE, DEPHASE and ENDT are synonyms of ENT

Example 5.12. 

SCREEN EQU $4000
    ORG $8000
    LD HL,BEGIN
    LD DE,SCREEN
    LD BC,ENDOFPROG-BEGIN
    LDIR
    CALL SCREEN
    DI
    HALT
BEGIN  DISP SCREEN ;code will compile for address $4000, but to the current ORG
MARKA  DEC A
    HALT
    JP NZ,MARKA
    RET
       ENT
ENDOFPROG


DISPLAY <bytes>

This pseudo-op comes from ZX-Spectrum assembler ALASM.

Out to console a string of bytes. Each value should be between -129 and 256. Keys /D, /H and /A set format of output of numbers:

/D - out only in Decimal
/H - out only in Hexadecimal
/A - out both in Hexadecimal and Decimal

Example 5.13. 

    ORG 100h
TESTLABEL:
    ;...some code...
    RET
    DISPLAY "--the some program-- by me"
    DISPLAY "TESTLABEL address is:",/A,TESTLABEL
/*  
will be out to the console next strings:
> --the some program-- by me
> TESTLABEL address is:0x100,257
*/


DM

Synonym of BYTE.

DS

Synonym of BLOCK.

DUP <count>

DUP specifies the number of times to generate the statements inside the macro. DUP can be used in macro's.

Example 5.14. 

    DUP 3
    NOP
    EDUP
/*this will expand to:
    NOP
    NOP
    NOP
*/


DW

Synonym of WORD.

DWORD

Defines a so called doubleword. Values should be between -2147483649 and 4294967296.

Example 5.15. 

    DWORD 4000h,0d000h
    DWORD 4


DZ

Same as BYTE, but an extra zero will be added at the end.

Example 5.16. 

    DZ 1      ; same as BYTE 1,0
    DZ "kip"  ; same as BYTE "kip",0


EMPTYTRD <filenameoftrdimage>

Useful only for ZX-Spectrum users

Create the empty TRD image for emulators of ZX-Spectrum. See example of SAVETRD.

ENCODING <encoding>

Useful only for non English users

Set the current encoding, i.e. if you set "DOS", SjASMPlus will automatically convert strings from ANSI to DOS-866. Encoding may be "DOS"(DOS-866) or "WIN"(ANSI/Win-1251). Default is "WIN".

Example 5.17. 

    ENCODING "WIN"
    DB "тексттекст" ;will be тексттекст
    ENCODING "DOS"
    DB "тексттекст" ;will be ⥪бв⥪бв


END

The assembler will stop at this point. The pseudo-op doesn't work in the beginning of line(with and without key --dirbol).

ENDLUA

See LUA for more information.

ENDMOD

Synonym of ENDMODULE.

ENDMODULE

To indicate the end of a module (see MODULE), and use the previous modulename.

Example 5.18. 

    MODULE M1
A                 ; M1.A
    MODULE M2
A                 ; M2.A
    ENDMODULE
B                 ; M1.B


ENDT

Synonym of ENT.

ENT

Restore current address. See DISP for more information.

EQU

To give a label a value other than the current program counter. '=' can be used instead of 'EQU'. The label should not already exist.

Example 5.19. 

Label EQU 3
Kip=3


EXPORT label

The named label will be written to the export-file, in the form 'label: EQU value'. This way the export-file can be included in other sources.

Example 5.20. 

DRIE=3
    EXPORT DRIE


FIELD

To give a label the value of the current map counter. Afterwards the map counter is increment by the given amount. '#' May be used instead of 'FIELD'. With map and field it is possible to create structure-like data structures. With '##' it is possible to align the map counter.

Example 5.21. 

    MAP 8
Label # 2     ; Label=8
Kip   # 3     ; Kip=10
Kop   #       ; Kop=13
Kop2  # 1     ; Kop2=13
     ##       ; align map address (align 4 is default)
Kop3  # 6     ; Kop3=16


FPOS <position>

The FPOS directive makes it possible to set the file position to anywhere in the output file.

In combination with OUTPUT “<filename>”,r it is possible to update existing files.

Example 5.22. 

; This example will result in a file with a length of one byte:
    BYTE 0
    FPOS 0
    BYTE 1
    END


INCBIN <filename>[,offset[,length]]

To include a binary file into the outputfile. The offset and length are optional.

Example 5.23. 

    INCBIN "gfx.scc",7        ; include gfx.scc, skip first 7 bytes
    INCBIN "rantab.com",3,256 ; include 256 bytes from offset 3
    INCBIN gfx.scc ,7         ; note the space between the filename and the ',7' here :)


INCHOB <filename>[,offset[,length]]

To include a data from a hobeta file into the outputfile. The offset and length are optional.

Example 5.24. 

    INCHOB "gfx.$c",7        ; include gfx.scc, skip first 7 bytes
    INCHOB "sprs.$c",3,256   ; include 256 bytes from offset 3
    INCHOB gfx.$c ,7        ; note the space between the filename and the ',7' here :)


INCLUDE <filename>

To include another sourcefile into the current. Sourcefiles can be nested 20 levels deep. If the file cannot be found in the current directory (the current directory is the directory the current file comes from) the file will be searched for in the directories specified at the commandline. When angle brackets are used, the commandline directories are searched before the current directory.

Example 5.25. 

    INCLUDE <VDP.I>
    INCLUDE MORE.I
    INCLUDE "MORE.I"


INCLUDELUA <filename>

To include another LUA script in first pass(!). If the file cannot be found in the current directory (the current directory is the directory the current file comes from) the file will be searched for in the directories specified at the commandline. When angle brackets are used, the commandline directories are searched before the current directory.

Example 5.26. 

    INCLUDELUA <mylibrary1.lua>
    INCLUDELUA mylibrary2.lua
    INCLUDELUA "library_for_zx.lua"


INCTRD <filenameoftrdimage>,<filenameintrdimage>[,offset[,length]]

To include a file from a TRD image into the outputfile. The offset and length are optional.

Example 5.27. 

    INCTRD "test.trd","mygfx.C" ; include mygfx.C from test.trd
    INCTRD "test.trd","mygfx.C",12 ; include mygfx.C from test.trd, skip first 12 bytes


INSERT <filename>[,offset[,length]]

INSERT is a synonym of INCBIN. See above.

LABELSLIST <filename>

Useful only for ZX-Spectrum Emulator UNREALSPECCY.

Work only in real device emulation mode. See DEVICE.

Save labels list in format:

NN:ADDRESS LABELNAME

,where NN is number of page of RAM

Example 5.28. 

    LABELSLIST "x:/somepath/user.l"


LUA [pass]

Using pseudo-ops LUA and ENDLUA you can insert Lua scripts. See more in the chapter "Lua scripting".

Parameter is optional. It may be:

PASS1  -  interpret Lua script in first pass only
PASS2  -  interpret Lua script in second pass only (why?)
PASS3  -  interpret Lua script in third pass only. By default.
ALLPASS  -  interpret Lua script in all passes. It is need, if you generate some Z80 code.

Example 5.29. 

    LUA
-- some comments
        print "Hi, man! This is Lua!"
    ENDLUA
; some code now:
    LUA ALLPASS
        _pl("LABEL LD A,10")
        _pc("RET")
    ENDLUA


MAP <address>

Set the map counter to the specified value. See FIELD for an example.

Example 5.30. 

    MAP 5


MEMORYMAP

Not available yet.

MODULE <name>

Labels are to be unique only in the current module. Also note the use of '@' to suppress all this label-processing. (The '@' is NOT part of the label name though!)

Example 5.31. 

    MODULE xxx
Kip                ; label xxx.Kip
    CALL Kip         ; call xxx.Kip
    CALL yyy.Kip     ; call yyy.Kip
    CALL Kop         ; call xxx.Kop
    CALL @Kop        ; call Kop
    Call @Kip        ; call Kip

    MODULE yyy
Kip                ; label yyy.Kip
@Kop               ; label Kop
@xxx.Kop           ; label xxx.Kop

    MODULE           ; no modulename
Kip                ; label Kip


ORG <address>

Set the program counter to a specific address.

Example 5.32. 

    ORG 100h


OUTPUT “<filename>”,mode

With OUTPUT it is possible to create multiple files from one source. All following instructions will be assembled to this file.

There are three possible output modes: truncate (overwrite existing files, this is the default), rewind (open and execute FPOS 0) and append (open and leave the file pointer at the end of the file).

OUTPUT “<filename>”,t  ; truncate (default)
OUTPUT “<filename>”,r  ; rewind
OUTPUT “<filename>”,a  ; append

Example 5.33. bigfile.asm

    OUTPUT loader.com
    ORG 100H
    INCLUDE loader.asm
    INCLUDE bios.asm

    OUTPUT bigfile.dat
    ORG 4000H
    INCLUDE main.asm
    ORG 8000H
    INCLUDE data.asm


This will create two files: loader.com and bigfile.dat.

When SjASMPlus is invoked without specifying an output file, there is still one created even when no bytes are output to it. So when the above file is called bigfile.asm, and assembled with the following line:

sjasmplus bigfile.asm

The following files are created:

Bigfile.out  ; file length is zero
Loader.com
Bigfile.dat
PAGE <number>

Work only in real device emulation mode. See DEVICE.

Set the current memory page to current slot.

Example 5.34. 

    PAGE 7 ;set 7 page
    SAVEBIN "ram7.bin",$C000,$4000 ;- save $4000 begin from $C000 of RAM to file


PHASE

Synonym of DISP.

REPT <count>

Synonym of DUP.

SAVEBIN <filename>,<startadress>,<lengthofcode>

Work only in real device emulation mode. See DEVICE.

Save the block of RAM.

Example 5.35. 

    PAGE 7 ;set 7 page to current slot
    SAVEBIN "ram7.bin",$C000,$4000 ;- save 4000h begin from C000h of RAM to file
    SAVEBIN "ram2.bin",$8000,$3000 ;- save 3000h begin from 8000h of RAM to file


SAVEHOB <filename>,<filename_in_trdos>,<startadress>,<lengthofcode>

Work only in real device emulation mode. See DEVICE.

Save the block of RAM in Hobeta format.

Example 5.36. 

    PAGE 7 ;set 7 page to current slot
    SAVEHOB "ram7.$c","myfile1.C",$C000,$4000 ;- save 4000h begin from C000h of RAM to file
    SAVEHOB "ram2.$c","myfile2.C",$8000,$3000 ;- save 3000h begin from 8000h of RAM to file


SAVESNA <filename>,<startadressofprogram>

Work only in real device emulation mode. See DEVICE.

Save the snapshot for emulators of ZX-Spectrum.

Example 5.37. 

    DEVICE ZXSPECTRUM128
    ORG $8000
START  .... ;something code
    RET
    SAVESNA "game.sna",START ;save snapshot to file game.sna. Start address is START ($8000)


SAVETRD <filenameoftrdimage>,<filename_in_trdos>,<startadress>,<lengthofcode>

Work only in real device emulation mode. See DEVICE.

Save the snapshot for emulators of ZX-Spectrum

Example 5.38. 

    EMPTYTRD "test.trd" ;create empty TRD image
    PAGE 7 ;set 7 page to current slot
    SAVETRD "test.trd","myfile1.C",$C000,$4000 ;- save 4000h begin from C000h of RAM to file to TRD image
    SAVETRD "test.trd","myfile2.C",$8000,$3000 ;- save 3000h begin from 8000h of RAM to file to TRD image


SHELLEXEC <filename>

Execute external program.

Example 5.39. 

    OUTPUT "mybin.bin"
    ;some code
    IF ((_ERRORS = 0) + (_WARNINGS = 0))
        SHELLEXEC "x:/mydeveloping/bin2tap.exe mybin.bin"
    ENDIF


SIZE <filesize in bytes>

If the resulting file is less than the given length, as many bytes are added as necessary. See OUTPUT for more.

Example 5.40. 

    SIZE 32768       ; make sure file will be 32K


SLOT <number>

Work only in real device emulation mode. See DEVICE.

Set current slot. Slot's defined by MEMORYMAP pseudo-op. Use pseudo-op PAGE to change page in the current slot.

Example 5.41. 

    DEVICE ZXSPECTRUM128
    SLOT 3 ;from 0C000h to 0FFFFh
    PAGE 1 ;set page 1 to slot 3
    ORG 0C000h
    ;your program here
    PAGE 2
    INCBIN "somegfx.bin"
    ;....


TEXTAREA <address>

Synonym of DISP.

UNPHASE

Synonym of ENT.

WORD <words>

Defines a word. Values should be between -32787 and 65536.

Example 5.42. 

    WORD 4000h,0d000h
    WORD 4,"HA"


3. Conditional assembly

It may be useful to assemble a part or not based on a certain condition.

IF <expression>

If <expression> is non-zero the following lines are assembled until an ELSE or ENDIF.

IFN <expression>

If <expression> is zero the following lines are assembled until an ELSE or ENDIF.

IFDEF <id>

The condition is true if there is an id defined. These are NOT labels.

Example 5.43. lab

    IFDEF MSX_LEAN_AND_MEAN
        CALL InitOwnMM
    ELSE
        CALL InitDos2MemMan
    ENDIF


IFNDEF <id>

The condition is true if there isn't an id defined. These are NOT labels.

Example 5.44. 

1   IN A,(0C4H)
    AND 2
    IFNDEF DEBUG
        JR NC,1B
    ENDIF


ELSE

See IF. If the condition is not true, the else-part is assembled.

ENDIF

Every IF should be followed by an ENDIF.

4. Macro's

The MACRO pseudo-op defines a macro. It should be followed by the name of the macro, optionally followed by the parameters. The following lines will be stored as the macro-body until an ENDM pseudo-op is encountered. Macro's have to be defined before their use.

Example 5.45. Macro without parameters

  MACRO ADD_HL_A
    ADD A,L
    JR NC,.hup
    INC H
.hup
    LD L,A
  ENDM


Labels in a macro starting with a dot are local to each macro expansion.

Example 5.46. A macro with parameters

  MACRO WAVEOUT reg, data
    LD A,reg
    OUT (7EH),A
    LD A,data
    OUT (7FH),A
  ENDM
; this macro will make
  WAVEOUT 2,17
; expand to:
  LD A,2
  OUT (7EH),A
  LD A,17
  OUT (7FH),A


Example 5.47. Another example

    MACRO LOOP
      IF $-.lus<127
        DJNZ .lus
      ELSE
        DEC B
        JP NZ,.lus
      ENDIF
    ENDM

Main
.lus
    CALL DoALot
    LOOP
; This will expand to:
Main
.lus                  ; Main.lus
    CALL DoALot
    DJNZ .lus         ; Main.lus


Angle brackets can be used when the arguments contain commas.

Example 5.48. 

    MACRO UseLess data
      DB data
    ENDM

    UseLess <10,12,13,0>
; expands to:
    DB 10,12,13,0

; use '!' to include '!' and '>' in those strings.

  UseLess <5, 6 !> 3>
; expands to:
  DB 5, 6 > 3

  UseLess <"Kip!!",3>
; expands to:
  DB "Kip!",3


Chapter 6. Structures

1. What is it?

Structures can be used to define data structures in memory more easily. The name of the structure is set to the total size of the structure.

2. Using

A structure definition starts with: STRUCT <name>,[<initial offset>] and ends with ENDS. Structure definitions are local to the current module, but, as with labels, '@' can be used to override this.

Lines between STRUCT and ENDS should have the following format:

membername pseudo-operation operands

All fields are optional. Lines without label should start with whitespace.

3. Instructions

Between the STRUCT and ENDS pseudo-instructions the following instructions can be used:

BYTE [<defaultvalue>]

To define a one byte member. The defaultvalue is used when no initialisation value is given when the structure is declared. (DB and DEFB may be used instead of BYTE).

WORD [<defaultvalue>]

To define a two byte member. The defaultvalue is used when no initialisation value is given when the structure is declared. (DW and DEFW may be used instead of WORD).

D24 [<defaultvalue>]

To define a three byte member. The defaultvalue is used when no initialisation value is given when the structure is declared.

DWORD [<defaultvalue>]

To define a four byte member. The defaultvalue is used when no initialisation value is given when the structure is declared. (DD and DEFD may be used instead of WORD).

BLOCK <length>[,<fillbyte>]]

To define an member of the specified number of bytes. ('#', DS and DEFS may be used instead of WORD).

ALIGN [<expression>]

To align the offset. If the expression is omitted, 4 is assumed. ('##' May be used instead of ALIGN).

<structure name> [<init values>]

It is possible to nest structures, and give new defaults for the BYTE and WORD members.

4. Examples

Example 6.1. 

	STRUCT SCOLOR 
RED	BYTE 4
GREEN	BYTE 5
BLUE	BYTE 6
	ENDS

This is identical to:

SCOLOR		EQU 3 ; lenght 
SCOLOR.RED	EQU 0 ; offset
SCOLOR.GREEN	EQU 1 ; offset
SCOLOR.BLUE	EQU 2 ; offset


Example 6.2. 

	STRUCT SDOT
X	BYTE
Y	BYTE
C	SCOLOR 0,0,0 ; use new default values
	ENDS

This is identical to:

SDOT		EQU 5 ; length
SDOT.X		EQU 0 ; offset
SDOT.Y		EQU 1 ; offset
SDOT.C		EQU 2 ; offset
SDOT.C.RED	EQU 2 ; offset
SDOT.C.GREEN	EQU 3 ; offset
SDOT.C.BLUE	EQU 4 ; offset


Example 6.3. 

	STRUCT SPOS,4
X	WORD
Y	BYTE
	ALIGN 2
AD	WORD
	ENDS

This is identical to:

SPOS	EQU 10 ; length
SPOS.X	EQU  4 ; offset
SPOS.Y	EQU  6 ; offset
SPOS.AD	EQU  8 ; offset


Example 6.4. 

When a structure is defined it is possible to declare labels with it

COLOR SCOLOR

This is identical to:

COLOR
COLOR.RED   BYTE 4
COLOR.GREEN BYTE 5
COLOR.BLUE  BYTE 6

Note the default values.

Or without label:

COLORTABLE
  SCOLOR 0,0,0
  SCOLOR 1,2,3
  SCOLOR ,2
  ; etc.

This is identical to:

COLORTABLE
  BYTE 0,0,0
  BYTE 1,2,3
  BYTE 4,2,6
  ; etc.

DOT1 SDOT 0,0, 0,0,0     ; or 0,0,0,0,0 or {0,0,{0,0,0}}

Only BYTE and WORD members can be initialised.

The resulting labels can be used as any other label:

  ld b,(ix+SCOLOR.RED)
  ld a,(COLOR.GREEN)
  ld de,COLOR
  ; etc.

Warning

Do not use the offset labels in indirections like:

LD A,(SDOT.X)

This will conflict with futher 'improvements' ;-)

If this is absolutely necessary (why?) use something like this:

LD A,(+SDOT.X)


Chapter 7. Lua scripting

1. Why?

Why is scripting engine as Lua embedded to the compiler? Answer is simple: It need to add extra features by users. And to whole other Lua is enough small, fast and powerful scripting engine.

2. How to use?

You must use LUA and ENDLUA pseudo-ops.

Example 7.1. Hello World!

    LUA
        print "Hello World!"
    ENDLUA


3. SjASMPlus binded functions

From Lua you can control some variables and use functions of the compiler. Complete list:

[integer] _c("expression")

Calculate expression using calculator of the compiler. Example: val = _c("SOMELABEL+12").

[void] _pc("code")

Parse string of Z80 assembly. Example: _pc("ADD A,B")

[void] _pl("label code")

Parse line of Z80 assembly. Example: _pc("SOMELABEL ADD A,B")

[integer] sj.calc("expression")

See _c

[void] sj.parse_code("label")

See _pc

[void] sj.parse_line("label code")

See _pl

[void] sj.error("message")

Print error message.

[void] sj.warning("message")

Print warning message.

[boolean] sj.file_exists("message")

Check for file exists.

[string] sj.get_define("name")

Get define value.

[boolean] sj.insert_define("name", "value")

Add new define.

[integer] sj.get_label("name")

Get label address.

[boolean] sj.insert_label("name", address)

Add new label.

[integer] sj.current_address

Variable. Current address.

[integer] sj.error_count

Variable. Count of Errors.

[integer] sj.warning_count

Variable. Count of Warnings.

[void] sj.exit(errorcode)

Shutdown the compiler.

[void] sj.add_byte(byte)

Add byte to output (or to memory) and increase sj.current_address

[void] sj.add_word(word)

Add word to output (or to memory) and twice increase sj.current_address

[integer] sj.get_byte(address)

Get byte from memory. Work only in real device emulation mode.

[integer] sj.get_word(address)

Get word from memory. Work only in real device emulation mode.

[string] sj.get_device()

Return current emulating device's identifier. Returns "NONE" if no emulation mode.

[boolean] sj.set_device("id")

Set current emulating device's identifier. Returns false if no device found.

[boolean] sj.set_page(number)

Set page with number "number" to the current slot. Works as pseudo-op PAGE.

[boolean] sj.set_slot(number)

Set current slot with number "number". Works as pseudo-op SLOT.

[void] sj.shellexec("programname")

See pseudo-op SHELLEXEC.

[void] zx.trdimage_create("filename")

Creates emptry TRD image file.

[void] zx.trdimage_add_file("filename", "somenameC", startaddress, length)

Save block of memory to TRD image file. Work only in real device emulation mode.

[void] zx.save_snapshot_sna128("filename.sna", startaddressofprogram)

Save snapshot of memory in SNA format. Work only in real device emulation mode and only for ZXSPECTRUM128 and better..

4. Third-party embedded library(ies)

lpack.c

a Lua library for packing and unpacking binary data

by Luiz Henrique de Figueiredo <lhf(at)tecgraf.puc-rio.br>

The library adds two functions to the string library: string.pack and string.unpack.

pack is called as follows: string.pack(F,x1,x2,...), where F is a string describing how the values x1, x2, ... are to be interpreted and formatted. Each letter in the format string F consumes one of the given values. Only values of type number or string are accepted. pack returns a (binary) string containing the values packed as described in F. The letter codes understood by pack are listed in lpack.c (they are inspired by Perl's codes but are not the same). Numbers following letter codes in F indicate repetitions.

unpack is called as follows: string.unpack(s,F,[init]), where s is a (binary) string containing data packed as if by pack, F is a format string describing what is to be read from s, and the optional init marks where in s to begin reading the values. unpack returns one value per letter in F until F or s is exhausted (the letters codes are the same as for pack, except that numbers following 'A' are interpreted as the number of characters to read into the string, not as repetitions).

The first value returned by unpack is the next unread position in s, which can be used as the init position in a subsequent call to unpack. This allows you to unpack values in a loop or in several steps. If the position returned by unpack is beyond the end of s, then s has been exhausted; any calls to unpack starting beyond the end of s will always return nil values.

List of types for F string:

z

zero-terminated string

p

string preceded by length byte

P

string preceded by length word

a

string preceded by length size_t

A

string

f

float

d

double

n

Lua number

c

char

b

byte = unsigned char

h

short = word

H

unsigned short

i

int

I

unsigned int

l

long

L

unsigned long

<

little endian

>

big endian

=

native endian

5. Example

Example 7.2. Variables doesn't clear in new passes of the compiler

    LUA PASS1
       v = 1
    ENDLUA

    LUA PASS2
       print (v)
-- out to console: 1
       v++
    ENDLUA

    LUA PASS3
       print (v)
-- out to console: 2
    ENDLUA


Example 7.3. To generate some code you need to generate it in all passes

    LUA ALLPASS
        _pl("ClearScreen LD (.savesp+1),SP")
        _pc("LD SP,16384+6144")
        _pc("LD HL,0")
        for i = 32768, 38912, 2 do
            _pc("PUSH HL")
        end
        _pl(".savesp: LD SP,0")
        _pc("RET")
    ENDLUA


Example 7.4. Declare function and use it

     LUA
         function savetape_mytype(filename, startaddress)
             local fp
             fp = assert(io.open(fname, "wb"))
             for i = 16384, 32767, 4 do
                 assert(fp:write( string.pack("bbbb", 
                                sj.get_byte(i), 
                                sj.get_byte(i+1), 
                                sj.get_byte(i+2), 
                                sj.get_byte(i+3)) ))
             end
             assert(fp:flush())
             assert(fp:close())
         end
     ENDLUA

 ;somewhere in your program
     LUA
         savetape_mytype("tapefiles/myprogram.tape", _c("StartGameLabel"))
     ENDLUA


Example 7.5. Simple sample :)

	LUA
-- Function reads number from file <fname>, increases it, creates define "BUILD" with the number and saves the number to <fname>.
-- With this function you can control count of compilations.
	function increase_build(fname)
		local fp
		local build
		fp = assert(io.open(fname, "rb"))
		build = tonumber(fp:read("*all"))
		assert(fp:close())
		if type(build) == "nil" then
		    build = 0
		end
		build = build + 1;
		sj.insert_define("BUILD", build)
		fp = assert(io.open(fname, "wb"))
		assert(fp:write( build ))
		assert(fp:flush())
		assert(fp:close())
	end

-- Before using you must create empty file "build.txt"!
	increase_build("build.txt")
	
-- Creates define "TIME" with current time
	sj.insert_define("TIME", '"' .. os.date("%Y-%m-%d %H:%M:%S") .. '"')
	ENDLUA
	
; print to console our time and build number
	DISPLAY "Build time: ", TIME
	DISPLAY "Build number: ", /D, BUILD