         Title   FLEXSIM DIAGNOSTIC TEST PROGRAM
*        Simple program to test functionality of FLEXSIM module
*
         include  FLEXDEFS.ASM

; Test the following things
;        AHEM. Pay attention.  The following is a list of stuff we DON'T test.
;
;        We can't test FCBDriveNumber: ignored by FLEXsim
;        We can't test FCBFileStartSector: not implemented by FLEXsim
;        We can't test FCBFileEndSector: not implemented by FLEXsim
;        We cannot usefully test FCBListPointer: can't think of what to test
;        We cannot test FCBNameWorkBuffer: not used by FLEXsim
;        We can't test FCBCurrentDirectoryAddress: not implemented by FLEXsim
;        We can't test FCBFirstDeletedDirectoryPointer: not implemented by FLEXsim
;        We can't test FCBSectorBuffer: not supposed to be visible to user
;
;        We can't test FMS:OpenDirectory: not implemented by FLEXsim
;        We can't test FMS:GetInformationRecord: not implemented by FLEXsim
;        We can't test FMS:PutInformationRecord: not implemented by FLEXsim
;        We can't test FMS:ReadSingleSector: not implemented by FLEXsim
;        We can't test FMS:WriteSingleSector: not implemented by FLEXsim
;        We can't test FMS:OpenSystemInformationRecord: not implemented by FLEXsim

;        We can't test SystemDirectoryError: FLEX doesn't define cause.
;        We can't test DirectoryFull: can't happen under SDOS.
;        We don't test DiskFileReadError: Too rare to care.
;        We don't test DiskFileWriteError: Too rare to care.
;        We can't test IllegalDiskAddress: can't happen under FLEXsim
;        We can't test ReadProtected: FLEX doesn't define cause.
;        We can't test FMSDataIndexRangeError: it can't happen!
;        We can't test SystemFileCloseError: FLEX doesn't define cause
;        We can't test SectorMapOverflow: can't happen under FLEXsim
;        We can't test RecordNumberMatchError: can't happen under FLEXsim
;        We can't test NotWhilePrinting: FLEXsim doesn't support spooling.
;        We can't test WrongHardwareConfiguration: can't happen under FLEXsim
;        We can't test DiskFull: it is too hard to cause.
;        We can't test IllegalDriveNumber: FLEXsim ignores it.
;        We can't test DriveNotReady: FLEXsim doesn't simulate it.

;        We can't test LINEBUFFER: that's just a holding area.
;        We can't test TTYSETBACKSPACECHARACTER: ignored by FLEXsim
;        We can't test TTYSETDELETECHARACTER: ignored by FLEXsim
;        We can't test TTYSETDEPTHCOUNT: not implemented
;        We can't test TTYSETNULLCOUNT: ignored by FLEXSIM
;        We can't test TTYSETTABCHARACTER: ignored by FLEXSIM
;        We can't test TTYSETBACKSPACEECHOCHARACTER: ignored by FLEXSIM
;        We can't test TTYSETEJECTCOUNT: ignored by FLEXSIM
;        We can't test TTYSETPAUSECONTROL: not implemented
;        We can't test TTYSETESCAPECHARACTER: ignored by FLEXSIM
;        We can't test SYSTEMDRIVENUMBER: ignored by FLEXSIM
;        We can't test WORKINGDRIVENUMBER: ignored by FLEXSIM
;        We can't test ESCAPERETURNREGISTER: ignored by FLEXSIM
;        We can't test USERCOMMANDTABLEADDRESS: ignored by FLEXSIM

;        We can't test COMMANDFLAG: not implemented by FLEXSIM
;        We can't test ERRORNAMEVECTOR: not implemented by FLEXSIM
;        We can't test FILEINPUTECHOFLAG: not implemented by FLEXSIM
;        We can't test SYSTEMCONSTANTS: not well defined
         page
         if    0
*****
***** WE NEED DIAGNOSTICS FOR THE FOLLOWING OBJECTS/OPERATIONS
*****

TTYSETENDOFLINECHARACTER equ $CC02     ; Command seperator character
TTYSETWIDTHCOUNT equ $CC04             ; Line width
CURRENTLINENUMBER equ $CC1A            ; # Lines currently on page.
LOADERADDRESSOFFSET equ $CC1B          ; 16 bit bias to add to load addresses
TRANSFERFLAG equ $CC1D                 ; <>0 --> transfer address seen
TRANSFERADDRESS equ $CC1E              ; Where to go if transfer address set
ERRORTYPE equ $CC20                    ; Error type number from FMS routines
SPECIALIOFLAG equ $CC21                ; makes PUTCHR ignore width and disable PAUSEing
OUTPUTSWITCH equ $CC22                 ; 0 --> PUTCHR uses OUTCH, else OUTCH2
INPUTSWITCH equ $CC23                  ; 0 --> GETCHR uses INCH, else INCH2
FILEOUTPUTADDRESS equ $CC24            ; Address of FCB in use for file output
FILEINPUTADDRESS equ $CC26             ; Address of FCB in use for file input
CURRENTOUTPUTCOLUMN equ $CC28          ; count of # chars currently in line being output to terminal

SEE MORE UNIMPLEMENTED STUFF AT END OF LISTING
         fin
         page
         org   $100
FLEXDIAG ; Diagnostic tests begin here.
         swi                           ; for debugging purposes
         jsr   Test1                   ; get location of string
         fcc   "Test that PUTCHR works"
         fcb   $0D,$0A,00
Test1    pulx
Test1l   ldaa  ,x+
         beq   Test1Done
         jsr   PUTCHR                  ; output a character
         bra   Test1l
Test1Done

         jsr   Test2                   ; test OUTCH
         fcc   "This tests output via OUTCH"
         fcb   $0D,$0A,0
Test2    pulx
Test2l   ldaa  ,x+
         beq   Test2Done
         jsr   OUTCH                   ; output a character
         bra   Test2l
Test2Done

         jsr   Test2a                  ; test OUTCH2
         fcc   "This tests output via OUTCH2"
         fcb   $0D,$0A,0
Test2a   pulx
Test2al  ldaa  ,x+
         beq   Test2adone
         jsr   OUTCH2                  ; output a character
         bra   Test2al
Test2adone
         page
         ldx   #TestPSTRNGMessage      Test operation of PSTRNG
         jsr   PSTRNG

         jsr   PrintInLine
         fcc   "Test to see if PCRLF works:"
         fcb   0
         jsr   PCRLF                   ; test PCRLF
         jsr   PrintInLine
         fcc   "This should be on its own line."
         fcb   $0D,$0A,0

         jsr   PrintInLine
         fcc   "Test ADDBX"
         fcb   $0D,$0A,0
         clr   Byte
         clr   Word
         clr   Word+1
TestADDBXloop
         ldab  Byte
         ldx   Word
         jsr   ADDBX
         txd
         subb  Byte
         sbca  #0
         cmpd  Word
         beq   TestADDBX1
         jsr   PrintInLine
         fcc   "ADDBX failed!"
         fcb   $0D,$0A,0
TestADDBX1
         stx   Word
         inc   Byte
         bne   TestADDBXloop
         page
         jsr   PrintInLine
         fcc   "Test OUTHEX: print all 256 possible patterns"
         fcb   0
         clr   Byte                    ; test OUTHEX
Test3    ldx   #Byte
         jsr   OUTHEX
         jsr   PCRLF
         inc   Byte
         bne   Test3

         jsr   PrintInLine
         fcc   "Test OUTADR: a byte and its complement"
         fcb   $0D,$0A,0
         clr   Word
Test4A   ldaa  Word
         coma
         staa  Word+1
         ldx   #Word
         jsr   OUTADR
         jsr   PCRLF
         inc   Word
         bne   Test4A

         jsr   PrintInLine
         fcc   "Test MEMORYEND: "
         fcb   0
         ldx   #MEMORYEND
         jsr   OUTADR
         jsr   PCRLF
         page
         jsr   PrintInLine
         fcc   "Test OUTDEC: All powers of 2, with leading blanks"
         fcb   $0D,$0A,0
         clr   Word
         clr   Word+1
         inc   Word+1
Test4    ldx   #Word
         ldab  #1                    ; set space compression flag
         jsr   OUTDEC
         jsr   PCRLF
         asl   Word+1
         rol   Word
         bcc   Test4

         jsr   PrintInLine
Test5M   fcc   "Test OUTDEC: All powers of 2, with leading blank supressed"
         fcb   $0D,$0A,0
         clr   Word
         clr   Word+1
         inc   Word+1
Test5    ldx   #Word
         clrb                          ; flag "supress blanks"
         jsr   OUTDEC
         jsr   PCRLF
         asl   Word+1
         rol   Word
         bcc   Test5

         jsr   PrintInline
         fcc   "Test OUTDEC on edge conditions: 65535 and 0, with leading blanks"
         fcb   0
         jsr   PCRLF
         ldx   #FDB65535
         ldab  #1
         jsr   OUTDEC
         ldx   #FDBZERO
         ldab  #1                      ; print with leading blanks
         jsr   OUTDEC
         jsr   PCRLF
         page
         jsr   PrintInline
         fcc   "Test SYSTEMDATEREGISTERS: MM DD YY "
         fcb   $0D,$0A,0

         ldaa  SystemDateRegisters
         clr   Word
         staa  Word+1
         clrb
         ldx   #Word
         jsr   OUTDEC
         ldaa  #$20
         jsr   PUTCHR
         ldaa  SystemDateRegisters+1
         clr   Word
         staa  Word+1
         clrb
         ldx   #Word
         jsr   OUTDEC
         ldaa  #$20
         jsr   PUTCHR
         ldaa  SystemDateRegisters+2
         clr   Word
         staa  Word+1
         clrb
         ldx   #Word
         jsr   OUTDEC
         jsr   PCRLF
         page
         jsr   PrintInline
         fcc   "Test INCH: Enter <ESC> to skip input tests"
         fcb   $0D,$0A
         fcc   "Enter <RETURN> to exit this test"
         fcb   0

TestINCH jsr   INCH                    ; get a keystoke
         staa  Byte
         ldx   #Byte
         jsr   OUTHEX
         jsr   PCRLF
         ldaa  Byte
         cmpa  #$1B
         lbeq  FileTests               ; b/ short circuit
         cmpa  #$0D
         bne   TestINCH

         jsr   PrintInline
         fcc   "Test INCH2: Enter <ESC> to skip input tests"
         fcb   $0D,$0A
         fcc   "Enter <RETURN> to exit this test"
         fcb   0

TestINCH2 jsr   INCH2                    ; get a keystoke
         staa  Byte
         ldx   #Byte
         jsr   OUTHEX
         jsr   PCRLF
         ldaa  Byte
         cmpa  #$1B
         lbeq  FileTests               ; b/ short circuit
         cmpa  #$0D
         bne   TestINCH2

         jsr   PrintInline
         fcc   "Test GETCHR: Enter <ESC> to skip input tests"
         fcb   $0D,$0A
         fcc   "Enter <RETURN> to exit this test"
         fcb   0
TestGETCHR jsr GETCHR                    ; get a keystoke
         staa  Byte
         ldx   #Byte
         jsr   OUTHEX
         jsr   PCRLF
         ldaa  Byte
         cmpa  #$1B
         lbeq  FileTests               ; b/ short circuit
         cmpa  #$0D
         bne   TestGETCHR
         page
         jsr   PrintInline
         fcc   "Test INBUFF, NXTCH and CLASS, along with CURRENTCHARACTER,"
         fcb   $0D,$0A
         fcc   "PREVIOUSCHARACTER, LASTTERMINATOR and LINEBUFFERPOINTER"
         fcb   $0D,$0A
         fcc   "Enter <RETURN> only to exit this test"
         fcb   $0D,$0A,0
TestINBUFF jsr INBUFF
         clr   Word                    = PreviousCharacter
TestNXTCHLoop
         ldx   #LINEBUFFERPOINTER
         jsr   OUTADR                  ; show line buffer address before fetch
         ldaa  #$20
         jsr   PUTCHR
         jsr   NXTCH
         staa  Byte
         cmpa  CURRENTCHARACTER
         beq   TestNXTCHcurrentok
         jsr   RecordError
         jsr   PrintInline
         fcc   "Doesn't match CurrentCharacter! "
         fcb   $0D,$0A,0
TestNXTCHcurrentok
         ldaa  Word
         cmpa  PreviousCharacter
         beq   TestPreviousCharacterOK
         jsr   RecordError
         jsr   PrintInline
         fcc   "Previous Character is Wrong!"
         fcb   $0D,$0A,0
TestPreviousCharacterOK
         ldaa  Byte
         jsr   PUTCHR
         ldaa  #$20
         jsr   PUTCHR
         ldx   #Byte
         jsr   OUTHEX
         ldaa  #$20
         jsr   PUTCHR
         ldaa  Byte
         jsr   Class
         bcs   Terminator
         ldaa  #'A
         bra   DisplayType

Terminator
         ldaa  #'T
DisplayType
         jsr   PUTCHR
         ldaa  #$20
         jsr   PUTCHR
         ldaa  LASTTERMINATOR          ; show last terminator character
         jsr   PUTCHR
         jsr   PCRLF
         ldaa  Byte
         staa  Word                    ; save as previous character
         cmpa  #$0D
         bne   TestNXTCHloop
         ldaa  LINEBUFFER
         cmpa  #$0D                    ; empty line ?
         bne   TestINBUFF              ; b/ no
         page
         jsr   PrintInline
         fcc   "Test RSTRIO"
         fcb   $0D,$0A,0
         jsr   RSTRIO
         page
         jsr   PrintInline
         fcc   "Test GETHEX: Enter hex values, exit via <RETURN>"
         fcb   $0D,$0A,0
TestGETHEX
         jsr   INBUFF
         ldaa  LINEBUFFER
         cmpa  #$0D
         beq   TestGETHEXdone
         jsr   GETHEX
         stx   Word                    save value collected
         pshb
         bcc   GETHEXVALIDCC
         jsr   PrintInline
         fcc   "Carry=1 "
         fcb   0
         bra   TestGetHex1

GETHEXVALIDCC
         jsr   PrintInline
         fcc   "Carry=0 "
         fcb   0
TestGetHex1
         pulb
         tstb
         bne   GETHEXVALID1
         jsr   PrintInline
         fcc   "B=0! "
         fcb   0
GETHEXVALID1
         ldx   #Word
         jsr   OUTADR
         ldaa  #$20
         jsr   PUTCHR
         jsr   NXTCH                   output delimiter character
         jsr   PUTCHR
         jsr   PCRLF
         bra   TestGETHEX

TestGETHEXdone
         page
         jsr   PrintInline
         fcc   "Test INDEC: Enter decimal values, exit via <RETURN>"
         fcb   $0D,$0A,0
TestINDEC
         jsr   INBUFF
         ldaa  LINEBUFFER
         cmpa  #$0D
         beq   TestINDECdone
         jsr   INDEC
         stx   Word                    save value collected
         pshb
         bcc   INDECVALIDCC
         jsr   PrintInline
         fcc   "Carry=1 "
         fcb   0
         bra   TestINDEC1

INDECVALIDCC
         jsr   PrintInline
         fcc   "Carry=0 "
         fcb   0
TestINDEC1
         pulb
         tstb
         bne   INDECVALID1
         jsr   PrintInline
         fcc   "B=0! "
         fcb   0
INDECVALID1
         ldx   #Word
         jsr   OUTDEC
         ldaa  #$20
         jsr   PUTCHR
         jsr   NXTCH                   output delimiter character
         jsr   PUTCHR
         jsr   PCRLF
         bra   TestINDEC

TestINDECdone
         page
         jsr   PrintInline
         fcc   "GETFIL, SETEXT, LOAD and RPTERR are tested by"
         fcb   $0D,$0A
         fcc   "FLEXsim command loop, so they are not tested here"
         fcb   $0D,$0A,0

         jsr   PrintInline
         fcc   "Testing STAT...takes about 3 seconds"
         fcb   $0D,$0A,0
         clr   Word
         clr   Word+1
TestSTATloop
         jsr   STAT
         beq   NoCharacter             b/ supposed to always branch
         jsr   PrintInline
         fcc   "Key struck: "
         fcb   0
         jsr   GETCHR
         staa  Byte
         ldx   #Byte
         jsr   OUTHEX
         jsr   PCRLF
NoCharacter
         ldx   Word
         inx
         stx   Word
         bne   TestSTATloop
         page
FileTests ; test FMS interface
         jsr   PrintInLine
         fcc   "Check that can't close FCB that was never open"
         fcb   $0D,$0A,0
         ldx   #FCB                    ; get pointer for FCB
         ldaa  #FMS:CloseFile
         staa  FCBFunctionCode,x
         jsr   FMS
         beq   TestFMSClose1           ; b/ no error? why not?
         ldaa  FCBErrorStatusByte,x
         cmpa  #BadFileControlBlock
         beq   TestFMSClose2           ; b/ correct error
         jsr   RecordError
         jsr   RPTERR                  report error
         jsr   PrintInLine
         fcc   "Wrong error reported"
         fcb   $0D,$0A,0
         bra   TestFMSClose2

TestFMSClose1 ; no error? why not?
         jsr   RecordError
         jsr   PrintInline
         fcc   "No error when attempt to close never-opened FCB"
         fcb   $0D,$0A,0
TestFMSClose2 ; continue here
         page
         jsr   PrintInLine
         fcc   "Test FMSOpenForWrite"
         fcb   $0D,$0A,0
         ; Place JUNK.TXT as file name into FCB
         ldx   #FCB                    ; set file name into FCB
         ldaa  #0                      ; drive number
         staa  FCBDriveNumber,x
         ldaa  #'j
         staa  FCBFileName,x
         lda   #'u
         staa  FCBFileName+1,x
         ldaa  #'n
         staa  FCBFileName+2,x
         ldaa  #'k
         staa  FCBFileName+3,x
         clr   FCBFileName+4,x
         clr   FCBFileName+5,x
         clr   FCBFileName+6,x
         clr   FCBFileName+7,x
         clr   FCBExtension,x
         clr   FCBExtension+1,x
         clr   FCBExtension+2,x
         ldaa  #1                      code for .TXT extension
         jsr   SETEXT
         ldaa  #FMS:DeleteFile         get rid of old JUNK.TXT file
         staa  FCBFunctionCode,x
         jsr   FMS
         beq   TestFileDeleted
         ldaa  FCBErrorStatusByte,x
         cmpa  #FileNotFound
         beq   TestFileDeleted
         jsr   RecordError
         jsr   RPTERR
         jsr   PrintInLine
         fcc   "...while trying to delete JUNK.TXT"
         fcb   $0D,$0A,0
TestFileDeleted ; JUNK.TXT no longer exists
         page
         ldaa  #FMS:OpenForWrite
         staa  FCBFunctionCode,x
         jsr   FMS
         beq   TestFMSOpenForWrite1
         jsr   RecordError
         jsr   RPTERR                  report error
TestFMSOpenForWrite1
         jsr   PrintInLine
         fcc   "Check that OPEN FCB can't be re-used"
         fcb   $0D,$0A,0
         ldx   #FCB                    ; get pointer for FCB
         ldaa  #FMS:OpenForRead
         staa  FCBFunctionCode,x
         jsr   FMS
         beq   TestFMSOpenForWrite2    ; b/ no error? why not?
         ldaa  FCBErrorStatusByte,x
         cmpa  #BadFileControlBlock
         beq   TestFMSOpenForWrite3    ; b/ correct error
         jsr   RecordError
         jsr   RPTERR                  report error
         jsr   PrintInLine
         fcc   "Wrong error reported"
         fcb   $0D,$0A,0
         bra   TestFMSOpenForWrite3

TestFMSOpenForWrite2 ; no error? why not?
         jsr   RecordError
         jsr   PrintInline
         fcc   "Already OPEN FCB not detected when second OPEN tried"
         fcb   $0D,$0A,0
TestFMSOpenForWrite3
         page
         jsr   PrintInLine
         fcc   "Filling file with sequential codes via WriteNextByte..."
         fcb   $0D,$0A,0
         clr   Word                    ; good for count of 65536 byte pairs
         clr   Word+1
         ldx   #FCB                    ; get pointer for FCB
         ldaa  #FMS:ReadWriteNextByteCharacter
         staa  FCBFunctionCode,x
TestFMSWriteNextByteLoop ; write 128kb into file
         ldx   #FCB                    ; get pointer for FCB
         ldaa  Word                    ; get upper 8 bits of byte pair
         jsr   FMS                     ; write the byte to the file
         bne   TestFMSWriteNextByteLoopError ; b/ screwed up!
         ldaa  Word+1
         jsr   FMS
         beq   TestFMSWriteNextByte1   ; b/ all is ok
TestFMSWriteNextByteLoopError ; b/ screwed up!
         jsr   RecordError
         ldaa  FCBErrorStatusByte,x
         jsr   RPTERR                  report error<note: want to create file suitable for random access!> put this in create logi
         ldaa  #1                      ; set FileSectorMap to make random file
         staa  FCBFileSectorMapIndicator,x ; force FLEX to create random file
TestFMSWriteNextByte1 ; set to write next byte pair
         ldx   Word                    ; advance counter
         inx
         stx   Word
         bne   TestFMSWriteNextByteLoop ; b/ more to write
         ldx   #FCB                    ; get pointer for FCB
         ldd   FCBFileSize,x           ; fetch size of file
         cmpd  #520                    ; (65536*2)/252
         beq   TestFMSWriteNextByte2   ; b/ file size seems right
         jsr   RecordError
         jsr   PrintInline
         fcc   "Wrong FCBFileSize after filling file."
         fcb   $0D,$0A,0
TestFMSWriteNextByte2
         page
         jsr   PrintInline
         fcc   "Testing NEXTSEQUENTIALSECTOR on Write-file at EOF."
         fcb   $0D,$0A,0
         ldx   #FCB                    ; get pointer for FCB
         ldaa  #FMS:NextSequentialSector
         staa  FCBFunctionCode,x
         ldx   #FCB                    ; get pointer for FCB
         jsr   FMS                     ; skip to next sector
         beq   TestFMSNextSequentialSectorWrite ; b/ no error expected
         jsr   RecordError
         jsr   RPTERR                  ; report the error
TestFMSNextSequentialSectorWrite ; File now ends on a "sector" boundary
         ldx   #FCB                    ; get pointer for FCB
         ldd   FCBFileSize,x           ; fetch size of file
         cmpd  #521                    ; should be one more record
         beq   TestFMSNextSequentialSectorWrite2 ; b/ file size seems right
         jsr   RecordError
         jsr   PrintInline
         fcc   "Wrong FCBFileSize after doing NEXTSEQUENTIALSECTOR."
         fcb   $0D,$0A,0
TestFMSNextSequentialSectorWrite2
         page
         jsr   PrintInline
         fcc   "Testing that Position to Record N is illegal."
         fcb   $0D,$0A,0
         ldx   #FCB
         ldaa  #FMS:PositionToRecordN
         staa  FCBFunctionCode,x
         jsr   FMS
         beq   TestPositionIllegal1    ; b/ no error ?
         ldaa  FCBErrorStatusByte,x
         cmpa  #SystemFileStatusError
         beq   TestPositionIllegal2    ; ok
         jsr   RecordError
         jsr   RPTERR
         bra   TestPositionIllegal2

TestPositionIllegal1 ; no error ?
         jsr   RecordError
         fcc   "Missing error on illegal operation."
         fcb   $0D,$0A,0
TestPositionIllegal2  ; TestPositionIllegal completed.

         jsr   PrintInline
         fcc   "Testing that Backup one Record is illegal."
         fcb   $0D,$0A,0
         ldx   #FCB
         ldaa  #FMS:BackupOneRecord
         staa  FCBFunctionCode,x
         jsr   FMS
         beq   TestBackupOneRecordIllegal1    ; b/ no error ?
         ldaa  FCBErrorStatusByte,x
         cmpa  #SystemFileStatusError
         beq   TestBackupOneRecordIllegal2    ; ok
         jsr   RecordError
         jsr   RPTERR
         bra   TestBackupOneRecordIllegal2

TestBackupOneRecordIllegal1 ; no error ?
         jsr   RecordError
         fcc   "Missing error on illegal operation."
         fcb   $0D,$0A,0
TestBackupOneRecordIllegal2  ; TestBackupOneRecordIllegal completed.
         page
         jsr   PrintInline
         fcc   "Closing file after filling."
         fcb   $0D,$0A,0
         ldx   #FCB                    ; get pointer for FCB
         ldaa  #FMS:CloseFile
         staa  FCBFunctionCode,x
         ldx   #FCB                    ; get pointer for FCB
         jsr   FMS                     ; write the byte to the file
         beq   TestFMSCloseFileafterWrite1 ; b/ no error expected
         jsr   RecordError
         jsr   RPTERR                  ; report the error
TestFMSCloseFileafterWrite1 ; File has been created and filled.
         page
         jsr   PrintInLine
         fcc   "Opening JUNK.TXT in read-only mode"
         fcb   $0D,$0A,0
         ldx   #FCB
         ldaa  #FMS:OpenForRead
         staa  FCBFunctionCode,x
         jsr   FMS
         beq   TestFMSOpenForRead1
         jsr   RecordError
         jsr   RPTERR                  report error
TestFMSOpenForRead1
         ldx   #FCB                    ; get pointer for FCB
         ldd   FCBFileSize,x           ; fetch size of file
         cmpd  #520+1                  ; # records that should be in file
         beq   TestFMSOpenForRead1a    ; b/ file size seems right
         jsr   RecordError
         jsr   PrintInline
         fcc   "Wrong FCBFileSize after doing OPEN for Read."
         fcb   $0D,$0A,0
TestFMSOpenForRead1a
         jsr   SequentialTestWORewind  do sequential verify on file
         jsr   SequentialTest          ; test Rewind and read thru file
         page
         jsr   PrintInline
         fcc   "Closing file after sequential verify."
         fcb   $0D,$0A,0
         ldx   #FCB                    ; get pointer for FCB
         ldaa  #FMS:CloseFile
         staa  FCBFunctionCode,x
         ldx   #FCB                    ; get pointer for FCB
         jsr   FMS                     ; write the byte to the file
         beq   TestFMSCloseFileafterVerify1 ; b/ no error expected
         jsr   RecordError
         jsr   RPTERR                  ; report the error
TestFMSCloseFileafterVerify1 ; File has been created and filled.

         jsr   PrintInline
         fcc   "Opening file for Update."
         fcb   $0D,$0A,0
         ldx   #FCB
         ldaa  #FMS:OpenForUpdate
         staa  FCBFunctionCode,x
         jsr   FMS
         beq   TestFMSOpenForUpdate1
         jsr   RecordError
         jsr   RPTERR                  report error
TestFMSOpenForUpdate1
         ldx   #FCB                    ; get pointer for FCB
         ldd   FCBFileSize,x           ; fetch size of file
         cmpd  #520+1                  ; (65536+65536)/252+1
         beq   TestFMSOpenForUpdate1a ; b/ file size seems right
         jsr   RecordError
         jsr   PrintInline
         fcc   "Wrong FCBFileSize after doing NEXTSEQUENTIALSECTOR."
         fcb   $0D,$0A,0
TestFMSOpenForUpdate1a
         page
         jsr   PrintInline
         fcc   "Testing Random read positioning..."
         fcb   $0D,$0A,00
         ldx   #1000                   ; read randomly 1000 times
         stx   Word
TestRandomReadLoop ; loop here to read randomly
         jsr   RollRandomNumber
         jsr   ComputeLRNandOffset
         ldx   #FCB
         ldaa  #FMS:PositionToRecordN
         staa  FCBFunctionCode,x
         ldd   DesiredLRN
         std   FCBCurrentRecordNumber,x signal where we want to go
         jsr   FMS
         beq   TestFMSRandomRead1      b/ no errors
         jsr   RecordError
         jsr   RPTERR
TestFMSRandomRead1
         ldx   #FCB
         ldaa  #FMS:GetRandomByteFromSector
         staa  FCBFunctionCode,x
         ldaa  DesiredOffset
         adda  #4
         staa  FCBRandomIndex,x        set offset into sector
         jsr   FMS
         beq   TestFMSRandomRead2      b/ no errors
         jsr   RecordError
         jsr   RPTERR
TestFMSRandomRead2 ; byte we desire is in (A)
         cmpa  RandomNumber            match to random number
         beq   TestFMSRandomRead3      b/ matches!
         jsr   RecordError
         jsr   PrintInline
         fcc   "1st byte of pair failed to match"
         fcb   $0D,$0A,0
TestFMSRandomRead3
         ldx   #FCB
         inc   FCBRandomIndex,x        set offset into sector
         jsr   FMS
         beq   TestFMSRandomRead4      b/ no errors
         jsr   RecordError
         jsr   RPTERR
TestFMSRandomRead4 ; byte we desire is in (A)
         cmpa  RandomNumber+1          match to random number
         beq   TestFMSRandomRead5      b/ matches!
         jsr   RecordError
         jsr   PrintInline
         fcc   "2nd byte of pair failed to match"
         fcb   $0D,$0A,0
TestFMSRandomRead5
         ldx   Word                    ; decrement # random reads left
         dex
         stx   Word
         bne   TestRandomReadLoop      ; b/ more tries to do
         page
         jsr   PrintInline
         fcc   "Testing Random Write positioning..."
         fcb   $0D,$0A,00
         ldx   #1000                   ; Write randomly 1000 times
         stx   Word
TestRandomWriteLoop ; loop here to read randomly
         jsr   RollRandomNumber
         jsr   ComputeLRNandOffset
         ldx   #FCB
         ldaa  #FMS:PositionToRecordN
         staa  FCBFunctionCode,x
         ldd   DesiredLRN
         std   FCBCurrentRecordNumber,x signal where we want to go
         jsr   FMS
         beq   TestFMSRandomWrite1      b/ no errors
         jsr   RecordError
         jsr   RPTERR
TestFMSRandomWrite1
         ldx   #FCB
         ldaa  #FMS:PutRandomByteInSector
         staa  FCBFunctionCode,x
         ldaa  DesiredOffset
         adda  #4
         staa  FCBRandomIndex,x        set offset into sector
         ldaa  RandomNumber            which byte to store into file
         jsr   FMS
         beq   TestFMSRandomWrite2      b/ no errors
         jsr   RecordError
         jsr   RPTERR
TestFMSRandomWrite2 ; byte we desire is in (A)
         ldx   #FCB
         inc   FCBRandomIndex,x        set offset into sector
         ldaa  RandomNumber+1
         jsr   FMS
         beq   TestFMSRandomWrite4      b/ no errors
         jsr   RecordError
         jsr   RPTERR
TestFMSRandomWrite4 ; byte we desire is in (A)
         ldx   Word                    ; decrement # random reads left
         dex
         stx   Word
         bne   TestRandomWriteLoop      ; b/ more tries to do
         page
;        <test backup one record>
;        ldaa  #FMS:BackupOneRecord
;        staa  FCBFunctionCode,x
         page
         jsr   PrintInline
         fcc   "Closing file after random write."
         fcb   $0D,$0A,0
         ldx   #FCB                    ; get pointer for FCB
         ldaa  #FMS:CloseFile
         staa  FCBFunctionCode,x
         ldx   #FCB                    ; get pointer for FCB
         jsr   FMS                     ; write the byte to the file
         beq   TestFMSCloseFileafterRandomWrite1 ; b/ no error expected
         jsr   RecordError
         jsr   RPTERR                  ; report the error
TestFMSCloseFileafterRandomWrite1 ; File has been randomly written.
         jsr   PrintInLine
         fcc   "Opening JUNK.TXT in read-only mode for sequential verify"
         fcb   $0D,$0A,0
         ldx   #FCB
         ldaa  #FMS:OpenForRead
         staa  FCBFunctionCode,x
         jsr   FMS
         beq   TestFMSOpenForReadAfterRandom
         jsr   RecordError
         jsr   RPTERR                  report error
TestFMSOpenForReadAfterRandom
         ldx   #FCB                    ; get pointer for FCB
         ldd   FCBFileSize,x           ; fetch size of file
         cmpd  #520+1                  ; # records that should be in file
         beq   TestFMSOpenForReadAfterRandom1a    ; b/ file size seems right
         jsr   RecordError
         jsr   PrintInline
         fcc   "Wrong FCBFileSize after doing OPEN for Read."
         fcb   $0D,$0A,0
TestFMSOpenForReadAfterRandom1a
         jsr   SequentialTest          ; verify file is sequentially readable
         page
         jsr   PrintInline
         fcc   "Test FMSCLOSE"
         fcb   $0D,$0A,0
         jsr   FMSCLOSE
         ldx   FCBBASEPOINTER
         beq   FMSCLOSEOK
         jsr   RecordError
         jsr   PrintInline
         fcc   "Failed to close all FCBs!"
         fcb   $0D,$0A,0
FMSCLOSEOK
         page
         jsr   PrintInline
         fcc   "Test RENAME file"
         fcb   $0D,$0A,0
         ldx   #FCB
         ldaa  #FMS:RenameFile
         staa  FCBFunctionCode,x
         ldaa  #'j
         staa  FCBRenameToFileSpecification,x
         ldaa  #'u
         staa  FCBRenameToFileSpecification+1,x
         ldaa  #'n
         staa  FCBRenameToFileSpecification+2,x
         ldaa  #'k
         staa  FCBRenameToFileSpecification+3,x
         ldaa  #'1
         staa  FCBRenameToFileSpecification+4,x
         clr   FCBRenameToFileSpecification+5,x
         clr   FCBRenameToFileSpecification+6,x
         clra  FCBRenameToFileSpecification+7,x
         ldaa  #'t
         staa  FCBRenameToFileSpecification+8,x
         ldaa  #'m
         staa  FCBRenameToFileSpecification+9,x
         ldaa  #'p
         staa  FCBRenameToFileSpecification+10,x
         jsr   FMS
         beq   TestRenameOK
         jsr   RecordError
         jsr   RPTERR
TestRenameOK
         page
         jsr   PrintInline
         fcc   "Test DELETE File"
         fcb   $0D,$0A,0
         ldx   #FCB
         ldaa  #FMS:DeleteFile
         staa  FCBFunctionCode,x
         ldaa  #'j
         staa  FCBFileName,x
         ldaa  #'u
         staa  FCBFileName+1,x
         ldaa  #'n
         staa  FCBFileName+2,x
         ldaa  #'k
         staa  FCBFileName+3,x
         ldaa  #'1
         staa  FCBFileName+4,x
         clr   FCBFileName+5,x
         clr   FCBFileName+6,x
         clr   FCBFileName+7,x
         ldaa  #'t
         staa  FCBExtension+0,x
         ldaa  #'m
         staa  FCBExtension+1,x
         ldaa  #'p
         staa  FCBExtension+2,x
         jsr   FMS
         beq   TestDeleteOK
         jsr   RecordError
         jsr   RPTERR
TestDeleteOK
         ldx   #FCB
         jsr   FMS                     ; try to delete it again
         beq   TestDeleteNoError       ; b/ no error ?
         ldaa  FCBErrorStatusByte,x
         cmpa  #FileNotFound
         beq   TestDeleteDone
         jsr   RecordError
         jsr   RPTERR
         jsr   PrintInline
         fcc   "2nd delete should have got NO SUCH FILE"
         fcb   $0D,$0A,0
         bra   TestDeleteDone

TestDeleteNoError ; no error ?
         jsr   RecordError
         jsr   PrintInLine
         fcc   "No error when DELETE non-existent file."
         fcb   $0D,$0A,0
TestDeleteDone ; Test delete is done
         page
         jsr   PrintInline
         fcc   "Test FINDNEXTDRIVE"
         fcb   $0D,$0A,0
         ldx   #FCB
         ldaa  #FMS:FindNextDrive
         staa  FCBFunctionCode,x
         ldaa  #$FF
         staa  FCBDriveNumber,x
         jsr   FMS
         bcc   TestFindNextDrive2
         jsr   RecordError
         jsr   RPTERR
         bra   TestFindNextDrive3

TestFindNextDrive2
         ldaa  FCBDriveNumber,x
         beq   TestFindNextDrive3
         jsr   RecordError
         jsr   PrintInline
         fcc   "Nonzero-drive number returned as READY."
         fcb   $0D,$0A,0
TestFindNextDrive3
         ldx   #FCB
         ldaa  #FMS:FindNextDrive
         staa  FCBFunctionCode,x
         ldaa  #0
         staa  FCBDriveNumber,x
         jsr   FMS
         bcs   TestFindNextDrive4
         jsr   RecordError
         jsr   PrintInLine
         fcc   "Drives other than 0 reported as ready."
         fcb   $0D,$0A,0
TestFindNextDrive4 ; End of FindNextDrive tests
         page
         if    0
***** Objects/Functions left that still need to be tested

FCBFileAttributes
FCBFileCreationDate
FCBCurrentPosition
FCBCurrentRecordNumber
FCBDataIndex
FCBRandomIndex
FCBSpaceCompressionFlag

IllegalFMA
FileBusy
FileExists
FileNotFound
WriteProtected
DeleteProtected
IllegalFileSpecification
NonexistentRecordNumber
CommandSyntaxError
         fin
         page
         jsr   PrintInLine
         fcc   "Test operation of Printer"
         fcb   $0D,$0A,0
         jsr   PINIT                   ; should just work

         jsr   TestP
         fcc   "This string should be printed on LPT:"
         fcb   $0D,$0A                 ; verify that LF is supressed
         fcb   $80+'T                  ; force PINIT a second time
         fcc   "his is the last line to be printed on LPT:"
         fcb   $0D,$0A                 ; verify that LF is supressed
         fcb   0
TestP    pulx                          ; get pointer to string
TestPL   jsr   PCHK                    ; see if printer is ready
         bpl   TestPL                  ; b/ no
         ldaa  ,x+                     ; fetch next byte
         beq   TestPDone               ; b/ printer test done
         bpl   Testp2                  ; b/ normal character
         psha                          ; save byte
         jsr   PINIT                   ; test redundant PINIT has no effect
         pula
Testp2   jsr   POUT                    ; output the character
         bra   TestPL                  ; go output another character

TestPDone ; printer test complete
         page
         jsr   PrintInline
         fcc   "Except for ILLEGAL FLEX ENTRY POINTS, Diagnostic complete."
         fcb   $0D,$0A,0
         jmp   WARMS                   ; give up when done

;        The following tests must be performed by hand.
;        An easy way is to set at SWI at the call to WARMS above,
;        change the PC to point to each of these in turn,
;        and turn them loose.  They should all fail.
         jsr   COLDS                   ; verify this fails
         jsr   DOCMND                  ; verify this fails
         jsr   FMSINIT                 ; verify this fails
         jsr   READSECTOR              ; verify this fails
         jsr   WRITESECTOR             ; verify this fails
         jsr   VERIFY                  ; verify this fails
         jsr   RESTORE                 ; verify this fails
         jsr   DRIVESELECT             ; verify this fails
         jsr   CHECKDRIVEREADY         ; verify this fails
         jsr   QUICKCHECKDRIVEREADY    ; verify this fails
         jsr   ULH                     ; verify this fails
         jsr   MTROFF                  ; verify this fails
         jsr   FCTE                    ; verify this fails
         jsr   INCHNE                  ; verify this fails
         page
SequentialTest ; Come here to rewind and sequentially read thru a file
; THIS IS A MAJOR SUBROUTINE OF THE FMS TESTS
         jsr   PrintInline
         fcc   "Test REWINDFILE"
         fcb   $0D,$0A,0
         ldx   #FCB                    ; get pointer for FCB
         ldaa  #FMS:RewindFile
         staa  FCBFunctionCode,x
         ldx   #FCB                    ; get pointer for FCB
         jsr   FMS                     ; write the byte to the file
         beq   TestFMSRewindFile1      ; b/ no error expected
         jsr   RecordError
         jsr   RPTERR                  ; report the error
TestFMSRewindFile1 ; File has been rewound.
         ldx   #FCB                    ; get pointer for FCB
         ldaa  FCBFunctionCode,x
         cmpa  #FMS:ReadWriteNextByteCharacter
         beq   TestFMSRewindFile2
         jsr   RecordError
         jsr   PrintInline
         fcc   "Function Code not properly reset."
         fcb   $0D,$0A,0
TestFMSRewindFile2
         ldd   FCBCurrentRecordNumber,x ; fetch where we are
         cmpd  #0
         beq   TestFMSRewindFile3
         jsr   RecordError
         jsr   PrintInline
         fcc   "Current Record number not zero."
         fcb   $0D,$0A,0
TestFMSRewindFile3
         page
SequentialTestWORewind ; enter here to sequentially test file W/O rewinding it
         clr   Word                    ; zero counter
         clr   Word+1
TestFMSReadNextByteLoop ; read file sequentially and check contents
         ldx   #FCB                    ; get prepared to read entire file
         ; assert: we are in Read/Write mode already
         jsr   FMS                     ; get 1st byte of pair
         bne   TestFMSReadNextByteError ; b/ error trying to read
         cmpa  Word                    ; better match, or we are out of sync
         beq   TestFMSReadNextByte1    ; b/ OK so far
         jsr   RecordError
         jsr   PrintInline
         fcc   "Failed match on 1st byte of pair"
         fcb   $0D,$0A,0
TestFMSReadNextByte1 ; b/ OK so far
         jsr   FMS
         bne   TestFMSReadNextByteError ; b/ error trying to read
         cmpa  Word+1                  ; better match, or we are out of sync
         beq   TestFMSReadNextByte2    ; b/ OK so far
         jsr   RecordError
         jsr   PrintInline
         fcc   "Failed match on 2nd byte of pair"
         fcb   $0D,$0A,0
TestFMSReadNextByte2 ; set to read next byte pair
         ldx   Word                    ; advance counter
         inx
         stx   Word
         bne   TestFMSReadNextByteLoop ; b/ more to read
         bra   TestFMSReadNext2

TestFMSReadNextByteError ; b/ screwed up!
         jsr   RecordError
         ldaa  FCBErrorStatusByte,x
         jsr   RPTERR                  report error
TestFMSReadNext2
         jsr   PrintInline
         fcc   "Testing NEXTSEQUENTIALSECTOR on Read-file at EOF."
         fcb   $0D,$0A,0
         ldx   #FCB                    ; get pointer for FCB
         ldaa  #FMS:NextSequentialSector
         staa  FCBFunctionCode,x
         ldx   #FCB                    ; get pointer for FCB
         jsr   FMS                     ; skip to next sector
         beq   TestFMSNextSequentialSectorRead ; b/ no error expected
         jsr   RecordError
         jsr   RPTERR                  ; report the error
TestFMSNextSequentialSectorRead ; File now ends on a "sector" boundary
         page
         ldx   #FCB                    ; get pointer for FCB
         ldd   FCBFileSize,x           ; fetch size of file
         cmpd  #520+1                  ; (65536+65536)/252+1
         beq   TestFMSNextSequentialSectorRead2 ; b/ file size seems right
         jsr   RecordError
         jsr   PrintInline
         fcc   "Wrong FCBFileSize after doing NEXTSEQUENTIALSECTOR."
         fcb   $0D,$0A,0
TestFMSNextSequentialSectorRead2
         ; Now, we should be exactly at EOF.
         ldx   #FCB
         jsr   FMS                     ; attempt to read byte at EOF
         beq   TestFMSReadNextByte3    ; b/ no error?
         ldaa  FCBErrorStatusByte,x    ; fetch error code
         cmpa  #EndOfFile              ; correct error code ?
         beq   TestFMSReadNextByte4    ; b/ yes
         jsr   RPTERR
TestFMSReadNextByte3 ; no error?
         jsr   RecordError
         jsr   PrintInline
         fcc   "Missing EOF error at correct point"
         fcb   $0D,$0A,0
TestFMSReadNextByte4
         rts
         page
RollRandomNumber ; make next random number from this one
         ldd   RandomNumber
         asld
         bcs   RollRandomNumber1
         eora  #$B7
         eorb  #$C1
RollRandomNumber1
         std   RandomNumber
         rts

RandomNumber fdb  0                    ; start with constant seed

ComputeLRNandOffset ; accepts byte pair number in (D)
; Generates DesiredLRN = (bytepairnumber*2)/252
;           DesiredOffset = remainder
         std   DesiredLRN              store (D) someplace safe
         ldab  #18
         clra                          zeroing the carry
ComputeLRNandOffsetLoop
         bcc   ComputeLRNandOffset1
         suba  #252
         sec
         bra   ComputeLRNandOffsetQ

ComputeLRNandOffset1
         adda  #(-252)&$FF
         bcs   ComputeLRNandOffsetQ
         suba  #(-252)&$FF
ComputeLRNandOffsetQ
         rol   DesiredLRN+1            shift in quotient bit
         rol   DesiredLRN
         rola
         decb
         bne   ComputeLRNandOffsetLoop
         rora
         staa  DesiredOffset
         rts
DesiredLRN  fdb  0                     position/252
DesiredOffset fcb 0                    remainder after division by 252
         page
RecordError ; Prints "*** ERROR @xxxx " with xxxx= return address
; All registers preserved
         pshs  cc,a,b,dp,x,y,u
         jsr   PrintInline
         fcc   "*** ERROR @ "
         fcb   0
         leax  10,s                    ; location of PC on stack
         jsr   OUTADR
         ldaa  #$20                    ; blank
         jsr   PUTCHR
         puls  cc,a,b,dp,x,y,u,pc

PrintInLine ; print string inline until 0 encountered
         pulx                          ; fetch return address
PrintInLineLoop ; print next in-line character
         ldaa  ,x+                     ; fetch next byte
         beq   PrintInLineDone         ; b/ end of string
         jsr   PUTCHR                  ; output character
         bra   PrintInLineLoop         ; and do it again

PrintInLineDone ; end of string
         jmp   ,x

Byte     fcb   0
Word     FDB   0
FDB65535 fdb   65535
FDBZERO  fdb   0

TestPSTRNGmessage
         fcc   "This tests to see if PSTRNG works."
         fcb   $0D,$0A                 ; test that LineFeed is supressed after CR
         fcc   "Test LF works in middle ->"
         fcb   $0A
         fcc   "<- of line"
         fcb   EOS

FCB      rmb   FCBsize

         equ   *                       ; so we know where to put patches

         end   FLEXDIAG
