                 lst            off
                 tr             on
                 exp            off
                 cas            in
*======================================================
* The toolbox used by QuickASM to make things fast
* and cool for itself and user written tools!

* Written by Shawn Quick and Lane Roath
* Copyright (c) 1990 QuickSoft & Ideas From the Deep
*------------------------------------------------------
* 15-Mar-90 0.30 :GetWord, InitWildCard, ReadDir
* 05-Feb-90 0.20 :DateTime,CR,Space,Version, optimization
* 01-Feb-90 0.10 :first usable version
*======================================================

                 xc
                 xc
                 mx             %00
                 rel

Class1           =              $0000                       ;class 0

                 lst            off
                 use            2/data/qa.equates
                 use            tool.macs
                 lst            rtn

mainbank         =              $000000                     ;some local equates
auxbank          =              $010000

hexlen           =              8
declen           =              10
maxlevels        =              30                          ;allow 30 levels of directory nesting

*======================================================
* The routine table required of any toolbox

tooltbl          adrl           {:tblend-tooltbl}/4
                 adrl           qabootinit-1                ;   $01 _QABootInit()
                 adrl           qastartup-1                 ;   $02 _QAStartup(userid,modeflags/4)
                 adrl           qashutdown-1                ;   $03 _QAShutdown()
                 adrl           qaversion-1                 ;   $04 _QAVersion():versionnum
                 adrl           qareset-1                   ;   $05 _QAReset()
                 adrl           qastatus-1                  ;   $06 _QAStatus():statflag
                 adrl           reserved-1                  ;   $07
                 adrl           reserved-1                  ;   $08
                 adrl           qadrawchar-1                ;   $09 _QADrawChar(char)
                 adrl           qadrawstring-1              ;   $0A _QADrawString(@strptr)
                 adrl           qaprbyte-1                  ;   $0B _QAPrByte(hexbyte)
                 adrl           qaprbytel-1                 ;   $0C _QAPrBytel(hexval/4)
                 adrl           qadrawdec-1                 ;   $0D _QADrawDec(longint/4,flags,fieldsize)
                 adrl           qakeyavail-1                ;   $0E _QAKeyAvail():availflag
                 adrl           qagetchar-1                 ;   $0F _QAGetChar():char (char in low/mod in high)
                 adrl           qagetline-1                 ;   $10 _QAGetLine(@linestr,@promptptr,maxlen)
                 adrl           qasetparmhdl-1              ;   $11 _QASetParmHdl(parmhandle)
                 adrl           qagetparmhdl-1              ;   $12 _QAGetParmHdl:parmhandle
                 adrl           qasetcmdhdl-1               ;   $13 _QASetCmdHdl(commandhandle,numcmds)
                 adrl           qagetcmdhdl-1               ;   $14 _QAGetCmdHdl:commandhandle,numcmds
                 adrl           qareadtotalerrs-1           ;$15 _QAReadTotalErrs():totalerrs
                 adrl           qagetmodeflags-1            ; $16 _QAGetModeFlags():modeflags/4
                 adrl           qasetmodeflags-1            ; $17 _QASetModeFlags(modeflags/4)
                 adrl           qaloadfile-1                ;   $18 _QALoadfile(@filename,filepos/4,length/4,@typelist,userid,address/4,memattrib):filehandle/4
                 adrl           qasavefile-1                ;   $19 _QASavefile(filehandle/4,@filename,filetype,auxtype/4)
                 adrl           qasetcmdline-1              ;   $1A _QASetCmdLine(@strptr)
                 adrl           qagetcmdline-1              ;   $1B _QAGetCmdLine(@strptr,maxlen)
                 adrl           qaparseline-1               ;   $1C _QAParseCmdLine(@strptr):cmdid,cmdtype
                 adrl           qagetquitflag-1             ;  $1D _QAGetQuitFlag():quitflag
                 adrl           qasetquitflag-1             ;  $1E _QASetQuitFlag(quitflag):
                 adrl           qasetcmdtbl-1               ;    $1F _QASetCmdTbl(@cmdtbl)
                 adrl           qagetcmdtbl-1               ;    $20 _QAGetCmdTbl():@cmdtbl
                 adrl           qaexeccmd-1                 ;      $21 _QAExecCommand(cmdtype,cmdid)
                 adrl           qagetmessbyid-1             ;  $22 _QAGetMessagebyID(userid):message,subtype/4
                 adrl           qarun-1                     ;       $23 _QARun()
                 adrl           qadispose-1                 ;      $24 _QADispose()
                 adrl           qashutdownid-1              ;   $25 _QAShutdownID(userid)
                 adrl           qacompile-1                 ;      $26 _QACompile(message,subtype/4)
                 adrl           qalink-1                    ;       $27 _QALink(message,subtype/4)
                 adrl           qacompileactive-1           ;$28 _QACompilerActive():activeflag
                 adrl           qalinkactive-1              ;   $29 _QALinkerActvie():activeflag
                 adrl           qagetcompileid-1            ; $2A _QAGetCompileID():compileid
                 adrl           qasetcompileid-1            ; $2B _QASetCompileID(compileid)
                 adrl           qagetlinkid-1               ;    $2C _QAGetLinkID():linkid
                 adrl           qasetlinkid-1               ;    $2D _QASetLinkID(linkid)
                 adrl           qagetvector-1               ;    $2E _QAGetVector(vect#):@address
                 adrl           qasetvector-1               ;    $2F _QASetVector(vect#,@address)
                 adrl           qaresetvectors-1            ; $30 _QAResetVectors()
                 adrl           qaevent-1                   ; $31 _QAEvent(@eventrecord,taskflag)
                 adrl           qagetcmdrecsize-1           ;$32 _QAGetCmdRecSize():recordsize
                 adrl           qatabtocol-1                ;     $33 _QATabtoCol(columnnum)
                 adrl           qaerrormsg-1                ;     $34 _QAErrorMsg(ErrorCode)
                 adrl           qabargraph-1                ;     $35 _QABarGraph(percent,@Message)
                 adrl           qaconvertpath-1             ;  $36 _QAConvertPath(@oldpath,@newpath,appendchar)
                 adrl           qatyp2txt-1                 ;      $37 _QAConvertTyp2Txt(filetype,@typestr)
                 adrl           qatxt2typ-1                 ;      $38 _QAConvertTxt2Typ(@typestr):type
                 adrl           qareaddir-1                 ;      $39 _QAReadDir(@pathname,@doroutine,flags)
                 adrl           qainitwildcard-1            ; $3A _QAInitWildcard(@wcstr,ft,aux/4,ftmask,auxmask/4)
                 adrl           notdefined-1                ;     $3B _QAUndefined()
                 adrl           qainittotalerrs-1           ;$3C _QAInitTotalErrs()
                 adrl           qainctotalerrs-1            ; $3D _QAIncTotalErrs()
                 adrl           qagettotalerrs-1            ; $3E _QAGetTotalErrs():totalerrs
                 adrl           qagetcancelflag-1           ;$3F _QAGetCancelFlag():cancelflag
                 adrl           qasetcancelflag-1           ;$40 _QASetCancelFlag(cancelflag)
                 adrl           qastarttiming-1             ;  $41 _QAStartTiming()
                 adrl           qaendtiming-1               ;    $42 _QAEndTiming:hours,minutes,seconds
                 adrl           qagetsymtbl-1               ;    $43 _QAGetSymTable():@table,symhandle/4,numlabels,nextptr/4
                 adrl           qasetsymtbl-1               ;    $44 _QASetSymTable(@table,symhandle/4,numlabels,nextptr/4)
                 adrl           qasetname-1                 ;      $45 _QASetPath(@pathname)
                 adrl           qagetname-1                 ;      $46 _QAGetPath(@pathname)
                 adrl           qagetobjtype-1              ;   $47 _QAGetObjType():type
                 adrl           qasetobjtype-1              ;   $48 _QASetObjType(type)
                 adrl           qagetobjname-1              ;   $49 _QAGetObjPath(@pathname)
                 adrl           qasetobjname-1              ;   $4A _QASetObjPath(@pathname)
                 adrl           notdefined-1                ;     $4B _QACallUSR(opcode,@operand):handled
                 adrl           notdefined-1                ;     $4C _QACallUser(rngstart,rngend,texthandle/4,textlen/4)
                 adrl           notdefined-1                ;     $4D _QAGoEVAL(@operand,offset):value/4
                 adrl           notdefined-1                ;     $4E _QAGoPutByte(byte)
                 adrl           notdefined-1                ;     $4F _QAGoPutOpcode(opcodebyte)
                 adrl           notdefined-1                ;     $50 _QAGoRelcorrect()
                 adrl           qadrawerrchar-1             ;$51 _QADrawErrChar(char)
                 adrl           qadrawerrstring-1           ;$52 _QADrawErrString(@strptr)
                 adrl           qagetwindow-1               ;    $53 _QAGetWindow():windowtype
                 adrl           qasetwindow-1               ;    $54 _QASetWindow(windowtype)
                 adrl           qagetshellid-1              ;   $55 _QAGetShellID():userid
                 adrl           qasetshellid-1              ;   $56 _QASetShellID(userid)
                 adrl           qagotoxy-1                  ;       $57 _QAGotoXY(x,y)
                 adrl           qagetxy-1                   ;       $58 _QAGetXY():X,Y
                 adrl           qaprnib-1                   ;       $59 _QAPrNibble(nibval)
                 adrl           qadrawhex-1                 ;      $5A _QADrawHex(hexval/4,flags,fieldsize)
                 adrl           qadrawblock-1               ;    $5B _QADrawBlock(@CBlock)
                 adrl           qadrawerrblock-1            ; $5C _QADrawErrBlock(@CBlock)
                 adrl           qadrawmultchar-1            ; $5D _QADrawCharX(char,count)
                 adrl           qadrawmultechar-1           ;$5E _QADrawECharX(char,count)
                 adrl           qagetlaunch-1               ;    $5F _QAGetLaunch():@path,flags
                 adrl           qasetlaunch-1               ;    $60 _QASetLaunch(@path,flags)
                 adrl           QAGetWord-1                 ;      $61 _QAGetWord(@Text,Offset,MaxLen):BegOffset,EndOffset
                 adrl           QADateTime-1                ;     $62 _QAPrintDate(Flags,@DateTime)
                 adrl           QADrawCR-1                  ;      $63 _QADrawCR()
                 adrl           QADrawSpace-1               ;    $64 _QADrawSpace()
                 adrl           QAPrintVersion-1            ; $65 _QAPrintVersion(Version/4)
                 adrl           qadrawbox-1                 ;      $66 _QADrawBox(x,y,width,height):buffhdl
                 adrl           qaerasebox-1                ;     $67 _QAEraseBox(buffhdl)
                 adrl           qaconvertstr-1              ;   $68 _QAConvertString(@string/class.1,@buffer/class.1,cmdcode):rtncode
                 adrl           qadrawstrl-1                ;    $69 _QADrawStringL(@string/class.1)
                 adrl           qadrawerrstrl-1             ; $6A _QADrawErrStringL(@strptr/class.1)
                 adrl           qagetkeyadrs-1              ;  $6B _QAGetKeyAddress():keyaddress/4
                 adrl           QANextLine-1                ;     $6C _QANextLine(@Text,Offset,MaxLen):NewLineOffset
                 adrl           QAClearKey-1                ;     $6D _QAClearKey()
                 adrl           QAParseWord-1               ;    $6E _QAParseWord(???):???
:tblend

*======================================================
* Vector Tables: patched by graphics shell, etc...

vectortbl
                 jml            pchar                       ; #1  _QADrawChar
                 jml            pstr                        ; #2  _QADrawString
                 jml            pechar                      ; #3  _QADrawErrChar
                 jml            pestr                       ; #4  _QADrawErrString
                 jml            pblk                        ; #5  _QADrawCStr
                 jml            peblk                       ; #6  _QADrawECStr
                 jml            putop                       ; #7  _QAPutOpcode
                 jml            putbyte                     ; #8  _QAPutByte
                 jml            eval                        ; #9  _QAEval
                 jml            relcorrect                  ; #10 _QARelCorrect
                 jml            mykeyavail                  ; #11 _QAKeyAvail
                 jml            mygetchar                   ; #12 _QAGetChar
                 jml            mygetline                   ; #13 _QAGetLine
                 jml            mytabtocol
                 jml            rtl
                 jml            rtl
                 jml            rtl
                 jml            rtl
                 jml            rtl
                 jml            pstrl
                 jml            pestrl
                 adrl           0                           ;NOT a Vector but a HANDLE

vectortbl1                                                  ;--- copy of ORIGINAL for restoration ---
                 jml            pchar
                 jml            pstr
                 jml            pechar
                 jml            pestr
                 jml            pblk
                 jml            peblk
                 jml            putop
                 jml            putbyte
                 jml            eval
                 jml            relcorrect
                 jml            mykeyavail
                 jml            mygetchar
                 jml            mygetline
                 jml            mytabtocol
                 jml            rtl
                 jml            rtl
                 jml            rtl
                 jml            rtl
                 jml            rtl
                 jml            pstrl
                 jml            pestrl
                 adrl           0                           ;NOT a Vector but a HANDLE
vectend

*======================================================
* Common exit routines to set carry & processor status

noerror          rep            $30
                 lda            #0
errxit           rep            $30
                 cmp            #1
                 rtl

                 mx             %00
qabootinit       phb
                 phd
                 phk
                 plb
                 stz            started
                 pea            #userorsys
                 pea            #toolnum
                 pea            0
                 pea            0
                 tll            $0d01                       ;_setwap
                 psl            #0
                 psl            #qabootinit
                 tll            $1A02                       ;_Findhandle
                 tsc
                 inc
                 tcd
                 lda            0
                 ora            2
                 beq            :err
                 ldy            #$06
                 lda            [0],y
                 sta            userid
                 pla
                 pla
                 jsr            initvars
                 pld
                 plb
                 brl            noerror
:err             plx
                 plx
                 pld
                 plb
                 lda            #$FF
                 brl            errxit

qastartup
                 dum            0
]rtl             ds             6                           ;these are passed on stack
]modeflag        ds             4
]userid          ds             2
]newstack        =              *-6                         ;must be at end of passed params
                 dend

                 mx             %00
                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb

                 jsr            initvars                    ;insure vars inited
                 jsr            InitASK

                 lda            ]modeflag
                 sta            modeflags
                 lda            ]modeflag+2
                 sta            modeflags+2                 ;set parms passed
                 lda            ]userid
                 sta            initid
                 jsr            ttinitscreen
                 dec            started                     ;show we are started

:noerr1          lda            #0
:xit             rep            $30
                 tax
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 cmpl           :one
                 rtl
:one             dw             1
                 mx             %00

qashutdown       phb
                 phk
                 plb
                 stz            started
                 ~SetVector     #$F;EMKeyVect               ;restore event manager vectors
                 jsr            ttshutdown
                 jsr            initvars
                 plb
                 brl            noerror

qastatus         ldal           started
                 sta            7,s
                 brl            noerror

qareset          brl            noerror

qaversion        lda            #versionnum
                 sta            7,s
                 brl            noerror

reserved
notdefined       lda            #qanotstarted               ;not defined error
                 brl            errxit

initvars
                 lda            cmdhandle
                 ora            cmdhandle+2
                 beq            :1
                 psl            cmdhandle
                 _disposehandle                             ;do this before total clear!
:1
                 ldx            #DS_Size-2
]loop            stz            DS_Start,x
                 dex                                        ;clear all variables
                 dex
                 bpl            ]loop

                 jsl            QAResetVectors              ;insure originals are good

*------------------------------------------------------
* Init the text tool variables

ttinitvars
                 php
                 rep            $30
                 stz            outflag
                 stz            cursx
                 stz            cursy
                 stz            fullwindow
                 stz            wintop
                 stz            winleft
                 lda            #23
                 sta            winbot
                 lda            #80
                 sta            winwidth
                 lda            #$80                        ;normal, no mousetext
                 sta            charflag
                 jsr            setcurs
                 plp
                 rts

*======================================================
* Actual Tool Functions Start Here

                 mx             %00
qasetparmhdl
                 lda            7,s
                 stal           parmhandle
                 lda            9,s
                 stal           parmhandle+2
                 lda            5,s
                 sta            5+4,s
                 lda            3,s
                 sta            3+4,s
                 lda            1,s
                 sta            1+4,s
                 pla
                 pla
                 brl            noerror

qagetparmhdl
                 ldal           parmhandle
                 sta            7,s
                 ldal           parmhandle+2
                 sta            9,s
                 brl            noerror

                 mx             %00
qasetquitflag
                 lda            7,s
                 stal           quitflag
                 lda            5,s
                 sta            5+2,s
                 lda            3,s
                 sta            3+2,s
                 lda            1,s
                 sta            1+2,s
                 pla
                 brl            noerror
qagetquitflag
                 ldal           quitflag
                 sta            7,s
                 brl            noerror

                 mx             %00
qasetcancelflag
                 lda            7,s
                 stal           cancelflag
                 lda            5,s
                 sta            5+2,s
                 lda            3,s
                 sta            3+2,s
                 lda            1,s
                 sta            1+2,s
                 pla
                 brl            noerror
qagetcancelflag
                 ldal           cancelflag
                 sta            7,s
                 brl            noerror


                 mx             %00
qasetcompileid
                 lda            7,s
                 stal           compiler
                 lda            5,s
                 sta            5+2,s
                 lda            3,s
                 sta            3+2,s
                 lda            1,s
                 sta            1+2,s
                 pla
                 brl            noerror
qagetcompileid
                 ldal           compiler
                 sta            7,s
                 brl            noerror

                 mx             %00
qasetlinkid
                 lda            7,s
                 stal           linker
                 lda            5,s
                 sta            5+2,s
                 lda            3,s
                 sta            3+2,s
                 lda            1,s
                 sta            1+2,s
                 pla
                 brl            noerror
qagetlinkid
                 ldal           linker
                 sta            7,s
                 brl            noerror

qasetcmdtbl
                 lda            7,s
                 stal           cmdtbl
                 lda            9,s
                 stal           cmdtbl+2
                 lda            5,s
                 sta            5+4,s
                 lda            3,s
                 sta            3+4,s
                 lda            1,s
                 sta            1+4,s
                 pla
                 pla
                 brl            noerror

qagetcmdtbl
                 ldal           cmdtbl
                 sta            7,s
                 ldal           cmdtbl+2
                 sta            9,s
                 brl            noerror

qagetcmdrecsize
                 lda            #erecsize
                 sta            7,s
                 brl            noerror


qasetcmdhdl
                 lda            9,s
                 stal           cmdhandle
                 lda            11,s
                 stal           cmdhandle+2
                 lda            7,s
                 stal           numcmds
                 lda            5,s
                 sta            5+6,s
                 lda            3,s
                 sta            3+6,s
                 lda            1,s
                 sta            1+6,s
                 pla
                 pla
                 pla
                 brl            noerror
qagetcmdhdl
                 ldal           numcmds
                 sta            7,s
                 ldal           cmdhandle
                 sta            9,s
                 ldal           cmdhandle+2
                 sta            11,s
                 brl            noerror


qacalllang
                 dum            0
]rtl             ds             6                           ;these are passed on stack
]subtype         ds             4
]message         ds             2
]langid          ds             2
]newstack        =              *-6                         ;must be at end of passed params
                 dend

                 mx             %00
                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
***
                 lda            #0
:xit             rep            $30
                 tax
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 brl            errxit

QAParseWord
dummy
                 dum            0
]rtl             ds             6                           ;these are passed on stack
]newstack        =              *-6                         ;must be at end of passed params
                 dend

                 mx             %00
                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
***

:xit             rep            $30
                 tax
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 brl            errxit

qadrawchar
]char            =              8

                 phb
                 phk
                 plb
                 rep            $30
                 lda            windowflag
                 bne            :1
                 lda            ]char,s
                 jsl            {vprintchar*4}+vectortbl-4
                 bra            :xit
:1               lda            ]char,s
                 jsl            {verrchar*4}+vectortbl-4
:xit             plb
                 lda            5,s
                 sta            7,s
                 lda            3,s
                 sta            5,s
                 lda            1,s
                 sta            3,s
                 pla
                 brl            noerror

qadrawmultchar
]count           =              8
]char            =              10

                 phb
                 phk
                 plb
                 rep            $30
                 lda            windowflag
                 bne            :1
                 lda            ]count,s
                 beq            :xit
:0               lda            ]char,s
                 jsl            {vprintchar*4}+vectortbl-4
                 lda            ]count,s
                 dec
                 sta            ]count,s
                 bne            :0
                 bra            :xit
:1               lda            ]count
                 beq            :xit
:11              lda            ]char,s
                 jsl            {verrchar*4}+vectortbl-4
                 lda            ]count,s
                 dec
                 sta            ]count,s
                 bne            :11
:xit             plb
                 lda            5,s
                 sta            5+4,s
                 lda            3,s
                 sta            3+4,s
                 lda            1,s
                 sta            1+4,s
                 pla
                 pla
                 brl            noerror

qadrawmultechar
]count           =              8
]char            =              10

                 phb
                 phk
                 plb
                 rep            $30
                 lda            ]count,s
                 beq            :xit
:1               lda            ]char,s
                 jsl            {verrchar*4}+vectortbl-4
                 lda            ]count,s
                 dec
                 sta            ]count,s
                 bne            :1
:xit             plb
                 lda            5,s
                 sta            5+4,s
                 lda            3,s
                 sta            3+4,s
                 lda            1,s
                 sta            1+4,s
                 pla
                 pla
                 brl            noerror


qadrawstring
]strptr          =              8

                 phb
                 phk
                 plb
                 lda            ]strptr+2,s
                 tax
                 lda            ]strptr,s
                 tay
                 lda            windowflag
                 beq            :tya
                 tya
                 jsl            {verrstr*4}+vectortbl-4
                 bra            :xit
:tya             tya
                 jsl            {vprintstr*4}+vectortbl-4
:xit             plb
                 lda            5,s
                 sta            9,s
                 lda            3,s
                 sta            7,s
                 lda            1,s
                 sta            5,s
                 pla
                 pla
                 brl            noerror

qadrawerrchar
]char            =              7
                 phb
                 phk
                 plb
                 lda            ]char,s
                 jsl            {verrchar*4}+vectortbl-4
                 plb
                 lda            5,s
                 sta            7,s
                 lda            3,s
                 sta            5,s
                 lda            1,s
                 sta            3,s
                 pla
                 brl            noerror

qadrawerrstring
]strptr          =              8
                 phb
                 phk
                 plb
                 lda            ]strptr+2,s
                 tax
                 lda            ]strptr,s
                 jsl            {verrstr*4}+vectortbl-4
                 plb
                 lda            5,s
                 sta            9,s
                 lda            3,s
                 sta            7,s
                 lda            1,s
                 sta            5,s
                 pla
                 pla
                 brl            noerror

qadrawerrstrl
]strptr          =              8
                 phb
                 phk
                 plb
                 lda            ]strptr+2,s
                 tax
                 lda            ]strptr,s
                 jsl            {verrstrl*4}+vectortbl-4
                 plb
                 lda            5,s
                 sta            9,s
                 lda            3,s
                 sta            7,s
                 lda            1,s
                 sta            5,s
                 pla
                 pla
                 jmp            noerror

qadrawstrl
]strptr          =              8

                 phb
                 phk
                 plb
                 lda            ]strptr+2,s
                 tax
                 lda            ]strptr,s
                 tay
                 ldal           windowflag
                 beq            :tya
                 tya
                 jsl            {verrstrl*4}+vectortbl-4
                 bra            :xit
:tya             tya
                 jsl            {vprintstrl*4}+vectortbl-4
:xit             plb
                 lda            5,s
                 sta            9,s
                 lda            3,s
                 sta            7,s
                 lda            1,s
                 sta            5,s
                 pla
                 pla
                 jmp            noerror

qadrawblock
]strptr          =              8

                 phb
                 phk
                 plb
                 lda            ]strptr+2,s
                 tax
                 lda            ]strptr,s
                 tay
                 lda            windowflag
                 beq            :tya
                 tya
                 jsl            {verrblk*4}+vectortbl-4
                 bra            :xit
:tya             tya
                 jsl            {vprintblk*4}+vectortbl-4
:xit             plb
                 lda            5,s
                 sta            9,s
                 lda            3,s
                 sta            7,s
                 lda            1,s
                 sta            5,s
                 pla
                 pla
                 brl            noerror

qadrawerrblock
]strptr          =              8
                 phb
                 phk
                 plb
                 lda            ]strptr+2,s
                 tax
                 lda            ]strptr,s
                 jsl            {verrblk*4}+vectortbl-4
                 plb
                 lda            5,s
                 sta            9,s
                 lda            3,s
                 sta            7,s
                 lda            1,s
                 sta            5,s
                 pla
                 pla
                 brl            noerror


qatabtocol
                 lda            7,s
                 jsl            {vtabtocol*4}+vectortbl-4
                 tax
                 lda            5,s
                 sta            5+2,s
                 lda            3,s
                 sta            3+2,s
                 lda            1,s
                 sta            1+2,s
                 pla
                 txa
                 rtl

qagotoxy         lda            7,s
                 stal           cursy
                 lda            9,s
                 stal           cursx
                 phb
                 phk
                 plb
                 jsr            setcurs
                 plb
                 tax
                 lda            5,s
                 sta            5+4,s
                 lda            3,s
                 sta            3+4,s
                 lda            1,s
                 sta            1+4,s
                 pla
                 pla
                 txa
                 rtl

qagetxy          ldal           cursy
                 sta            7,s
                 ldal           cursx
                 sta            9,s
                 brl            noerror

qaprnib

]byte            =              7
                 lda            ]byte,s
                 jsr            myPrNib
                 lda            5,s
                 sta            7,s
                 lda            3,s
                 sta            5,s
                 lda            1,s
                 sta            3,s
                 pla
                 brl            noerror

qaprbyte

]byte            =              7
                 lda            ]byte,s
                 lsr
                 lsr
                 lsr
                 lsr
                 jsr            myPrNib
                 lda            ]byte,s
                 jsr            myPrNib
                 lda            5,s
                 sta            7,s
                 lda            3,s
                 sta            5,s
                 lda            1,s
                 sta            3,s
                 pla
                 brl            noerror

qaprbytel

]byte            =              7
                 lda            ]byte+1,s
                 lsr
                 lsr
                 lsr
                 lsr
                 jsr            myPrNib
                 lda            ]byte+1,s
                 jsr            myPrNib
                 lda            ]byte,s
                 lsr
                 lsr
                 lsr
                 lsr
                 jsr            myPrNib
                 lda            ]byte,s
                 jsr            myPrNib
                 lda            5,s
                 sta            7,s
                 lda            3,s
                 sta            5,s
                 lda            1,s
                 sta            3,s
                 pla
                 brl            noerror

myPrNib
                 phb
                 phk
                 plb
                 and            #$0F
                 tax
                 lda            hextbl,x
                 jsl            {vprintchar*4}+vectortbl-4
                 plb
                 rts

hextbl           asc            '0123456789ABCDEF'

*------------------------------------------------------
                 mx             %00
qakeyavail
                 lda            #0
                 sta            7,s
                 jsl            {vkeymac*4}+vectortbl-4
                 bcc            :myavail
                 sta            7,s
                 brl            noerror
:myavail
                 lda            #0
                 jsl            {vkeyavail*4}+vectortbl-4
                 rep            $30
                 bcs            :rtl
                 sta            7,s
:rtl             rtl

*------------------------------------------------------
qagetchar
                 lda            #$01
                 jsl            {vkeymac*4}+vectortbl-4
                 bcc            :myget
                 sta            7,s
                 brl            noerror
:myget           lda            #0
                 sta            7,s
                 jsl            {vgetchar*4}+vectortbl-4
                 rep            $30
                 bcs            :rtl
                 sta            7,s
:rtl             rtl

                 mx             %00

qagetmodeflags
                 ldal           modeflags
                 sta            7,s
                 ldal           modeflags+2
                 sta            9,s
                 brl            noerror

qasetmodeflags
                 lda            7,s
                 stal           modeflags
                 lda            9,s
                 stal           modeflags+2
                 lda            5,s
                 sta            9,s
                 lda            3,s
                 sta            7,s
                 lda            1,s
                 sta            5,s
                 pla
                 pla
                 brl            noerror

qalinkactive
                 ldal           linkactive
                 sta            7,s
                 brl            noerror
qacompileactive
                 ldal           compileactive
                 sta            7,s
                 brl            noerror

qaloadfile
                 dum            0

]loadzp          ds             4
]rtl             ds             3                           ;these are passed on stack
]rtl1            ds             3
]memattrib       ds             2
]loadadr         ds             4
]loadid          ds             2
]typeptr         ds             4
]length          ds             4
]filepos         ds             4
]nameptr         ds             4
]newstack        =              *-6                         ;must be at end of passed params
]loadhandle      ds             4                           ;these are returned on stack

                 dend

                 mx             %00

                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb

                 stz            :errcode                    ;init all variables
                 stz            :close
                 stz            :open
                 stz            :read
                 stz            :markparm
                 stz            :lockflag

                 stz            ]loadhandle
                 stz            ]loadhandle+2

                 lda            ]nameptr
                 sta            :pathptr
                 sta            :info
                 lda            ]nameptr+2
                 sta            :pathptr+2
                 sta            :info+2
                 lda            ]length
                 sta            :request
                 lda            ]length+2
                 sta            :request+2

                 _GSOS          _getfileinfo;:info
                 jcs            :doserror
                 sep            $30
                 lda            []typeptr]
                 beq            :all
                 tay
]lup             lda            []typeptr],y
                 cmp            :ftype
                 beq            :all
                 dey
                 bne            ]lup
                 rep            $30
                 lda            #$5C                        ;file mismatch error
                 brl            :doserror

:all             rep            $30
                 lda            ]length+2
                 and            ]length
                 cmp            #$ffff
                 bne            :norm

                 jsl            prodos
                 dw             $10
                 adrl           :open
                 jcs            :doserror

                 lda            :open
                 sta            :eof
                 jsl            prodos
                 dw             $19
                 adrl           :eof
                 jcs            :doserror
                 lda            :eof+2
                 sta            :request
                 lda            :eof+4
                 sta            :request+2

:norm            psl            #0
                 psl            :request
                 lda            ]loadid
                 pha
                 lda            ]memattrib
                 pha
                 psl            ]loadadr                    ;where do we want it?
                 tll            $0902
                 plx
                 ply
                 jcs            :doserror
                 stx            ]loadhandle
                 sty            ]loadhandle+2

                 ldy            #$04
                 lda            []loadhandle],y
                 and            #$8000
                 sta            :lockflag
                 lda            []loadhandle],y
                 ora            #$8000
                 sta            []loadhandle],y
                 ldy            #$02
                 lda            []loadhandle]
                 sta            :buffer
                 tax
                 lda            []loadhandle],y
                 sta            :buffer+2
                 sta            ]loadzp+2
                 stx            ]loadzp
:load            lda            :open
                 bne            :o
                 jsl            prodos
                 dw             $10
                 adrl           :open
                 jcs            :doserror
:o               lda            :open
                 sta            :read
                 sta            :markparm

                 lda            ]filepos
                 sta            :markparm+2
                 lda            ]filepos+2
                 sta            :markparm+4

                 jsl            prodos
                 dw             $16
                 adrl           :markparm
                 jcs            :doserror

                 jsl            prodos
                 dw             $12
                 adrl           :read
                 jcs            :doserror

                 _GSOS          _close;:open
                 stz            :open
                 jcs            :doserror

                 lda            :ftype
                 cmp            #$04
                 beq            :addcr
                 cmp            #$b0
                 bne            :noerr
:addcr           lda            :request
                 clc
                 adc            :buffer
                 sta            ]loadzp
                 lda            :request+2
                 adc            :buffer+2
                 sta            ]loadzp+2
                 lda            ]loadzp
                 bne            :d
                 dec            ]loadzp+2
:d               dec            ]loadzp
                 lda            []loadzp]
                 and            #$7f
                 cmp            #$0d
                 beq            :noerr
                 psl            ]loadhandle
                 _Hunlock
                 psl            #0
                 psl            ]loadhandle
                 _gethandlesize
                 pll            ]loadzp
                 inc            ]loadzp
                 bne            :noinc
                 inc            ]loadzp+2
:noinc           psl            ]loadzp
                 psl            ]loadhandle
                 _sethandlesize
                 bcs            :doserror
                 ldy            #$02
                 lda            []loadhandle]
                 clc
                 adc            ]loadzp
                 sta            ]loadzp
                 lda            []loadhandle],y
                 adc            ]loadzp+2
                 sta            ]loadzp+2
                 sep            $20
                 lda            #$0d
                 sta            []loadzp]
:noerr           rep            $30
                 lda            #0
:doserror        sta            :errcode
                 lda            ]loadhandle
                 ora            ]loadhandle+2
                 beq            :e1
                 lda            :errcode
                 bne            :dispose
                 ldy            #$04
                 lda            []loadhandle],y
                 and            #$7fff
                 ora            :lockflag
                 sta            []loadhandle],y
                 stz            :lockflag
                 bra            :e1
:dispose         psl            ]loadhandle
                 _disposehandle
                 stz            ]loadhandle
                 stz            ]loadhandle+2
:e1              lda            :open
                 beq            :noclose

                 jsl            prodos
                 dw             $14                         ;close the file
                 adrl           :open

:noclose         rep            $30
                 stz            :open
                 lda            :errcode
:xit             rep            $30
                 pha                                        ;save the error
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 pla
                 plb
                 pld
                 tax
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 cmp            #$01
                 rtl

:errcode         ds             2
:lockflag        ds             2

:open            dw             0
:pathptr         adrl           $0000
                 adrl           0
:markparm        dw             0
:mark            adrl           0
:read            dw             0
:buffer          ds             4
:request         ds             4
                 ds             4
:close           dw             0
:eof             ds             6,0
:info            adrl           $0000
                 dw             0
:ftype           dw             0
                 ds             18,0


***
qasavefile
                 dum            0

]rtl             ds             3                           ;these are passed on stack
]rtl1            ds             3
]auxtype         ds             4
]filetype        ds             2
]nameptr         ds             4
]datahandle      ds             4
]newstack        =              *-6                         ;must be at end of passed params

                 dend

                 mx             %00

                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb

                 stz            :errcode                    ;init all variables
                 stz            :open
                 stz            :lockflag

                 lda            ]nameptr
                 sta            :pathptr
                 sta            :create
                 sta            :info
                 lda            ]nameptr+2
                 sta            :pathptr+2
                 sta            :create+2
                 sta            :info+2

                 psl            #0
                 psl            ]datahandle
                 _gethandlesize
                 plx
                 ply
                 jcs            :err
                 stx            :request
                 sty            :request+2

                 _GSOS          _getfileinfo;:info
                 bcc            :nocreate

                 lda            ]filetype
                 sta            :ctype
                 lda            ]auxtype
                 sta            :caux
                 lda            ]auxtype+2
                 sta            :caux+2
                 _GSOS          _create;:create
                 jcs            :err
                 _GSOS          _getfileinfo;:info
                 jcs            :err

:nocreate
                 lda            :ftype
                 cmp            ]filetype
                 beq            :doopen
                 lda            #$5C                        ;file mismatch error
                 brl            :err
:doopen          _GSOS          _open;:open
                 jcs            :err
                 lda            :open
                 sta            :write
                 ldy            #$04
                 lda            []datahandle],y
                 and            #$8000
                 sta            :lockflag
                 lda            []datahandle],y
                 ora            #$8000
                 sta            []datahandle],y
                 ldy            #$02
                 lda            []datahandle]
                 sta            :buffer
                 lda            []datahandle],y
                 sta            :buffer+2
                 _GSOS          _write;:write
                 php
                 pha
                 ldy            #$04
                 lda            []datahandle],y
                 and            #$7fff
                 ora            :lockflag
                 sta            []datahandle],y
                 pla
                 plp
                 bcs            :err
                 lda            :open
                 sta            :mark
                 _GSOS          _getmark;:mark
                 _GSOS          _seteof;:mark
                 _GSOS          _close;:open
                 bcs            :err
                 stz            :open
                 _GSOS          _getfileinfo;:info
                 bcs            :err
                 lda            ]auxtype
                 sta            :aux
                 lda            ]auxtype+2
                 sta            :aux+2
                 _GSOS          _setfileinfo;:info
                 bcs            :err
                 lda            #0
:err             sta            :errcode
                 lda            :open
                 beq            :noclose
                 jsl            prodos
                 dw             $14                         ;close the file
                 adrl           :open
:noclose         rep            $30
                 stz            :open
                 lda            :errcode
:xit             rep            $30
                 pha                                        ;save the error
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 pla
                 plb
                 pld
                 tax
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 cmp            #$01
                 rtl

:errcode         ds             2
:lockflag        ds             2

:open            dw             0
:pathptr         adrl           $0000
                 adrl           0
:write           dw             0
:buffer          ds             4
:request         ds             4
                 ds             4
:info            adrl           $0000
                 dw             0
:ftype           dw             0
:aux             ds             18,0
:mark            ds             6
:create          adrl           0
                 dw             $e3
:ctype           dw             0
:caux            adrl           0
                 dw             $01
                 adrl           0
                 adrl           0


qagetcmdline
                 dum            0
]rtl             ds             6                           ;these are passed on stack
]maxlen          ds             2
]strptr          ds             4

]newstack        =              *-6                         ;must be at end of passed params
                 dend

                 mx             %00
                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
                 lda            ]maxlen
                 and            #$ff
                 beq            :xit
                 sta            ]maxlen
                 sep            $30
                 lda            cmdstr
                 cmp            ]maxlen
                 blt            :ok
                 beq            :ok
                 lda            ]maxlen
:ok              tay
]lup             lda            cmdstr,y
                 sta            []strptr],y
                 dey
                 cpy            #$ff
                 bne            ]lup
:xit             rep            $30
                 tax
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 brl            errxit


qasetcmdline
                 dum            0
]rtl             ds             6                           ;these are passed on stack
]strptr          ds             4
]newstack        =              *-6                         ;must be at end of passed params
                 dend

                 mx             %00
                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
                 sep            $30
                 lda            []strptr]
                 bne            :move
                 sta            cmdstr
                 brl            :xit
:move            tax
                 ldy            #$01
]lup             lda            []strptr],y
                 and            #$7f
                 cmp            #' '
                 blt            :done
                 sta            cmdstr,y
                 iny
                 dey
                 dex
                 bne            ]lup
:done            lda            #$0d
                 sta            cmdstr,y
                 sty            cmdstr
                 rep            $30
                 lda            #'|'
                 jsl            {vprintchar*4}+vectortbl-4
                 psl            #cmdstr
                 _QADrawStr

:xit             rep            $30
                 tax
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 brl            errxit

:len             ds             2
:cmd             ds             17


qaparseline
                 dum            0
]ct              ds             2
]ptr             ds             4
]rtl             ds             6                           ;these are passed on stack
]strptr          ds             4
]newstack        =              *-6                         ;must be at end of passed params
]cmdtype         ds             2
]cmdid           ds             2
                 dend

                 mx             %00
                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
                 stz            ]cmdtype
                 stz            ]cmdid
                 sep            $30
                 lda            []strptr]
                 jeq            :xit
                 ldy            #$01
                 tax
]lup             lda            []strptr],y
                 and            #$7f
                 cmp            #' '
                 blt            :done
                 sta            cmdstr,y
                 iny
                 dex
                 bne            ]lup
:done            lda            #$0d
                 cpy            #0
                 bne            :sta
                 ldy            #$ff
:sta             sta            cmdstr,y
                 sty            cmdstr
                 ldx            #0
]lup             lda            cmdstr+1,x
                 inx
                 cmp            #' '
                 jlt            :xit
                 beq            ]lup
                 ldy            #$01
                 cmp            #'a'
                 blt            :s0
                 cmp            #'z'+1
                 bge            :s0
                 and            #$5f
:s0              sta            :cmd+1
]lup             lda            cmdstr+1,x
                 cmp            #' '+1
                 blt            :sty
                 cpy            #15
                 bge            :s1
                 cmp            #'a'
                 blt            :s00
                 cmp            #'z'+1
                 bge            :s00
                 and            #$5f
:s00             sta            :cmd+1,y
                 iny
:s1              inx
                 bra            ]lup
:run             rep            $30
                 and            #$7f
                 sta            :cmd+1
                 ldy            #$01
                 sep            $30
                 sty            :cmd
                 bra            :r1
:sty             sep            $30
                 sty            :cmd
                 lda            :cmd+1
                 cmp            #'='
                 beq            :run
                 cmp            #'-'
                 beq            :run
:r1              rep            $30
                 lda            cmdhandle
                 ora            cmdhandle+2
                 jeq            :notfound
                 psl            cmdhandle
                 _Hlock
                 lda            numcmds
                 sta            ]ct
                 lda            cmdhandle
                 sta            ]ptr
                 lda            cmdhandle+2
                 sta            ]ptr+2
                 ldy            #$02
                 lda            []ptr]
                 tax
                 lda            []ptr],y
                 sta            ]ptr+2
                 stx            ]ptr
:find            rep            $30
                 ldy            ]ct
                 beq            :notfound
                 sep            $30
                 lda            []ptr]
                 cmp            :cmd
                 bne            :next
                 tay
:fl1             lda            []ptr],y
                 cmp            :cmd,y
                 bne            :next
                 dey
                 bne            :fl1
                 brl            :found
:next            rep            $30
                 lda            ]ptr
                 clc
                 adc            #erecsize
                 sta            ]ptr
                 bcc            :dec
                 inc            ]ptr+2
:dec             dec            ]ct
                 bra            :find
:found           rep            $30
                 ldy            #eid
                 lda            []ptr],y
                 sta            ]cmdid
                 ldy            #etype
                 lda            []ptr],y
                 sta            ]cmdtype
                 lda            #0
                 brl            :xit
:notfound        rep            $30
                 lda            #qacmdnotfound
:xit             rep            $30
                 tax
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 brl            errxit

:len             ds             2
:cmd             ds             17

qacompile                                                   ;
                 dum            0
]zp              ds             4
]zp1             ds             4
]cid             ds             2
]ctype           ds             2
]rtl             ds             6                           ;these are passed on stack
]sub             ds             4
]message         ds             2
]newstack        =              *-6                         ;must be at end of passed params
                 dend

                 mx             %00
                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
                 lda            compileactive
                 jne            :already
                 lda            cmdtbl
                 ora            cmdtbl+2
                 jeq            :notavail
                 lda            compiler
                 jeq            :notavail
                 sta            ]cid
                 lda            #$02                        ;compiler type
                 sta            ]ctype
:loadit
                 psl            #0
                 lda            ]ctype
                 pha
                 lda            ]cid
                 pha
                 jsl            getcmdptr
                 plx
                 ply
                 jcs            :notavail
                 sty            ]zp+2
                 stx            ]zp
                 ldy            #euserid
                 lda            []zp],y
                 beq            :aload
                 ldy            #eflags
                 lda            []zp],y
                 bit            #$4000
                 beq            :aload
                 lda            ]zp
                 ldx            ]zp+2
                 jsr            shutdownid
:aload           sep            $30
                 lda            []zp]
                 tay
]lup             lda            []zp],y
                 sta            :name+2,y
                 dey
                 bne            ]lup
                 lda            []zp]
                 clc
                 adc            #$02
                 sta            :name
                 lda            #'6'
                 sta            :name+1
                 lda            #':'
                 sta            :name+2
                 rep            $30
                 ldy            #eflags
                 lda            []zp],y
                 bit            #$8000
                 beq            :initial
                 ldy            #euserid
                 lda            []zp],y
                 beq            :initial
                 pha
                 pha
                 pha
                 pha
                 pha
                 pha
                 tll            $0a11                       ;_Restart
                 plx
                 stx            :id
                 plx
                 stx            :add
                 plx
                 stx            :add+2
                 plx
                 ply
                 bcc            :cpy
:initial         rep            $30
                 pha
                 pha
                 pha
                 pha
                 pha
                 pea            0                           ;new userid
                 psl            #:name
                 pea            $FFFF                       ;don't use special mem
                 tll            $0911                       ;_InitialLoad
                 plx                                        ;userid
                 stx            :id
                 plx
                 stx            :add
                 plx
                 stx            :add+2
                 plx
                 ply
                 jcs            :xit
:cpy             cpy            #0
                 beq            :newdp
                 stx            :dp
                 stz            ]zp1
                 stz            ]zp1+2
                 bra            :ago
:newdp           psl            #0
                 psl            #$100
                 lda            :id
                 pha
                 pea            $c015
                 psl            #0
                 _newhandle
                 plx
                 ply
                 jcs            :xit
                 stx            ]zp1
                 sty            ]zp1+2
                 lda            []zp1]
                 sta            :dp
                 ldy            #$02
                 lda            []zp1]
                 tax
                 lda            []zp1],y
                 sta            ]zp1+2
                 stx            ]zp1
                 phd
                 lda            :dp
                 tcd
                 ldx            #0
]l               stz            0,x
                 inx
                 inx
                 cpx            #$100
                 blt            ]l
                 pld
:ago             lda            :add
                 sta            :ajsl+1
                 lda            :add+2
                 sep            $20
                 sta            :ajsl+3
                 rep            $20
                 ldy            #edp
                 lda            :dp
                 sta            []zp],y
                 ldy            #eaddress
                 lda            :add
                 sta            []zp],y
                 iny
                 iny
                 lda            :add+2
                 sta            []zp],y
                 ldy            #eflags
                 lda            []zp],y
                 ora            #$4000
                 sta            []zp],y
                 ldy            #emesstype
                 lda            ]message
                 sta            []zp],y
                 ldy            #emesssub
                 lda            ]sub
                 sta            []zp],y
                 iny
                 iny
                 lda            ]sub+2
                 sta            []zp],y
                 ldy            #euserid
                 lda            :id
                 sta            []zp],y
                 ldy            #edphandle
                 lda            ]zp1
                 sta            []zp],y
                 iny
                 iny
                 lda            ]zp1+2
                 sta            []zp],y

                 lda            #-1
                 sta            compileactive
                 phb
                 phd
                 lda            :dp
                 tcd
                 lda            :id
                 ldx            #0
                 txy
:ajsl            jsl            $FFFFFF
                 php
                 clc
                 xce
                 plp
                 rep            $30
                 stz            compileactive
                 pld
                 plb

                 php
                 pha
                 bcs            :sdown
                 ldy            #etype
                 lda            []zp],y
                 cmp            #$05
                 beq            :nosdown
                 ldy            #eflags
                 lda            []zp],y
                 bit            #$4000
                 beq            :nosdown
:sdown           lda            ]zp
                 ldx            ]zp+2
                 jsr            shutdownid
:nosdown         pla
                 plp
                 jcs            :xit
                 lda            #0
                 brl            :xit

:bad             rep            $30
                 lda            #qacmdnotfound
                 bra            :xit
:already         rep            $30
                 lda            #qaalreadyactive
                 bra            :xit
:notavail        rep            $30
                 lda            #qalangnotavail
:xit             rep            $30
                 tax
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 brl            errxit

:name            ds             20
:id              ds             2
:add             ds             4
:dp              ds             2


qalink
                 dum            0
]zp              ds             4
]zp1             ds             4
]cid             ds             2
]ctype           ds             2
]rtl             ds             6                           ;these are passed on stack
]sub             ds             4
]message         ds             2
]newstack        =              *-6                         ;must be at end of passed params
                 dend

                 mx             %00
                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
                 lda            linkactive
                 jne            :already
                 lda            cmdtbl
                 ora            cmdtbl+2
                 jeq            :notavail
                 lda            linker
                 jeq            :notavail
                 sta            ]cid
                 lda            #$01                        ;linker type
                 sta            ]ctype

:loadit          psl            #0
                 lda            ]ctype
                 pha
                 lda            ]cid
                 pha
                 jsl            getcmdptr
                 plx
                 ply
                 jcs            :notavail
                 sty            ]zp+2
                 stx            ]zp
                 ldy            #euserid
                 lda            []zp],y
                 beq            :aload
                 ldy            #eflags
                 lda            []zp],y
                 bit            #$4000
                 beq            :aload
                 lda            ]zp
                 ldx            ]zp+2
                 jsr            shutdownid
:aload           sep            $30
                 lda            []zp]
                 tay
]lup             lda            []zp],y
                 sta            :name+2,y
                 dey
                 bne            ]lup
                 lda            []zp]
                 clc
                 adc            #$02
                 sta            :name
                 lda            #'6'
                 sta            :name+1
                 lda            #':'
                 sta            :name+2
                 rep            $30
                 ldy            #eflags
                 lda            []zp],y
                 bit            #$8000
                 beq            :initial
                 ldy            #euserid
                 lda            []zp],y
                 beq            :initial
                 pha
                 pha
                 pha
                 pha
                 pha
                 pha
                 tll            $0a11                       ;_Restart
                 plx
                 stx            :id
                 plx
                 stx            :add
                 plx
                 stx            :add+2
                 plx
                 ply
                 bcc            :cpy
:initial         rep            $30
                 pha
                 pha
                 pha
                 pha
                 pha
                 pea            0                           ;new userid
                 psl            #:name
                 pea            $FFFF                       ;don't use special mem
                 tll            $0911                       ;_InitialLoad
                 plx                                        ;userid
                 stx            :id
                 plx
                 stx            :add
                 plx
                 stx            :add+2
                 plx
                 ply
                 jcs            :xit
:cpy             cpy            #0
                 beq            :newdp
                 stx            :dp
                 stz            ]zp1
                 stz            ]zp1+2
                 bra            :ago
:newdp           psl            #0
                 psl            #$100
                 lda            :id
                 pha
                 pea            $c015
                 psl            #0
                 _newhandle
                 plx
                 ply
                 jcs            :xit
                 stx            ]zp1
                 sty            ]zp1+2
                 lda            []zp1]
                 sta            :dp
                 ldy            #$02
                 lda            []zp1]
                 tax
                 lda            []zp1],y
                 sta            ]zp1+2
                 stx            ]zp1
                 phd
                 lda            :dp
                 tcd
                 ldx            #0
]l               stz            0,x
                 inx
                 inx
                 cpx            #$100
                 blt            ]l
                 pld
:ago             lda            :add
                 sta            :ajsl+1
                 lda            :add+2
                 sep            $20
                 sta            :ajsl+3
                 rep            $20
                 ldy            #edp
                 lda            :dp
                 sta            []zp],y
                 ldy            #eaddress
                 lda            :add
                 sta            []zp],y
                 iny
                 iny
                 lda            :add+2
                 sta            []zp],y
                 ldy            #eflags
                 lda            []zp],y
                 ora            #$4000
                 sta            []zp],y
                 ldy            #emesstype
                 lda            ]message
                 sta            []zp],y
                 ldy            #emesssub
                 lda            ]sub
                 sta            []zp],y
                 iny
                 iny
                 lda            ]sub+2
                 sta            []zp],y
                 ldy            #euserid
                 lda            :id
                 sta            []zp],y
                 ldy            #edphandle
                 lda            ]zp1
                 sta            []zp],y
                 iny
                 iny
                 lda            ]zp1+2
                 sta            []zp],y

                 lda            #-1
                 sta            linkactive
                 phb
                 phd
                 lda            :dp
                 tcd
                 lda            :id
                 ldx            #0
                 txy
:ajsl            jsl            $FFFFFF
                 php
                 clc
                 xce
                 plp
                 rep            $30
                 stz            linkactive
                 pld
                 plb

                 php
                 pha
                 bcs            :sdown
                 ldy            #etype
                 lda            []zp],y
                 cmp            #$05
                 beq            :nosdown
                 ldy            #eflags
                 lda            []zp],y
                 bit            #$4000
                 beq            :nosdown
:sdown           lda            ]zp
                 ldx            ]zp+2
                 jsr            shutdownid
:nosdown         pla
                 plp
                 jcs            :xit
                 lda            #0
                 brl            :xit

:bad             rep            $30
                 lda            #qacmdnotfound
                 bra            :xit
:already         rep            $30
                 lda            #qaalreadyactive
                 bra            :xit
:notavail        rep            $30
                 lda            #qalinknotavail
:xit             rep            $30
                 tax
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 brl            errxit

:name            ds             20
:id              ds             2
:add             ds             4
:dp              ds             2




qaexeccmd
                 dum            0
]zp              ds             4
]zp1             ds             4
]zp2             ds             4
]rtl             ds             6                           ;these are passed on stack
]cmdid           ds             2
]cmdtype         ds             2
]newstack        =              *-6                         ;must be at end of passed params
                 dend

                 mx             %00
                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
                 lda            cmdtbl
                 ora            cmdtbl+2
                 jeq            :bad
                 lda            ]cmdtype
                 cmp            #$01                        ;linker type?
                 jeq            :linker
                 cmp            #$02
                 jeq            :compiler                   ;compiler type?
                 cmp            #$03
                 jeq            :internal                   ;internal command?
                 cmp            #$04
                 jeq            :external                   ;external command?
                 cmp            #$05
                 jeq            :application
:bad             rep            $30
                 lda            #qacmdnotfound
:xit             rep            $30
                 tax
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 brl            errxit

:linker          psl            #0
                 lda            ]cmdtype
                 pha
                 lda            ]cmdid
                 pha
                 jsl            getcmdptr
                 plx
                 ply
                 jcs            :bad
                 sty            ]zp+2
                 stx            ]zp
                 ldy            #eid
                 lda            []zp],y
                 sta            linker
                 psl            #:lstr
                 bra            :lcxit

:compiler        psl            #0
                 lda            ]cmdtype
                 pha
                 lda            ]cmdid
                 pha
                 jsl            getcmdptr
                 plx
                 ply
                 jcs            :bad
                 sty            ]zp+2
                 stx            ]zp
                 ldy            #eid
                 lda            []zp],y
                 sta            compiler
                 psl            #:cstr
:lcxit           _QADrawString
                 pei            ]zp+2
                 pei            ]zp
                 _QADrawString
                 lda            #$0d
                 jsl            {vprintchar*4}+vectortbl-4
                 lda            #0
                 brl            :xit

:lstr            str            'Current Linker now: '
:cstr            str            'Current Language now: '

:external
:application     psl            #0
                 lda            ]cmdtype
                 pha
                 lda            ]cmdid
                 pha
                 jsl            getcmdptr
                 plx
                 ply
                 jcs            :bad
                 sty            ]zp+2
                 stx            ]zp
                 ldy            #euserid
                 lda            []zp],y
                 beq            :aload
                 ldy            #eflags
                 lda            []zp],y
                 bit            #$4000
                 beq            :aload
                 lda            ]zp
                 ldx            ]zp+2
                 jsr            shutdownid
:aload           sep            $30
                 lda            []zp]
                 tay
]lup             lda            []zp],y
                 sta            :name+2,y
                 dey
                 bne            ]lup
                 lda            []zp]
                 clc
                 adc            #$02
                 sta            :name
                 lda            #'6'
                 sta            :name+1
                 lda            #':'
                 sta            :name+2
                 rep            $30
                 ldy            #eflags
                 lda            []zp],y
                 bit            #$8000
                 beq            :initial
                 ldy            #euserid
                 lda            []zp],y
                 beq            :initial
                 pha
                 pha
                 pha
                 pha
                 pha
                 pha
                 tll            $0a11                       ;_Restart
                 plx
                 stx            :id
                 plx
                 stx            :add
                 plx
                 stx            :add+2
                 plx
                 ply
                 bcc            :cpy
:initial         rep            $30
                 pha
                 pha
                 pha
                 pha
                 pha
                 pea            0                           ;new userid
                 psl            #:name
                 pea            $FFFF                       ;don't use special mem
                 tll            $0911                       ;_InitialLoad
                 plx                                        ;userid
                 stx            :id
                 plx
                 stx            :add
                 plx
                 stx            :add+2
                 plx
                 ply
                 jcs            :xit
:cpy             cpy            #0
                 beq            :newdp
                 stx            :dp
                 stz            ]zp1
                 stz            ]zp1+2
                 bra            :ago
:newdp           psl            #0
                 psl            #$100
                 lda            :id
                 pha
                 pea            $c015
                 psl            #0
                 _newhandle
                 plx
                 ply
                 jcs            :xit
                 stx            ]zp1
                 sty            ]zp1+2
                 lda            []zp1]
                 sta            :dp
                 ldy            #$02
                 lda            []zp1]
                 tax
                 lda            []zp1],y
                 sta            ]zp1+2
                 stx            ]zp1
                 phd
                 lda            :dp
                 tcd
                 ldx            #0
]l               stz            0,x
                 inx
                 inx
                 cpx            #$100
                 blt            ]l
                 pld


:ago             rep            $30
                 lda            :add
                 sta            :ajsl+1
                 sta            ]zp2
                 lda            :add+2
                 sta            ]zp2+2
                 sep            $20
                 sta            :ajsl+3
                 rep            $20
                 ldy            #edp
                 lda            :dp
                 sta            []zp],y
                 ldy            #eaddress
                 lda            :add
                 sta            []zp],y
                 iny
                 iny
                 lda            :add+2
                 sta            []zp],y
                 ldy            #eflags
                 lda            []zp],y
                 ora            #$4000
                 sta            []zp],y
                 ldy            #emesstype
                 lda            #startmess                  ;startup message
                 sta            []zp],y
                 ldy            #emesssub
                 sta            []zp],y
                 iny
                 iny
                 sta            []zp],y
                 ldy            #euserid
                 lda            :id
                 sta            []zp],y
                 ldy            #edphandle
                 lda            ]zp1
                 sta            []zp],y
                 iny
                 iny
                 lda            ]zp1+2
                 sta            []zp],y

                 psl            #cmdline-1
                 pea            128
                 _QAGetCmdLine
                 sep            $30
                 ldx            cmdline-1
                 stz            cmdline,x
                 lda            #'S'
                 sta            cmdline-1
                 rep            $30

                 do             0
                 sep            $20
                 ldy            #$03                        ;look for QUICKASM in file
                 ldx            #0
]l               lda            []zp2],y
                 and            #$5f
                 cmp            qasmstr,x
                 jne            :nr1
                 iny
                 inx
                 cpx            #$08
                 blt            ]l
                 rep            $20
                 fin

                 brl            :run
:nr1             rep            $30
                 lda            #qabadcmdfile
                 sec
                 brl            :norun

:run             rep            $30
                 phb
                 phd
                 tsc
                 sta            stack
                 lda            #:return
                 sta            return
                 jsr            setvects
                 rep            $30
* lda #:ajsl
* brk $aa
                 lda            :dp
                 tcd
                 lda            :id
                 ldx            #^qasmstr
                 ldy            #qasmstr
:ajsl            jsl            $FFFFFF
:return          php
                 clc
                 xce
                 phk
                 plb
                 rep            $30
                 pha
                 jsr            restorevects
                 pla
                 plp
                 rep            $30
                 pld
                 plb

:norun           php
                 pha
                 bcs            :sdown
                 ldy            #etype
                 lda            []zp],y
                 cmp            #$05
                 beq            :nosdown
                 ldy            #eflags
                 lda            []zp],y
                 bit            #$4000
                 beq            :nosdown
:sdown           lda            ]zp
                 ldx            ]zp+2
                 jsr            shutdownid
:nosdown         pla
                 plp
                 jcs            :xit
                 lda            #0
                 brl            :xit


:name            ds             20
:id              ds             2
:add             ds             4
:dp              ds             2


:internal        lda            cmdtbl
                 sta            ]zp
                 lda            cmdtbl+2
                 sta            ]zp+2
                 lda            ]cmdid
                 jeq            :bad
                 cmp            []zp]
                 blt            :iok
                 jne            :bad
:iok             dec
                 asl
                 asl                                        ;*4
                 clc
                 adc            #$02                        ;to account for count word
                 tay
                 lda            []zp],y
                 sta            :ijsl+1
                 iny
                 iny
                 lda            []zp],y
                 sep            $20
                 sta            :ijsl+3
                 rep            $30
                 phd
                 phb
:ijsl            jsl            $FFFFFF
                 rep            $30
                 plb
                 pld
                 bcc            :i0
                 brl            :xit
:i0              lda            #0
                 brl            :xit


qagetmessbyid
                 dum            0
]ptr             ds             4
]ct              ds             2
]rtl             ds             6                           ;these are passed on stack
]userid          ds             2
]newstack        =              *-6                         ;must be at end of passed params
]subtype         ds             4
]message         ds             2
                 dend

                 mx             %00
                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
                 stz            ]message
                 stz            ]subtype
                 stz            ]subtype+2
                 lda            ]userid
                 beq            :notfound
                 psl            cmdhandle
                 _Hlock
                 bcs            :notfound
                 lda            cmdhandle
                 sta            ]ptr
                 lda            cmdhandle+2
                 sta            ]ptr+2
                 ldy            #$02
                 lda            []ptr]
                 tax
                 lda            []ptr],y
                 sta            ]ptr+2
                 stx            ]ptr
                 lda            numcmds
                 sta            ]ct
]lup             lda            ]ct
                 beq            :notfound
                 ldy            #euserid
                 lda            []ptr],y
                 cmp            ]userid
                 beq            :found
:next            dec            ]ct
                 lda            #erecsize
                 clc
                 adc            ]ptr
                 sta            ]ptr
                 bcc            ]lup
                 inc            ]ptr+2
                 bra            ]lup
:found           ldy            #emesstype
                 lda            []ptr],y
                 sta            ]message
                 ldy            #emesssub
                 lda            []ptr],y
                 sta            ]subtype
                 iny
                 iny
                 lda            []ptr],y
                 sta            ]subtype+2
                 lda            #0
                 brl            :xit
:notfound        lda            #$01
:xit             rep            $30
                 tax
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 brl            errxit



qarun
                 dum            0
]ptr             ds             4
]ct              ds             2
]rtl             ds             6                           ;these are passed on stack
]newstack        =              *-6                         ;must be at end of passed params
                 dend

                 mx             %00
                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
                 psl            cmdhandle
                 _Hlock
                 jcs            :done
                 lda            cmdhandle
                 sta            ]ptr
                 lda            cmdhandle+2
                 sta            ]ptr+2
                 ldy            #$02
                 lda            []ptr]
                 tax
                 lda            []ptr],y
                 sta            ]ptr+2
                 stx            ]ptr
                 lda            numcmds
                 sta            ]ct
]lup             lda            ]ct
                 beq            :done
                 ldy            #euserid
                 lda            []ptr],y
                 beq            :next
                 ldy            #etype
                 lda            []ptr],y
                 cmp            #$05                        ;application?
                 bne            :next
                 ldy            #eaddress
                 lda            []ptr],y
                 iny
                 iny
                 ora            []ptr],y
                 beq            :next
                 ldy            #emesstype
                 lda            #runmess
                 sta            []ptr],y
                 ldy            #emesssub
                 lda            #0
                 sta            []ptr],y
                 iny
                 iny
                 sta            []ptr],y
                 ldy            #eaddress
                 lda            []ptr],y
                 sta            :jsl+1
                 iny
                 iny
                 lda            []ptr],y
                 sep            $20
                 sta            :jsl+3
                 rep            $30
                 ldy            #euserid
                 lda            []ptr],y
                 tax
                 ldy            #edp
                 lda            []ptr],y
                 phd
                 phb
                 tcd
                 txa
                 ldy            #0
                 tyx
:jsl             jsl            $FFFFFF
                 php
                 clc
                 xce
                 plp
                 rep            $30
                 plb
                 pld
                 ldy            #emesstype
                 lda            #0
                 sta            []ptr],y
:next            dec            ]ct
                 lda            #erecsize
                 clc
                 adc            ]ptr
                 sta            ]ptr
                 bcc            ]lup
                 inc            ]ptr+2
                 bra            ]lup
:done            lda            #0
:xit             rep            $30
                 tax
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 brl            errxit


qaevent
                 dum            0
]ptr             ds             4
]ct              ds             2
]rtl             ds             6                           ;these are passed on stack
]taskflag        ds             2
]eventptr        ds             4
]newstack        =              *-6                         ;must be at end of passed params
                 dend

                 mx             %00
                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb

                 psl            cmdhandle
                 _Hlock
                 jcs            :done
                 lda            cmdhandle
                 sta            ]ptr
                 lda            cmdhandle+2
                 sta            ]ptr+2
                 ldy            #$02
                 lda            []ptr]
                 tax
                 lda            []ptr],y
                 sta            ]ptr+2
                 stx            ]ptr
                 lda            numcmds
                 sta            ]ct
]lup             lda            ]ct
                 jeq            :done
                 ldy            #euserid
                 lda            []ptr],y
                 beq            :next
                 ldy            #etype
                 lda            []ptr],y
                 cmp            #$05                        ;application?
                 bne            :next
                 ldy            #eaddress
                 lda            []ptr],y
                 iny
                 iny
                 ora            []ptr],y
                 beq            :next
                 ldy            #emesstype
                 lda            #eventmess
                 sta            []ptr],y
                 ldy            #emesssub
                 lda            ]eventptr
                 sta            []ptr],y
                 iny
                 iny
                 lda            ]eventptr+2
                 ldx            ]taskflag
                 beq            :sta
                 ora            #$8000
:sta             sta            []ptr],y
                 ldy            #eaddress
                 lda            []ptr],y
                 sta            :jsl+1
                 iny
                 iny
                 lda            []ptr],y
                 sep            $20
                 sta            :jsl+3
                 rep            $30
                 ldy            #euserid
                 lda            []ptr],y
                 tax
                 ldy            #edp
                 lda            []ptr],y
                 phd
                 phb
                 tcd
                 txa
                 ldy            #0
                 tyx
:jsl             jsl            $FFFFFF
                 php
                 clc
                 xce
                 plp
                 rep            $30
                 plb
                 pld
                 php
                 ldy            #emesstype
                 lda            #0
                 sta            []ptr],y
                 plp
                 bcc            :done                       ;was event handled?
:next            dec            ]ct
                 lda            #erecsize
                 clc
                 adc            ]ptr
                 sta            ]ptr
                 jcc            ]lup
                 inc            ]ptr+2
                 brl            ]lup
:done            lda            #0
:xit             rep            $30
                 tax
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 brl            errxit


getcmdptr
                 dum            0
]ct              ds             2
]rtl             ds             3                           ;these are passed on stack
]id              ds             2
]type            ds             2
]newstack        =              *-3                         ;must be at end of passed params
]ptr             ds             4
                 dend

                 mx             %00
                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
                 stz            ]ptr
                 stz            ]ptr+2
                 psl            cmdhandle
                 _Hlock
                 bcs            :notfound
                 lda            cmdhandle
                 sta            ]ptr
                 lda            cmdhandle+2
                 sta            ]ptr+2
                 ldy            #$02
                 lda            []ptr]
                 tax
                 lda            []ptr],y
                 sta            ]ptr+2
                 stx            ]ptr
                 lda            numcmds
                 sta            ]ct
]lup             lda            ]ct
                 beq            :notfound
                 ldy            #eid
                 lda            []ptr],y
                 cmp            ]id
                 bne            :next
                 ldy            #etype
                 lda            []ptr],y
                 cmp            ]type
                 beq            :found
:next            dec            ]ct
                 lda            #erecsize
                 clc
                 adc            ]ptr
                 sta            ]ptr
                 bcc            ]lup
                 inc            ]ptr+2
                 bra            ]lup
:found           lda            #0
                 brl            :xit
:notfound        lda            #$01
:xit             rep            $30
                 tax
                 lda            ]rtl+1
                 sta            ]newstack+1
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 brl            errxit

qadispose
                 dum            0
]ct              ds             2
]ptr             ds             4
]rtl             ds             6                           ;these are passed on stack
]newstack        =              *-6                         ;must be at end of passed params
                 dend

                 mx             %00
                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
***
                 ldal           cmdhandle
                 oral           cmdhandle+2
                 jeq            :noerr
                 lda            cmdhandle+2
                 pha
                 lda            cmdhandle
                 pha
                 _Hlock
                 bcs            :xit
                 lda            cmdhandle
                 sta            ]ptr
                 lda            cmdhandle+2
                 sta            ]ptr+2
                 ldy            #$02
                 lda            []ptr]
                 tax
                 lda            []ptr],y
                 sta            ]ptr+2
                 stx            ]ptr
                 ldal           numcmds
                 sta            ]ct
]lup             lda            ]ct
                 beq            :noerr
                 ldy            #eflags                     ;clear the restart bit
                 lda            []ptr],y
                 and            #$7fff
                 sta            []ptr],y
                 lda            ]ptr
                 ldx            ]ptr+2
                 jsr            shutdownid
                 dec            ]ct
                 lda            ]ptr
                 clc
                 adc            #erecsize
                 sta            ]ptr
                 bcc            ]lup
                 inc            ]ptr+2
                 bra            ]lup
:noerr           rep            $30
                 lda            #0
:xit             rep            $30
                 tax
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 brl            errxit

                 mx             %00
qaresetvectors
                 ldx            #vectend-vectortbl1-2
]lup             ldal           vectortbl1,x
                 stal           vectortbl,x
                 dex
                 dex                                        ;restore default vectors
                 bpl            ]lup
                 brl            noerror

qasetvector
                 lda            11,s
                 beq            :badid
                 cmp            #maxvectors+1
                 bge            :badid
                 dec
                 asl
                 asl
                 tax
                 lda            9,s
                 sep            $20
                 stal           vectortbl+3,x
                 rep            $20
                 lda            7,s
                 stal           vectortbl+1,x
                 lda            #0
                 brl            :xit
:badid           lda            #qabadvectornum
:xit             tax
                 lda            5,s
                 sta            5+6,s
                 lda            3,s
                 sta            3+6,s
                 lda            1,s
                 sta            1+6,s
                 pla
                 pla
                 pla
                 txa
                 cmp            #$01
                 rtl

qagetvector      rep            $30
                 lda            7,s
                 beq            :badid
                 cmp            #maxvectors+1
                 bge            :badid
                 dec
                 asl
                 asl
                 tax
                 ldal           vectortbl+1,x
                 sta            9,s
                 ldal           vectortbl+3,x
                 and            #$ff
                 sta            11,s
                 lda            #0
                 bra            :xit
:badid           lda            #qabadvectornum
:xit             tax
                 lda            5,s
                 sta            5+2,s
                 lda            3,s
                 sta            3+2,s
                 lda            1,s
                 sta            1+2,s
                 pla
                 txa
                 cmp            #$01
                 rtl

qashutdownid
                 dum            0
]ct              ds             2
]ptr             ds             4
]rtl             ds             6                           ;these are passed on stack
]userid          ds             2
]newstack        =              *-6                         ;must be at end of passed params
                 dend

                 mx             %00
                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
***
                 ldal           cmdhandle
                 oral           cmdhandle+2
                 jeq            :noerr
                 lda            cmdhandle+2
                 pha
                 lda            cmdhandle
                 pha
                 _Hlock
                 bcs            :xit
                 lda            cmdhandle
                 sta            ]ptr
                 lda            cmdhandle+2
                 sta            ]ptr+2
                 ldy            #$02
                 lda            []ptr]
                 tax
                 lda            []ptr],y
                 sta            ]ptr+2
                 stx            ]ptr
                 ldal           numcmds
                 sta            ]ct
]lup             lda            ]ct
                 beq            :noerr

                 ldy            #euserid
                 lda            []ptr],y
                 cmp            ]userid
                 bne            :next
                 lda            ]ptr
                 ldx            ]ptr+2
                 jsr            shutdownid
:next            dec            ]ct
                 lda            ]ptr
                 clc
                 adc            #erecsize
                 sta            ]ptr
                 bcc            ]lup
                 inc            ]ptr+2
                 bra            ]lup
:noerr           rep            $30
                 lda            #0
:xit             rep            $30
                 tax
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 brl            errxit


shutdownid       php                                        ;enters with recptr(low) in A
                 phd                                        ;            recptr(high) in X
                 rep            $30
                 pha
                 pha
                 tay
                 tsc
                 inc
                 tcd
                 sty            0
                 stx            2

                 ldy            #euserid
                 lda            [0],y
                 jeq            :done
                 ldy            #eaddress
                 lda            [0],y
                 iny
                 iny
                 ora            [0],y
                 jeq            :nomess

                 ldy            #etype
                 lda            [0],y
                 cmp            #$05
                 jne            :nomess                     ;pass shutdown only to APPS
                 ldy            #eflags
                 lda            [0],y
                 bit            #$4000
                 jeq            :nomess                     ;if already shutdown no message.

                 ldy            #emesstype
                 lda            #shutdownmess
                 sta            [0],y
                 ldy            #emesssub
                 lda            #0
                 sta            [0],y
                 iny
                 iny
                 sta            [0],y
                 ldy            #eaddress
                 lda            [0],y
                 sta            :jsl+1
                 iny
                 iny
                 lda            [0],y
                 sep            $20
                 sta            :jsl+3
                 rep            $30
                 ldy            #euserid
                 lda            [0],y
                 tax
                 ldy            #edp
                 lda            [0],y
                 phb
                 phd
                 tcd
                 txa
:jsl             jsl            $FFFFFF
                 clc
                 xce
                 rep            $30
                 pld
                 plb
:nomess          ldy            #edphandle
                 lda            [0],y
                 iny
                 iny
                 ora            [0],y
                 beq            :nodispose
                 ldy            #edphandle+2
                 lda            [0],y
                 pha
                 lda            #0
                 sta            [0],y
                 dey
                 dey
                 lda            [0],y
                 pha
                 lda            #0
                 sta            [0],y
                 _disposehandle
:nodispose       ldy            #euserid
                 ldx            #0
                 lda            [0],y
                 pha
                 pha
                 ldy            #eflags
                 lda            [0],y
                 and            #$8000                      ;get restart flag
                 beq            :tax
                 lda            #$4000
:tax             tax
:phx             phx
                 tll            $1211                       ;_UserShutdown
                 pla
:done            lda            #0
                 ldy            #eaddress
                 sta            [0],y
                 iny
                 iny
                 sta            [0],y
                 ldy            #eflags
                 lda            [0],y
                 bit            #$8000                      ;restartable?
                 bne            :dp
:id0             ldy            #euserid
                 lda            #0
                 sta            [0],y
:dp              ldy            #edp
                 lda            #0
                 sta            [0],y
                 ldy            #emesstype
                 sta            [0],y
                 ldy            #emesssub
                 sta            [0],y
                 iny
                 iny
                 sta            [0],y
                 ldy            #edp
                 sta            [0],y

                 ldy            #eflags
                 lda            [0],y
                 and            #$4000!$FFFF
                 sta            [0],y

                 pla
                 pla
                 pld
                 plp
                 rts

qatyp2txt

                 dum            0
]rtl             ds             3                           ;these are passed on stack
]rtl1            ds             3
]typestr         ds             4
]filetype        ds             2
]newstack        =              *-6                         ;must be at end of passed params
                 dend

                 mx             %00

                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
                 lda            ]filetype
                 pha
                 asl
                 clc
                 adc            1,s
                 sta            1,s
                 plx
                 lda            filetypelist,x
                 and            #$ff
                 xba
                 ora            #$03
                 sta            []typestr]
                 ldy            #$02
                 lda            filetypelist+1,x
                 sta            []typestr],y
                 lda            #0
:xit             rep            $30
                 tax
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 brl            errxit

qatxt2typ

                 dum            0
]rtl             ds             3                           ;these are passed on stack
]rtl1            ds             3
]typestr         ds             4
]newstack        =              *-6                         ;must be at end of passed params
]filetype        ds             2
                 dend

                 mx             %00

                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
                 stz            ]filetype
                 sep            $20
                 lda            []typestr]
                 cmp            #$03
                 bne            :err1
                 ldx            #0
]lup             sep            $20
                 ldy            #$01
                 lda            []typestr],y
                 and            #$7f
                 cmp            #'a'
                 blt            :1
                 cmp            #'z'+1
                 bge            :1
                 and            #$5f
:1               cmp            filetypelist,x
                 bne            :next
                 iny
                 lda            []typestr],y
                 and            #$7f
                 cmp            #'a'
                 blt            :2
                 cmp            #'z'+1
                 bge            :2
                 and            #$5f
:2               cmp            filetypelist+1,x
                 bne            :next
                 iny
                 lda            []typestr],y
                 and            #$7f
                 cmp            #'a'
                 blt            :3
                 cmp            #'z'+1
                 bge            :3
                 and            #$5f
:3               cmp            filetypelist+2,x
                 beq            :found
:next            rep            $20
                 inc            ]filetype
                 txa
                 clc
                 adc            #$03
                 tax
                 cpx            #256*3
                 blt            ]lup
                 brl            :err1
:found           rep            $30
                 lda            #0
                 brl            :xit
:err1            rep            $30
                 lda            #qaunknowntypestr
:xit             rep            $30
                 tax
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 brl            errxit



                 mx             %00
qastarttiming
                 ldal           timerlevel
                 cmp            #10
                 bge            :err
                 pha
                 pha
                 pha
                 pha
                 tll            $0d03                       ;_readtimehex
                 ldal           timerlevel
                 asl
                 asl
                 asl
                 tax
                 pla
                 tay
                 and            #$ff
                 stal           timetbl,x
                 tya
                 xba
                 and            #$ff
                 stal           timetbl+2,x
                 pla
                 and            #$ff
                 stal           timetbl+4,x
                 pla
                 pla
                 ldal           timerlevel
                 inc
                 stal           timerlevel
                 brl            noerror
:err             lda            #qatimeleverr
                 brl            errxit

qaendtiming      ldal           timerlevel
                 jeq            :zero
                 dec
                 stal           timerlevel
                 pha
                 pha
                 pha
                 pha
                 tll            $0d03                       ;_readtimehex
                 pla
                 tay
                 and            #$ff
                 stal           :secs
                 tya
                 xba
                 and            #$ff
                 stal           :mins
                 pla
                 and            #$ff
                 stal           :hours
                 pla
                 pla
                 ldal           timerlevel
                 asl
                 asl
                 asl
                 tax
                 phb
                 phk
                 plb
                 lda            :secs
                 sec
                 sbc            timetbl,x
                 bcs            :min
                 adc            #60
                 ldy            :mins
                 bne            :dmin
                 dec            :hours
                 bpl            :dmin1
                 ldy            #23
                 sty            :hours
:dmin1           ldy            #59
                 sty            :mins
                 brl            :min
:dmin            dey
                 sty            :mins
:min             sta            :secs
                 lda            :mins
                 sec
                 sbc            timetbl+2,x
                 bcs            :hour
                 adc            #60
                 dec            :hours
                 bpl            :hour
                 ldy            #23
                 sty            :hours
:hour            sta            :mins
                 lda            :hours
                 sec
                 sbc            timetbl+4,x
                 bcs            :show
                 adc            #24
:show            sta            :hours
                 plb
                 ldal           :secs
                 sta            11,s
                 ldal           :mins
                 sta            9,s
                 ldal           :hours
                 sta            7,s
                 brl            noerror
:zero            lda            #0
                 sta            7,s
                 sta            9,s
                 sta            11,s
                 brl            noerror
:hours           ds             2
:mins            ds             2
:secs            ds             2


qainctotalerrs
                 ldal           totalerrlev
                 tay
]lup             cpy            #0
                 beq            :done
                 dey
                 tya
                 asl
                 tax
                 ldal           errtbl,x
                 inc
                 stal           errtbl,x
                 brl            ]lup
:done            brl            noerror

qainittotalerrs
                 ldal           totalerrlev
                 cmp            #10
                 bge            :err
                 tay
                 asl
                 tax
                 lda            #0
                 stal           errtbl,x
                 tya
                 inc
                 stal           totalerrlev
                 brl            noerror
:err             lda            #qatotalerrleverr
                 brl            errxit

qagettotalerrs
                 ldal           totalerrlev
                 beq            :zero
                 dec
                 stal           totalerrlev
                 asl
                 tax
                 ldal           errtbl,x
                 sta            7,s
                 brl            noerror
:zero            lda            #0
                 sta            7,s
                 brl            noerror

qareadtotalerrs
                 ldal           totalerrlev
                 beq            :zero
                 dec
                 asl
                 tax
                 ldal           errtbl,x
                 sta            7,s
                 brl            noerror
:zero            lda            #0
                 sta            7,s
                 brl            noerror


qasetname
                 dum            0
]rtl             ds             6                           ;these are passed on stack
]pathptr         ds             4
]newstack        =              *-6                         ;must be at end of passed params
                 dend

                 mx             %00

                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
                 sep            $30
                 lda            []pathptr]
                 cmp            #127
                 blt            :1
                 lda            #127
:1               tay
]lup             lda            []pathptr],y
                 cpy            #0
                 beq            :sta
                 and            #$7f
:sta             sta            filename,y
                 dey
                 cpy            #$ff
                 bne            ]lup
:xit             rep            $30
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 lda            #0
                 brl            errxit

qasetobjname
                 dum            0
]rtl             ds             6                           ;these are passed on stack
]pathptr         ds             4
]newstack        =              *-6                         ;must be at end of passed params
                 dend

                 mx             %00

                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
                 sep            $30
                 lda            []pathptr]
                 cmp            #127
                 blt            :1
                 lda            #127
:1               tay
]lup             lda            []pathptr],y
                 cpy            #0
                 beq            :sta
                 and            #$7f
:sta             sta            objfilename,y
                 dey
                 cpy            #$ff
                 bne            ]lup
:xit             rep            $30
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 lda            #0
                 brl            errxit

qaconvertpath

                 dum            0
]rtl             ds             6                           ;these are passed on stack
]appendflag      ds             2
]newpath         ds             4
]oldpath         ds             4
]newstack        =              *-6                         ;must be at end of passed params
                 dend

                 mx             %00
                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
                 lda            ]appendflag
                 and            #$FF
                 sta            ]appendflag
                 lda            #0
                 ldy            #$02
                 sta            []newpath]
                 sta            []newpath],y
                 sep            $30
                 ldy            #$01
]flush           lda            []oldpath],y
                 and            #$7f
                 cmp            #' '
                 blt            :bad
                 bne            :first
                 iny
                 brl            ]flush
:first           cmp            #'.'
                 jeq            :backup
                 brl            :ok
:bad             pea            #qabadpathname
                 brl            :error
:ok              ldx            #0
:return          sep            $30
:save            lda            []oldpath],y
                 and            #$7f
                 cmp            #' '+1
                 blt            :done
                 cmp            #'/'
                 bne            :store
                 lda            #':'
:store           cpx            #128
                 bge            :inx
                 phy
                 txy
                 iny
                 sta            []newpath],y
                 ply
:inx             inx
                 iny
                 brl            :save
:done            cpx            #64
                 blt            :len
                 ldx            #64
:len             txa
                 sta            []newpath]
                 lda            ]appendflag
                 beq            :plp
                 lda            []newpath]
                 cmp            #63
                 bge            :plp
                 tay
                 lda            []newpath],y
                 and            #$7f
                 cmp            #':'
                 beq            :plp
                 lda            []newpath]
                 inc
                 inc
                 sta            []newpath]
                 iny
                 lda            #'.'
                 sta            []newpath],y
                 iny
                 lda            ]appendflag
                 and            #$5f
                 sta            []newpath],y
:plp             sep            $30
                 lda            []newpath]
                 beq            :syn
                 rep            $30
                 lda            #0
                 brl            :xit
:syn             rep            $30
                 lda            #qabadpathname
                 brl            :xit
                 mx             %11

:backup          stz            :level
:loop            sty            :y
                 iny
                 lda            []oldpath],y
                 and            #$7f
                 cmp            #' '+1
                 blt            :pfx
                 cmp            #'.'
                 bne            :pfx
                 iny
                 lda            []oldpath],y
                 and            #$7f
                 cmp            #' '+1
                 blt            :pfx
                 cmp            #'/'
                 beq            :g
                 cmp            #':'
                 bne            :pfx
:g               inc            :level
                 iny
                 sty            :y
                 lda            []oldpath],y
                 and            #$7f
                 cmp            #'.'
                 beq            :loop
:pfx             ldx            #0
                 lda            :level
                 beq            :noexp
                 rep            $30
                 lda            #0
                 sta            []newpath]
                 lda            ]newpath+2
                 sta            :pfxparm+4
                 lda            ]newpath
                 sta            :pfxparm+2
                 _GSOS          _getprefix;:pfxparm
                 sep            $30
                 lda            []newpath]
                 tay
                 beq            :noexp
]lup             lda            []newpath],y
                 and            #$7f
                 cmp            #'/'
                 bne            :store1
                 lda            #':'
:store1          sta            []newpath],y
                 dey
                 bne            ]lup
                 lda            []newpath]
                 tay
                 lda            []newpath],y
                 cmp            #':'
                 bne            :exp
                 dey
:exp             cpy            #0
                 beq            :noexp
                 lda            []newpath],y
                 and            #$7f
                 cmp            #':'
                 bne            :dex
                 dec            :level
                 beq            :noexp
:dex             dey
                 brl            :exp
:noexp           tya
                 sta            []newpath]
                 tax
                 ldy            :y
                 brl            :return
:error           rep            $30
                 pla
:xit             rep            $30
                 tax
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 brl            errxit

:temp            ds             2
:level           ds             2
:y               ds             2
:pfxparm         dw             0
                 adrl           0


qagetname
                 dum            0
]rtl             ds             6                           ;these are passed on stack
]pathptr         ds             4
]newstack        =              *-6                         ;must be at end of passed params
                 dend

                 mx             %00

                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
                 sep            $30
                 lda            filename
                 cmp            #127
                 blt            :1
                 lda            #127
:1               tay
]lup             lda            filename,y
                 cpy            #0
                 beq            :sta
                 and            #$7f
:sta             sta            []pathptr],y
                 dey
                 cpy            #$ff
                 bne            ]lup
:xit             rep            $30
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 lda            #0
                 brl            errxit

qagetobjname
                 dum            0
]rtl             ds             6                           ;these are passed on stack
]pathptr         ds             4
]newstack        =              *-6                         ;must be at end of passed params
                 dend

                 mx             %00

                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
                 sep            $30
                 lda            objfilename
                 cmp            #127
                 blt            :1
                 lda            #127
:1               tay
]lup             lda            objfilename,y
                 cpy            #0
                 beq            :sta
                 and            #$7f
:sta             sta            []pathptr],y
                 dey
                 cpy            #$ff
                 bne            ]lup
:xit             rep            $30
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 lda            #0
                 brl            errxit

                 mx             %00
qasetobjtype
                 lda            7,s
                 and            #$ff
                 stal           objfiletype
                 lda            5,s
                 sta            5+2,s
                 lda            3,s
                 sta            3+2,s
                 lda            1,s
                 sta            1+2,s
                 pla
                 brl            noerror
qagetobjtype
                 ldal           objfiletype
                 sta            7,s
                 brl            noerror

                 mx             %00
qasetwindow
                 lda            7,s
                 stal           windowflag
                 lda            5,s
                 sta            5+2,s
                 lda            3,s
                 sta            3+2,s
                 lda            1,s
                 sta            1+2,s
                 pla
                 brl            noerror
qagetwindow
                 ldal           windowflag
                 sta            7,s
                 brl            noerror
                 mx             %00
qasetshellid
                 lda            7,s
                 stal           shellUid
                 lda            5,s
                 sta            5+2,s
                 lda            3,s
                 sta            3+2,s
                 lda            1,s
                 sta            1+2,s
                 pla
                 brl            noerror
qagetshellid
                 ldal           shellUid
                 sta            7,s
                 brl            noerror

qagetsymtbl
                 dum            0
]rtl             ds             6                           ;these are passed on stack
]newstack        =              *-6                         ;must be at end of passed params
]nextptr         ds             4
]number          ds             2
]symhandle       ds             4
]symptr          ds             4
                 dend

                 mx             %00
                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
                 lda            symnext
                 sta            ]nextptr
                 lda            symnext+2
                 sta            ]nextptr+2
                 lda            symhandle
                 sta            ]symhandle
                 lda            symhandle+2
                 sta            ]symhandle+2
                 lda            symptr
                 sta            ]symptr
                 lda            symptr+2
                 sta            ]symptr+2
                 lda            symlabels
                 sta            ]number
                 lda            #0
:xit             rep            $30
                 tax
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 brl            errxit


qasetsymtbl
                 dum            0
]rtl             ds             6                           ;these are passed on stack
]nextptr         ds             4
]number          ds             2
]symhandle       ds             4
]symptr          ds             4
]newstack        =              *-6                         ;must be at end of passed params
                 dend

                 mx             %00
                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
                 lda            ]nextptr
                 sta            symnext
                 lda            ]nextptr+2
                 sta            symnext+2
                 lda            ]symhandle
                 sta            symhandle
                 lda            ]symhandle+2
                 sta            symhandle+2
                 lda            ]symptr
                 sta            symptr
                 lda            ]symptr+2
                 sta            symptr+2
                 lda            ]number
                 sta            symlabels
                 lda            #0
:xit             rep            $30
                 tax
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 brl            errxit

QABarGraph
                 dum            0
]rtl             ds             6                           ;these are passed on stack
]msgptr          ds             4
]percent         ds             4
]newstack        =              *-6                         ;must be at end of passed params
                 dend

                 mx             %00
                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb

                 lda            #0
:xit             rep            $30
                 tax
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 brl            errxit


QAErrorMsg
                 dum            0
]rtl             ds             6                           ;these are passed on stack
]errorcode       ds             2
]newstack        =              *-6                         ;must be at end of passed params
                 dend

                 mx             %00
                 tsc
                 sec
                 sbc            #]rtl
                 tcs
                 phd
                 inc
                 tcd
                 phb
                 phk
                 plb
                 lda            windowflag
                 pha
                 lda            #-1
                 sta            windowflag
                 psl            #:str
                 _QADrawErrString
                 lda            ]errorcode
                 pha
                 _QAPrbytel
                 pea            #$0d
                 _QADrawErrChar
                 pla
                 sta            windowflag
:xit             rep            $30
                 tax
                 lda            ]rtl+4
                 sta            ]newstack+4
                 lda            ]rtl+2
                 sta            ]newstack+2
                 lda            ]rtl
                 sta            ]newstack
                 plb
                 pld
                 tsc
                 clc
                 adc            #]newstack
                 tcs
                 txa
                 brl            errxit
:str             str            'Unknown Error $'

*------------------------------------------------------
pchar
pechar           php
                 rep            $30
                 jsr            printchar
                 plp
                 clc
                 rtl

pstr
pestr            php
                 phd
                 rep            $30
                 phx
                 pha
                 tsc
                 inc
                 tcd
                 sep            $30
                 lda            [0]
                 beq            :xit
                 tax
                 ldy            #$01
]lup             lda            [0],y
                 phy
                 phx
                 jsr            printchar
                 plx
                 ply
                 iny
                 dex
                 bne            ]lup
:xit             rep            $30
                 pla
                 pla
                 pld
                 plp
                 clc
                 rtl

pestrl
pstrl            php
                 phd
                 rep            $30
                 phx
                 pha
                 tsc
                 inc
                 tcd

                 lda            [0]
                 beq            :xit
                 tax
                 ldy            #$02
                 sep            $20
]lup             lda            [0],y
                 phy
                 phx
                 jsr            printchar
                 plx
                 ply
                 iny
                 dex
                 bne            ]lup
:xit             rep            $30
                 pla
                 pla
                 pld
                 plp
                 clc
                 rtl

pblk
peblk            php
                 phd
                 rep            $30
                 phx
                 pha
                 tsc
                 inc
                 tcd
                 sep            $20
                 ldy            #0
]lup             lda            [0],y
                 beq            :xit
                 phy
                 jsr            printchar
                 ply
                 iny
                 bne            ]lup
:xit             rep            $30
                 pla
                 pla
                 pld
                 plp
                 clc
                 rtl

*------------------------------------------------------
putop
putbyte
eval
relcorrect
rtl              clc
                 rtl

mytabtocol       sep            $20
                 cmpl           winwidth
                 blt            :ok
                 pha
                 jsl            DrawCR                      ;past edge, do a CR
                 pla
                 sec
                 sbcl           winwidth
:ok              cmpl           cursx
                 blt            :space
                 beq            :space
                 stal           cursx
                 rep            $30
                 lda            #0
                 clc
                 rtl

:space           rep            $30
                 brl            DrawSpace                   ;tab over a single space

*======================================================
* Routines to read the keyboard in a quick/fast manner.

mygetchar
                 ~GetNextEvent  #%101000;#tpfx
                 pla
                 beq            mygetchar                   ;wait for a keypress
                 lda            #0
                 stal           keypress                    ;show no keypress waiting
                 sep            $20
                 ldal           #$E0C025                    ;place modifiers in hi byte
                 xba
                 ldal           tpfx+2                      ; & ASCII in lo
                 ora            #$80
                 rep            $20
                 clc
                 rtl

*------------------------------------------------------
* Clear keypress flag, coulda been set earlier!

QAClearKey
                 lda            #0                          ;simple!
                 stal           keypress
                 brl            noerror

*------------------------------------------------------
* Allows QUICK checking to see if a key event occured

myKeyAvail
                 ldal           keypress                    ;all there is to it!
                 clc
                 rtl

*------------------------------------------------------
* Setup the Event Manager so we get to see keypresses
* as they happen, for quick and easy _KeyAvail checks.

InitASK
                 ~GetVector     #$F                         ;get the current keypress vector
                 pla
                 sta            amod+1
                 sta            EMKeyVect
                 pla
                 sta            EMKeyVect+2
                 SEP            #$20
                 sta            amod+3
                 REP            #$20
                 ~SetVector     #$F;#ASyncKey               ;point to our vector
                 rts

ASyncKey
                 ldal           $E0C025                     ;get modifiers
                 xba
                 ldal           $E0C000                     ; & combine into standard mod/ascii word
                 REP            #$20
                 stal           keypress                    ;save for later test
                 SEP            #$20
amod             jml            $E10000                     ; & continue w/keypress handling

*======================================================
* The PRINTCHAR control code handlers

formfeed         php
                 rep            $30
                 jsr            clearwindow
                 bra            h1
home             php
                 rep            $30
h1               lda            wintop
                 sta            cursy
                 lda            winleft
                 sta            cursx
                 jsr            setcurs
                 plp
                 rts

gotoxy           php
                 sep            $30
                 lda            #$01
                 tsb            charflag
                 plp
                 rts

tab2             php
                 sep            $30
                 lda            #%100
                 tsb            charflag
                 plp
                 rts

clreoln          php
                 sep            $30
                 lda            cursx
                 tax
                 clc
                 adc            winleft
                 tay
]lup             cpx            winwidth
                 bge            :done
                 phy
                 phx
                 lda            #$a0
                 jsr            storchar
                 plx
                 ply
                 iny
                 inx
                 bra            ]lup
:done            plp
                 rts

clrline          php
                 sep            $30
                 lda            #0
                 tax
                 clc
                 adc            winleft
                 tay
]lup             cpx            winwidth
                 bge            :done
                 phy
                 phx
                 lda            #$a0
                 jsr            storchar
                 plx
                 ply
                 iny
                 inx
                 bra            ]lup
:done            plp
                 rts


printmult        php
                 sep            $30
                 lda            #$80
                 tsb            charflag+1
                 lda            #%0110_0000
                 trb            charflag+1
                 plp
                 rts

clreos           rts

savexy           php
                 sep            $30
                 lda            cursx
                 sta            xtemp
                 lda            cursy
                 sta            ytemp
                 plp
                 rts

savex            php
                 sep            $30
                 lda            cursx
                 sta            xtemp
                 plp
                 rts

savey            php
                 sep            $30
                 lda            cursy
                 sta            ytemp
                 plp
                 rts

restorexy        php
                 sep            $30
                 lda            xtemp
                 sta            cursx
                 lda            ytemp
                 sta            cursy
                 jsr            setcurs
                 plp
                 rts

restorex         php
                 sep            $30
                 lda            xtemp
                 sta            cursx
                 jsr            setcurs
                 plp
                 rts

restorey         php
                 sep            $30
                 lda            ytemp
                 sta            cursy
                 jsr            setcurs
                 plp
                 rts


linefeed         php
                 rep            $30
                 lda            outflag
                 bit            #$80                        ;cr out?
                 beq            :lf
                 stz            outflag
                 plp
                 rts
:lf              inc            cursy
                 lda            cursy
                 cmp            winbot
                 blt            :update
                 beq            :update
                 jsr            scrollup
                 lda            winbot
                 sta            cursy
:update          rep            $30
                 and            #$7f
                 asl
                 tay
                 lda            table,y
                 sta            basl
                 plp
                 rts

textcr           php
                 rep            $30
                 stz            cursx
                 lda            outflag
                 bit            #$40                        ;has a LF been sent?
                 beq            :lf
                 stz            outflag
                 plp
                 rts

:lf              inc            cursy
                 lda            cursy
                 cmp            winbot
                 blt            :update
                 beq            :update
                 jsr            scrollup
                 lda            winbot
                 sta            cursy
:update          rep            $30
                 and            #$7f
                 asl
                 tay
                 lda            table,y
                 sta            basl
                 plp
                 rts

nil              rts

inverse          php
                 sep            $30
                 lda            #$80
                 trb            charflag
                 plp
                 rts
normal           php
                 sep            $30
                 lda            #$80
                 tsb            charflag
                 plp
                 rts
mouseon          php
                 sep            $30
                 lda            #$40
                 tsb            charflag
                 plp
                 rts
mouseoff         php
                 sep            $30
                 lda            #$40
                 trb            charflag
                 plp
                 rts


setcurs          php
                 rep            $30
                 lda            cursy
                 cmp            winbot
                 blt            :ok
                 lda            winbot
                 sta            cursy
:ok              asl
                 tay
                 lda            table,y
                 sta            basl
                 lda            cursx
                 clc
                 adc            winleft
                 cmp            winwidth
                 blt            :rts
                 beq            :rts
                 lda            cursx
                 clc
                 adc            winwidth
                 cmp            #80
                 blt            :s
                 lda            #80-1
:s               sta            cursx
:rts             plp
                 rts

ttinitscreen     php
                 rep            $30
                 pha
                 pha
                 tll            $0e0c                       ;_GetErrGlobals
                 pla
                 sta            errormask
                 pla
                 sta            errandmask
                 pha
                 pha
                 tll            $0C0C                       ;_GetInGlobals
                 pla
                 sta            inormask
                 pla
                 sta            inandmask
                 pha
                 pha
                 tll            $0D0C                       ;_GetOutGlobals
                 pla
                 sta            outormask
                 pla
                 sta            outandmask

                 pea            0
                 psl            #0
                 tll            $140C                       ;_GetErrorDevice
                 pll            errdevslot
                 pla
                 sta            errdevtype

                 pea            0
                 psl            #0
                 tll            $120C                       ;_GetInputDevice
                 pll            indevslot
                 pla
                 sta            indevtype

                 pea            0
                 psl            #0
                 tll            $130C                       ;_GetErrorDevice
                 pll            outdevslot
                 pla
                 sta            outdevtype

                 pea            2                           ;RAM Based
                 psl            #TTErrDevice
                 tll            $110C
                 pea            #$FF
                 pea            #$80
                 tll            $0B0C

                 pea            2                           ;RAM Based
                 psl            #TTDevice
                 tll            $0F0C
                 pea            #$FF
                 pea            #$80
                 tll            $090C

                 pea            2                           ;RAM Based
                 psl            #TTDevice
                 tll            $100C
                 pea            #$FF
                 pea            #$80
                 tll            $0A0C

                 jsr            ttinitvars
                 jsr            setcurs
                 jsr            clearwindow
                 plp
                 rts

ttshutdown       php
                 rep            $30
                 lda            indevtype
                 pha
                 psl            indevslot
                 tll            $0F0C
                 lda            inandmask
                 pha
                 lda            inormask
                 pha
                 tll            $090C

                 lda            outdevtype
                 pha
                 psl            outdevslot
                 tll            $100C
                 lda            outandmask
                 pha
                 lda            outormask
                 pha
                 tll            $0A0C

                 lda            errdevtype
                 pha
                 psl            errdevslot
                 tll            $110C
                 lda            errandmask
                 pha
                 lda            errormask
                 pha
                 tll            $0B0C
                 plp
                 rts

*======================================================
                 put            qatools.1
*======================================================

filetypelist
                 ASC            'NON'
                 ASC            'BAD'
                 ASC            '$02'
                 ASC            '$03'
                 ASC            'TXT'
                 ASC            '$05'
                 ASC            'BIN'
                 ASC            '$07'
                 ASC            '$08'
                 ASC            '$09'
                 ASC            '$0A'
                 ASC            '$0B'
                 ASC            '$0C'
                 ASC            '$0D'
                 ASC            '$0E'
                 ASC            'DIR'
                 ASC            '$10'
                 ASC            '$11'
                 ASC            '$12'
                 ASC            '$13'
                 ASC            '$14'
                 ASC            '$15'
                 ASC            'PFS'
                 ASC            '$17'
                 ASC            '$18'
                 ASC            'ADB'
                 ASC            'AWP'
                 ASC            'ASP'
                 ASC            '$1C'
                 ASC            '$1D'
                 ASC            '$1E'
                 ASC            '$1F'
                 ASC            '$20'
                 ASC            '$21'
                 ASC            '$22'
                 ASC            '$23'
                 ASC            '$24'
                 ASC            '$25'
                 ASC            '$26'
                 ASC            '$27'
                 ASC            '$28'
                 ASC            '$29'
                 ASC            '$2A'
                 ASC            '$2B'
                 ASC            '$2C'
                 ASC            '$2D'
                 ASC            '$2E'
                 ASC            '$2F'
                 ASC            '$30'
                 ASC            '$31'
                 ASC            '$32'
                 ASC            '$33'
                 ASC            '$34'
                 ASC            '$35'
                 ASC            '$36'
                 ASC            '$37'
                 ASC            '$38'
                 ASC            '$39'
                 ASC            '$3A'
                 ASC            '$3B'
                 ASC            '$3C'
                 ASC            '$3D'
                 ASC            '$3E'
                 ASC            '$3F'
                 ASC            '$40'
                 ASC            '$41'
                 ASC            '$42'
                 ASC            '$43'
                 ASC            '$44'
                 ASC            '$45'
                 ASC            '$46'
                 ASC            '$47'
                 ASC            '$48'
                 ASC            '$49'
                 ASC            '$4A'
                 ASC            '$4B'
                 ASC            '$4C'
                 ASC            '$4D'
                 ASC            '$4E'
                 ASC            '$4F'
                 ASC            '$50'
                 ASC            '$51'
                 ASC            '$52'
                 ASC            '$53'
                 ASC            '$54'
                 ASC            '$55'
                 ASC            '$56'
                 ASC            '$57'
                 ASC            '$58'
                 ASC            '$59'
                 ASC            '$5A'
                 ASC            '$5B'
                 ASC            '$5C'
                 ASC            '$5D'
                 ASC            '$5E'
                 ASC            '$5F'
                 ASC            '$60'
                 ASC            '$61'
                 ASC            '$62'
                 ASC            '$63'
                 ASC            '$64'
                 ASC            '$65'
                 ASC            '$66'
                 ASC            '$67'
                 ASC            '$68'
                 ASC            '$69'
                 ASC            '$6A'
                 ASC            '$6B'
                 ASC            '$6C'
                 ASC            '$6D'
                 ASC            '$6E'
                 ASC            '$6F'
                 ASC            '$70'
                 ASC            '$71'
                 ASC            '$72'
                 ASC            '$73'
                 ASC            '$74'
                 ASC            '$75'
                 ASC            '$76'
                 ASC            '$77'
                 ASC            '$78'
                 ASC            '$79'
                 ASC            '$7A'
                 ASC            '$7B'
                 ASC            '$7C'
                 ASC            '$7D'
                 ASC            '$7E'
                 ASC            '$7F'
                 ASC            '$80'
                 ASC            '$81'
                 ASC            '$82'
                 ASC            '$83'
                 ASC            '$84'
                 ASC            '$85'
                 ASC            '$86'
                 ASC            '$87'
                 ASC            '$88'
                 ASC            '$89'
                 ASC            '$8A'
                 ASC            '$8B'
                 ASC            '$8C'
                 ASC            '$8D'
                 ASC            '$8E'
                 ASC            '$8F'
                 ASC            '$90'
                 ASC            '$91'
                 ASC            '$92'
                 ASC            '$93'
                 ASC            '$94'
                 ASC            '$95'
                 ASC            '$96'
                 ASC            '$97'
                 ASC            '$98'
                 ASC            '$99'
                 ASC            '$9A'
                 ASC            '$9B'
                 ASC            '$9C'
                 ASC            '$9D'
                 ASC            '$9E'
                 ASC            '$9F'
                 ASC            '$A0'
                 ASC            '$A1'
                 ASC            '$A2'
                 ASC            '$A3'
                 ASC            '$A4'
                 ASC            '$A5'
                 ASC            '$A6'
                 ASC            '$A7'
                 ASC            '$A8'
                 ASC            '$A9'
                 ASC            '$AA'
                 ASC            'BAS'
                 ASC            'TDF'
                 ASC            'DAT'
                 ASC            '$AE'
                 ASC            '$AF'
                 ASC            'SRC'
                 ASC            'OBJ'
                 ASC            'LIB'
                 ASC            'S16'
                 ASC            'RTL'
                 ASC            'EXE'
                 ASC            'PIF'
                 ASC            'TIF'
                 ASC            'NDA'
                 ASC            'CDA'
                 ASC            'TOL'
                 ASC            'DRV'
                 ASC            '$BC'
                 ASC            'FST'
                 ASC            '$BE'
                 ASC            'DOC'
                 ASC            'PNT'
                 ASC            'PIC'
                 ASC            '$C2'
                 ASC            '$C3'
                 ASC            '$C4'
                 ASC            '$C5'
                 ASC            '$C6'
                 ASC            '$C7'
                 ASC            'FON'
                 ASC            'FND'
                 ASC            'ICN'
                 ASC            '$CB'
                 ASC            '$CC'
                 ASC            '$CD'
                 ASC            '$CE'
                 ASC            '$CF'
                 ASC            '$D0'
                 ASC            '$D1'
                 ASC            '$D2'
                 ASC            '$D3'
                 ASC            '$D4'
                 ASC            '$D5'
                 ASC            '$D6'
                 ASC            '$D7'
                 ASC            '$D8'
                 ASC            '$D9'
                 ASC            '$DA'
                 ASC            '$DB'
                 ASC            '$DC'
                 ASC            '$DD'
                 ASC            '$DE'
                 ASC            '$DF'
                 ASC            'TEL'
                 ASC            '$E1'
                 ASC            'ATK'
                 ASC            '$E3'
                 ASC            '$E4'
                 ASC            '$E5'
                 ASC            '$E6'
                 ASC            '$E7'
                 ASC            '$E8'
                 ASC            '$E9'
                 ASC            '$EA'
                 ASC            '$EB'
                 ASC            '$EC'
                 ASC            '$ED'
                 ASC            '$EE'
                 ASC            'PAS'
                 ASC            '$F0'
                 ASC            '$F1'
                 ASC            '$F2'
                 ASC            '$F3'
                 ASC            '$F4'
                 ASC            '$F5'
                 ASC            '$F6'
                 ASC            '$F7'
                 ASC            'LNK'
                 ASC            'DOS'
                 ASC            'INT'
                 ASC            'IVR'
                 ASC            'BAS'
                 ASC            'VAR'
                 ASC            'REL'
                 ASC            'SYS'

*------------------------------------------------------
* Stuff for the end of the code segment--no disk space!

qasmstr          asc            'MERLINGS'

DS_Start
                 dum            *                           ;allocated by loader

cmdline          ds             256
cmdhandle        ds             4                           ;handle to command table
cmdtbl           ds             4                           ;ptr to the internal cmd table
userid           ds             2                           ;our userid
initid           ds             2                           ;id that started us
started          ds             2                           ;<>0 if currently started up
modeflags        ds             4                           ;b15 = text (0), graphics (1)
                                                            ;b14 = Event Manager Active
numcmds          ds             2
compiler         ds             2
linker           ds             2
linkactive       ds             2
compileactive    ds             2
windowflag       ds             2

** application variables

shellUid         ds             2
quitflag         ds             2
cancelflag       ds             2
totalerrlev      ds             2
timerlevel       ds             2
parmhandle       ds             4                           ;handle to system preferences

xtemp            ds             2
ytemp            ds             2

filename         ds             130
objfilename      ds             130
objfiletype      ds             2
cmdstr           ds             256
errtbl           ds             20
timetbl          ds             10*8
symhandle        ds             4
symnext          ds             4
symptr           ds             4
symlabels        ds             2

inandmask        ds             2
inormask         ds             2
indevtype        ds             2
indevslot        ds             4
outandmask       ds             2
outormask        ds             2
outdevtype       ds             2
outdevslot       ds             4
errandmask       ds             2
errormask        ds             2
errdevtype       ds             2
errdevslot       ds             4

charflag         ds             2                           ;b7 = normal text enable
cursx            ds             2
cursy            ds             2
basl             ds             2
wintop           ds             2
winbot           ds             2
winleft          ds             2
winwidth         ds             2
fullwindow       ds             2                           ;neg if window not set to 80x24

launchflags      ds             2
launchpath       ds             256

stack            ds             2
return           ds             2

p16y             ds             2

outflag          ds             2
startx           ds             2
startpos         ds             2
curpos           ds             2
tempbuff         ds             256

hdstr            ds             declen+1
hdfinalstr       ds             declen+2

EMKeyVect        ds             4
keypress         ds             2
VCount           ds             2
BlinkRate        ds             2

wcstring         ds             16
wcftype          ds             2
wcftypemask      ds             2
wcaux            ds             4
wcauxmask        ds             4

dhandles         ds             maxlevels*8

spfx             ds             2
                 ds             2
pptr             ds             4

tpfx             ds             258

emactive         dw             0
keyintsactive    ds             2
keyaddress       ds             2

DS_Size          =              *-CmdLine
                 ENT            DS_Size
                 dend

                 typ            tol

                 lst            off
                 sav            2/obj/qatools.l

