37 ace.s 1383 ;ACE-128/64 kernel by Craig Bruce, started 04-Mar-1992. ;* system zero-page memory usage: ;* $02-$7f = application work area ;* $80-$8f = system work area ;* $fa-$ff = system parameter area ;* initial ACE RAM0 organization ;* $0000-$0eff = system storage ;* $0f00-$0fff = kernel interface variables ;* $1000-$12ff = system storage ;* $1300-$1fff = Shell program (3.25K) ;* $2000-$27ff = character set (2K) ;* $2800-$5fff = ACE kernel and device drivers (14K) ;* $6000-$bfff = application area & stack (24K) ;* $c000-$ffff = ROM and I/O, RAM (16K) ;* far memory types ;* $00=null, $01=reu, $02=internal-512K, $06=rl-reu, $07=rl-ram computer = 128 .seq acehead.s .org $2800 .if computer-64 .obj "@0:ace128" .else .obj "@0:ace64" .ife ;***jump table jmp entryPoint jmp aceOpen jmp aceClose jmp aceRead jmp aceWrite jmp aceIsdir jmp aceBload jmp aceCmdOpen jmp aceCmdClose jmp aceCmdSend jmp aceCmdStatus jmp aceDirOpen jmp aceClose jmp aceDirRead jmp aceFcbSwap jmp aceRemove jmp aceRename jmp aceChDir jmp aceZpLoad jmp aceZpStore jmp aceFetch jmp aceStash jmp acePageAlloc jmp acePageFree jmp aceExit jmp aceDevInfo jmp aceStopKey jmp aceUtoa jmp aceGetDate jmp aceSetDate jmp aceExec jmp aceCdHome jmp aceWinmax jmp aceWincls jmp aceWinset jmp aceWinsize jmp aceWinload jmp aceWinsave jmp aceWinput jmp aceWincolor jmp aceWinpos jmp aceWincursor jmp aceWinscroll jmp conGetkey jmp conColor jmp conPalette jmp conScreen ;***global declarations maxZpUse = $90 configBuf = $800 basicZpSave = $900 keyline = $b00 cdBuffer = $c00 ram0FreeMap = $d00 freemap = $e00 .if computer-64 maxPage = $c0 bkACE = $0e bkKernel = $00 bkCharset = $0f bkSelect = $ff00 kernelIrqHandler = $fa65 kernelBrkHandler = $b003 kernelNmiHandler = $fa40 .else stringBuffer = $a00 maxPage = $d0 bkSelect = $01 bkACE = $76 bkKernel = $77 kernelIrqHandler = $ea31 kernelBrkHandler = $fe66 kernelNmiHandler = $fe47 .ife cia1 = $dc00 chrCR = $0d st = $90 true = $ff false = $00 fcbCount = 16 lftable .buf fcbCount devtable .buf fcbCount satable .buf fcbCount eoftable .buf fcbCount pidtable .buf fcbCount lfnull = $ff fcbNull = $ff minDisk = 8 regsave .buf 3 newlf .buf 1 kernelClall = $ffe7 kernelSetbnk = $ff68 kernelSetmsg = $ff90 kernelReadst = $ffb7 kernelSetlfs = $ffba kernelSetnam = $ffbd kernelOpen = $ffc0 .if computer-64 kernelClose = $ffc3 .ife kernelChkin = $ffc6 kernelChkout = $ffc9 kernelClrchn = $ffcc kernelChrin = $ffcf kernelChrout = $ffd2 kernelLoad = $ffd5 kernelStop = $ffe1 kernelGetin = $ffe4 kernelScrorg = $ffed .if computer-64 ;128 nothing here .else ;*** kernel close with pseudo-close for disk command channel for the 64 kernelClose = * bcs + jmp $ffc3 + ldx $98 - dex bmi kernelCloseExit cmp $259,x bne - beq + brk ;** found entry; copy last entry on top if it + ldy $98 dey lda $259,y ;move lfn sta $259,x lda $263,y ;move dev num sta $263,x lda $26d,y ;move sec addr sta $26d,x dec $98 kernelCloseExit = * clc rts .ife ;*** entrypoint() entryPoint = * lda #0 pha plp lda #bkACE sta bkSelect jmp main ;*** startup() aceBootstrap = * php sei ldx #2 - lda $00,x sta basicZpSave,x lda #0 sta $00,x inx cpx #maxZpUse bcc - lda #irqInitHandler sta $314 sty $315 lda #brkHandler sta $316 sty $317 lda #nmiHandler sta $318 sty $319 ldx #127 lda #0 - sta errno,x dex bpl - lda 186 ;last accessed Commodore device cmp #8 bcs + lda #$04 + sta aceCurrentDevice lda #0 jsr kernelSetmsg .if computer-64 lda #0 ldx #0 jsr kernelSetbnk .ife jsr kernelClall plp rts aceConfig = * lda #0 ldx bootDevice ldy #0 jsr kernelSetlfs lda #6 ldx #aceConfigName jsr kernelSetnam lda #0 ldx #aceAppAddress jsr kernelLoad bcc + rts + lda #configBuf sta 2 sty 3 lda #aceStartupMsg sta 4 sty 5 lda #ram0FreeMap sta 6 sty 7 ldx #>aceBssEnd lda #cdBuffer sta aceCurDirName+0 sty aceCurDirName+1 jsr initStack lda #shellPathBuf sta aceShellPath+0 sty aceShellPath+1 ldx #31 - lda configBuf+$e0,x sta shellPathBuf,x dex bpl - lda #shellAliasBuf sta aceShellAlias+0 sty aceShellAlias+1 lda #0 sta shellAliasBuf lda #1 sta aceProcessID ;jsr aceIrqInit rts initStack = * lda #$ac sta aceID lda #$e1 sta aceID+1 lda #0 .if computer-64 ldy configBuf+$a8 .else ldy configBuf+$c6 .ife cpy #maxPage bcc + ldy #maxPage + sta aceStackTop+0 sty aceStackTop+1 sta aceStackPtr+0 sty aceStackPtr+1 lda #0 ;push the ZERO trailer argv ldy #0 jsr pushAY lda #0 ;push argc ldy #0 jsr pushAY lda #$ff ;push flags, restore stderr ldy #$00 jsr pushAY lda #$ff ;push restore stdout, restore stdin ldy #$ff jsr pushAY lda #$ff ;push previous frame pointer ldy #$ff jsr pushAY lda aceStackPtr ldy aceStackPtr+1 sta aceFramePtr sty aceFramePtr+1 rts zsp = $60 pushAY = * tax sec lda aceStackPtr sbc #2 sta aceStackPtr sta zsp lda aceStackPtr+1 sbc #0 sta aceStackPtr+1 sta zsp+1 tya ldy #1 sta (zsp),y dey txa sta (zsp),y rts ;*** shutdown() aceShutdown = * ldx #2 - lda basicZpSave,x sta $00,x inx cpx #maxZpUse bcc - lda #bkKernel sta bkSelect php sei lda #kernelIrqHandler sta $314 sty $315 lda #kernelBrkHandler sta $316 sty $317 lda #kernelNmiHandler sta $318 sty $319 .if computer-64 .else lda #%10000001 sta $dc0d lda #%01111111 sta $dd0d bit $dc0d bit $dd0d lda #%00000000 sta vic+$1a .ife plp rts lda #0 pha plp rts aceShutdownBasic = * .if computer-64 jsr vdcShutdown jsr vicShutdown .else jsr vicShutdown .ife jsr aceShutdown .if computer-64 lda #$16 sta 2604 sta $d018 lda #0 sta $1c00 jsr $51d6 jmp $4db7 .else lda #$16 sta $d018 lda #0 sta $800 jsr $a642 jmp $a474 .ife brk nmiHandler = * .if computer-64 cld lda #$7f sta $dd0d ldy $dd0d bmi + jsr $f63d jsr $ffe1 bne + jsr aceShutdown jsr $e056 jsr $e109 jsr $c000 lda #0 sta $1c00 jsr $51d6 jmp ($0a00) + jmp $ff33 .else cld pha txa pha tya pha lda #$7f sta $dd0d ldy $dd0d bmi + jsr $f6bc jsr $ffe1 bne + jsr aceShutdown jsr $fd15 jsr $fda3 jsr $e518 lda #0 sta $800 jsr $a642 jmp ($a002) + pla tay pla tax pla rti .ife irqInitHandler = * cld jmp kernelIrqHandler aceIrqInit = * php sei lda #irqHandler sta $314 sty $315 lda #%01111111 sta $dc0d sta $dd0d bit $dc0d bit $dd0d lda vic+$11 and #%01111111 ora #%00000000 sta vic+$11 lda #252 sta vic+$12 lda #%00000001 sta vic+$1a plp rts irqHandler = * ;(.AXY already saved, 128 bank) cld .if computer-64 .else lda bkSelect pha .ife lda vic+$19 bpl + and #1 bne sixty + lda $dc0d jmp irqExit ;%%% sixty = * sta vic+$19 lda #bkACE sta bkSelect jsr conScreenSave jsr vicIrqCursor jsr conIrqKeyscan jmp irqExit .if computer-64 irqExit = $ff33 .else irqExit = * pla sta bkSelect pla tay pla tax pla rti .ife brkHandler = * cld ldx #0 - lda $00,x sta $0400,x dex bne - jsr aceShutdown .if computer-64 lda #0 sta $1c00 ;jsr $51d6 .else lda #0 sta $800 jsr $a642 .ife jmp kernelBrkHandler ;*** getDevice( zp=filenameZ ) : .A=device, .Y=scanPos getDevice = * ldy #0 lda (zp),y beq useDefault ldy #1 lda (zp),y cmp #":" bne useDefault ldy #0 lda (zp),y ldy #2 cmp #"." bne + lda aceCurrentDevice jmp gotDev + and #$1f asl asl jmp gotDev useDefault = * lda aceCurrentDevice ldy #0 gotDev = * rts getLfAndFcb = * ;() : .X=fcb, .A=lf openLfSearch = * inc newlf lda newlf and #$7f ldx #fcbCount-1 - cmp lftable,x beq openLfSearch dex bpl - tay ldx #0 - lda lftable,x bmi + inx cpx #fcbCount bcc - lda #aceErrNoFreeFcbs sec rts + lda aceProcessID sta pidtable,x tya clc rts ;*** isdir( (zp)=FilenameZ ) : .A=Dev, .X=isDisk, .Y=isDir aceIsdir = * jsr getDevice pha tax lda configBuf+0,x cmp #1 beq + cmp #4 beq + ldx #false ldy #false jmp isDirExit ldx #true + ldy #255 - iny lda (zp),y bne - dey lda (zp),y ldy #true cmp #":" beq isDirExit ldy #false isDirExit = * pla rts ;*** open( zp=filenameZ, .A=mode["r","w","a"] ) : .A=fcb openFcb = syswork+0 openNameScan = syswork+1 openMode = syswork+2 openNameLength = syswork+3 openDevice = syswork+4 checkStat .buf 1 aceOpen = * sta openMode lda #true sta checkStat jsr getLfAndFcb bcc + rts + sta lftable,x lda #$00 sta eoftable,x stx openFcb jsr getDevice sty openNameScan ldx openFcb sta devtable,x sta openDevice tax ;get sa here lda configBuf+0,x cmp #0 bne + ldy configBuf+2,x jmp nonDiskSa + ldy #0 cmp #1 bne nonDiskSa ldy #2 diskSaSearch = * ldx #fcbCount-1 - lda lftable,x bmi + lda devtable,x cmp openDevice bne + tya cmp satable,x bne + iny bne diskSaSearch + dex bpl - nonDiskSa = * ldx openFcb tya sta satable,x ;set the name ldx #0 ldy openNameScan - lda (zp),y sta stringBuffer,x beq + iny inx bne - + ldy openDevice lda configBuf+0,y cmp #1 bne nonDiskOpen ;** stick the mode for disk files cpx #0 bne + lda #aceErrOpenDirectory sec rts + lda #"," sta stringBuffer,x inx lda openMode sta stringBuffer,x inx jmp openGotName ;** get rid of the filename for non-disks nonDiskOpen = * ldx #0 openGotName = * ;** dispatch here for non-kernel devices txa ldx #stringBuffer jsr kernelSetnam ;set lfs ldx openFcb lda lftable,x pha lda satable,x tay lda devtable,x tax lda configBuf+1,x tax pla jsr kernelSetlfs ;do the open jsr kernelOpen bcs openError + ldx openDevice lda configBuf+0,x cmp #1 bne + lda checkStat beq + txa jsr openDiskStatus bcc + openError = * sta errno ldx openFcb lda lftable,x clc jsr kernelClose ldx openFcb lda #lfnull sta lftable,x sec lda #fcbNull rts + lda openFcb clc rts openDiskStatus = * ;( .A=device ) : errno=.A=errcode, .CS=errflag jsr cmdchOpen bcs + jsr checkDiskStatus php pha jsr cmdchClose pla plp + rts cmdchOpen = * ;( .A=device ) pha jsr cmdchClose pla tax lda configBuf+1,x tax ldy #15 lda #lfnull jsr kernelSetlfs lda #0 jsr kernelSetnam jsr kernelOpen bcc + sta errno + rts cmdchSend = * ;( stringBuffer ) ldx #lfnull jsr kernelChkout bcs cmdchErr ldx #0 - lda stringBuffer,x beq + jsr kernelChrout bcs cmdchErr inx bne - + jsr kernelClrchn clc rts cmdchErr = * sta errno pha jsr kernelClrchn pla sec rts checkDiskStatusCode .buf 1 checkDiskStatus = * ldx #lfnull jsr kernelChkin bcs cmdchErr jsr kernelChrin bcs cmdchErr and #$0f sta checkDiskStatusCode asl asl adc checkDiskStatusCode asl sta checkDiskStatusCode jsr kernelChrin bcs cmdchErr and #$0f clc adc checkDiskStatusCode sta checkDiskStatusCode - jsr kernelReadst and #$80 beq + lda #aceErrDeviceNotPresent sec bcs cmdchErr + jsr kernelChrin bcs cmdchErr cmp #chrCR bne - jsr kernelClrchn lda checkDiskStatusCode cmp #62 bne + lda #aceErrFileNotFound sta errno sec rts + cmp #20 bcc + sta errno + rts cmdchClose = * sec lda #lfnull jsr kernelClose bcc + sta errno + rts ;*** close( .A=fcb ) aceClose = * tax lda lftable,x pha lda #lfnull sta lftable,x pla clc jmp kernelClose ;*** read( .X=fcb, (zp)=data, .AY=maxLength ) : .AY=length, .Z=eof readMaxLen = syswork+0 readPtr = syswork+2 readLength = syswork+4 readFcb = syswork+6 readDeviceDisk = syswork+7 aceRead = * sta readMaxLen+0 sty readMaxLen+1 stx readFcb lda zp+0 ldy zp+1 sta readPtr+0 sty readPtr+1 lda #0 sta readLength+0 sta readLength+1 lda eoftable,x bne readEofExit ldy #0 lda devtable,x tax lda configBuf+0,x cmp #2 bne + jmp conRead + cmp #1 bne + ldy #$ff + ldx readFcb sty readDeviceDisk lda lftable,x tax jsr kernelChkin bcc readByte rts readByte = * lda readLength+0 cmp readMaxLen+0 lda readLength+1 sbc readMaxLen+1 bcs readExit jsr kernelChrin ldy #0 sta (readPtr),y inc readPtr+0 bne + inc readPtr+1 + inc readLength+0 bne + inc readLength+1 + bit readDeviceDisk bpl readByte lda st and #$40 beq readByte ldx readFcb sta eoftable,x readExit = * jsr kernelClrchn readExitNoclr = * lda readLength+0 ldy readLength+1 ldx #$ff clc rts readEofExit = * lda #0 ldy #0 clc rts ;*** write( .X=fcb, (zp)=data, .AY=length ) writeLength = syswork+0 writePtr = syswork+2 aceWrite = * sta writeLength+0 sty writeLength+1 lda zp+0 ldy zp+1 sta writePtr+0 sty writePtr+1 stx regsave+1 lda devtable,x tax lda configBuf+0,x cmp #2 ;beq writeByte bne + jmp conWrite + ldx regsave+1 lda lftable,x tax jsr kernelChkout bcc writeByte rts writeByte = * lda writeLength+0 ora writeLength+1 beq writeFinish ldy #0 lda (writePtr),y jsr kernelChrout bcc + sta errno jsr kernelClrchn sec rts + inc writePtr+0 bne + inc writePtr+1 + lda writeLength+0 bne + dec writeLength+1 + dec writeLength+0 jmp writeByte writeFinish = * jsr kernelClrchn clc rts ;*** cmdopen( (zp)=DevName ) : .A=Fcb getDiskDevice = * ;( (zp)=devname ) : .A=device, .Z=isKernalDisk jsr getDevice tax lda configBuf+0,x cmp #1 php txa plp rts aceCmdOpen = * jsr getDiskDevice beq + lda #aceErrDiskOnlyOperation sta errno sec rts + sta openDevice jsr getLfAndFcb bcc + rts + sta lftable,x stx openFcb lda openDevice sta devtable,x lda #0 sta eoftable,x lda #15 sta satable,x stx openFcb lda #0 sta stringBuffer lda #false sta checkStat ldx #0 jsr openGotName bcc + rts + lda st and #$80 beq + lda #aceErrDeviceNotPresent sta errno sec rts + lda openFcb rts ;*** cmdclose( .A=fcb ) aceCmdClose = * tax lda lftable,x pha lda #lfnull sta lftable,x pla sec jmp kernelClose ;*** cmdsend( .X=Fcb, .AY=Cmd ) aceCmdSend = * sta syswork+0 sty syswork+1 lda lftable,x tax jsr kernelChkout bcc + sta errno rts + ldy #0 - lda (syswork),y beq + jsr kernelChrout bcs ++ iny bne - + jsr kernelClrchn clc rts + sta errno jsr kernelClrchn sec rts ;*** cmdstatus( .X=Fcb, .AY=StatusBuf ) : StatusBuf, .A=statusCode aceCmdStatus = * sta syswork+0 sty syswork+1 lda lftable,x tax jsr kernelChkin bcc + - sta errno jsr kernelClrchn sec rts + ldy #0 - jsr kernelChrin bcs -- cmp #$0d beq + sta (syswork),y iny jsr kernelReadst and #$40 beq - + lda #0 sta (syswork),y jsr kernelClrchn ldy #0 lda (syswork),y and #$0f asl asl adc (syswork),y asl sta syswork+3 iny lda (syswork),y and #$0f adc syswork+3 clc rts .seq acecall.s .seq acemem.s .seq acecon.s ;*** screen calls textMode .buf 1 .if computer-64 .seq acevdc.s .seq acevic.s .else .seq acevic80.s .seq acevic.s .ife screenInit = * .if computer-64 jsr vdcInit jsr vicInit lda #80 bit $d7 bmi + lda #40 + jsr conscreen .else lda #40 ;xx check config for screen jsr conscreen .ife rts aceWinmax = * bit textMode bmi + jmp vicWinmax + jmp vdcWinmax aceWincls = * bit textMode bmi + jmp vicWincls + jmp vdcWincls aceWinset = * bit textMode bmi + jmp vicWinset + jmp vdcWinset aceWinsize = * bit textMode bmi + jmp vicWinsize + jmp vdcWinsize aceWinload = * bit textMode bmi + jmp vicWinload + jmp vdcWinload aceWinsave = * bit textMode bmi + jmp vicWinsave + jmp vdcWinsave aceWinput = * bit textMode bmi + jmp vicWinput + jmp vdcWinput aceWincolor = * bit textMode bmi + jmp vicWincolor + jmp vdcWincolor aceWinpos = * bit textMode bmi + jmp vicWinpos + jmp vdcWinpos aceWincursor = * bit textMode bmi + jmp vicWincursor + jmp vdcWincursor aceWinscroll = * bit textMode bmi + jmp vicWinscroll + jmp vdcWinscroll ;*** main() bootDevice .buf 1 titlePtr .buf 2 titleLen .buf 2 main = * lda #147 jsr kernelChrout lda #14 jsr kernelChrout ldx #0 - lda aceStartupMsg,x beq + jsr kernelChrout inx bne - + sei jsr aceBootstrap lda aceCurrentDevice sta bootDevice jsr initMemory jsr aceConfig bcs mainExit lda 2 ldy 3 sta titlePtr+0 sty titlePtr+1 lda 4 ldy 5 sta titleLen+0 sty titleLen+1 jsr aceStartup jsr initMemoryAlloc sei jsr screenInit jsr conInit jsr aceIrqInit cli ;** open std files lda #configBuf+$91 sta zp+0 sty zp+1 jsr chdir lda #stdinName sta zp+0 sty zp+1 lda #"r" jsr open ;fcb=0 lda #stdoutName sta zp sty zp+1 lda #"w" jsr open ;fcb=1 lda #"w" jsr open ;fcb=2 lda titlePtr+0 ldy titlePtr+1 sta zp+0 sty zp+1 lda titleLen+0 ldy titleLen+1 ldx #stdout jsr write cli ;** call shell lda #aceShellAddress jsr exec ;** exit mainExit = * lda #stdin jsr close lda #stdout jsr close lda #stderr jsr close lda bootDevice sta 186 jsr shutdownMemory lda #147 jsr kernelChrout jmp aceShutdownBasic stdoutName .asc "s:" .byte 0 stdinName .asc "k:" .byte 0 aceStartupMsg = * .if computer-64 .asc "ACE-128 " .else .asc "ACE-64 " .ife .asc "Kernel 0.54.00 - CSB 30-Nov-93" .byte chrCR,chrCR,0 ;*** bss: c128=768 bytes, c64=512 bytes aceBss = * shellAliasBuf = aceBss+0 shellPathBuf = shellAliasBuf+256 .if computer-64 stringBuffer = shellPathBuf+256 aceBssEnd = stringBuffer+256 .else aceBssEnd = shellPathBuf+256 .ife acecall.s 801 ;*** diropen( (zp)=deviceName ) : .A=fcb aceDirOpen = * lda #true sta checkStat jsr getDiskDevice beq + lda #aceErrDiskOnlyOperation sec rts + sta openDevice sty openNameScan jsr getLfAndFcb bcc + rts + sta lftable,x lda openDevice sta devtable,x lda #0 sta eoftable,x lda #0 sta satable,x stx openFcb lda #"$" sta stringBuffer lda #"0" sta stringBuffer+1 lda #0 sta stringBuffer+2 ldx #2 jsr dirOpenSetName jsr openGotName bcc + rts + ldx openFcb lda lftable,x tax jsr kernelChkin jsr kernelChrin jsr kernelChrin jsr kernelClrchn lda openFcb clc rts dirOpenSetName = * ldy openDevice lda configBuf+3,y bmi dirNameDate ldy openNameScan lda (zp),y bne + rts + ldx #1 dirNameNormal = * - lda (zp),y sta stringBuffer,x beq + iny inx bne - + dex lda #":" cmp stringBuffer,x beq + inx sta stringBuffer,x + inx lda #"*" sta stringBuffer,x inx lda #0 sta stringBuffer,x rts dirNameDate = * lda #"=" sta stringBuffer+1 lda #"t" sta stringBuffer+2 ldx #3 ldy openNameScan jsr dirNameNormal lda #"=" sta stringBuffer,x inx lda #"l" sta stringBuffer,x inx lda #0 sta stringBuffer,x rts ;*** dirread( .X=fcb ) : .Z=eof, aceDirentBuffer=data dirBlocks = syswork+0 aceDirRead = * lda lftable,x tax jsr kernelChkin bcc + lda #0 rts ;** read the link + jsr kernelChrin sta syswork+4 jsr kernelReadst and #$40 bne dirreadEofExit jsr kernelChrin ora syswork+4 bne + dirreadEofExit = * jsr kernelClrchn ldx #0 rts ;** read the block count + jsr kernelChrin sta dirBlocks sta aceDirentBytes+1 jsr kernelChrin sta dirBlocks+1 sta aceDirentBytes+2 asl dirBlocks rol dirBlocks+1 lda #0 rol sta dirBlocks+2 sec lda #0 sbc dirBlocks sta aceDirentBytes+0 lda aceDirentBytes+1 sbc dirBlocks+1 sta aceDirentBytes+1 lda aceDirentBytes+2 sbc dirBlocks+2 sta aceDirentBytes+2 ;** read the filename lda #0 sta aceDirentName sta aceDirentNameLen - jsr kernelChrin bcs dirreadErrExit bit st bvs dirreadErrExit cmp #" " beq - cmp #18 beq - cmp #$22 bne dirreadExit ldx #0 - jsr kernelChrin bcs dirreadErrExit bit st bvs dirreadErrExit cmp #$22 beq + sta aceDirentName,x inx bne - + lda #0 sta aceDirentName,x stx aceDirentNameLen - jsr kernelChrin cmp #" " beq - ;** read type and flags ldx #%01100000 stx aceDirentFlags cmp #"*" bne + lda aceDirentFlags ora #%00001000 sta aceDirentFlags jsr kernelChrin + ldx #3 ldy #0 jmp dirTypeFirst - jsr kernelChrin dirTypeFirst = * sta aceDirentType,y iny dex bne - lda #0 sta aceDirentType+3 lda aceDirentType cmp #"d" bne + lda aceDirentFlags ora #%10010000 sta aceDirentFlags jmp dirreadExit + cmp #"p" bne dirreadExit lda aceDirentFlags ora #%00010000 sta aceDirentFlags jmp dirreadExit dirreadErrExit = * sta errno jsr kernelClrchn ldx #0 sec rts dirreadExit = * jsr kernelChrin cmp #0 beq dirreadRealExit cmp #"<" bne + lda aceDirentFlags and #%11011111 sta aceDirentFlags + ldx #7 lda #0 - sta aceDirentDate,x dex bpl - - jsr kernelChrin cmp #0 beq dirreadRealExit cmp #"0" bcc - cmp #"9"+1 bcs - dirreadDate = * jsr dirGetNumGot sta aceDirentDate+2 jsr dirGetNum sta aceDirentDate+3 jsr dirGetNum sta aceDirentDate+1 lda configBuf+$86 sta aceDirentDate+0 jsr dirGetNum sta aceDirentDate+4 jsr dirGetNum sta aceDirentDate+5 jsr kernelChrin jsr kernelChrin cmp #"a" bne dirreadPM dirreadAM = * lda aceDirentDate+4 cmp #$12 bne + lda #$00 sta aceDirentDate+4 jmp + dirreadPM = * lda aceDirentDate+4 cmp #$12 beq + clc sei sed adc #$12 cld cli sta aceDirentDate+4 / jsr kernelChrin cmp #0 bne - dirreadRealExit = * jsr kernelClrchn ldx #$ff clc rts dirGetNum = * - jsr kernelChrin dirGetNumGot = * cmp #0 beq + cmp #"0" bcc - cmp #"9"+1 bcs - asl asl asl asl sta syswork+6 jsr kernelChrin cmp #0 beq + and #$0f ora syswork+6 + rts ;*** fcbswap( .X=Fcb1, .Y=Fcb2 ) aceFcbSwap = * lda lftable,x pha lda lftable,y sta lftable,x pla sta lftable,y lda devtable,x pha lda devtable,y sta devtable,x pla sta devtable,y lda satable,x pha lda satable,y sta satable,x pla sta satable,y lda eoftable,x pha lda eoftable,y sta eoftable,x pla sta eoftable,y lda pidtable,x pha lda pidtable,y sta pidtable,x pla sta pidtable,y clc rts ;*** bload( (zp)=Name, .AY=Address ) : .AY=End+1 bloadAddress = syswork bloadFilename = syswork+2 bloadDevice = syswork+4 aceBload = * sta bloadAddress+0 sty bloadAddress+1 jsr getDevice sta bloadDevice tax clc tya adc zp+0 sta bloadFilename+0 lda zp+1 adc #0 sta bloadFilename+1 lda configBuf+1,x tax lda #0 ldy #0 jsr kernelSetlfs ldy #0 - lda (bloadFilename),y beq + iny bne - + tya ldx bloadFilename+0 ldy bloadFilename+1 jsr kernelSetnam lda #0 ldx bloadAddress+0 ldy bloadAddress+1 jsr kernelLoad stx bloadAddress+0 sty bloadAddress+1 bcc bloadOk pha cmp #aceErrDeviceNotPresent beq + ldx bloadDevice lda configBuf+0,x cmp #1 bne + txa jsr openDiskStatus + pla - sta errno lda #0 lda #0 ldy #0 sec rts bloadOk = * ldx bloadDevice lda configBuf+0,x cmp #1 bne + txa jsr openDiskStatus bcs - + lda bloadAddress+0 ldy bloadAddress+1 rts ;*** remove( (zp)=Name ) removeDevice = syswork aceRemove = * jsr getDiskDevice sta removeDevice lda #"s" sta stringBuffer lda #":" sta stringBuffer+1 ldx #1 lda (zp),y cmp #"/" beq + ldx #2 / lda (zp),y sta stringBuffer,x beq + iny inx bne - + lda #0 sta stringBuffer,x lda removeDevice jsr cmdchOpen bcs ++ jsr cmdchSend bcs + jsr checkDiskStatus + php jsr cmdchClose plp + rts ;*** cdhome( ) aceCdHome = * lda #configBuf+$90 sta zp+0 sty zp+1 ;xx fall through ;*** chdir( (zp)=DirName ) chdirDevice = syswork+0 chdirScan = syswork+1 chdirNameScan = syswork+2 chdirCmdOpen = syswork+3 aceChDir = * lda #0 sta chdirCmdOpen jsr getDiskDevice beq + lda #aceErrDiskOnlyOperation sta errno sec rts + sty chdirNameScan sta chdirDevice + lda #"c" sta stringBuffer+0 lda #"p" sta stringBuffer+1 ldx #2 - lda (zp),y cmp #"0" bcc + cmp #"9"+1 bcs + sta stringBuffer,x inx iny bne - + cpx #2 beq chdirCd lda #0 sta stringBuffer,x sty chdirScan lda chdirDevice jsr cmdchOpen bcc + rts + lda #$ff sta chdirCmdOpen jsr cmdchSend bcs chdirAbort jsr checkDiskStatus bcs chdirAbort ldy chdirScan chdirCd = * lda #"d" sta stringBuffer+1 ldx #2 - lda (zp),y sta stringBuffer,x beq + cmp #":" beq + iny inx bne - + cpx #2 beq chdirSetName lda #0 sta stringBuffer,x lda chdirCmdOpen bmi + lda chdirDevice jsr cmdchOpen bcc + rts + jsr cmdchSend bcs chdirAbort jsr checkDiskStatus bcs chdirAbort jsr cmdchClose chdirSetName = * lda chdirDevice sta aceCurrentDevice lsr lsr ora #$40 sta cdBuffer lda #":" sta cdBuffer+1 ldx #2 ldy chdirNameScan - lda (zp),y sta cdBuffer,x beq + inx iny bne - + rts chdirAbort = * jsr cmdchClose sec rts ;*** devinfo( .X=Fcb ) : .A=DevType(0=con,1=char,2=disk), .X=Cols, .Y=Rows aceDevInfo = * lda devtable,x tax lda configBuf+0,x cmp #2 bne + jsr winsize tay ldx syswork+0 lda #0 rts + ldx #80 ldy #66 cmp #1 beq + cmp #4 beq + lda #1 rts + lda #2 rts ;*** utoa( $0+X=value32, ($80)=buf, .A=minLen ) : buf, .A=.Y=len utoaBuf = syswork ;(2) utoaBin = syswork+2 ;(4) utoaBcd = syswork+6 ;(5) utoaFlag = syswork+11 ;(1) utoaLen = syswork+12 ;(1) utoaPos = syswork+13 ;(1) aceUtoa = * cmp #10 bcc + lda #10 + sta utoaLen sec lda #10 sbc utoaLen sta utoaLen ldy #0 - lda 0,x sta utoaBin,y inx iny cpy #4 bcc - ldx #4 lda #0 - sta utoaBcd,x dex bpl - sta utoaFlag ldy #32 sei sed utoaNextBit = * asl utoaBin+0 rol utoaBin+1 rol utoaBin+2 rol utoaBin+3 ldx #4 - lda utoaBcd,x adc utoaBcd,x sta utoaBcd,x dex bpl - dey bne utoaNextBit cld cli lda #10 sta utoaPos ldx #0 ldy #0 - lda utoaBcd,x jsr utoaPutHex inx cpx #5 bcc - lda #0 sta (utoaBuf),y rts utoaPutHex = * pha lsr lsr lsr lsr jsr utoaPutDigit pla and #$0f utoaPutDigit = * dec utoaPos beq utoaForceDigit cmp utoaFlag bne utoaForceDigit dec utoaLen bmi + rts + lda #$20 bne utoaPoke utoaForceDigit = * ora #$30 sta utoaFlag utoaPoke = * sta (utoaBuf),y iny rts ;*** date( (.AY)=dateString ) fmt:YY:YY:MM:DD:HH:MM:SS:TW aceGetDate = * sta syswork sty syswork+1 ldy #3 - lda aceDate,y sta (syswork),y dey bpl - ldy #4 lda cia1+$b bpl + and #$1f sei sed clc adc #$12 cld cli + cmp #$12 bne + lda #$00 + cmp #$24 bne + lda #$12 + sta (syswork),y iny lda cia1+$a sta (syswork),y iny lda cia1+$9 sta (syswork),y iny lda cia1+$8 asl asl asl asl ora aceDOW sta (syswork),y rts aceSetDate = * sta syswork sty syswork+1 ldy #3 - lda (syswork),y sta aceDate,y dey bpl - ldy #4 lda (syswork),y cmp #$13 bcc + sei sed sec sbc #$12 cld cli ora #$80 + sta cia1+$b iny lda (syswork),y sta cia1+$a iny lda (syswork),y sta cia1+$9 iny lda (syswork),y lsr lsr lsr lsr sta cia1+$8 lda (syswork),y and #$07 sta aceDOW rts ;*** rename( (zp)=OldName, (zw)=NewName ) ;*** don't even think about renaming files outside the current directory renameDevice = syswork+0 renameScan = syswork+1 aceRename = * jsr getDiskDevice sta renameDevice sty renameScan lda #"r" sta stringBuffer+0 lda #":" sta stringBuffer+1 ;** copy new name ldy #0 ldx #2 - lda (zw),y sta stringBuffer,x beq + iny inx bne - + lda #"=" sta stringBuffer,x inx ;** copy old name ldy renameScan - lda (zp),y sta stringBuffer,x beq + inx iny bne - + lda renameDevice jsr cmdchOpen bcs ++ jsr cmdchSend bcs + jsr checkDiskStatus + php jsr cmdchClose plp + rts ;blank line acecon.s 991 ;ACE-128/64 kernel console driver: high level I/O & keyboard conWinStart .buf 2 conWinRows .buf 1 conWinCols .buf 1 conRowInc .buf 2 conLineAddr .buf 2 conCurRow .buf 1 conCurCol .buf 1 conPutMask .byte $80 ;.buf 1 conCharColor .byte $0e ;.buf 1 conCursorColor .byte $07 ;.buf 1 chrTab = $09 keylinePtr .buf 1 keylineCount .buf 1 .if computer-64 shiftValue = $d3 .else shiftValue = $28d .ife conInit = * lda configBuf+$8e sta conSsMax sta conSsCountdown lda #0 sta keylineCount jsr keyscanInit conWinInit = * jsr winsize sta conWinRows lda syswork+0 sta conWinCols lda syswork+2 ldy syswork+3 sta conWinStart+0 sty conWinStart+1 lda syswork+4 ldy syswork+5 sta conRowInc+0 sty conRowInc+1 conCls = * lda #" " ldy conCharColor ldx #$ff jsr wincls jsr conHome rts conShutdown = * rts conHome = * lda conWinStart+0 ldy conWinStart+1 sta conLineAddr+0 sty conLineAddr+1 lda #0 sta conCurRow sta conCurCol rts conPutSave .buf 1 conPutchar = * ;( .A=char ) cmp #chrCR beq conNewline cmp #147 beq conCls cmp #chrTab bne + jmp conTab + sta conPutSave lda conCurCol cmp conWinCols bcc + jsr conNewline + clc lda conLineAddr+0 adc conCurCol sta syswork+0 lda conLineAddr+1 adc #0 sta syswork+1 lda #conPutSave sta zw+0 sty zw+1 ldx #1 stx syswork+5 lda conPutMask ldy conCharColor jsr winput inc conCurCol rts conGetCursorAddr = * clc lda conLineAddr+0 adc conCurCol sta syswork+0 lda conLineAddr+1 adc #0 sta syswork+1 rts conSynchCursor = * lda conCurCol cmp conWinCols bcc + jsr conNewline + rts conNewline = * - lda shiftValue and #$0f cmp #$04 beq - lda scrollFreeze bne - lda #0 sta conCurCol inc conCurRow lda conCurRow cmp conWinRows bcs + clc lda conLineAddr+0 adc conRowInc+0 sta conLineAddr+0 lda conLineAddr+1 adc conRowInc+1 sta conLineAddr+1 clc rts + dec conCurRow jsr conScroll clc rts conScroll = * lda #"+" sta syswork+4 lda conPutMask ldx #1 ldy conCharColor jsr winscroll rts conTab = * lda conCurCol and #7 sta syswork+0 sec lda #8 sbc syswork+0 clc adc conCurCol cmp conWinCols bcc + lda conWinCols + sta conCurCol rts ;*** conWrite( writePtr, writeLength ) **zw gets modified** conWritePtr = syswork+8 conWriteLength = syswork+10 conWrite = * lda writeLength+0 ldy writeLength+1 sta conWriteLength+0 sty conWriteLength+1 lda writePtr+0 ldy writePtr+1 sta conWritePtr+0 sty conWritePtr+1 conWriteByte = * lda conWriteLength+0 ora conWriteLength+1 beq conWriteFinish ldy #0 lda (conWritePtr),y jsr conPutchar inc conWritePtr+0 bne + inc conWritePtr+1 + lda conWriteLength+0 bne + dec conWriteLength+1 + dec conWriteLength+0 jmp conWriteByte conWriteFinish = * clc rts ;*** conRead( readPtr, readMaxLen, readLength ) : .AY=len, .Z conRead = * lda readLength+0 cmp readMaxLen+0 lda readLength+1 sbc readMaxLen+1 bcs conReadExit jsr keylineGet bcs conReadEofExit ldy #0 sta (readPtr),y inc readPtr+0 bne + inc readPtr+1 + inc readLength+0 bne + inc readLength+1 + cmp #$0d beq conReadExit jmp conRead conReadExit = * lda readLength+0 ldy readLength+1 ldx #$ff clc rts conReadEofExit = * lda #0 ldy #0 clc rts keylineGet = * ;( keylinePtr, keylineCount ) : .A=char, .CS=eof lda keylineCount bne + jsr conInput bcs ++ + ldx keylinePtr inc keylinePtr dec keylineCount lda keyline,x clc + rts conParmSave .buf 8 conInput = * ldx #7 - lda syswork,x sta conParmSave,x dex bpl - ldx #0 stx keylinePtr stx keylineCount conInNext = * jsr conSynchCursor jsr conCursorOn jsr conGetkey jsr conCursorOff cmp #$0d beq conInReturn cmp #$14 beq conInBackspace cmp #$03 beq conInNext cmp #147 beq conInClear cmp #$04 bne + jsr conRestoreParms sec rts + ldx keylinePtr cpx #254 bcs conInNext sta keyline,x inc keylinePtr jsr conPutchar jmp conInNext conInReturn = * ldx keylinePtr sta keyline,x inx stx keylineCount ldx #0 stx keylinePtr jsr conPutchar jsr conRestoreParms clc rts conInBackspace = * ldx keylinePtr beq + dec keylinePtr jsr conBackspace lda #" " jsr conPutchar jsr conBackspace + jmp conInNext conInClear = * jsr conPutchar lda #0 sta keylinePtr jmp conInNext conRestoreParms = * ldx #7 - lda conParmSave,x sta syswork,x dex bpl - rts conBackspace = * dec conCurCol bpl + ldx conWinCols dex stx conCurCol lda conCurRow beq + dec conCurRow sec lda conLineAddr+0 sbc conRowInc+0 sta conLineAddr+0 lda conLineAddr+1 sbc conRowInc+1 sta conLineAddr+1 + rts conCursorOn = * ;( ) jsr conGetCursorAddr ldy conCursorColor lda #$ff jsr wincursor rts conCursorOff = * ;( ) ;.A preserved pha jsr conGetCursorAddr lda #0 jsr wincursor pla rts conColor = * cmp #128 bcc + stx conCharColor + and #64 beq + sty conCursorColor + ldx conCharColor ldy conCursorColor rts conPalette = * ldy #0 bit textMode bmi + ldy #8 + ldx #0 - nop .if computer-64 lda configBuf+$b0,y .else lda configBuf+$d0,y .ife sta syswork+0,x iny inx cpx #8 bcc - rts conScreen = * ldx #$00 cmp #40+1 bcc + ldx #$80 + stx textMode .if computer-64 ;** 128-set fast/slow cpx #0 beq + lda vic+$11 and #%11101111 sta vic+$11 lda #1 sta vic+$30 jmp ++ + lda #0 sta vic+$30 lda vic+$11 ora #%00010000 sta vic+$11 + nop .else ;** 64-initialize screen hardware cpx #$00 bne + jsr vicInit jmp ++ + jsr vdcInit + nop .ife ;** change colors jsr conpalette ldx syswork+0 ldy syswork+1 lda #$ff jsr concolor jsr conpalette ldx syswork+7 ldy syswork+6 lda #$ff jsr wincolor ;** window parms jsr winmax jsr conWinInit rts ;3-Key Rollover-128 by Craig Bruce 18-Jun-93 from C= Hacking magazine .if computer-64 scanrows = 11 pk = $d02f newpos = $cc keycode = $d4 prevKeycode = $d5 xsave = $cd mask = $cc capsPort = $0001 keymapPtr = $cc .else scanrows = 8 pk .buf 1 ;dummy newpos = $f5 keycode = $cb prevKeycode = $c5 xsave = $f6 mask = $f5 capsPort .byte $40 keymapPtr = $f5 .ife stopKeyRow .buf 1 rollover = 3 nullKey = $ff pa = $dc00 pb = $dc01 conIrqKeyscan = * lda #0 sta pa sta pk - lda pb cmp pb bne - cmp #$ff beq noKeyPressed jsr conScreenUnsave jsr checkJoystick bcc noKeyPressed jsr keyscan jsr checkJoystick bcc noKeyPressed lda scanTable+7 sta stopKeyRow jsr selectMouse jsr shiftdecode jsr keydecode jsr keyorder bit ignoreKeys bmi + lda prevKeys+0 cmp #nullKey beq + sta keycode jmp interpKey noKeyPressed = * jsr selectMouse lda #nullKey ldx #rollover-1 - sta prevKeys,x dex bpl - jsr scanCaps lda #0 sta ignoreKeys sta stopKeyRow + lda #nullKey sta keycode sta prevKeycode rts selectMouse = * lda #$ff sta pk lda #$7f ;selects paddle/mouse A sta pa rts keyscanInit = * lda #nullKey ldx #rollover-1 - sta prevKeys,x dex bpl - lda #0 sta ignoreKeys rts keyscan = * .if computer-64 ldx #$ff ldy #$ff lda #$fe sta mask+0 lda #$ff sta mask+1 jmp + nextRow = * - lda pb cmp pb bne - sty pa sty pk eor #$ff sta scanTable,x sec rol mask+0 rol mask+1 + lda mask+0 sta pa lda mask+1 sta pk inx cpx #scanrows bcc nextRow rts .else ldx #$ff ldy #$ff lda #$fe sta mask jmp + nextRow = * - lda pb cmp pb bne - sty pa eor #$ff sta scanTable,x sec rol mask + lda mask sta pa inx cpx #scanrows bcc nextRow rts .ife shiftRows .byte $01,$06,$07,$07,$0a shiftBits .byte $80,$10,$20,$04,$01 shiftMask .byte $01,$01,$02,$04,$08 shiftdecode = * jsr scanCaps .if computer-64 ldy #4 .else ldy #3 .ife - ldx shiftRows,y lda scanTable,x and shiftBits,y beq + lda shiftMask,y ora shiftValue sta shiftValue lda shiftBits,y eor #$ff and scanTable,x sta scanTable,x + dey bpl - rts scanCaps = * - lda capsPort cmp capsPort bne - eor #$ff and #$40 lsr lsr sta shiftValue rts keydecode = * ldx #rollover-1 lda #$ff - sta newKeys,x dex bpl - ldy #0 sty newpos ldx #0 stx keycode decodeNextRow = * lda scanTable,x beq decodeContinue ldy keycode - lsr bcc ++ pha stx xsave ldx newpos cpx #rollover bcs + tya sta newKeys,x inc newpos + ldx xsave pla + iny cmp #$00 bne - decodeContinue = * clc lda keycode adc #8 sta keycode inx cpx #scanrows bcc decodeNextRow rts keyorder = * ;** remove old keys no longer held ldy #0 nextRemove = * lda prevKeys,y cmp #$ff beq ++ ldx #rollover-1 - cmp newKeys,x beq + dex bpl - tya tax - lda prevKeys+1,x sta prevKeys+0,x inx cpx #rollover-1 bcc - lda #$ff sta prevKeys+rollover-1 sta ignoreKeys + iny cpy #rollover bcc nextRemove ;** insert new key at front + ldy #0 nextInsert = * lda newKeys,y cmp #$ff beq ++ ldx #rollover-1 - cmp prevKeys,x beq + dex bpl - pha ldx #rollover-2 - lda prevKeys+0,x sta prevKeys+1,x dex bpl - lda #0 sta ignoreKeys pla sta prevKeys+0 ldy #rollover + iny cpy #rollover bcc nextInsert + rts checkJoystick = * lda #$ff sta pa sta pk - lda pb cmp pb bne - cmp #$ff rts scanTable .buf scanrows newKeys .buf rollover ignoreKeys .buf 1 prevKeys .buf rollover+2 scrollFreeze .byte $00 delayCountdown .byte $00 repeatCountdown .byte $00 interpKey = * ;( keycode ) lda keycode ;** noscroll .if computer-64 cmp #87 ;noscroll bne interpCaps .else cmp #63 ;run/stop bne interpCaps lda shiftValue and #%1111 cmp #4 ;control bne interpCaps lda keycode .ife cmp prevKeycode beq + sta prevKeycode lda scrollFreeze eor #$ff sta scrollFreeze + rts interpCaps = * .if computer-64 .else lda keycode cmp #63 ;run/stop bne interpShifts lda shiftValue and #%1111 cmp #2 ;commodore bne interpShifts lda keycode cmp prevKeycode beq + sta prevKeycode lda capsPort eor #$40 sta capsPort + rts .ife interpShifts = * lda shiftValue and #%00011111 cmp #%00010000 bne + lda #5 jmp handleKey ;caps + and #%1111 tax lda shiftPriVec,x jmp handleKey shiftPriVec = * .if computer-64 ; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 .byte $00,$01,$02,$02,$03,$03,$03,$03,$04,$04,$04,$04,$04,$04,$04,$04 .else .byte $00,$01,$02,$02,$03,$03,$04,$04,$04,$04,$04,$04,$04,$04,$04,$04 .ife handleKey = * ;( keycode, .A=shiftTableNum ) asl tax lda keycode cmp prevKeycode beq handleRepeat jmp handleOrigKey handleRepeat = * stx xsave lda delayCountdown beq + dec delayCountdown beq ++ rts + dec repeatCountdown beq + - rts + lda #3 sta repeatCountdown lda keybufCount bne - ldx xsave jmp + handleOrigKey = * ;( .X=shiftTabOff ) lda #20 sta delayCountdown lda #0 sta scrollFreeze + lda conKeymapIndirect+0,x sta keymapPtr+0 lda conKeymapIndirect+1,x sta keymapPtr+1 ldy keycode sty prevKeycode lda (keymapPtr),y bne storeKey rts keybufHead .byte 0 keybufTail .byte 0 keybufCount .byte 0 keybufSize = 16 ;power of 2 keybufData .buf keybufSize storeKey = * ;( .A=char ) ldx keybufCount cpx #keybufSize bcc + ;xx ring bell rts + ldx keybufTail sta keybufData,x inc keybufTail lda keybufTail and #keybufSize-1 sta keybufTail inc keybufCount rts ;*** getkey( ) : .A=keyChar conGetkey = * - lda keybufCount beq - sei ldx keybufHead dec keybufCount inc keybufHead lda keybufHead and #keybufSize-1 sta keybufHead lda keybufData,x cli rts ;*** stopkey( ) : .CC=notPressed aceStopKey = * sei lda stopKeyRow cmp #$80 beq + - clc cli rts + lda shiftValue and #$0f bne - lda #0 sta keybufCount sta keybufHead sta keybufTail sta scrollFreeze lda #aceErrStopped sta errno sec cli rts conKeymapIndirect = * .word conKeymapNormal,conKeymapShift,conKeymapCommodore,conKeymapControl .word conKeymapAlternate,conKeymapCaps conKeymapNormal = * .byte $14,$0d,$1d,$88,$85,$86,$87,$11,$0033,$57,$41,$34,$5a,$53,$45,$01 .byte $35,$52,$44,$36,$43,$46,$54,$58,$0037,$59,$47,$38,$42,$48,$55,$56 .byte $39,$49,$4a,$30,$4d,$4b,$4f,$4e,$002b,$50,$4c,$2d,$2e,$3a,$40,$2c .byte $5c,$2a,$3b,$13,$01,$3d,$5e,$2f,$0031,$5f,$04,$32,$20,$02,$51,$03 .byte $84,$38,$35,$09,$32,$34,$37,$31,$001b,$2b,$2d,$0a,$0d,$36,$39,$33 .byte $08,$30,$2e,$91,$11,$9d,$1d,$00 conKeymapShift = * .byte $94,$8d,$9d,$8c,$89,$8a,$8b,$91,$0023,$d7,$c1,$24,$da,$d3,$c5,$01 .byte $25,$d2,$c4,$26,$c3,$c6,$d4,$d8,$0027,$d9,$c7,$28,$c2,$c8,$d5,$d6 .byte $29,$c9,$ca,$30,$cd,$cb,$cf,$ce,$00db,$d0,$cc,$dd,$3e,$5b,$ba,$3c .byte $a9,$c0,$5d,$93,$01,$3d,$de,$3f,$0021,$5f,$04,$22,$a0,$02,$d1,$83 .byte $84,$38,$35,$18,$32,$34,$37,$31,$001b,$2b,$2d,$0a,$8d,$36,$39,$33 .byte $08,$30,$2e,$91,$11,$9d,$1d,$00 conKeymapCommodore = * .byte $94,$8d,$9d,$8c,$89,$8a,$8b,$91,$0096,$b3,$b0,$97,$ad,$ae,$b1,$01 .byte $98,$b2,$ac,$99,$bc,$bb,$a3,$bd,$009a,$b7,$a5,$9b,$bf,$b4,$b8,$be .byte $29,$a2,$b5,$30,$a7,$a1,$b9,$aa,$00a6,$af,$b6,$dc,$3e,$5b,$a4,$3c .byte $a8,$df,$5d,$93,$01,$3d,$de,$3f,$0081,$5f,$04,$95,$a0,$02,$ab,$03 .byte $84,$38,$35,$18,$32,$34,$37,$31,$001b,$2b,$2d,$0a,$8d,$36,$39,$33 .byte $08,$30,$2e,$91,$11,$9d,$1d,$00 conKeymapControl = * .byte $00,$00,$00,$00,$00,$00,$00,$00,$001c,$17,$01,$9f,$1a,$13,$05,$00 .byte $9c,$12,$04,$1e,$03,$06,$14,$18,$001f,$19,$07,$9e,$02,$08,$15,$16 .byte $12,$09,$0a,$92,$0d,$0b,$0f,$0e,$00ff,$10,$0c,$00,$00,$1b,$00,$00 .byte $1c,$00,$1d,$00,$00,$1f,$1e,$00,$0090,$06,$00,$05,$00,$00,$11,$00 .byte $84,$38,$35,$18,$32,$34,$37,$31,$001b,$2b,$2d,$0a,$8d,$36,$39,$33 .byte $08,$30,$2e,$91,$11,$9d,$1d,$00 conKeymapAlternate = * .byte $14,$0d,$1d,$88,$85,$86,$87,$11,$0033,$57,$41,$34,$5a,$53,$45,$01 .byte $35,$e2,$44,$36,$43,$46,$54,$58,$0037,$59,$47,$38,$42,$48,$55,$56 .byte $39,$49,$4a,$30,$4d,$4b,$4f,$4e,$002b,$50,$4c,$2d,$2e,$3a,$40,$2c .byte $5c,$2a,$3b,$13,$01,$3d,$5e,$2f,$0031,$5f,$04,$32,$20,$02,$51,$03 .byte $84,$38,$35,$09,$32,$34,$37,$31,$001b,$2b,$2d,$0a,$0d,$36,$39,$33 .byte $08,$30,$2e,$91,$11,$9d,$1d,$00 conKeymapCaps = * .byte $14,$0d,$1d,$88,$85,$86,$87,$11,$0033,$d7,$c1,$34,$da,$d3,$c5,$01 .byte $35,$d2,$c4,$36,$c3,$c6,$d4,$d8,$0037,$d9,$c7,$38,$c2,$c8,$d5,$d6 .byte $39,$c9,$ca,$30,$cd,$cb,$cf,$ce,$002b,$d0,$cc,$2d,$2e,$3a,$40,$2c .byte $5c,$2a,$3b,$13,$01,$3d,$5e,$2f,$0031,$5f,$04,$32,$20,$02,$d1,$03 .byte $84,$38,$35,$09,$32,$34,$37,$31,$001b,$2b,$2d,$0a,$0d,$36,$39,$33 .byte $08,$30,$2e,$91,$11,$9d,$1d,$00 conSsCountdown .byte 1 conJifsPerMin = 3600+255 conSsMinute .word conJifsPerMin conSsMax .byte 1 conSsActive .byte $00 conScreenSave = * lda conSsCountdown bne + - rts + dec conSsMinute+0 bne - dec conSsMinute+1 bne - lda #conJifsPerMin sta conSsMinute+0 sty conSsMinute+1 dec conSsCountdown bne - jsr vdcScreenSave jsr vicScreenSave lda #$ff sta conSsActive rts conScreenUnsave = * lda conSsMax sta conSsCountdown lda #conJifsPerMin sta conSsMinute+0 sty conSsMinute+1 lda conSsActive bne + rts + jsr vdcScreenUnsave jsr vicScreenUnsave lda #$00 sta conSsActive rts ;the end + blank line acehead.s 139 ;===ace system interface declarations=== zp = $fa ;(4) zw = $fe ;(2) syswork = $80 ;(16) aceCallBase = $2800 reboot = aceCallBase+0 ;( ) open = aceCallBase+3 ;( (zp)=Name, .A=Mode ) : .A=Fcb close = aceCallBase+6 ;( .A=Fcb ) read = aceCallBase+9 ;( .X=Fcb, (zp)=Buf, .AY=Len ) : .AY=Len, .Z write = aceCallBase+12 ;( .X=Fcb, (zp)=Buf, .AY=Len ) isdir = aceCallBase+15 ;( (zp)=Name ) : .A=Dev, .X=isDisk, .Y=isDir bload = aceCallBase+18 ;( (zp)=Name, .AY=Address ) : .AY=End+1 cmdopen = aceCallBase+21 ;( (zp)=DevName ) : .A=Fcb cmdclose = aceCallBase+24 ;( .A=Fcb ) cmdsend = aceCallBase+27 ;( .X=Fcb, .AY=Cmd ) cmdstatus = aceCallBase+30 ;( .X=Fcb, .AY=StatBufPtr ) : StatBuf, .A=statusCode diropen = aceCallBase+33 ;( (zp)=DevName ) : .A=Fcb dirclose = aceCallBase+36 ;( .A=Fcb ) dirread = aceCallBase+39 ;( .X=Fcb ) : direntBuffer, .Z=eof fcbswap = aceCallBase+42 ;( .X=Fcb1, .Y=Fcb2 ) remove = aceCallBase+45 ;( (zp)=Name ) rename = aceCallBase+48 ;( (zp)=Name, (zw)=NewName ) chdir = aceCallBase+51 ;( (zp)=DirName ) zpload = aceCallBase+54 ;( [zp]=Source, .X=ZpDest, .Y=Length ) zpstore = aceCallBase+57 ;( .X=ZpSource, [zp]=Dest, .Y=Length ) fetch = aceCallBase+60 ;( [zp]=FarSource, (zw)=Ram0Dest, .AY=Length ) stash = aceCallBase+63 ;( (zw)=Ram0Source, [zp]=FarDest, .AY=length ) pagealloc = aceCallBase+66 ;( .A=PageCount ) : [zp]=FarPointer pagefree = aceCallBase+69 ;( [zp]=FarPointer, .A=PageCount ) exit = aceCallBase+72 ;( .A=exitCode, .X=exitBufDataLen ) devinfo = aceCallBase+75 ;( .X=Fcb ) : .A=DevType, .X=Cols, .Y=Rows stopkey = aceCallBase+78 ;( ) : .CC=notPressed utoa = aceCallBase+81 ;( $0+X=value32, ($80)=buf, .A=minLen ) :buf, .Y=len getdate = aceCallBase+84 ;( (.AY)=dateString ) : dateString setdate = aceCallBase+87 ;( (.AY)=dateString ) exec = aceCallBase+90 ;( (.AY)=addr ) : .A=exitCode cdhome = aceCallBase+93 ;( ) winmax = aceCallBase+96 ;( ) wincls = aceCallBase+99 ;( .A=char, .Y=color, .X=char:$80/attr:$40 flags ) winset = aceCallBase+102 ;( .Y=scrRow, .X=scrCol, .A=rows, syswork=cols ) winsize = aceCallBase+105 ;( ) : ^^^,(sw+2)=addr,(sw+4)=rowinc,(sw+6)=savesize winload = aceCallBase+108 ;( [zp]=farAddr ) winsave = aceCallBase+111 ;( [zp]=farAddr, .A=attrFlag ) winput = aceCallBase+114 ;( (sw+0)=addr,(zw)=charPtr,.A=attr,.Y=color,.X=len ; sw+4=fillChar, sw+5=fieldLen ) wincolor = aceCallBase+117 ;( .X=screen, .Y=border, .A=which ) : .X=scr, .Y=bor winpos = aceCallBase+120 ;( .A=row, .X=col ) : (sw+0)=addr wincursor = aceCallBase+123 ;( (sw+0)=addr, .Y=color, .A=$ff:on/$00:off) winscroll = aceCallBase+126 ;( .A=$80/$40:char/attr+$01:up/down, .X=rows, ; sw+4=fillChar, .Y=fillColor ) getkey = aceCallBase+129 ;( ) : .A=key concolor = aceCallBase+132 ;( .A=which, .X=char, .Y=cursor ) : .X=char,.Y=cursr conpalette = aceCallBase+135 ;( ) : sw+0...sw+7=palette [8 colors] conscreen = aceCallBase+138 ;( .A=cols ) conpos = aceCallBase+141 ;( .A=row, .X=col ) ;**NOT IMPLEMENTED aceStatusBase = $f00 errno = aceStatusBase+0 ;(1) aceID = aceStatusBase+2 ;(2) aceArgc = aceStatusBase+4 ;(2) aceArgv = aceStatusBase+6 ;(2) aceStackPtr = aceStatusBase+8 ;(2) aceFramePtr = aceStatusBase+10 ;(2) aceStackTop = aceStatusBase+12 ;(2) aceShellPath = aceStatusBase+14 ;(2) aceShellAlias = aceStatusBase+16 ;(2) aceCurrentDevice = aceStatusBase+18 ;(1) aceCurDirName = aceStatusBase+20 ;(2) aceDate = aceStatusBase+22 ;(4) YYYY:MM:DD aceDOW = aceStatusBase+26 ;(1) 1-7,1=Sun aceProcessID = aceStatusBase+27 ;(1) aceFreeMemory = aceStatusBase+28 ;(4) aceTotalMemory = aceStatusBase+32 ;(4) aceInternalBanks = aceStatusBase+36 ;(1/2wasted) aceInternalCur = aceStatusBase+39 ;(1) aceRam0Freemap = aceStatusBase+40 ;(2) aceRam1Freemap = aceStatusBase+42 ;(1) aceReuStart = aceStatusBase+43 ;(1) aceReuBanks = aceStatusBase+44 ;(1) aceReuCur = aceStatusBase+45 ;(1) aceRamlinkStart = aceStatusBase+46 ;(2) aceRamlinkBanks = aceStatusBase+48 ;(1) aceRamlinkCur = aceStatusBase+49 ;(1) aceRamlinkReuStart = aceStatusBase+50 ;(2) aceRamlinkReuBanks = aceStatusBase+52 ;(1) aceRamlinkReuCur = aceStatusBase+53 ;(1) aceVirtualParts = aceStatusBase+54 ;(1) aceRestoreStack = aceStatusBase+55 ;(1) ;aceDirentBuffer = aceStatusBase+92 aceJunk = aceStatusBase+92 aceDirentBytes = aceJunk+0 ;(4) aceDirentDate = aceJunk+4 ;(8) = YY:YY:MM:DD:HH:MM:SS:TW aceDirentType = aceJunk+12 ;(4) aceDirentFlags = aceJunk+16 ;(1) = drwx*-mt aceDirentNameLen = aceJunk+17 ;(1) aceDirentName = aceJunk+18 ;(17) aceDirentLength = 35 aceShellAddress = $1300 aceAppAddress = $6000 aceID1 = "c" aceID2 = "B" aceID3 = 9 aceMemNull = $00 aceMemREU = $01 aceMemInternal = $02 aceMemRLREU = $06 aceMemRL = $07 aceMemTypes = 8 aceErrStopped = 0 aceErrTooManyFiles = 1 aceErrFileOpen = 2 aceErrFileNotOpen = 3 aceErrFileNotFound = 4 aceErrDeviceNotPresent = 5 aceErrFileNotInput = 6 aceErrFileNotOutput = 7 aceErrMissingFilename = 8 aceErrIllegalDevice = 9 aceErrWriteProtect = 26 aceErrFileExists = 63 aceErrFileTypeMismatch = 64 aceErrNoChannel = 70 aceErrInsufficientMemory = 128 aceErrOpenDirectory = 129 aceErrNoFreeFcbs = 130 aceErrDiskOnlyOperation = 131 aceErrNullPointer = 132 aceErrInvalidFreeParms = 133 aceErrFreeNotOwned = 134 stdin = 0 stdout = 1 stderr = 2 ;===end of ace interface declarations=== acemem.s 1053 ;ACE-128/64 kernel Dynamic Memory routine by Craig Bruce. ;*** memory routines *** comCodeBuffer = $200 temp1 = $8f bkSelectRam0 = $ff01 .if computer-64 bkRam0 = $3f .else bkRam0 = $70 .ife reu = $df00 rl = $de00 rlRegs = $e0a9 rlExec = $fe1e ;***startup initMemory = * .if computer-64 ldx #0 - lda comCodeStart,x sta comCodeBuffer,x inx cpx #comCodeEnd-comCodeStart bcc - .ife rts shutdownMemory = * .if computer-64 ldx #0 lda #0 - sta comCodeBuffer,x inx cpx #comCodeEnd-comCodeStart bne - .ife rts internBankConfigs = * .if computer-64 .byte $3f,$7f,$bf,$ff,$bf,$ff,$bf,$ff,$3f .else .byte $70,$70 .ife internBankGroups = * .if computer-64 .byte $04,$04,$04,$04,$14,$14,$24,$24,$04 .ife ;***common code comCodeStart = * comZpLoad = * sty temp1 ldy zp+2 .if computer-64 lda internBankGroups,y sta $d506 .else php sei .ife lda internBankConfigs,y sta bkSelect ldy #0 - lda (zp),y sta 0,x inx iny cpy temp1 bcc - lda #bkACE sta bkSelect .if computer-64 .else plp .ife clc rts comZpStore = * sty temp1 ldy zp+2 .if computer-64 lda internBankGroups,y sta $d506 .else php sei .ife lda internBankConfigs,y sta bkSelect ldy #0 - lda 0,x sta (zp),y inx iny cpy temp1 bcc - lda #bkACE sta bkSelect .if computer-64 .else plp .ife clc rts comCopyToRam0 = * ldx zp+2 .if computer-64 lda internBankGroups,x sta $d506 lda internBankConfigs,x tax .else php sei lda internBankConfigs,x sta bkSelect .ife dey beq + .if computer-64 - stx bkSelect lda (zp),y sta bkSelectRam0 .else - lda (zp),y .ife sta (zw),y dey bne - .if computer-64 + stx bkSelect lda (zp),y sta bkSelectRam0 .else + lda (zp),y .ife sta (zw),y lda #bkACE sta bkSelect .if computer-64 .else plp .ife clc rts comCopyFromRam0 = * ldx zp+2 .if computer-64 lda internBankGroups,x sta $d506 lda internBankConfigs,x tax .else php sei lda internBankConfigs,x sta bkSelect .ife dey beq + .if computer-64 - sta bkSelectRam0 lda (zw),y stx bkSelect .else - lda (zw),y .ife sta (zp),y dey bne - .if computer-64 + sta bkSelectRam0 lda (zw),y stx bkSelect .else + lda (zw),y .ife sta (zp),y lda #bkACE sta bkSelect .if computer-64 .else plp .ife clc rts comCodeEnd = * ;*** zpload( [zp]=Source, .X=ZpDest, .Y=Length ) : .CS=err, [zp]preserved aceZpLoad = * lda zp+3 beq nullPtrError cmp #$02 bcc + bne zpLoadRL .if computer-64 jmp comZpLoad-comCodeStart+comCodeBuffer .else jmp comZpLoad .ife + sty reu+7 ldy #$91 zeroPageReuOp = * lda zp+2 sta reu+6 stx reu+2 lda #0 sta reu+3 sta reu+8 lda zp sta reu+4 lda zp+1 sta reu+5 .if computer-64 lda vic+$30 ldx #$00 stx vic+$30 .ife sty reu+1 .if computer-64 sta vic+$30 .ife clc rts nullPtrError = * lda #aceErrNullPointer sta errno sec rts zpLoadRL = * lda #$91 zeroPageRlOp = * ;( .A=opcode, .X=zpaddr, .Y=len, [zp]=farPtr ) sta ramlinkOpcode lda #0 sty ramlinkLength sta ramlinkLength+1 stx ramlinkNearPtr sta ramlinkNearPtr+1 jmp ramlinkOp ramlinkOpcode .buf 1 ramlinkLength .buf 2 ramlinkNearPtr .buf 2 ramlinkOp = * ;( [zp]=farPtr, ramlinkNearPtr, ramlinkLength, ramlinkOpcode ) jsr rlRegs lda ramlinkOpcode sta rl+1 lda ramlinkNearPtr ldy ramlinkNearPtr+1 sta rl+2 sty rl+3 ldx #0 lda zp+3 cmp #aceMemRL beq + ldx #4 + lda zp sta rl+4 clc lda aceRamlinkStart,x adc zp+1 sta rl+5 lda aceRamlinkStart+1,x adc zp+2 sta rl+6 lda ramlinkLength ldy ramlinkLength+1 sta rl+7 sty rl+8 lda #0 sta rl+10 sta rl+16 jsr rlExec clc rts ;*** zpstore( .X=ZpSource, [zp]=Dest, .Y=Length ) : .CS=err, [zp]preserved aceZpStore = * lda zp+3 beq nullPtrError cmp #$02 bcc + bne zpStoreRL .if computer-64 jmp comZpStore-comCodeStart+comCodeBuffer .else jmp comZpStore .ife + sty reu+7 ldy #$90 jmp zeroPageReuOp zpStoreRL = * lda #$90 jmp zeroPageRlOp ;*** fetch( [zp]=FarSource, (zw)=Ram0Dest, .AY=Length ) fetchLength .buf 2 fetchSaveSource .buf 1 fetchSaveDest .buf 1 aceFetch = * ldx zp+3 beq fetchNullPtrError cpx #aceMemInternal bcs + ldx #$91 jmp doReu + bne fetchRL cpy #0 bne fetchLong tay bne fetchPage clc rts fetchNullPtrError = * jmp nullPtrError fetchPage = * ;( [zp]=from, (zw)=to, .Y=len(0=256) ) ldx zp+2 cpx #0 beq + jmp comCopyToRam0-comCodeStart+comCodeBuffer .if computer-64 + stx bkSelectRam0 .else + php sei ldx #bkRam0 stx bkSelect .ife dey beq + - lda (zp),y sta (zw),y dey bne - + lda (zp),y sta (zw),y lda #bkACE sta bkSelect .if computer-64 .else plp .ife clc rts fetchLong = * sta fetchLength sty fetchLength+1 lda zp+1 sta fetchSaveSource lda zw+1 sta fetchSaveDest lda fetchLength+1 beq fetchLongExit - ldy #0 jsr fetchPage inc zp+1 inc zw+1 dec fetchLength+1 bne - fetchLongExit = * ldy fetchLength beq + jsr fetchPage + lda fetchSaveSource sta zp+1 lda fetchSaveDest sta zw+1 clc rts fetchRL = * ldx #$91 largeRlOp = * stx ramlinkOpcode sta ramlinkLength sty ramlinkLength+1 lda zw ldy zw+1 sta ramlinkNearPtr sty ramlinkNearPtr+1 jmp ramlinkOp ;*** stash( (zw)=Ram0Source, [zp]=FarDest, .AY=length ) stashLength .buf 2 stashSaveSource .buf 1 stashSaveDest .buf 1 aceStash = * ldx zp+3 beq stashNullPtrError cpx #aceMemInternal bcs + ldx #$90 jmp doReu + bne stashRL cpy #0 bne stashLong tay bne stashPage clc rts stashNullPtrError = * jmp nullPtrError stashPage = * ldx zp+2 cpx #0 beq + jmp comCopyFromRam0-comCodeStart+comCodeBuffer .if computer-64 + stx bkSelectRam0 .else + php sei ldx #bkRam0 stx bkSelect .ife dey beq + - lda (zw),y sta (zp),y dey bne - + lda (zw),y sta (zp),y lda #bkACE sta bkSelect .if computer-64 .else plp .ife clc rts stashLong = * sta stashLength sty stashLength+1 lda zw+1 sta stashSaveSource lda zp+1 sta stashSaveDest lda stashLength+1 beq stashLongExit - ldy #0 jsr stashPage inc zp+1 inc zw+1 dec stashLength+1 bne - stashLongExit = * ldy stashLength beq + ldx zp+2 jsr stashPage + lda stashSaveSource sta zw+1 lda stashSaveDest sta zp+1 clc rts stashRL = * ldx #$90 jmp largeRlOp ;*** ram0 load/store(.X) expansion memory [zp] <- -> (zw) for .AY bytes doReu = * sta reu+7 sty reu+8 lda zw ldy zw+1 sta reu+2 sty reu+3 lda zp ldy zp+1 sta reu+4 sty reu+5 lda zp+2 sta reu+6 ldy vic+$30 lda #0 sta vic+$30 stx reu+1 sty vic+$30 clc rts ;*** memory allocation routines freemapBank .buf 2 freemapDirty .buf 1 freemapPage .buf 1 searchMinFail .buf 8 initMemoryAlloc = * ldx #0 ldy #0 stx freemapPage stx freemapDirty - lda ram0FreeMap,x sta freemap,x bne + iny + inx bne - lda #0 ldy #aceMemInternal sta freemapBank+0 sty freemapBank+1 lda #$00 ldx #0 - sta searchMinFail,x inx cpx #8 bcc - clc rts freemapBankSave .buf 2 getFreemap = * ;( .AY=bank ) cmp freemapBank+0 bne + cpy freemapBank+1 bne + rts ;** save old freemap + sta freemapBankSave+0 sty freemapBankSave+1 lda freemapDirty beq + lda freemapBank+0 ldy freemapBank+1 jsr locateBankFreemap jsr setZwFreemap jsr stash ;** load new freemap + lda freemapBankSave+0 ldy freemapBankSave+1 sta freemapBank+0 sty freemapBank+1 jsr locateBankFreemap jsr setZwFreemap jsr fetch lda #0 sta freemapDirty sta freemapPage rts setZwFreemap = * ;() : .AY=#256 lda #freemap sta zw+0 sty zw+1 lda #<256 ldy #>256 rts locateBankFreemap = * ;( .AY=bank ) : [zp] sta zp+2 sty zp+3 lda #<$ff00 ldx #>$ff00 sta zp+0 stx zp+1 cpy #aceMemInternal beq + rts + lda zp+2 bne + ;** ram0 lda aceRam0Freemap+0 ldy aceRam0Freemap+1 - sta zp+0 sty zp+1 rts + cmp #1 bne + ;** ram1 lda #0 ldy aceRam1Freemap jmp - ;** exp.int.ram + lda #<$0400 ldy #>$0400 jmp - searchTypeStart .buf 1 searchTypeStop .buf 1 searchSize .buf 1 searchTypeJmp = * .word 0,pageAllocREU,pageAllocInternal,0,0,0,pageAllocRLREU,pageAllocRL acePageAlloc = * ;( .A=pages, .X=stType, .Y=endType ) : [zp]=farPtr sta searchSize cmp #0 bne + jsr pageAllocFail clc rts + cpx #aceMemREU bcs + ldx #aceMemREU + cpy #aceMemRL beq + bcc + ldy #aceMemRL + stx searchTypeStart sty searchTypeStop - lda searchTypeStart cmp searchTypeStop beq + bcs pageAllocFail + ldx searchTypeStart lda searchMinFail,x beq + cmp searchSize beq pageAllocNext bcc pageAllocNext + lda searchTypeStart asl tax lda searchTypeJmp+0,x sta zp+0 lda searchTypeJmp+1,x beq pageAllocNext sta zp+1 jsr pageAllocDispatch bcc ++ ldx searchTypeStart lda searchMinFail,x beq + cmp searchSize bcc pageAllocNext + lda searchSize sta searchMinFail,x pageAllocNext = * inc searchTypeStart jmp - + ldx zp+3 lda zp+2 cmp minUsedBank,x bcs + sta minUsedBank,x + cmp maxUsedBank,x bcc + sta maxUsedBank,x + clc rts pageAllocDispatch = * jmp (zp) pageAllocFail = * lda #aceErrInsufficientMemory sta errno lda #$00 sta zp+0 sta zp+1 sta zp+2 sta zp+3 sec rts pageAllocREU = * ;( ) : .X=page, freemapBank, .CC=ok lda #aceMemREU sta zp+3 lda aceReuCur ldx aceReuStart ldy aceReuBanks jsr searchType sta aceReuCur rts pageAllocInternal = * lda #aceMemInternal sta zp+3 lda aceInternalCur ldx #$00 ldy aceInternalBanks jsr searchType sta aceInternalCur rts pageAllocRLREU = * lda #aceMemRLREU sta zp+3 lda aceRamlinkReuCur ldx aceReuStart ldy aceRamlinkReuBanks jsr searchType sta aceRamlinkReuCur rts pageAllocRL = * lda #aceMemRL sta zp+3 lda aceRamlinkCur ldx #$00 ldy aceRamlinkBanks jsr searchType sta aceRamlinkCur rts searchCurrent .buf 1 searchStart .buf 1 searchStop .buf 1 searchType = * ;( zp+3=type, .A=current, .X=start, .Y=stop ):[zp],.CC,.A=cur,.X sta searchCurrent sta zp+2 stx searchStart sty searchStop cpx searchStop bcc + rts / lda zp+2 ldy zp+3 jsr getFreemap ldy searchSize jsr searchFreemap bcs + lda #0 sta zp+0 stx zp+1 lda zp+2 clc rts + inc zp+2 lda zp+2 cmp searchStop bcc + lda searchStart sta zp+2 + lda zp+2 cmp searchCurrent bne - sec rts searchPages .buf 1 newmax .buf 1 searchFreemap = * ;( .Y=pages ) : .CC=found, .X=firstPg ;** first free ldx freemapPage lda freemap,x beq + - inx beq freemapFull lda freemap,x bne - stx freemapPage jmp + freemapFull = * sec rts ;** search + sty searchPages cpx #0 beq + dex - ldy searchPages - inx beq freemapFull + lda freemap,x bne -- dey bne - ;** allocate stx newmax ldy searchPages lda aceProcessID - sta freemap,x dex dey bne - inx cpx freemapPage bne + ldy newmax iny sty freemapPage + lda #$ff sta freemapDirty sec lda aceFreeMemory+1 sbc searchPages sta aceFreeMemory+1 lda aceFreeMemory+2 sbc #0 sta aceFreeMemory+2 bcs + dec aceFreeMemory+3 + clc rts freePage .buf 1 freeLen .buf 1 acePageFree = * ;( [zp]=FarPtr, .A=pages ) sta freeLen cmp #0 bne + jmp pageFreeExit + lda zp+3 cmp #aceMemNull bne + lda #aceErrNullPointer jmp pageFreeFail + lda #aceErrInvalidFreeParms ldx zp+0 bne pageFreeFail lda zp+1 sta freePage clc adc freeLen bcc + lda #aceErrInvalidFreeParms jmp pageFreeFail + lda zp+2 ldy zp+3 jsr getFreemap lda aceProcessID ldx freePage ldy freeLen - cmp freemap,x beq + lda #aceErrFreeNotOwned jmp pageFreeFail + inx dey bne - ldx freePage ldy freeLen lda #$00 - sta freemap,x inx dey bne - lda #$ff sta freemapDirty lda freePage cmp freemapPage bcs + sta freemapPage ;** assume 2*(min-1)+len+1 new min + ldx zp+3 lda searchMinFail,x beq ++ sec sbc #1 asl bcs + sec adc freeLen bcc ++ + lda #0 + sta searchMinFail,x clc lda aceFreeMemory+1 adc freeLen sta aceFreeMemory+1 bcc pageFreeExit inc aceFreeMemory+2 bne pageFreeExit inc aceFreeMemory+3 pageFreeExit = * clc rts pageFreeFail = * sta errno sec rts reclaimMemType .buf 1 reclaimProcMemory = * ldx #0 - lda minUsedBank,x cmp maxUsedBank,x beq + bcs ++ + stx reclaimMemType lda minUsedBank,x ldy maxUsedBank,x tax lda reclaimMemType jsr reclaimProcType ldx reclaimMemType + inx cpx #aceMemTypes bcc - rts rpBank .buf 2 rpEnd .buf 1 reclaimProcType = * ;( .A=type, .X=startBank, .Y=endBank ) stx rpBank+0 sta rpBank+1 sty rpEnd - lda rpBank+0 ldy rpBank+1 cmp rpEnd beq + bcs ++ + jsr getFreemap jsr reclaimProcFreemap inc rpBank+0 bne - + rts reclaimProcFreemap = * ;( ) : .Y=pagesRemoved ldy #0 ldx #0 lda aceProcessID jmp + - inx beq ++ + cmp freemap,x bne - lda #0 sta freemap,x iny lda aceProcessID jmp - + cpy #0 beq + lda #0 sta freemapPage ldx freemapBank+1 sta searchMinFail,x lda #$ff sta freemapDirty tya clc adc aceFreeMemory+1 sta aceFreeMemory+1 bcc + inc aceFreeMemory+2 bne + inc aceFreeMemory+3 + clc rts minUsedBank .buf aceMemTypes maxUsedBank .buf aceMemTypes ;plus 1 clearMemoryInfo = * ldx #aceMemTypes-1 - lda #$ff sta minUsedBank,x lda #$00 sta maxUsedBank,x dex bpl - rts ;*** process primitives exitCodeSave .buf 1 aceExec = * sta syswork+0 sty syswork+1 ;xx push old memory info jsr clearMemoryInfo lda aceRestoreStack pha tsx stx aceRestoreStack inc aceProcessID jsr aceEnter lda #0 aceReEnter = * sta exitCodeSave pla sta aceRestoreStack jsr reclaimOpenFiles jsr reclaimProcMemory jsr clearMemoryInfo ;** make restore memory info dec aceProcessID lda exitCodeSave clc rts aceEnter = * jmp (syswork) aceExit = * ldx aceRestoreStack txs jmp aceReEnter reclaimSave .buf 1 reclaimOpenFiles = * jsr kernelClrchn ldx #0 - lda lftable,x cmp #lfnull beq + lda pidtable,x cmp aceProcessID bne + stx reclaimSave txa jsr close ldx reclaimSave + inx cpx #fcbCount bcc - rts acevdc.s 578 ;ACE-128/64 kernel VDC 80-column screen driver code ;vdc memory layout: $0000=char,$1000=color,$2000=charset,$3000=altcharset vdcColorAddr = $1000 vdcCharsetAddr = $2000 vdcSelect = $d600 vdcStatus = $d600 vdcData = $d601 vdcRowInc = 80 vdcWinScrX .buf 1 vdcWinScrY .buf 1 vdcWinRows .buf 1 vdcWinCols .buf 1 vdcWinStart .buf 2 vdcWinSaveSz .buf 2 vdcInit = * ;** charset jsr vdcFillMode jsr vdcLoadCharset ;** init screen colors nop ;** move attributes lda #vdcColorAddr ldx #$14 jsr vdcWrite16 ;** cursor height lda #8 ldx #$0b jsr vdcWrite ;** window parameters jsr vdcWinmax rts vdcShutdown = * ;** restore charset lda #<$d000 ldy #>$d000 sta syswork+0 sty syswork+1 lda #<$2000 ldy #>$2000 sta syswork+2 sty syswork+3 sei lda #bkCharset sta bkSelect ldx #8 ldy #0 - lda (syswork+0),y sta (syswork+2),y iny bne - inc syswork+1 inc syswork+3 dex bne - lda #bkACE sta bkSelect cli jsr vdcLoadCharset ;** restore attributes lda #<$800 ldy #>$800 ldx #$14 jsr vdcWrite16 ;** restore cursor height lda #7 ldx #$0b jsr vdcWrite rts chsSource = syswork+0 chsCount = syswork+2 vdcLoadCharset = * lda #vdcCharsetAddr jsr vdcAddrWrite16 lda #<$2000 ldy #>$2000 sta chsSource+0 sty chsSource+1 ldx #0 stx chsCount charLoop = * lda #$1f sta vdcSelect ldy #0 - lda (chsSource),y - bit vdcStatus bpl - sta vdcData iny cpy #8 bcc -- lda #$00 jsr vdcRamWrite ldx #$1e lda #7 jsr vdcWrite clc lda chsSource+0 adc #8 sta chsSource+0 bcc + inc chsSource+1 + inc chsCount bne charLoop rts vdcFillMode = * ;( ) ldx #$18 jsr vdcRead and #$7f jsr vdcWrite rts vdcCopyMode = * ;( ) ldx #$18 jsr vdcRead ora #$80 jsr vdcWrite rts vdcRamWrite = * ;( .A=value ) ldx #$1f vdcWrite = * ;( .X=register, .A=value ) stx vdcSelect - bit vdcStatus bpl - sta vdcData rts vdcAddrWrite16 = * ;( .AY=value ) ldx #$12 vdcWrite16 = * ;( .X=hiRegister, .AY=value ) stx vdcSelect - bit vdcStatus bpl - sty vdcData inx stx vdcSelect - bit vdcStatus bpl - sta vdcData rts vdcRamRead = * ;( ) : .A=value ldx #$1f vdcRead = * ;( .X=register ) : .A=value stx vdcSelect - bit vdcStatus bpl - lda vdcData rts vdcWinmax = * lda #0 sta vdcWinScrX sta vdcWinScrY sta vdcWinStart+0 sta vdcWinStart+1 lda #25 ldx #80 sta vdcWinRows stx vdcWinCols lda #<2000+2000+16 ldy #>2000+2000+16 sta vdcWinSaveSz+0 sty vdcWinSaveSz+1 clc rts vdcClsColor .buf 1 vdcWincls = * sta vdcFillByte sty vdcClsColor stx syswork+2 bit syswork+2 bpl + jsr vdcWinclsSetup jsr vdcRowFill + bit syswork+2 bvc + jsr vdcWinclsSetup lda vdcClsColor sta vdcFillByte jsr vdcAddColor jsr vdcRowFill + rts vdcWinclsSetup = * lda vdcWinStart+0 ldy vdcWinStart+1 sta syswork+0 sty syswork+1 lda vdcWinRows sta vdcFillRows rts vdcAddColor = * clc lda syswork+1 adc #>vdcColorAddr sta syswork+1 rts vdcFillByte .buf 1 vdcFillRows .buf 1 vdcFillCols .buf 1 vdcRowFill = * ;( (sw+0)=addr++, vdcFillByte, vdcFillRows-- ) lda vdcWinCols sta vdcFillCols lda vdcFillRows bne + rts / jsr vdcColFill clc lda syswork+0 adc #vdcRowInc sta syswork+0 bcc + inc syswork+1 + dec vdcFillRows bne - rts vdcColFill = * ;( (sw+0)=addr, vdcFillByte, vdcFillCols ) lda syswork+0 ldy syswork+1 jsr vdcAddrWrite16 vdcColFillGotAddr = * lda vdcFillCols beq + lda vdcFillByte jsr vdcRamWrite ldx vdcFillCols dex beq + txa ldx #$1e jsr vdcWrite + rts vdcWinset = * rts vdcWinsize = * lda vdcWinCols sta syswork lda vdcWinStart+0 ldy vdcWinStart+1 sta syswork+2 sty syswork+3 lda #vdcRowInc sta syswork+4 sty syswork+5 lda vdcWinSaveSz+0 ldy vdcWinSaveSz+1 sta syswork+6 sty syswork+7 ldx vdcWinScrX ldy vdcWinScrY lda vdcWinRows clc rts vdcWinload = * rts vdcWinsave = * rts vdcPutWhich .buf 1 vdcPutColor .buf 1 vdcPutLen .buf 1 vdcWinput = * sta vdcPutWhich sty vdcFillByte stx vdcPutLen bit vdcPutWhich bpl vdcWinputColor lda syswork+0 ldy syswork+1 jsr vdcAddrWrite16 ldy #0 cpy vdcPutLen beq + lda #$1f sta vdcSelect - lda (zw),y - bit vdcStatus bpl - sta vdcData iny cpy vdcPutLen bcc -- + sec lda syswork+5 sbc vdcPutLen beq vdcWinputColor tay lda syswork+4 jsr vdcRamWrite dey beq vdcWinputColor tya ldx #$1e jsr vdcWrite vdcWinputColor = * bit vdcPutWhich bvs + rts + lda syswork+1 clc adc #>vdcColorAddr tay lda syswork+0 jsr vdcAddrWrite16 lda syswork+5 sta vdcFillCols jsr vdcColFillGotAddr rts vdcWincolor = * php sei cmp #128 bcc + txa ldx #$1a jsr vdcWrite + and #64 beq + tya nop + ldx #$1a jsr vdcRead and #$0f tax tay plp rts vdcWinposCol .buf 1 vdcWinpos = * sta syswork+0 ;(0 to 50) stx vdcWinposCol ldx #0 stx syswork+1 asl asl adc syswork+0 asl rol syswork+1 asl rol syswork+1 asl rol syswork+1 asl rol syswork+1 clc adc vdcWinposCol bcc + inc syswork+1 + clc adc vdcWinStart+0 sta syswork+0 lda syswork+1 adc vdcWinStart+1 sta syswork+1 rts vdcCursorSave .buf 1 vdcCursorColor .buf 1 vdcWincursor = * cmp #0 beq vdcCursorOff sty vdcCursorColor lda syswork+0 ldy syswork+1 ldx #$0e jsr vdcWrite16 ldx #$0a jsr vdcRead and #$1f ora #$60 jsr vdcWrite jsr vdcSetColorAddr jsr vdcRamRead sta vdcCursorSave jsr vdcSetColorAddr lda vdcCursorSave and #$f0 ora vdcCursorColor jsr vdcRamWrite rts vdcCursorOff = * ldx #$0e jsr vdcWrite16 ldx #$0a jsr vdcRead and #$1f ora #$20 jsr vdcWrite jsr vdcSetColorAddr lda vdcCursorSave jsr vdcRamWrite rts vdcSetColorAddr = * ;( (sw+0)=addr ) clc lda syswork+1 adc #>vdcColorAddr tay lda syswork+0 jmp vdcAddrWrite16 vdcScrollDest = syswork+0 vdcScrollSource = syswork+2 vdcScrollRows .buf 1 vdcScrollExtra .buf 1 vdcWinscroll = * sta syswork+5 sty vdcClsColor stx vdcScrollExtra cpx #0 bne + rts + cpx vdcWinRows bcc + lda syswork+4 ldx syswork+5 ldy vdcClsColor jsr vdcWincls rts + bit syswork+5 bpl + jsr vdcScrollUpSetup jsr vdcRowScrollUp lda #" " jsr vdcDoScrollExtra + bit syswork+5 bvc + jsr vdcScrollUpSetup jsr vdcScrollAddColor jsr vdcRowScrollUp lda vdcClsColor jsr vdcDoScrollExtra + rts vdcScrollUpSetup = * lda vdcScrollExtra ldx #0 jsr vdcWinpos lda syswork+0 ldy syswork+1 sta vdcScrollSource+0 sty vdcScrollSource+1 lda vdcWinStart+0 ldy vdcWinStart+1 sta vdcScrollDest+0 sty vdcScrollDest+1 sec lda vdcWinRows sbc vdcScrollExtra sta vdcScrollRows rts vdcScrollAddColor = * clc lda syswork+1 adc #>vdcColorAddr sta syswork+1 lda syswork+3 adc #>vdcColorAddr sta syswork+3 rts vdcDoScrollExtra = * ;( .A=fillByte, (sw+0)=addr ) sta vdcFillByte lda vdcScrollExtra sta vdcFillRows lda vdcWinCols sta vdcFillCols jsr vdcRowFill rts vdcRowScrollUp = * ;( vdcScrollSource++, vdcScrollDest++, vdcScrollRows-- ) lda vdcScrollRows bne + rts + jsr vdcCopyMode - jsr vdcColScroll clc lda vdcScrollSource+0 adc #vdcRowInc sta vdcScrollSource+0 bcc + inc vdcScrollSource+1 + clc lda vdcScrollDest+0 adc #vdcRowInc sta vdcScrollDest+0 bcc + inc vdcScrollDest+1 + dec vdcScrollRows bne - jsr vdcFillMode rts vdcColScroll = * ;( vdcScrollSource, vdcScrollDest, vdcWinCols ) lda vdcScrollDest+0 ldy vdcScrollDest+1 jsr vdcAddrWrite16 lda vdcScrollSource+0 ldy vdcScrollSource+1 ldx #$20 jsr vdcWrite16 lda vdcWinCols ldx #$1e jsr vdcWrite rts ;*** interrupt screen-saver code: **potential vdc-access conflicts** vdcSsColor .buf 1 vdcSsRows .buf 1 vdcSsActive .byte $00 vdcScreenSave = * rts ldx #$06 jsr vdcRead sta vdcSsRows ldx #$1a jsr vdcRead sta vdcSsColor lda #$ff sta vdcSsActive ldx #$06 lda #0 jsr vdcWrite ldx #$1a lda #$e0 jsr vdcWrite rts vdcScreenUnsave = * rts ldx #$06 lda vdcSsRows jsr vdcWrite ldx #$1a lda vdcSsColor jsr vdcWrite lda #$00 sta vdcSsActive rts ;the end + blank line acevic.s 487 ;ACE-128/64 kernel VIC 40-column screen driver code vicCharAddr = $0400 vicColorOff = $d400 vicRowInc = 40 vic = $d000 vicWinScrX .buf 1 vicWinScrY .buf 1 vicWinRows .buf 1 vicWinCols .buf 1 vicWinStart .buf 2 vicWinSaveSz .buf 2 vicInit = * lda #$18 sta vic+$18 ;** window parameters jsr vicWinmax rts vicShutdown = * rts vicWinmax = * lda #0 sta vicWinScrX sta vicWinScrY lda #vicCharAddr sta vicWinStart+0 sty vicWinStart+1 lda #25 ldx #40 sta vicWinRows stx vicWinCols lda #<1000+1000+16 ldy #>1000+1000+16 sta vicWinSaveSz+0 sty vicWinSaveSz+1 clc rts rgbi2vicTab .byte 0,12,6,14,5,13,11,3,2,10,8,4,9,7,15,1 rgbi2vic = * and #$0f tax lda rgbi2vicTab,x rts vic2rgbiTab .byte 0,15,8,7,11,4,2,13,10,12,9,6,1,5,3,14 vic2rgbi = * and #$0f tax lda vic2rgbiTab,x rts vicClsColor .buf 1 vicWincls = * sta vicFillByte sty vicClsColor stx syswork+2 bit syswork+2 bpl + jsr vicWinclsSetup jsr vicRowFill + bit syswork+2 bvc + jsr vicWinclsSetup lda vicClsColor jsr rgbi2vic sta vicFillByte jsr vicAddColor jsr vicRowFill + rts vicWinclsSetup = * lda vicWinStart+0 ldy vicWinStart+1 sta syswork+0 sty syswork+1 lda vicWinRows sta vicFillRows rts vicAddColor = * clc lda syswork+1 adc #>vicColorOff sta syswork+1 rts vicFillByte .buf 1 vicFillRows .buf 1 vicFillCols .buf 1 vicRowFill = * ;( (sw+0)=addr++, vicFillByte, vicFillRows-- ) lda vicWinCols sta vicFillCols lda vicFillRows bne + rts / jsr vicColFill clc lda syswork+0 adc #vicRowInc sta syswork+0 bcc + inc syswork+1 + dec vicFillRows bne - rts vicColFill = * ;( (sw+0)=addr, vicFillByte, vicFillCols ) ldy vicFillCols beq + dey lda vicFillByte - sta (syswork),y dey bpl - + rts vicWinset = * rts vicWinsize = * lda vicWinCols sta syswork lda vicWinStart+0 ldy vicWinStart+1 sta syswork+2 sty syswork+3 lda #vicRowInc sta syswork+4 sty syswork+5 lda vicWinSaveSz+0 ldy vicWinSaveSz+1 sta syswork+6 sty syswork+7 ldx vicWinScrX ldy vicWinScrY lda vicWinRows clc rts vicWinload = * rts vicWinsave = * rts vicPutWhich .buf 1 vicPutLen .buf 1 vicWinput = * sta vicPutWhich sty vicFillByte stx vicPutLen bit vicPutWhich bpl vicWinputColor ldy #0 cpy vicPutLen beq + - lda (zw),y sta (syswork+0),y iny cpy vicPutLen bcc - + cpy syswork+5 beq vicWinputColor lda syswork+4 - sta (syswork+0),y iny cpy syswork+5 bcc - vicWinputColor = * bit vicPutWhich bvs + rts + clc lda syswork+1 adc #>vicColorOff sta syswork+1 lda vicFillByte jsr rgbi2vic ldy syswork+5 dey bmi + - sta (syswork),y dey bpl - + sec lda syswork+1 sbc #>vicColorOff sta syswork+1 rts vicWincolor = * php sei cmp #128 bcc + pha txa jsr rgbi2vic sta vic+$21 pla + and #64 beq vicWincolorExit tya jsr rgbi2vic bit vicSsActive bmi + sta vic+$20 jmp vicWincolorExit + sta vicSsColor vicWincolorExit = * bit vicSsActive bmi + lda vic+$20 jmp ++ + lda vicSsColor + jsr vic2rgbi tay lda vic+$21 jsr vic2rgbi tax plp rts vicWinposCol .buf 1 vicWinpos = * sta syswork+0 ;(0 to 24) stx vicWinposCol ldx #0 stx syswork+1 asl asl adc syswork+0 asl rol syswork+1 asl rol syswork+1 asl rol syswork+1 clc adc vicWinposCol bcc + inc syswork+1 + clc adc vicWinStart+0 sta syswork+0 lda syswork+1 adc vicWinStart+1 sta syswork+1 rts vicCursorChar .buf 1 vicCursorColor .buf 1 vicCursorFlash .byte $00 ;$00=inactive, $ff=active vicCursorCountdown .buf 1 vicCursorAddr .buf 2 vicWincursor = * cmp #0 beq vicCursorOff tya jsr rgbi2vic sta vicCursorColor lda syswork+0 ldy syswork+1 sta vicCursorAddr+0 sty vicCursorAddr+1 ldy #0 lda (syswork+0),y sta vicCursorChar jsr vicSetColorAddr ldy #0 lda (syswork+0),y tax lda vicCursorColor sta (syswork+0),y stx vicCursorColor jsr vicUnsetColorAddr lda #1 sta vicCursorCountdown jsr vicIrqCursor lda #$ff sta vicCursorFlash rts vicCursorOff = * lda #$00 sta vicCursorFlash ldy #0 lda vicCursorChar sta (syswork+0),y jsr vicSetColorAddr lda vicCursorColor sta (syswork+0),y jsr vicUnsetColorAddr rts vicIrqWork = $a0 vicIrqCursor = * bit vicCursorFlash bmi + - rts + dec vicCursorCountdown bne - lda #20 sta vicCursorCountdown lda vicCursorAddr+0 ldy vicCursorAddr+1 sta vicIrqWork+0 sty vicIrqWork+1 ldy #0 lda (vicIrqWork),y pha sec sbc #32 and #%01000000 bne + pla sec sbc #64 jmp ++ + pla clc adc #64 + sta (vicIrqWork),y rts vicSetColorAddr = * ;( (sw+0)=addr ) : (sw+0)=colorAddr clc lda syswork+1 adc #>vicColorOff sta syswork+1 rts vicUnsetColorAddr = * ;( (sw+0)=colorAddr ) : (sw+0)=addr sec lda syswork+1 sbc #>vicColorOff sta syswork+1 rts vicScrollDest = syswork+0 vicScrollSource = syswork+2 vicScrollRows .buf 1 vicScrollExtra .buf 1 vicWinscroll = * sta syswork+5 sty vicClsColor stx vicScrollExtra cpx #0 bne + rts + cpx vicWinRows bcc + lda syswork+4 ldx syswork+5 ldy vicClsColor jsr vicWincls rts + bit syswork+5 bpl + jsr vicScrollUpSetup jsr vicRowScrollUp lda #" " jsr vicDoScrollExtra + bit syswork+5 bvc + jsr vicScrollUpSetup jsr vicScrollAddColor jsr vicRowScrollUp lda vicClsColor jsr vicDoScrollExtra + rts vicScrollUpSetup = * lda vicScrollExtra ldx #0 jsr vicWinpos lda syswork+0 ldy syswork+1 sta vicScrollSource+0 sty vicScrollSource+1 lda vicWinStart+0 ldy vicWinStart+1 sta vicScrollDest+0 sty vicScrollDest+1 sec lda vicWinRows sbc vicScrollExtra sta vicScrollRows rts vicScrollAddColor = * clc lda syswork+1 adc #>vicColorOff sta syswork+1 lda syswork+3 adc #>vicColorOff sta syswork+3 rts vicDoScrollExtra = * ;( .A=fillByte, (sw+0)=addr ) sta vicFillByte lda vicScrollExtra sta vicFillRows lda vicWinCols sta vicFillCols jsr vicRowFill rts vicRowScrollUp = * ;( vicScrollSource++, vicScrollDest++, vicScrollRows-- ) lda vicScrollRows bne + rts + nop - jsr vicColScroll clc lda vicScrollSource+0 adc #vicRowInc sta vicScrollSource+0 bcc + inc vicScrollSource+1 + clc lda vicScrollDest+0 adc #vicRowInc sta vicScrollDest+0 bcc + inc vicScrollDest+1 + dec vicScrollRows bne - rts vicColScroll = * ;( vicScrollSource, vicScrollDest, vicWinCols ) ldy vicWinCols dey - lda (vicScrollSource),y sta (vicScrollDest),y dey bpl - rts ;*** interrupt screen-save stuff vicSsColor .buf 1 vicSsRows .buf 1 vicSsActive .byte $00 vicScreenSave = * lda vic+$11 sta vicSsRows lda vic+$20 sta vicSsColor lda #$ff sta vicSsActive lda #$00 sta vic+$11 lda #$00 sta vic+$20 rts vicScreenUnsave = * lda vicSsRows sta vic+$11 lda vicSsColor sta vic+$20 lda #$00 sta vicSsActive rts ;the end + blank line acevic80.s 37 ;ACE-64 kernel VIC bitmapped 80-column screen driver code vdcInit = * rts vdcShutdown = * rts vdcWinmax = * rts vdcWincls = * rts vdcWinset = * rts vdcWinsize = * rts vdcWinload = * rts vdcWinsave = * rts vdcWinput = * rts vdcWincolor = * rts vdcWinpos = * rts vdcWincursor = * rts vdcWinscroll = * rts vdcScreenSave = * rts vdcScreenUnsave = * rts ;the end + blank line as.s 630 ;*** as program .seq acehead.s .org aceAppAddress .obj "@0:as" jmp asmain .asc "cB" ;*** global declarations libwork = $60 chrCR = $0d chrQuote = $22 chrTab = $09 chrEOF = $00 ;******** standard library ******** puts = * ldx #stdout fputs = * sta zp sty zp+1 ldy #$ff - iny lda (zp),y bne - tya ldy #0 jmp write putchar = * ldx #stdout putc = * sta putcBuffer lda #putcBuffer sta zp sty zp+1 lda #1 ldy #0 jmp write putcBuffer .buf 1 getchar = * ldx #stdin getc = * lda #getcBuffer sta zp sty zp+1 lda #1 ldy #0 jsr read beq + lda getcBuffer rts + sec rts getcBuffer .buf 1 getarg = * sty zp+1 asl sta zp rol zp+1 clc lda aceArgv adc zp sta zp lda aceArgv+1 adc zp+1 sta zp+1 ldy #0 lda (zp),y tax iny lda (zp),y stx zp sta zp+1 rts sourceFcb = 2 ;(1) bufptr = 3 ;(1) sourceLine = 4 ;(4) number = 8 ;(4) stringLen = 12 ;(1) prevChar = 13 ;(1) tokenIdentifier = 0 tokenNumber = 1 tokenString = 2 tokenSpecial = 3 chrErrIdentTooLong = $f0 chrErrStringTooLong = $f1 chrErrNoCloseQuote = $f2 chrErrBadNumber = $f3 chrErrNumOverflow = $f4 asmain = * lda aceArgc+1 beq + ;** usage error! - rts + lda aceArgc cmp #2 bne - lda #1 ldy #0 jsr getarg lda #"r" jsr open bcc + ;** source open error! rts + sta sourceFcb lda #1 sta sourceLine lda #0 sta sourceLine+1 sta sourceLine+2 sta sourceLine+3 lda #255 sta bufptr jsr asDriver lda sourceFcb jsr close rts ;=fill entire buffer, pad with spaces; .CS=eof fillbuf = * lda #sourceBuf sta zp sty zp+1 lda #0 ldy #1 sta bufptr ldx sourceFcb jsr read bne + sec rts + cpy #1 bcc + clc rts + tay lda #" " - sta sourceBuf,y iny bne - clc rts getNextChar = * inc bufptr beq + - ldy bufptr lda sourceBuf,y rts + jsr fillbuf bcc - lda #chrEOF rts eatWhitespace = * ;() : .A=NextChar lda prevChar cmp #" " beq + cmp #chrTab beq + rts + ldy bufptr - iny beq + eatWhCont = * lda sourceBuf,y cmp #" " beq - cmp #chrTab beq - sty bufptr rts + jsr fillbuf bcs + ldy #0 jmp eatWhCont + lda #chrEOF rts ;===token dispatch=== ;ret: .X=tokenIdentifier, .A=nextChar, .Y=strlen, stringLen, stringBuf ; .X=tokenNumber, .Y=numlen, number ; .X=tokenString, .A=firstChar,.Y=strlen, stringLen, stringBuf ; .X=tokenSpecial, .A=char getToken = * lda prevChar cmp #" " bne + - jsr eatWhitespace + cmp #chrTab beq - cmp #"@" bcc + jmp getIdentifier + cmp #"'" bcc cmpMore1 bne + jmp getString + cmp #"0" bcc tokSpecial cmp #":" bcs + tokNum = * jmp getNumber + cmp #";" bne + jmp eatComment tokSpecial = * jmp getSpecialToken cmpMore1 = * cmp #"$" bcc + beq tokNum cmp #"%" beq tokNum jmp getSpecialToken + cmp #chrQuote bne tokSpecial jmp getString ;===comment=== eatComment = * ldy bufptr - iny beq + commentChar = * lda sourceBuf,y cmp #chrCR bne - sty bufptr jmp getSpecialToken + jsr fillbuf bcs + ldy #0 beq commentChar + lda #chrEOF jmp getSpecialToken ;===special=== getSpecialToken = * pha cmp #chrCR bne + inc sourceLine bne + inc sourceLine+1 bne + inc sourceLine+2 bne + inc sourceLine+3 + cmp #chrEOF beq + jsr getNextChar + sta prevChar pla ldx #tokenSpecial rts ;===identifier=== getIdentifier = * sta stringBuf ldy #1 sty stringLen - jsr getNextChar cmp #"@" bcc identExit identGoodChar = * ldy stringLen sta stringBuf,y inc stringLen bne - sta prevChar ldx #tokenSpecial lda #chrErrIdentTooLong rts identExit = * cmp #"." beq identGoodChar cmp #"_" beq identGoodChar cmp #"0" bcc + cmp #":" bcc identGoodChar + cmp #" " bne + - sta prevChar jsr eatWhitespace + cmp #chrTab beq - sta prevChar lda #0 ldy stringLen sta stringBuf,y lda prevChar ldy stringLen ldx #tokenIdentifier rts ;===string=== strDelimit = 20 getString = * sta strDelimit lda #0 sta stringLen - jsr getNextChar sta prevChar cmp #chrEOF beq strEof cmp strDelimit beq strExit cmp #chrCR beq strEof cmp #"\" beq strEsc getStrPut = * ldy stringLen sta stringBuf,y inc stringLen bne - sta prevChar lda #chrErrStringTooLong ldx #tokenSpecial rts strEsc = * jsr getNextChar cmp #chrCR beq strEof cmp #chrEOF beq strEof ldx #strEscCharEnd-strEscChar-1 - cmp strEscChar,x beq + dex bpl - jmp getStrPut + lda strEscTrans,x jmp getStrPut strEscChar = * .asc "\nbtraz'e0" .byte chrQuote strEscCharEnd = * strEscTrans = * .byte 92,13,157,9,13,7,0,39,27,0,34 strEof = * lda #chrErrNoCloseQuote ldx #tokenSpecial rts strExit = * jsr getNextChar sta prevChar lda #0 ;but may contain \0 ldy stringLen sta stringBuf,y lda stringBuf ldx #tokenString rts numBase = 20 ;(1) numSave = 21 ;(4) getNumber = * pha ldx #3 lda #0 - sta number,x dex bpl - pla ldx #16 cmp #"$" beq + ldx #2 cmp #"%" beq + ldx #10 stx numBase bne gotNextDigit + stx numBase jsr getNextChar sta prevChar jsr checkDigit bcc + lda #chrErrBadNumber ldx #tokenSpecial rts + txa jmp gotNextDigit nextDigit = * jsr getNextChar sta prevChar cmp #"_" beq nextDigit gotNextDigit = * jsr checkDigit bcs getNumExit pha jsr shiftNumber bcs overflowExitPla pla clc adc number sta number bcc + inc number+1 bne + inc number+2 bne + inc number+3 beq overflowExit + jmp nextDigit overflowExitPla = * pla overflowExit = * ldx #tokenSpecial lda #chrErrNumOverflow rts getNumExit = * ldx #tokenNumber ldy #3 - lda number,y beq + dey bpl - + iny rts checkDigit = * ;( .A=asciiDigit ) : .A=binDigit, .X=asciiDigit, .CC=ok tax cmp #"0" bcc checkBad cmp #"9"+1 bcc checkAnd cmp #"a" bcc checkBad cmp #"f"+1 bcc + cmp #"A" bcc checkBad cmp #"F"+1 bcs checkBad + sec sbc #7 checkAnd = * and #$0f cmp numBase rts checkBad = * sec rts shiftNumber = * lda numBase cmp #10 bne + ldx #3 - lda number,x sta numSave,x dex bpl - ldx #2 jsr rollNumber jsr addNumber ldx #1 jsr rollNumber rts + ldx #1 cmp #16 bne + ldx #4 + jsr rollNumber rts rollNumber = * ;( .X=times ) asl number rol number+1 rol number+2 rol number+3 bcs + dex bne rollNumber rts + pla pla sec rts addNumber = * ldx #0 clc - lda number,x adc numSave,x sta number,x inx txa and #$03 bne - bcs + rts + pla pla sec rts asDriver = * lda #$ff sta bufptr lda #" " sta prevChar nextToken = * jsr stopkey bcc + lda #1 jmp exit + jsr getToken cpx #tokenIdentifier beq dispIdentifier cpx #tokenString beq dispString cpx #tokenSpecial beq dispSpecial cpx #tokenNumber beq dispNumber jmp nextToken dispIdentifier = * pha lda #"i" jsr putchar lda #":" jsr putchar jsr showStr lda #"," jsr putchar pla showChar = * cmp #chrCR bne + lda #"_" + jsr putchar showCR = * lda #chrCR jsr putchar jmp nextToken dispString = * lda #"s" jsr putchar lda #":" jsr putchar jsr showStr jmp showCR showStr = * lda #stringBuf sta zp sty zp+1 lda stringLen ldy #0 ldx #stdout jsr write rts dispSpecial = * cmp #chrEOF bne + rts + pha lda #"c" jsr putchar lda #":" jsr putchar pla jmp showChar dispNumber = * lda #"n" jsr putchar lda #":" jsr putchar lda #stringBuf sta $80 sty $81 ldx #number lda #1 jsr utoa sty stringLen jsr showStr jmp showCR sourceBuf = * stringBuf = sourceBuf+256 asEnd = stringBuf+256 bcode.s 1150 ;*** BCODE: bcode encoder version 1.00 - by Craig Bruce - 17-Nov-93 ;bcode [-help] [-v] [-u] [-m] [-l max_line_count] filename ... .seq acehead.s .org aceAppAddress .obj "@0:bcode" jmp main .byte aceID1,aceID2,aceID3 ;*** global declarations chrCR = $0d chrLF = $0a chrQuote = $22 true = $ff false = $00 maxChunk = 54 maxLine = 80 trPetscii = 0 trAsciiCrLf = 1 trAsciiLf = 2 arg = 2 ;(2) ;current argument number name = 4 ;(2) ;name of file being bcoded string = 8 ;(2) ;temp string maxlines = 10 ;(4) ;max number of lines per segment linelimit = 14 ;(1) ;whether there is a restriction on lines/seg alias = 16 ;(2) ;current alias name to use transTo = 18 ;(1) ;output file translation: petscii, asc-crlf, asc-lf progname = 19 ;(2) ;pointer to argv[0] verbose = 21 ;(1) ;flag for giving verbose information filenameUsed = 22;(1) ;flag: if a filename has been encountered on the cmd line bufPtr = 23 ;(2) ;pointer to next char in input buffer bufCount = 25 ;(2) ;number of bytes left in input buffer inBufSize = 27 ;(2) ;maximum size of input buffer infile = 29 ;(1) ;fd of input binary file outfile = 30 ;(1) ;fd to output bcoded data to chunkLen = 31 ;(1) ;length of chunk for encoding chunkPos = 32 ;(1) ;scanning position in chunk during encoding bctemp = 33 ;(1) ;temporary for conversion from 8 to 6 bits trPutPtr = 34 ;(2) ;pointer to translated-puts string trPutIndex = 36 ;(1) ;index into translated-puts string crc = 37 ;(4) ;cumulative crc-32 of segment bytes = 41 ;(4) ;cumulative bytes in segment segnum = 45 ;(4) ;current segment number stopCountdn = 49 ;(1) ;countdown to check stop key scanVal = 50 ;(4) ;result of converting string to 32-bit number linenum = 54 ;(4) ;current line number being encoded isLastSeg = 58 ;(1) ;whether we have just encoded the last segment work = 112;(16) ;misc work area ;===main=== main = * ;** check for large enough TPA sec lda #bssEnd sbc aceStackPtr+1 bcs + jmp mainInit + lda #tpaMsg jsr eputs die = * lda #1 ldx #0 jmp exit tpaMsg = * .asc "Insufficient program space to run bcode" .byte chrCR,0 usage = * lda #usageMsg jsr eputs jmp die usageMsg = * .asc "usage: bcode [-help] [-v] [-u] [-m] [-l max_line_count] filename ..." .byte chrCR .asc "flags: -v:verbose, -u:unix-ascii, -m:ms-dos-ascii" .byte chrCR,0 defaultAlias = * .asc "stdin" .byte 0 mainInit = * ;** set globals lda #true sta verbose lda #0 ldy #0 jsr getarg lda zp+0 ldy zp+1 sta progname+0 sty progname+1 lda #false sta filenameUsed lda #0 sta arg+0 sta arg+1 lda #defaultAlias sta alias+0 sty alias+1 lda #false sta linelimit lda #trPetscii sta transTo ;** get input buffer length sec lda aceStackPtr+0 sbc #inBuf sta inBufSize+1 mainNext = * jsr checkStop inc arg+0 bne + inc arg+1 + lda arg+0 ldy arg+1 jsr getarg lda zp+0 ora zp+1 beq mainExit lda zp+0 ldy zp+1 sta name+0 sty name+1 ldy #0 lda (zp),y cmp #"-" bne + jmp handleFlags + jsr echo jsr bcode jmp mainNext mainExit = * bit filenameUsed bmi + ;xx should read from stdin if no files nop + rts handleFlags = * iny lda (zp),y bne + jmp mainNext + cmp #"v" beq flagV cmp #"m" beq flagM cmp #"a" beq flagM cmp #"u" beq flagU cmp #"l" beq flagL cmp #"h" bne + jmp usage + nop ;xx unrecognized option jmp handleFlags flagV = * lda #true sta verbose jmp handleFlags flagM = * lda #trAsciiCrLf sta transTo jmp handleFlags flagU = * lda #trAsciiLf sta transTo jmp handleFlags flagL = * inc arg+0 bne + inc arg+1 + lda arg+0 ldy arg+1 jsr getarg lda zp+0 ora zp+1 beq flagLerror ldy #0 jsr scanNum bcs flagLerror ldx #3 - lda scanVal,x sta maxlines,x dex bpl - lda maxlines+0 ora maxlines+1 ora maxlines+2 ora maxlines+3 beq flagLerror lda #true sta linelimit jmp mainNext flagLerror = * lda #flagLerrorMsg jsr eputs jmp die flagLerrorMsg = * .asc "ERROR: invalid maximum line limit given with -l option" .byte chrCR,0 echo = * lda #echoMsg1 jsr eputs lda name+0 ldy name+1 jsr eputs lda #echoMsg2 jsr eputs rts echoMsg1 = * .asc "bcoding file " .byte chrQuote,0 echoMsg2 = * .byte chrQuote .asc "..." .byte chrCR,0 checkStop = * jsr stopkey bcs + rts + lda #stoppedMsg jsr eputs jmp die stoppedMsg = * .asc "" .byte chrCR,0 bcode = * lda #true sta filenameUsed lda name+0 ldy name+1 sta zp+0 sty zp+1 lda #"r" jsr open bcs openError sta infile lda #0 sta bufCount+0 sta bufCount+1 jsr setBase64Table lda #1 ldy #0 sta segnum+0 sty segnum+1 sty segnum+2 sty segnum+3 bcodeNextSegment = * lda #stdout sta outfile bit linelimit bpl + jsr getOutfile + jsr bcodeSegment lda outfile cmp #stdout beq + jsr close + bit isLastSeg bpl + lda infile jsr close rts + inc segnum+0 bne + inc segnum+1 bne + inc segnum+2 bne + inc segnum+3 + jmp bcodeNextSegment openError = * lda #openErrorMsg1 jsr eputs lda name+0 ldy name+1 jsr eputs lda #openErrorMsg2 jsr eputs rts openErrorMsg1 = * .asc "ERROR: cannot open " .byte chrQuote,0 openErrorMsg2 = * .byte chrQuote,chrCR,0 outfileFileLen = work+0 outfileExtLen = work+1 outfileTemp = work+2 getOutfile = * ;** get filename lda name+0 ldy name+1 sta zp+0 sty zp+1 jsr basename stx outfileFileLen ;** get seg number, 2+ digits lda #numbuf sta syswork+0 sty syswork+1 lda #1 ldx #segnum jsr utoa cpy #1 bne + lda numbuf+0 sta numbuf+1 lda #"0" sta numbuf+0 lda #0 sta numbuf+2 iny + tya clc adc #2 sta outfileExtLen clc lda outfileFileLen adc outfileExtLen ldy outfileFileLen cmp #17 bcc + sec lda #16 sbc outfileExtLen ;gives allowed filename len tay + lda #"." sta outBuf,y iny lda #"b" sta outBuf,y iny ldx #0 - lda numbuf,x sta outBuf,y beq + inx iny bne - ;** open the file + lda #outBuf sta zp+0 sty zp+1 lda #"w" jsr openOverwrite sta outfile bcc + lda #outfileErrMsg1 jsr eputs lda #outBuf jsr eputs lda #outfileErrMsg2 jsr eputs jmp die ;** echo opening + lda #outfileMsg jsr eputs lda #outBuf jsr eputs lda #chrQuote jsr eputchar lda #chrCR jmp eputchar outfileMsg = * .asc "outputting to file " .byte chrQuote,0 outfileErrMsg1 = * .asc "ERROR: cannot open " .byte chrQuote,0 outfileErrMsg2 = * .byte chrQuote .asc ", aborting!" .byte chrCR,0 bcodeSegment = * ;( ) : isLastSeg ;** header line lda #bcodeHeaderMsg jsr trPuts ldx #segnum jsr trPutnum lda #" " jsr trPutchar lda name+0 ldy name+1 sta zp+0 sty zp+1 jsr basename lda #outBuf jsr trPuts lda #chrCR jsr trPutchar jsr crcInit lda #0 sta linenum+0 sta linenum+1 sta linenum+2 sta linenum+3 ;** loop encodeNext = * jsr encodeLine bcc + lda #true sta isLastSeg jmp encodeSegFinish + bit linelimit bpl encodeNext inc linenum+0 bne + inc linenum+1 bne + inc linenum+2 bne + inc linenum+3 + sec ldy #4 ldx #0 - lda linenum,x sbc maxlines,x inx dey bne - bcc encodeNext lda #false sta isLastSeg ;** end line encodeSegFinish = * jsr crcFinish bit isLastSeg bpl + lda #bcodeEndMsg jmp ++ + lda #bcodeContinuedMsg + jsr trPuts ldx #segnum jsr trPutnum lda #" " jsr trPutchar ldx #bytes jsr trPutnum lda #" " jsr trPutchar ldx #crc jsr trPuthex lda #chrCR jsr trPutchar rts bcodeHeaderMsg = * .asc "--bcode-begin " .byte 0 bcodeEndMsg = * .asc "--bcode-end " .byte 0 bcodeContinuedMsg = * .asc "--bcode-continued " .byte 0 basenameStart .buf 1 basename = * ;( (zp)=inname ) : outBuf=outname, .X=basenameLen ldy #255 sty basenameStart - iny lda (zp),y beq basenameDone cmp #":" beq + cmp #"/" bne - + sty basenameStart jmp - basenameDone = * ldy basenameStart ldx #255 - iny inx lda (zp),y sta outBuf,x bne - cpx #2 bcc + lda outBuf-2,x cmp #"," bne + lda #0 sta outBuf-2,x dex dex + rts encodeLine = * inc stopCountdn lda stopCountdn and #7 bne + jsr checkStop ;** get the chunk + jsr readChunk bcc + rts + stx chunkLen lda #0 sta inChunk+0,x sta inChunk+1,x jsr crcChunk ;** encode the chunk ldx #0 ;chunkpos ldy #0 ;linepos - jsr encodeFourChars cpx chunkLen bcc - ;** fix non-integral-length (last) line beq + lda #"=" sta outBuf-1,y dex cpx chunkLen beq + sta outBuf-2,y ;** output the line + lda #chrCR sta outBuf,y ldx transTo cpx #trPetscii beq + iny lda #chrLF sta outBuf,y cpx #trAsciiCrLf beq + dey sta outBuf,y + iny tya lda #outBuf sta zp+0 stx zp+1 tya ldy #0 ldx outfile jsr write rts encodeFourChars = * ;( .X++=chunkpos, .Y++=linepos ) stx chunkPos ;** put bytes into output line ;pos 76543210 76543210 76543210 76543210 ;byt xx111111 xx112222 xx222233 xx333333 ;bit 765432 107654 321076 543210 ;** first byte lda inChunk+0,x lsr lsr tax lda base64Char,x sta outBuf,y iny ;** second byte ldx chunkPos lda inChunk+0,x asl asl asl asl sta bctemp lda inChunk+1,x lsr lsr lsr lsr ora bctemp and #%00111111 tax lda base64Char,x sta outBuf,y iny ;** third byte ldx chunkPos lda inChunk+1,x asl asl sta bctemp lda inChunk+2,x asl rol rol and #%00000011 ora bctemp and #%00111111 tax lda base64Char,x sta outBuf,y iny ;** fourth byte ldx chunkPos lda inChunk+2,x and #%00111111 tax lda base64Char,x sta outBuf,y iny ldx chunkPos inx inx inx rts base64Index .buf 1 setBase64Table = * ldy #0 ldx #0 lda transTo cmp #trPetscii beq + ldx #base64DescAsc-base64DescPet + stx base64Index - ldx base64Index lda base64DescPet+0,x beq + pha lda base64DescPet+1,x tax pla - sta base64Char,y clc adc #1 iny dex bne - inc base64Index inc base64Index bne -- + rts base64DescPet = * .byte "A",26,"a",26,"0",10,"+",1,"/",1,$00 base64DescAsc = * .byte $41,26,$61,26,"0",10,"+",1,"/",1,$00 readChunk = * ;( ) : .X=len ldx #0 - stx chunkLen jsr getByte ldx chunkLen bcs + sta inChunk,x inx cpx #maxChunk bcc - - clc rts + cpx #0 bne - sec rts getByte = * lda bufCount+0 ora bufCount+1 beq getByteFillBuf ldy #0 lda (bufPtr),y inc bufPtr+0 bne + inc bufPtr+1 + ldx bufCount+0 bne + dec bufCount+1 + dec bufCount+0 clc rts getByteFillBuf = * jsr checkStop lda #inBuf sta zp+0 sty zp+1 sta bufPtr+0 sty bufPtr+1 lda inBufSize+0 ldy inBufSize+1 ldx infile jsr read beq + bcs + sta bufCount+0 sty bufCount+1 jmp getByte + sec rts crcTable0 = * .byte $00,$96,$2c,$ba,$19,$8f,$35,$a3,$32,$a4,$1e,$88,$2b,$bd,$07,$91 .byte $64,$f2,$48,$de,$7d,$eb,$51,$c7,$56,$c0,$7a,$ec,$4f,$d9,$63,$f5 .byte $c8,$5e,$e4,$72,$d1,$47,$fd,$6b,$fa,$6c,$d6,$40,$e3,$75,$cf,$59 .byte $ac,$3a,$80,$16,$b5,$23,$99,$0f,$9e,$08,$b2,$24,$87,$11,$ab,$3d .byte $90,$06,$bc,$2a,$89,$1f,$a5,$33,$a2,$34,$8e,$18,$bb,$2d,$97,$01 .byte $f4,$62,$d8,$4e,$ed,$7b,$c1,$57,$c6,$50,$ea,$7c,$df,$49,$f3,$65 .byte $58,$ce,$74,$e2,$41,$d7,$6d,$fb,$6a,$fc,$46,$d0,$73,$e5,$5f,$c9 .byte $3c,$aa,$10,$86,$25,$b3,$09,$9f,$0e,$98,$22,$b4,$17,$81,$3b,$ad .byte $20,$b6,$0c,$9a,$39,$af,$15,$83,$12,$84,$3e,$a8,$0b,$9d,$27,$b1 .byte $44,$d2,$68,$fe,$5d,$cb,$71,$e7,$76,$e0,$5a,$cc,$6f,$f9,$43,$d5 .byte $e8,$7e,$c4,$52,$f1,$67,$dd,$4b,$da,$4c,$f6,$60,$c3,$55,$ef,$79 .byte $8c,$1a,$a0,$36,$95,$03,$b9,$2f,$be,$28,$92,$04,$a7,$31,$8b,$1d .byte $b0,$26,$9c,$0a,$a9,$3f,$85,$13,$82,$14,$ae,$38,$9b,$0d,$b7,$21 .byte $d4,$42,$f8,$6e,$cd,$5b,$e1,$77,$e6,$70,$ca,$5c,$ff,$69,$d3,$45 .byte $78,$ee,$54,$c2,$61,$f7,$4d,$db,$4a,$dc,$66,$f0,$53,$c5,$7f,$e9 .byte $1c,$8a,$30,$a6,$05,$93,$29,$bf,$2e,$b8,$02,$94,$37,$a1,$1b,$8d crcTable1 = * .byte $00,$30,$61,$51,$c4,$f4,$a5,$95,$88,$b8,$e9,$d9,$4c,$7c,$2d,$1d .byte $10,$20,$71,$41,$d4,$e4,$b5,$85,$98,$a8,$f9,$c9,$5c,$6c,$3d,$0d .byte $20,$10,$41,$71,$e4,$d4,$85,$b5,$a8,$98,$c9,$f9,$6c,$5c,$0d,$3d .byte $30,$00,$51,$61,$f4,$c4,$95,$a5,$b8,$88,$d9,$e9,$7c,$4c,$1d,$2d .byte $41,$71,$20,$10,$85,$b5,$e4,$d4,$c9,$f9,$a8,$98,$0d,$3d,$6c,$5c .byte $51,$61,$30,$00,$95,$a5,$f4,$c4,$d9,$e9,$b8,$88,$1d,$2d,$7c,$4c .byte $61,$51,$00,$30,$a5,$95,$c4,$f4,$e9,$d9,$88,$b8,$2d,$1d,$4c,$7c .byte $71,$41,$10,$20,$b5,$85,$d4,$e4,$f9,$c9,$98,$a8,$3d,$0d,$5c,$6c .byte $83,$b3,$e2,$d2,$47,$77,$26,$16,$0b,$3b,$6a,$5a,$cf,$ff,$ae,$9e .byte $93,$a3,$f2,$c2,$57,$67,$36,$06,$1b,$2b,$7a,$4a,$df,$ef,$be,$8e .byte $a3,$93,$c2,$f2,$67,$57,$06,$36,$2b,$1b,$4a,$7a,$ef,$df,$8e,$be .byte $b3,$83,$d2,$e2,$77,$47,$16,$26,$3b,$0b,$5a,$6a,$ff,$cf,$9e,$ae .byte $c2,$f2,$a3,$93,$06,$36,$67,$57,$4a,$7a,$2b,$1b,$8e,$be,$ef,$df .byte $d2,$e2,$b3,$83,$16,$26,$77,$47,$5a,$6a,$3b,$0b,$9e,$ae,$ff,$cf .byte $e2,$d2,$83,$b3,$26,$16,$47,$77,$6a,$5a,$0b,$3b,$ae,$9e,$cf,$ff .byte $f2,$c2,$93,$a3,$36,$06,$57,$67,$7a,$4a,$1b,$2b,$be,$8e,$df,$ef crcTable2 = * .byte $00,$07,$0e,$09,$6d,$6a,$63,$64,$db,$dc,$d5,$d2,$b6,$b1,$b8,$bf .byte $b7,$b0,$b9,$be,$da,$dd,$d4,$d3,$6c,$6b,$62,$65,$01,$06,$0f,$08 .byte $6e,$69,$60,$67,$03,$04,$0d,$0a,$b5,$b2,$bb,$bc,$d8,$df,$d6,$d1 .byte $d9,$de,$d7,$d0,$b4,$b3,$ba,$bd,$02,$05,$0c,$0b,$6f,$68,$61,$66 .byte $dc,$db,$d2,$d5,$b1,$b6,$bf,$b8,$07,$00,$09,$0e,$6a,$6d,$64,$63 .byte $6b,$6c,$65,$62,$06,$01,$08,$0f,$b0,$b7,$be,$b9,$dd,$da,$d3,$d4 .byte $b2,$b5,$bc,$bb,$df,$d8,$d1,$d6,$69,$6e,$67,$60,$04,$03,$0a,$0d .byte $05,$02,$0b,$0c,$68,$6f,$66,$61,$de,$d9,$d0,$d7,$b3,$b4,$bd,$ba .byte $b8,$bf,$b6,$b1,$d5,$d2,$db,$dc,$63,$64,$6d,$6a,$0e,$09,$00,$07 .byte $0f,$08,$01,$06,$62,$65,$6c,$6b,$d4,$d3,$da,$dd,$b9,$be,$b7,$b0 .byte $d6,$d1,$d8,$df,$bb,$bc,$b5,$b2,$0d,$0a,$03,$04,$60,$67,$6e,$69 .byte $61,$66,$6f,$68,$0c,$0b,$02,$05,$ba,$bd,$b4,$b3,$d7,$d0,$d9,$de .byte $64,$63,$6a,$6d,$09,$0e,$07,$00,$bf,$b8,$b1,$b6,$d2,$d5,$dc,$db .byte $d3,$d4,$dd,$da,$be,$b9,$b0,$b7,$08,$0f,$06,$01,$65,$62,$6b,$6c .byte $0a,$0d,$04,$03,$67,$60,$69,$6e,$d1,$d6,$df,$d8,$bc,$bb,$b2,$b5 .byte $bd,$ba,$b3,$b4,$d0,$d7,$de,$d9,$66,$61,$68,$6f,$0b,$0c,$05,$02 crcTable3 = * .byte $00,$77,$ee,$99,$07,$70,$e9,$9e,$0e,$79,$e0,$97,$09,$7e,$e7,$90 .byte $1d,$6a,$f3,$84,$1a,$6d,$f4,$83,$13,$64,$fd,$8a,$14,$63,$fa,$8d .byte $3b,$4c,$d5,$a2,$3c,$4b,$d2,$a5,$35,$42,$db,$ac,$32,$45,$dc,$ab .byte $26,$51,$c8,$bf,$21,$56,$cf,$b8,$28,$5f,$c6,$b1,$2f,$58,$c1,$b6 .byte $76,$01,$98,$ef,$71,$06,$9f,$e8,$78,$0f,$96,$e1,$7f,$08,$91,$e6 .byte $6b,$1c,$85,$f2,$6c,$1b,$82,$f5,$65,$12,$8b,$fc,$62,$15,$8c,$fb .byte $4d,$3a,$a3,$d4,$4a,$3d,$a4,$d3,$43,$34,$ad,$da,$44,$33,$aa,$dd .byte $50,$27,$be,$c9,$57,$20,$b9,$ce,$5e,$29,$b0,$c7,$59,$2e,$b7,$c0 .byte $ed,$9a,$03,$74,$ea,$9d,$04,$73,$e3,$94,$0d,$7a,$e4,$93,$0a,$7d .byte $f0,$87,$1e,$69,$f7,$80,$19,$6e,$fe,$89,$10,$67,$f9,$8e,$17,$60 .byte $d6,$a1,$38,$4f,$d1,$a6,$3f,$48,$d8,$af,$36,$41,$df,$a8,$31,$46 .byte $cb,$bc,$25,$52,$cc,$bb,$22,$55,$c5,$b2,$2b,$5c,$c2,$b5,$2c,$5b .byte $9b,$ec,$75,$02,$9c,$eb,$72,$05,$95,$e2,$7b,$0c,$92,$e5,$7c,$0b .byte $86,$f1,$68,$1f,$81,$f6,$6f,$18,$88,$ff,$66,$11,$8f,$f8,$61,$16 .byte $a0,$d7,$4e,$39,$a7,$d0,$49,$3e,$ae,$d9,$40,$37,$a9,$de,$47,$30 .byte $bd,$ca,$53,$24,$ba,$cd,$54,$23,$b3,$c4,$5d,$2a,$b4,$c3,$5a,$2d ;** crc = 0xFFFFFFFF; ;** while( (c=getc(fp)) != EOF ) { ;** crc = (crc>>8) & 0x00FFFFFF ^ crcTable[ (crc^c) & 0xFF ]; ;** } ;** return( crc^0xFFFFFFFF ); crcInit = * ldx #3 - lda #$ff sta crc,x lda #0 sta bytes,x dex bpl - rts crcChunk = * ldy #0 cpy chunkLen bcs + - lda inChunk,y ;.X = (crc^c) & 0xFF eor crc+0 tax lda crc+1 ;crc = (crc>>8) & 0x00FFFFFF ^ crcTable[ .X ] eor crcTable0,x sta crc+0 lda crc+2 eor crcTable1,x sta crc+1 lda crc+3 eor crcTable2,x sta crc+2 lda crcTable3,x sta crc+3 iny cpy chunkLen bcc - + clc lda bytes+0 adc chunkLen sta bytes+0 bcc + inc bytes+1 bne + inc bytes+2 bne + inc bytes+3 + rts crcFinish = * ldx #3 - lda crc,x eor #$ff sta crc,x dex bpl - rts trPuts = * sta trPutPtr+0 sty trPutPtr+1 ldy #0 sty trPutIndex - ldy trPutIndex lda (trPutPtr),y beq + jsr trPutchar inc trPutIndex bne - + rts trPutchar = * ldx transTo cpx #trPetscii beq + cmp #chrCR beq ++ jsr convPet2Asc + ldx outfile jmp putc + ldx transTo cpx #trAsciiLf beq + lda #chrCR ldx outfile jsr putc + lda #chrLF ldx outfile jmp putc convPet2Asc = * cmp #"a" bcs + rts + tax bpl + sbc #$c0-$60 tax + and #$1f bne + - txa rts + cmp #$1b bcs - txa eor #$20 rts trPutnum = * ;( .X=number32 ) lda #numbuf sta syswork+0 sty syswork+1 lda #1 jsr utoa trPutnumDump = * lda #numbuf jsr trPuts rts trPuthex = * ;( .X=number32 ) lda #4 sta work ldy #0 inx inx inx - lda 0,x pha lsr lsr lsr lsr jsr trPuthexDigit pla jsr trPuthexDigit dex dec work bne - lda #0 sta numbuf,y jmp trPutnumDump trPuthexDigit = * ;( .A=digit, .Y=numbufIndex ) and #$0f ora #$30 cmp #$3a bcc + adc #6 + sta numbuf,y iny rts ;=== standard library === puts = * ldx #stdout fputs = * sta zp+0 sty zp+1 ldy #$ff - iny lda (zp),y bne - tya ldy #0 jmp write eputs = * ldx #stderr jmp fputs eputchar = * ldx #stderr jmp putc putchar = * ldx #stdout putc = * sta putcBuffer lda #putcBuffer sta zp+0 sty zp+1 lda #1 ldy #0 jmp write putcBuffer .buf 1 getarg = * sty zp+1 asl sta zp+0 rol zp+1 clc lda aceArgv+0 adc zp+0 sta zp+0 lda aceArgv+1 adc zp+1 sta zp+1 ldy #0 lda (zp),y tax iny lda (zp),y stx zp+0 sta zp+1 rts scanDigit .buf 1 scanSave .buf 4 scanTemp .buf 1 scanIndex .buf 1 scanAnything .buf 1 scanNum = * ;( (zp)=numStr, .Y=numIndex ) : .Y=scan, [scanVal]=num, .CS=err ldx #3 lda #0 - sta scanVal,x dex bpl - lda #0 sta scanAnything - lda (zp),y cmp #" " bne scanNumNext iny bne - sec rts scanNumNext = * lda (zp),y cmp #"0" bcc + cmp #"9"+1 bcc ++ + lda scanAnything beq scanError clc rts + and #$0f sta scanDigit lda #$ff sta scanAnything ;** times ten sty scanTemp ldx #3 - lda scanVal,x sta scanSave,x dex bpl - lda #2 sta scanIndex - clc ldy #4 ldx #0 - rol scanVal,x inx dey bne - bcs scanError dec scanIndex bne -- clc ldy #4 ldx #0 - lda scanVal,x adc scanSave,x sta scanVal,x inx dey bne - bcs scanError clc ldy #4 ldx #0 - rol scanVal,x inx dey bne - bcs scanError clc ldy #4 ldx #0 lda scanDigit - adc scanVal,x sta scanVal,x lda #0 inx dey bne - bcs scanError ldy scanTemp iny beq scanError jmp scanNumNext scanError = * sec rts openOvMode .buf 1 openOverwrite = * ;( (zp)=name, .A=mode ) : .A=Fcb, .CS=err sta openOvMode jsr open bcs + rts + lda errno cmp #aceErrFileExists beq + - sec rts + jsr remove lda openOvMode jsr open bcs - rts ;===bss=== bss = * outBuf = bss inChunk = outBuf+maxLine+1 base64Char = inChunk+maxChunk+5 numbuf = base64Char+64 inBuf = numbuf+12 bssEnd = inBuf+64 brk.s 9 .seq acehead.s .org aceAppAddress .obj "@0:brk" jmp main .asc "cB" main = * brk config.s 1172 ;*** Configuration Program *** .seq acehead.s .org aceAppAddress .obj "@0:config" jmp main .asc "cF" kernelSetlfs = $ffba kernelSetnam = $ffbd kernelOpen = $ffc0 kernelClose = $ffc3 kernelChkin = $ffc6 kernelChkout = $ffc9 kernelClrchn = $ffcc kernelChrin = $ffcf kernelLoad = $ffd5 kernelSwapper = $ff5f st = $90 totalBanks = aceTotalMemory+2 chrCR = 13 chrQuote = 34 configBuf = 2 ;(2) sysName = 4 ;(2) ram0FreeMap = 6 ;(2) aceEndPage = 8 ;(1) sysType = 9 ;(1) memRead = 12 ;(2) memWrite = 14 ;(2) banks = 16 ;(1) bankLimit = 17 ;(1) save0 = 18 ;(2) save2 = 20 ;(2) saveN = 22 ;(2) titlePtr = $70 ;(2) main = * lda #title sta titlePtr+0 sty titlePtr+1 jsr loadConfig bcs + jsr loadCharset bcs + jsr loadShell bcs + jsr screenInit jsr setDate jsr displayDate jsr getRamlinkParms jsr internalMemory jsr reuMemory jsr rlreuMemory jsr rlMemory jsr totalMemory clc lda #<title ldy #>title sta 2 sty 3 sec lda titlePtr+0 sbc #<title sta 4 lda titlePtr+1 sbc #>title sta 5 clc + rts testMemoryType = * ;( .A=type, .X=bankLimit ) : .A=bankCount sta zp+3 stx bankLimit lda #$00 ldy #$80 ldx #$00 sta zp sty zp+1 stx zp+2 lda #0 sta banks nextBank = * lda banks sta zp+2 jsr saveBank lda #$ff-$cb sta memWrite lda zp+2 sta memWrite+1 ldx #memWrite ldy #2 jsr zpstore lda #$ff-$cb ldx zp+2 jsr testBank bcs bankFail lda #$cb sta memWrite ldx #memWrite ldy #2 jsr zpstore lda #$cb ldx zp+2 jsr testBank bcs bankFail lda #$cb ldx #0 jsr testBank bcs bankFail lda zp+2 cmp #2 bcc + lda #$cb ldx #2 jsr testBank bcs bankFail + jsr restoreBank inc banks lda banks cmp bankLimit bcc nextBank bankFail = * jsr restoreWrapBanks lda banks rts saveBank = * ;() ldx #saveN ldy #2 lda zp+2 cmp #0 bne + ldx #save0 + cmp #2 bne + ldx #save2 + jsr zpload rts restoreBank = * ;() lda zp+2 cmp #0 beq + cmp #2 beq + ldx #saveN ldy #2 jsr zpstore + rts restoreWrapBanks = * ;() lda banks cmp #3 bcc + + lda #2 sta zp+2 ldx #save2 ldy #2 jsr zpstore lda banks cmp #1 bcc + lda #0 sta zp+2 ldx #save0 ldy #2 jsr zpstore + rts rdVal = 10 ;(1) rdBank = 11 ;(1) testBank = * ;( .A=data, .X=bank ) : .CS=err sta rdVal lda zp+2 sta rdBank stx zp+2 lda #$ff sta memRead sta memRead+1 ldx #memRead ldy #2 jsr zpload lda memRead cmp rdVal bne + lda memRead+1 cmp zp+2 bne + lda rdBank sta zp+2 clc rts + lda rdBank sta zp+2 sec rts puts = * sta $40 sty $41 ldy #0 - lda ($40),y beq + jsr chrout iny bne - inc $41 bne - + rts loadConfig = * lda #0 ldx 186 ldy #0 jsr kernelSetlfs lda #10 ldx #<loadConfigName ldy #>loadConfigName jsr kernelSetnam lda #0 ldx configBuf ldy configBuf+1 jsr kernelLoad bcs + clc rts + lda #<badConfig ldy #>badConfig jsr puts sec rts loadConfigName = * .asc "config.sys" badConfig = * .asc "Error attempting to b-load " .byte chrQuote .asc "config.sys" .byte chrQuote .asc ", aborting." .byte chrCR,0 loadCharset = * lda #0 ldx 186 ldy #0 jsr kernelSetlfs lda #11 ldx #<loadCharsetName ldy #>loadCharsetName jsr kernelSetnam lda #0 ldx #<$2000 ldy #>$2000 jsr kernelLoad bcs + clc rts + lda #<badCharset ldy #>badCharset jsr puts sec rts loadCharsetName = * .asc "ace-charset" badCharset = * .asc "Error attempting to b-load " .byte chrQuote .asc "ace-charset" .byte chrQuote .asc ", aborting." .byte chrCR,0 loadShell = * lda #0 ldx 186 ldy #0 jsr kernelSetlfs lda #2 ldx #<loadShellName ldy #>loadShellName jsr kernelSetnam lda #0 ldx #<aceShellAddress ldy #>aceShellAddress jsr kernelLoad bcs + clc rts + lda #<badShell ldy #>badShell jsr puts sec rts loadShellName = * .asc "sh" badShell = * .asc "Error attempting to b-load " .byte chrQuote .asc "sh" .byte chrQuote .asc ", aborting." .byte chrCR,0 screenInit = * lda #147 jsr $ffd2 lda sysName+0 ldy sysName+1 jsr puts rts displayDate = * lda #<dateBuf ldy #>dateBuf jsr getdate ;** year lda dateBuf+0 ldx #11 jsr putDigits lda dateBuf+1 ldx #13 jsr putDigits ;** month lda dateBuf+2 cmp #$10 bcc + sec sbc #$10-10 + tax lda monthStr+0,x sta dateStr+7 lda monthStr+13,x sta dateStr+8 lda monthStr+26,x sta dateStr+9 ;** day lda dateBuf+3 ldx #4 jsr putDigits ;** hour lda dateBuf+4 ldx #"a" cmp #$00 bne + lda #$12 jmp putHour + cmp #$12 bcc putHour ldx #"p" cmp #$12 beq putHour sei sed sec sbc #$12 cld cli putHour = * stx dateStr+26 ldx #17 jsr putDigits ;** minute lda dateBuf+5 ldx #20 jsr putDigits ;** second lda dateBuf+6 ldx #23 jsr putDigits ;** day of week lda dateBuf+7 and #$07 tax lda dowStr+0,x sta dateStr+0 lda dowStr+8,x sta dateStr+1 lda dowStr+16,x sta dateStr+2 lda #<dateStr ldy #>dateStr jsr puts rts putDigits = * ;( .A=num, .X=offset ) pha lsr lsr lsr lsr ora #$30 sta dateStr,x pla and #$0f ora #$30 sta dateStr+1,x rts dateStr = * ;0123456789012345678901234567 .asc "Tue-05-May-1993 11:34:12 pm" .byte 13,13,0 dateBuf .buf 10 dowStr = * .asc "*SMTWTFS" .asc "*uouehra" .asc "*nneduit" monthStr = * .asc "*JFMAMJJASOND" .asc "*aeapauuuecoe" .asc "*nbrrynlgptvc" tryDate = 10 setDate = * ldy #$82 - sty tryDate lda (configBuf),y cmp #$ff beq + jsr cmdOpen bcs + lda #<queryDateStr ldy #>queryDateStr jsr cmdSend bcs queryError lda #<dateBuf ldy #>dateBuf ldx #9 jsr cmdData bcs queryError jsr cmdClose jmp convertCmdDate queryError = * jsr cmdClose + inc tryDate ldy tryDate cpy #$86 bcc - setDefaultDate = * lda configBuf ldy configBuf+1 clc adc #$86 bcc + iny + jmp setdate queryDateStr = * .asc "t-rb" .byte 13,0 convertCmdDate = * lda dateBuf+4 ldx dateBuf+7 beq + sei sed clc adc #$12 cld cli + cmp #$12 bne + lda #$00 + cmp #$24 bne + lda #$12 + sta dateBuf+4 clc lda dateBuf+0 adc #$51 sta dateBuf+7 ldx #$19 lda dateBuf+1 cmp #$70 bcs + ldx #$20 + stx dateBuf+0 lda #<dateBuf ldy #>dateBuf jsr setdate rts cmdOpen = * ;( .A=device ) : .CS=err tax lda #6 ldy #15 jsr kernelSetlfs lda #0 jsr kernelSetnam jsr kernelOpen rts cmdClose = * ;() clc lda #6 jsr kernelClose rts cmdSend = * ;( (.AY)=cmdStrZ ) : .CS=err sta $40 sty $41 ldx #6 jsr kernelChkout bcc + rts + ldy #0 - lda ($40),y beq + jsr $ffd2 iny bne - + jsr kernelClrchn clc rts cmdData = * ;( (.AY)=cmdBuf, .X=len ) : .CS=err sta $40 sty $41 stx $42 ldx #6 jsr kernelChkin bcc + rts + ldx #0 jsr kernelChrin cmp #"0" bcc ++ cmp #"9"+1 bcs ++ badData = * - jsr kernelChrin bcs + bit st bvs + cmp #13 bne - + jsr kernelClrchn sec rts + ldy #0 sta ($40),y iny - jsr kernelChrin sta ($40),y iny cpy $42 bcc - cmp #13 bne badData jsr kernelClrchn clc rts getRamlinkParms = * ldy #$80 lda (configBuf),y jsr cmdOpen bcs rlParmsError ;** ramlink ram access lda #<partRlCmd ldy #>partRlCmd jsr cmdSend bcs rlParmsError lda #<rlIdent ldy #>rlIdent jsr checkPartition bcs + sta aceRamlinkStart sty aceRamlinkStart+1 stx aceRamlinkBanks ;** indirect reu access + lda #<partRlreuCmd ldy #>partRlreuCmd jsr cmdSend bcs rlParmsError lda #<rlreuIdent ldy #>rlreuIdent jsr checkPartition bcs rlParmsError sta aceRamlinkReuStart sty aceRamlinkReuStart+1 stx aceRamlinkReuBanks rlParmsError = * jsr cmdClose rts checkPartition = * ;( (.AY)=name ) : .CS=err, .AY=start, .X=banks sta $44 sty $45 lda #<partitionBuf ldy #>partitionBuf ldx #31 jsr cmdData bcs checkErrExit lda partitionBuf+0 cmp #7 bne checkErrExit ldy #0 - lda ($44),y beq + cmp partitionBuf+3,y bne checkErrExit iny bne - + lda partitionBuf+21 ldy partitionBuf+20 ldx partitionBuf+28 clc rts checkErrExit = * sec rts partRlCmd = * .asc "g-p" .byte 31,0 rlIdent = * .asc "rl-ram" .byte $a0,0 partRlreuCmd = * .asc "g-p" .byte 30,0 rlreuIdent = * .asc "indirect-reu" .byte $a0,0 partitionBuf .buf 35 putnum = * ;( [$44]=num, .A=width ) pha lda #<outchar ldy #>outchar sta $80 sty $81 ldx #$44 pla jsr utoa jsr putcomma ldx #0 - lda outchar,x beq + jsr chrout inx bne - + rts outchar .buf 11 putcomma = * ;( outchar ) ldx #$ff - inx lda outchar,x bne - - dex dex dex dex cpx #$80 bcc + rts + cpx #0 bcs + rts + lda outchar,x cmp #" " bne + rts + stx $44 ldy #0 - lda outchar+1,y sta outchar,y iny cpy $44 bcc - lda #"," sta outchar,y jmp -- rts displayAvail = * ;( (.AY)=name, (.X,$45)=banks ) sta $40 sty $41 stx $44 ldy #0 - lda ($40),y jsr chrout iny cpy #6 bcc - lda #":" jsr chrout txa clc adc totalBanks sta totalBanks lda $45 adc totalBanks+1 sta totalBanks+1 lda #0 sta $46 sta $47 ldx #6 - asl $44 rol $45 rol $46 rol $47 dex bne - lda #6 jsr putnum lda #"K" jsr chrout rts addToFree = * ;( [$44]=bytes ) clc lda $44 adc aceFreeMemory+0 sta aceFreeMemory+0 lda $45 adc aceFreeMemory+1 sta aceFreeMemory+1 lda $46 adc aceFreeMemory+2 sta aceFreeMemory+2 bcc + inc aceFreeMemory+3 + rts displayFree = * ;( [$44]=bytes ) lda #<freeMsg ldy #>freeMsg jsr puts lda #10 jsr putnum lda #13 jsr chrout rts freeMsg = * .asc " free:" .byte 0 resetFree = * lda #0 ldx #3 - sta $44,x dex bpl - rts internalMemory = * lda #aceMemInternal ldx #255 sei jsr testMemoryType cli sta aceInternalBanks pha jsr installInternVectors pla tax lda #0 sta $45 lda #<internalName ldy #>internalName jsr displayAvail jsr resetFree ;** ram0 lda #aceMemInternal sta zp+3 lda #0 sta aceInternalCur lda ram0FreeMap+0 ldy ram0FreeMap+1 sta aceRam0Freemap+0 sty aceRam0Freemap+1 ldx #0 sta zp+0 sty zp+1 stx zp+2 ldy #$a3 bit sysType bmi + ldy #$c1 + lda (configBuf),y tay lda #1 ldx #>aceAppAddress jsr initBanks jsr freeRam0AfterKernel ;** ram1 bit sysType bpl expInternal64 lda #$00 sta zp+0 ldy #$a0 lda (configBuf),y sta zp+1 sta aceRam1Freemap lda #1 sta zp+2 ldy #$a1 lda (configBuf),y tay lda #2 ldx zp+1 inx jsr initBanks ;** ram2-7 c128 expInternal128 = * lda #2 sta zp+2 lda #$00 ldy #$04 sta zp+0 sty zp+1 ldy #$a5 lda (configBuf),y ldx aceInternalBanks jsr min sta aceInternalBanks ldx #$05 ldy #$ff jsr initBanks jsr addToFree jsr displayFree rts ;** ram1-3 c64 expInternal64 = * lda #1 sta aceInternalBanks jsr addToFree jsr displayFree rts internalName = * .asc "intern" reserveTPA = * ldy #$a8 bit sysType bmi + ldy #$c6 + lda (configBuf),y sta $40 ldy #>aceAppAddress lda #$fe cpy $40 bcs + - sta (ram0FreeMap),y iny cpy $40 bcc - + sec lda $40 sbc #>aceAppAddress sta $40 sec lda aceFreeMemory+1 sbc $40 sta aceFreeMemory+1 lda aceFreeMemory+2 sbc #0 sta aceFreeMemory+2 lda aceFreeMemory+3 sbc #0 sta aceFreeMemory+3 rts freeRam0AfterKernel = * ;** free end.kernel->st.shell ldy aceEndPage cpy #>aceAppAddress bcs + lda #$00 - sta (ram0FreeMap),y iny cpy #>aceAppAddress bcc - + sec lda #>aceAppAddress sbc aceEndPage sta $40 clc lda $45 adc $40 sta $45 bcc + inc $46 bne + inc $47 + rts installInternVectors = * bit sysType bpl installVectors64 lda aceInternalBanks cmp #2 bcs + rts + sei lda #2 ldy #aceMemInternal sta zp+2 sty zp+3 - lda #$05 ldy #$ff sta zp+0 sty zp+1 sta zw+0 sty zw+1 lda #<251 ldy #>251 jsr stash inc zp+2 lda zp+2 cmp aceInternalBanks bcc - cli rts installVectors64 = * ldx #$3f - lda vectorCode64,x sta $ffc0,x dex bpl - ;xx copy to exp banks rts vectorCode64 = * .byte $00 ;xx vector dispatch code here reuMemory = * lda #aceMemREU ldx #255 jsr testMemoryType sta aceReuBanks tax bne + lda aceRamlinkReuBanks beq + rts + lda #0 sta $45 lda #<reuName ldy #>reuName jsr displayAvail jsr resetFree lda #aceMemREU sta zp+3 ldy #$a6 bit sysType bmi + ldy #$c2 + lda (configBuf),y sta aceReuStart sta aceReuCur ldy #$a7 bit sysType bmi + ldy #$c3 + lda (configBuf),y ldx aceReuBanks jsr min sta aceReuBanks lda #$00 ldy #$ff ldx aceReuStart sta zp+0 sty zp+1 stx zp+2 lda aceReuBanks ldx #$00 ldy #$ff jsr initBanks jsr addToFree jsr displayFree rts reuName = * .asc "reu " rlreuMemory = * lda aceReuBanks beq + lda #0 sta aceRamlinkReuBanks - rts + ldx aceRamlinkReuBanks beq - lda #0 sta $45 lda #<rlreuName ldy #>rlreuName jsr displayAvail jsr resetFree lda #aceMemRLREU sta zp+3 ldy #$a6 bit sysType bmi + ldy #$c2 + lda (configBuf),y sta aceReuStart ;**sic sta aceRamlinkReuCur ldy #$a7 bit sysType bmi + ldy #$c3 + lda (configBuf),y ldx aceRamlinkReuBanks jsr min sta aceRamlinkReuBanks lda #$00 ldy #$ff ldx aceRamlinkReuStart sta zp+0 sty zp+1 stx zp+2 lda aceRamlinkReuBanks ldx #$00 ldy #$ff jsr initBanks jsr addToFree jsr displayFree rts rlreuName = * .asc "rl-reu" rlMemory = * ldx aceRamlinkBanks lda #0 sta $45 lda #<rlName ldy #>rlName jsr displayAvail jsr resetFree ldy #$81 lda (configBuf),y ldx aceRamlinkBanks jsr min sta aceRamlinkBanks lda #aceMemRL sta zp+3 lda #$00 ldy #$ff ldx #0 stx aceRamlinkCur sta zp+0 sty zp+1 stx zp+2 lda aceRamlinkBanks ldx #$00 ldy #$ff jsr initBanks jsr addToFree jsr displayFree rts rlName = * .asc "rl-ram" totalMemory = * ldx totalBanks lda totalBanks+1 sta $45 lda #<totalName ldy #>totalName jsr displayAvail ldx #3 - lda aceFreeMemory,x sta $44,x dex bpl - jsr displayFree lda #13 jsr chrout jsr reserveTPA rts totalName = * .asc "total " rts endBank = 10 ;(1) startFree = 11 ;(1) endFree = 12 ;(1) initBanks = * ;( [zp]=firstFreemap, .A=endBank+1, .X=startFree, .Y=endFree+1 ) sta endBank stx startFree sty endFree lda #<freemap ldy #>freemap sta zw sty zw+1 ldx #0 lda #$ff - sta freemap,x inx bne - ldx startFree cpx endFree bcs freeNextBank lda #$00 - sta freemap,x inx cpx endFree bcc - freeNextBank = * lda zp+2 cmp endBank bcs + lda #<256 ldy #>256 jsr stash inc zp+2 sec lda endFree sbc startFree clc adc $45 sta $45 bcc freeNextBank inc $46 bne freeNextBank inc $47 jmp freeNextBank + rts min = * ;( .A=num1, .X=num2 ) : .A=min stx $40 cmp $40 bcc + lda $40 + rts chroutSave .buf 1 chrout = * jsr $ffd2 sty chroutSave ldy #0 sta (titlePtr),y inc titlePtr+0 bne + inc titlePtr+1 + ldy chroutSave clc rts freemap = * title = freemap+256 cp.s 458 ;*** cp program *** .seq acehead.s .org aceAppAddress .obj "@0:cp" jmp copymain .asc "cB" ;*** global declarations libwork = $60 chrCR = $0d chrQuote = $22 overwriteAllFlag .buf 1 abortFlag .buf 1 ;******** standard library ******** eputs = * ldx #stderr jmp fputs puts = * ldx #stdout fputs = * sta zp sty zp+1 ldy #$ff - iny lda (zp),y bne - tya ldy #0 jmp write putchar = * ldx #stdout putc = * sta putcBuffer lda #<putcBuffer ldy #>putcBuffer sta zp sty zp+1 lda #1 ldy #0 jmp write putcBuffer .buf 1 getchar = * ldx #stdin getc = * lda #<getcBuffer ldy #>getcBuffer sta zp sty zp+1 lda #1 ldy #0 jsr read beq + lda getcBuffer rts + sec rts getcBuffer .buf 1 ;===copy library=== copyBufferPtr = 2 copyBufferLength = 4 getBufferParms = * lda #<cpEnd ldy #>cpEnd sta copyBufferPtr sty copyBufferPtr+1 sec lda aceStackPtr sbc copyBufferPtr sta copyBufferLength lda aceStackPtr+1 sbc copyBufferPtr+1 sta copyBufferLength+1 rts getarg = * sty zp+1 asl sta zp rol zp+1 clc lda aceArgv adc zp sta zp lda aceArgv+1 adc zp+1 sta zp+1 ldy #0 lda (zp),y tax iny lda (zp),y stx zp sta zp+1 rts getLastArg = * lda aceArgc ldy aceArgc+1 sec sbc #1 bcs + dey + jmp getarg ;===copy=== copyInFile = 6 copyOutFile = 7 copyInName = 8 copyOutName = 10 copymain = * lda #0 sta overwriteAllFlag sta abortFlag jsr getBufferParms ;** check for at least three arguments lda aceArgc+1 bne + lda aceArgc cmp #3 bcc copyUsageError ;** check if destination is a directory + jsr getLastArg jsr isdir cpy #0 beq + jmp copyToDir ;** check for exactly three parameters + lda aceArgc+1 bne copyUsageError lda aceArgc cmp #3 bne copyUsageError ;** get buffer parameters lda #1 ldy #0 jsr getarg lda zp ldy zp+1 sta copyInName sty copyInName+1 lda #2 ldy #0 jsr getarg lda zp ldy zp+1 sta copyOutName sty copyOutName+1 jsr copyfile rts copyUsageError = * lda #<copyUsageErrorMsg ldy #>copyUsageErrorMsg ldx #stderr jsr fputs rts copyUsageErrorMsg = * .asc "usage: cp fromfile tofile" .byte chrCR .asc " cp fromfile1 from2 ...fromN todir" .byte chrCR,0 copyfile = * ;** open files lda copyInName ldy copyInName+1 sta zp sty zp+1 lda #"r" jsr open bcc + lda copyInName ldy copyInName+1 jmp copyOpenError + sta copyInFile copyfileOutput = * lda copyOutName ldy copyOutName+1 sta zp sty zp+1 lda #"w" jsr open bcc copyWriteOk lda errno cmp #aceErrFileExists beq + - lda copyInFile jsr close lda copyOutName ldy copyOutName+1 jmp copyOpenError + jsr copyAskOverwrite beq + lda copyInFile jsr close sec rts + jsr copyRemoveOutfile jmp copyfileOutput copyWriteOk = * sta copyOutFile jsr copyFileContents lda copyOutFile jsr close lda copyInFile jsr close rts copyAskOverwrite = * ;() : .CS=quit, .EQ=yes, .NE=no lda overwriteAllFlag beq + lda #0 rts / lda #<copyAskOverwriteMsg ldy #>copyAskOverwriteMsg jsr puts lda copyOutName ldy copyOutName+1 jsr puts lda #<copyAskOverwriteMsg2 ldy #>copyAskOverwriteMsg2 jsr puts jsr getchar cmp #chrCR beq - pha - jsr getchar cmp #chrCR bne - pla cmp #"q" bne + - lda #$ff sta abortFlag sec rts + cmp #"Q" beq - cmp #"a" bne + - lda #$ff sta overwriteAllFlag lda #"y" + cmp #"A" beq - cmp #"y" beq + cmp #"Y" + clc rts copyAskOverwriteMsg = * .asc "Overwrite " .byte chrQuote,0 copyAskOverwriteMsg2 = * .byte chrQuote .asc " (y/n/a/q)? " .byte 0 copyRemoveOutfile = * lda copyOutName ldy copyOutName+1 sta zp sty zp+1 jsr remove rts copyFileContents = * ;** copy file contents lda copyBufferPtr ldy copyBufferPtr+1 sta zp sty zp+1 - lda copyBufferLength ldy copyBufferLength+1 ldx copyInFile jsr read bcs copyFileError beq + ldx copyOutFile jsr write bcc - bcs copyFileError + rts copyOpenName = 14 copyOpenError = * sta copyOpenName sty copyOpenName+1 lda #<copyOpenErrorMsg1 ldy #>copyOpenErrorMsg1 ldx #stderr jsr fputs lda copyOpenName ldy copyOpenName+1 ldx #stderr jsr fputs lda #<copyOpenErrorMsg2 ldy #>copyOpenErrorMsg2 ldx #stderr jsr fputs rts copyOpenErrorMsg1 = * .asc "Error opening file " .byte chrQuote .byte 0 copyOpenErrorMsg2 = * .byte chrQuote .byte chrCR .byte 0 copyFileError = * lda #<copyFileErrorMsg ldy #>copyFileErrorMsg ldx #stderr jmp fputs copyFileErrorMsg = * .asc "File data error!" .byte chrCR .byte 0 copyArg = 12 lastArg = 14 copyToDir = * lda #1 ldy #0 sta copyArg sty copyArg+1 - lda aceArgc ldy aceArgc+1 sec sbc #1 bcs + dey + cmp copyArg bne + cpy copyArg+1 beq copyToDirExit + jsr stopkey bcs copyToDirStopped lda copyArg ldy copyArg+1 jsr getarg lda zp ldy zp+1 sta copyInName sty copyInName+1 jsr copyFileToDir lda abortFlag bne copyToDirStopped inc copyArg bne + inc copyArg+1 + jmp - copyToDirExit = * rts copyToDirStopped = * lda #<stoppedMsg ldy #>stoppedMsg jsr eputs rts stoppedMsg = * .asc "<Stopped>" .byte chrCR,0 scanPos = 6 copyFileToDir = * ;** generate output file name jsr getLastArg ldy #0 - lda (zp),y beq + sta copyNameBuf,y iny bne - + tya tax ;** extract basename ldy #0 sty scanPos - lda (copyInName),y beq + cmp #":" bne basenameNext iny sty scanPos dey basenameNext = * iny bne - + ldy scanPos - lda (copyInName),y sta copyNameBuf,x beq + inx iny bne - ;** copy file + lda #<copyNameBuf ldy #>copyNameBuf sta copyOutName sty copyOutName+1 jsr copyToDirStatus jsr copyfile rts nameSpace .buf 1 copyToDirStatus = * lda copyInName ldy copyInName+1 jsr puts ldy #255 - iny lda (copyInName),y bne - tya - sec sbc #10 bcs - adc #10 sta nameSpace sta nameSpace sec lda #10 sbc nameSpace sta nameSpace - lda #" " jsr putchar dec nameSpace bne - lda copyOutName ldy copyOutName+1 jsr puts lda #chrCR jsr putchar rts ;===the end=== cpBss = * copyNameBuf = cpBss+0 cpEnd = cpBss+256 crc32.s 394 ;*** crc32b program - by Craig Bruce - 14-Oct-93 .seq acehead.s .org aceAppAddress .obj "@0:crc32b" jmp crcMain .byte aceID1,aceID2,aceID3 ;*** global declarations libwork = $40 chrCR = $0d chrQuote = $22 crcTable0 = * .byte $00,$96,$2c,$ba,$19,$8f,$35,$a3,$32,$a4,$1e,$88,$2b,$bd,$07,$91 .byte $64,$f2,$48,$de,$7d,$eb,$51,$c7,$56,$c0,$7a,$ec,$4f,$d9,$63,$f5 .byte $c8,$5e,$e4,$72,$d1,$47,$fd,$6b,$fa,$6c,$d6,$40,$e3,$75,$cf,$59 .byte $ac,$3a,$80,$16,$b5,$23,$99,$0f,$9e,$08,$b2,$24,$87,$11,$ab,$3d .byte $90,$06,$bc,$2a,$89,$1f,$a5,$33,$a2,$34,$8e,$18,$bb,$2d,$97,$01 .byte $f4,$62,$d8,$4e,$ed,$7b,$c1,$57,$c6,$50,$ea,$7c,$df,$49,$f3,$65 .byte $58,$ce,$74,$e2,$41,$d7,$6d,$fb,$6a,$fc,$46,$d0,$73,$e5,$5f,$c9 .byte $3c,$aa,$10,$86,$25,$b3,$09,$9f,$0e,$98,$22,$b4,$17,$81,$3b,$ad .byte $20,$b6,$0c,$9a,$39,$af,$15,$83,$12,$84,$3e,$a8,$0b,$9d,$27,$b1 .byte $44,$d2,$68,$fe,$5d,$cb,$71,$e7,$76,$e0,$5a,$cc,$6f,$f9,$43,$d5 .byte $e8,$7e,$c4,$52,$f1,$67,$dd,$4b,$da,$4c,$f6,$60,$c3,$55,$ef,$79 .byte $8c,$1a,$a0,$36,$95,$03,$b9,$2f,$be,$28,$92,$04,$a7,$31,$8b,$1d .byte $b0,$26,$9c,$0a,$a9,$3f,$85,$13,$82,$14,$ae,$38,$9b,$0d,$b7,$21 .byte $d4,$42,$f8,$6e,$cd,$5b,$e1,$77,$e6,$70,$ca,$5c,$ff,$69,$d3,$45 .byte $78,$ee,$54,$c2,$61,$f7,$4d,$db,$4a,$dc,$66,$f0,$53,$c5,$7f,$e9 .byte $1c,$8a,$30,$a6,$05,$93,$29,$bf,$2e,$b8,$02,$94,$37,$a1,$1b,$8d crcTable1 = * .byte $00,$30,$61,$51,$c4,$f4,$a5,$95,$88,$b8,$e9,$d9,$4c,$7c,$2d,$1d .byte $10,$20,$71,$41,$d4,$e4,$b5,$85,$98,$a8,$f9,$c9,$5c,$6c,$3d,$0d .byte $20,$10,$41,$71,$e4,$d4,$85,$b5,$a8,$98,$c9,$f9,$6c,$5c,$0d,$3d .byte $30,$00,$51,$61,$f4,$c4,$95,$a5,$b8,$88,$d9,$e9,$7c,$4c,$1d,$2d .byte $41,$71,$20,$10,$85,$b5,$e4,$d4,$c9,$f9,$a8,$98,$0d,$3d,$6c,$5c .byte $51,$61,$30,$00,$95,$a5,$f4,$c4,$d9,$e9,$b8,$88,$1d,$2d,$7c,$4c .byte $61,$51,$00,$30,$a5,$95,$c4,$f4,$e9,$d9,$88,$b8,$2d,$1d,$4c,$7c .byte $71,$41,$10,$20,$b5,$85,$d4,$e4,$f9,$c9,$98,$a8,$3d,$0d,$5c,$6c .byte $83,$b3,$e2,$d2,$47,$77,$26,$16,$0b,$3b,$6a,$5a,$cf,$ff,$ae,$9e .byte $93,$a3,$f2,$c2,$57,$67,$36,$06,$1b,$2b,$7a,$4a,$df,$ef,$be,$8e .byte $a3,$93,$c2,$f2,$67,$57,$06,$36,$2b,$1b,$4a,$7a,$ef,$df,$8e,$be .byte $b3,$83,$d2,$e2,$77,$47,$16,$26,$3b,$0b,$5a,$6a,$ff,$cf,$9e,$ae .byte $c2,$f2,$a3,$93,$06,$36,$67,$57,$4a,$7a,$2b,$1b,$8e,$be,$ef,$df .byte $d2,$e2,$b3,$83,$16,$26,$77,$47,$5a,$6a,$3b,$0b,$9e,$ae,$ff,$cf .byte $e2,$d2,$83,$b3,$26,$16,$47,$77,$6a,$5a,$0b,$3b,$ae,$9e,$cf,$ff .byte $f2,$c2,$93,$a3,$36,$06,$57,$67,$7a,$4a,$1b,$2b,$be,$8e,$df,$ef crcTable2 = * .byte $00,$07,$0e,$09,$6d,$6a,$63,$64,$db,$dc,$d5,$d2,$b6,$b1,$b8,$bf .byte $b7,$b0,$b9,$be,$da,$dd,$d4,$d3,$6c,$6b,$62,$65,$01,$06,$0f,$08 .byte $6e,$69,$60,$67,$03,$04,$0d,$0a,$b5,$b2,$bb,$bc,$d8,$df,$d6,$d1 .byte $d9,$de,$d7,$d0,$b4,$b3,$ba,$bd,$02,$05,$0c,$0b,$6f,$68,$61,$66 .byte $dc,$db,$d2,$d5,$b1,$b6,$bf,$b8,$07,$00,$09,$0e,$6a,$6d,$64,$63 .byte $6b,$6c,$65,$62,$06,$01,$08,$0f,$b0,$b7,$be,$b9,$dd,$da,$d3,$d4 .byte $b2,$b5,$bc,$bb,$df,$d8,$d1,$d6,$69,$6e,$67,$60,$04,$03,$0a,$0d .byte $05,$02,$0b,$0c,$68,$6f,$66,$61,$de,$d9,$d0,$d7,$b3,$b4,$bd,$ba .byte $b8,$bf,$b6,$b1,$d5,$d2,$db,$dc,$63,$64,$6d,$6a,$0e,$09,$00,$07 .byte $0f,$08,$01,$06,$62,$65,$6c,$6b,$d4,$d3,$da,$dd,$b9,$be,$b7,$b0 .byte $d6,$d1,$d8,$df,$bb,$bc,$b5,$b2,$0d,$0a,$03,$04,$60,$67,$6e,$69 .byte $61,$66,$6f,$68,$0c,$0b,$02,$05,$ba,$bd,$b4,$b3,$d7,$d0,$d9,$de .byte $64,$63,$6a,$6d,$09,$0e,$07,$00,$bf,$b8,$b1,$b6,$d2,$d5,$dc,$db .byte $d3,$d4,$dd,$da,$be,$b9,$b0,$b7,$08,$0f,$06,$01,$65,$62,$6b,$6c .byte $0a,$0d,$04,$03,$67,$60,$69,$6e,$d1,$d6,$df,$d8,$bc,$bb,$b2,$b5 .byte $bd,$ba,$b3,$b4,$d0,$d7,$de,$d9,$66,$61,$68,$6f,$0b,$0c,$05,$02 crcTable3 = * .byte $00,$77,$ee,$99,$07,$70,$e9,$9e,$0e,$79,$e0,$97,$09,$7e,$e7,$90 .byte $1d,$6a,$f3,$84,$1a,$6d,$f4,$83,$13,$64,$fd,$8a,$14,$63,$fa,$8d .byte $3b,$4c,$d5,$a2,$3c,$4b,$d2,$a5,$35,$42,$db,$ac,$32,$45,$dc,$ab .byte $26,$51,$c8,$bf,$21,$56,$cf,$b8,$28,$5f,$c6,$b1,$2f,$58,$c1,$b6 .byte $76,$01,$98,$ef,$71,$06,$9f,$e8,$78,$0f,$96,$e1,$7f,$08,$91,$e6 .byte $6b,$1c,$85,$f2,$6c,$1b,$82,$f5,$65,$12,$8b,$fc,$62,$15,$8c,$fb .byte $4d,$3a,$a3,$d4,$4a,$3d,$a4,$d3,$43,$34,$ad,$da,$44,$33,$aa,$dd .byte $50,$27,$be,$c9,$57,$20,$b9,$ce,$5e,$29,$b0,$c7,$59,$2e,$b7,$c0 .byte $ed,$9a,$03,$74,$ea,$9d,$04,$73,$e3,$94,$0d,$7a,$e4,$93,$0a,$7d .byte $f0,$87,$1e,$69,$f7,$80,$19,$6e,$fe,$89,$10,$67,$f9,$8e,$17,$60 .byte $d6,$a1,$38,$4f,$d1,$a6,$3f,$48,$d8,$af,$36,$41,$df,$a8,$31,$46 .byte $cb,$bc,$25,$52,$cc,$bb,$22,$55,$c5,$b2,$2b,$5c,$c2,$b5,$2c,$5b .byte $9b,$ec,$75,$02,$9c,$eb,$72,$05,$95,$e2,$7b,$0c,$92,$e5,$7c,$0b .byte $86,$f1,$68,$1f,$81,$f6,$6f,$18,$88,$ff,$66,$11,$8f,$f8,$61,$16 .byte $a0,$d7,$4e,$39,$a7,$d0,$49,$3e,$ae,$d9,$40,$37,$a9,$de,$47,$30 .byte $bd,$ca,$53,$24,$ba,$cd,$54,$23,$b3,$c4,$5d,$2a,$b4,$c3,$5a,$2d ;******** standard library ******** puts = * ldx #stdout fputs = * sta zp+0 sty zp+1 ldy #$ff - iny lda (zp),y bne - tya ldy #0 jmp write eputs = * ldx #stderr jmp fputs putchar = * ldx #stdout putc = * sta putcBuffer lda #<putcBuffer ldy #>putcBuffer sta zp+0 sty zp+1 lda #1 ldy #0 jmp write putcBuffer .buf 1 getchar = * ldx #stdin getc = * lda #<getcBuffer ldy #>getcBuffer sta zp+0 sty zp+1 lda #1 ldy #0 jsr read beq + lda getcBuffer rts + sec rts getcBuffer .buf 1 getarg = * sty zp+1 asl sta zp+0 rol zp+1 clc lda aceArgv adc zp+0 sta zp+0 lda aceArgv+1 adc zp+1 sta zp+1 ldy #0 lda (zp),y tax iny lda (zp),y stx zp+0 sta zp+1 rts ;===crc32=== crcArg = 2 crcName = 4 inBufLen = 6 crcMain = * ;** check argument count lda aceArgc+1 bne crcEnoughArgs lda aceArgc+0 cmp #2 bcs crcEnoughArgs crcUsage = * lda #<crcUsageMsg ldy #>crcUsageMsg jmp eputs crcUsageMsg = * .asc "Usage: crc32b file1 file2 ... fileN" .byte chrCR .byte 0 crcEnoughArgs = * ;** get input buffer length sec lda aceStackPtr+0 sbc #<crcInBuf sta inBufLen+0 lda aceStackPtr+1 sbc #>crcInBuf sta inBufLen+1 ;** main loop lda #1 ldy #0 sta crcArg+0 sty crcArg+1 - jsr stopkey bcs crcStopped lda crcArg+0 ldy crcArg+1 jsr getarg lda zp+0 ldy zp+1 sta crcName sty crcName+1 ora zp+1 beq crcExit jsr crc32 bcc + jsr crcError + inc crcArg+0 bne + inc crcArg+1 + jmp - crcExit = * rts crcStopped = * lda #<stoppedMsg ldy #>stoppedMsg jsr eputs rts stoppedMsg = * .asc "<Stopped>" .byte chrCR,0 crcError = * lda #<crcErrorMsg1 ldy #>crcErrorMsg1 jsr eputs lda crcName+0 ldy crcName+1 jsr eputs lda #<crcErrorMsg2 ldy #>crcErrorMsg2 jmp eputs crcErrorMsg1 = * .asc "Error reading file " .byte chrQuote,0 crcErrorMsg2 = * .byte chrQuote,chrCR,0 bufPtr = 8 bufCount = 10 infile = 12 crc32 = * ;** open file lda crcName+0 ldy crcName+1 sta zp+0 sty zp+1 lda #"r" jsr open bcc + rts + sta infile ;** encode file jsr crcBody ;** close file lda infile jsr close rts ch = 13 ;(1) crcAccum = 34 ;(4) crcTemp = 38 ;(4) crcBody = * ldx #3 lda #$ff - sta crcAccum,x dex bpl - lda #0 sta bufCount+0 sta bufCount+1 ;***scan file nextChar = * jsr getByte bcs crcPrint sta ch ;** crc = 0xFFFFFFFF; ;** while( (c=getc(fp)) != EOF ) { ;** crc = (crc>>8) & 0x00FFFFFF ^ crcTable[ (crc^c) & 0xFF ]; ;** } ;** return( crc^0xFFFFFFFF ); lda crcAccum+0 ;.X = (crc^c) & 0xFF eor ch tax lda crcAccum+1 ;crc = (crc>>8) & 0x00FFFFFF ^ crcTable[ .X ] eor crcTable0,x sta crcAccum+0 lda crcAccum+2 eor crcTable1,x sta crcAccum+1 lda crcAccum+3 eor crcTable2,x sta crcAccum+2 lda crcTable3,x sta crcAccum+3 jmp nextChar crcPrint = * lda #<resMsg1+8 ldy #>resMsg1+8 sta syswork+0 sty syswork+1 ldy #9 ldx #3 - lda crcAccum,x eor #$ff pha lsr lsr lsr lsr jsr putHex pla jsr putHex dex bpl - lda #<resMsg1 ldy #>resMsg1 jsr puts lda crcName+0 ldy crcName+1 jsr puts lda #<resMsg2 ldy #>resMsg2 jsr puts clc rts putHex = * and #$0f ora #$30 cmp #$3a bcc + adc #6 + sta resMsg1,y iny rts resMsg1 = * .asc "crc32b = 12345678 for " .byte chrQuote,0 resMsg2 = * .byte chrQuote,chrCR,0 getByte = * lda bufCount+0 ora bufCount+1 beq getByteFillBuf ldy #0 lda (bufPtr),y inc bufPtr bne + inc bufPtr+1 + ldx bufCount+0 bne + dec bufCount+1 + dec bufCount+0 clc rts getByteFillBuf = * lda #<crcInBuf ldy #>crcInBuf sta zp+0 sty zp+1 sta bufPtr+0 sty bufPtr+1 lda inBufLen+0 ldy inBufLen+1 ldx infile jsr read beq + bcs + sta bufCount+0 sty bufCount+1 jmp getByte + sec rts ;===the end=== crcBss = * crcInBuf = crcBss crc32a.s 308 ;*** crc32a program - by Craig Bruce .seq acehead.s .org aceAppAddress .obj "@0:crc32a" jmp crcMain .asc "cB" ;*** global declarations libwork = $40 chrCR = $0d chrQuote = $22 ;******** standard library ******** puts = * ldx #stdout fputs = * sta zp sty zp+1 ldy #$ff - iny lda (zp),y bne - tya ldy #0 jmp write eputs = * ldx #stderr jmp fputs putchar = * ldx #stdout putc = * sta putcBuffer lda #<putcBuffer ldy #>putcBuffer sta zp sty zp+1 lda #1 ldy #0 jmp write putcBuffer .buf 1 getchar = * ldx #stdin getc = * lda #<getcBuffer ldy #>getcBuffer sta zp sty zp+1 lda #1 ldy #0 jsr read beq + lda getcBuffer rts + sec rts getcBuffer .buf 1 getarg = * sty zp+1 asl sta zp rol zp+1 clc lda aceArgv adc zp sta zp lda aceArgv+1 adc zp+1 sta zp+1 ldy #0 lda (zp),y tax iny lda (zp),y stx zp sta zp+1 rts ;===crc32=== crcArg = 2 crcName = 4 inBufLen = 6 crcMain = * ;** check argument count lda aceArgc+1 bne crcEnoughArgs lda aceArgc cmp #2 bcs crcEnoughArgs crcUsage = * lda #<crcUsageMsg ldy #>crcUsageMsg jmp eputs crcUsageMsg = * .asc "Usage: crc32 file1 file2 ... fileN" .byte chrCR .byte 0 crcEnoughArgs = * ;** get input buffer length sec lda aceStackPtr sbc #<crcInBuf sta inBufLen lda aceStackPtr+1 sbc #>crcInBuf sta inBufLen+1 ;** main loop lda #1 ldy #0 sta crcArg sty crcArg+1 - jsr stopkey bcs crcStopped lda crcArg ldy crcArg+1 jsr getarg lda zp ldy zp+1 sta crcName sty crcName+1 ora zp+1 beq crcExit jsr crc32 bcc + jsr crcError + inc crcArg bne + inc crcArg+1 + jmp - crcExit = * rts crcStopped = * lda #<stoppedMsg ldy #>stoppedMsg jsr eputs rts stoppedMsg = * .asc "<Stopped>" .byte chrCR,0 crcError = * lda #<crcErrorMsg1 ldy #>crcErrorMsg1 jsr eputs lda crcName ldy crcName+1 jsr eputs lda #<crcErrorMsg2 ldy #>crcErrorMsg2 jmp eputs crcErrorMsg1 = * .asc "Error reading file " .byte chrQuote,0 crcErrorMsg2 = * .byte chrQuote,chrCR,0 bufPtr = 8 bufCount = 10 infile = 12 crc32 = * ;** open file lda crcName ldy crcName+1 sta zp sty zp+1 lda #"r" jsr open bcc + rts + sta infile ;** encode file jsr crcBody ;** close file lda infile jsr close rts ;crc32 version 1.0 for the C-128 and C-64 by Craig Bruce 23-May-92 ch = 13 ;(1) crcAccum = 34 ;(4) crcLow = $b7 crcMid1 = $1d crcMid2 = $c1 crcHigh = $04 crcBody = * ldx #3 lda #0 - sta crcAccum,x dex bpl - sta bufCount sta bufCount+1 ;***scan file nextChar = * jsr getByte bcs crcPrint sta ch ldx #8 nextBit = * asl ch rol crcAccum+0 rol crcAccum+1 rol crcAccum+2 rol crcAccum+3 bcc + lda crcAccum+0 eor #crcLow sta crcAccum+0 lda crcAccum+1 eor #crcMid1 sta crcAccum+1 lda crcAccum+2 eor #crcMid2 sta crcAccum+2 lda crcAccum+3 eor #crcHigh sta crcAccum+3 + dex bne nextBit jmp nextChar crcPrint = * lda #<resMsg1+9 ldy #>resMsg1+9 sta syswork+0 sty syswork+1 ldx #crcAccum lda #10 jsr utoa lda #" " sta resMsg1+19 lda #<resMsg1 ldy #>resMsg1 jsr puts lda crcName ldy crcName+1 jsr puts lda #<resMsg2 ldy #>resMsg2 jsr puts clc rts resMsg1 = * .asc "crc32a = 1234567890 for " .byte chrQuote,0 resMsg2 = * .byte chrQuote,chrCR,0 getByte = * lda bufCount ora bufCount+1 beq getByteFillBuf ldy #0 lda (bufPtr),y inc bufPtr bne + inc bufPtr+1 + ldx bufCount bne + dec bufCount+1 + dec bufCount clc rts getByteFillBuf = * lda #<crcInBuf ldy #>crcInBuf sta zp sty zp+1 sta bufPtr sty bufPtr+1 lda inBufLen ldy inBufLen+1 ldx infile jsr read beq + bcs + sta bufCount sty bufCount+1 jmp getByte + sec rts ;===the end=== crcBss = * crcInBuf = crcBss date.s 58 ;date program .seq acehead.s .org aceAppAddress .obj "@:date" jmp main .asc "cB" main = * lda #<dateBuf ldy #>dateBuf jsr getdate ldy #7 - lda dateBuf,y jsr getasc pha txa ldx dateNumFields,y sta dateNum+1,x pla sta dateNum,x dey bpl - lda #13 sta dateNum+21 lda #<dateNum ldy #>dateNum sta zp sty zp+1 lda #22 ldy #0 ldx #stdout jmp write getasc = * ;( .A=bcd ) : .A=aschi, .X=asclo pha and #$0f ora #$30 tax pla lsr lsr lsr lsr ora #$30 rts dateNum = * ;0123456789012345678901 .asc "1993/05/16-18:04:50.3z" dateNumFields = * .byte 0,2,5,8,11,14,17,20 dateStr = * ;0123456789012345678901234567 .asc "Sun-16-May-1993 06:03:50 pm" .byte 0 dateBuf = * eighty.s 10 .seq acehead.s .org aceAppAddress .obj "@0:eighty" jmp main .asc "cB" main = * lda #80 jmp conscreen fast.s 14 .seq acehead.s .org aceAppAddress .obj "@0:fast" jmp main .asc "cB" main = * lda $d011 and #%11101111 sta $d011 lda #$01 sta $d030 rts forty.s 10 .seq acehead.s .org aceAppAddress .obj "@0:forty" jmp main .asc "cB" main = * lda #40 jmp conscreen grep.s 507 ;*** grep program .seq acehead.s .org aceAppAddress .obj "@0:grep" jmp grepMain .asc "cB" ;*** global declarations libwork = $40 chrCR = $0d chrQuote = $22 maxLineLen = 2049 inverseFlag .buf 1 ignoreCaseFlag .buf 1 displayFilenameFlag .buf 1 anchorLeftFlag .buf 1 anchorRightFlag .buf 1 stringLen .buf 1 ;******** standard library ******** puts = * ldx #stdout fputs = * sta zp sty zp+1 ldy #$ff - iny lda (zp),y bne - tya ldy #0 jmp write eputs = * ldx #stderr jmp fputs putchar = * ldx #stdout putc = * sta putcBuffer lda #<putcBuffer ldy #>putcBuffer sta zp sty zp+1 lda #1 ldy #0 jmp write putcBuffer .buf 1 getchar = * ldx #stdin getc = * lda #<getcBuffer ldy #>getcBuffer sta zp sty zp+1 lda #1 ldy #0 jsr read beq + lda getcBuffer rts + sec rts getcBuffer .buf 1 getarg = * sty zp+1 asl sta zp rol zp+1 clc lda aceArgv adc zp sta zp lda aceArgv+1 adc zp+1 sta zp+1 ldy #0 lda (zp),y tax iny lda (zp),y stx zp sta zp+1 rts ;===grep=== grepArg = 2 grepName = 4 inBufLen = 6 grepString = 8 grepMain = * ;** check argument count lda #0 sta inverseFlag sta ignoreCaseFlag sta displayFilenameFlag sta anchorLeftFlag sta anchorRightFlag lda aceArgc+1 bne grepEnoughArgs lda aceArgc cmp #3 bcs grepEnoughArgs grepUsage = * lda #<grepUsageMsg ldy #>grepUsageMsg jmp eputs grepUsageMsg = * .asc "usage: grep [-[i][v]] [^]substr[$] files" .byte chrCR,0 grepEnoughArgs = * ;** get input buffer length sec lda aceStackPtr sbc #<grepInBuf sta inBufLen lda aceStackPtr+1 sbc #>grepInBuf sta inBufLen+1 ;** main loop lda #1 ldy #0 sta grepArg sty grepArg+1 jsr getarg ldy #0 lda (zp),y cmp #"-" bne substrArg inc grepArg - iny lda (zp),y beq substrArg cmp #"i" bne + lda #$ff sta ignoreCaseFlag + cmp #"v" bne + lda #$ff sta inverseFlag + jmp - substrArg = * lda grepArg ldy #0 jsr getarg lda zp ldy zp+1 sta grepString sty grepString+1 bit ignoreCaseFlag bpl + jsr foldString + jsr checkAnchors inc grepArg firstArg = * lda grepArg ldy #0 jsr getarg lda zp ora zp+1 bne + jmp grepUsage + clc lda grepArg adc #1 ldy #0 jsr getarg lda zp ora zp+1 beq nextArg lda #$ff sta displayFilenameFlag nextArg = * jsr stopkey bcs grepStopped lda grepArg ldy grepArg+1 jsr getarg lda zp ldy zp+1 sta grepName sty grepName+1 ora zp+1 beq grepExit jsr grep bcc + jsr grepError + inc grepArg bne + inc grepArg+1 + jmp nextArg grepExit = * rts foldString = * ldy #0 - lda (grepString),y bne + rts + cmp #"A" bcc + cmp #"Z"+1 bcs + sec sbc #"A"-"a" sta (grepString),y + iny bne - rts checkAnchors = * ldy #0 lda (grepString),y cmp #"^" bne + lda #$ff sta anchorLeftFlag inc grepString bne + inc grepString+1 + ldy #255 - iny lda (grepString),y bne - sty stringLen dey cpy #255 beq + lda (grepString),y cmp #"$" bne + lda #$ff sta anchorRightFlag lda #0 sta (grepString),y sty stringLen + rts grepStopped = * lda #<stoppedMsg ldy #>stoppedMsg jsr eputs rts stoppedMsg = * .asc "<Stopped>" .byte chrCR,0 grepError = * lda #<grepErrorMsg1 ldy #>grepErrorMsg1 jsr eputs lda grepName ldy grepName+1 jsr eputs lda #<grepErrorMsg2 ldy #>grepErrorMsg2 jmp eputs grepErrorMsg1 = * .asc "Error reading file " .byte chrQuote,0 grepErrorMsg2 = * .byte chrQuote,chrCR,0 bufPtr = 10 bufCount = 12 infile = 14 grep = * ;** open file lda grepName ldy grepName+1 sta zp sty zp+1 lda #"r" jsr open bcc + rts + sta infile ;** encode file jsr grepBody ;** close file lda infile jsr close rts lineLen = $40 ;(2) linePtr = $42 ;(2) grepBody = * lda #0 sta bufCount sta bufCount+1 - jsr getline bcc + rts + jsr checkLine bit inverseFlag bmi + bcc - jsr writeLine jmp - + bcs - jsr writeLine jmp - lineReset = $44 ;(2) stringPos = $46 ;(1) checkLine = * ;() : .CC=no_match, .CS=match bit anchorRightFlag bpl checkSubstr clc lda linePtr adc lineLen sta linePtr lda linePtr+1 adc lineLen+1 sta linePtr+1 sec lda linePtr sbc stringLen sta linePtr lda linePtr+1 sbc #0 sta linePtr+1 checkSubstr = * lda linePtr ldy linePtr+1 sta lineReset sty lineReset+1 inc lineReset bne + inc lineReset+1 + ldy #0 sty stringPos checkChar = * + ldy stringPos lda (grepString),y beq endOfString ldy #0 cmp (linePtr),y bne mismatch - inc stringPos inc linePtr bne + inc linePtr+1 + jmp checkChar mismatch = * ldy #0 lda (linePtr),y beq endOfLine bit ignoreCaseFlag bpl + cmp #"A" bcc + cmp #"Z"+1 bcs + sec sbc #"A"-"a" ldy stringPos cmp (grepString),y beq - + lda lineReset ldy lineReset+1 sta linePtr sty linePtr+1 jmp checkSubstr endOfLine = * clc rts endOfString = * bit anchorLeftFlag bmi + sec rts + lda lineReset bne + dec lineReset+1 + dec lineReset lda lineReset cmp #<grepLine bne endOfLine lda lineReset+1 cmp #>grepLine bne endOfLine sec rts writeLine = * lda displayFilenameFlag beq + lda grepName ldy grepName+1 jsr puts lda #":" jsr putchar + lda #<grepLine ldy #>grepLine sta zp sty zp+1 lda lineLen ldy lineLen+1 ldx #stdout jsr write lda #chrCR jsr putchar rts getline = * ;() : lineLen, linePtr ;** ignores chars beyond max line len, ignores last line not ending in CR, ;** line ends with \0 lda #0 sta lineLen sta lineLen+1 lda #<grepLine ldy #>grepLine sta linePtr sty linePtr+1 - jsr getByte bcc + rts + cmp #chrCR bne + lda #0 ldy #0 sta (linePtr),y lda #<grepLine ldy #>grepLine sta linePtr sty linePtr+1 clc rts + ldx lineLen+1 cpx #>maxLineLen bcs - ldy #0 sta (linePtr),y inc linePtr bne + inc linePtr+1 + inc lineLen bne + inc lineLen+1 + jmp - getByte = * lda bufCount ora bufCount+1 beq getByteFillBuf ldy #0 lda (bufPtr),y inc bufPtr bne + inc bufPtr+1 + ldx bufCount bne + dec bufCount+1 + dec bufCount clc rts getByteFillBuf = * lda #<grepInBuf ldy #>grepInBuf sta zp sty zp+1 sta bufPtr sty bufPtr+1 lda inBufLen ldy inBufLen+1 ldx infile jsr read beq + bcs + sta bufCount sty bufCount+1 jmp getByte + sec rts ;===the end=== grepBss = * grepLine = grepBss grepInBuf = grepLine+maxLineLen inc.s 20 .seq acehead.s .org aceAppAddress .obj "@0:inc" jmp main .asc "cB" main = * lda #15 ldx #255 ldy #0 - inc $d020 iny bne - dex bne - sec sbc #1 bcs - rts mem.s 190 .seq acehead.s .org aceAppAddress .obj "@:mem" jmp main .asc "cB" rep = 4 main = * lda #<processMsg ldy #>processMsg jsr puts lda aceProcessID ora #$30 jsr chrout lda #13 jsr chrout jsr printFreemap jsr displayFree jsr displayTPA rts processMsg = * .asc "ProcessID=" .byte 0 displayFree = * lda #<freeMsg ldy #>freeMsg jsr puts lda #<numbuf ldy #>numbuf sta syswork+0 sty syswork+1 lda #10 ldx #$40 jsr utoa ldx #0 - lda numbuf,x beq + jsr chrout inx bne - + lda #13 jsr chrout rts freeMsg = * .asc "Dynamic Free =" .byte 0 numbuf .buf 12 displayTPA = * lda #<tpaFree ldy #>tpaFree jsr puts lda #<numbuf ldy #>numbuf sta syswork+0 sty syswork+1 lda #0 sta 6 sta 7 sec lda aceStackPtr+0 sbc #<aceAppAddress sta 4 lda aceStackPtr+1 sbc #>aceAppAddress sta 5 lda #10 ldx #4 jsr utoa ldx #0 - lda numbuf,x beq + jsr chrout inx bne - + lda #13 jsr chrout rts tpaFree = * .asc "Program Free =" .byte 0 freemap = 2 printFreemap = * lda aceRam0Freemap+0 ldy aceRam0Freemap+1 iny ;freemap sta freemap+0 sty freemap+1 ldy #0 - ldx #"." lda (freemap),y beq + ldx #"*" cmp #$ff beq + ldx #"#" cmp #$fe beq + ldx #"+" + txa jsr chrout iny bne - lda #13 jsr chrout ldx #3 - lda aceFreeMemory,x sta $40,x dex bpl - rts printZp = * ldx #3 - lda zp,x jsr printHex dex bpl - lda #13 jsr chrout rts printHex = * pha lsr lsr lsr lsr jsr printHexit pla and #$0f printHexit = * ora #$30 cmp #$3a bcc + adc #6 + jsr chrout rts chrout = * stx saver+0 sty saver+1 sta char lda zp pha lda zp+1 pha lda #<char ldy #>char sta zp sty zp+1 lda #1 ldy #0 ldx #1 jsr write pla sta zp+1 pla sta zp lda char ldx saver+0 ldy saver+1 rts char .buf 1 saver .buf 2 puts = * ldx #stdout fputs = * sta zp sty zp+1 ldy #$ff - iny lda (zp),y bne - tya ldy #0 jmp write eputs = * ldx #stderr jmp fputs mv.s 223 ;*** mv (rename) program .seq acehead.s .org aceAppAddress .obj "@0:mv" jmp main .byte aceID1,aceID2,aceID3 ;*** global declarations chrCR = $0d chrQuote = $22 ;******** standard library ******** puts = * ldx #stdout fputs = * sta zp+0 sty zp+1 ldy #$ff - iny lda (zp),y bne - tya ldy #0 jmp write eputs = * ldx #stderr jmp fputs putchar = * ldx #stdout putc = * sta putcBuffer lda #<putcBuffer ldy #>putcBuffer sta zp+0 sty zp+1 lda #1 ldy #0 jmp write putcBuffer .buf 1 getchar = * ldx #stdin getc = * lda #<getcBuffer ldy #>getcBuffer sta zp+0 sty zp+1 lda #1 ldy #0 jsr read beq + lda getcBuffer rts + sec rts getcBuffer .buf 1 getarg = * sty zp+1 asl sta zp+0 rol zp+1 clc lda aceArgv adc zp+0 sta zp+0 lda aceArgv+1 adc zp+1 sta zp+1 ldy #0 lda (zp),y tax iny lda (zp),y stx zp+0 sta zp+1 rts ;===rename=== arg = 2 oldname = 4 newname = 6 main = * ;** check argument count lda aceArgc+1 bne enoughArgs lda aceArgc+0 cmp #3 bcs enoughArgs usage = * lda #<usageMsg ldy #>usageMsg jmp puts usageMsg = * .asc "Usage: mv oldname newname ..." .byte chrCR .asc " where ... means repeat names in old/new pairs" .byte chrCR,0 enoughArgs = * lda #1 ldy #0 sta arg+0 sty arg+1 mainNext = * lda arg+0 ldy arg+1 jsr getarg lda zp+0 ldy zp+1 sta oldname+0 sty oldname+1 ora zp+1 beq mainExit inc arg+0 bne + inc arg+1 + lda arg+0 ldy arg+1 jsr getarg lda zp+0 ldy zp+1 sta newname+0 sty newname+1 ora zp+1 beq mainExit jsr checkstop jsr echo lda oldname+0 ldy oldname+1 sta zp+0 sty zp+1 lda newname+0 ldy newname+1 sta zw+0 sty zw+1 jsr rename bcc + jsr error + inc arg+0 bne + inc arg+1 + jmp mainNext mainExit = * rts checkstop = * jsr stopkey bcs + rts + lda #<stoppedMsg ldy #>stoppedMsg jsr eputs lda #1 ldx #0 jmp exit stoppedMsg = * .asc "<stopped>" .byte chrCR,0 error = * lda #<errorMsg1 ldy #>errorMsg1 jsr eputs lda oldname+0 ldy oldname+1 jsr eputs lda #<errorMsg2 ldy #>errorMsg2 jmp eputs errorMsg1 = * .asc "Error attempting to rename " .byte chrQuote,0 errorMsg2 = * .byte chrQuote,chrCR,0 echo = * lda #<echoMsg1 ldy #>echoMsg1 jsr eputs lda oldname+0 ldy oldname+1 jsr eputs lda #<echoMsg2 ldy #>echoMsg2 jsr eputs lda newname+0 ldy newname+1 jsr eputs lda #<echoMsg3 ldy #>echoMsg3 jsr eputs rts echoMsg1 = * .asc "Renaming file " .byte chrQuote,0 echoMsg2 = * .byte chrQuote .asc " to " .byte chrQuote,0 echoMsg3 = * .byte chrQuote,chrCR,0 ;===the end=== bss = * bssEnd = bss+0 read.s 282 ;*** file reader program .seq acehead.s .org aceAppAddress .obj "@:read" jmp crcMain .asc "cB" ;*** global declarations libwork = $40 chrCR = $0d chrQuote = $22 ;******** standard library ******** puts = * ldx #stdout fputs = * sta zp sty zp+1 ldy #$ff - iny lda (zp),y bne - tya ldy #0 jmp write eputs = * ldx #stderr jmp fputs putchar = * ldx #stdout putc = * sta putcBuffer lda #<putcBuffer ldy #>putcBuffer sta zp sty zp+1 lda #1 ldy #0 jmp write putcBuffer .buf 1 getchar = * ldx #stdin getc = * lda #<getcBuffer ldy #>getcBuffer sta zp sty zp+1 lda #1 ldy #0 jsr read beq + lda getcBuffer rts + sec rts getcBuffer .buf 1 getarg = * sty zp+1 asl sta zp rol zp+1 clc lda aceArgv adc zp sta zp lda aceArgv+1 adc zp+1 sta zp+1 ldy #0 lda (zp),y tax iny lda (zp),y stx zp sta zp+1 rts itoaBin = libwork ;(4) itoaBcd = libwork+4 ;(5) itoaFlag = libwork+9 ;(1) itoaNumber .buf 11 itoa = * ;( .X=numZpaddr ) : itoaNumber ldy #0 - lda 0,x sta itoaBin,y inx iny cpy #4 bcc - ldx #5 lda #0 - sta itoaBcd,x ;zeros "itoaFlag" too dex bpl - ldy #32 sei sed itoaNextBit = * asl itoaBin+0 rol itoaBin+1 rol itoaBin+2 rol itoaBin+3 ldx #4 - lda itoaBcd,x adc itoaBcd,x sta itoaBcd,x dex bpl - dey bne itoaNextBit cld cli ldx #0 ldy #0 - lda itoaBcd,x jsr itoaPutHex inx cpx #5 bcc - lda #0 sta itoaNumber,y rts itoaPutHex = * pha lsr lsr lsr lsr jsr itoaPutDigit pla and #$0f itoaPutDigit = * cmp itoaFlag bne + cpy #7 bcs + lda #$20 bne itoaPoke + ora #$30 sta itoaFlag itoaPoke = * sta itoaNumber,y iny rts ;===crc32=== crcArg = 2 crcName = 4 inBufLen = 6 crcMain = * ;** check argument count lda aceArgc+1 bne crcEnoughArgs lda aceArgc cmp #2 bcs crcEnoughArgs crcUsage = * lda #<crcUsageMsg ldy #>crcUsageMsg jmp eputs crcUsageMsg = * .asc "usage: read file1 file2 ... fileN" .byte chrCR .byte 0 crcEnoughArgs = * ;** get input buffer length sec lda aceStackPtr sbc #<crcInBuf sta inBufLen lda aceStackPtr+1 sbc #>crcInBuf sta inBufLen+1 ;** main loop lda #1 ldy #0 sta crcArg sty crcArg+1 - jsr stopkey bcs crcStopped lda crcArg ldy crcArg+1 jsr getarg lda zp ldy zp+1 sta crcName sty crcName+1 ora zp+1 beq crcExit jsr doRead bcc + jsr crcError + inc crcArg bne + inc crcArg+1 + jmp - crcExit = * rts crcStopped = * lda #<stoppedMsg ldy #>stoppedMsg jsr eputs rts stoppedMsg = * .asc "<Stopped>" .byte chrCR,0 crcError = * lda #<crcErrorMsg1 ldy #>crcErrorMsg1 jsr eputs lda crcName ldy crcName+1 jsr eputs lda #<crcErrorMsg2 ldy #>crcErrorMsg2 jmp eputs crcErrorMsg1 = * .asc "Error reading file " .byte chrQuote,0 crcErrorMsg2 = * .byte chrQuote,chrCR,0 bufPtr = 8 bufCount = 10 infile = 12 doRead = * ;** open file lda crcName ldy crcName+1 sta zp sty zp+1 lda #"r" jsr open bcc + rts + sta infile ;** read file jsr readBody ;** close file lda infile jsr close rts readBody = * lda #<crcInBuf ldy #>crcInBuf sta zp sty zp+1 lda inBufLen+0 ldy inBufLen+1 ldx infile jsr read beq + bcs + jmp readBody + sec rts ;===the end=== crcBss = * crcInBuf = crcBss rm.s 190 ;*** rm program .seq acehead.s .org aceAppAddress .obj "@0:rm" jmp removeMain .asc "cB" ;*** global declarations libwork = $60 chrCR = $0d chrQuote = $22 ;******** standard library ******** puts = * ldx #stdout fputs = * sta zp sty zp+1 ldy #$ff - iny lda (zp),y bne - tya ldy #0 jmp write eputs = * ldx #stderr jmp fputs putchar = * ldx #stdout putc = * sta putcBuffer lda #<putcBuffer ldy #>putcBuffer sta zp sty zp+1 lda #1 ldy #0 jmp write putcBuffer .buf 1 getchar = * ldx #stdin getc = * lda #<getcBuffer ldy #>getcBuffer sta zp sty zp+1 lda #1 ldy #0 jsr read beq + lda getcBuffer rts + sec rts getcBuffer .buf 1 ;===remove library=== getarg = * sty zp+1 asl sta zp rol zp+1 clc lda aceArgv adc zp sta zp lda aceArgv+1 adc zp+1 sta zp+1 ldy #0 lda (zp),y tax iny lda (zp),y stx zp sta zp+1 rts ;===remove=== rmArg = 2 rmName = 4 removeMain = * ;** check argument count lda aceArgc+1 bne rmEnoughArgs lda aceArgc cmp #2 bcs rmEnoughArgs rmUsage = * lda #<rmUsageMsg ldy #>rmUsageMsg jmp puts rmUsageMsg = * .asc "Usage: rm file1 file2 ... fileN" .byte chrCR .byte 0 rmEnoughArgs = * lda #1 ldy #0 sta rmArg sty rmArg+1 - lda rmArg ldy rmArg+1 jsr getarg lda zp ldy zp+1 sta rmName sty rmName+1 ora zp+1 beq rmExit jsr stopkey bcs stopped jsr rmEcho lda rmName ldy rmName+1 sta zp sty zp+1 jsr remove bcc + jsr rmError + inc rmArg bne + inc rmArg+1 + jmp - rmExit = * rts stopped = * lda #<stoppedMsg ldy #>stoppedMsg jmp eputs stoppedMsg = * .asc "<stopped>" .byte chrCR,0 rmError = * lda #<rmErrorMsg1 ldy #>rmErrorMsg1 jsr eputs lda rmName ldy rmName+1 jsr eputs lda #<rmErrorMsg2 ldy #>rmErrorMsg2 jmp eputs rmErrorMsg1 = * .asc "Error attempting to remove " .byte chrQuote .byte 0 rmErrorMsg2 = * .byte chrQuote .byte chrCR .byte 0 rmEcho = * lda #<rmEchoMsg1 ldy #>rmEchoMsg1 jsr eputs lda rmName ldy rmName+1 jsr eputs lda #<rmEchoMsg2 ldy #>rmEchoMsg2 jmp eputs rmEchoMsg1 = * .asc "Removing file " .byte chrQuote,0 rmEchoMsg2 = * .byte chrQuote .asc "..." .byte chrCR,0 ;===the end=== rmEnd = * sh.s 1674 ;ACE command shell by Craig Bruce .seq acehead.s .org aceShellAddress .obj "@0:sh" jmp main .byte "s","H",aceID3 libwork = $60 chrCR = 13 chrQuote = 34 chrTab = 9 shellRedirectStdin .buf 1 shellRedirectStdout .buf 1 shellRedirectStderr .buf 1 parseArgc .buf 2 shellExitFlag .buf 1 shellPromptFlag .buf 1 checkPromptFlag .buf 1 suppressPromptFlag .buf 1 abortCommandFlag .buf 1 regsave .buf 3 ;******** standard library ******** eputs = * ldx #stderr jmp fputs puts = * ldx #stdout fputs = * sta zp+0 sty zp+1 ldy #$ff - iny lda (zp),y bne - tya ldy #0 jmp write putchar = * ldx #stdout putc = * sta putcBuffer lda #<putcBuffer ldy #>putcBuffer sta zp+0 sty zp+1 lda #1 ldy #0 jmp write putcBuffer .buf 1 getchar = * ldx #stdin getc = * lda #<getcBuffer ldy #>getcBuffer sta zp+0 sty zp+1 lda #1 ldy #0 jsr read beq + lda getcBuffer rts + sec rts getcBuffer .buf 1 cls = * lda #147 jmp putchar itoaBin = libwork itoaNumber .buf 11 itoa = * jsr itoaPrepare jmp utoa itoaStrip = * jsr itoaPrepare lda #1 jmp utoa itoaPrepare = * sta itoaBin+0 sty itoaBin+1 stx itoaBin+2 lda #0 sta itoaBin+3 lda #<itoaNumber ldy #>itoaNumber sta syswork+0 sty syswork+1 lda #8 ldx #itoaBin rts zsp = libwork pushAY = * tax sec lda aceStackPtr+0 sbc #2 sta aceStackPtr+0 sta zsp lda aceStackPtr+1 sbc #0 sta aceStackPtr+1 sta zsp+1 tya ldy #1 sta (zsp),y dey txa sta (zsp),y rts ;******** shell ******** ;ComShell main = * lda #<shellTitle ldy #>shellTitle jsr puts jmp shell shellTitle .asc "ACE Shell vers 0.54.00 - CSB 25-Nov-93" .byte chrCR,chrCR .byte 0 shell = * lda #$ff sta checkPromptFlag sta shellRedirectStdin sta shellRedirectStdout sta shellRedirectStderr lda #0 sta suppressPromptFlag getCommand = * lda #0 sta abortCommandFlag lda checkPromptFlag beq + jsr shellCheckPromptability + lda shellPromptFlag beq + lda suppressPromptFlag bne + lda #"[" ldx #stderr jsr putc lda aceCurDirName+0 ldy aceCurDirName+1 jsr eputs lda #<shellReady2 ldy #>shellReady2 jsr eputs + lda #0 sta suppressPromptFlag sta shellExitFlag jsr shellGetArgs bcs shellFinish lda parseArgc+0 ora parseArgc+1 beq + lda abortCommandFlag bne + jsr setupRedirects jsr shellConstructFrame jsr shellExecCommand jsr shellRemoveFrame jsr unsetRedirects + jsr closeRedirects bit shellExitFlag bmi shellFinish jmp getCommand shellFinish = * rts shellReady2 .asc "] " .byte 0 shellCheckPromptability = * ldx #0 jsr devinfo ldx #$ff cmp #0 beq + ldx #0 + stx shellPromptFlag lda #0 sta checkPromptFlag rts ;=== command parsing === argPtr = $02 argQuote = $03 argWasQuoted = $04 shellGetArgs = * lda #0 sta parseArgc+0 sta parseArgc+1 newarg = * jsr getchar bcc + jmp argEof + cmp #" " beq newarg cmp #chrTab beq newarg cmp #chrCR bne + jmp argEndOfLine + cmp #";" bne + lda #$ff sta suppressPromptFlag jmp argEndOfLine + ldx #0 stx argPtr stx argWasQuoted argNewQuote = * ldx #0 stx argQuote cmp #$22 beq argStartQuote cmp #"'" bne + argStartQuote = * sta argQuote sta argWasQuoted jmp argNextChar + ldx argPtr sta argBuffer,x inc argPtr argNextChar = * jsr getchar bcs argEof ldx argQuote bne argQuoteMode cmp #" " beq argProcess cmp #chrTab beq argProcess - cmp #";" bne + ldx argWasQuoted bne + lda #$ff sta suppressPromptFlag lda #chrCR + cmp #chrCR beq argProcess ldx argPtr sta argBuffer,x inc argPtr jmp argNextChar argQuoteMode = * cmp #0 beq - cmp argQuote bne - jsr getchar bcs argEof cmp #" " beq argProcess cmp #chrTab beq argProcess cmp #chrCR beq argProcess jmp argNewQuote argProcess = * pha ldx argPtr lda #0 sta argBuffer,x jsr shellHandleArg pla cmp #chrCR beq argEndOfLine jmp newarg argEndOfLine = * clc argEof = * rts shellHandleArg = * lda abortCommandFlag beq + rts + lda argWasQuoted bne + ldx #stdin ldy #"r" lda argBuffer cmp #"<" beq shellHandleRedirect ldx #stdout ldy #"w" cmp #">" beq shellHandleRedirect jsr checkWildcards bcc + rts + jsr shellStoreArg rts shellStoreArg = * lda aceStackPtr+0 ldy aceStackPtr+1 clc sbc argPtr bcs + dey + sta aceStackPtr+0 sty aceStackPtr+1 sta zp+0 sty zp+1 ldy #0 - lda argBuffer,y sta (zp),y beq + iny bne - + lda parseArgc+1 sta zp+1 lda parseArgc+0 asl rol zp+1 clc adc #<argArgvBuffer sta zp+0 lda zp+1 adc #>argArgvBuffer sta zp+1 ldy #0 lda aceStackPtr+0 sta (zp),y iny lda aceStackPtr+1 sta (zp),y inc parseArgc+0 bne + inc parseArgc+1 + rts shellHandleRedirect = * ;( .X=fd, .Y=mode ) lda #<argBuffer+1 sta zp lda #>argBuffer+1 sta zp+1 lda argBuffer+1 cmp #">" bne + jsr shellRedirInc ldy #"a" lda argBuffer+2 + cmp #"!" bne + - ldx #stderr jsr shellRedirInc lda #0 + cmp #"&" beq - lda shellRedirectStdin,x cmp #255 bne redirectMultiError tya stx cmdBuffer sta regsave - jsr open bcc ++ lda errno cmp #aceErrFileExists bne + jsr remove bcs redirectError lda regsave jmp - + cmp #aceErrFileNotFound bne redirectError lda regsave cmp #"a" bne redirectError lda #"w" sta regsave jmp - + ldx cmdBuffer sta shellRedirectStdin,x rts redirectError = * lda #<redirectErrorMsg ldy #>redirectErrorMsg redirectErrorWmsg = * pha tya pha lda #$ff sta abortCommandFlag lda zp+0 ldy zp+1 jsr eputs pla tay pla jsr eputs rts redirectErrorMsg = * .asc ": Error opening redirection file." .byte chrCR,0 redirectMultiError = * lda #<redirectMultiErrorMsg ldy #>redirectMultiErrorMsg jmp redirectErrorWmsg redirectMultiErrorMsg = * .asc ": Error - Multiple redirections of same stream." .byte chrCR,0 shellRedirInc = * inc zp+0 bne + inc zp+1 + rts shellSetupRed = 2 setupRedirects = * unsetRedirects = * ldx #0 stx shellSetupRed - lda shellRedirectStdin,x cmp #255 beq + tay jsr fcbswap + inc shellSetupRed ldx shellSetupRed cpx #3 bcc - rts shellCloseRed = 2 closeRedirects = * ldx #0 stx shellCloseRed - lda shellRedirectStdin,x cmp #$ff beq + jsr close ldx shellCloseRed lda #$ff sta shellRedirectStdin,x + inc shellCloseRed ldx shellCloseRed cpx #3 bcc - rts wildPrefix = 10 wildSuffix = 11 checkWildcards = * lda #255 sta wildPrefix sta wildSuffix ldx argPtr - dex cpx #255 beq + lda argBuffer,x cmp #":" beq + cmp #"*" bne - ldy wildSuffix cpy #255 bne - stx wildSuffix inc wildSuffix jmp - + inx stx wildPrefix lda wildSuffix cmp #255 bne + clc rts + jsr handleWildcards sec rts wildLength = 12 wildSuffixLength = 13 wildFcb = 14 wildMatch = 15 handleWildcards = * lda #0 sta wildMatch ldx argPtr inx - dex lda argBuffer,x sta cmdBuffer+1,x cpx wildPrefix bne - lda #0 sta cmdBuffer,x sta argBuffer,x ldx wildSuffix sta cmdBuffer,x inc wildPrefix inc wildSuffix ldx #0 - lda argBuffer,x beq + sta cmdBuffer,x inx bne - + sec lda argPtr sbc wildSuffix sta wildSuffixLength inc wildSuffixLength sec lda argPtr sbc wildPrefix sta wildLength lda #<cmdBuffer ldy #>cmdBuffer sta zp+0 sty zp+1 jsr diropen bcs noMatch sta wildFcb jsr dirread bcs + beq + jsr scanWildcard + lda wildFcb jsr dirclose lda wildMatch bne + noMatch = * lda #$ff sta abortCommandFlag lda #<noMatchMsg ldy #>noMatchMsg jsr eputs + rts noMatchMsg = * .asc "No match for wildcard" .bytes chrCR,0 scanWildcard = * ldx wildFcb jsr dirread bcs + bne ++ + rts + lda aceDirentName bne + rts + lda aceDirentNameLen cmp wildLength bcc scanWildcard ldx wildPrefix ldy #0 jsr substrCmp bcs scanWildcard ldx wildSuffix sec lda aceDirentNameLen sbc wildSuffixLength tay jsr substrCmp bcs scanWildcard ldx #0 - lda cmdBuffer,x beq + sta argBuffer,x inx bne - + ldy #0 - lda aceDirentName,y sta argBuffer,x beq + inx iny bne - + lda aceDirentType cmp #"s" beq + sta argBuffer+1,x lda #"," sta argBuffer,x inx inx lda #0 sta argBuffer,x + stx argPtr jsr shellStoreArg lda #$ff sta wildMatch jmp scanWildcard substrCmp = * ;( .X=cmdbufOff, .Y=direntNameOff ) : .CC=match - lda cmdBuffer,x bne + clc rts + cmp aceDirentName,y bne + iny inx bne - + sec rts ;=== stack management === frameArgvSource = $02 frameArgvDest = $04 frameArgvBytes = $06 shellConstructFrame = * ;** push the ZERO trailer argv lda #0 ldy #0 jsr pushAY ;** push argv[] here lda parseArgc ldy parseArgc+1 sty frameArgvBytes+1 asl sta frameArgvBytes rol frameArgvBytes+1 sec lda aceStackPtr sbc frameArgvBytes sta aceStackPtr sta frameArgvDest lda aceStackPtr+1 sbc frameArgvBytes+1 sta aceStackPtr+1 sta frameArgvDest+1 lda #<argArgvBuffer ldy #>argArgvBuffer sta frameArgvSource sty frameArgvSource+1 - lda frameArgvBytes ora frameArgvBytes+1 beq frameSetArgvPtr ldy #0 lda (frameArgvSource),y sta (frameArgvDest),y inc frameArgvSource bne + inc frameArgvSource+1 + inc frameArgvDest bne + inc frameArgvDest+1 + lda frameArgvBytes bne + dec frameArgvBytes+1 + dec frameArgvBytes jmp - ;** set argv pointer frameSetArgvPtr = * lda aceStackPtr ldy aceStackPtr+1 sta aceArgv sty aceArgv+1 ;** set and push argc lda parseArgc ldy parseArgc+1 sta aceArgc sty aceArgc+1 jsr pushAY ;** push un-redirection info here lda shellRedirectStderr ldy #$ff jsr pushAY lda shellRedirectStdin ldy shellRedirectStdout jsr pushAY ;** push and set frame pointer lda aceFramePtr ldy aceFramePtr+1 jsr pushAY lda aceStackPtr ldy aceStackPtr+1 sta aceFramePtr sty aceFramePtr+1 rts frameFP = $02 frameNewFP = $04 shellRemoveFrame = * ;** get frame pointer lda aceFramePtr ldy aceFramePtr+1 sta frameFP sty frameFP+1 ;** restore the std files ldy #2 - lda (frameFP),y sta shellRedirectStdin-2,y iny cpy #5 bcc - ;** back up frame pointer ldy #1 - lda (frameFP),y sta aceFramePtr,y sta aceStackPtr,y sta frameNewFP,y sta aceArgv,y dey bpl - ;** restore the argc, argv values ldy #6 lda (frameNewFP),y sta aceArgc iny lda (frameNewFP),y sta aceArgc+1 clc lda aceArgv adc #8 sta aceArgv bcc + inc aceArgv+1 + rts ;=== dispatch === dispArgv = $02 dispArgPtr = $04 dispVector = $02 shellExecCommand = * ;** fetch the command name lda aceArgv ldy aceArgv+1 sta dispArgv sty dispArgv+1 ldy #1 - lda (dispArgv),y sta dispArgPtr,y dey bpl - ldy #0 - lda (dispArgPtr),y sta argBuffer,y beq + iny bne - ;** search internal dispatch table for name + ldy #0 dispCmpCommand = * lda dispTable,y beq shellLoadExternal ldx #0 - lda argBuffer,x cmp dispTable,y bne + cmp #0 beq dispMatch inx iny bne - brk + dey - iny lda dispTable,y bne - iny iny iny jmp dispCmpCommand dispMatch = * lda dispTable+1,y sta dispVector lda dispTable+2,y sta dispVector+1 jmp (dispVector) ;** load external file into transient program area loadPath = 2 loadPathPos = 4 loadGiveUp = 7 shellLoadExternal = * lda #0 sta aceAppAddress+3 lda #0 sta loadPathPos sta loadGiveUp lda aceShellPath ldy aceShellPath+1 sta loadPath sty loadPath+1 shellTryLoadAgain = * ldy loadPathPos lda (loadPath),y beq dispCmdNotFound lda loadGiveUp bne dispCmdNotFound lda #0 ldy #0 jsr getarg jsr getLoadPathname lda #<aceAppAddress ldy #>aceAppAddress jsr bload bcs dispLoadError lda aceAppAddress+3 cmp #"c" bne dispBadProg lda aceAppAddress+4 cmp #"B" bne dispBadProg lda #<aceAppAddress ldy #>aceAppAddress jmp exec dispBadProg = * lda #<dispBadProgMsg ldy #>dispBadProgMsg jsr eputs rts dispBadProgMsg = * .asc "Bad external program format" .byte chrCR,0 dispLoadError = * lda errno cmp #aceErrFileNotFound beq shellTryLoadAgain cmp #aceErrDeviceNotPresent beq shellTryLoadAgain lda #<dispLoadErrorMsg1 ldy #>dispLoadErrorMsg1 jmp eputs dispCmdNotFound = * lda #<dispLoadErrorMsg2 ldy #>dispLoadErrorMsg2 jmp eputs dispLoadErrorMsg1 = * .asc "External program load error" .byte chrCR,0 dispLoadErrorMsg2 = * .asc "Command not found" .byte chrCR .byte 0 getLoadPathname = * ldy loadPathPos ldx #0 - lda (loadPath),y beq + sta cmdBuffer,x iny inx bne - + iny sty loadPathPos ldy #1 lda (zp),y cmp #":" beq + dey lda (zp),y cmp #"/" bne getPathReally + sta loadGiveUp ldx #0 getPathReally = * ldy #0 - lda (zp),y sta cmdBuffer,x beq + inx iny bne - + lda #<cmdBuffer ldy #>cmdBuffer sta zp sty zp+1 rts ;===internal command name and dispatch table=== dispTable = * .asc "echo" .byte 0 .word echo .asc "sh" .byte 0 .word shellCmd .asc "directory" .byte 0 .word dirWithCls .asc "dir" .byte 0 .word dirWithCls .asc "d" .byte 0 .word dir .asc "ls" .byte 0 .word ls .asc "cd" .byte 0 .word cd .asc "g" .byte 0 .word cd .asc "cat" .byte 0 .word cat .asc "type" .byte 0 .word cat .asc "t" .byte 0 .word cat .asc "cls" .byte 0 .word cls .asc "clear" .byte 0 .word cls .asc "exit" .byte 0 .word shellExit .asc "x" .byte 0 .word shellExit .asc "clsl" .byte 0 .word lsWithCls .asc "@" .byte 0 .word dos .asc "dos" .byte 0 .word dos .asc "path" .byte 0 .word path .byte 0 ;===echo=== echoArgv = $02 echoSpace = $04 echoTemp = $06 echo = * lda #0 sta echoSpace lda aceArgv ldy aceArgv+1 echoNewArg = * clc adc #2 bcc + iny + sta echoArgv sty echoArgv+1 lda #" " cmp echoSpace bne + jsr putchar + lda #" " sta echoSpace ldy #0 lda (echoArgv),y sta echoTemp iny lda (echoArgv),y tay ora echoTemp beq echoExit lda echoTemp jsr puts lda echoArgv ldy echoArgv+1 jmp echoNewArg echoExit = * lda #chrCR jsr putchar rts ;===copy parameters=== copyBufferPtr = $02 copyBufferLength = $04 getBufferParms = * lda #<copyBuffer ldy #>copyBuffer sta copyBufferPtr sty copyBufferPtr+1 sec lda aceStackPtr sbc copyBufferPtr sta copyBufferLength lda aceStackPtr+1 sbc copyBufferPtr+1 sta copyBufferLength+1 rts getarg = * sty zp+1 asl sta zp rol zp+1 clc lda aceArgv adc zp sta zp lda aceArgv+1 adc zp+1 sta zp+1 ldy #0 lda (zp),y tax iny lda (zp),y stx zp sta zp+1 rts ;===dir=== dirFcb = $02 dirColumns = $03 dirCurCol = $04 dirLong = $05 dirSpaces = $06 dirlineLen = $07 dirChCols = $08 dirWithCls = * jsr cls jmp dir lsWithCls = * jsr cls jmp ls ls = * ldx #1 jsr devinfo stx dirChCols cmp #0 bne + txa ldx #$ff - inx sbc #20 bcs - txa bne lsSetCols + lda #1 lsSetCols = * sta dirColumns lda #0 sta dirLong jmp dirCommon dir = * ldx #1 jsr devinfo stx dirChCols lda #1 sta dirColumns lda #$ff sta dirLong dirCommon = * lda #0 sta dirCurCol lda #<dirDefaultDirectory ldy #>dirDefaultDirectory sta zp sty zp+1 lda aceArgc+1 bne + lda aceArgc cmp #2 bcc dirGotName + lda #1 ldy #0 jsr getarg dirGotName = * jsr diropen bcc + rts + sta dirFcb ldx dirFcb jsr dirread bcs dirExit beq dirExit jsr stopkey bcs dirExit lda dirLong bpl + jsr dirDisplayHeading / ldx dirFcb jsr dirread bcs dirExit beq dirExit jsr stopkey bcs dirExit lda aceDirentName beq dirTrailerExit jsr dirDisplay jmp - dirTrailerExit = * lda dirLong bpl dirExit jsr dirDisplayTrailer dirExit = * lda dirCurCol beq + lda #chrCR jsr putchar + lda dirFcb jmp close dirDefaultDirectory = * .asc ".:" .byte 0 dirDisplay = * bit dirLong bmi + jmp dirDisplayShort + jsr dirSetupDirline lda #<dirline ldy #>dirline sta zp sty zp+1 lda dirlineLen ldy #0 ldx #stdout jmp write ;* 0000000000111111111122222222223333333333444444444455555555556666 ;* pos: 0123456789012345678901234567890123456789012345678901234567890123 dirline .asc "drwx*-mt 00-Xxx-00 12:00a 12345678 *SEQ 1234567890123456" .byte chrCR,0 dirFlagNames .asc "drwx*-mt" dirDateStr .asc " 00-Xxx-00 12:00a " dirDateEnd = * dirSetupDirline = * ;** flags ldx #0 lda aceDirentFlags - asl pha lda #"-" bcc + lda dirFlagNames,x + sta dirline+0,x pla inx cpx #8 bcc - ;** date ldx #dirDateEnd-dirDateStr-1 - lda dirDateStr,x sta dirline+8,x dex bpl - ;** bytes lda aceDirentBytes+0 ldy aceDirentBytes+1 ldx aceDirentBytes+2 jsr itoa ldy #28 lda dirChCols cmp #59 bcs + ldy #8 + ldx #0 - lda itoaNumber,x sta dirline,y iny inx cpx #8 bcc - lda #" " sta dirline,y iny ;** unclosed flag lda dirline+4 cmp #"-" bne + lda #" " + sta dirline,y iny ;** filetype ldx #0 - lda aceDirentType,x ora #$80 sta dirline,y iny inx cpx #3 bcc - lda #" " sta dirline,y iny sta dirline,y iny ;** filename ldx #0 - lda aceDirentName,x beq + sta dirline,y iny inx bne - + lda #chrCR sta dirline,y iny lda #0 sta dirline,y sty dirlineLen rts dirDisplayShort = * lda #<aceDirentName ldy #>aceDirentName jsr puts inc dirCurCol lda dirCurCol cmp dirColumns bcc + lda #0 sta dirCurCol lda #chrCR jmp putchar + ldy #$ff - iny lda aceDirentName,y bne - sty dirSpaces lda #20 sbc dirSpaces sta dirSpaces - lda #" " jsr putchar dec dirSpaces bne - rts dirDisplayHeading = * lda #<dirHeadingMsg ldy #>dirHeadingMsg jsr puts lda #<aceDirentName ldy #>aceDirentName jsr puts lda #chrCR jsr putchar rts dirHeadingMsg = * .asc "Dir: " .byte 0 dirDisplayTrailer = * lda aceDirentBytes+0 ldy aceDirentBytes+1 ldx aceDirentBytes+2 jsr itoaStrip lda #<itoaNumber ldy #>itoaNumber jsr puts lda #<dirTrailingMsg ldy #>dirTrailingMsg jsr puts rts dirTrailingMsg = * .asc " bytes free" .byte chrCR .byte 0 ;===cd=== cd = * lda aceArgc+0 cmp #2 lda aceArgc+1 sbc #0 bcs + jsr cdhome rts + lda #1 ldy #0 jsr getarg cdSetDevice = * ldx #2 ldy #0 lda (zp),y sta argBuffer+0 iny lda (zp),y sta argBuffer+1 iny cmp ":" beq cdCheckPath ldx #0 ldy #0 cdCheckPath = * lda (zp),y sta argBuffer,x cmp #0 beq cdOkay cmp #"/" beq cdPathOkay cmp #"0" bcc + cmp #"9"+1 bcc cdPathOkay + lda #"/" sta argBuffer,x inx cdPathOkay = * - lda (zp),y sta argBuffer,x beq cdCheckEnd inx iny bne - cdCheckEnd = * dex lda argBuffer,x cmp #":" beq + inx lda #":" sta argBuffer,x lda #0 sta argBuffer+1,x + dex lda argBuffer,x cmp #"/" beq cdOkay lda #"/" sta argBuffer+1,x lda #":" sta argBuffer+2,x lda #0 sta argBuffer+3,x cdOkay = * lda #<argBuffer ldy #>argBuffer sta zp+0 sty zp+1 jsr chdir bcs + rts + lda #<cdErrMsg ldy #>cdErrMsg jmp eputs cdDefault = * .asc "a:" .byte 0 cdErrMsg = * .asc "Error changing directory" .byte chrCR,0 ;===cat=== catBufferPtr = $02 catBufferLength = $04 catArg = $06 catFcb = $08 catAbort = 10 cat = * lda #0 sta catAbort jsr getBufferParms ldx #stdout jsr devinfo cmp #0 bne + lda catBufferLength+1 beq + lda #<254 ldy #>254 sta catBufferLength+0 sty catBufferLength+1 + lda #1 ldy #0 sta catArg+0 sty catArg+1 lda aceArgc+0 cmp #2 lda aceArgc+1 sbc #0 bcs catFiles lda #0 sta catFcb jmp catFile catFiles = * lda catArg+0 ldy catArg+1 jsr getarg lda #"r" jsr open bcc + lda zp+0 ldy zp+1 jsr eputs lda #<catErrMsg ldy #>catErrMsg jsr eputs jmp ++ + sta catFcb jsr catFile lda catFcb jsr close + inc catArg bne + inc catArg+1 + lda catAbort bne + lda catArg cmp aceArgc lda catArg+1 sbc aceArgc+1 bcc catFiles + rts catErrMsg = * .asc ": cannot open" .byte chrCR,0 catFile = * lda catBufferPtr ldy catBufferPtr+1 sta zp sty zp+1 - lda catBufferLength ldy catBufferLength+1 ldx catFcb jsr read beq + bcs + ldx #1 jsr write bcs + jsr stopkey bcs printStoppedMsg jmp - + rts printStoppedMsg = * lda #$ff sta catAbort lda #<stoppedMsg ldy #>stoppedMsg jmp eputs stoppedMsg = * .asc "<Stopped>" .byte chrCR,0 ;===exit=== shellExit = * lda #$ff sta shellExitFlag rts ;===dos=== dosFcb = $02 dos = * ;** open command channel lda #<dosCurDevice ldy #>dosCurDevice sta zp sty zp+1 jsr cmdopen bcc + rts + sta dosFcb ;** send command lda #1 ldy #0 jsr getarg lda zp ora zp+1 beq dosStatusOnly lda zp ldy zp+1 ldx dosFcb jsr cmdsend bcs + ;** read status dosStatusOnly = * lda #<cmdBuffer ldy #>cmdBuffer ldx dosFcb jsr cmdstatus bcs + lda #<cmdBuffer ldy #>cmdBuffer jsr puts lda #chrCR jsr putchar ;** close command channel + lda dosFcb jmp cmdclose dosCurDevice .asc ".:" .byte 0 ;===shell=== shellCmd = * jsr shell lda #0 sta shellExitFlag lda #255 sta checkPromptFlag rts ;===path=== pathPtr = 2 pathPos = 4 pathArg = 6 pathSourcePos = 7 path = * lda aceShellPath ldy aceShellPath+1 sta pathPtr sty pathPtr+1 lda #0 sta pathPos lda aceArgc+1 beq + rts + lda aceArgc cmp #2 bcs pathSet lda #<pathMsg ldy #>pathMsg jsr puts displayPath = * ldy pathPos lda (pathPtr),y bne + lda #chrCR jsr putchar rts + lda #chrQuote sta cmdBuffer ldx #1 - lda (pathPtr),y sta cmdBuffer,x beq + iny inx bne - + iny sty pathPos lda #chrQuote sta cmdBuffer,x inx lda #" " sta cmdBuffer,x inx lda #<cmdBuffer ldy #>cmdBuffer sta zp sty zp+1 txa ldy #0 ldx #1 jsr write jmp displayPath pathMsg = * .asc "path " .byte 0 pathSet = * ldy #0 sty pathPos lda #1 sta pathArg pathNextArg = * lda pathArg ldy #0 jsr getarg lda zp ora zp+1 bne + lda #0 ldy pathPos sta (pathPtr),y rts + ldy #0 sty pathSourcePos - ldy pathSourcePos inc pathSourcePos lda (zp),y ldy pathPos inc pathPos sta (pathPtr),y cmp #0 bne - inc pathArg jmp pathNextArg bss = aceAppAddress cmdBuffer = bss+0 argBuffer = cmdBuffer+256 argArgvBuffer = argBuffer+256 copyBuffer = argArgvBuffer slow.s 14 .seq acehead.s .org aceAppAddress .obj "@0:slow" jmp main .asc "cB" main = * lda $d011 ora #%00010000 sta $d011 lda #$00 sta $d030 rts sort.s 1079 ;*** sort program - by Craig Bruce, started 13-Jun-93 .seq acehead.s .org aceAppAddress .obj "@0:sort" jmp main .asc "cB" .byte $06 ;*** global declarations libwork = $40 chrCR = $0d chrQuote = $22 maxLineLen = 2049 true = $ff false = $00 reverseFlag .buf 1 ignoreCaseFlag .buf 1 keyPosition .buf 1 ;******** standard library ******** puts = * ldx #stdout fputs = * sta zp sty zp+1 ldy #$ff - iny lda (zp),y bne - tya ldy #0 jmp write eputs = * ldx #stderr jmp fputs putchar = * ldx #stdout putc = * sta putcBuffer lda #<putcBuffer ldy #>putcBuffer sta zp sty zp+1 lda #1 ldy #0 jmp write putcBuffer .buf 1 getarg = * sty zp+1 asl sta zp rol zp+1 clc lda aceArgv adc zp sta zp lda aceArgv+1 adc zp+1 sta zp+1 ldy #0 lda (zp),y tax iny lda (zp),y stx zp sta zp+1 rts ;===main=== arg = 2 name = 4 string = 8 main = * ;** check argument count lda #0 sta reverseFlag sta ignoreCaseFlag lda #1 sta keyPosition lda aceArgc+1 bne enoughArgs lda aceArgc cmp #2 bcs enoughArgs usage = * lda #<usageMsg ldy #>usageMsg jmp eputs usageMsg = * .asc "usage: sort [-[i][v]] [+column] file ..." .byte chrCR,0 enoughArgs = * ;** main loop lda #1 ldy #0 sta arg+0 sty arg+1 jsr getarg ldy #0 lda (zp),y cmp #"-" bne keyArg inc arg - iny lda (zp),y beq keyArg cmp #"i" bne + lda #true sta ignoreCaseFlag + cmp #"v" bne + lda #true sta reverseFlag + jmp - keyArg = * lda arg ldy #0 jsr getarg ldy #0 lda (zp),y cmp #"+" bne fileArg jsr getKeyPosition inc arg fileArg = * jsr sortInit - jsr stopkey bcs stopped lda arg+0 ldy arg+1 jsr getarg lda zp+0 ldy zp+1 sta name+0 sty name+1 ora zp+1 beq mainExit jsr sortRead bcc + jsr error + inc arg+0 bne + inc arg+1 + jmp - mainExit = * jsr sortReal jsr sortPrint jsr sortClean rts keyDigit = $71 getKeyPosition = * lda #0 sta keyPosition iny - lda (zp),y cmp #"0" bcc + cmp #"9"+1 bcs + and #$0f sta keyDigit lda keyPosition asl asl clc adc keyPosition asl clc adc keyDigit sta keyPosition iny bne - + rts stopped = * lda #<stoppedMsg ldy #>stoppedMsg jsr eputs lda #1 jmp exit stoppedMsg = * .asc "<Stopped>" .byte chrCR,0 error = * lda #<errorMsg1 ldy #>errorMsg1 jsr eputs lda name+0 ldy name+1 jsr eputs lda #<errorMsg2 ldy #>errorMsg2 jmp eputs errorMsg1 = * .asc "Error reading file " .byte chrQuote,0 errorMsg2 = * .byte chrQuote,chrCR,0 bufPtr = 10 ;(1) bufCount = 12 ;(1) infile = 14 ;(1) sortRead = * ;** open file lda name+0 ldy name+1 sta zp+0 sty zp+1 lda #"r" jsr open bcc + rts + sta infile jsr readBody lda infile jsr close rts ;===sort routines=== sorthead = 30 ;(4) sortP = 34 ;(4) sortQ = 38 ;(4) header = 42 ;(5) sortInit = * lda #"s" jsr echoStatus jsr mallocInit lda keyPosition cmp #1 bcc + sbc #1 + sta keyPosition ldx #3 lda #aceMemNull - sta sorthead,x dex bpl - rts readBody = * lda #"r" jsr echoStatus lda #0 sta bufCount - jsr getline bcs + jsr positionLine jsr storeline bcs + lda #"." jsr echoStatus jmp - + rts sortReal = * lda reverseFlag bmi + lda #"v" jsr echoStatus jsr reverseFile + rts sortPrint = * lda #"w" jsr echoStatus lda #13 jsr echoStatus jsr writefile rts sortClean = * ;lda #"f" ;jsr echoStatus ;jsr freefile ;lda #13 ;jsr echoStatus rts ;*** fetchline( sortP=LinePtr, .AY=Ram0buf ) fetchline = * sta zw sty zw+1 ldx #3 - lda sortP,x sta zp,x dex bpl - ldx #header ldy #5 jsr zpload lda header+4 ldy #0 jmp fetch ;*** sortGTcmp( sortline, cmpline ) : .C={sortline >= cmpline} sortGTcmp = * ldx #0 clc lda keyPosition adc #6 cmp sortbuflen bcc + inx + cmp cmpbuflen bcc + inx inx + txa beq doCompare cmp #2 rts doCompare = * bit ignoreCaseFlag bmi doCaselessCompare ldy keyPosition - lda sortline,y cmp cmpline,y bne + cmp #0 beq + iny bne - + rts caselessChar = $72 doCaselessCompare = * ldy keyPosition - lda sortline,y jsr lowcase pha lda cmpline,y jsr lowcase sta caselessChar pla cmp caselessChar bne + cmp #0 beq + iny bne - + rts lowcase = * cmp #"A" bcc + cmp #"Z"+1 bcs + and #$7f + rts ;*** positionLine( sortline ) : sortQ=prev, sortP=next positionLine = * ldx #3 - lda #aceMemNull sta sortQ,x lda sorthead,x sta sortP,x dex bpl - positionSearch = * lda sortP+3 cmp #aceMemNull beq positionExit lda #<cmpbuf ldy #>cmpbuf jsr fetchline jsr sortGTcmp bcs positionExit ;** controls sort order ldx #3 - lda sortP,x sta sortQ,x lda cmpbuf,x sta sortP,x dex bpl - bmi positionSearch positionExit = * rts ;*** storeline( sortline ) {between sortQ and sortP} storeline = * lda sortbuflen ldy #0 jsr malloc bcc + rts + ldx #3 - lda sortP,x sta sortbuf,x dex bpl - lda #<sortbuf ldy #>sortbuf sta zw+0 sty zw+1 lda sortbuflen ldy #0 jsr stash lda sortQ+3 cmp #aceMemNull beq storelineFirst ldx #3 - lda zp,x ldy sortQ,x sta sortQ,x sty zp,x dex bpl - ldx #sortQ ldy #4 jsr zpstore clc rts storelineFirst = * ldx #3 - lda zp,x sta sorthead,x dex bpl - clc rts ;*** writefile() writefile = * ldx #3 - lda sorthead,x sta sortP,x dex bpl - writeLine = * lda sortP+3 cmp #aceMemNull beq writeExit lda #<sortbuf ldy #>sortbuf jsr fetchline jsr putline ldx #3 - lda sortbuf,x sta sortP,x dex bpl - jmp writeLine writeExit = * rts ;*** reverseList() reverseFile = * ldx #3 - lda sorthead,x sta zp,x lda #aceMemNull sta sorthead,x dex bpl - reverseLine = * lda zp+3 cmp #aceMemNull beq reverseExit ldx #sortP ldy #4 jsr zpload ldx #sorthead ldy #4 jsr zpstore ldx #3 - lda zp,x sta sorthead,x lda sortP,x sta zp,x dex bpl - bmi reverseLine reverseExit = * rts ;*** freefile() freefile = * ldx #3 - lda sorthead,x sta zp,x dex bpl - freeLine = * lda zp+3 cmp #aceMemNull bne + rts + ldx #header ldy #5 jsr zpload lda header+4 ldy #0 jsr free ldx #3 - lda header,x sta zp,x dex bpl - jmp freeLine echoStatus = * ldx #stderr jmp putc ;===dynamic memory routines=== mallocWork = $60 mallocHead .buf 4 tpaFreeFirst .buf 1 tpaFreeMin .buf 1 tpaFreePages .buf 1 tpaAreaStart .buf 1 tpaAreaEnd .buf 1 ;*** mallocInit() mallocInit = * lda #aceMemNull sta mallocHead+3 ldx #0 lda #$ff - sta tpaFreemap,x inx bne - ldx #>bssEnd lda #<bssEnd beq + inx + stx tpaFreeFirst stx tpaAreaStart ldx aceStackPtr+1 stx mallocWork stx tpaAreaEnd txa sec sbc tpaFreeFirst bcs + lda #0 + sta tpaFreePages clc adc #1 sta tpaFreeMin ldx tpaFreeFirst cpx mallocWork bcs + lda #$00 - sta tpaFreemap,x inx cpx mallocWork bcc - + rts libPages .buf 1 libPageAlloc = * ;( .A=pages ) : [zp] sta libPages ldx #$00 ldy #aceMemInternal-1 jsr pagealloc bcs + rts + jsr tpaPageAlloc bcs + rts + lda libPages ldx #aceMemInternal ldy #$ff jsr pagealloc bcs + rts + lda #<nomemMsg ldy #>nomemMsg jsr eputs lda #1 jmp exit nomemMsg = * .byte chrCR .asc "Insufficient memory, aborting." .byte chrCR,0 newmax .buf 1 tpaPageAlloc = * ;( libPages ) : [zp] lda libPages cmp tpaFreeMin bcs tpaFreemapFull ;** first free ldx tpaFreeFirst lda tpaFreemap,x beq ++ - inx beq tpaFreemapFull lda tpaFreemap,x bne - stx tpaFreeFirst jmp ++ tpaFreemapFull = * lda libPages cmp tpaFreeMin bcs + sta tpaFreeMin + sec rts ;** search + dex - ldy libPages - inx beq tpaFreemapFull lda tpaFreemap,x bne -- dey bne - ;** allocate stx newmax ldy libPages lda #$41 - sta tpaFreemap,x dex dey bne - inx cpx tpaFreeFirst bne + ldy newmax iny sty tpaFreeFirst + sec lda tpaFreePages sbc libPages sta tpaFreePages lda #0 ldy #aceMemInternal sta zp+0 stx zp+1 sta zp+2 sty zp+3 clc rts mallocLenSave .buf 3 malloc = * sta mallocLenSave+0 sty mallocLenSave+1 jsr libMalloc bcs + rts + ldx mallocLenSave+1 lda mallocLenSave+0 beq + inx + txa cpx #>1024 bcs + ldx #>1024 + txa sta mallocLenSave+2 jsr libPageAlloc bcc + rts + lda #0 ldy mallocLenSave+2 jsr free lda mallocLenSave+0 ldy mallocLenSave+1 jmp malloc ;*** malloc( .AY=Bytes ) : [zp]=FarPointer mallocMemNextPtr = mallocWork+0 ;(4) mallocMemLength = mallocWork+4 ;(2) mallocLength = mallocWork+6 ;(2) mallocQ = mallocWork+8 ;(4) libMalloc = * clc adc #7 bcc + iny + and #$f8 sta mallocLength sty mallocLength+1 ldx #3 - lda mallocHead,x sta zp,x lda #aceMemNull sta mallocQ,x dex bpl - mallocLook = * lda zp+3 cmp #aceMemNull bne + mallocErrorExit = * lda #aceMemNull sta zp+3 lda #aceErrInsufficientMemory sta errno sec rts + ldx #mallocMemNextPtr ldy #6 jsr zpload lda mallocMemLength cmp mallocLength lda mallocMemLength+1 sbc mallocLength+1 bcs mallocGotBlock ldx #3 - lda zp,x sta mallocQ,x lda mallocMemNextPtr,x sta zp,x dex bpl - jmp mallocLook mallocGotBlock = * lda mallocMemLength cmp mallocLength bne + lda mallocMemLength+1 sbc mallocLength+1 beq mallocTakeWholeBlock + sec lda mallocMemLength sbc mallocLength sta mallocMemLength lda mallocMemLength+1 sbc mallocLength+1 sta mallocMemLength+1 ldx #mallocMemNextPtr ldy #6 jsr zpstore clc lda zp+0 adc mallocMemLength sta zp+0 lda zp+1 adc mallocMemLength+1 sta zp+1 clc rts mallocTakeWholeBlock = * lda mallocQ+3 cmp #aceMemNull bne + ldx #3 - lda mallocMemNextPtr,x sta mallocHead,x dex bpl - clc rts + ldx #3 - lda zp,x ldy mallocQ,x sta mallocQ,x sty zp,x dex bpl - ldx #mallocMemNextPtr ldy #4 jsr zpstore ldx #3 - lda mallocQ,x sta zp,x dex bpl - clc rts ;*** free( [zp]=FarPointer, .AY=Length ) {alters [zp]} freeMemNextPtr = mallocWork+0 ;(4) freeMemLength = mallocWork+4 ;(2) freeLength = mallocWork+6 ;(2) freeNewPtr = mallocWork+8 ;(4) freeQ = mallocWork+12 ;(4) free = * clc adc #7 bcc + iny + and #$f8 sta freeLength+0 sty freeLength+1 ldx #3 - lda zp,x sta freeNewPtr,x lda mallocHead,x sta zp,x lda #aceMemNull sta freeQ,x dex bpl - freeSearchLoop = * lda zp+3 cmp #aceMemNull beq freeCoalesceQandNew lda zp+0 cmp freeNewPtr+0 lda zp+1 sbc freeNewPtr+1 lda zp+2 sbc freeNewPtr+2 lda zp+3 sbc freeNewPtr+3 bcs freeCoalesceQandNew + ldx #freeMemNextPtr ldy #4 jsr zpload ldx #3 - lda zp,x sta freeQ,x lda freeMemNextPtr,x sta zp,x dex bpl - bmi freeSearchLoop freeCoalesceQandNew = * ldx #3 - lda freeQ,x sta zp,x dex bpl - lda zp+3 cmp #aceMemNull bne + ;** prev is head ldx #3 - lda mallocHead,x sta freeMemNextPtr,x lda freeNewPtr,x sta mallocHead,x dex bpl - lda freeLength+0 ldy freeLength+1 sta freeMemLength+0 sty freeMemLength+1 jmp freeCoalesceNewAndP ;** prev is real + ldx #freeMemNextPtr ldy #6 jsr zpload lda zp+3 cmp freeNewPtr+3 bne + lda zp+2 cmp freeNewPtr+2 bne + clc lda zp adc freeMemLength tax lda zp+1 adc freeMemLength+1 cmp freeNewPtr+1 bne + cpx freeNewPtr bne + ;** prev does coalesce clc lda freeMemLength adc freeLength sta freeMemLength lda freeMemLength+1 adc freeLength+1 sta freeMemLength+1 ldx #3 - lda freeQ,x sta freeNewPtr,x dex bpl - bmi freeCoalesceNewAndP ;** prev does not coalesce + ldx #freeNewPtr ldy #4 jsr zpstore lda freeLength+0 ldy freeLength+1 sta freeMemLength+0 sty freeMemLength+1 freeCoalesceNewAndP = * lda freeNewPtr+3 cmp freeMemNextPtr+3 bne + lda freeNewPtr+2 cmp freeMemNextPtr+2 bne + clc lda freeNewPtr adc freeMemLength tax lda freeNewPtr+1 adc freeMemLength+1 cmp freeMemNextPtr+1 bne + cpx freeMemNextPtr bne + ;** new and next coalesce ldx #3 - lda freeMemNextPtr,x sta zp,x dex bpl - lda freeMemLength+1 pha lda freeMemLength+0 pha ldx #freeMemNextPtr ldy #6 jsr zpload clc pla adc freeMemLength+0 sta freeMemLength+0 pla adc freeMemLength+1 sta freeMemLength+1 + ldx #3 - lda freeNewPtr,x sta zp,x dex bpl - ldx #freeMemNextPtr ldy #6 jsr zpstore clc rts ;=== line I/O routines === ysave = $70 getline = * ;( infile ) : sortline, .CS=eof ldy #0 - sty ysave jsr getByte ldy ysave bcs + sta sortline,y iny cpy #240 bcs getlineExit cmp #13 bne - dey getlineExit = * lda #0 sta sortline,y clc tya adc #6 sta sortbuflen clc + rts putline = * ;( sortbuf ) jsr stopkey bcc + jsr stopped + ldy sortbuflen lda #13 sta sortbuf-1,y lda #<sortline ldy #>sortline sta zp+0 sty zp+1 sec lda sortbuflen sbc #5 ldy #0 ldx #stdout jsr write ldy sortbuflen lda #0 sta sortbuf-1,y rts getByte = * lda bufCount beq getByteFillBuf ldy bufPtr lda inBuf,y inc bufPtr dec bufCount clc rts getByteFillBuf = * jsr stopkey bcc + jsr stopped + lda #<inBuf ldy #>inBuf sta zp+0 sty zp+1 lda #254 ldy #0 sty bufPtr ldx infile jsr read beq + bcs + sta bufCount jmp getByte + sec rts ;===bss=== bss = * sortbuf = bss+0 sortbuflen = sortbuf+4 sortline = sortbuf+5 cmpbuf = sortbuf+256 cmpbuflen = cmpbuf+4 cmpline = cmpbuf+5 inBuf = cmpbuf+256 tpaFreemap = inBuf+256 bssEnd = tpaFreemap+256 tr.s 476 ;*** translation program - by Craig Bruce, started 10-Jul-93 .seq acehead.s .org aceAppAddress .obj "@0:tr" jmp main .asc "cB" .byte $06 ;*** global declarations libwork = $40 chrCR = $0d chrQuote = $22 maxLineLen = 2049 true = $ff false = $00 trPetscii = 0 trAsciiCrLf = 1 trAsciiLf = 2 trAsciiCr = 3 trSpeedscript = 4 trFrom .buf 1 trTo .buf 1 ;******** standard library ******** puts = * ldx #stdout fputs = * sta zp sty zp+1 ldy #$ff - iny lda (zp),y bne - tya ldy #0 jmp write eputs = * ldx #stderr jmp fputs putchar = * ldx #stdout putc = * sta putcBuffer lda #<putcBuffer ldy #>putcBuffer sta zp sty zp+1 lda #1 ldy #0 jmp write putcBuffer .buf 1 getarg = * sty zp+1 asl sta zp rol zp+1 clc lda aceArgv adc zp sta zp lda aceArgv+1 adc zp+1 sta zp+1 ldy #0 lda (zp),y tax iny lda (zp),y stx zp sta zp+1 rts ;===main=== arg = 2 name = 4 string = 8 main = * lda #trAsciiCrLf sta trFrom lda #trPetscii sta trTo ;** check argument count lda aceArgc+1 bne enoughArgs lda aceArgc+0 cmp #2 bcs enoughArgs jmp usage enoughArgs = * lda #1 ldy #0 sta arg+0 sty arg+1 jsr getarg ldy #0 lda (zp),y cmp #"-" bne fileArg inc arg iny jsr getTrType stx trFrom iny jsr getTrType stx trTo fileArg = * jsr initOutBuf - jsr stopkey bcc + jmp stopped + lda arg+0 ldy arg+1 jsr getarg lda zp+0 ldy zp+1 sta name+0 sty name+1 ora zp+1 beq mainExit jsr trFile bcc + jsr error + inc arg+0 bne + inc arg+1 + jmp - mainExit = * jsr flushOutBuf rts getTrType = * ;( (zp)+.y=str ) : .X=type lda (zp),y iny ldx #trPetscii cmp #"p" beq getTrRet ldx #trSpeedscript cmp #"s" beq getTrRet ldx #trAsciiLf cmp #"u" beq getTrRet ldx #trAsciiCrLf cmp #"m" beq getTrRet ldx #trPetscii cmp #"c" beq getTrRet cmp #"a" bne usage lda (zp),y iny ldx #trAsciiLf cmp #"l" beq getTrRet ldx #trAsciiCr cmp #"c" beq getTrRet cmp #"r" beq getTrRet dey ldx #trAsciiCrLf getTrRet = * clc rts usage = * lda #<usageMsg ldy #>usageMsg jsr eputs lda #1 jmp exit usageMsg = * .asc "usage: tr [-fromset2toset] file ..." .byte chrCR .asc "where fromset/toset=p,a,al,ac,s,c,u,m" .byte chrCR .asc "(petscii,asc-crlf,asc-lf,asc-cr," .byte chrCR .asc " speedscript,commodore,unix,ms-dos)" .byte chrCR,0 stopped = * lda #<stoppedMsg ldy #>stoppedMsg jsr eputs lda #1 jmp exit stoppedMsg = * .asc "<Stopped>" .byte chrCR,0 error = * lda #<errorMsg1 ldy #>errorMsg1 jsr eputs lda name+0 ldy name+1 jsr eputs lda #<errorMsg2 ldy #>errorMsg2 jmp eputs errorMsg1 = * .asc "Error reading file " .byte chrQuote,0 errorMsg2 = * .byte chrQuote,chrCR,0 bufPtr = 10 ;(2) bufCount = 12 ;(2) infile = 14 ;(1) inBufLen = 16 ;(2) readTrTab = 18 ;(2) writeTrTab = 20 ;(2) outBufCount = 22 ;(1) trFile = * jsr initTr jsr initInBuf lda name+0 ldy name+1 sta zp+0 sty zp+1 lda #"r" jsr open bcc + rts + sta infile jsr trBody lda infile jsr close rts trBody = * jsr getByte bcs bodyExit ldx trFrom beq bodyWrite cmp #13 bne + cpx #trAsciiCrLf beq trBody cpx #trAsciiCr beq bodyWrite + tay lda (readTrTab),y bodyWrite = * ldx trTo beq bodyRep cmp #13 bne + cpx #trSpeedscript beq + cpx #trAsciiCr beq bodyRep cpx #trAsciiLf beq + jsr putByte lda #13 + tay lda (writeTrTab),y bodyRep = * jsr putByte jmp trBody bodyExit = * rts getByte = * lda bufCount+0 ora bufCount+1 beq getByteFillBuf ldy #0 lda (bufPtr),y inc bufPtr+0 bne + inc bufPtr+1 + ldx bufCount+0 bne + dec bufCount+1 + dec bufCount+0 clc rts getByteFillBuf = * jsr stopkey bcc + jsr stopped + lda #<inBuf ldy #>inBuf sta zp+0 sty zp+1 sta bufPtr+0 sty bufPtr+1 lda inBufLen+0 ldy inBufLen+1 ldx infile jsr read beq + bcs + sta bufCount+0 sty bufCount+1 jmp getByte + sec rts initInBuf = * sec lda aceStackPtr+0 sbc #<inBuf sta inBufLen+0 lda aceStackPtr+1 sbc #>inBuf sta inBufLen+1 lda #0 sta bufCount+0 sta bufCount+1 ldx #stdout jsr devinfo cmp #0 bne + lda #<254 ldy #>254 sta inBufLen+0 sty inBufLen+1 + rts putByte = * ldx outBufCount cpx #254 bcc + pha jsr flushOutBuf pla ldx outBufCount + sta outBuf,x inc outBufCount rts flushOutBuf = * jsr stopkey bcc + jmp stopped + lda #<outBuf ldy #>outBuf sta zp+0 sty zp+1 lda outBufCount ldy #0 ldx #stdout jsr write lda #0 sta outBufCount rts initOutBuf = * lda #0 sta outBufCount rts initTr = * lda trFrom asl tax lda readTr,x sta readTrTab+0 lda readTr+1,x sta readTrTab+1 lda trTo asl tax lda writeTr,x sta writeTrTab+0 lda writeTr+1,x sta writeTrTab+1 rts readTr .word 0,ascToPet,ascToPet,ascToPet,spdToPet writeTr .word 0,petToAsc,petToAsc,petToAsc,petToSpd ascToPet = * ;0 1 2 3 4 5 6 7 8 9 a b c d e f .byte $00,$01,$02,$03,$04,$05,$06,$07,$9d,$09,$0d,$0b,$93,$0a,$0e,$0f ;0 .byte $10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1a,$1b,$1c,$1d,$1e,$1f ;1 .byte $20,$21,$22,$23,$24,$25,$26,$27,$28,$29,$2a,$2b,$2c,$2d,$2e,$2f ;2 .byte $30,$31,$32,$33,$34,$35,$36,$37,$38,$39,$3a,$3b,$3c,$3d,$3e,$3f ;3 .byte $40,$c1,$c2,$c3,$c4,$c5,$c6,$c7,$c8,$c9,$ca,$cb,$cc,$cd,$ce,$cf ;4 .byte $d0,$d1,$d2,$d3,$d4,$d5,$d6,$d7,$d8,$d9,$da,$5b,$5c,$5d,$5e,$5f ;5 .byte $c0,$41,$42,$43,$44,$45,$46,$47,$48,$49,$4a,$4b,$4c,$4d,$4e,$4f ;6 .byte $50,$51,$52,$53,$54,$55,$56,$57,$58,$59,$5a,$db,$dc,$dd,$de,$df ;7 .byte $80,$81,$82,$83,$84,$85,$86,$87,$88,$89,$8a,$8b,$8c,$8d,$8e,$8f ;8 .byte $90,$91,$92,$0c,$94,$95,$96,$97,$98,$99,$9a,$9b,$9c,$08,$9e,$9f ;9 .byte $a0,$a1,$a2,$a3,$a4,$a5,$a6,$a7,$a8,$a9,$aa,$ab,$ac,$ad,$ae,$af ;a .byte $b0,$b1,$b2,$b3,$b4,$b5,$b6,$b7,$b8,$b9,$ba,$bb,$bc,$bd,$be,$bf ;b .byte $60,$61,$62,$63,$64,$65,$66,$67,$68,$69,$6a,$6b,$6c,$6d,$6e,$6f ;c .byte $70,$71,$72,$73,$74,$75,$76,$77,$78,$79,$7a,$7b,$7c,$7d,$7e,$7f ;d .byte $e0,$e1,$e2,$e3,$e4,$e5,$e6,$e7,$e8,$e9,$ea,$eb,$ec,$ed,$ee,$ef ;e .byte $f0,$f1,$f2,$f3,$f4,$f5,$f6,$f7,$f8,$f9,$fa,$fb,$fc,$fd,$fe,$ff ;f spdToPet = * ;0 1 2 3 4 5 6 7 8 9 a b c d e f .byte $40,$41,$42,$43,$44,$45,$46,$47,$48,$49,$4a,$4b,$4c,$4d,$4e,$4f ;0 .byte $50,$51,$52,$53,$54,$55,$56,$57,$58,$59,$5a,$5b,$5c,$5d,$5e,$0d ;1 .byte $20,$21,$22,$23,$24,$25,$26,$27,$28,$29,$2a,$2b,$2c,$2d,$2e,$2f ;2 .byte $30,$31,$32,$33,$34,$35,$36,$37,$38,$39,$3a,$3b,$3c,$3d,$3e,$3f ;3 .byte $c0,$c1,$c2,$c3,$c4,$c5,$c6,$c7,$c8,$c9,$ca,$cb,$cc,$cd,$ce,$cf ;4 .byte $d0,$d1,$d2,$d3,$d4,$d5,$d6,$d7,$d8,$d9,$da,$db,$dc,$dd,$de,$df ;5 .byte $a0,$a1,$a2,$a3,$a4,$a5,$a6,$a7,$a8,$a9,$aa,$ab,$ac,$ad,$ae,$af ;6 .byte $b0,$b1,$b2,$b3,$b4,$b5,$b6,$b7,$b8,$b9,$ba,$bb,$bc,$bd,$be,$bf ;7 .byte $00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0a,$0b,$0c,$5f,$0e,$0f ;8 .byte $10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1a,$1b,$1c,$1d,$1e,$1f ;9 .byte $e0,$e1,$e2,$e3,$e4,$e5,$e6,$e7,$e8,$e9,$ea,$eb,$ec,$ed,$ee,$ef ;a .byte $f0,$f1,$f2,$f3,$f4,$f5,$f6,$f7,$f8,$f9,$fa,$fb,$fc,$fd,$fe,$ff ;b .byte $80,$81,$82,$83,$84,$85,$86,$87,$88,$89,$8a,$8b,$8c,$8d,$8e,$8f ;c .byte $90,$91,$92,$93,$94,$95,$96,$97,$98,$99,$9a,$9b,$9c,$9d,$9e,$9f ;d .byte $60,$61,$62,$63,$64,$65,$66,$67,$68,$69,$6a,$6b,$6c,$6d,$6e,$6f ;e .byte $70,$71,$72,$73,$74,$75,$76,$77,$78,$79,$7a,$7b,$7c,$7d,$7e,$7f ;f petToAsc = * ;0 1 2 3 4 5 6 7 8 9 a b c d e f .byte $00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0d,$0b,$93,$0a,$0e,$0f ;0 .byte $10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1a,$1b,$1c,$1d,$1e,$1f ;1 .byte $20,$21,$22,$23,$24,$25,$26,$27,$28,$29,$2a,$2b,$2c,$2d,$2e,$2f ;2 .byte $30,$31,$32,$33,$34,$35,$36,$37,$38,$39,$3a,$3b,$3c,$3d,$3e,$3f ;3 .byte $40,$61,$62,$63,$64,$65,$66,$67,$68,$69,$6a,$6b,$6c,$6d,$6e,$6f ;4 .byte $70,$71,$72,$73,$74,$75,$76,$77,$78,$79,$7a,$5b,$5c,$5d,$5e,$5f ;5 .byte $c0,$c1,$c2,$c3,$c4,$c5,$c6,$c7,$c8,$c9,$ca,$cb,$cc,$cd,$ce,$cf ;6 .byte $d0,$d1,$d2,$d3,$d4,$d5,$d6,$d7,$d8,$d9,$da,$db,$dc,$dd,$de,$df ;7 .byte $80,$81,$82,$83,$84,$85,$86,$87,$88,$89,$8a,$8b,$8c,$8d,$8e,$8f ;8 .byte $90,$91,$92,$93,$94,$95,$96,$97,$98,$99,$9a,$9b,$9c,$9d,$9e,$9f ;9 .byte $a0,$a1,$a2,$a3,$a4,$a5,$a6,$a7,$a8,$a9,$aa,$ab,$ac,$ad,$ae,$af ;a .byte $b0,$b1,$b2,$b3,$b4,$b5,$b6,$b7,$b8,$b9,$ba,$bb,$bc,$bd,$be,$bf ;b .byte $60,$41,$42,$43,$44,$45,$46,$47,$48,$49,$4a,$4b,$4c,$4d,$4e,$4f ;c .byte $50,$51,$52,$53,$54,$55,$56,$57,$58,$59,$5a,$7b,$7c,$7d,$7e,$7f ;d .byte $e0,$e1,$e2,$e3,$e4,$e5,$e6,$e7,$e8,$e9,$ea,$eb,$ec,$ed,$ee,$ef ;e .byte $f0,$f1,$f2,$f3,$f4,$f5,$f6,$f7,$f8,$f9,$fa,$fb,$fc,$fd,$fe,$ff ;f petToSpd = * ;0 1 2 3 4 5 6 7 8 9 a b c d e f .byte $80,$81,$82,$83,$84,$85,$86,$87,$88,$89,$8a,$8b,$8c,$1f,$8e,$8f ;0 .byte $90,$91,$92,$93,$94,$95,$96,$97,$98,$99,$9a,$9b,$9c,$9d,$9e,$9f ;1 .byte $20,$21,$22,$23,$24,$25,$26,$27,$28,$29,$2a,$2b,$2c,$2d,$2e,$2f ;2 .byte $30,$31,$32,$33,$34,$35,$36,$37,$38,$39,$3a,$3b,$3c,$3d,$3e,$3f ;3 .byte $00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0a,$0b,$0c,$0d,$0e,$0f ;4 .byte $10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1a,$1b,$1c,$1d,$1e,$8d ;5 .byte $e0,$e1,$e2,$e3,$e4,$e5,$e6,$e7,$e8,$e9,$ea,$eb,$ec,$ed,$ee,$ef ;6 .byte $f0,$f1,$f2,$f3,$f4,$f5,$f6,$f7,$f8,$f9,$fa,$fb,$fc,$fd,$fe,$ff ;7 .byte $c0,$c1,$c2,$c3,$c4,$c5,$c6,$c7,$c8,$c9,$ca,$cb,$cc,$cd,$ce,$cf ;8 .byte $d0,$d1,$d2,$d3,$d4,$d5,$d6,$d7,$d8,$d9,$da,$db,$dc,$dd,$de,$df ;9 .byte $60,$61,$62,$63,$64,$65,$66,$67,$68,$69,$6a,$6b,$6c,$6d,$6e,$6f ;a .byte $70,$71,$72,$73,$74,$75,$76,$77,$78,$79,$7a,$7b,$7c,$7d,$7e,$7f ;b .byte $40,$41,$42,$43,$44,$45,$46,$47,$48,$49,$4a,$4b,$4c,$4d,$4e,$4f ;c .byte $50,$51,$52,$53,$54,$55,$56,$57,$58,$59,$5a,$5b,$5c,$5d,$5e,$5f ;d .byte $a0,$a1,$a2,$a3,$a4,$a5,$a6,$a7,$a8,$a9,$aa,$ab,$ac,$ad,$ae,$af ;e .byte $b0,$b1,$b2,$b3,$b4,$b5,$b6,$b7,$b8,$b9,$ba,$bb,$bc,$bd,$be,$bf ;f ;===bss=== bss = * outBuf = bss inBuf = outBuf+256 unbcode.s 812 ;*** UNBCODE: bcode decoder version 1.00 - by Craig Bruce - 25-Nov-93 ;assumes 1-65535 segments, 1-65536 temp files max, 0-4 G file length, 64 frags .seq acehead.s .org aceAppAddress .obj "@0:unbcode" jmp main .asc "cB" ;*** global declarations chrLF = $0a chrCR = $0d chrQuote = $22 true = $ff false = $00 maxChunk = 64 maxLine = 85 maxFilename = 85 maxHave = 64 maxTempname = 20 copyBufSize = 4096 version .asc "1.00" .byte 0 hrFromSeg = 0 ;(2) hrToSeg = 2 ;(2) hrTempFileName = 4 ;(2) hrValidLength = 6 ;(4) hrIsEnd = 10 ;(1) hrFilename = 11 ;(17) hrSize = 32 ;(really 28) asciiFile .buf 1 temp .buf 1 progName .buf 2 informative .buf 1 verbose .buf 1 debug .buf 1 readFilename .buf 2 readLineNum .buf 4 haveCount .buf 1 statusFileExists .buf 1 nextTempName .buf 2 filenameUsed .buf 1 arg = 2 ;(2) name = 4 ;(2) inBufLen = 6 ;(2) bufPtr = 8 ;(2) bufCount = 10 ;(2) infile = 12 ;(1) outfile = 13 ;(1) outName = 14 ;(2) segnum = 16 ;(4) convertLen = 20 ;(1) getlinePos = 21 ;(1) scanVal = 22 ;(4) crc = 26 ;(4) bytes = 30 ;(4) isEnd = 34 ;(1) curHave = 35 ;(1) tempName = 36 ;(4) : really only uses 2 h = 40 ;(2) nextH = 42 ;(2) haveRec = 44 ;(1) fin = 45 ;(1) fout = 46 ;(1) work = 112 ;(16) crcTable0 = * .byte $00,$96,$2c,$ba,$19,$8f,$35,$a3,$32,$a4,$1e,$88,$2b,$bd,$07,$91 .byte $64,$f2,$48,$de,$7d,$eb,$51,$c7,$56,$c0,$7a,$ec,$4f,$d9,$63,$f5 .byte $c8,$5e,$e4,$72,$d1,$47,$fd,$6b,$fa,$6c,$d6,$40,$e3,$75,$cf,$59 .byte $ac,$3a,$80,$16,$b5,$23,$99,$0f,$9e,$08,$b2,$24,$87,$11,$ab,$3d .byte $90,$06,$bc,$2a,$89,$1f,$a5,$33,$a2,$34,$8e,$18,$bb,$2d,$97,$01 .byte $f4,$62,$d8,$4e,$ed,$7b,$c1,$57,$c6,$50,$ea,$7c,$df,$49,$f3,$65 .byte $58,$ce,$74,$e2,$41,$d7,$6d,$fb,$6a,$fc,$46,$d0,$73,$e5,$5f,$c9 .byte $3c,$aa,$10,$86,$25,$b3,$09,$9f,$0e,$98,$22,$b4,$17,$81,$3b,$ad .byte $20,$b6,$0c,$9a,$39,$af,$15,$83,$12,$84,$3e,$a8,$0b,$9d,$27,$b1 .byte $44,$d2,$68,$fe,$5d,$cb,$71,$e7,$76,$e0,$5a,$cc,$6f,$f9,$43,$d5 .byte $e8,$7e,$c4,$52,$f1,$67,$dd,$4b,$da,$4c,$f6,$60,$c3,$55,$ef,$79 .byte $8c,$1a,$a0,$36,$95,$03,$b9,$2f,$be,$28,$92,$04,$a7,$31,$8b,$1d .byte $b0,$26,$9c,$0a,$a9,$3f,$85,$13,$82,$14,$ae,$38,$9b,$0d,$b7,$21 .byte $d4,$42,$f8,$6e,$cd,$5b,$e1,$77,$e6,$70,$ca,$5c,$ff,$69,$d3,$45 .byte $78,$ee,$54,$c2,$61,$f7,$4d,$db,$4a,$dc,$66,$f0,$53,$c5,$7f,$e9 .byte $1c,$8a,$30,$a6,$05,$93,$29,$bf,$2e,$b8,$02,$94,$37,$a1,$1b,$8d crcTable1 = * .byte $00,$30,$61,$51,$c4,$f4,$a5,$95,$88,$b8,$e9,$d9,$4c,$7c,$2d,$1d .byte $10,$20,$71,$41,$d4,$e4,$b5,$85,$98,$a8,$f9,$c9,$5c,$6c,$3d,$0d .byte $20,$10,$41,$71,$e4,$d4,$85,$b5,$a8,$98,$c9,$f9,$6c,$5c,$0d,$3d .byte $30,$00,$51,$61,$f4,$c4,$95,$a5,$b8,$88,$d9,$e9,$7c,$4c,$1d,$2d .byte $41,$71,$20,$10,$85,$b5,$e4,$d4,$c9,$f9,$a8,$98,$0d,$3d,$6c,$5c .byte $51,$61,$30,$00,$95,$a5,$f4,$c4,$d9,$e9,$b8,$88,$1d,$2d,$7c,$4c .byte $61,$51,$00,$30,$a5,$95,$c4,$f4,$e9,$d9,$88,$b8,$2d,$1d,$4c,$7c .byte $71,$41,$10,$20,$b5,$85,$d4,$e4,$f9,$c9,$98,$a8,$3d,$0d,$5c,$6c .byte $83,$b3,$e2,$d2,$47,$77,$26,$16,$0b,$3b,$6a,$5a,$cf,$ff,$ae,$9e .byte $93,$a3,$f2,$c2,$57,$67,$36,$06,$1b,$2b,$7a,$4a,$df,$ef,$be,$8e .byte $a3,$93,$c2,$f2,$67,$57,$06,$36,$2b,$1b,$4a,$7a,$ef,$df,$8e,$be .byte $b3,$83,$d2,$e2,$77,$47,$16,$26,$3b,$0b,$5a,$6a,$ff,$cf,$9e,$ae .byte $c2,$f2,$a3,$93,$06,$36,$67,$57,$4a,$7a,$2b,$1b,$8e,$be,$ef,$df .byte $d2,$e2,$b3,$83,$16,$26,$77,$47,$5a,$6a,$3b,$0b,$9e,$ae,$ff,$cf .byte $e2,$d2,$83,$b3,$26,$16,$47,$77,$6a,$5a,$0b,$3b,$ae,$9e,$cf,$ff .byte $f2,$c2,$93,$a3,$36,$06,$57,$67,$7a,$4a,$1b,$2b,$be,$8e,$df,$ef crcTable2 = * .byte $00,$07,$0e,$09,$6d,$6a,$63,$64,$db,$dc,$d5,$d2,$b6,$b1,$b8,$bf .byte $b7,$b0,$b9,$be,$da,$dd,$d4,$d3,$6c,$6b,$62,$65,$01,$06,$0f,$08 .byte $6e,$69,$60,$67,$03,$04,$0d,$0a,$b5,$b2,$bb,$bc,$d8,$df,$d6,$d1 .byte $d9,$de,$d7,$d0,$b4,$b3,$ba,$bd,$02,$05,$0c,$0b,$6f,$68,$61,$66 .byte $dc,$db,$d2,$d5,$b1,$b6,$bf,$b8,$07,$00,$09,$0e,$6a,$6d,$64,$63 .byte $6b,$6c,$65,$62,$06,$01,$08,$0f,$b0,$b7,$be,$b9,$dd,$da,$d3,$d4 .byte $b2,$b5,$bc,$bb,$df,$d8,$d1,$d6,$69,$6e,$67,$60,$04,$03,$0a,$0d .byte $05,$02,$0b,$0c,$68,$6f,$66,$61,$de,$d9,$d0,$d7,$b3,$b4,$bd,$ba .byte $b8,$bf,$b6,$b1,$d5,$d2,$db,$dc,$63,$64,$6d,$6a,$0e,$09,$00,$07 .byte $0f,$08,$01,$06,$62,$65,$6c,$6b,$d4,$d3,$da,$dd,$b9,$be,$b7,$b0 .byte $d6,$d1,$d8,$df,$bb,$bc,$b5,$b2,$0d,$0a,$03,$04,$60,$67,$6e,$69 .byte $61,$66,$6f,$68,$0c,$0b,$02,$05,$ba,$bd,$b4,$b3,$d7,$d0,$d9,$de .byte $64,$63,$6a,$6d,$09,$0e,$07,$00,$bf,$b8,$b1,$b6,$d2,$d5,$dc,$db .byte $d3,$d4,$dd,$da,$be,$b9,$b0,$b7,$08,$0f,$06,$01,$65,$62,$6b,$6c .byte $0a,$0d,$04,$03,$67,$60,$69,$6e,$d1,$d6,$df,$d8,$bc,$bb,$b2,$b5 .byte $bd,$ba,$b3,$b4,$d0,$d7,$de,$d9,$66,$61,$68,$6f,$0b,$0c,$05,$02 crcTable3 = * .byte $00,$77,$ee,$99,$07,$70,$e9,$9e,$0e,$79,$e0,$97,$09,$7e,$e7,$90 .byte $1d,$6a,$f3,$84,$1a,$6d,$f4,$83,$13,$64,$fd,$8a,$14,$63,$fa,$8d .byte $3b,$4c,$d5,$a2,$3c,$4b,$d2,$a5,$35,$42,$db,$ac,$32,$45,$dc,$ab .byte $26,$51,$c8,$bf,$21,$56,$cf,$b8,$28,$5f,$c6,$b1,$2f,$58,$c1,$b6 .byte $76,$01,$98,$ef,$71,$06,$9f,$e8,$78,$0f,$96,$e1,$7f,$08,$91,$e6 .byte $6b,$1c,$85,$f2,$6c,$1b,$82,$f5,$65,$12,$8b,$fc,$62,$15,$8c,$fb .byte $4d,$3a,$a3,$d4,$4a,$3d,$a4,$d3,$43,$34,$ad,$da,$44,$33,$aa,$dd .byte $50,$27,$be,$c9,$57,$20,$b9,$ce,$5e,$29,$b0,$c7,$59,$2e,$b7,$c0 .byte $ed,$9a,$03,$74,$ea,$9d,$04,$73,$e3,$94,$0d,$7a,$e4,$93,$0a,$7d .byte $f0,$87,$1e,$69,$f7,$80,$19,$6e,$fe,$89,$10,$67,$f9,$8e,$17,$60 .byte $d6,$a1,$38,$4f,$d1,$a6,$3f,$48,$d8,$af,$36,$41,$df,$a8,$31,$46 .byte $cb,$bc,$25,$52,$cc,$bb,$22,$55,$c5,$b2,$2b,$5c,$c2,$b5,$2c,$5b .byte $9b,$ec,$75,$02,$9c,$eb,$72,$05,$95,$e2,$7b,$0c,$92,$e5,$7c,$0b .byte $86,$f1,$68,$1f,$81,$f6,$6f,$18,$88,$ff,$66,$11,$8f,$f8,$61,$16 .byte $a0,$d7,$4e,$39,$a7,$d0,$49,$3e,$ae,$d9,$40,$37,$a9,$de,$47,$30 .byte $bd,$ca,$53,$24,$ba,$cd,$54,$23,$b3,$c4,$5d,$2a,$b4,$c3,$5a,$2d ;******** standard library ******** puts = * ldx #stdout fputs = * sta zp+0 sty zp+1 ldy #$ff - iny lda (zp),y bne - tya ldy #0 jmp write eputs = * ldx #stderr jmp fputs eputchar = * ldx #stderr jmp putc putchar = * ldx #stdout putc = * sta putcBuffer lda #<putcBuffer ldy #>putcBuffer sta zp+0 sty zp+1 lda #1 ldy #0 jmp write putcBuffer .buf 1 getchar = * ldx #stdin getc = * lda #<getcBuffer ldy #>getcBuffer sta zp+0 sty zp+1 lda #1 ldy #0 jsr read beq + lda getcBuffer rts + sec rts getcBuffer .buf 1 getarg = * sty zp+1 asl sta zp+0 rol zp+1 clc lda aceArgv adc zp+0 sta zp+0 lda aceArgv+1 adc zp+1 sta zp+1 ldy #0 lda (zp),y tax iny lda (zp),y stx zp+0 sta zp+1 rts ;===unbcode=== main = * ;** check for large enough TPA sec lda #<bssEnd cmp aceStackPtr+0 lda #>bssEnd sbc aceStackPtr+1 bcc tpaOk lda #<tpaMsg ldy #>tpaMsg jsr eputs die = * lda #1 ldx #0 jmp exit tpaMsg = * .asc "Insufficient program space to run unbcode" .byte chrCR,0 tpaOk = * ;** check argument count lda aceArgc+1 beq + jmp enoughArgs + lda aceArgc+0 cmp #2 bcc usage jmp enoughArgs usage = * lda #<usageMsg ldy #>usageMsg jsr eputs jmp die usageMsg = * .asc "usage: unbcode [-v] [-i] [-d] [-help] filename ..." .byte chrCR .asc " [-v]=verbose, [-i]=informative, [-d]=debugging info" .byte chrCR,0 enoughArgs = * ;** set globals lda #true sta informative lda #false sta verbose lda #false sta debug lda #0 ldy #0 jsr getarg lda zp+0 ldy zp+1 sta progName+0 sty progName+1 lda #false sta filenameUsed lda #0 sta tempPrefix sta tempName+2 sta tempName+3 jsr loadStatusFile ;** get input buffer length sec lda aceStackPtr+0 sbc #<inBuf sta inBufLen+0 lda aceStackPtr+1 sbc #>inBuf sta inBufLen+1 lda #0 sta arg+0 sta arg+1 mainNext = * jsr checkStop inc arg+0 bne + inc arg+1 + lda arg+0 ldy arg+1 jsr getarg lda zp+0 ora zp+1 beq mainExit lda zp+0 ldy zp+1 sta name+0 sty name+1 ldy #0 lda (zp),y cmp #"-" bne + jsr handleFlags jmp mainNext + jsr echo jsr unbcode bcc + jsr error + jmp mainNext mainExit = * ;xx should read from stdin if no files jsr saveStatusFile rts handleFlags = * iny lda (zp),y bne + rts + cmp #"d" beq flagD cmp #"v" beq flagV cmp #"i" beq flagI cmp #"h" bne + jmp usage + nop ;xx unrecognized option jmp handleFlags flagD = * lda #true sta debug sta verbose sta informative ;xx print stuff jmp handleFlags flagV = * lda #true sta verbose sta informative ;xx print version jmp handleFlags flagI = * lda #true sta informative jmp handleFlags error = * lda #<errorMsg1 ldy #>errorMsg1 jsr eputs lda name+0 ldy name+1 jsr eputs lda #<errorMsg2 ldy #>errorMsg2 jsr eputs rts errorMsg1 = * .asc "Error attempting to unbcode file " .byte chrQuote,0 errorMsg2 = * .byte chrQuote .asc ", continuing" .byte chrCR,0 echo = * lda #<echoMsg1 ldy #>echoMsg1 jsr eputs lda name+0 ldy name+1 jsr eputs lda #<echoMsg2 ldy #>echoMsg2 jmp eputs echoMsg1 = * .asc "unbcoding file " .byte chrQuote,0 echoMsg2 = * .byte chrQuote .asc "..." .byte chrCR,0 checkStop = * jsr stopkey bcs + rts + lda #<stoppedMsg ldy #>stoppedMsg jsr eputs jmp die stoppedMsg = * .asc "<Stopped>" .byte chrCR,0 .seq unbcodehelp.s statFcb .buf 1 statHR .buf 1 writeStatusData = * ;( statFcb ) lda #255 sta statHR writeStatusNext = * inc statHR lda statHR cmp haveCount bcc + rts + jsr getH ldy #10 - lda (h),y sta work,y dey bpl - ;** from segment ldx #work+hrFromSeg jsr writeNum5 ;** to segment ldx #work+hrToSeg jsr writeNum5 ;** beg/mid/end ldx #12 lda work+hrIsEnd bne + ldx #6 lda work+hrFromSeg+0 cmp #1 bne + lda work+hrFromSeg+1 cmp #0 bne + ldx #0 + txa ldy #>begMidEndMsg clc adc #<begMidEndMsg bcc + iny + ldx statFcb jsr fputs ;** length ldx #work+hrValidLength jsr writeNum10 ;** temp name lda #<tempNamePrefix ldy #>tempNamePrefix ldx statFcb jsr fputs ldx #work+hrTempFileName jsr writeNum5 ;** filename lda h+0 ldy h+1 clc adc #hrFilename bcc + iny + ldx statFcb jsr fputs lda #chrCR ldx statFcb jsr putc jmp writeStatusNext begMidEndMsg = * .byte "b","e","g"," "," ",0 .byte "m","i","d"," "," ",0 .byte "e","n","d"," "," ",0 tempNamePrefix = * .asc "0BC" .byte 0 saveStatusFile = * bit verbose bpl + lda #<saveStatMsg ldy #>saveStatMsg jsr eputs + lda #<statusFilename ldy #>statusFilename sta zp+0 sty zp+1 lda haveCount bne ++ lda statusFileExists bne + rts + jsr remove rts + lda #"w" jsr openOverwrite bcc + lda #<statusWriteErrMsg ldy #>statusWriteErrMsg jsr eputs lda #stderr + sta statFcb jsr writeStatusData lda statFcb cmp #stderr beq + jsr close + rts saveStatMsg = * .asc "saving status file 0BC-STAT" .byte chrCR,0 statusFilename = * .asc "0BC-STAT" .byte 0 statusWriteErrMsg = * .asc "Cannot open " .byte chrQuote .asc "0BC-STAT" .byte chrQuote .asc ", writing status to stderr:" .byte chrCR,0 discardSegment = * lda curHave jsr getH ldy #hrFromSeg lda segnum+0 cmp (h),y bne discardAppendedSeg iny lda segnum+1 cmp (h),y bne discardAppendedSeg ;** this is the only segment in the fragment, delete it lda #<discMsg ldy #>discMsg jsr eputs jsr fetchTempName lda #true jsr getTempNameStr lda #<tempNameStr ldy #>tempNameStr sta zp+0 sty zp+1 jsr remove lda curHave jsr removeHaveRec discardSegExit = * bit debug bpl + ldx #stderr stx statFcb jsr writeStatusData + rts discMsg = * .asc "discarding segment" .byte chrCR,0 discardAppendedSeg = * ldy #hrToSeg sec lda segnum+0 sbc #1 sta (h),y iny lda segnum+1 sbc #0 sta (h),y lda #<discAppMsg ldy #>discAppMsg jsr eputs ;** get and open new temp file jsr getTempFileNameOnly lda #"w" sta fileMode jsr openTempFile lda outfile sta fout bcs discardSegExit ;** open old temp file lda curHave jsr getH ldy #hrTempFileName lda (h),y pha lda tempName+0 sta (h),y pla sta tempName+0 iny lda (h),y pha lda tempName+1 sta (h),y pla sta tempName+1 lda #"r" sta fileMode jsr openTempFile lda outfile sta fin bcc + lda fout jsr close jmp discardSegExit + sta fin ;** copy valid contents into new temp file ldx #3 ldy #hrValidLength+3 - lda (h),y sta bytes,x dey dex bpl - jsr copyFile ;** remove old temp file lda #<tempNameStr ldy #>tempNameStr sta zp+0 sty zp+1 jsr remove jmp discardSegExit discAppMsg = * .asc "discarding appended segment" .byte chrCR,0 loadStatusFile = * bit verbose bpl + lda #<loadStatMsg ldy #>loadStatMsg jsr eputs + lda #0 sta haveCount lda #false sta statusFileExists lda #1 ldy #0 sta nextTempName+0 sty nextTempName+1 lda #<statusFilename ldy #>statusFilename sta zp+0 sty zp+1 lda #"r" jsr open bcs + sta statFcb lda #true sta statusFileExists jsr scanStatusFile lda statFcb jsr close + rts loadStatMsg = * .asc "scanning status file 0BC-STAT" .byte chrCR,0 ssPos .buf 1 scanStatusFile = * ;** read status line ldx #0 stx ssPos - ldx statFcb jsr getc bcc + rts + cmp #chrCR beq + ldx ssPos cpx #maxLine-1 bcs - sta inLine,x inc ssPos jmp - + lda #0 ldx ssPos sta inLine,x cpx #42 bcc scanStatusFile sta inLine+52 ;** scan status line bit debug bpl + lda #<inLine ldy #>inLine jsr eputs lda #chrCR jsr eputchar + ldx #hrSize-1 lda #0 - sta tempHaveRec,x dex bpl - ;0----+----1----+----2----+----3----+----4----+----5----+-- ;00001 00002 beg 0000001140 0BC00007 new4 ;00004 00004 end 0000000189 0BC00004 1234567890123456. ;00002 00003 end 0000000529 0BC00006 new5 ;** filename ldx #0 - lda inLine+41,x sta tempHaveRec+hrFilename,x beq + inx bne - ;** isEnd + ldx #true lda inLine+14 cmp #"e" beq + ldx #false + stx tempHaveRec+hrIsEnd ;** fromSeg ldy #0 jsr scanNum bcs scanErr lda scanVal+0 ldy scanVal+1 sta tempHaveRec+hrFromSeg+0 sty tempHaveRec+hrFromSeg+1 ;** toSeg ldy #7 jsr scanNum bcs scanErr lda scanVal+0 ldy scanVal+1 sta tempHaveRec+hrToSeg+0 sty tempHaveRec+hrToSeg+1 ;** validLength ldy #19 jsr scanNum bcs scanErr lda scanVal+0 ldy scanVal+1 sta tempHaveRec+hrValidLength+0 sty tempHaveRec+hrValidLength+1 lda scanVal+2 ldy scanVal+3 sta tempHaveRec+hrValidLength+2 sty tempHaveRec+hrValidLength+3 ;** tempFileName ldy #34 jsr scanNum bcs scanErr lda scanVal+0 ldy scanVal+1 sta tempHaveRec+hrTempFileName+0 sty tempHaveRec+hrTempFileName+1 ;** store status info lda haveCount cmp #maxHave bcc + lda #<scanTooManyFrags ldy #<scanTooManyFrags jsr eputs scanErr = * jmp scanStatusFile + lda haveCount inc haveCount jsr getH ldy #hrSize-1 - lda tempHaveRec,y sta (h),y dey bpl - jmp scanStatusFile scanTooManyFrags = * .asc "too many fragments in 0BC-STAT, ignoring fragment" .byte chrCR,0 ;===bss=== bss = * inLine = bss+0 tempPrefix = inLine+maxLine tempNameStr = tempPrefix+20 haves = tempNameStr+maxFilename copyBuf = hrSize*maxHave+haves decodeTable = copyBuf+copyBufSize tempHaveRec = decodeTable+256 inBuf = tempHaveRec+hrSize bssEnd = inBuf+64 unbcodehelp.s 1598 unbcode = * ;** open file lda name+0 ldy name+1 sta zp+0 sty zp+1 lda #"r" jsr open bcc + rts + sta infile ;** decode file jsr unbcodeBody ;** close file lda infile jsr close rts unbcodeBody = * lda #0 sta bufCount+0 sta bufCount+1 sta hitLastLine sta lastLineTerminator ;** search for "begin" line searchLine = * jsr getline bcc + clc rts + lda inLine cmp #"-" bne searchLine jsr checkStop ldx #0 lda inLine+2 cmp #"b" beq + ldx #asciiBegin-petsciiBegin + ldy #0 - lda inLine,y cmp petsciiBegin,x bne searchLine inx iny cpy #asciiBegin-petsciiBegin bcc - ldy #0 cpx #asciiBegin-petsciiBegin+1 bcc + ldy #$ff + sty asciiFile jmp processBegin petsciiBegin = * .asc "--bcode-begin " asciiBegin = * .byte $2d,$2d,$62,$63,$6f,$64,$65,$2d,$62,$65,$67,$69,$6e,$20 ;** process "begin" line processBegin = * ;** extract the segment number ldy #14 jsr scanNum bcc + jmp beginError + iny lda scanVal+2 ora scanVal+3 beq + lda #<segTooBigMsg ldy #>segTooBigMsg jsr eputs jmp searchLine + lda scanVal+0 ldx scanVal+1 sta segnum+0 stx segnum+1 lda #0 sta segnum+2 sta segnum+3 lda segnum+0 ora segnum+1 bne + jmp beginError ;** extract filename, trunc to 16 chars + clc tya adc #<inLine sta outName+0 lda #>inLine adc #0 sta outName+1 ldy #16 lda #0 sta (outName),y jsr makePetsciiName jsr echoExtractName ;** open output file jsr getTempFile bcc + jmp searchLine ;** read bcoded data + jsr buildDecodeTable jsr crcInit - jsr getline bcs unexpectedEof jsr convertLine bcc + ;** check if segment-end line lda inLine cmp #"-" beq finishFile ;** report invalid characters lda #<badCharsMsg ldy #>badCharsMsg jsr eputs jmp - + jsr crunchLine jsr crcLine jsr writeLine jmp - ;** finish with file finishFile = * lda outfile jsr close jsr crcFinish jsr processFinish ;** process for another file jmp searchLine unexpectedEof = * lda #<unexEofMsg ldy #>unexEofMsg jsr eputs lda outfile jsr close jsr discardSegment sec rts unexEofMsg = * .asc "unexpected EOF, ignoring segment." .byte chrCR,0 segTooBigMsg = * .asc "segment number is larger than 65535, ignoring segment." .byte chrCR,0 badCharsMsg = * .asc "warning: bad characters on line, ignoring line." .byte chrCR,0 makePetsciiName = * bit asciiFile bmi + rts + ldy #0 - lda (outName),y beq + jsr convAsc2Pet sta (outName),y iny bne - + rts convAsc2Pet = * and #$7f cmp #$60 bcc + clc adc #$c0-$60 + tax and #$7f cmp #"a" bcs + - txa rts + cmp #"z"+1 bcs - txa eor #$80 rts echoExtractName = * lda #<echoExtractMsg1 ldy #>echoExtractMsg1 jsr eputs lda #<numbuf ldy #>numbuf sta syswork+0 sty syswork+1 lda #1 ldx #segnum jsr utoa lda #<numbuf ldy #>numbuf jsr eputs lda #<echoExtractMsg2 ldy #>echoExtractMsg2 jsr eputs lda outName+0 ldy outName+1 jsr eputs lda #<echoExtractMsg3 ldy #>echoExtractMsg3 jmp eputs echoExtractMsg1 = * .asc "extracting seg " .byte 0 echoExtractMsg2 = * .asc " of " .byte chrQuote,0 echoExtractMsg3 = * .byte chrQuote,chrCR,0 numbuf .buf 12 reportOpenError = * lda zp+0 ldy zp+1 jsr eputs lda #<reportOpenErrorMsg ldy #>reportOpenErrorMsg jsr eputs rts reportOpenErrorMsg = * .asc ": cannot open, continuing" .byte chrCR,0 scanDigit .buf 1 scanSave .buf 4 scanTemp .buf 1 scanIndex .buf 1 scanAnything .buf 1 scanNum = * ;( .Y=inLineIndex ) : .Y=scan, [scanVal]=num, .CS=err ldx #3 lda #0 - sta scanVal,x dex bpl - lda #0 sta scanAnything - lda inLine,y cmp #" " bne scanNumNext iny bne - sec rts scanNumNext = * lda inLine,y cmp #"0" bcc + cmp #"9"+1 bcc ++ + lda scanAnything beq scanError clc rts + and #$0f sta scanDigit lda #$ff sta scanAnything ;** times ten sty scanTemp ldx #3 - lda scanVal,x sta scanSave,x dex bpl - lda #2 sta scanIndex - clc ldy #4 ldx #0 - rol scanVal,x inx dey bne - bcs scanError dec scanIndex bne -- clc ldy #4 ldx #0 - lda scanVal,x adc scanSave,x sta scanVal,x inx dey bne - bcs scanError clc ldy #4 ldx #0 - rol scanVal,x inx dey bne - bcs scanError clc ldy #4 ldx #0 lda scanDigit - adc scanVal,x sta scanVal,x lda #0 inx dey bne - bcs scanError ldy scanTemp iny beq scanError jmp scanNumNext scanError = * sec rts beginError = * lda #<beginErrorMsg ldy #>beginErrorMsg jsr eputs jmp searchLine beginErrorMsg = * .asc "invalid --bcode-begin line format, ignoring segment" .byte chrCR,0 convertPads .buf 1 convertChars .buf 1 convertLine = * ldx #0 stx convertPads - lda inLine,x bne + stx convertChars clc rts + cmp #"=" bne + inc convertPads + tay lda decodeTable,y bmi + sta inLine,x inx bne - + sec rts crunchBytes .buf 1 crunchLine = * ldx #0 ldy #0 - jsr crunchQuantum cpx convertChars bcc - tya sec sbc convertPads sta crunchBytes rts ;pos 76543210 76543210 76543210 76543210 ;byt xx111111 xx112222 xx222233 xx333333 ;bit 765432 107654 321076 543210 crunchQuantum = * ;(.X=In4bytesOffset, .Y=Out3bytesOffset) : .X++, .Y++ lda inLine,x ;*** output byte 0 asl asl sta temp inx lda inLine,x lsr lsr lsr lsr and #%00000011 ora temp sta inLine,y iny lda inLine,x ;*** output byte 1 asl asl asl asl sta temp inx lda inLine,x lsr lsr and #%00001111 ora temp sta inLine,y iny lda inLine,x ;*** output byte 2 inx ror ror ror and #%11000000 sta temp lda inLine,x inx and #%00111111 ora temp sta inLine,y iny rts writeLine = * lda #<inLine ldy #>inLine sta zp+0 sty zp+1 lda crunchBytes ldy #0 ldx outfile jsr write rts ;** crc = 0xFFFFFFFF; ;** while( (c=getc(fp)) != EOF ) { ;** crc = (crc>>8) & 0x00FFFFFF ^ crcTable[ (crc^c) & 0xFF ]; ;** } ;** return( crc^0xFFFFFFFF ); crcInit = * ldx #3 - lda #$ff sta crc,x lda #0 sta bytes,x dex bpl - rts crcLine = * ldy #0 cpy crunchBytes bcs + - lda inLine,y ;.X = (crc^c) & 0xFF eor crc+0 tax lda crc+1 ;crc = (crc>>8) & 0x00FFFFFF ^ crcTable[ .X ] eor crcTable0,x sta crc+0 lda crc+2 eor crcTable1,x sta crc+1 lda crc+3 eor crcTable2,x sta crc+2 lda crcTable3,x sta crc+3 iny cpy crunchBytes bcc - + clc lda bytes+0 adc crunchBytes sta bytes+0 bcc + inc bytes+1 bne + inc bytes+2 bne + inc bytes+3 + rts crcFinish = * ldx #3 - lda crc,x eor #$ff sta crc,x dex bpl - rts hitLastLine .buf 1 lastLineTerminator .buf 1 getline = * lda hitLastLine beq + sec rts + ldx #0 stx getlinePos ;** toss an LF that follows a CR jsr getByte bcs getlineProcess cmp #chrLF clc bne getlineProcess ldx lastLineTerminator cpx #chrCR clc bne getlineProcess getlineChar = * jsr getByte getlineProcess = * bcc + lda #$ff sta hitLastLine jmp getlineFinish + cmp #chrCR beq getlineFinish cmp #chrLF beq getlineFinish ldx getlinePos cpx #98 bcs + sta inLine,x inc getlinePos + jmp getlineChar getlineFinish = * sta lastLineTerminator ldx getlinePos lda #0 sta inLine,x cpx #0 beq + clc rts + lda hitLastLine cmp #1 rts getByte = * lda bufCount+0 ora bufCount+1 beq getByteFillBuf ldy #0 lda (bufPtr),y inc bufPtr+0 bne + inc bufPtr+1 + ldx bufCount+0 bne + dec bufCount+1 + dec bufCount+0 clc rts getByteFillBuf = * jsr checkStop lda #<inBuf ldy #>inBuf sta zp+0 sty zp+1 sta bufPtr+0 sty bufPtr+1 lda inBufLen+0 ldy inBufLen+1 ldx infile jsr read beq + bcs + sta bufCount+0 sty bufCount+1 jsr checkStop jmp getByte + sec rts setIndex .buf 1 setCountdown .buf 1 buildDecodeTable = * ldx #0 lda #$ff - sta decodeTable,x inx bne - ldy #0 ldx #0 bit asciiFile bpl + ldx #ascTableSet-petTableSet + stx setIndex lda #5 sta setCountdown - ldx setIndex lda petTableSet+1,x sta temp lda petTableSet+0,x inx inx stx setIndex ldx temp jsr buildSet dec setCountdown bne - lda #0 sta decodeTable+$3d rts petTableSet .asc "AZaz09++//" ascTableSet .byte $41,$5a,$61,$7a,$30,$39,$2b,$2b,$2f,$2f setLimit .buf 1 buildSet = * inx stx setLimit tax - tya sta decodeTable,x iny inx cpx setLimit bcc - rts processFinish = * ;process the bcode-end line lda #true sta isEnd ldx #ascEnd-petEnd-1 bit asciiFile bpl + ldx #petCont-petEnd-1 + ldy #ascEnd-petEnd-1 jsr compareFinish ldy #ascEnd-petEnd-1 bcc finCheckSegment lda #false sta isEnd ldx #ascCont-petEnd-1 bit asciiFile bpl + ldx #ascContEnd-petEnd-1 + ldy #ascCont-petCont-1 jsr compareFinish ldy #ascCont-petCont bcc finCheckSegment lda #0 jmp badFinish finCheckSegment = * jsr scanNum bcc + - lda #1 jmp badFinish + ldx #3 - lda scanVal,x cmp segnum,x bne -- dex bpl - finCheckSize = * jsr scanNum bcc + - lda #2 jmp badFinish + ldx #3 - lda scanVal,x cmp bytes,x bne -- dex bpl - finCheckCrc = * iny jsr scanHex bcc + - lda #3 jmp badFinish + ldx #3 - lda scanVal,x cmp crc,x bne -- dex bpl - jsr commitSegment bit debug bpl + ldx #stderr stx statFcb jsr writeStatusData + jsr checkStop clc rts scanHex = * ldx #3 - lda inLine,y iny jsr hexToBin bcs + asl asl asl asl sta temp lda inLine,y iny jsr hexToBin bcs + ora temp sta scanVal,x dex bpl - clc + rts hexToBinXsave .buf 1 hexToBin = * bit asciiFile bpl + stx hexToBinXsave jsr convAsc2Pet ldx hexToBinXsave + cmp #"0" bcs + - sec rts + cmp #"9"+1 bcc + and #$7f cmp #"a" bcc - cmp #"f"+1 bcs - sec sbc #"a"-$0a + and #$0f clc rts compareFinish = * - lda inLine,y cmp petEnd,x bne + dex dey bpl - clc rts + sec rts badFinish = * ;.A=error [0=token,1=segment,2=size,3=crc] pha lda name+0 ldy name+1 jsr eputs pla asl tax lda badFinVec+1,x tay lda badFinVec+0,x jsr eputs lda #<badFinDiscard ldy #>badFinDiscard jsr eputs jsr discardSegment jsr checkStop rts badFinVec = * .word badFinToken,badFinSegment,badFinSize,badFinCrc badFinToken = * .asc ": invalid token on finish line" .byte 0 badFinSegment = * .asc ": segment number mismatch" .byte 0 badFinSize = * .asc ": file size mismatch" .byte 0 badFinCrc = * .asc ": CRC-32 checksum mismatch" .byte 0 badFinDiscard = * .asc ", ignoring segment" .byte chrCR,0 petEnd .asc "--bcode-end " ascEnd .byte $2d,$2d,$62,$63,$6f,$64,$65,$2d,$65,$6e,$64,$20 petCont .asc "--bcode-continued " ascCont .byte $2d,$2d,$62,$63,$6f,$64,$65,$2d,$63,$6f,$6e,$74,$69,$6e,$75 .byte $65,$64,$20 ascContEnd = * getTempNameStr = * ;( tempName, .A=putFiletype ) : tempNameStr, (zp) pha lda #"0" sta tempNameStr+0 lda #"B" sta tempNameStr+1 lda #"C" sta tempNameStr+2 lda #<tempNameStr+3 ldy #>tempNameStr+3 sta syswork+0 sty syswork+1 sta zp+0 sty zp+1 ldx #tempName lda #5 jsr utoaz pla cmp #false beq + lda #"," sta tempNameStr+3,y lda #"p" sta tempNameStr+4,y lda #0 sta tempNameStr+5,y + rts utoaz = * ;( 0+.X=var32, .A=width, (syswork)=store ) jsr utoa ldy #0 - lda (syswork),y beq ++ cmp #" " bne + lda #"0" sta (syswork),y + iny bne - + rts fileMode .buf 1 getTempFile = * ;( outName, segnum ) : curHave, curHaveNum, outfile, .CS=err ;** search to append to existing file lda #255 sta curHave checkNext = * inc curHave lda curHave cmp haveCount bcc + jmp cannotAppend + jsr getH jsr cmpOutNameH cmp #0 bne checkNext ldy #hrFromSeg lda segnum+0 cmp (h),y lda segnum+1 iny sbc (h),y bcc + ldy #hrToSeg lda (h),y cmp segnum+0 iny lda (h),y sbc segnum+1 bcc + lda #<ignoreDupMsg ldy #>ignoreDupMsg jsr eputs sec rts ignoreDupMsg = * .asc "ignoring duplicate segment" .byte chrCR,0 + ldy #hrToSeg lda (h),y tax iny lda (h),y tay inx bne + iny + cpx segnum+0 bne + cpy segnum+1 beq canAppend + jmp checkNext ;** here we know we can append to an existing temp file canAppend = * lda #"a" sta fileMode ldy #hrTempFileName lda (h),y sta tempName+0 iny lda (h),y sta tempName+1 ldy #hrToSeg lda segnum+0 sta (h),y iny lda segnum+1 sta (h),y ldy #hrIsEnd lda #false sta (h),y jmp openTempFile ;** cannot append cannotAppend = * jsr getTempFileNameOnly ;** create new have record createNewHaveRec = * jsr insertHaveRec bcs + lda #"w" sta fileMode jmp openTempFile + lda #<haveOverMsg ldy #>haveOverMsg jsr eputs sec rts haveOverMsg = * .asc "fragment table full, ignoring current segment" .byte chrCR,0 ;** open temporary file openTempFile = * lda #true jsr getTempNameStr lda #<tempNameStr ldy #>tempNameStr sta zp+0 sty zp+1 lda fileMode jsr openOverwrite bcs + sta outfile clc rts + lda #<tempNameStr ldy #>tempNameStr jsr eputs lda #<openErrMsg ldy #>openErrMsg jsr eputs sec rts openErrMsg = * .asc ": cannot open, ignoring segment" .byte chrCR,0 getTempFileNameOnly = * ;( nextTempName ) : tempName lda nextTempName+0 ldy nextTempName+1 sta tempName+0 sty tempName+1 inc nextTempName+0 bne + inc nextTempName+1 + lda #0 sta work - cmp haveCount bcc + rts + lda work jsr getH ldy #hrTempFileName lda (h),y cmp tempName+0 bne + iny lda (h),y cmp tempName+1 bne + jmp getTempFileNameOnly + inc work lda work jmp - getH = * ;( .A=haveRecNum ) : h ldx #0 stx h+1 ldx #5 - asl rol h+1 dex bne - clc adc #<haves sta h+0 lda h+1 adc #>haves sta h+1 rts getNextH = * ;( h ) : nextH clc lda h+0 adc #hrSize sta nextH+0 lda h+1 adc #0 sta nextH+1 rts cmpOutNameH = * ;( (outName)=str1, (h)=hrec ) : .A=cmpResult[0=EQ,1=GT,-1=LT] lda h+0 ldy h+1 clc adc #hrFilename bcc + iny + sta work+0 sty work+1 ldy #255 - iny lda (outName),y cmp (work),y bne + cmp #0 bne - lda #0 rts + bcc + lda #1 rts + lda #$ff rts insertHaveRec = * ;( segnum, tempName, outName ) : curHave ;** allocate new record lda haveCount cmp #maxHave bcc + rts + sta curHave inc haveCount ;** find correct position for new record - dec curHave lda curHave cmp #$ff beq insertHaveRecInit jsr getH jsr cmpOutNameH cmp #1 beq insertHaveRecInit cmp #0 bne + ldy #hrFromSeg lda (h),y cmp segnum+0 iny lda (h),y sbc segnum+1 bcc insertHaveRecInit + jsr getNextH ldy #hrSize-1 - lda (h),y sta (nextH),y dey bpl - jmp -- ;** initialize record insertHaveRecInit = * inc curHave ldx #hrSize-1 lda #0 - sta tempHaveRec,x dex bpl - lda segnum+0 ldy segnum+1 sta tempHaveRec+hrFromSeg+0 sty tempHaveRec+hrFromSeg+1 sta tempHaveRec+hrToSeg+0 sty tempHaveRec+hrToSeg+1 lda #false sta tempHaveRec+hrIsEnd lda tempName+0 ldy tempName+1 sta tempHaveRec+hrTempFileName+0 sty tempHaveRec+hrTempFileName+1 ldy #0 - lda (outName),y sta tempHaveRec+hrFilename,y beq + iny cpy #16 bcc - + lda curHave jsr getH ldy #hrSize-1 - lda tempHaveRec,y sta (h),y dey bpl - clc rts writeNum5 = * ;( 0+.X=num16 ) lda 0,x sta work+12 lda 1,x sta work+13 lda #0 sta work+14 sta work+15 ldx #work+12 lda #5 jmp writeNum writeNum10 = * ;( 0+.X=num32 ) lda #10 writeNum = * pha lda #<numbuf ldy #>numbuf sta syswork+0 sty syswork+1 pla jsr utoaz lda #<numbuf ldy #>numbuf ldx statFcb jsr fputs jsr writeSpaces rts writeSpaces = * lda #<spacesMsg ldy #>spacesMsg ldx statFcb jsr fputs rts spacesMsg = * .byte $20,$20,0 commitSegment = * ;** add byte length, update IsEnd flag in haverec lda curHave jsr getH ldx #4 ldy #hrValidLength clc - lda (h),y adc bytes-hrValidLength,y sta (h),y iny dex bne - ldy #hrIsEnd lda isEnd sta (h),y jsr checkCoalesce jsr checkComplete rts checkFilenamePtr .buf 2 checkComplete = * lda curHave jsr getH ldy #hrIsEnd lda (h),y bne + - rts + ldy #hrFromSeg lda (h),y cmp #1 bne - iny lda (h),y bne - jsr fetchTempName lda #false jsr getTempNameStr lda #<tempNameStr ldy #>tempNameStr sta zp+0 sty zp+1 lda h+0 ldy h+1 clc adc #hrFilename bcc + iny + sta zw+0 sty zw+1 sta checkFilenamePtr+0 sty checkFilenamePtr+1 jsr renameOverwrite lda #<completeMsg1 ldy #>completeMsg1 jsr eputs lda checkFilenamePtr+0 ldy checkFilenamePtr+1 jsr eputs lda #<completeMsg2 ldy #>completeMsg2 jsr eputs lda curHave jsr removeHaveRec rts completeMsg1 = * .asc "--Reassembled " .byte chrQuote,0 completeMsg2 = * .byte chrQuote,chrCR,0 removeHaveRec = * ;( .A=haveRec ) dec haveCount sta haveRec - lda haveRec cmp haveCount bcc + rts + lda haveRec jsr getH jsr getNextH ldy #hrSize-1 - lda (nextH),y sta (h),y dey bpl - inc haveRec jmp -- checkFromPlus1 .buf 2 checkCoalesce = * ;( curHave ) ldx curHave inx cpx haveCount bcc + - rts + lda curHave jsr getH jsr getNextH clc lda nextH+0 adc #hrFilename sta outName+0 lda nextH+1 adc #0 sta outName+1 jsr cmpOutNameH cmp #0 bne - ldy #hrToSeg clc lda (h),y adc #1 sta checkFromPlus1+0 iny lda (h),y adc #0 sta checkFromPlus1+1 ldy #hrFromSeg lda (nextH),y cmp checkFromPlus1+0 bne - iny lda (nextH),y cmp checkFromPlus1+1 bne - lda #<coalesceMsg1 ldy #>coalesceMsg1 jsr eputs lda h+0 ldy h+1 jsr eputRange lda #"," jsr eputchar lda #" " jsr eputchar lda nextH+0 ldy nextH+1 jsr eputRange lda #<coalesceMsg2 ldy #>coalesceMsg2 jsr eputs clc lda h+0 adc #hrFilename ldy h+1 bcc + iny + jsr eputs lda #chrQuote jsr eputchar lda #chrCR jsr eputchar ldx curHave inx lda #"r" jsr openTemp bcc + rts + sta fin ldx curHave lda #"a" jsr openTemp bcc + lda fin jsr close + sta fout lda curHave jsr getH jsr getNextH ldy #hrValidLength+3 ldx #3 - lda (nextH),y sta bytes,x dey dex bpl - jsr copyFile lda fout jsr close lda fin jsr close ldy #hrIsEnd lda (nextH),y sta (h),y ldy #hrToSeg lda (nextH),y sta (h),y iny lda (nextH),y sta (h),y ldx #4 ldy #hrValidLength clc - lda (h),y adc (nextH),y sta (h),y iny dex bne - lda curHave clc adc #1 jsr getH jsr fetchTempName lda #false jsr getTempNameStr lda #<tempNameStr ldy #>tempNameStr sta zp+0 sty zp+1 jsr remove bcc + nop ;xx error msg + lda curHave clc adc #1 jsr removeHaveRec rts coalesceMsg1 = * .asc "coalescing segs " .byte 0 coalesceMsg2 = * .asc " of " .byte chrQuote,0 eputRange = * sta work+0 sty work+1 ldy #hrFromSeg jsr eputHaveNum lda #"-" jsr eputchar ldy #hrToSeg eputHaveNum = * lda (work),y sta work+4 iny lda (work),y sta work+5 lda #0 sta work+6 sta work+7 lda #<numbuf ldy #>numbuf sta syswork+0 sty syswork+1 lda #1 ldx #work+4 jsr utoa lda #<numbuf ldy #>numbuf jsr eputs rts fetchTempName = * ;( h ) ldy #hrTempFileName lda (h),y sta tempName+0 iny lda (h),y sta tempName+1 rts openTemp = * ;( .X=haveRec, .A=mode ) : .A=fcb, .CS=err pha txa jsr getH jsr fetchTempName lda #true jsr getTempNameStr lda #<tempNameStr ldy #>tempNameStr sta zp+0 sty zp+1 pla jsr open bcc + lda #<tempNameStr ldy #>tempNameStr jsr eputs lda #<openTempMsg ldy #>openTempMsg jsr eputs sec + rts openTempMsg = * .asc ": cannot open, should be able to, continuing" .byte chrCR,0 copySegLen .buf 2 .byte $00,$00 copyFile = * ;( fin, fout, bytes-- ) lda #<copyBuf ldy #>copyBuf sta zp+0 sty zp+1 lda bytes+2 ora bytes+3 bne + lda bytes+0 cmp #<copyBufSize lda bytes+1 sbc #>copyBufSize bcs + lda bytes+0 ldy bytes+1 jmp ++ + lda #<copyBufSize ldy #>copyBufSize + ldx fin jsr read beq + sta copySegLen+0 sty copySegLen+1 ldx fout jsr write sec ldy #4 ldx #0 - lda bytes,x sbc copySegLen,x sta bytes,x inx dey bne - lda bytes+0 ora bytes+1 ora bytes+2 ora bytes+3 bne copyFile rts + lda bytes+0 ora bytes+1 ora bytes+2 ora bytes+3 bne + rts + lda #<copyLenMsg ldy #>copyLenMsg jsr eputs rts copyLenMsg = * .asc "Insufficient temp data coalesced, shouldn't happen, continuing" .byte chrCR,0 openOvMode .buf 1 openOverwrite = * ;( (zp)=name, .A=mode ) : .A=Fcb, .CS=err sta openOvMode jsr open bcs + rts + lda errno cmp #aceErrFileExists beq + - jsr reportOpenError sec rts + jsr remove lda openOvMode jsr open bcs - rts renameOvName .buf 2 renameOverwrite = * ;( (zp)=name, (zw)=newName ) : .CS=err jsr rename bcs + rts + lda zp+0 ldy zp+1 sta renameOvName+0 sty renameOvName+1 lda errno cmp #aceErrFileExists beq + - jsr reportRenameError sec rts + lda zw+0 ldy zw+1 sta zp+0 sty zp+1 jsr remove lda renameOvName+0 ldy renameOvName+1 sta zp+0 sty zp+1 jsr rename bcs - rts renameOvNewName .buf 2 reportRenameError = * lda zw+0 ldy zw+1 sta renameOvNewName+0 sty renameOvNewName+1 lda #<renameErrMsg1 ldy #>renameErrMsg1 jsr eputs lda renameOvName+0 ldy renameOvName+1 jsr eputs lda #<renameErrMsg2 ldy #>renameErrMsg2 jsr eputs lda renameOvNewName+0 ldy renameOvNewName+1 jsr eputs lda #<renameErrMsg3 ldy #>renameErrMsg3 jsr eputs rts renameErrMsg1 = * .asc "Cannot rename " .byte chrQuote,0 renameErrMsg2 = * .byte chrQuote .asc " to " .byte chrQuote,0 renameErrMsg3 = * .byte chrQuote .asc ", continuing." .byte chrCR,0 uudecode.s 660 ;*** uudecode program .seq acehead.s .org aceAppAddress .obj "@0:uudecode" jmp uudecodeMain .asc "cB" ;*** global declarations libwork = $60 chrLF = $0a chrCR = $0d chrQuote = $22 asciiFile .buf 1 temp .buf 1 ;******** standard library ******** puts = * ldx #stdout fputs = * sta zp sty zp+1 ldy #$ff - iny lda (zp),y bne - tya ldy #0 jmp write eputs = * ldx #stderr jmp fputs putchar = * ldx #stdout putc = * sta putcBuffer lda #<putcBuffer ldy #>putcBuffer sta zp sty zp+1 lda #1 ldy #0 jmp write putcBuffer .buf 1 getchar = * ldx #stdin getc = * lda #<getcBuffer ldy #>getcBuffer sta zp sty zp+1 lda #1 ldy #0 jsr read beq + lda getcBuffer rts + sec rts getcBuffer .buf 1 getarg = * sty zp+1 asl sta zp rol zp+1 clc lda aceArgv adc zp sta zp lda aceArgv+1 adc zp+1 sta zp+1 ldy #0 lda (zp),y tax iny lda (zp),y stx zp sta zp+1 rts ;===uudecode=== uudArg = 2 uudName = 4 inBufLen = 6 uudecodeMain = * ;** check argument count lda aceArgc+1 bne uudEnoughArgs lda aceArgc cmp #2 bcs uudEnoughArgs uudUsage = * lda #<uudUsageMsg ldy #>uudUsageMsg jmp puts uudUsageMsg = * .asc "Usage: uudecode file1 file2 ... fileN" .byte chrCR,0 uudEnoughArgs = * ;** get input buffer length sec lda aceStackPtr sbc #<uudInBuf sta inBufLen lda aceStackPtr+1 sbc #>uudInBuf sta inBufLen+1 ;** main loop lda #1 ldy #0 sta uudArg sty uudArg+1 - lda uudArg ldy uudArg+1 jsr getarg lda zp ldy zp+1 sta uudName sty uudName+1 ora zp+1 beq uudExit jsr uudEcho jsr uudecode bcc + jsr uudError + inc uudArg bne + inc uudArg+1 + jmp - uudExit = * rts uudError = * lda #<uudErrorMsg1 ldy #>uudErrorMsg1 jsr eputs lda uudName ldy uudName+1 jsr eputs lda #<uudErrorMsg2 ldy #>uudErrorMsg2 jmp eputs uudErrorMsg1 = * .asc "Error attempting to uudecode file " .byte chrQuote,0 uudErrorMsg2 = * .byte chrQuote,chrCR,0 uudEcho = * lda #<uudEchoMsg1 ldy #>uudEchoMsg1 jsr eputs lda uudName ldy uudName+1 jsr eputs lda #<uudEchoMsg2 ldy #>uudEchoMsg2 jmp eputs uudEchoMsg1 = * .asc "uudecoding file " .byte chrQuote,0 uudEchoMsg2 = * .byte chrQuote .asc "..." .byte chrCR,0 bufPtr = 8 bufCount = 10 infile = 12 outfile = 13 uudecode = * ;** open file lda uudName ldy uudName+1 sta zp sty zp+1 lda #"r" jsr open bcc + rts + sta infile ;** decode file jsr uudecodeBody ;** close file lda infile jsr close rts uudecodeBody = * lda #0 sta bufCount sta bufCount+1 sta hitLastLine sta lastLineTerminator ;** search for "begin" line uudSearchLine = * jsr getline bcc + rts + ldx #0 lda uudInLine cmp #"b" beq + ldx #asciiBegin-petsciiBegin + ldy #0 - lda uudInLine,y cmp petsciiBegin,x bne uudSearchLine inx iny cpy #6 bcc - ldy #0 cpx #asciiBegin-petsciiBegin+1 bcc + ldy #$ff + sty asciiFile lda uudInLine+9 cmp #" " bne uudSearchLine ldx #0 - lda uudInLine+6,x cmp #"0" bcc uudSearchLine cmp #"8" bcs uudSearchLine inx cpx #3 bcc - jmp processBegin petsciiBegin = * .asc "begin " asciiBegin = * .byte $62,$65,$67,$69,$6e,$20 ;** process "begin" line processBegin = * lda asciiFile beq + ;** jsr convert filename + jsr makePetsciiName jsr defaultPrgFile jsr echoExtractName lda #<uudInLine+10 ldy #>uudInLine+10 sta zp sty zp+1 lda #"w" jsr open bcc openOk lda errno cmp #aceErrFileExists beq + - jsr reportOpenError jmp uudSearchLine + jsr scratchFile lda #"w" jsr open bcs - openOk = * sta outfile ;** read uuencoded data - jsr getline bcs uudFinishFile jsr uuConvertLine bcc + ;** report invalid characters lda #<badCharsMsg ldy #>badCharsMsg jsr eputs jmp - + lda uudInLine beq uudFinishFile jsr uuCrunchLine jsr uuWriteLine jmp - ;** finish with file uudFinishFile = * lda outfile jsr close ;** process for another file jmp uudSearchLine badCharsMsg = * .asc "warning: bad characters in line; ignoring line." .byte chrCR,0 ;%%% makePetsciiName = * bit asciiFile bmi + rts + ldx #0 - lda uudInLine+10,x beq + jsr convAsc2Pet sta uudInLine+10,x inx bne - + rts convAsc2Pet = * and #$7f cmp #$60 bcc + clc adc #$c0-$60 + tay and #$7f cmp #"a" bcs + - tya rts + cmp #"z"+1 bcs - tya eor #$80 rts defaultPrgFile = * ldx #0 - lda uudInLine+10,x beq + inx bne - + lda uudInLine+8,x cmp #"," bne + rts + lda #"," sta uudInLine+10,x lda #"p" sta uudInLine+11,x lda #0 sta uudInLine+12,x rts echoExtractName = * lda #<echoExtractMsg1 ldy #>echoExtractMsg1 jsr eputs lda #<uudInLine+10 ldy #>uudInLine+10 jsr eputs lda #<echoExtractMsg2 ldy #>echoExtractMsg2 jmp eputs echoExtractMsg1 = * .asc "extracting file " .byte chrQuote,0 echoExtractMsg2 = * .byte chrQuote .asc "..." .byte chrCR,0 reportOpenError = * lda zp ldy zp+1 jsr eputs lda #<reportOpenErrorMsg ldy #>reportOpenErrorMsg jsr eputs rts reportOpenErrorMsg = * .asc ": cannot open; skipping this file." .byte chrCR,0 scratchFile = * lda #<scratchFileMsg1 ldy #>scratchFileMsg1 jsr eputs lda #<uudInLine+10 ldy #>uudInLine+10 jsr eputs lda #<scratchFileMsg2 ldy #>scratchFileMsg2 jsr eputs jsr getchar pha - cmp #chrCR beq + jsr getchar jmp - + lda #<uudInLine+10 ldy #>uudInLine+10 sta zp sty zp+1 pla cmp #"y" beq + cmp #"Y" beq + rts + jsr remove rts scratchFileMsg1 = * .asc "Overwrite existing file " .byte chrQuote,0 scratchFileMsg2 = * .byte chrQuote .asc "? " .byte 0 convertFill .buf 1 convertLen = 15 uuConvertLine = * lda #0 sta convertFill lda uudInLine bne + clc rts + jsr uuConvertChar bcc + rts + sta uudInLine ldx #60 cmp #46 bcc + ldx #84 + stx convertLen ldx #0 - cpx convertLen bcc + clc rts + bit convertFill bmi doConvertFill lda uudInLine+1,x beq + jsr uuConvertChar bcc convertCont rts + lda #$ff sta convertFill doConvertFill = * lda #0 convertCont = * sta uudInLine+1,x inx bne - rts uuConvertChar = * cmp #" " bcs + sec rts + cmp #"_"+1 bcs + sec sbc #" " clc rts + cmp #96 bne + - clc lda #0 rts + cmp #"`" beq - bcs + sec rts + cmp #"Z"+1 bcc + rts + sec sbc #"A"-33 clc rts uuCrunchLine = * ldx #0 ldy #0 - jsr uuCrunchGroup cpy uudInLine bcc - rts ;pos 76543210 76543210 76543210 76543210 ;byt xx111111 xx112222 xx222233 xx333333 ;bit 765432 107654 321076 543210 uuCrunchGroup = * ;(.X=In4bytesOffset, .Y=Out3bytesOffset) : .X++, .Y++ lda uudInLine+1,x ;*** output byte 0 asl asl sta temp inx lda uudInLine+1,x lsr lsr lsr lsr and #%00000011 ora temp sta uudInLine+1,y iny lda uudInLine+1,x ;*** output byte 1 asl asl asl asl sta temp inx lda uudInLine+1,x lsr lsr and #%00001111 ora temp sta uudInLine+1,y iny lda uudInLine+1,x ;*** output byte 2 inx ror ror ror and #%11000000 sta temp lda uudInLine+1,x inx and #%00111111 ora temp sta uudInLine+1,y iny rts uuWriteLine = * lda #<uudInLine+1 ldy #>uudInLine+1 sta zp sty zp+1 lda uudInLine ldy #0 ldx outfile jsr write rts getlinePos = 14 hitLastLine .buf 1 lastLineTerminator .buf 1 getline = * lda hitLastLine beq + sec rts + ldx #0 stx getlinePos ;** toss an LF that follows a CR jsr getByte bcs getlineProcess cmp #chrLF clc bne getlineProcess ldx lastLineTerminator cpx #chrCR clc bne getlineProcess getlineChar = * jsr getByte getlineProcess = * bcc + lda #$ff sta hitLastLine jmp getlineFinish + cmp #chrCR beq getlineFinish cmp #chrLF beq getlineFinish ldx getlinePos cpx #98 bcs + sta uudInLine,x inc getlinePos + jmp getlineChar getlineFinish = * sta lastLineTerminator ldx getlinePos lda #0 sta uudInLine,x cpx #0 beq + clc rts + lda hitLastLine cmp #1 rts getByte = * lda bufCount ora bufCount+1 beq getByteFillBuf ldy #0 lda (bufPtr),y inc bufPtr bne + inc bufPtr+1 + ldx bufCount bne + dec bufCount+1 + dec bufCount clc rts getByteFillBuf = * lda #<uudInBuf ldy #>uudInBuf sta zp sty zp+1 sta bufPtr sty bufPtr+1 lda inBufLen ldy inBufLen+1 ldx infile jsr read beq + bcs + sta bufCount sty bufCount+1 jmp getByte + sec rts ;===the end=== uudBss = * uudInLine = uudBss+0 uudInBuf = uudBss+100 uuencode.s 443 ;*** uuencode program .seq acehead.s .org aceAppAddress .obj "@0:uuencode" jmp uuencodeMain .asc "cB" ;*** global declarations libwork = $60 chrCR = $0d chrQuote = $22 ;******** standard library ******** puts = * ldx #stdout fputs = * sta zp sty zp+1 ldy #$ff - iny lda (zp),y bne - tya ldy #0 jmp write eputs = * ldx #stderr jmp fputs putchar = * ldx #stdout putc = * sta putcBuffer lda #<putcBuffer ldy #>putcBuffer sta zp sty zp+1 lda #1 ldy #0 jmp write putcBuffer .buf 1 getchar = * ldx #stdin getc = * lda #<getcBuffer ldy #>getcBuffer sta zp sty zp+1 lda #1 ldy #0 jsr read beq + lda getcBuffer rts + sec rts getcBuffer .buf 1 getarg = * sty zp+1 asl sta zp rol zp+1 clc lda aceArgv adc zp sta zp lda aceArgv+1 adc zp+1 sta zp+1 ldy #0 lda (zp),y tax iny lda (zp),y stx zp sta zp+1 rts basenameStart = libwork basename = * ;( (zp)=inname ) : uueOutBuf=outname ldy #255 sty basenameStart - iny lda (zp),y beq basenameDone cmp #":" beq + cmp #"/" bne - + sty basenameStart jmp - basenameDone = * ldy basenameStart ldx #255 - iny inx lda (zp),y sta uueOutBuf,x bne - cpx #2 bcc + lda uueOutBuf-2,x cmp #"," bne + lda #0 sta uueOutBuf-2,x + rts ;===uuencode=== uueArg = 2 uueName = 4 inBufLen = 6 uuencodeMain = * ;** check argument count lda aceArgc+1 bne uueEnoughArgs lda aceArgc cmp #2 bcs uueEnoughArgs uueUsage = * lda #<uueUsageMsg ldy #>uueUsageMsg jmp puts uueUsageMsg = * .asc "Usage: uuencode file1 file2 ... fileN" .byte chrCR .byte 0 uueEnoughArgs = * ;** get input buffer length sec lda aceStackPtr sbc #<uueInBuf sta inBufLen lda aceStackPtr+1 sbc #>uueInBuf sta inBufLen+1 ;** main loop lda #1 ldy #0 sta uueArg sty uueArg+1 - lda uueArg ldy uueArg+1 jsr getarg lda zp ldy zp+1 sta uueName sty uueName+1 ora zp+1 beq uueExit jsr uueEcho jsr uuencode bcc + jsr uueError + inc uueArg bne + inc uueArg+1 + jmp - uueExit = * rts uueError = * lda #<uueErrorMsg1 ldy #>uueErrorMsg1 jsr eputs lda uueName ldy uueName+1 jsr eputs lda #<uueErrorMsg2 ldy #>uueErrorMsg2 jmp eputs uueErrorMsg1 = * .asc "Error attempting to uuencode " .byte chrQuote .byte 0 uueErrorMsg2 = * .byte chrQuote .byte chrCR .byte 0 uueEcho = * lda #<uueEchoMsg1 ldy #>uueEchoMsg1 jsr eputs lda uueName ldy uueName+1 jsr eputs lda #<uueEchoMsg2 ldy #>uueEchoMsg2 jmp eputs uueEchoMsg1 = * .asc "Uuencoding file " .byte chrQuote .byte 0 uueEchoMsg2 = * .byte chrQuote .asc "..." .byte chrCR .byte 0 bufPtr = 8 bufCount = 10 infile = 12 uuencode = * ;** open file lda uueName ldy uueName+1 sta zp sty zp+1 lda #"r" jsr open bcc + rts + sta infile ;** encode file jsr uuencodeBody ;** close file lda infile jsr close rts uuencodeBody = * lda #0 sta bufCount sta bufCount+1 ;** header line lda #<uueHeaderMsg ldy #>uueHeaderMsg jsr puts lda uueName ldy uueName+1 sta zp sty zp+1 jsr basename lda #<uueOutBuf ldy #>uueOutBuf jsr puts lda #chrCR jsr putchar ;** loop - jsr uuLine bcc - ;** end line lda #<uueEndMsg ldy #>uueEndMsg jsr puts ;** crc line rts uueHeaderMsg = * .asc "begin 640 " .byte 0 uueEndMsg = * .asc "`" .byte chrCR .asc "end" .byte chrCR,0 getByte = * lda bufCount ora bufCount+1 beq getByteFillBuf ldy #0 lda (bufPtr),y inc bufPtr bne + inc bufPtr+1 + ldx bufCount bne + dec bufCount+1 + dec bufCount clc rts getByteFillBuf = * lda #<uueInBuf ldy #>uueInBuf sta zp sty zp+1 sta bufPtr sty bufPtr+1 lda inBufLen ldy inBufLen+1 ldx infile jsr read beq + bcs + sta bufCount sty bufCount+1 jmp getByte + sec rts datalen = 13 outlinelen = 14 uuLine = * lda #0 sta datalen lda #1 sta outlinelen ;** get the line - jsr getFourChars bcs + lda datalen cmp #45 bcc - clc ;** put the line + php ldy outlinelen lda #chrCR sta uueOutBuf,y inc outlinelen lda datalen cmp #0 beq + jsr getUuchar sta uueOutBuf lda #<uueOutBuf ldy #>uueOutBuf sta zp sty zp+1 lda outlinelen ldy #0 ldx #1 jsr write + plp rts uutemp = 15 uubuf .buf 3 getFourChars = * ldx #2 lda #0 - sta uubuf,x dex bpl - ;** read the bytes ldx #0 - stx uutemp jsr getByte bcs + ldx uutemp sta uubuf,x inc datalen inx cpx #3 bcc - clc ;** put bytes into output line ;pos 76543210 76543210 76543210 76543210 ;byt xx111111 xx112222 xx222233 xx333333 ;bit 765432 107654 321076 543210 + php ldy outlinelen ;** first byte lda uubuf lsr lsr jsr getUuchar sta uueOutBuf,y iny ;** second byte lda uubuf asl asl asl asl sta uutemp lda uubuf+1 lsr lsr lsr lsr ora uutemp jsr getUuchar sta uueOutBuf,y iny ;** third byte lda uubuf+1 asl asl sta uutemp lda uubuf+2 asl rol rol and #%00000011 ora uutemp jsr getUuchar sta uueOutBuf,y iny ;** fourth byte lda uubuf+2 jsr getUuchar sta uueOutBuf,y iny sty outlinelen plp rts getUuchar = * and #%00111111 bne + lda #"`" rts + clc adc #" " cmp #"a" bcs + rts + cmp #"[" bcs + adc #128 + rts ;===the end=== uueEnd = * uueOutBuf = uueEnd uueInBuf = uueOutBuf+80 vi.s 1084 ;*** zed text editor program .seq acehead.s .org aceAppAddress .obj "@0:vi" jmp main .asc "cB" ;*** global declarations work1 = $02 ;(16) work2 = $12 ;(16) work3 = $22 ;(14) chrCR = $0d chrTab = $09 chrQuote = $22 ;screen scrTopAddr = $30 ;(2) scrLineAddr = $32 ;(2) curRow = $34 ;(1) curCol = $35 ;(1) scrRows = $36 ;(1) scrCols = $37 ;(1) scrRowInc = $38 ;(2) curLeftMargin = $3a ;(1) statusMargin .buf 1 ;document linePtr = $40 ;(4) lineNum = $44 ;(4) tosLinePtr = $48 ;(4) topLinePtr = $4c ;(4) botLinePtr = $50 ;(4) lineCount = $54 ;(4) fileLength = $58 ;(4) targetLen = $5c ;(1) wrapFlag = $5d ;(1) ;128=wrap,64=showCR ;management modified = $3b ;(1) ;$00=no, $ff=modified modeFlags = $3c ;(1) ;$80=insert, $40=indent statusUpdate = $3d ;(1) ;128=line,64=col,32=mod,16=ins,8=byt,4=fre,2=nm,1=msg markedLinePtr .buf 4 ;(4) markedLineNum .buf 4 ;(4) markedCol .buf 4 ;(1) ;line format headBuffer = $70 ;(11) headNextPtr = $70 ;(4) headPrevPtr = $74 ;(4) headLineLen = $78 ;(1) headIndent = $79 ;(1) headFlags = $7a ;(1) ;$80=connected, $40=nullLine, $3F=indent headLength = $0b ;kill buffer bufferTopPtr .buf 4 ;(4) bufferBotPtr .buf 4 ;(4) bufferLineCount .buf 4 ;(4) ;document buffers ;colors charColor .byte $0c ;$0e cursorColor .byte $06 statusColor .byte $04 separColor .byte $0f ;$03 hiliteColor .byte $0d ;$0c alertColor .byte $0f borderColor .byte $00 bkgndColor .byte $00 ;=== new === screenInit = * ;** get screen parms jsr winsize sta scrRows lda syswork+0 sta scrCols lda syswork+2 ldy syswork+3 sta scrTopAddr+0 sty scrTopAddr+1 sta $400 sty $401 lda syswork+4 ldy syswork+5 sta scrRowInc+0 sty scrRowInc+1 ;** get color palette jsr conpalette ldx #7 - lda syswork,x sta charColor,x dex bpl - ;** clear screen lda #$a0 ldy charColor ldx #$ff jsr wincls ;** set status color lda scrTopAddr+0 ldy scrTopAddr+1 sta syswork+0 sty syswork+1 lda scrCols sta syswork+5 lda #$40 ldy statusColor ldx #0 jsr winput ;** set separator color jsr setSeparAddr lda #$40 ldy separColor ldx #0 jsr winput rts jsr displaySeparator lda #$ff sta statusUpdate jsr updateStatus rts setSeparAddr = * clc lda scrTopAddr+0 adc scrRowInc+0 sta syswork+0 lda scrTopAddr+1 adc scrRowInc+1 sta syswork+1 rts displayStatus = * lda scrTopAddr+0 ldy scrTopAddr+1 sta syswork+0 sty syswork+1 lda #<statusLine ldy #>statusLine clc adc statusMargin bcc + iny + sta zw+0 sty zw+1 lda scrCols sta syswork+5 lda #$80 ldx scrCols jsr winput rts statusLine = * .asc "L:12345678C:241 * Ins Ind B:12345678 F:12345678 " ; "0----+----1----+----2----+----3----+----4----+----5-" .asc "1234567890123456789012345678" ; "---+----6----+----7----+----" updateStatus = * jsr displayStatus rts displaySeparator = * rts ;=== main === main = * jsr mallocInit jsr mainInit jsr screenInit jsr displayStatus lda #1 ldy #0 jsr getarg jsr loadFile jsr dumpDoc rts msg .asc "Zed for ACE version ACE-0.01" .byte chrCR,0 mainInit = * ldx #$7f-$02 lda #0 - sta 2,x dex bpl - lda #$80 sta wrapFlag jsr winsize lda syswork+0 sta targetLen rts ;*** load file: uses work2 *** loadHead = work2+0 loadTail = work2+4 loadLines = work2+8 loadBytes = work2+12 loadFcb = work3+0 loadLineScan = work3+1 loadLineLen = work3+2 loadBufCount = work3+3 loadBufPtr = work3+4 loadFile = * ;( (zp)=name ) : [w2]=head, [w2]=tail, [w2]=lines, [w2]=bytes jsr saveWork3 jsr loadInit lda #"r" jsr open sta loadFcb - jsr loadLine bcs + jsr loadLineWrap jsr loadLineStore jsr loadLineOverflow jmp - + lda loadLineLen beq + jsr loadLineWrap lda #$00 sta headFlags jsr loadLineStore + lda loadFcb jsr close jsr restoreWork3 rts loadInit = * lda #0 ldx #16+14-1 - sta loadHead,x dex bpl - rts loadLine = * ;( ) : .CS=end ;tab expansion will go into this routine ldx loadBufPtr ldy loadLineLen loadNextByte = * lda loadBufCount bne ++ sty loadLineLen jsr loadBuf bcc + rts + ldy loadLineLen ldx loadBufPtr + nop - lda filebuf,x sta line,y inx iny cmp #chrCR beq ++ cpy targetLen beq + ;determines if CRs will go beyond len bcs ++ + dec loadBufCount bne - beq loadNextByte + dec loadBufCount stx loadBufPtr sty loadLineLen clc rts loadBuf = * ;( ) : .CS=eof jsr stopkey bcs + lda #<filebuf ldy #>filebuf sta zp+0 sty zp+1 lda #<254 ldy #>254 ldx loadFcb jsr read bcs + beq + sta loadBufCount lda #0 sta loadBufPtr clc rts + sec rts loadLineWrap = * ldx loadLineLen dex ldy #$00 lda line,x cmp #chrCR beq + ldy #$80 + sty headFlags cmp #chrCR bne + - stx headLineLen stx loadLineScan stx loadLineLen rts + ldx loadLineLen cpx targetLen bcc - + bit wrapFlag bmi + - lda targetLen sta loadLineScan sta headLineLen rts + ldx targetLen - dex cpx #255 beq -- lda line,x cmp #" " bne - + inx stx loadLineScan stx headLineLen rts loadLineStore = * inc loadLines+0 bne + inc loadLines+1 bne + inc loadLines+2 bne + inc loadLines+3 + sec bit headFlags bmi + clc + lda loadBytes+0 adc headLineLen sta loadBytes+0 bcc + inc loadBytes+1 bne + inc loadBytes+2 bne + inc loadBytes+3 + ldx #3 - lda #aceMemNull sta headNextPtr,x lda loadTail,x sta headPrevPtr,x dex bpl - jsr stashLine ;** first line to be stored lda loadHead+3 cmp #aceMemNull bne + ldx #3 - lda zp,x sta loadHead,x sta loadTail,x dex bpl - rts ;** additional lines + ldx #3 - lda zp,x ldy loadTail,x sta loadTail,x sty zp,x dex bpl - jsr fetchHead ldx #3 - lda loadTail,x sta headNextPtr,x dex bpl - jsr stashHead rts loadLineOverflow = * ldx loadLineScan ldy #0 - cpx loadLineLen bcs + lda line,x sta line,y inx iny bne - + sty loadLineLen rts ;=== management routines === work3Save .buf 14 saveWork3 = * ldx #13 - lda work3,x sta work3Save,x dex bpl - rts restoreWork3 = * ldx #13 - lda work3Save,x sta work3,x dex bpl - rts fetchLineExtra = 6 fetchLine = * ;( [zp]=farLine ) : head*, linebuf lda #<linebuf ldy #>linebuf sta zw+0 sty zw+1 lda #headLength+fetchLineExtra ldy #0 jsr fetch ldx #headLength-1 - lda linebuf,x sta headBuffer,x dex bpl - lda headLineLen cmp #fetchLineExtra+1 bcc + clc adc #headLength ldy #0 jsr fetch + rts stashLine = * ;( head*, linebuf ) : [zp]=storedLine, .CS=err lda #0 sta headIndent ldx #headLength-1 - lda headBuffer,x sta linebuf,x dex bpl - clc lda headLineLen adc #headLength ldy #0 jsr malloc bcc + rts + lda #<linebuf ldy #>linebuf sta zw+0 sty zw+1 clc lda headLineLen adc #headLength ldy #0 jsr stash clc rts fetchHead = * ;( [zp]=farLinePtr ) : headBuffer ldx #headBuffer ldy #headLength jsr zpload rts stashHead = * ;( [zp]=farLinePtr, headBuffer ) ldx #headBuffer ldy #headLength jsr zpstore rts ;=== dynamic memory routines === mallocWork = work1 mallocHead .buf 4 tpaFreeFirst .buf 1 tpaFreeMin .buf 1 tpaFreePages .buf 1 tpaAreaStart .buf 1 tpaAreaEnd .buf 1 ;*** mallocInit() mallocInit = * lda #aceMemNull sta mallocHead+3 ldx #0 lda #$ff - sta tpaFreemap,x inx bne - ldx #>bssEnd lda #<bssEnd beq + inx + stx tpaFreeFirst stx tpaAreaStart ldx aceStackPtr+1 stx mallocWork stx tpaAreaEnd txa sec sbc tpaFreeFirst bcs + lda #0 + sta tpaFreePages clc adc #1 sta tpaFreeMin ldx tpaFreeFirst cpx mallocWork bcs + lda #$00 - sta tpaFreemap,x inx cpx mallocWork bcc - + rts libPages .buf 1 libPageAlloc = * ;( .A=pages ) : [zp] sta libPages ldx #$00 ldy #aceMemInternal-1 jsr pagealloc bcs + rts + jsr tpaPageAlloc bcs + rts + lda libPages ldx #aceMemInternal ldy #$ff jsr pagealloc bcs + rts + lda #<nomemMsg ldy #>nomemMsg jsr eputs lda #1 jmp exit nomemMsg = * .byte chrCR .asc "Insufficient memory, aborting." .byte chrCR,0 newmax .buf 1 tpaPageAlloc = * ;( libPages ) : [zp] lda libPages cmp tpaFreeMin bcs tpaFreemapFull ;** first free ldx tpaFreeFirst lda tpaFreemap,x beq ++ - inx beq tpaFreemapFull lda tpaFreemap,x bne - stx tpaFreeFirst jmp ++ tpaFreemapFull = * lda libPages cmp tpaFreeMin bcs + sta tpaFreeMin + sec rts ;** search + dex - ldy libPages - inx beq tpaFreemapFull lda tpaFreemap,x bne -- dey bne - ;** allocate stx newmax ldy libPages lda #$41 - sta tpaFreemap,x dex dey bne - inx cpx tpaFreeFirst bne + ldy newmax iny sty tpaFreeFirst + sec lda tpaFreePages sbc libPages sta tpaFreePages lda #0 ldy #aceMemInternal sta zp+0 stx zp+1 sta zp+2 sty zp+3 clc rts mallocLenSave .buf 3 malloc = * quickMalloc = * sta mallocLenSave+0 sty mallocLenSave+1 jsr libMalloc bcs + rts + ldx mallocLenSave+1 lda mallocLenSave+0 beq + inx + txa cpx #>1024 bcs + ldx #>1024 + txa sta mallocLenSave+2 jsr libPageAlloc bcc + rts + lda #0 ldy mallocLenSave+2 jsr free lda mallocLenSave+0 ldy mallocLenSave+1 jmp malloc ;*** malloc( .AY=Bytes ) : [zp]=FarPointer mallocMemNextPtr = mallocWork+0 ;(4) mallocMemLength = mallocWork+4 ;(2) mallocLength = mallocWork+6 ;(2) mallocQ = mallocWork+8 ;(4) libMalloc = * clc adc #7 bcc + iny + and #$f8 sta mallocLength sty mallocLength+1 ldx #3 - lda mallocHead,x sta zp,x lda #aceMemNull sta mallocQ,x dex bpl - mallocLook = * lda zp+3 cmp #aceMemNull bne + mallocErrorExit = * lda #aceMemNull sta zp+3 lda #aceErrInsufficientMemory sta errno sec rts + ldx #mallocMemNextPtr ldy #6 jsr zpload lda mallocMemLength cmp mallocLength lda mallocMemLength+1 sbc mallocLength+1 bcs mallocGotBlock ldx #3 - lda zp,x sta mallocQ,x lda mallocMemNextPtr,x sta zp,x dex bpl - jmp mallocLook mallocGotBlock = * lda mallocMemLength cmp mallocLength bne + lda mallocMemLength+1 sbc mallocLength+1 beq mallocTakeWholeBlock + sec lda mallocMemLength sbc mallocLength sta mallocMemLength lda mallocMemLength+1 sbc mallocLength+1 sta mallocMemLength+1 ldx #mallocMemNextPtr ldy #6 jsr zpstore clc lda zp+0 adc mallocMemLength sta zp+0 lda zp+1 adc mallocMemLength+1 sta zp+1 clc rts mallocTakeWholeBlock = * lda mallocQ+3 cmp #aceMemNull bne + ldx #3 - lda mallocMemNextPtr,x sta mallocHead,x dex bpl - clc rts + ldx #3 - lda zp,x ldy mallocQ,x sta mallocQ,x sty zp,x dex bpl - ldx #mallocMemNextPtr ldy #4 jsr zpstore ldx #3 - lda mallocQ,x sta zp,x dex bpl - clc rts ;*** free( [zp]=FarPointer, .AY=Length ) {alters [zp]} freeMemNextPtr = mallocWork+0 ;(4) freeMemLength = mallocWork+4 ;(2) freeLength = mallocWork+6 ;(2) freeNewPtr = mallocWork+8 ;(4) freeQ = mallocWork+12 ;(4) free = * clc adc #7 bcc + iny + and #$f8 sta freeLength+0 sty freeLength+1 ldx #3 - lda zp,x sta freeNewPtr,x lda mallocHead,x sta zp,x lda #aceMemNull sta freeQ,x dex bpl - freeSearchLoop = * lda zp+3 cmp #aceMemNull beq freeCoalesceQandNew lda zp+0 cmp freeNewPtr+0 lda zp+1 sbc freeNewPtr+1 lda zp+2 sbc freeNewPtr+2 lda zp+3 sbc freeNewPtr+3 bcs freeCoalesceQandNew + ldx #freeMemNextPtr ldy #4 jsr zpload ldx #3 - lda zp,x sta freeQ,x lda freeMemNextPtr,x sta zp,x dex bpl - bmi freeSearchLoop freeCoalesceQandNew = * ldx #3 - lda freeQ,x sta zp,x dex bpl - lda zp+3 cmp #aceMemNull bne + ;** prev is head ldx #3 - lda mallocHead,x sta freeMemNextPtr,x lda freeNewPtr,x sta mallocHead,x dex bpl - lda freeLength+0 ldy freeLength+1 sta freeMemLength+0 sty freeMemLength+1 jmp freeCoalesceNewAndP ;** prev is real + ldx #freeMemNextPtr ldy #6 jsr zpload lda zp+3 cmp freeNewPtr+3 bne + lda zp+2 cmp freeNewPtr+2 bne + clc lda zp adc freeMemLength tax lda zp+1 adc freeMemLength+1 cmp freeNewPtr+1 bne + cpx freeNewPtr bne + ;** prev does coalesce clc lda freeMemLength adc freeLength sta freeMemLength lda freeMemLength+1 adc freeLength+1 sta freeMemLength+1 ldx #3 - lda freeQ,x sta freeNewPtr,x dex bpl - bmi freeCoalesceNewAndP ;** prev does not coalesce + ldx #freeNewPtr ldy #4 jsr zpstore lda freeLength+0 ldy freeLength+1 sta freeMemLength+0 sty freeMemLength+1 freeCoalesceNewAndP = * lda freeNewPtr+3 cmp freeMemNextPtr+3 bne + lda freeNewPtr+2 cmp freeMemNextPtr+2 bne + clc lda freeNewPtr adc freeMemLength tax lda freeNewPtr+1 adc freeMemLength+1 cmp freeMemNextPtr+1 bne + cpx freeMemNextPtr bne + ;** new and next coalesce ldx #3 - lda freeMemNextPtr,x sta zp,x dex bpl - lda freeMemLength+1 pha lda freeMemLength+0 pha ldx #freeMemNextPtr ldy #6 jsr zpload clc pla adc freeMemLength+0 sta freeMemLength+0 pla adc freeMemLength+1 sta freeMemLength+1 + ldx #3 - lda freeNewPtr,x sta zp,x dex bpl - ldx #freeMemNextPtr ldy #6 jsr zpstore clc rts ;=== standard library === puts = * ldx #stdout fputs = * sta zp+0 sty zp+1 ldy #$ff - iny lda (zp),y bne - tya ldy #0 jmp write eputs = * ldx #stderr jmp fputs putchar = * stx xsave sty ysave ldx #stdout jsr putc ldx xsave ldy ysave rts xsave .buf 1 ysave .buf 1 putc = * sta putcBuffer lda #<putcBuffer ldy #>putcBuffer sta zp+0 sty zp+1 lda #1 ldy #0 jmp write putcBuffer .buf 1 getchar = * ldx #stdin getc = * lda #<getcBuffer ldy #>getcBuffer sta zp+0 sty zp+1 lda #1 ldy #0 jsr read beq + lda getcBuffer rts + sec rts getcBuffer .buf 1 getarg = * sty zp+1 asl sta zp+0 rol zp+1 clc lda aceArgv adc zp+0 sta zp+0 lda aceArgv+1 adc zp+1 sta zp+1 ldy #0 lda (zp),y tax iny lda (zp),y stx zp+0 sta zp+1 rts ;===NEW FUNCTIONS=== stopCountdown .byte 0 dumpDoc = * ldy charColor ldx #$40 jsr wincls ldx #3 - lda loadHead,x sta zp,x dex bpl - - lda zp+3 cmp #aceMemNull bne + rts + jsr fetchLine lda #<line ldy #>line sta zp+0 sty zp+1 lda headLineLen ldy #0 ldx #stdout jsr write lda headFlags bpl + ;lda #"=" ;jsr putchar + lda #chrCR jsr putchar ldx #3 - lda headNextPtr,x sta zp,x dex bpl - inc stopCountdown lda stopCountdown and #7 bne + jsr stopkey bcc + lda #1 ldx #0 jmp exit + jmp -- ;===bss=== bss = * linebuf = bss+0 ;(256) line = linebuf+headLength ;(241) filebuf = linebuf+256 ;(256) tpaFreemap = filebuf+256 ;(256) bssEnd = tpaFreemap+256 wc.s 392 ;*** word counter program .seq acehead.s .org aceAppAddress .obj "@0:wc" jmp wcMain .asc "cB" ;*** global declarations libwork = $60 chrCR = $0d chrQuote = $22 ;******** standard library ******** puts = * ldx #stdout fputs = * sta zp sty zp+1 ldy #$ff - iny lda (zp),y bne - tya ldy #0 jmp write eputs = * ldx #stderr jmp fputs putchar = * stx xsave sty ysave ldx #stdout jsr putc ldx xsave ldy ysave rts xsave .buf 1 ysave .buf 1 putc = * sta putcBuffer lda #<putcBuffer ldy #>putcBuffer sta zp sty zp+1 lda #1 ldy #0 jmp write putcBuffer .buf 1 getchar = * ldx #stdin getc = * lda #<getcBuffer ldy #>getcBuffer sta zp sty zp+1 lda #1 ldy #0 jsr read beq + lda getcBuffer rts + sec rts getcBuffer .buf 1 getarg = * sty zp+1 asl sta zp rol zp+1 clc lda aceArgv adc zp sta zp lda aceArgv+1 adc zp+1 sta zp+1 ldy #0 lda (zp),y tax iny lda (zp),y stx zp sta zp+1 rts ;===word count=== wcArg = 2 wcName = 4 inBufLen = 6 files = $50 wcMain = * ;** check argument count lda aceArgc+1 bne wcEnoughArgs lda aceArgc cmp #2 bcs wcEnoughArgs wcUsage = * lda #<wcUsageMsg ldy #>wcUsageMsg jmp eputs wcUsageMsg = * .asc "Usage: wc file1 file2 ... fileN" .byte chrCR,0 wcEnoughArgs = * ;** get input buffer length sec lda aceStackPtr sbc #<wcInBuf sta inBufLen lda aceStackPtr+1 sbc #>wcInBuf sta inBufLen+1 ;** main loop lda #1 ldy #0 sta wcArg sty wcArg+1 sty files jsr totInit - jsr stopkey bcs wcStopped lda wcArg ldy wcArg+1 jsr getarg lda zp ldy zp+1 sta wcName sty wcName+1 ora zp+1 beq wcExit jsr wcFile bcs + lda files bmi + inc files + bcc + jsr wcError + inc wcArg bne + inc wcArg+1 + jmp - wcExit = * lda files cmp #2 bcc + jsr reportTotal + rts wcStopped = * lda #<stoppedMsg ldy #>stoppedMsg jsr eputs rts stoppedMsg = * .asc "<Stopped>" .byte chrCR,0 wcError = * lda #<wcErrorMsg1 ldy #>wcErrorMsg1 jsr eputs lda wcName ldy wcName+1 jsr eputs lda #<wcErrorMsg2 ldy #>wcErrorMsg2 jmp eputs wcErrorMsg1 = * .asc "Error reading file " .byte chrQuote,0 wcErrorMsg2 = * .byte chrQuote,chrCR,0 bufCount = 10 infile = 12 wcFile = * ;** open file lda wcName ldy wcName+1 sta zp sty zp+1 lda #"r" jsr open bcc + rts + sta infile ;** count file jsr wcInit jsr wcBody ;** close file lda infile jsr close jsr wcReport jsr addToTotal rts wcBody = * - lda #<wcInBuf ldy #>wcInBuf+1 sta zp sty zp+1 lda #254 ldy #0 ldx infile jsr read sta bufCount sty bufCount+1 beq + jsr wcScanBuffer jmp - + rts wcInWord = $4c ;(1) wcLines = $40 ;(3) wcWords = $44 ;(3) wcBytes = $48 ;(3) totLines = $20 ;(3) totWords = $24 ;(3) totBytes = $28 ;(3) wcInit = * lda #0 ldx #11 - sta wcLines,x dex bpl - sta wcInWord rts totInit = * lda #0 ldx #11 - sta totLines,x dex bpl - rts wcScanBuffer = * ldy #0 cpy bufCount bne + rts + ldx wcInWord - lda wcInBuf,y cmp #chrCR bne + inc wcLines bne + inc wcLines+1 bne + inc wcLines+2 bne + inc wcLines+3 + cmp #33 bcs isLetter cmp #" " beq isDelimiter cmp #chrCR beq isDelimiter cmp #9 beq isDelimiter isLetter = * cpx #1 beq scanCont ldx #1 inc wcWords bne scanCont inc wcWords+1 bne scanCont inc wcWords+2 bne scanCont inc wcWords+3 jmp scanCont isDelimiter = * ldx #0 scanCont = * iny cpy bufCount bcc - clc lda wcBytes adc bufCount sta wcBytes bcc + inc wcBytes+1 bne + inc wcBytes+2 bne + inc wcBytes+3 + stx wcInWord rts wcReport = * ldx #wcLines lda #6 jsr putnum ldx #wcWords lda #6 jsr putnum ldx #wcBytes lda #7 jsr putnum lda wcName ldy wcName+1 jsr puts lda #chrCR jsr putchar rts putnum = * ldy #<numbuf sty $80 ldy #>numbuf sty $81 jsr utoa lda #<numbuf ldy #>numbuf jsr puts lda #" " jsr putchar rts addToTotal = * clc ldx #0 - lda totLines,x adc wcLines,x sta totLines,x inx txa and #$03 bne - clc ldx #0 - lda totWords,x adc wcWords,x sta totWords,x inx txa and #$03 bne - clc ldx #0 - lda totBytes,x adc wcBytes,x sta totBytes,x inx txa and #$03 bne - rts reportTotal = * lda #<totalMsg ldy #>totalMsg sta wcName sty wcName+1 ldx #11 - lda totLines,x sta wcLines,x dex bpl - jsr wcReport rts totalMsg = * .asc "<total>" .byte 0 ;===the end=== wcBss = * numbuf = wcBss wcInBuf = numbuf+12 wrap.s 361 ;*** wrap program .seq acehead.s .org aceAppAddress .obj "@0:wrap" jmp main .asc "cB" ;*** global declarations work1 = $02 ;(16) work2 = $12 ;(16) work3 = $22 ;(14) chrCR = $0d chrTab = $09 chrQuote = $22 ;screen scrTopAddr = $30 ;(2) scrLineAddr = $32 ;(2) curRow = $34 ;(1) curCol = $35 ;(1) scrRows = $36 ;(1) scrCols = $37 ;(1) scrRowInc = $38 ;(2) curLeftMargin = $3a ;(1) ;document linePtr = $40 ;(4) lineNum = $44 ;(4) tosLinePtr = $48 ;(4) topLinePtr = $4c ;(4) botLinePtr = $50 ;(4) lineCount = $54 ;(4) fileLength = $58 ;(4) targetLen = $5c ;(1) wrapFlag = $5d ;(1) ;128=wrap,64=showCR ;management modified = $3b ;(1) ;$00=no, $ff=modified modeFlags = $3c ;(1) ;$80=insert, $40=indent statusUpdate = $3d ;(1) ;128=line,64=col,32=mod,16=ins,8=byt,4=fre,2=nm,1=msg markedLinePtr .buf 4 ;(4) markedLineNum .buf 4 ;(4) markedCol .buf 4 ;(1) ;line format headNextPtr = $70 ;(4) headPrevPtr = $74 ;(4) headLineLen = $78 ;(1) headIndent = $79 ;(1) headFlags = $7a ;(1) ;$80=connected, $40=nullLine headLength = $0b ;kill buffer bufferTopPtr .buf 4 ;(4) bufferBotPtr .buf 4 ;(4) bufferLineCount .buf 4 ;(4) ;document buffers ;=== main === main = * jsr mainInit lda #1 ldy #0 jsr getarg jsr loadFile rts mainInit = * lda #$80 sta wrapFlag lda #75 sta targetLen rts ;*** load file: uses work2 *** loadHead = work2+0 loadTail = work2+4 loadLines = work2+8 loadBytes = work2+12 loadFcb = work3+0 loadLineScan = work3+1 loadLineLen = work3+2 loadBufCount = work3+3 loadBufPtr = work3+4 loadFile = * ;( (zp)=name ) : [w2]=head, [w2]=tail, [w2]=lines, [w2]=bytes jsr saveWork3 jsr loadInit lda #"r" jsr open sta loadFcb - jsr loadLine bcs + jsr loadLineWrap jsr loadLineStore jsr loadLineOverflow jmp - + lda loadLineLen beq + jsr loadLineWrap lda #$00 sta lineFlags jsr loadLineStore + lda loadFcb jsr close jsr restoreWork3 rts loadInit = * lda #0 ldx #16+14-1 - sta loadHead,x dex bpl - rts loadLine = * ;( ) : .CS=end ;tab expansion will go into this routine ldx loadBufPtr ldy loadLineLen loadNextByte = * lda loadBufCount bne ++ sty loadLineLen jsr loadBuf bcc + rts + ldy loadLineLen ldx loadBufPtr + nop - lda filebuf,x sta line,y inx iny cmp #chrCR beq ++ cpy targetLen beq + ;determines if CRs will go beyond len bcs ++ + dec loadBufCount bne - beq loadNextByte + dec loadBufCount stx loadBufPtr sty loadLineLen clc rts loadBuf = * ;( ) : .CS=eof jsr stopkey bcs + lda #<filebuf ldy #>filebuf sta zp+0 sty zp+1 lda #<254 ldy #>254 ldx loadFcb jsr read bcs + beq + sta loadBufCount lda #0 sta loadBufPtr clc rts + sec rts loadLineWrap = * ldx loadLineLen dex ldy #$00 lda line,x cmp #chrCR beq + ldy #$80 + sty lineFlags cmp #chrCR bne + - stx lineLineLen stx loadLineScan stx loadLineLen rts + ldx loadLineLen cpx targetLen bcc - + bit wrapFlag bmi + - lda targetLen sta loadLineScan sta lineLineLen rts + ldx targetLen - dex cpx #255 beq -- lda line,x cmp #" " bne - + inx stx loadLineScan stx lineLineLen rts loadLineStore = * lda #<line ldy #>line sta zp+0 sty zp+1 lda lineLineLen ldy #0 ldx #stdout jsr write lda #chrCR jsr putchar rts loadLineOverflow = * ldx loadLineScan ldy #0 - cpx loadLineLen bcs + lda line,x sta line,y inx iny bne - + sty loadLineLen rts ;=== management routines === work3Save .buf 14 saveWork3 = * ldx #13 - lda work3,x sta work3Save,x dex bpl - rts restoreWork3 = * ldx #13 - lda work3Save,x sta work3,x dex bpl - rts ;=== standard library === puts = * ldx #stdout fputs = * sta zp+0 sty zp+1 ldy #$ff - iny lda (zp),y bne - tya ldy #0 jmp write eputs = * ldx #stderr jmp fputs putchar = * stx xsave sty ysave ldx #stdout jsr putc ldx xsave ldy ysave rts xsave .buf 1 ysave .buf 1 putc = * sta putcBuffer lda #<putcBuffer ldy #>putcBuffer sta zp+0 sty zp+1 lda #1 ldy #0 jmp write putcBuffer .buf 1 getchar = * ldx #stdin getc = * lda #<getcBuffer ldy #>getcBuffer sta zp+0 sty zp+1 lda #1 ldy #0 jsr read beq + lda getcBuffer rts + sec rts getcBuffer .buf 1 getarg = * sty zp+1 asl sta zp+0 rol zp+1 clc lda aceArgv adc zp+0 sta zp+0 lda aceArgv+1 adc zp+1 sta zp+1 ldy #0 lda (zp),y tax iny lda (zp),y stx zp+0 sta zp+1 rts ;===bss=== bss = * linebuf = bss+0 ;(256) lineNextPtr = linebuf+$0 ;(4) linePrevPtr = linebuf+$4 ;(4) lineLineLen = linebuf+$8 ;(1) lineIndent = linebuf+$9 ;(1) lineFlags = linebuf+$a ;(1) ;$80=connected, $40=tailLine line = linebuf+$b ;(241) filebuf = linebuf+256 ;(256) tpaFreemap = filebuf+256 ;(256) bssEnd = tpaFreemap+256 xls.s 611 ;*** directory program - by Craig Bruce .seq acehead.s .org aceAppAddress .obj "@0:xls" jmp main .byte aceID1,aceID2,aceID3 ;*** global declarations libwork = 80 chrCR = $0d chrCls = 147 chrQuote = $22 true = $ff false = $00 arg = 2 name = 4 string = 8 dirFcb = 16 dirColumns = 17 dirCurCol = 18 dirLong = 19 dirSpaces = 20 dirlineLen = 21 dirChCols = 22 dirPaged = 23 dirShown = 24 dirCls = 25 dirFiles = 32 dirBytes = 36 dirFree = 40 work = 64 main = * lda #false sta dirLong sta dirPaged sta dirShown sta dirCls lda #0 ldy #0 sta arg+0 sty arg+1 nextArg = * jsr stopkey bcc + jmp stopped + inc arg+0 bne + inc arg+1 + lda arg+0 ldy arg+1 jsr getarg lda zp+0 ora zp+1 beq mainExit ldy #0 lda (zp),y cmp #"-" bne nameArg jsr handleOption jmp nextArg nameArg = * lda zp+0 ldy zp+1 sta name+0 sty name+1 jsr ls lda #true sta dirShown jmp nextArg mainExit = * lda dirShown bne + lda #<defaultDir ldy #>defaultDir sta name+0 sty name+1 jsr ls + rts defaultDir = * .byte ".",":",0 handleOption = * ldy #0 sty work+2 lda zp+0 ldy zp+1 sta work+0 sty work+1 nextOption = * inc work+2 ldy work+2 lda (work),y bne + rts + cmp #"?" bne + lda #<usageMsg ldy #>usageMsg jsr eputs lda #0 ldx #0 jmp exit + cmp #"l" bne + lda #true sta dirLong jmp nextOption + cmp #"c" bne + lda #true sta dirCls jmp nextOption + jmp nextOption usageMsg = * .asc "usage: ls [-][l][?][c] [directory ...]" .byte chrCR .asc "opts: l=long form, ?=help, c=clear screen" .byte chrCR,0 stopped = * lda #<stoppedMsg ldy #>stoppedMsg jsr eputs lda #1 ldx #0 jmp exit stoppedMsg = * .asc "<Stopped>" .byte chrCR,0 error = * lda #<errorMsg1 ldy #>errorMsg1 jsr eputs lda name+0 ldy name+1 jsr eputs lda #<errorMsg2 ldy #>errorMsg2 jmp eputs errorMsg1 = * .asc "Error reading directory " .byte chrQuote,0 errorMsg2 = * .byte chrQuote,chrCR,0 ;===dir=== ls = * lda dirCls beq + lda #chrCls jsr putchar + lda dirLong bne dir trueLs = * ldx #1 jsr devinfo stx dirChCols cmp #0 bne + txa ldx #$ff - inx sbc #20 bcs - txa bne lsSetCols + lda #1 lsSetCols = * sta dirColumns jmp dirCommon dir = * ldx #1 jsr devinfo stx dirChCols lda #1 sta dirColumns dirCommon = * lda #0 sta dirCurCol ldx #3 - sta dirBytes,x sta dirFiles,x dex bpl - dirGotName = * lda name+0 ldy name+1 sta zp+0 sty zp+1 jsr diropen bcc + jmp error + sta dirFcb ldx dirFcb jsr dirread bcs dirExit beq dirExit jsr stopkey bcc + jmp stopped + lda dirLong bpl + jsr dirDisplayHeading / ldx dirFcb jsr dirread bcs dirExit beq dirExit jsr stopkey bcc + jsr dirExit jmp stopped + lda aceDirentName beq dirTrailerExit jsr dirDisplay jmp - dirTrailerExit = * lda dirLong bpl dirExit jsr dirDisplayTrailer dirExit = * lda dirCurCol beq + lda #chrCR jsr putchar + lda dirFcb jmp dirclose dirDisplay = * bit aceDirentFlags bmi ++ inc dirFiles+0 bne + inc dirFiles+1 bne + inc dirFiles+2 bne + inc dirFiles+3 + ldx #0 ldy #4 clc - lda dirBytes,x adc aceDirentBytes,x sta dirBytes,x inx dey bne - + bit dirLong bmi + jmp dirDisplayShort + jsr dirSetupDirline lda #<dirline ldy #>dirline sta zp+0 sty zp+1 lda dirlineLen ldy #0 ldx #stdout jmp write ;* 000000000011111111112222222222333333333344444444445555555555 ;* pos: 012345678901234567890123456789012345678901234567890123456789 dirline .asc "drwx*-mt 00-Xxx-00 12:00a 12345678 *SEQ 1234567890123456" .byte chrCR,0 dirFlagNames .asc "drwx*-mt" dirDateStr .asc " 00-Xxx-00 12:00a " dirDateEnd = * dirSetupDirline = * ;** flags ldx #0 lda aceDirentFlags - asl pha lda #"-" bcc + lda dirFlagNames,x + sta dirline+0,x pla inx cpx #8 bcc - ;** date jsr putInDate ldx #dirDateEnd-dirDateStr-1 - lda dirDateStr,x sta dirline+8,x dex bpl - ;** bytes ldx #3 - lda aceDirentBytes,x sta dirFree,x dex bpl - lda #<utoaNumber ldy #>utoaNumber sta syswork+0 sty syswork+1 lda #8 ldx #dirFree jsr utoa ldy #28 lda dirChCols cmp #60 bcs + ldy #8 + ldx #0 - lda utoaNumber,x sta dirline,y iny inx cpx #8 bcc - lda #" " sta dirline,y iny ;** unclosed flag lda dirline+4 cmp #"-" bne + lda #" " + sta dirline,y iny ;** filetype ldx #0 - lda aceDirentType,x ora #$80 sta dirline,y iny inx cpx #3 bcc - lda #" " sta dirline,y iny sta dirline,y iny ;** filename ldx #0 - lda aceDirentName,x beq + sta dirline,y iny inx bne - + lda #chrCR sta dirline,y iny lda #0 sta dirline,y sty dirlineLen rts dirDisplayShort = * lda #<aceDirentName ldy #>aceDirentName jsr puts inc dirCurCol lda dirCurCol cmp dirColumns bcc + lda #0 sta dirCurCol lda #chrCR jmp putchar + ldy #$ff - iny lda aceDirentName,y bne - sty dirSpaces lda #20 sbc dirSpaces sta dirSpaces - lda #" " jsr putchar dec dirSpaces bne - rts dirDisplayHeading = * lda #<dirHeadingMsg ldy #>dirHeadingMsg jsr puts lda #<aceDirentName ldy #>aceDirentName jsr puts lda #chrCR jsr putchar rts dirHeadingMsg = * .asc "Dir: " .byte 0 dirDisplayTrailer = * ldx #3 - lda aceDirentBytes,x sta dirFree,x dex bpl - ldx #0 ldy #0 - lda dirTrailingMsg,x beq + cmp #4 bcc storeNum sta trailBuf,y inx iny bne - + lda #<trailBuf ldx #>trailBuf sta zp+0 stx zp+1 tya ldy #0 ldx #stdout jmp write storeNum = * stx work+0 sty work+1 sec sbc #1 asl asl adc #dirFiles tax lda #<utoaNumber ldy #>utoaNumber sta syswork+0 sty syswork+1 lda #1 jsr utoa ldx #0 ldy work+1 - lda utoaNumber,x beq + sta trailBuf,y inx iny bne - + ldx work+0 inx jmp -- dirTrailingMsg = * .asc "files=" .byte 1 .asc " bytes=" .byte 2 .asc " free=" .byte 3 .byte chrCR .byte 0 trailBuf .buf 64 putInDate = * ;** year lda aceDirentDate+1 ldx #9 jsr putDigits ;** month lda aceDirentDate+2 cmp #$10 bcc + sec sbc #$10-10 + tax lda monthStr+0,x sta dirDateStr+5 lda monthStr+13,x sta dirDateStr+6 lda monthStr+26,x sta dirDateStr+7 ;** day lda aceDirentDate+3 ldx #2 jsr putDigits ;** hour lda aceDirentDate+4 ldx #"a" cmp #$00 bne + lda #$12 jmp putHour + cmp #$12 bcc putHour ldx #"p" cmp #$12 beq putHour sei sed sec sbc #$12 cld cli putHour = * stx dirDateStr+18 ldx #13 jsr putDigits ;** minute lda aceDirentDate+5 ldx #16 jsr putDigits rts putDigits = * ;( .A=num, .X=offset ) pha lsr lsr lsr lsr ora #$30 sta dirDateStr,x pla and #$0f ora #$30 sta dirDateStr+1,x rts monthStr = * .asc "XJFMAMJJASOND" .asc "xaeapauuuecoe" .asc "xnbrrynlgptvc" ;******** standard library ******** puts = * ldx #stdout fputs = * sta zp sty zp+1 ldy #$ff - iny lda (zp),y bne - tya ldy #0 jmp write eputs = * ldx #stderr jmp fputs putchar = * ldx #stdout putc = * sta putcBuffer lda #<putcBuffer ldy #>putcBuffer sta zp sty zp+1 lda #1 ldy #0 jmp write putcBuffer .buf 1 getarg = * sty zp+1 asl sta zp rol zp+1 clc lda aceArgv adc zp sta zp lda aceArgv+1 adc zp+1 sta zp+1 ldy #0 lda (zp),y tax iny lda (zp),y stx zp sta zp+1 rts utoaNumber .buf 11 ;===bss=== bss = *