diff --git a/Apps/Assign - Copy.asm b/Apps/Assign - Copy.asm new file mode 100644 index 00000000..4fc1aedd --- /dev/null +++ b/Apps/Assign - Copy.asm @@ -0,0 +1,1073 @@ +;=============================================================================== +; ASSIGN - Display and/or modify drive letter assignments +; +;=============================================================================== +; +; Author: Wayne Warthen (wwarthen@gmail.com) +;_______________________________________________________________________________ +; +; Usage: +; ASSIGN [D:={D:|[:]}] +; ex: ASSIGN (display all active drive assignments) +; ASSIGN /? (display version and usage) +; ASSIGN /L (display all possible devices) +; ASSIGN C:=D: (swaps C: and D:) +; ASSIGN C:=FD0: (assign C: to floppy unit 0) +; ASSIGN C:=IDE0:1 (assign C: to IDE unit0, slice 1) +;_______________________________________________________________________________ +; +; Change Log: +;_______________________________________________________________________________ +; +; ToDo: +; 1) Do something to prevent assigning to non-existent devices +; 2) Do something to prevent assigning slices when device does not support them +;_______________________________________________________________________________ +; +;=============================================================================== +; Definitions +;=============================================================================== +; +stksiz .equ $40 ; Working stack size +; +restart .equ $0000 ; CP/M restart vector +bdos .equ $0005 ; BDOS invocation vector +; +stamp .equ $40 ; loc of RomWBW CBIOS zero page stamp +; +rmj .equ 2 ; CBIOS version - major +rmn .equ 6 ; CBIOS version - minor +; +;=============================================================================== +; Code Section +;=============================================================================== +; + .org $100 +; + ; setup stack (save old value) + ld (stksav),sp ; save stack + ld sp,stack ; set new stack +; + ; initialization + call init ; initialize + jr nz,exit ; abort if init fails +; + ; do the real work + call process ; parse and process command line +; + ; perform table integrity check + call valid +; +exit: ; clean up and return to command processor +; + ld sp,(stksav) ; restore stack + jp restart ; return to CP/M via restart + ret ; return to CP/M w/o restart +; +; Initialization +; +init: +; + ; locate cbios function table address + ld hl,(restart+1) ; load address of CP/M restart vector + ld de,-3 ; adjustment for start of table + add hl,de ; HL now has start of table + ld (cbftbl),hl ; save it +; + ; get location of config data and verify integrity + ld hl,stamp ; HL := adr or RomWBW zero page stamp + ld a,(hl) ; get first byte of RomWBW marker + cp 'W' ; match? + jp nz,errinv ; abort with invalid config block + inc hl ; next byte (marker byte 2) + ld a,(hl) ; load it + cp ~'W' ; match? + jp nz,errinv ; abort with invalid config block + inc hl ; next byte (major/minor version) + ld a,(hl) ; load it + cp rmj << 4 | rmn ; match? + jp nz,errver ; abort with invalid os version + inc hl ; bump past + inc hl ; ... version info +; + ; dereference HL to point to CBIOS extension data + ld a,(hl) ; dereference HL + inc hl ; ... to point to + ld h,(hl) ; ... ROMWBW config data block + ld l,a ; ... in CBIOS +; + ; get location of drive map + inc hl ; bump two bytes + inc hl ; ... to drive map address + ld a,(hl) ; dereference HL + inc hl ; ... to point to + ld h,(hl) ; ... drivemap data + ld l,a ; ... in CBIOS + ld (maploc),hl ; and save it +; + ; check for UNA (UBIOS) + ld a,($fffd) ; fixed location of UNA API vector + cp $c3 ; jp instruction? + jr nz,initx ; if not, not UNA + ld hl,($fffe) ; get jp address + ld a,(hl) ; get byte at target address + cp $fd ; first byte of UNA push ix instruction + jr nz,initx ; if not, not UNA + inc hl ; next byte + ld a,(hl) ; get next byte + cp $e5 ; second byte of UNA push ix instruction + jr nz,initx ; if not, not UNA + ld hl,unamod ; point to UNA mode flag + ld (hl),$ff ; set UNA mode +; +initx: + ; return success + xor a ; signal success + ret ; return +; +; Process command line +; +process: +; + ; look for start of parms + ld hl,$81 ; point to start of parm area (past len byte) + call nonblank ; skip to next non-blank char + jp z,showall ; no parms, show all active assignments +; + ; check for special option, introduced by a "/" + cp '/' ; start of usage request? + jr z,option ; yes, handle option +; +process0: +; + sub 'A' ; make it binary + ld (dstdrv),a ; save it as destination drive + inc hl ; next char + ld a,(hl) ; get it + cp ':' ; is it ':' as expected? + jp nz,errprm ; error if not + inc hl ; skip ':' + call nonblank ; skip possible blanks + cp '=' ; proper delimiter? + jr z,process1 ; yes, continue + or a ; set flags + jp nz,errprm ; handle unexpected delimiter + ld a,(dstdrv) ; dest drive back to A + jp showone ; no more parms, dump specific drive assignment +; +process1: ; handle other side of '=' +; + inc hl ; skip '=' + call nonblank ; skip blanks as needed + jp z,errprm ; nothing after '=', parm error + call getalpha ; gobble all alpha characters + dec b ; decrement num chars parsed + jr nz,process2 ; more than 1 char, handle as device name +; + ; handle as drive swap + cp ':' ; check for mandatory trailing colon + jp nz,errprm ; handle unexpected character + inc hl ; skip ':' + ld a,(tmpstr) ; get the drive letter + sub 'A' ; make it binary + ld (srcdrv),a ; assume it is a src drv and save it + ld de,drvswap ; put routine to call in DE + jr process4 ; and continue +; +process2: ; handle a device/slice assignment +; + call getnum ; get number from buffer + jp c,errnum ; abort on overflow + cp 16 ; compare to max + jp nc,errnum ; abort if too high + ld (unit),a ; save it as unit num + ld a,(hl) ; get terminating char + cp ':' ; check for mandatory colon + jp nz,errprm ; handle unexpected character + inc hl ; skip past colon + call getnum ; get number from buffer + jp c,errnum ; abort on overflow + ld (slice),a ; save it as slice num + ld de,drvmap ; put routine to call in DE + jr process4 ; and continue +; +process4: ; check for terminating null or comma +; + call nonblank ; skip possible blanks + jr z,process5 ; null terminator OK + cp ',' ; check for comma + jr z,process5 ; also OK + jp errprm ; otherwise parm error +; +process5: ; do the processing +; + ex de,hl ; move routine to call to HL + push de ; save command string pointer + call jphl ; do the work + pop hl ; recover command string pointer + ld a,(hl) ; get the current cmd string char + or a ; set flags + ret z ; if null, we are done + inc hl ; otherwise, skip comma + call nonblank ; and possible blanks after comma + ret z ; get out if nothing more + jr process0 ; we have more work, loop +; +; Handle special options +; +option: +; + inc hl ; next char + ld a,(hl) ; get it + cp '?' ; is it a '?' as expected? + jp z,usage ; yes, display usage + cp 'L' ; is it a 'L', display device list? + jp z,devlist ; yes, display device list + jp errprm ; anything else is an error +; +usage: +; + ld de,msgban1 ; point to version message part 1 + call prtstr ; print it + ld a,(unamod) ; get UNA flag + or a ; set flags + ld de,msghb ; point to HBIOS mode message + call z,prtstr ; if not UNA, say so + ld de,msgub ; point to UBIOS mode message + call nz,prtstr ; if UNA, say so + ld de,msgban2 ; point to version message part 2 + call prtstr ; print it + call crlf ; blank line + ld de,msguse ; point to usage message + call prtstr ; print it + ret ; and return +; +devlist: +; + ld a,(unamod) ; get UNA mode flag + or a ; set flags + jr nz,devlstu ; do UNA mode dev list +; + call crlf + ld c,0 +devlist1: + ld de,indent ; indent + call prtstr ; ... to look nice + ld a,c + call prtdev + ld a,':' + call prtchr + call crlf + inc c + ld a,c + cp devcnt + jr nz,devlist1 + ret +; +devlstu: + ; UNA mode device list + ld b,0 ; use unit 0 to get count + ld c,$48 ; una func: get disk type + ld l,0 ; preset unit count to zero + call $fffd ; call una, b is assumed to be untouched!!! + ld a,l ; unit count to a + or a ; set flags + ret z ; no units, return + ld b,l ; unit count to b + ld c,0 ; init unit index +devlstu1: + push bc ; save loop control vars + ld de,indent ; indent + call prtstr ; ... to look nice + ld a,c ; put unit num in A + push af ; save it + call prtdevu ; print the device name + pop af ; restore unit num + call prtdecb ; print unit num + ld a,':' ; colon delimiter + call prtchr ; print it + call crlf ; formatting + pop bc ; restore loop control + inc c ; next drive + djnz devlstu1 ; loop as needed + ret ; return +; +; Scan drive map table for integrity +; Currently just checks for multiple drive +; letters referencing a single file system +; +valid: + ld hl,(maploc) ; get the map table location + dec hl ; point to table entry count + ld b,(hl) ; B := table entries + dec b ; loop one less times than num entries + inc hl ; point back to table start +; +valid1: ; outer loop + push hl ; save pointer + push bc ; save loop control + call valid2 ; do the inner loop + pop bc ; restore loop control + pop hl ; restore pointer + jp z,errint ; validation error + ld a,4 ; 4 bytes per entry + call addhl ; bump to next entry + djnz valid1 ; loop until done + ret ; done +; +valid2: ; setup for inner loop + push hl ; save HL + ld a,4 ; 4 bytes per entry + call addhl ; point to entry following + pop de ; de points to comparison entry +; +valid3: ; inner loop + ld c,(hl) ; first byte to C + ld a,(de) ; second byte to A + cp c ; compare + inc hl ; bump HL to next byte + jr nz,valid4 ; if not equal, continue loop + inc de ; bump DE to next byte + ld c,(hl) ; first byte to C + ld a,(de) ; second byte to A + cp c ; compare + ret z ; both bytes equal, return signaling problem + dec de ; point DE back to first byte of comparison entry +; +valid4: ; no match, loop + inc hl ; bump HL + inc hl ; ... to + inc hl ; ... next entry + djnz valid3 ; loop as appropriate + ret +; +; Swap the source and destination drive letters +; +drvswap: + ld a,(dstdrv) ; get the destination drive + call chkdrv ; valid drive? + ret nz ; abort if not + ld a,(srcdrv) ; get the source drive + call chkdrv ; valid drive? + ret nz ; abort if not + ld hl,(drives) ; load source/dest in DE + ld a,h ; put source drive num in a + cp l ; compare to the dest drive num + jp z,errswp ; Invalid swap request, src == dest +; + ; Get pointer to source drive table entry + ld hl,(maploc) + ld a,(srcdrv) + rlca + rlca + call addhl + ld (srcptr),hl +; + ; Get pointer to destination drive table entry + ld hl,(maploc) + ld a,(dstdrv) + rlca + rlca + call addhl + ld (dstptr),hl +; + ; 1) dest -> temp + ld hl,(dstptr) + ld de,tmpent + ld bc,4 + ldir +; + ; 2) source -> dest + ld hl,(srcptr) + ld de,(dstptr) + ld bc,4 + ldir +; + ; 3) temp -> source + ld hl,tmpent + ld de,(srcptr) + ld bc,4 + ldir +; + ; print the results + ld a,(dstdrv) ; get the destination + call showone ; show it + ld a,(srcdrv) ; get the source drive + call showone ; show it +; + jp drvrst ; exit via a full drive reset +; +; Assign drive to specified device/unit/slice +; +drvmap: ; determine device code by scanning for string + ld b,16 ; device table always has 16 entries + ld c,0 ; c is used to track table entry num + ld de,tmpstr ; de points to specified device name + ld hl,devtbl ; hl points to first entry of dvtbl +; +drvmap1: ; loop through device table looking for a match + push hl ; save device table entry pointer + ld a,(hl) ; dereference HL + inc hl ; ... to point to + ld h,(hl) ; ... string + ld l,a ; ... in device table + push de ; save string pointer + push bc ; save loop control stuff + call strcmp ; compare strings + pop bc ; restore loop control stuff + pop de ; restore de + pop hl ; restore table entry pointer + jr z,drvmap2 ; match, continue + inc hl ; bump to next + inc hl ; device table pointer + inc c ; keep track of table entry num + djnz drvmap1 ; and loop + jp errdev +; +drvmap2: ; verify the unit is eligible for assignment (hard disk unit only!) + ld a,c ; get the specified device number + call chktyp ; check it + jp nz,errtyp ; abort with bad unit error +; + ; construct the requested dph table entry + ld a,c ; C has device num + rlca ; move it to upper nibble + rlca ; ... + rlca ; ... + rlca ; ... + ld c,a ; stash it back in C + ld a,(unit) ; get the unit number + or c ; combine device and unit + ld c,a ; and save in C + ld a,(slice) ; get the slice + ld b,a ; and save in B +; + ; resolve the CBIOS DPH table entry + ld a,(dstdrv) ; dest drv num to A + call chkdrv ; valid drive? + ret nz ; abort if invalid + ld hl,(maploc) ; start of DPH table to HL + rlca ; multiply by + rlca ; ... entry size of 4 + call addhl ; adjust HL to point to entry + ld (dstptr),hl ; save it +; + ; verify the drive letter being assigned is a hard disk + ld a,(hl) ; get the device/unit byte + rrca ; move device nibble to low nibble + rrca ; ... + rrca ; ... + rrca ; ... + and $0F ; and isolate device bits + call chktyp ; check it + jp nz,errtyp ; abort with bad device type error +; + ; shove updated device/unit/slice into the entry + ld (hl),c ; save device/unit byte + inc hl ; bump to next byte + ld (hl),b ; save slice +; + ; finish up + ld a,(dstdrv) ; get the destination drive + call showone ; show it's new value + jp drvrst ; exit via drive reset +; +; Display all active drive letter assignments +; +showall: + ld hl,(maploc) ; HL = address of drive map + dec hl ; point to prior byte with map entry count + ld b,(hl) ; put it in b for loop counter + ld c,0 ; map index (drive letter) +; + ld a,b ; load count + or a ; set flags + ret z ; bail out if zero +; +showall1: ; loop + ld a,c ; + call showone + inc c + djnz showall1 + ret +; +; Display drive letter assignment for the drive num in A +; +showone: +; + push af ; save the incoming drive num +; + ld de,indent ; indent + call prtstr ; ... to look nice +; + ; setup HL to point to desired entry in table + pop af + push af + ld hl,(maploc) ; HL = address of drive map + rlca + rlca + call addhl ; HL = address of drive map table entry + pop af +; + ; render the drive letter based on table index + add a,'A' ; convert to alpha + call prtchr ; print it + ld a,':' ; conventional color after drive letter + call prtchr ; print it + ld a,'=' ; use '=' to represent assignment + call prtchr ; print it +; + ; render the map entry + ld a,(hl) ; load device/unit + call prtdev ; print device mnemonic + ld a,(hl) ; load device/unit again + and $0F ; isolate unit num + call prtdecb ; print it + inc hl ; point to slice num + ld a,':' ; colon to separate slice + call prtchr ; print it + ld a,(hl) ; load slice num + call prtdecb ; print it +; + call crlf +; + ret +; +; Force BDOS to reset (logout) all drives +; +drvrst: + ld c,$0D ; BDOS Reset Disk function + call bdos ; do it +; + xor a ; signal success + ret +; +; Print device mnemonic based on device number in A +; +prtdev: + ld e,a ; stash incoming device num in E + ld a,(unamod) ; get UNA mode flag + or a ; set flags + ld a,e ; put device num back + jr nz,prtdevu ; print device in UNA mode + rrca ; isolate high nibble (device) + rrca ; ... + rrca ; ... + rrca ; ... into low nibble + and $0F ; mask out undesired bits + push hl ; save HL + add a,a ; multiple A by two for word table + ld hl,devtbl ; point to start of device name table + call addhl ; add A to hl to point to table entry + ld a,(hl) ; dereference hl to loc of device name string + inc hl ; ... + ld d,(hl) ; ... + ld e,a ; ... + call prtstr ; print the device nmemonic + pop hl ; restore HL + ret ; done +; +prtdevu: + ld e,a ; save unit num in E + push bc + push de + push hl + ; UNA mode version of print device + ld b,a ; B := unit num + ld c,$48 ; UNA func: get disk type + call $FFFD ; call UNA + ld a,d ; disk type to A + pop hl + pop de + pop bc +; + cp $40 ; RAM/ROM? + jr z,prtdevu1 ; if so, handle it + cp $41 ; IDE? + ld de,udevide ; load string + jp z,prtstr ; if IDE, print and return + cp $43 ; SD? + ld de,udevsd ; load string + jp z,prtstr ; if SD, print and return + ld de,udevunk ; load string for unknown + jr prtstr ; and print it +; +prtdevu1: + ; handle RAM/ROM + push bc + push hl + ld b,e ; unit num to B + ld c,$45 ; UNA func: get disk info + ld de,$9000 ; 512 byte buffer *** FIX!!! *** + call $FFFD ; call UNA + bit 7,b ; test RAM drive bit + pop hl + pop bc + ld de,udevrom ; load string + jp z,prtstr ; print and return + ld de,udevram ; load string + jp prtstr ; print and return +; +; Check that specified drive num is valid +; +chkdrv: + push hl ; preserve incoming hl + ld hl,(maploc) ; point to drive map + dec hl ; back up to point to table entry count + cp (hl) ; compare to incoming + pop hl ; restore hl now + jp nc,errdrv ; handle bad drive + cp a ; set Z to signal good + ret ; and return +; +; Check that specified device is valid for a mapping operation +; Only hard disk devices are dynamically mappable because +; the DPH vector allocation sizes may not change. +; +chktyp: + cp 3 ; first mappable device is 3 (IDE) + jr c,chkunit1 ; if below 3, return error + cp 9 + 1 ; last mappable device is 9 (HDSK) + jr nc,chkunit1 ; if above 8, return error + xor a ; signal valid + ret ; and return +; +chkunit1: ; return error + or $ff ; signal error + ret ; and return +; +; Print character in A without destroying any registers +; +prtchr: + push bc ; save registers + push de + push hl + ld e,a ; character to print in E + ld c,$02 ; BDOS function to output a character + call bdos ; do it + pop hl ; restore registers + pop de + pop bc + ret +; +prtdot: +; + ; shortcut to print a dot preserving all regs + push af ; save af + ld a,'.' ; load dot char + call prtchr ; print it + pop af ; restore af + ret ; done +; +; Print a zero terminated string at (HL) without destroying any registers +; +prtstr: + push de +; +prtstr1: + ld a,(de) ; get next char + or a + jr z,prtstr2 + call prtchr + inc de + jr prtstr1 +; +prtstr2: + pop de ; restore registers + ret +; +; Print the value in A in hex without destroying any registers +; +prthex: + push af ; save AF + push de ; save DE + call hexascii ; convert value in A to hex chars in DE + ld a,d ; get the high order hex char + call prtchr ; print it + ld a,e ; get the low order hex char + call prtchr ; print it + pop de ; restore DE + pop af ; restore AF + ret ; done +; +; Convert binary value in A to ascii hex characters in DE +; +hexascii: + ld d,a ; save A in D + call hexconv ; convert low nibble of A to hex + ld e,a ; save it in E + ld a,d ; get original value back + rlca ; rotate high order nibble to low bits + rlca + rlca + rlca + call hexconv ; convert nibble + ld d,a ; save it in D + ret ; done +; +; Convert low nibble of A to ascii hex +; +hexconv: + and $0F ; low nibble only + add a,$90 + daa + adc a,$40 + daa + ret +; +; Print value of A or HL in decimal with leading zero suppression +; Use prtdecb for A or prtdecw for HL +; +prtdecb: + push hl + ld h,0 + ld l,a + call prtdecw ; print it + pop hl + ret +; +prtdecw: + push af + push bc + push de + push hl + call prtdec0 + pop hl + pop de + pop bc + pop af + ret +; +prtdec0: + ld e,'0' + ld bc,-10000 + call prtdec1 + ld bc,-1000 + call prtdec1 + ld bc,-100 + call prtdec1 + ld c,-10 + call prtdec1 + ld e,0 + ld c,-1 +prtdec1: + ld a,'0' - 1 +prtdec2: + inc a + add hl,bc + jr c,prtdec2 + sbc hl,bc + cp e + ret z + ld e,0 + call prtchr + ret +; +; Start a new line +; +crlf: + ld a,13 ; + call prtchr ; print it + ld a,10 ; + jp prtchr ; print it +; +; Get the next non-blank character from (HL). +; +nonblank: + ld a,(hl) ; load next character + or a ; string ends with a null + ret z ; if null, return pointing to null + cp ' ' ; check for blank + ret nz ; return if not blank + inc hl ; if blank, increment character pointer + jr nonblank ; and loop +; +; Check character at (DE) for delimiter. +; +delim: or a + ret z + cp ' ' ; blank + ret z + jr c,delim1 ; handle control characters + cp '=' ; equal + ret z + cp '_' ; underscore + ret z + cp '.' ; period + ret z + cp ':' ; colon + ret z + cp $3b ; semicolon + ret z + cp '<' ; less than + ret z + cp '>' ; greater than + ret +delim1: + ; treat control chars as delimiters + xor a ; set Z + ret ; return +; +; Get alpha chars and save in tmpstr +; return with terminating char in A and flags set +; return with num chars in B +; +getalpha: +; + ld de,tmpstr ; location to save chars + ld b,0 ; length counter +; +getalpha1: + ld a,(hl) ; get active char + cp 'A' ; check for start of alpha range + jr c,getalpha2 ; not alpha, get out + cp 'Z' + 1 ; check for end of alpha range + jr nc,getalpha2 ; not alpha, get out + ; handle alpha char + inc hl ; increment buffer ptr + ld (de),a ; save it + inc de ; inc string pointer + inc b ; inc string length + ld a,b ; put length in A + cp 8 ; max length? + jr z,getalpha2 ; if max, get out + jr getalpha1 ; and loop +; +getalpha2: ; non-alpha, clean up and return + xor a ; clear accum + ld (de),a ; terminate string + ld a,(hl) ; recover terminating char + or a ; set flags + ret ; and done +; +; Get numeric chars and convert to number returned in A +; Carry flag set on overflow +; +getnum: + ld c,0 ; C is working register +getnum1: + ld a,(hl) ; get the active char + cp '0' ; compare to ascii '0' + jr c,getnum2 ; abort if below + cp '9' + 1 ; compare to ascii '9' + jr nc,getnum2 ; abort if above\ +; + ; valid digit, add new digit to C + ld a,c ; get working value to A + rlca ; multiply by 10 + ret c ; overflow, return with carry set + rlca ; ... + ret c ; overflow, return with carry set + add a,c ; ... + ret c ; overflow, return with carry set + rlca ; ... + ret c ; overflow, return with carry set + ld c,a ; back to C + ld a,(hl) ; get new digit + sub '0' ; make binary + add a,c ; add in working value + ret c ; overflow, return with carry set + ld c,a ; back to C +; + inc hl ; bump to next char + jr getnum1 ; loop +; +getnum2: ; return result + ld a,c ; return result in A + or a ; with flags set, CF is cleared + ret +; +; Compare null terminated strings at HL & DE +; If equal return with Z set, else NZ +; +strcmp: +; + ld a,(de) ; get current source char + cp (hl) ; compare to current dest char + ret nz ; compare failed, return with NZ + or a ; set flags + ret z ; end of string, match, return with Z set + inc de ; point to next char in source + inc hl ; point to next char in dest + jr strcmp ; loop till done +; +; Invoke CBIOS function +; The CBIOS function offset must be stored in the byte +; following the call instruction. ex: +; call cbios +; .db $0C ; offset of CONOUT CBIOS function +; +cbios: + ex (sp),hl + ld a,(hl) ; get the function offset + inc hl ; point past value following call instruction + ex (sp),hl ; put address back at top of stack and recover HL + ld hl,(cbftbl) ; address of CBIOS function table to HL + call addhl ; determine specific function address + jp (hl) ; invoke CBIOS +; +; Add the value in A to HL (HL := HL + A) +; +addhl: + add a,l ; A := A + L + ld l,a ; Put result back in L + ret nc ; if no carry, we are done + inc h ; if carry, increment H + ret ; and return +; +; Jump indirect to address in HL +; +jphl: + jp (hl) +; +; Errors +; +erruse: ; command usage error (syntax) + ld de,msguse + jr err +; +errprm: ; command parameter error (syntax) + ld de,msgprm + jr err +; +errinv: ; invalid CBIOS, zp signature not found + ld de,msginv + jr err +; +errver: ; CBIOS version is not as expected + ld de,msgver + jr err +; +errdrv: ; CBIOS version is not as expected + push af + ld de,msgdrv1 + call prtstr + pop af + add a,'A' + call prtchr + ld de,msgdrv2 + jr err1 +; +errswp: ; invalid drive swap request + ld de,msgswp + jr err +; +errdev: ; invalid device name + ld de,msgdev + jr err +; +errtyp: ; invalid device assignment request (not a hard disk device type) + ld de,msgtyp + jr err +; +errnum: ; invalid number parsed, overflow + ld de,msgnum + jr err +; +errint: ; DPH table integrity error (multiple drives ref one filesystem) + ld de,msgint + jr err +; +errdos: ; handle BDOS errors + push af ; save return code + call crlf ; newline + ld de,msgdos ; load + call prtstr ; and print error string + pop af ; recover return code + call prthex ; print error code + jr err2 +; +err: ; print error string and return error signal + call crlf ; print newline +; +err1: ; without the leading crlf + call prtstr ; print error string +; +err2: ; without the string + call crlf ; print newline + or $FF ; signal error + ret ; done +; +;=============================================================================== +; Storage Section +;=============================================================================== +; +cbftbl .dw 0 ; address of CBIOS function table +maploc .dw 0 ; location of drive map +drives: +dstdrv .db 0 ; destination drive +srcdrv .db 0 ; source drive +device .db 0 ; source device +unit .db 0 ; source unit +slice .db 0 ; source slice +; +unamod .db 0 ; $FF indicates UNA UBIOS active +; +srcptr .dw 0 ; source pointer for copy +dstptr .dw 0 ; destination pointer for copy +tmpent .fill 4,0 ; space to save a table entry +tmpstr .fill 9,0 ; temporary string of up to 8 chars, zero term +; +devtbl: ; device table + .dw dev00, dev01, dev02, dev03 + .dw dev04, dev05, dev06, dev07 + .dw dev08, dev09, dev10, dev11 + .dw dev12, dev13, dev14, dev15 +; +devunk .db "?",0 +dev00 .db "MD",0 +dev01 .db "FD",0 +dev02 .db "RAMF",0 +dev03 .db "IDE",0 +dev04 .db "ATAPI",0 +dev05 .db "PPIDE",0 +dev06 .db "SD",0 +dev07 .db "PRPSD",0 +dev08 .db "PPPSD",0 +dev09 .db "HDSK",0 +dev10 .equ devunk +dev11 .equ devunk +dev12 .equ devunk +dev13 .equ devunk +dev14 .equ devunk +dev15 .equ devunk +; +devcnt .equ 10 ; 10 devices defined +; +udevram .db "RAM",0 +udevrom .db "ROM",0 +udevide .db "IDE",0 +udevsd .db "SD",0 +udevunk .db "UNK",0 +; +stksav .dw 0 ; stack pointer saved at start + .fill stksiz,0 ; stack +stack .equ $ ; stack top +; +; Messages +; +indent .db " ",0 +msgban1 .db "ASSIGN v0.9c for RomWBW CP/M 2.2, 20-Aug-2014",0 +msgban2 .db 13,10,"Copyright 2014, Wayne Warthen, GNU GPL v3",13,10,0 +msghb .db " (HBIOS Mode)",0 +msgub .db " (UBIOS Mode)",0 +msguse .db "Usage: ASSIGN [D:[={D:|[:]}]]",13,10 + .db " ex. ASSIGN (display all active assignments)",13,10 + .db " ASSIGN /? (display version and usage)",13,10 + .db " ASSIGN /L (display all possible devices)",13,10 + .db " ASSIGN C:=D: (swaps C: and D:)",13,10 + .db " ASSIGN C:=FD0: (assign C: to floppy unit 0)",13,10 + .db " ASSIGN C:=IDE0:1 (assign C: to IDE unit0, slice 1)",13,10,0 +msgprm .db "Parameter error (ASSIGN /? for usage)",0 +msginv .db "Unexpected CBIOS (signature missing)",0 +msgver .db "Unexpected CBIOS version",0 +msgdrv1 .db "Invalid drive letter (",0 +msgdrv2 .db ":)",0 +msgswp .db "Invalid drive swap request",0 +msgdev .db "Invalid device name",0 +msgnum .db "Unit or slice number invalid",0 +msgtyp .db "Only hard drive devices can be reassigned",0 +msgint .db "WARNING: Multiple drive letters reference one filesystem!",0 +msgdos .db "DOS error, return code=0x",0 +; + .end \ No newline at end of file diff --git a/Apps/Assign.asm b/Apps/Assign.asm new file mode 100644 index 00000000..cbddc601 --- /dev/null +++ b/Apps/Assign.asm @@ -0,0 +1,1163 @@ +;=============================================================================== +; ASSIGN - Display and/or modify drive letter assignments +; +;=============================================================================== +; +; Author: Wayne Warthen (wwarthen@gmail.com) +;_______________________________________________________________________________ +; +; Usage: +; ASSIGN [D:={D:|[]:[]}] +; ex: ASSIGN (display all active drive assignments) +; ASSIGN /? (display version and usage) +; ASSIGN /L (display all possible devices) +; ASSIGN C:=D: (swaps C: and D:) +; ASSIGN C:=FD0: (assign C: to floppy unit 0) +; ASSIGN C:=IDE0:1 (assign C: to IDE unit0, slice 1) +;_______________________________________________________________________________ +; +; Change Log: +;_______________________________________________________________________________ +; +; ToDo: +; 1) Do something to prevent assigning to non-existent devices +; 2) Do something to prevent assigning slices when device does not support them +;_______________________________________________________________________________ +; +;=============================================================================== +; Definitions +;=============================================================================== +; +stksiz .equ $40 ; Working stack size +; +restart .equ $0000 ; CP/M restart vector +bdos .equ $0005 ; BDOS invocation vector +; +stamp .equ $40 ; loc of RomWBW CBIOS zero page stamp +; +rmj .equ 2 ; CBIOS version - major +rmn .equ 6 ; CBIOS version - minor +; +;=============================================================================== +; Code Section +;=============================================================================== +; + .org $100 +; + ; setup stack (save old value) + ld (stksav),sp ; save stack + ld sp,stack ; set new stack +; + ; initialization + call init ; initialize + jr nz,exit ; abort if init fails +; + ; do the real work + call process ; parse and process command line +; + ; perform table integrity check + call valid +; +exit: ; clean up and return to command processor +; + ld sp,(stksav) ; restore stack + jp restart ; return to CP/M via restart + ret ; return to CP/M w/o restart +; +; Initialization +; +init: +; + ; locate cbios function table address + ld hl,(restart+1) ; load address of CP/M restart vector + ld de,-3 ; adjustment for start of table + add hl,de ; HL now has start of table + ld (cbftbl),hl ; save it +; + ; get location of config data and verify integrity + ld hl,stamp ; HL := adr or RomWBW zero page stamp + ld a,(hl) ; get first byte of RomWBW marker + cp 'W' ; match? + jp nz,errinv ; abort with invalid config block + inc hl ; next byte (marker byte 2) + ld a,(hl) ; load it + cp ~'W' ; match? + jp nz,errinv ; abort with invalid config block + inc hl ; next byte (major/minor version) + ld a,(hl) ; load it + cp rmj << 4 | rmn ; match? + jp nz,errver ; abort with invalid os version + inc hl ; bump past + inc hl ; ... version info +; + ; dereference HL to point to CBIOS extension data + ld a,(hl) ; dereference HL + inc hl ; ... to point to + ld h,(hl) ; ... ROMWBW config data block + ld l,a ; ... in CBIOS +; + ; get location of drive map + inc hl ; bump two bytes + inc hl ; ... to drive map address + ld a,(hl) ; dereference HL + inc hl ; ... to point to + ld h,(hl) ; ... drivemap data + ld l,a ; ... in CBIOS + ld (maploc),hl ; and save it +; + ; check for UNA (UBIOS) + ld a,($fffd) ; fixed location of UNA API vector + cp $c3 ; jp instruction? + jr nz,initx ; if not, not UNA + ld hl,($fffe) ; get jp address + ld a,(hl) ; get byte at target address + cp $fd ; first byte of UNA push ix instruction + jr nz,initx ; if not, not UNA + inc hl ; next byte + ld a,(hl) ; get next byte + cp $e5 ; second byte of UNA push ix instruction + jr nz,initx ; if not, not UNA + ld hl,unamod ; point to UNA mode flag + ld (hl),$ff ; set UNA mode +; +initx: + ; return success + xor a ; signal success + ret ; return +; +; Process command line +; +process: +; + ; look for start of parms + ld hl,$81 ; point to start of parm area (past len byte) + call nonblank ; skip to next non-blank char + jp z,showall ; no parms, show all active assignments +; + ; check for special option, introduced by a "/" + cp '/' ; start of usage request? + jr z,option ; yes, handle option +; +process0: +; + sub 'A' ; make it binary + ld (dstdrv),a ; save it as destination drive + inc hl ; next char + ld a,(hl) ; get it + cp ':' ; is it ':' as expected? + jp nz,errprm ; error if not + inc hl ; skip ':' + call nonblank ; skip possible blanks + cp '=' ; proper delimiter? + jr z,process1 ; yes, continue + or a ; set flags + jp nz,errprm ; handle unexpected delimiter + ld a,(dstdrv) ; dest drive back to A + jp showone ; no more parms, dump specific drive assignment +; +process1: ; handle other side of '=' +; + inc hl ; skip '=' + call nonblank ; skip blanks as needed + jp z,errprm ; nothing after '=', parm error + call getalpha ; gobble all alpha characters + dec b ; decrement num chars parsed + jr nz,process2 ; more than 1 char, handle as device name +; + ; handle as drive swap + cp ':' ; check for mandatory trailing colon + jp nz,errprm ; handle unexpected character + inc hl ; skip ':' + ld a,(tmpstr) ; get the drive letter + sub 'A' ; make it binary + ld (srcdrv),a ; assume it is a src drv and save it + ld de,drvswap ; put routine to call in DE + jr process4 ; and continue +; +process2: ; handle a device/slice assignment +; + call getnum ; get number from buffer + jp c,errnum ; abort on overflow + cp 16 ; compare to max + jp nc,errnum ; abort if too high + ld (unit),a ; save it as unit num + ld a,(hl) ; get terminating char + cp ':' ; check for mandatory colon + jp nz,errprm ; handle unexpected character + inc hl ; skip past colon + call getnum ; get number from buffer + jp c,errnum ; abort on overflow + ld (slice),a ; save it as slice num + ld de,drvmap ; put routine to call in DE + jr process4 ; and continue +; +process4: ; check for terminating null or comma +; + call nonblank ; skip possible blanks + jr z,process5 ; null terminator OK + cp ',' ; check for comma + jr z,process5 ; also OK + jp errprm ; otherwise parm error +; +process5: ; do the processing +; + ex de,hl ; move routine to call to HL + push de ; save command string pointer + call jphl ; do the work + pop hl ; recover command string pointer + ld a,(hl) ; get the current cmd string char + or a ; set flags + ret z ; if null, we are done + inc hl ; otherwise, skip comma + call nonblank ; and possible blanks after comma + ret z ; get out if nothing more + jr process0 ; we have more work, loop +; +; Handle special options +; +option: +; + inc hl ; next char + ld a,(hl) ; get it + cp '?' ; is it a '?' as expected? + jp z,usage ; yes, display usage + cp 'L' ; is it a 'L', display device list? + jp z,devlist ; yes, display device list + jp errprm ; anything else is an error +; +usage: +; + ld de,msgban1 ; point to version message part 1 + call prtstr ; print it + ld a,(unamod) ; get UNA flag + or a ; set flags + ld de,msghb ; point to HBIOS mode message + call z,prtstr ; if not UNA, say so + ld de,msgub ; point to UBIOS mode message + call nz,prtstr ; if UNA, say so + ld de,msgban2 ; point to version message part 2 + call prtstr ; print it + call crlf ; blank line + ld de,msguse ; point to usage message + call prtstr ; print it + ret ; and return +; +devlist: +; + ld a,(unamod) ; get UNA mode flag + or a ; set flags + jr nz,devlstu ; do UNA mode dev list +; + call crlf ; formatting + ld c,0 ; start with device 0 +devlist1: + ld de,indent ; indent + call prtstr ; ... to look nice + ld a,c ; next device + rlca ; rotate to + rlca ; ... high + rlca ; ... nibble + rlca ; ... for device + call prtdev ; print device mnemonic + ld a,':' ; formatting + call prtchr ; print it + call crlf ; next line + inc c ; next device + ld a,c ; put in a + cp devcnt ; compare to max + jr nz,devlist1 ; loop if more to do + ret ; done +; +devlstu: + ; UNA mode device list + ld b,0 ; use unit 0 to get count + ld c,$48 ; una func: get disk type + ld l,0 ; preset unit count to zero + call $fffd ; call una, b is assumed to be untouched!!! + ld a,l ; unit count to a + or a ; set flags + ret z ; no units, return + ld b,l ; unit count to b + ld c,0 ; init unit index +devlstu1: + push bc ; save loop control vars + ld de,indent ; indent + call prtstr ; ... to look nice + ld a,c ; put unit num in A + push af ; save it + call prtdevu ; print the device name + pop af ; restore unit num + call prtdecb ; print unit num + ld a,':' ; colon delimiter + call prtchr ; print it + call crlf ; formatting + pop bc ; restore loop control + inc c ; next drive + djnz devlstu1 ; loop as needed + ret ; return +; +; Scan drive map table for integrity +; Currently just checks for multiple drive +; letters referencing a single file system +; +valid: + ld hl,(maploc) ; get the map table location + dec hl ; point to table entry count + ld b,(hl) ; B := table entries + dec b ; loop one less times than num entries + inc hl ; point back to table start +; +valid1: ; outer loop + push hl ; save pointer + push bc ; save loop control + call valid2 ; do the inner loop + pop bc ; restore loop control + pop hl ; restore pointer + jp z,errint ; validation error + ld a,4 ; 4 bytes per entry + call addhl ; bump to next entry + djnz valid1 ; loop until done + ret ; done +; +valid2: ; setup for inner loop + push hl ; save HL + ld a,4 ; 4 bytes per entry + call addhl ; point to entry following + pop de ; de points to comparison entry +; +valid3: ; inner loop + ld c,(hl) ; first byte to C + ld a,(de) ; second byte to A + cp c ; compare + inc hl ; bump HL to next byte + jr nz,valid4 ; if not equal, continue loop + inc de ; bump DE to next byte + ld c,(hl) ; first byte to C + ld a,(de) ; second byte to A + cp c ; compare + ret z ; both bytes equal, return signaling problem + dec de ; point DE back to first byte of comparison entry +; +valid4: ; no match, loop + inc hl ; bump HL + inc hl ; ... to + inc hl ; ... next entry + djnz valid3 ; loop as appropriate + ret +; +; Swap the source and destination drive letters +; +drvswap: + ld a,(dstdrv) ; get the destination drive + call chkdrv ; valid drive? + ret nz ; abort if not + ld a,(srcdrv) ; get the source drive + call chkdrv ; valid drive? + ret nz ; abort if not + ld hl,(drives) ; load source/dest in DE + ld a,h ; put source drive num in a + cp l ; compare to the dest drive num + jp z,errswp ; Invalid swap request, src == dest +; + ; Get pointer to source drive table entry + ld hl,(maploc) + ld a,(srcdrv) + rlca + rlca + call addhl + ld (srcptr),hl +; + ; Get pointer to destination drive table entry + ld hl,(maploc) + ld a,(dstdrv) + rlca + rlca + call addhl + ld (dstptr),hl +; + ; 1) dest -> temp + ld hl,(dstptr) + ld de,tmpent + ld bc,4 + ldir +; + ; 2) source -> dest + ld hl,(srcptr) + ld de,(dstptr) + ld bc,4 + ldir +; + ; 3) temp -> source + ld hl,tmpent + ld de,(srcptr) + ld bc,4 + ldir +; + ; print the results + ld a,(dstdrv) ; get the destination + call showone ; show it + ld a,(srcdrv) ; get the source drive + call showone ; show it +; + jp drvrst ; exit via a full drive reset +; +; Assign drive to specified device/unit/slice +; +drvmap: + ; check for UNA mode + ld a,(unamod) ; get UNA mode flag + or a ; set flags + jr nz,drvmapu ; do UNA mode drvmap +; + ; determine device code by scanning for string + ld b,16 ; device table always has 16 entries + ld c,0 ; c is used to track table entry num + ld de,tmpstr ; de points to specified device name + ld hl,devtbl ; hl points to first entry of devtbl +; +drvmap1: ; loop through device table looking for a match + push hl ; save device table entry pointer + ld a,(hl) ; dereference HL + inc hl ; ... to point to + ld h,(hl) ; ... string + ld l,a ; ... in device table + push de ; save string pointer + push bc ; save loop control stuff + call strcmp ; compare strings + pop bc ; restore loop control stuff + pop de ; restore de + pop hl ; restore table entry pointer + jr z,drvmap2 ; match, continue + inc hl ; bump to next + inc hl ; device table pointer + inc c ; keep track of table entry num + djnz drvmap1 ; and loop + jp errdev +; +drvmap2: ; verify the unit is eligible for assignment (hard disk unit only!) + ld a,c ; get the specified device number + call chktyp ; check it + jp nz,errtyp ; abort with bad unit error +; + ; construct the requested dph table entry + ld a,c ; C has device num + rlca ; move it to upper nibble + rlca ; ... + rlca ; ... + rlca ; ... + ld c,a ; stash it back in C + ld a,(unit) ; get the unit number + or c ; combine device and unit + ld c,a ; and save in C + ld a,(slice) ; get the slice + ld b,a ; and save in B +; + ; resolve the CBIOS DPH table entry + ld a,(dstdrv) ; dest drv num to A + call chkdrv ; valid drive? + ret nz ; abort if invalid + ld hl,(maploc) ; start of DPH table to HL + rlca ; multiply by + rlca ; ... entry size of 4 + call addhl ; adjust HL to point to entry + ld (dstptr),hl ; save it +; + ; verify the drive letter being assigned is a hard disk + ld a,(hl) ; get the device/unit byte + rrca ; move device nibble to low nibble + rrca ; ... + rrca ; ... + rrca ; ... + and $0F ; and isolate device bits + call chktyp ; check it + jp nz,errtyp ; abort with bad device type error +; + ; shove updated device/unit/slice into the entry + ld (hl),c ; save device/unit byte + inc hl ; bump to next byte + ld (hl),b ; save slice +; + ; finish up + ld a,(dstdrv) ; get the destination drive + call showone ; show it's new value + jp drvrst ; exit via drive reset +; +; UNA mode drive mapping +; +drvmapu: +; + ; verify the device nmeumonic + ld a,(unit) ; get unit specified + ld b,a ; put in b + ld d,0 ; preset type to 0 + ld c,$48 ; una func: get disk type + call $fffd ; call una, b is assumed to be untouched!!! + ld a,d ; resultant device type to a + cp $40 ; RAM/ROM + jr z,drvmapu0 ; special case for RAM/ROM + ld de,udevide ; assume IDE + cp $41 ; IDE? + jr z,drvmapu1 ; do compare + ld de,udevsd ; assume SD + cp $43 ; SD? + jr z,drvmapu1 ; do compare + jp errdev ; error, invalid device name +; +drvmapu0: + ; handle RAM/ROM + ld a,(unit) ; get unit specified + ld b,a ; unit num to B + ld c,$45 ; UNA func: get disk info + ld de,$9000 ; 512 byte buffer *** FIX!!! *** + call $FFFD ; call UNA + bit 7,b ; test RAM drive bit + ld de,udevrom ; assume ROM + jr z,drvmapu1 ; do compare + ld de,udevram ; assume RAM + jr drvmapu1 ; do compare + jp errdev ; error, invalid device name +; +drvmapu1: + ld hl,tmpstr ; point HL to specified device name + call strcmp ; compare + jp nz,errdev ; no match, invalid device name +; + ; resolve the CBIOS DPH table entry + ld a,(dstdrv) ; dest drv num to A + call chkdrv ; valid drive? + ret nz ; abort if invalid + ld hl,(maploc) ; start of DPH table to HL + rlca ; multiply by + rlca ; ... entry size of 4 + call addhl ; adjust HL to point to entry + ld (dstptr),hl ; save it +; + ; verify the drive letter being assigned is a hard disk + ld a,(hl) ; get the device/unit byte + push hl ; save pointer + call chktypu ; check it + pop hl ; recover pointer + jp nz,errtyp ; abort with bad device type error +; + ; shove updated device/unit/slice into the entry + ld a,(unit) ; get specified unit + ld (hl),a ; save it + inc hl ; next byte is slice + ld a,(slice) ; get specified slice + ld (hl),a ; save it +; + ; finish up + ld a,(dstdrv) ; get the destination drive + call showone ; show it's new value + jp drvrst ; exit via drive reset +; +; Display all active drive letter assignments +; +showall: + ld hl,(maploc) ; HL = address of drive map + dec hl ; point to prior byte with map entry count + ld b,(hl) ; put it in b for loop counter + ld c,0 ; map index (drive letter) +; + ld a,b ; load count + or a ; set flags + ret z ; bail out if zero +; +showall1: ; loop + ld a,c ; + call showone + inc c + djnz showall1 + ret +; +; Display drive letter assignment for the drive num in A +; +showone: +; + push af ; save the incoming drive num +; + ld de,indent ; indent + call prtstr ; ... to look nice +; + ; setup HL to point to desired entry in table + pop af + push af + ld hl,(maploc) ; HL = address of drive map + rlca + rlca + call addhl ; HL = address of drive map table entry + pop af +; + ; render the drive letter based on table index + add a,'A' ; convert to alpha + call prtchr ; print it + ld a,':' ; conventional color after drive letter + call prtchr ; print it + ld a,'=' ; use '=' to represent assignment + call prtchr ; print it +; + ; render the map entry + ld a,(hl) ; load device/unit + call prtdev ; print device mnemonic + ld a,(hl) ; load device/unit again + and $0F ; isolate unit num + call prtdecb ; print it + inc hl ; point to slice num + ld a,':' ; colon to separate slice + call prtchr ; print it + ld a,(hl) ; load slice num + call prtdecb ; print it +; + call crlf +; + ret +; +; Force BDOS to reset (logout) all drives +; +drvrst: + ld c,$0D ; BDOS Reset Disk function + call bdos ; do it +; + xor a ; signal success + ret +; +; Print device mnemonic based on device number in A +; +prtdev: + ld e,a ; stash incoming device num in E + ld a,(unamod) ; get UNA mode flag + or a ; set flags + ld a,e ; put device num back + jr nz,prtdevu ; print device in UNA mode + rrca ; isolate high nibble (device) + rrca ; ... + rrca ; ... + rrca ; ... into low nibble + and $0F ; mask out undesired bits + push hl ; save HL + add a,a ; multiple A by two for word table + ld hl,devtbl ; point to start of device name table + call addhl ; add A to hl to point to table entry + ld a,(hl) ; dereference hl to loc of device name string + inc hl ; ... + ld d,(hl) ; ... + ld e,a ; ... + call prtstr ; print the device nmemonic + pop hl ; restore HL + ret ; done +; +prtdevu: + ld e,a ; save unit num in E + push bc + push de + push hl + ; UNA mode version of print device + ld b,a ; B := unit num + ld c,$48 ; UNA func: get disk type + call $FFFD ; call UNA + ld a,d ; disk type to A + pop hl + pop de + pop bc +; + cp $40 ; RAM/ROM? + jr z,prtdevu1 ; if so, handle it + cp $41 ; IDE? + ld de,udevide ; load string + jp z,prtstr ; if IDE, print and return + cp $43 ; SD? + ld de,udevsd ; load string + jp z,prtstr ; if SD, print and return + ld de,udevunk ; load string for unknown + jr prtstr ; and print it +; +prtdevu1: + ; handle RAM/ROM + push bc + push hl + ld b,e ; unit num to B + ld c,$45 ; UNA func: get disk info + ld de,$9000 ; 512 byte buffer *** FIX!!! *** + call $FFFD ; call UNA + bit 7,b ; test RAM drive bit + pop hl + pop bc + ld de,udevrom ; load string + jp z,prtstr ; print and return + ld de,udevram ; load string + jp prtstr ; print and return +; +; Check that specified drive num is valid +; +chkdrv: + push hl ; preserve incoming hl + ld hl,(maploc) ; point to drive map + dec hl ; back up to point to table entry count + cp (hl) ; compare to incoming + pop hl ; restore hl now + jp nc,errdrv ; handle bad drive + cp a ; set Z to signal good + ret ; and return +; +; Check that specified device is valid for a mapping operation +; Only hard disk devices are dynamically mappable because +; the DPH vector allocation sizes may not change. +; +chktyp: ; HBIOS variant + cp 3 ; first mappable device is 3 (IDE) + jr c,chkunit1 ; if below 3, return error + cp 9 + 1 ; last mappable device is 9 (HDSK) + jr nc,chkunit1 ; if above 8, return error + xor a ; signal valid + ret ; and return +; +chktypu: ; UNA variant + ld b,a ; put unit in b + ld c,$48 ; una func: get disk type + ld d,0 ; preset disk type to zero + call $fffd ; call UNA + ld a,d ; disk type to A + cp $41 ; IDE? + ret z ; OK + cp $43 ; SD? + ret z ; OK +; +chkunit1: ; return error + or $ff ; signal error + ret ; and return +; +; Print character in A without destroying any registers +; +prtchr: + push bc ; save registers + push de + push hl + ld e,a ; character to print in E + ld c,$02 ; BDOS function to output a character + call bdos ; do it + pop hl ; restore registers + pop de + pop bc + ret +; +prtdot: +; + ; shortcut to print a dot preserving all regs + push af ; save af + ld a,'.' ; load dot char + call prtchr ; print it + pop af ; restore af + ret ; done +; +; Print a zero terminated string at (HL) without destroying any registers +; +prtstr: + push de +; +prtstr1: + ld a,(de) ; get next char + or a + jr z,prtstr2 + call prtchr + inc de + jr prtstr1 +; +prtstr2: + pop de ; restore registers + ret +; +; Print the value in A in hex without destroying any registers +; +prthex: + push af ; save AF + push de ; save DE + call hexascii ; convert value in A to hex chars in DE + ld a,d ; get the high order hex char + call prtchr ; print it + ld a,e ; get the low order hex char + call prtchr ; print it + pop de ; restore DE + pop af ; restore AF + ret ; done +; +; Convert binary value in A to ascii hex characters in DE +; +hexascii: + ld d,a ; save A in D + call hexconv ; convert low nibble of A to hex + ld e,a ; save it in E + ld a,d ; get original value back + rlca ; rotate high order nibble to low bits + rlca + rlca + rlca + call hexconv ; convert nibble + ld d,a ; save it in D + ret ; done +; +; Convert low nibble of A to ascii hex +; +hexconv: + and $0F ; low nibble only + add a,$90 + daa + adc a,$40 + daa + ret +; +; Print value of A or HL in decimal with leading zero suppression +; Use prtdecb for A or prtdecw for HL +; +prtdecb: + push hl + ld h,0 + ld l,a + call prtdecw ; print it + pop hl + ret +; +prtdecw: + push af + push bc + push de + push hl + call prtdec0 + pop hl + pop de + pop bc + pop af + ret +; +prtdec0: + ld e,'0' + ld bc,-10000 + call prtdec1 + ld bc,-1000 + call prtdec1 + ld bc,-100 + call prtdec1 + ld c,-10 + call prtdec1 + ld e,0 + ld c,-1 +prtdec1: + ld a,'0' - 1 +prtdec2: + inc a + add hl,bc + jr c,prtdec2 + sbc hl,bc + cp e + ret z + ld e,0 + call prtchr + ret +; +; Start a new line +; +crlf: + ld a,13 ; + call prtchr ; print it + ld a,10 ; + jp prtchr ; print it +; +; Get the next non-blank character from (HL). +; +nonblank: + ld a,(hl) ; load next character + or a ; string ends with a null + ret z ; if null, return pointing to null + cp ' ' ; check for blank + ret nz ; return if not blank + inc hl ; if blank, increment character pointer + jr nonblank ; and loop +; +; Check character at (DE) for delimiter. +; +delim: or a + ret z + cp ' ' ; blank + ret z + jr c,delim1 ; handle control characters + cp '=' ; equal + ret z + cp '_' ; underscore + ret z + cp '.' ; period + ret z + cp ':' ; colon + ret z + cp $3b ; semicolon + ret z + cp '<' ; less than + ret z + cp '>' ; greater than + ret +delim1: + ; treat control chars as delimiters + xor a ; set Z + ret ; return +; +; Get alpha chars and save in tmpstr +; return with terminating char in A and flags set +; return with num chars in B +; +getalpha: +; + ld de,tmpstr ; location to save chars + ld b,0 ; length counter +; +getalpha1: + ld a,(hl) ; get active char + cp 'A' ; check for start of alpha range + jr c,getalpha2 ; not alpha, get out + cp 'Z' + 1 ; check for end of alpha range + jr nc,getalpha2 ; not alpha, get out + ; handle alpha char + inc hl ; increment buffer ptr + ld (de),a ; save it + inc de ; inc string pointer + inc b ; inc string length + ld a,b ; put length in A + cp 8 ; max length? + jr z,getalpha2 ; if max, get out + jr getalpha1 ; and loop +; +getalpha2: ; non-alpha, clean up and return + xor a ; clear accum + ld (de),a ; terminate string + ld a,(hl) ; recover terminating char + or a ; set flags + ret ; and done +; +; Get numeric chars and convert to number returned in A +; Carry flag set on overflow +; +getnum: + ld c,0 ; C is working register +getnum1: + ld a,(hl) ; get the active char + cp '0' ; compare to ascii '0' + jr c,getnum2 ; abort if below + cp '9' + 1 ; compare to ascii '9' + jr nc,getnum2 ; abort if above\ +; + ; valid digit, add new digit to C + ld a,c ; get working value to A + rlca ; multiply by 10 + ret c ; overflow, return with carry set + rlca ; ... + ret c ; overflow, return with carry set + add a,c ; ... + ret c ; overflow, return with carry set + rlca ; ... + ret c ; overflow, return with carry set + ld c,a ; back to C + ld a,(hl) ; get new digit + sub '0' ; make binary + add a,c ; add in working value + ret c ; overflow, return with carry set + ld c,a ; back to C +; + inc hl ; bump to next char + jr getnum1 ; loop +; +getnum2: ; return result + ld a,c ; return result in A + or a ; with flags set, CF is cleared + ret +; +; Compare null terminated strings at HL & DE +; If equal return with Z set, else NZ +; +strcmp: +; + ld a,(de) ; get current source char + cp (hl) ; compare to current dest char + ret nz ; compare failed, return with NZ + or a ; set flags + ret z ; end of string, match, return with Z set + inc de ; point to next char in source + inc hl ; point to next char in dest + jr strcmp ; loop till done +; +; Invoke CBIOS function +; The CBIOS function offset must be stored in the byte +; following the call instruction. ex: +; call cbios +; .db $0C ; offset of CONOUT CBIOS function +; +cbios: + ex (sp),hl + ld a,(hl) ; get the function offset + inc hl ; point past value following call instruction + ex (sp),hl ; put address back at top of stack and recover HL + ld hl,(cbftbl) ; address of CBIOS function table to HL + call addhl ; determine specific function address + jp (hl) ; invoke CBIOS +; +; Add the value in A to HL (HL := HL + A) +; +addhl: + add a,l ; A := A + L + ld l,a ; Put result back in L + ret nc ; if no carry, we are done + inc h ; if carry, increment H + ret ; and return +; +; Jump indirect to address in HL +; +jphl: + jp (hl) +; +; Errors +; +erruse: ; command usage error (syntax) + ld de,msguse + jr err +; +errprm: ; command parameter error (syntax) + ld de,msgprm + jr err +; +errinv: ; invalid CBIOS, zp signature not found + ld de,msginv + jr err +; +errver: ; CBIOS version is not as expected + ld de,msgver + jr err +; +errdrv: ; CBIOS version is not as expected + push af + ld de,msgdrv1 + call prtstr + pop af + add a,'A' + call prtchr + ld de,msgdrv2 + jr err1 +; +errswp: ; invalid drive swap request + ld de,msgswp + jr err +; +errdev: ; invalid device name + ld de,msgdev + jr err +; +errtyp: ; invalid device assignment request (not a hard disk device type) + ld de,msgtyp + jr err +; +errnum: ; invalid number parsed, overflow + ld de,msgnum + jr err +; +errint: ; DPH table integrity error (multiple drives ref one filesystem) + ld de,msgint + jr err +; +errdos: ; handle BDOS errors + push af ; save return code + call crlf ; newline + ld de,msgdos ; load + call prtstr ; and print error string + pop af ; recover return code + call prthex ; print error code + jr err2 +; +err: ; print error string and return error signal + call crlf ; print newline +; +err1: ; without the leading crlf + call prtstr ; print error string +; +err2: ; without the string + call crlf ; print newline + or $FF ; signal error + ret ; done +; +;=============================================================================== +; Storage Section +;=============================================================================== +; +cbftbl .dw 0 ; address of CBIOS function table +maploc .dw 0 ; location of drive map +drives: +dstdrv .db 0 ; destination drive +srcdrv .db 0 ; source drive +device .db 0 ; source device +unit .db 0 ; source unit +slice .db 0 ; source slice +; +unamod .db 0 ; $FF indicates UNA UBIOS active +; +srcptr .dw 0 ; source pointer for copy +dstptr .dw 0 ; destination pointer for copy +tmpent .fill 4,0 ; space to save a table entry +tmpstr .fill 9,0 ; temporary string of up to 8 chars, zero term +; +devtbl: ; device table + .dw dev00, dev01, dev02, dev03 + .dw dev04, dev05, dev06, dev07 + .dw dev08, dev09, dev10, dev11 + .dw dev12, dev13, dev14, dev15 +; +devunk .db "?",0 +dev00 .db "MD",0 +dev01 .db "FD",0 +dev02 .db "RAMF",0 +dev03 .db "IDE",0 +dev04 .db "ATAPI",0 +dev05 .db "PPIDE",0 +dev06 .db "SD",0 +dev07 .db "PRPSD",0 +dev08 .db "PPPSD",0 +dev09 .db "HDSK",0 +dev10 .equ devunk +dev11 .equ devunk +dev12 .equ devunk +dev13 .equ devunk +dev14 .equ devunk +dev15 .equ devunk +; +devcnt .equ 10 ; 10 devices defined +; +udevram .db "RAM",0 +udevrom .db "ROM",0 +udevide .db "IDE",0 +udevsd .db "SD",0 +udevunk .db "UNK",0 +; +stksav .dw 0 ; stack pointer saved at start + .fill stksiz,0 ; stack +stack .equ $ ; stack top +; +; Messages +; +indent .db " ",0 +msgban1 .db "ASSIGN v0.9d for RomWBW CP/M 2.2, 23-Aug-2014",0 +msgban2 .db 13,10,"Copyright 2014, Wayne Warthen, GNU GPL v3",13,10,0 +msghb .db " (HBIOS Mode)",0 +msgub .db " (UBIOS Mode)",0 +msguse .db "Usage: ASSIGN [D:[={D:|[]:[]}]]",13,10 + .db " ex. ASSIGN (display all active assignments)",13,10 + .db " ASSIGN /? (display version and usage)",13,10 + .db " ASSIGN /L (display all possible devices)",13,10 + .db " ASSIGN C:=D: (swaps C: and D:)",13,10 + .db " ASSIGN C:=FD0: (assign C: to floppy unit 0)",13,10 + .db " ASSIGN C:=IDE0:1 (assign C: to IDE unit0, slice 1)",13,10,0 +msgprm .db "Parameter error (ASSIGN /? for usage)",0 +msginv .db "Unexpected CBIOS (signature missing)",0 +msgver .db "Unexpected CBIOS version",0 +msgdrv1 .db "Invalid drive letter (",0 +msgdrv2 .db ":)",0 +msgswp .db "Invalid drive swap request",0 +msgdev .db "Invalid device name",0 +msgnum .db "Unit or slice number invalid",0 +msgtyp .db "Only hard drive devices can be reassigned",0 +msgint .db "WARNING: Multiple drive letters reference one filesystem!",0 +msgdos .db "DOS error, return code=0x",0 +; + .end \ No newline at end of file diff --git a/Apps/Build.cmd b/Apps/Build.cmd new file mode 100644 index 00000000..5dd223b1 --- /dev/null +++ b/Apps/Build.cmd @@ -0,0 +1,26 @@ +@echo off + +setlocal + +set PATH=..\Tools\tasm32;..\Tools\zx;%PATH% + +set TASMTABS=..\Tools\tasm32 + +set ZXBINDIR=../tools/cpm/bin/ +set ZXLIBDIR=../tools/cpm/lib/ +set ZXINCDIR=../tools/cpm/include/ + +call :asm SysCopy || goto :eof +call :asm Assign || goto :eof +call :asm Format || goto :eof +call :asm Talk || goto :eof + +zx Z80ASM -SYSGEN/F + +goto :eof + +:asm +echo. +echo Building %1... +tasm -t80 -b -g3 -fFF %1.asm %1.com %1.lst +goto :eof \ No newline at end of file diff --git a/Apps/Clean.cmd b/Apps/Clean.cmd new file mode 100644 index 00000000..ee59da67 --- /dev/null +++ b/Apps/Clean.cmd @@ -0,0 +1,4 @@ +@echo off +if exist *.bin del *.bin +if exist *.com del *.com +if exist *.lst del *.lst \ No newline at end of file diff --git a/Apps/Format.asm b/Apps/Format.asm new file mode 100644 index 00000000..79cc4eeb --- /dev/null +++ b/Apps/Format.asm @@ -0,0 +1,28 @@ +;=============================================================================== +; FORMAT - DISK FORMAT UTILITY FOR ROMWBW ADAPTATION OF CP/M 2.2 +;=============================================================================== +; +; AUTHOR: WAYNE WARTHEN (wwarthen@gmail.com) +;_______________________________________________________________________________ +; +; CHANGELOG: +;_______________________________________________________________________________ +; +; TODO: +; +;_______________________________________________________________________________ +; +; +;=============================================================================== +; MAIN PROGRAM PROCEDURE +;=============================================================================== +; + .ORG 00100H + RET +; +STACKSAV .DW 0 +STACKSIZ .EQU 40H ; WE ARE A STACK PIG + .FILL STACKSIZ,0 +STACK .EQU $ +; + .END diff --git a/Apps/Source/2drive.c b/Apps/Source/2drive.c deleted file mode 100644 index 3e7e8b91..00000000 --- a/Apps/Source/2drive.c +++ /dev/null @@ -1,106 +0,0 @@ -/* twodrive.c 7/11/2012 dwg - */ - -/* This program is experimental and is not for release because - it contains techniques which are not recommended because - there are better API functions to do these operations. */ - -/* - This code is in the crossdev folder because it is part of - my development environment, and I said I would make everything - available. - - The purpose of this code is to dynamically alter the BIOS - data associated with PPIDE (or PPISD) drives. The default - configuration is that mass storage devices get four drives. - - Each of the four drives can be remapped using the logical - unit utility MAP. - - The purpose of this code is to alter the runtime data so that - instead of the PPIDE having four drives for the primary IDE - device, it then has two for the primary and two for the secondary. - - The MAP command will properly display the status after this is - run, but you must keep in mind that having two sets of logical - units at the same time is twice as complicated to keep straight - in your mind, and you have to be more careful you know exactly - how the drives are mapped so you don't accidentally destroy your - data. - - This utility is unsupported, and not recommended for general use. - The reason this utility wasn't generally published is that it - is very difficult to give support about this remotely. - - If you are brave, and talented, and you can figure out what I did - with pointers in this program, then you get the prize, which is - to be able to copy from one CF chip to another in a dual adapter. - - It has only been tested on my PPIDE, and I don't know what will - happen if you try it. You could wipe out your CF chip, so make - sure you are backed up if you try this. -*/ - - -#include "cpmbios.h" -#include "bioscall.h" - -#include "cpmbdos.h" -#include "bdoscall.h" - -#define u8 unsigned char -#define u16 unsigned int - -struct DPH * pDPH_C; -struct DPB * pDPB_C; -u8 * pDU_C; -u16 * pCUR_C; -u16 * pNUM_C; - -struct DPH * pDPH_D; -struct DPB * pDPB_D; -u8 * pDU_D; -u16 * pCUR_D; -u16 * pNUM_D; - -main(argc,argv) - int argc; - char *argv[]; -{ - - ireghl = pSELDSK; - iregbc = DRIVEC; - iregde = 0; - bioscall(); - pDPH_C = ireghl; - pDPB_C = pDPH_C->dpb; - pDU_C = ireghl -1; - *pDU_C = 0X41; - printf("Current C: DevUnit is %02x\n",*pDU_C); - pCUR_C = ireghl + 18; - *pCUR_C = 0; - printf("Current C: Logical Unit is %d\n",* pCUR_C); - pNUM_C = ireghl + 20; - *pNUM_C = 64/9; - printf("Current C: Number of LU's is %d\n",* pNUM_C); - - ireghl = pSELDSK; - iregbc = DRIVED; - iregde = 0; - bioscall(); - - pDPH_D = ireghl; - pDPB_D = pDPH_D->dpb; - pDU_D = ireghl -1; - *pDU_D = 0x41; - printf("Current D: DevUnit is %02x\n",*pDU_D); - - pCUR_D = ireghl + 18; - *pCUR_D = 1; - printf("Current D: Logical Unit is %d\n",* pCUR_D); - - pNUM_D = ireghl + 20; - *pNUM_D = 64/9; - printf("Current D: Number of LU's is %d\n",* pNUM_D); - - -} diff --git a/Apps/Source/2map.c b/Apps/Source/2map.c deleted file mode 100644 index 48dfb65b..00000000 --- a/Apps/Source/2map.c +++ /dev/null @@ -1,322 +0,0 @@ -/* map.c 6/7/2012 dwg - */ - -#include "portab.h" -#include "globals.h" -#include "stdio.h" -#include "stdlib.h" -#include "memory.h" - -#include "cpmbind.h" - -#include "infolist.h" -#include "dphdpb.h" -#include "dphmap.h" -#include "metadata.h" -#include "clogical.h" -#include "applvers.h" - -#define MAXDRIVE 8 - -/* Drive List Geometry */ -#define COL1 0 -#define COL2 (80/4) -#define COL3 (80/2) -#define COL4 (COL2+COL3) -#define LINE 3 - -/* Logical Unit List Geometry */ -#define LGUT 5 -#define COL1A 0 -#define COL2A (80/3) -#define COL3A (2*COL2A) - -/* Nomenclature Geometry */ -#define LINE2 8 - -/* Misc Info Geometry */ -#define CDLINE 6 - -/* BDOS Function number */ -#define RETCURR 25 - -/* function defined in bdoscall.asm */ -extern lurst(); - -struct BIOS * pBIOS; - -struct DPH * pDPH; - -int devunit; -int dev; -int unit; -int currlu; -int numlu; -int drivenum; -int drive; -int deflu; - -char szTemp[128]; - -int readsec(drive,track,sector,buffer) - int drive; - int track; - int sector; - unsigned int buffer; -{ - ireghl = pSELDSK; - iregbc = drive; - iregde = 0; - bioscall(); - - ireghl = pSETTRK; - iregbc = track; - bioscall(); - - ireghl = pSETSEC; - iregbc = sector; - bioscall(); - - ireghl = pSETDMA; - iregbc = buffer; - bioscall(); - - ireghl = pREAD; - bioscall(); - return irega; -} - - - - -int haslu(dr) - int dr; -{ - if(0 < lugnum(dr)) { - return TRUE; - } else { - return FALSE; - } -} - - - -void dispdph(l,c,drive,ptr) - int l; - int c; - char drive; - struct DPH *ptr; -{ - -/* - unsigned int xlt; - unsigned int rv1; - unsigned int rv2; - unsigned int rv3; - unsigned int dbf; - unsigned int dpb; - unsigned int csv; - unsigned int alv; - unsigned char sigl; - unsigned char sigu; - unsigned int current; - unsigned int number; -*/ - crtlc(l,c); - printf("%c: ",drive); - - devunit = lugdu(drive-'A'); - dev = devunit & 0xf0; - unit = devunit & 0x0f; - - currlu = lugcur(drive-'A'); - switch(dev) { - case DEV_MD: - if(0 == unit) printf("ROM"); - if(1 == unit) printf("RAM"); - break; - case DEV_FD: - printf("FD%d",unit); - break; - case DEV_IDE: - printf("IDE%d",unit); - break; - case DEV_ATAPI: - printf("ATAPI%d",unit); - break; - case DEV_PPIDE: - printf("PPIDE%d",unit); - break; - case DEV_SD: - printf("SD%d",unit); - break; - case DEV_PRPSD: - printf("PRPSD%d",unit); - break; - default: - printf("UNK"); - break; - }; - - if('L' == (unsigned char)ptr->sigl) { - if('U' == (unsigned char)ptr->sigu) { -/* printf("-LU%d",(int)ptr->current); */ - printf("-LU%d",currlu); - } - } - -/* printf("dpb=0x%04x, ",(unsigned int)ptr->dpb); - printf("sigl=0x%02x, ",(unsigned char)ptr->sigl); - printf("sigu=0x%02x, ",(unsigned char)ptr->sigu); - printf("curr=0x%04x, ",(unsigned int)ptr->current); - printf("numb=0x%04x", (unsigned int)ptr->number); -*/ - -} - -int main(argc,argv) - int argc; - char *argv[]; -{ - int i; - int mylu; - int drivenum; - int column; - int line; - char szDrive[32]; - char szLuNum[32]; - - if(argc == 3) { - - strcpy(szDrive,argv[1]); - strcpy(szLuNum,argv[2]); - - mylu = atoi(szLuNum); - - if(strlen(szDrive) == 2) { - if(':' == szDrive[1]) { - switch(szDrive[0]) { - case 'a': - case 'A': - luscur(0,mylu); - break; - case 'b': - case 'B': - luscur(1,mylu); - break; - case 'c': - case 'C': - luscur(2,mylu); - break; - case 'd': - case 'D': - luscur(3,mylu); - break; - case 'e': - case 'E': - luscur(4,mylu); - break; - case 'f': - case 'F': - luscur(5,mylu); - break; - case 'g': - case 'G': - luscur(6,mylu); - break; - case 'h': - case 'H': - luscur(7,mylu); - break; - default: - break; - } - - } - } - exit(1); - } - - - pBIOS = BIOSAD; - - crtinit(); - crtclr(); - crtlc(0,0); - - printf("MAP.COM %d/%d/%d v%d.%d.%d.%d", - A_MONTH,A_DAY,A_YEAR,A_RMJ,A_RMN,A_RUP,A_RTP); - printf(" dwg - System Storage Drives and Logical Units"); - - ireghl = pGETINFO; - bioscall(); - pINFOLIST = ireghl; - - crtlc(CDLINE,COL3A+LGUT); - printf("infolist.version %d\n",pINFOLIST->version); - - pDPHMAP = (struct DPHMAPA *)pINFOLIST->dphmap; - - dispdph(LINE, COL1+LGUT-1,'A',(struct DPH *)pDPHMAP->drivea); - dispdph(LINE+1,COL1+LGUT-1,'B',(struct DPH *)pDPHMAP->driveb); - dispdph(LINE, COL2+LGUT-1,'C',(struct DPH *)pDPHMAP->drivec); - dispdph(LINE+1,COL2+LGUT-1,'D',(struct DPH *)pDPHMAP->drived); - dispdph(LINE, COL3+LGUT-1,'E',(struct DPH *)pDPHMAP->drivee); - dispdph(LINE+1,COL3+LGUT-1,'F',(struct DPH *)pDPHMAP->drivef); - dispdph(LINE, COL4+LGUT-1,'G',(struct DPH *)pDPHMAP->driveg); - dispdph(LINE+1,COL4+LGUT-1,'H',(struct DPH *)pDPHMAP->driveh); - - dregbc = RETCURR; - bdoscall(); - drive = drega; - - crtlc(CDLINE,5); - printf("Current drive is %c:",'A'+drive); - - devunit = lugdu(drive); - dev = devunit & 0xf0; - unit = devunit & 0x0f; - currlu = lugcur(drive); - deflu = currlu; - numlu = lugnum(drive); - - crtlc(CDLINE,COL2A+LGUT); - printf("Number of LUs is %d\n",lugnum(drive)); - - if(0. - -;---------------------------------------------------------------------- - maclib portab - maclib globals - maclib cpmbdos - maclib printers - maclib banner - maclib applvers - maclib z80 - maclib memory - maclib version - maclib cpmappl - maclib banner -;----------------------- - - do$start - - jmp around$bandata -argv dw prog,dat,prod,orig,ser,myname,0 -prog db 'ACCESS.COM $' - date - serial - product - originator - oriname -uuid db '08D4953E-B6F4-4673-990C-7E17A0A299BD$' -around$bandata: - - sbanner argv - - lda 80h ; pick up the command tail length provided by CCP - cpi 0 ; were there any parameters given? - jnz no$usage ; If not, go around - printf 'usage - access ' - jmp do$exit -no$usage: - - memcpy work$fcb,PRIFCB,32 ; Save initial default FCB from CCP - - printf 'Checking: ' - - mvi a,'$' ; place a terminating dollar sign - sta PRIFCB+9 ; at the end of the filname field - print PRIFCB+1 ; and print the filename portion - - conout '.' ; print the seperating dot - - memcpy PRIFCB,work$fcb,16 ; get a fresh copy of the initial FCB - mvi a,'$' ; place a terminating dollar sign - sta PRIFCB+12 ; at the end of the filetype field - print PRIFCB+9 ; and print the filetype - print crlf ; followed by a CR and LF - - memcpy PRIFCB,work$fcb,32 ; restore the initial FCB - - mvi c,FOPEN ; Try to open the given filename - lxi d,PRIFCB ; using the primary default FCB - call BDOS ; with a BDOS call - cpi 255 ; Test for Open Failure (255) - jnz done ; jump if file existed - - mvi c,FDELETE ; Delete the A:$$$.SUB file - lxi d,del$fcb ; using an alternative FCB - call BDOS - - printf 'Submit file terminated due to missing file$' - - jmp do$exit ; Go to the one true exit point - -done: - printf 'File found, Submit may proceed' -do$exit: - do$end - - newfcb del$fcb,1,'$$$ SUB' - -work$fcb ds 36 ; A place to save a copy of the default FCB on entry - -crlf db CR,LF ; a dollar sign terminated CR and LF -term db '$' ; a general purpose terminating character - - end start - -; eof - access.asm - - \ No newline at end of file diff --git a/Apps/Source/ansi.h b/Apps/Source/ansi.h deleted file mode 100644 index a6e6f32f..00000000 Binary files a/Apps/Source/ansi.h and /dev/null differ diff --git a/Apps/Source/applvers.h b/Apps/Source/applvers.h deleted file mode 100644 index 04577392..00000000 --- a/Apps/Source/applvers.h +++ /dev/null @@ -1,19 +0,0 @@ -/************************************/ -/* applvers.h dwg - 2.5.5.21 */ -/************************************/ - -#define A_RMJ 2 -#define A_RMN 5 -#define A_RUP 5 -#define A_RTP 21 - -#define A_MONTH 5 -#define A_DAY 4 -#define A_YEAR 2014 -#define A_YR 14 - -/********************/ -/* eof - applvers.h */ -/********************/ - - diff --git a/Apps/Source/applvers.lib b/Apps/Source/applvers.lib deleted file mode 100644 index dc368cd1..00000000 --- a/Apps/Source/applvers.lib +++ /dev/null @@ -1,32 +0,0 @@ -; applvers.lib 3/31/2012 dwg - For RomWBW 2.5.4.20 Release - -A$RMJ equ 2 -A$RMN equ 5 -A$RUP equ 5 -A$RTP equ 21 - -A$MONTH equ 5 -A$DAY equ 4 -A$YEAR equ 2014 - -date macro -dat db ' 5/4/2014$' - endm - -serial macro -ser db '654321$' - endm - -product macro -prod db 'CPM80$' - endm - -originator macro -orig db 'DWG$' - endm - -oriname macro -myname db ' Douglas W Goodall $' - endm - -; eof - applvers.lib diff --git a/Apps/Source/ascii.h b/Apps/Source/ascii.h deleted file mode 100644 index 8e1b7765..00000000 --- a/Apps/Source/ascii.h +++ /dev/null @@ -1,13 +0,0 @@ -/* ascii.h 11/25/2012 dwg - */ - -#define ASCII_BS 8 -#define ASCII_TAB 9 -#define ASCII_LF 10 -#define ASCII_VT 11 -#define ASCII_FF 12 -#define ASCII_CR 13 -#define ASCII_ESC 27 - -/* eof - ascii.h */ - - \ No newline at end of file diff --git a/Apps/Source/asmiface.asm b/Apps/Source/asmiface.asm deleted file mode 100644 index fd84186c..00000000 --- a/Apps/Source/asmiface.asm +++ /dev/null @@ -1,67 +0,0 @@ -; asmiface.asm 6/4/2012 dwg - - - extrn .begin,.chl,.swt - extrn csave,cret,.move - - global xrega_,1 - global xregbc_,2 - global xregde_,2 - global xreghl_,2 - - PUBLIC asmif_ -asmif_: lxi d,.2 - call csave - - LXI H,8-.2 ; pick up 1st parm "function address" - DAD SP - MOV E,M - INX H - MOV D,M - xchg - shld callad+1 - - LXI H,10-.2 - DAD SP - MOV E,M - INX H - MOV D,M ; DE = parm - xchg - shld xregbc_ - - LXI H,12-.2 - DAD SP - MOV E,M - INX H - MOV D,M - xchg - shld xregde_ - - LXI H,14-.2 - DAD SP - MOV E,M - INX H - MOV D,M - xchg - shld xreghl_ - - lhld xregbc_ - mov b,h - mov c,l ; setup B&C - lhld xregde_ - xchg ; setup D&E - lhld xreghl_ ; setup H&L - -callad: call 0e639h ; setlu - - sta xrega_ - shld xreghl_ - xchg - shld xregde_ - mov l,c - mov h,b - shld xregbc_ - RET ; HL has return value - -.2 EQU 0 - END - \ No newline at end of file diff --git a/Apps/Source/asmiface.h b/Apps/Source/asmiface.h deleted file mode 100644 index 5b39e406..00000000 --- a/Apps/Source/asmiface.h +++ /dev/null @@ -1,14 +0,0 @@ -/*****************************/ -/* asmiface.H 6/4/2012 dwg - */ -/*****************************/ - - extern char xrega; - extern unsigned int xregbc; - extern unsigned int xregde; - extern unsigned int xreghl; - extern asmif(); /* asmif(0xe60,bc,de,hl); */ - -/********************/ -/* eof - asmiface.h */ -/********************/ - \ No newline at end of file diff --git a/Apps/Source/banker.c b/Apps/Source/banker.c deleted file mode 100644 index b6974de6..00000000 --- a/Apps/Source/banker.c +++ /dev/null @@ -1,153 +0,0 @@ -/* banker.c 6/7/2012 dwg - */ - -#include "stdio.h" -#include "stdlib.h" -#include "memory.h" - -/* #include "cpmbind.h" */ - -#include "std.h" -#include "infolist.h" -#include "metadata.h" - -/* #include "setlunum.h" */ - -#include "applvers.h" -#include "bdoscall.h" -#include "cpmbdos.h" -#include "bioscall.h" -#include "cpmbios.h" -#include "diagnose.h" -#include "cnfgdata.h" -#include "syscfg.h" -#include "applvers.h" - -#define COL1 0 -#define COL2 (80/3) -#define COL3 (2*COL2) -#define LINE 2 - -#define BDOS 5 /* memory address of BDOS invocation */ -#define HIGHSEG 0x0C000 /* memory address of system config */ - -#define GETSYSCFG 0x0F000 /* HBIOS function for Get System Configuration */ - -struct SYSCFG * pSYSCFG; -struct BIOS * pCBIOS; - -int main(argc,argv) - int argc; - char *argv[] ; -{ - - char * varloc; - char * tstloc; - char temp[128]; - - int i; - int bFirst; - - bFirst = 0; - - ireghl = pGETINFO; - bioscall(); - pINFOLIST = ireghl; - printf("post GETINFO ireghl is 0x%04x\n",pINFOLIST); - - pCBIOS = 0x0e600; - - hregbc = GETSYSCFG; /* function = Get System Config */ - hregde = HIGHSEG; /* addr of dest (must be high) */ - diagnose(); /* invoke the NBIOS function */ - pSYSCFG = HIGHSEG; - - crtinit(pSYSCFG->cnfgdata.termtype); - crtclr(); - crtlc(0,0); - - printf("BANKER.COM %d/%d/%d v%d.%d.%d.%d", - A_MONTH,A_DAY,A_YEAR,A_RMJ,A_RMN,A_RUP,A_RTP); - printf(" dwg - Display Memory Bank Characteristics"); - - hregbc = 0x0f000; - hregde = 0x0c000; - diagnose(); - pSYSCFG = 0x0C000; - - crtlc(LINE+0,COL1); - crtlc(LINE+1,COL1); - printf("ROM Bank1"); - crtlc(LINE+2,COL1); - printf("RMJ = %d",pSYSCFG->cnfgdata.rmj); - crtlc(LINE+3,COL1); - printf("RMN = %d",pSYSCFG->cnfgdata.rmn); - crtlc(LINE+4,COL1); - printf("RUP = %d",pSYSCFG->cnfgdata.rup); - crtlc(LINE+5,COL1); - printf("RTP = %d",pSYSCFG->cnfgdata.rtp); - crtlc(LINE+7,COL1); - varloc = pSYSCFG->varloc; -/* dregde = (unsigned int)varloc-0x200+0x0c000; */ - dregde = (unsigned int)varloc+0x0c000; - - dregbc = 9; - bdoscall(); - crtlc(LINE+8,COL1); -/* tstloc = 0x0c000-0x0200+(unsigned int)pSYSCFG->tstloc; */ - tstloc = 0x0c000+(unsigned int)pSYSCFG->tstloc; - memset(temp,0,sizeof(temp)); - memcpy(temp,tstloc,11); - printf("%s",temp); - - crtlc(LINE+1,COL2); - printf("CBIOS HDR"); - crtlc(LINE+2,COL2); - printf("RMJ = %d",pCBIOS->rmj); - crtlc(LINE+3,COL2); - printf("RMN = %d",pCBIOS->rmn); - crtlc(LINE+4,COL2); - printf("RUP = %d",pCBIOS->rup); - crtlc(LINE+5,COL2); - printf("RTP = %d",pCBIOS->rtp); - /* */ - crtlc(LINE+7,COL2); - varloc = pINFOLIST->varloc; - memset(temp,0,sizeof(temp)); - memcpy(temp,varloc,sizeof(temp)-1); - for(i=0;itstloc; - memset(temp,0,sizeof(temp)); - memcpy(temp,tstloc,11); - printf("%s",temp); - - crtlc(LINE+1,COL3); - printf("BANKER.COM"); - crtlc(LINE+2,COL3); - printf("RMJ = %d",A_RMJ); - crtlc(LINE+3,COL3); - printf("RMN = %d",A_RMN); - crtlc(LINE+4,COL3); - printf("RUP = %d",A_RUP); - crtlc(LINE+5,COL3); - printf("RTP = %d",A_RTP); - - crtlc(LINE+8,COL3); - printf("%02d%02d%02d",A_YR,A_MONTH,A_DAY); - crtlc(23,0); -} - -/*****************/ -/* eof - cview.c */ -/*****************/ - \ No newline at end of file diff --git a/Apps/Source/banner.asm b/Apps/Source/banner.asm deleted file mode 100644 index 935a8671..00000000 --- a/Apps/Source/banner.asm +++ /dev/null @@ -1,156 +0,0 @@ -; banner.asm 9/5/2012 dwg - new version semantics - #.#.# (#) - - maclib portab - maclib globals - maclib cpmbios - maclib cpmbdos - maclib bioshdr - maclib printers - maclib cpmappl - maclib applvers - - cseg - - -; entered with argv in hl - public x$banner -x$banner: - shld argv - mov e,m ! inx h ! mov d,m ! inx h ! xchg ! shld xprog ! xchg - mov e,m ! inx h ! mov d,m ! inx h ! xchg ! shld xvers ! xchg - mov e,m ! inx h ! mov d,m ! inx h ! xchg ! shld xprod ! xchg - mov e,m ! inx h ! mov d,m ! inx h ! xchg ! shld xorig ! xchg - mov e,m ! inx h ! mov d,m ! inx h ! xchg ! shld xser ! xchg - mov e,m ! inx h ! mov d,m ! inx h ! xchg ! shld xnam ! xchg - - - printf '----------------------------------------' - print crlf - lhld xprog ! xchg ! mvi c,9 ! call BDOS - printf ' ' - IF A$MONTH LT 10 - conout ' ' - ENDIF - IF A$DAY LT 10 - conout ' ' - ENDIF - lxi h,A$MONTH - call pr$d$word - conout '/' - lxi h,A$DAY - call pr$d$word - conout '/' - lxi h,A$YEAR - call pr$d$word - printf ' ' - printf 'Version ' - lxi h,A$RMJ - call pr$d$word - conout '.' - lxi h,A$RMN - call pr$d$word - conout '.' - lxi h,A$RUP - call pr$d$word - printf ' (' - lxi h,A$RTP - call pr$d$word - conout ')' - print crlf - printf 'S/N ' - - lhld xprod ! xchg ! mvi c,9 ! call BDOS - - conout '-' - - lhld xorig ! xchg ! mvi c,9 ! call BDOS - - conout '-' - -; print xser - lhld xser ! xchg ! mvi c,9 ! call BDOS - - printf ' ' -; printf 'All Rights Reserved' - printf 'Licensed under GPL3' - print crlf - printf 'Copyright (C) 2011-12' - - lhld xnam ! xchg ! mvi c,9 ! call BDOS - - print crlf - printf '----------------------------------------' - print crlf - - ret - - -; entered with argv in hl - public x$sbanner -x$sbanner: - shld argv - mov e,m ! inx h ! mov d,m ! inx h ! xchg ! shld xprog ! xchg - mov e,m ! inx h ! mov d,m ! inx h ! xchg ! shld xvers ! xchg - mov e,m ! inx h ! mov d,m ! inx h ! xchg ! shld xprod ! xchg - mov e,m ! inx h ! mov d,m ! inx h ! xchg ! shld xorig ! xchg - mov e,m ! inx h ! mov d,m ! inx h ! xchg ! shld xser ! xchg - mov e,m ! inx h ! mov d,m ! inx h ! xchg ! shld xnam ! xchg - - -; printf '----------------------------------------' -; print crlf - lhld xprog ! xchg ! mvi c,9 ! call BDOS - printf ' ' - IF A$MONTH LT 10 - conout ' ' - ENDIF - IF A$DAY LT 10 - conout ' ' - ENDIF - lxi h,A$MONTH - call pr$d$word - conout '/' - lxi h,A$DAY - call pr$d$word - conout '/' - lxi h,A$YEAR - call pr$d$word - printf ' ' - printf 'Vers. ' - lxi h,A$RMJ - call pr$d$word - conout '.' - lxi h,A$RMN - call pr$d$word - conout '.' - lxi h,A$RUP - call pr$d$word - printf ' ( ' - lxi h,A$RTP - call pr$d$word - printf ') ' - printf 'COPR Douglas Goodall Licensed w/GPLv3' - - - print crlf - - ret - - -;---------------------------------------------------------------- - -argv ds 2 -;---------------- -xprog ds 2 -xvers ds 2 -xprod ds 2 -xorig ds 2 -xser ds 2 -xnam ds 2 - -crlf db CR,LF,'$' - - end - -; eof - banner.asm - \ No newline at end of file diff --git a/Apps/Source/banner.lib b/Apps/Source/banner.lib deleted file mode 100644 index fca38939..00000000 --- a/Apps/Source/banner.lib +++ /dev/null @@ -1,18 +0,0 @@ -; banner.lib 7/19/2012 dwg - for 2.0.0.0 B22 -; banner.lib 2/17/2012 dwg - review for release 1.5.1.0 -; banner.lib 2/11/2012 dwg - banner library declarations - - extrn x$banner -banner macro argv - lxi h,argv - call x$banner - endm - - extrn x$sbanner -sbanner macro argv - lxi h,argv - call x$sbanner - endm - -; eof - banner.lib - \ No newline at end of file diff --git a/Apps/Source/bdoscall.asm b/Apps/Source/bdoscall.asm deleted file mode 100644 index 07850d39..00000000 --- a/Apps/Source/bdoscall.asm +++ /dev/null @@ -1,71 +0,0 @@ -; bdoscall.asm 3/10/2012 dwg - bdos binding for Aztec C - - global drega_,1 - global dregbc_,2 - global dregde_,2 - global dreghl_,2 - - PUBLIC lurst_ -lurst_: - - push b - push d - push h - push psw - - mvi c,37 - lxi d,127 - lxi b,127 - call 5 - - pop psw - pop h - pop d - pop b - - RET - - - PUBLIC bdoscall_ -bdoscall_: - - push b - push d - push h - push psw - - lhld dregbc_ - mov b,h - mov c,l - - lhld dregde_ - mov d,h - mov e,l - - lhld dreghl_ - - lda drega_ - - call 5 - - sta drega_ - - shld dreghl_ - - mov l,e - mov h,d - shld dregde_ - - mov l,c - mov h,b - shld dregbc_ - - pop psw - pop h - pop d - pop b - - RET - - END - \ No newline at end of file diff --git a/Apps/Source/bdoscall.h b/Apps/Source/bdoscall.h deleted file mode 100644 index b816e90a..00000000 --- a/Apps/Source/bdoscall.h +++ /dev/null @@ -1,8 +0,0 @@ -/* bdoscall.h 3/10/2012 dwg - header file for bdoscall */ - - extern char drega; - extern unsigned int dregbc; - extern unsigned int dregde; - extern unsigned int dreghl; - extern bdoscall(); - \ No newline at end of file diff --git a/Apps/Source/bioscall.asm b/Apps/Source/bioscall.asm deleted file mode 100644 index f3a501de..00000000 --- a/Apps/Source/bioscall.asm +++ /dev/null @@ -1,80 +0,0 @@ -; bioscall.asm 3/10/2012 dwg - bios binding for Aztec C - - global irega_,1 - global iregbc_,2 - global iregde_,2 - global ireghl_,2 - - - public getmeta_ -getmeta_: - push psw - push b - push d - push h - - lxi b,4 - lxi d,0 - call 0e61bh - - lxi d,0 - call 0e61eh - - lxi d,11 - call 0e621h - - lxi d,80h - call 0e624h - - call 0e627h - - pop h - pop d - pop b - pop psw - ret - - PUBLIC bioscall_ -bioscall_: - - push b - push d - push h - push psw - - lhld iregbc_ - mov b,h - mov c,l - - lhld iregde_ - mov d,h - mov e,l - - lhld ireghl_ - shld mycall+1 - - lda irega_ - -mycall: call 5 - - sta irega_ - - shld ireghl_ - - mov l,e - mov h,d - shld iregde_ - - mov l,c - mov h,b - shld iregbc_ - - pop psw - pop h - pop d - pop b - - RET - - END - \ No newline at end of file diff --git a/Apps/Source/bioscall.h b/Apps/Source/bioscall.h deleted file mode 100644 index a563b075..00000000 --- a/Apps/Source/bioscall.h +++ /dev/null @@ -1,8 +0,0 @@ -/* bioscall.h 3/10/2012 dwg - header file for bdoscall */ - - extern char irega; - extern unsigned int iregbc; - extern unsigned int iregde; - extern unsigned int ireghl; - extern bioscall(); - \ No newline at end of file diff --git a/Apps/Source/bioshdr.lib b/Apps/Source/bioshdr.lib deleted file mode 100644 index f315a292..00000000 --- a/Apps/Source/bioshdr.lib +++ /dev/null @@ -1,385 +0,0 @@ -; biohdr.lib 2/19/2012 dwg - BIOS header display macros -; copyright (C) 2011 Douglas Goodall. All Rights Reserved. -; Licensed to N8VEM Community for non-commercial use only. - -; 2/19/2012 dwg - review for release 1.5.1.0 -; 2/05/2012 dwg - added DSKM (DM_ROM...) better late than never -; 2/05/2012 dwg - added prpsdenable,prpsdtrace, and prpsdcapacity -; 1/16/2012 dwg - extend LU numbers to 0x1C entries (256MB) -; 1/11/2012 dwg - added new setlu for 1.4 slice technique -; 12/18/2011 dwg - added REVISION (from svn) -; 12/07/2011 dwg - BIOS header enhancement for version 1.3 - -; Common Configuration items, -; Valid in all configurations -RMJ equ 0E64Bh -RMN equ RMJ+1 -RUP equ RMN+1 -RTP equ RUP+1 - - if 0 -BANPTR equ RTP+1 -DKMP equ BANPTR+2 -DBBOOL equ DKMP+2 ; Disk Boot Boolean -DBDRV equ DBBOOL+1 ; Disk Boot Drive Code -FREQ equ DBDRV+1 -PLAT equ FREQ+1 ; Hardware Platform -DIOPLT equ PLAT+1 -VDUPLT equ DIOPLT+1 -ROMSIZ equ VDUPLT+1 -RAMSIZ equ ROMSIZ+2 -CRAM equ RAMSIZ+2 -DSKY equ CRAM+1 ; Is Display/Keyboard Attached? -UART equ DSKY+1 ; Is UART Enabled? -VDUEN equ UART+1 -FDEN equ VDUEN+1 ; Is Floppy Disk Support Enabled -FDTR equ FDEN+1 ; Is Floppy Disk Error Tracing Enabled? -FMED equ FDTR+1 ; Floppy Disk Media Type -FALT equ FMED+1 ; Alternative Floppy Disk Media Type -FAUT equ FALT+1 ; Is Floppy Disk Automatic Sensing Enabled? -IDEN equ FAUT+1 ; Is On-Board IDE Support Enabled -IDTR equ IDEN+1 -IDE8 equ IDTR+1 -IDCP equ IDE8+1 ; 1/13/2012 IDE Capacity -PPEN equ IDCP+2 ; Is PPIDE Support Enablned? -PPTR equ PPEN+1 ; Is PPIDE Tracing Enabled? -PP8B equ PPTR+1 -PPCP equ PP8B+1 ; 1/13/2012 PPIDE Capacity -PSLW equ PPCP+2 ; Use NOPs for recovery-time compensation -BTYP equ PSLW+1 -BTTO equ BTYP+1 -BTDF equ BTTO+1 -BAUD equ BTDF+1 ; What is the Console Baud Rate - -; Only Valid if PLATFORM == PLT_N8 -CLKDIV equ BAUD+2 ; Z180_CLKDIV -MEMWAIT equ CLKDIV+1 ; Z180_MEMWAIT -IOWAIT equ MEMWAIT+1 ; Z180_IOWAIT -CNTLB0 equ IOWAIT+1 ; Z180_CNTLB0 -CNTLB1 equ CNTLB0+1 ; Z180_CNTLB1 -SDENABLE equ CNTLB1+1 -SDTRACE equ SDENABLE+1 -SDCP equ SDTRACE+1 ; 1/13/2012 SD Capacity -VDPTR equ SDCP+2 ; pointer to VDU Data -FDPTR equ VDPTR+2 ; pointer to FD Data -IDEPTR equ FDPTR+2 ; pointer to IDE Data -PPIPTR equ IDEPTR+2 ; pointer to PPIDE_DATA Data -PPIPTR2 equ PPIPTR+2 ; pointer to PPIDE.ASM DATA - -DEFIO equ PPIPTR2+2 ; pointer to DEFIOBYTE -LDRC equ DEFIO+1 ; pointer to LDRCON -DBGC equ LDRC+1 ; pointer to DBGCON -TTYP equ DBGC+1 ; pointer to TERMTYPE -REV equ TTYP+1 ; subversion revision - -TMDT equ REV+2 ; startup date and time - -PSDE equ TMDT+6 ; prpsdenable -PSDT equ PSDE+1 ; prpsdtrace -PSDC equ PSDT+1 ; prpsdcapacity -PRCE equ PSDC+2 - -DSKM equ PRCE+1 ; DM_ROM... - -DTSZ equ DSKM+1 ; DATASIZE - -; LU0 LU1 LU2 LU3 LU4 LU5 LU6 LU7 LU8 LU9 -; 41 82 c3 104 145 186 1c7 208 249 286 -; -; LU10 LU11 LU12 LU13 LU14 LU15 LU16 -; 2c7 308 349 38a 3cb 40c 44d - -LU0 equ 0 ; 041h ; PPIDE1 offset for first slice (default) -LU1 equ 1 ; 082h ; PPIDE1 offset for second slice -LU2 equ 2 ; 0C3h ; PPIDE1 offset for third slice -LU3 equ 3 ; 104h ; PPIDE1 offset for fourth slice -LU4 equ 4 ; 145h ; PPIDE1 offset for fifth slice -LU5 equ 5 ; 186h ; PPIDE1 offset for sixth slice -LU6 equ 6 ; 1c7h ; PPIDE1 offset for seventh slice -LU7 equ 7 ; 208h ; PPIDE1 offset for eighth slice -LU8 equ 8 ; 249h ; PPIDE1 offset for ninth slice -LU9 equ 9 ; 286h ; PPIDE1 offset for tenth slice -LU10 equ 10 -LU11 equ 11 -LU12 equ 12 -LU13 equ 13 -LU14 equ 14 -LU15 equ 15 -LU16 equ 16 -LU17 equ 17 -LU18 equ 18 -LU19 equ 19 -LU20 equ 20 -LU21 equ 21 -LU22 equ 22 -LU23 equ 23 -LU24 equ 24 -LU25 equ 25 -LU26 equ 26 ; 0x1a -LU27 equ 27 ; 0x1b (1Cth entry) - - endif - -DRIVEB equ 1 ; 0=A, 1=B... - - -setlu13 macro offset - lxi h,PPIPTR2 ; set pointer to ppide.asm data - mov e,m ; dereference pointer - inx h - mov d,m ; de -> ppide.asm data - xchg ; hl -> ppide.asm data - lxi d,6 ; offset to offset - dad d ; hl -> offset in ppide.asm data - lxi d,offset ; load caller's parameter in de - mov m,e ; stuff LO offset byte into offset - inx h ; bump ptr - mov m,d ; stuff HO offset byte into offset - mvi c,13 ; BDOS DSKRESET - call 5 ; call BDOS - endm - -getlu13 macro - lxi h,PPIPTR2 ; set pointer to ppide.asm data - mov e,m ; dereference pointer - inx h - mov d,m ; de -> ppide.asm data - xchg ; hl -> ppide.asm data - lxi d,6 ; offset to offset - dad d ; hl -> offset in ppide.asm data - mov e,m ; pick up LO byte of offset - inx h ; bump ptr - mov d,m ; pick up HO byte of offset - xchg ; hl = offset - endm - -setlu14 macro offset - lxi h,PPIPTR2 ; set pointer to ppide.asm data - mov e,m ; dereference pointer - inx h - mov d,m ; de -> ppide.asm data - xchg ; hl -> ppide.asm data - lxi d,6 ; offset to offset - dad d ; hl -> offset in ppide.asm data - lxi d,offset ; load caller's parameter in de - mov m,e ; stuff LO offset byte into offset - inx h ; bump ptr - mov m,d ; stuff HO offset byte into offset - mvi c,13 ; BDOS DSKRESET - call 5 ; call BDOS - endm - -getlu14 macro - lxi h,PPIPTR2 ; set pointer to ppide.asm data - mov e,m ; dereference pointer - inx h - mov d,m ; de -> ppide.asm data - xchg ; hl -> ppide.asm data - lxi d,6 ; offset to offset - dad d ; hl -> offset in ppide.asm data - mov e,m ; pick up LO byte of offset - inx h ; bump ptr - mov d,m ; pick up HO byte of offset - xchg ; hl = offset - endm - -setlu macro drive,slice - local dontboth,msg,msg2 - mvi c,drive - call BISELDSK - lxi d,16 - dad d - mov a,m - cpi 'L' - jnz dontboth - inx h - mov a,m - cpi 'U' - jnz dontboth - inx h - mvi a,slice - mov m,a - print msg - mvi a,drive - adi 'A' - mov e,a - mvi c,2 - call BDOS - print msg2 - lxi h,slice - call pr$d$word - jmp dontboth -msg db CR,LF,'Drive $' -msg2 db ': set to Logical Unit (slice) $' -dontboth: - endm - - -xluset macro - local ldrive,lslice,dontboth,msg,msg2 - ; C = DRIVE - ; A = SLICE - sta lslice - mov a,c - sta ldrive - - call BISELDSK ; uses c parameter (drive) - lxi d,16 - dad d - mov a,m - cpi 'L' - jnz dontboth - inx h - mov a,m - cpi 'U' - jnz dontboth - inx h - lda lslice - mov m,a ; put slice into CURRENT - -; print msg -; lda ldrive -; adi 'A' -; mov e,a -; mvi c,2 -; call BDOS -; print msg2 -; lda lslice -; mov l,a -; mvi h,0 -; call pr$d$word - - jmp dontboth -msg db CR,LF,'Drive $' -msg2 db ': set to Logical Unit (slice) $' -ldrive db 0 -lslice db 0 -dontboth: - endm - - - - - - - -hdrlit macro ptr,val,msg - local notval - lxi h,ptr - mvi a,val - cmp m - jnz notval - print msg -notval: - endm - - -hdrbool macro ptr,tmsg,fmsg - local itstrue,itsfalse,imdone - enter - lxi h,ptr - mov a,m - cpi TRUE - jnz itsfalse - lxi d,tmsg - jmp imdone -itsfalse: lxi d,fmsg -imdone: mvi c,PRINTSTR - call BDOS - leave - endm - -hdrbyte macro ptr,msg - enter - mvi c,PRINTSTR - lxi d,msg - call BDOS - lxi h,ptr - mov a,m - call pr$h$byte - - conout '(' - mov e,m - mov d,0 - xchg - call pr$d$word - conout ')' - - leave - endm - -hdrpbyte macro ptr,msg - enter - mvi c,PRINTSTR - lxi d,msg - call BDOS - lxi h,PTR - mov e,m - inx h - mov d,m - xchg - mov a,m - call pr$h$byte - -; conout ' ' - conout '(' - mov e,m - mov d,0 - xchg - call pr$d$word - conout ')' - leave - endm - -hdrword macro ptr,msg - enter - - mvi c,PRINTSTR - lxi d,msg - call BDOS - - lxi h,ptr - inx h - mov a,m - call pr$h$byte - - lxi h,ptr - mov a,m - call pr$h$byte - - conout '(' - lxi h,ptr - mov e,m - inx h - mov d,m - xchg - call pr$d$word - conout ')' - leave - endm - -syncerr macro - print syncmsg - exit - endm - -hdrvalid macro - local byte1ok,byte2ok - enter - lxi h,CFDA - mov a,m - cpi 0DAh - jz byte1ok - syncerr -byte1ok: - inx h - mov al,m - cpi 0CFh - jz byte2ok - syncerr -byte2ok: - leave - endm - -; eof - bioshdr.lib - \ No newline at end of file diff --git a/Apps/Source/cbanner.c b/Apps/Source/cbanner.c deleted file mode 100644 index 83eb6511..00000000 --- a/Apps/Source/cbanner.c +++ /dev/null @@ -1,39 +0,0 @@ -/* cbanner.c 3/12/2012 dwg - */ - -#include "portab.h" -#include "globals.h" -#include "applvers.h" - -char * lines = "----------------------------------------"; -char * line1 = "12345678.123 mm/dd/yyyy Version x.x.x.x"; -char * line2 = "S/N CPM80-DWG-654321 Licensed under GPL3"; -char * line3 = "Copyright (C) 2011-12 Douglas W. Goodall"; - -sbanner(program) - char *program; -{ - char szTemp[128]; - - printf("%s ",program); - printf("%d/%d/%d ",A_MONTH,A_DAY,A_YEAR); - printf("Version %d.%d.%d.%d ",A_RMJ,A_RMN,A_RUP,A_RTP); - printf("COPR Douglas Goodall Licensed w/GPLv3\n"); -} - -banner(program) - char *program; -{ - char szTemp[128]; - - printf("%s\n",lines); - strcpy(szTemp,program); - while(12 > strlen(szTemp)) { - strcat(szTemp," "); - } - printf("%s ",szTemp); - printf("%d/%d/%d ",A_MONTH,A_DAY,A_YEAR); - printf("Version %d.%d.%d.%d\n",A_RMJ,A_RMN,A_RUP,A_RTP); - printf("%s\n",line2); - printf("%s\n",line3); - printf("%s\n",lines); -} diff --git a/Apps/Source/cbanner.h b/Apps/Source/cbanner.h deleted file mode 100644 index 43c1908a..00000000 --- a/Apps/Source/cbanner.h +++ /dev/null @@ -1 +0,0 @@ -åååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååå \ No newline at end of file diff --git a/Apps/Source/chars.c b/Apps/Source/chars.c deleted file mode 100644 index 10d3fd1e..00000000 --- a/Apps/Source/chars.c +++ /dev/null @@ -1,152 +0,0 @@ -/* chars.c 6/7/2012 dwg - test command line arguments */ - -#include "stdio.h" - -#include "portab.h" -#include "globals.h" -#include "std.h" -#include "cpm80.h" -#include "cpmappl.h" -#include "applvers.h" -#include "cnfgdata.h" -#include "syscfg.h" - -#define TOP 0 -#define LEFT 4 - -#define BDOS 5 /* memory address of BDOS invocation */ -#define HIGHSEG 0x0C000 /* memory address of system config */ - -#define GETSYSCFG 0x0F000 /* HBIOS function for Get System Configuration */ - -struct SYSCFG * pSYSCFG = HIGHSEG; - -char map[256] = -{ -/* 0 1 2 3 4 5 6 7 8 9 A B C D E F */ - - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /* 0 */ - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /* 1 */ - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 2 */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 3 0 - 9 */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 4 A - O */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 5 P - Z */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 6 a - o */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, /* 7 p - z */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 8 */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 9 */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* A */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* B 0 - 9 */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* C A - O */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* D P - Z */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* E a - o */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /* F p - z */ -}; - -char attroff[] = { 27, '[', 'm', 0 }; -char attrbold[] = { 27, '[', '1', 'm', 0 }; -char attrlow[] = { 27, '[', '2', 'm', 0 }; -char attrundr[] = { 27, '[', '4', 'm', 0 }; -char attrblnk[] = { 27, '[', '5', 'm', 0 }; -char attrrevs[] = { 27, '[', '7', 'm', 0 }; -char attrinvs[] = { 27, '[', '8', 'm', 0 }; -char graphon[] = { 27, 'F', 0 }; -char graphoff[] = { 27, 'G', 0 }; - - -char atreset[] = "0"; -char atbold[] = "1"; -char atdim[] = "2"; -char atundrscr[] = "4"; -char atblink[] = "5"; -char atrevs[] = "7"; -char athidden[] = "8"; - -char fgblack[] = "30"; -char fgred[] = "31"; -char fggreen[] = "32"; -char fgyellow[] = "33"; -char fgblue[] = "34"; -char fgmagenta[] = "35"; -char fgcyan[] = "36"; -char fgwhite[] = "37"; - -char bgblack[] = "40"; -char bgred[] = "41"; -char bggreen[] = "42"; -char bgyellow[] = "43"; -char bgblue[] = "44"; -char bgmagenta[] = "45"; -char bgcyan[] = "46"; -char bgwhite[] = "47"; - -dispattr(attr,fg,bg) - char * attr; - char * fg; - char * bg; -{ - printf("%c[%s;%s;%sm",27,attr,fg,bg); -} - -int main(argc,argv) - int argc; - char *argv[]; -{ - int i,j,k; - int x,y; - - if(1 < argc) { - for(i=1;icnfgdata.termtype); */ - - - crtinit(pSYSCFG->cnfgdata.termtype); - crtclr(); - crtlc(0,0); - - dispattr(atbold,fggreen,bgblack); - banner("CHARS"); - - printf("%s",attroff); - - dispattr(atbold,fgcyan,bgblack); - for(x=0;x<16;x++) { - crtlc(TOP+6,LEFT+(x*4)+5); - printf("[%x]",x); - } - printf("%s",attroff); - - for(y=0;y<16;y++) { - crtlc(TOP+y+7,LEFT+0); - dispattr(atbold,fgcyan,bgblack); - printf("[%x]",y); - printf("%s",attroff); - - for(x=0;x<16;x++) { - crtlc(TOP+y+7,LEFT+(x*4)+6); - if(1 == map[(y*16)+x]) { - printf("."); - } else { - printf("%c",(y*16)+x); - } - } - dispattr(atbold,fgcyan,bgblack); - printf(" [%x]",y); - printf("%s",attroff); - } - } - - return 0; -} - \ No newline at end of file diff --git a/Apps/Source/clear.c b/Apps/Source/clear.c deleted file mode 100644 index 2edfea8d..00000000 --- a/Apps/Source/clear.c +++ /dev/null @@ -1,48 +0,0 @@ -/* clear.c 11/23/2012 dwg - */ - -#include "portab.h" -#include "globals.h" - -#include "stdio.h" -#include "stdlib.h" -#include "memory.h" -#include "applvers.h" -#include "n8chars.h" -#include "tms9918.h" -#include "std.h" -#include "ctermcap.h" -#include "cpmbdos.h" -#include "bdoscall.h" -#include "hbios.h" -#include "asmiface.h" -#include "diagnose.h" -#include "cnfgdata.h" -#include "syscfg.h" -#include "cpmbind.h" -#include "infolist.h" -#include "metadata.h" -#include "clogical.h" - -#define HIGHSEG 0x0C000 /* memory address of system config */ - -#define GETSYSCFG 0x0F000 /* HBIOS function for Get System Configuration */ - -struct CNFGDATA * pCNFGDATA; -struct SYSCFG * pSYSCFG; - -int main(argc,argv) - int argc; - char *argv[]; -{ - char column; - - hregbc = GETSYSCFG; /* function = Get System Config */ - hregde = HIGHSEG; /* addr of dest (must be high) */ - diagnose(); /* invoke the NBIOS function */ - pSYSCFG = HIGHSEG; - crtinit(pSYSCFG->cnfgdata.termtype); - crtclr(); - crtlc(0,0); -} - - \ No newline at end of file diff --git a/Apps/Source/clogical.c b/Apps/Source/clogical.c deleted file mode 100644 index c3975c11..00000000 --- a/Apps/Source/clogical.c +++ /dev/null @@ -1,57 +0,0 @@ -/* clogical.c 6/4/2012 dwg - */ - -#include "portab.h" -#include "cpmbios.h" -#include "asmiface.h" - -lugcur(drive) -{ - asmif(pGETLU,drive,0,0); - return xregde; -} - -lugnum(drive) -{ - asmif(pGETLU,drive,0,0); - return xreghl; -} - -lugdu(drive) -{ - asmif(pGETLU,drive,0,0); - return xregbc>>8; -} - -luscur(drive,lunum) -{ - asmif(pGETLU,drive,0,0); - /* A = Result 0=OK */ - /* B = devunit */ - /* DE = current */ - /* HL = numlu */ - - /* BC = devunit*256+drive */ - /* DE = current */ - /* HL = numlu */ - asmif(pSETLU,xregbc,lunum,xreghl); -} - -lusnum(drive,numlu) -{ - asmif(pGETLU,drive,0,0); - /* A = Result 0=OK */ - /* B = devunit */ - /* DE = current */ - /* HL = numlu */ - - /* BC = devunit*256+drive */ - /* DE = current */ - /* HL = numlu */ - asmif(pSETLU,xregbc,xregde,numlu); -} - - -/********************/ -/* eof - clogical.c */ -/********************/ - \ No newline at end of file diff --git a/Apps/Source/clogical.h b/Apps/Source/clogical.h deleted file mode 100644 index c0624494..00000000 --- a/Apps/Source/clogical.h +++ /dev/null @@ -1,14 +0,0 @@ -/*****************************/ -/* clogical.H 6/4/2012 dwg - */ -/*****************************/ - -extern lugdu(); -extern lugcur(); -extern luscur(); -extern lugnum(); -extern lusnum(); - -/********************/ -/* eof - clogical.h */ -/********************/ - \ No newline at end of file diff --git a/Apps/Source/cls.c b/Apps/Source/cls.c deleted file mode 100644 index 2bbf9c2f..00000000 --- a/Apps/Source/cls.c +++ /dev/null @@ -1,127 +0,0 @@ -/* cls.c 7/21/2012 dwg - elegant form of clear screen program */ - -/* -#include "stdio.h" -#include "applvers.h" -*/ - -/* declarations for HBIOS access */ -extern char hrega; -extern unsigned int hregbc; -extern unsigned int hregde; -extern unsigned int hreghl; -extern diagnose(); - -/* declaration dir BIOS and BDOS and low level calls */ -extern char xrega; -extern unsigned int xregbc; -extern unsigned int xregde; -extern unsigned int xreghl; -extern asmif(); /* asmif(0x0E6**,bc,de,hl); */ - -#define BDOS 5 /* memory address of BDOS invocation */ -#define HIGHSEG 0x0C000 /* memory address of system config */ - -#define GETSYSCFG 0x0F000 /* HBIOS function for Get System Configuration */ - -/* pointer based Configuration Data structure */ -struct CNFGDATA { - unsigned char rmj; - unsigned char rmn; - unsigned char rup; - unsigned char rtp; - unsigned char diskboot; - unsigned char devunit; - unsigned int bootlu; - unsigned char hour; - unsigned char minute; - unsigned char second; - unsigned char month; - unsigned char day; - unsigned char year; - unsigned char freq; - unsigned char platform; - unsigned char dioplat; - unsigned char vdumode; - unsigned int romsize; - unsigned int ramsize; - unsigned char clrramdk; - unsigned char dskyenable; - unsigned char uartenable; - unsigned char vduenable; - unsigned char fdenable; - unsigned char fdtrace; - unsigned char fdmedia; - unsigned char fdmediaalt; - unsigned char fdmauto; - unsigned char ideenable; - unsigned char idetrace; - unsigned char ide8bit; - unsigned int idecapacity; - unsigned char ppideenable; - unsigned char ppidetrace; - unsigned char ppide8bit; - unsigned int ppidecapacity; - unsigned char ppideslow; - unsigned char boottype; - unsigned char boottimeout; - unsigned char bootdefault; - unsigned int baudrate; - unsigned char ckdiv; - unsigned char memwait; - unsigned char iowait; - unsigned char cntlb0; - unsigned char cntlb1; - unsigned char sdenable; - unsigned char sdtrace; - unsigned int sdcapacity; - unsigned char sdcsio; - unsigned char sdcsiofast; - unsigned char defiobyte; - unsigned char termtype; - unsigned int revision; - unsigned char prpsdenable; - unsigned char prpsdtrace; - unsigned int prpsdcapacity; - unsigned char prpconenable; - unsigned int biossize; - unsigned char pppenable; - unsigned char pppsdenable; - unsigned char pppsdtrace; - unsigned int pppsdcapacity; - unsigned char pppconenable; - unsigned char prpenable; -}; - -struct JMP { - unsigned char opcode; /* JMP opcode */ - unsigned int address; /* JMP address */ -}; - -struct SYSCFG { - struct JMP jmp; - void * cnfloc; - void * tstloc; - void * varloc; - struct CNFGDATA cnfgdata; - char filler[256-3-2-2-2-sizeof(struct CNFGDATA)]; -} * pSYSCFG = HIGHSEG; - - -main(argc,argv) - int argc; - char *argv[]; -{ - hregbc = GETSYSCFG; /* function = Get System Config */ - hregde = HIGHSEG; /* addr of dest (must be high) */ - diagnose(); /* invoke the HBIOS function */ - - crtinit(pSYSCFG->cnfgdata.termtype); /* pass termtype to init */ - - crtclr(); - - crtlc(0,0); -} - - - \ No newline at end of file diff --git a/Apps/Source/cmemory.c b/Apps/Source/cmemory.c deleted file mode 100644 index ba33be0e..00000000 --- a/Apps/Source/cmemory.c +++ /dev/null @@ -1,53 +0,0 @@ -/* cmemory.c 3/13/2012 dwg - */ - -#include "portab.h" -/* #include "cpmbind.h" */ - -memcmp(xptr,yptr,count) - u8 * xptr; - u8 * yptr; - int count; -{ - u8 * x; - u8 * y; - int i; - - x = xptr; - y = yptr; - for(i=0;idphmap; - pDPH = pDPHVEC[drive] - pDPB = pDPH->dpb; - if(0 < pDPB->off) { - return TRUE; - } else { - return FALSE; - } - -} - -int getmeta(drive,buffer) - int drive; - struct METADATA * buffer; -{ - if(TRUE == hasmeta(drive)) { - rdsector(drive,track,sector,buffer,0); - return SUCCESS; - } else { - return FAILURE; - } -} - -int putmeta(drive,buffer) - int drive; - struct METADATA * buffer; -{ - if(TRUE == hasmeta(drive)) { - wrsector(drive,track,sector,buffer,0); - return SUCCESS; - } else { - return FAILURE; - } -} - -/********************/ -/* eof - metadata.c */ -/********************/ - - - - \ No newline at end of file diff --git a/Apps/Source/cnfgdata.h b/Apps/Source/cnfgdata.h deleted file mode 100644 index b6737102..00000000 --- a/Apps/Source/cnfgdata.h +++ /dev/null @@ -1,140 +0,0 @@ -/* cnfgdata.h 6/04/2012 dwg - */ - -struct CNFGDATA { - - unsigned char rmj; - unsigned char rmn; - unsigned char rup; - unsigned char rtp; - unsigned int revision; - - unsigned char diskboot; - unsigned char devunit; - unsigned int bootlu; - unsigned char year; - unsigned char month; - unsigned char day; - unsigned char hour; - unsigned char minute; - unsigned char second; - - unsigned char platform; - unsigned char freq; - unsigned int ramsize; - unsigned int romsize; - - unsigned char ckdiv; - unsigned char memwait; - unsigned char iowait; - unsigned char cntlb0; - unsigned char cntlb1; - - unsigned char boottype; - unsigned char boottimeout; - unsigned char bootdefault; - - unsigned char defcon; - unsigned char altcon; - unsigned int conbaud; - unsigned char defvda; - unsigned char defemu; - unsigned char termtype; - - unsigned char defiobyte; - unsigned char altiobyte; - unsigned char wrtcache; - unsigned char dsktrace; - unsigned char dskmap; - unsigned char clrramdsk; - - unsigned char dskyenable; - - unsigned char uartenable; - unsigned char uartcnt; - unsigned char uart0iob; - unsigned int uart0baud; /* actual baudrate / 10 */ - unsigned char uart0fifo; - unsigned char uart0afc; - unsigned char uart1iob; - unsigned int uart1baud; /* actual baudrate / 10 */ - unsigned char uart1fifo; - unsigned char uart1afc; - unsigned char uart2iob; - unsigned int uart2baud; /* actual baudrate / 10 */ - unsigned char uart2fifo; - unsigned char uart2afc; - unsigned char uart3iob; - unsigned int uart3baud; /* actual baudrate / 10 */ - unsigned char uart3fifo; - unsigned char uart3afc; - - unsigned char ascienable; - unsigned int asci0baud; /* actual baudrate / 10 */ - unsigned int asci1baud; /* actual baudrate / 10 */ - - unsigned char vduenable; - - unsigned char cvduenable; - - unsigned char upd7220enable; - - unsigned char n8venable; - - unsigned char fdenable; - unsigned char fdmode; - unsigned char fdtrace; - unsigned char fdmedia; - unsigned char fdmediaalt; - unsigned char fdmauto; - - unsigned char ideenable; - unsigned char idemode; - unsigned char idetrace; - unsigned char ide8bit; - unsigned int idecapacity; - - unsigned char ppideenable; - unsigned char ppideiob; - unsigned char ppidetrace; - unsigned char ppide8bit; - unsigned int ppidecapacity; - unsigned char ppideslow; - - unsigned char sdenable; - unsigned char sdmode; - unsigned char sdtrace; - unsigned int sdcapacity; - unsigned char sdcsiofast; - - unsigned char prpenable; - unsigned char prpsdenable; - unsigned char prpsdtrace; - unsigned int prpsdcapacity; - unsigned char prpconenable; - - unsigned char pppenable; - unsigned char pppsdenable; - unsigned char pppsdtrace; - unsigned int pppsdcapacity; - unsigned char pppconenable; - - unsigned char hdskenable; - unsigned char hdsktrace; - unsigned int hdskcapacity; - - unsigned char ppkenable; - unsigned char ppktrace; - - unsigned char kbdenable; - unsigned char kbdtrace; - - unsigned char ttyenable; - - unsigned char ansienable; - unsigned char ansitrace; -}; - -/********************/ -/* eof - cnfgdata.h */ -/********************/ - \ No newline at end of file diff --git a/Apps/Source/cnfgdata.lib b/Apps/Source/cnfgdata.lib deleted file mode 100644 index 10b24d99..00000000 --- a/Apps/Source/cnfgdata.lib +++ /dev/null @@ -1,210 +0,0 @@ -; cnfgdata.lib 7/19/2012 dwg - - -byte equ 1 -word equ 2 - -;; /* cnfgdata.h 6/04/2012 dwg - */ -;; -;; struct CNFGDATA { -;; unsigned char rmj; -cfgrmj equ 08009h -;; -;; unsigned char rmn; -cfgrmn equ cfgrmj + byte -;; -;; unsigned char rup; -cfgrup equ cfgrmn + byte -;; -;; unsigned char rtp; -cfgrtp equ cfgrup + byte -;; -;; unsigned char diskboot; -diskboot equ cfgrtp + byte -;; -;; unsigned char devunit; -devunit equ diskboot + byte -;; -;; unsigned int bootlu; -bootlu equ devunit + byte -;; -;; unsigned char hour; -hour equ bootlu + word -;; -;; unsigned char minute; -minute equ hour + byte -;; -;; unsigned char second; -second equ minute + byte -;; -;; unsigned char month; -month equ second + byte -;; -;; unsigned char day; -day equ month + byte -;; -;; unsigned char year; -year equ day + byte -;; -;; unsigned char freq; -freq equ year + byte -;; -;; unsigned char platform; -platform equ freq+ byte -;; -;; unsigned char dioplat; -dioplat equ platform + byte -;; -;; unsigned char vdumode; -vdumode equ dioplat + byte -;; -;; unsigned int romsize; -romsize equ vdumode + byte -;; -;; unsigned int ramsize; -ramsize equ romsize + word -;; -;; unsigned char clrramdk; -clrramdk equ ramsize + word -;; -;; unsigned char dskyenable; -dskyenable equ clrramdk + byte -;; -;; unsigned char uartenable; -uartenable equ dskyenable + byte -;; -;; unsigned char vduenable; -vduenable equ uartenable + byte -;; -;; unsigned char fdenable; -fdenable equ vduenable + byte -;; -;; unsigned char fdtrace; -fdtrace equ fdenable + byte -;; -;; unsigned char fdmedia; -fdmedia equ fdtrace + byte -;; -;; unsigned char fdmediaalt; -fdmediaalt equ fdmedia + byte -;; -;; unsigned char fdmauto; -fdmauto equ fdmediaalt + byte -;; -;; unsigned char ideenable; -ideenable equ fdmauto + byte -;; -;; unsigned char idetrace; -idetrace equ ideenable + byte -;; -;; unsigned char ide8bit; -ide8bit equ idetrace + byte -;; -;; unsigned int idecapacity; -idecapacity equ ide8bit + byte -;; -;; unsigned char ppideenable; -ppideenable equ idecapacity + word -;; -;; unsigned char ppidetrace; -ppidetrace equ ppideenable + byte -;; -;; unsigned char ppide8bit; -ppide8bit equ ppidetrace + byte -;; -;; unsigned int ppidecapacity; -ppidecapacity equ ppide8bit + byte -;; -;; unsigned char ppideslow; -ppideslow equ ppidecapacity + word -;; -;; unsigned char boottype; -boottype equ ppideslow + byte -;; -;; unsigned char boottimeout; -boottimeout equ boottype + byte -;; -;; unsigned char bootdefault; -bootdefault equ boottimeout + byte -;; -;; unsigned int baudrate; -baudrate equ bootdefault + byte -;; -;; unsigned char ckdiv; -ckdiv equ baudrate + word -;; -;; unsigned char memwait; -memwait equ ckdiv + byte -;; -;; unsigned char iowait; -iowait equ memwait + byte -;; -;; unsigned char cntlb0; -cntlb0 equ iowait + byte -;; -;; unsigned char cntlb1; -cntlb1 equ cntlb0 + byte -;; -;; unsigned char sdenable; -sdenable equ cntlb1 + byte -;; -;; unsigned char sdtrace; -sdtrace equ sdenable + byte -;; -;; unsigned int sdcapacity; -sdcapacity equ sdtrace + byte -;; -;; unsigned char sdcsio; -sdcsio equ sdcapacity + word -;; -;; unsigned char sdcsiofast; -sdcsiofast equ sdcsio + byte -;; -;; unsigned char defiobyte; -defiobyte equ sdcsiofast + byte -;; -;; unsigned char termtype; -termtype equ defiobyte + byte -;; -;; unsigned int revision; -revision equ termtype + byte -;; -;; unsigned char prpsdenable; -prpsdenable equ revision + word -;; -;; unsigned char prpsdtrace; -prpsdtrace equ prpsdenable + byte -;; -;; unsigned int prpsdcapacity; -prpsdcapacity equ prpsdtrace + byte -;; -;; unsigned char prpconenable; -prpconenable equ prpsdcapacity + word -;; -;; unsigned int biossize; -biossize equ prpconenable + byte -;; -;; unsigned char pppenable; -pppenable equ biossize + word -;; -;; unsigned char pppsdenable; -pppsdenable equ pppenable + byte -;; -;; unsigned char pppsdtrace; -pppsdtrace equ pppsdenable + byte -;; -;; unsigned int pppsdcapacity; -pppsdcapacity equ pppsdtrace + byte -;; -;; unsigned char pppconenable; -pppconenable equ pppsdcapacity + word -;; -;; unsigned char prpenable; -prpenable equ pppconenable + byte -;; -;; }; -;; -;; /********************/ -;; /* eof - cnfgdata.h */ -;; /********************/ - - \ No newline at end of file diff --git a/Apps/Source/convert.c b/Apps/Source/convert.c deleted file mode 100644 index 57cfdf2a..00000000 --- a/Apps/Source/convert.c +++ /dev/null @@ -1,80 +0,0 @@ -/* convert.c 7/11/2012 dwg - - - The purpose of this program is similar to the CP/M dump program - except that in addition to the normal hexadecimal bytes, a field - of ascii bytes to the right are displayed as well. - -*/ - -#include "stdio.h" - - -char visible[256] = { - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 00 */ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 10 */ - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* 20 */ - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* 30 */ - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* 40 */ - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* 50 */ - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* 60 */ - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0, /* 70 */ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 80 */ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 90 */ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* A0 */ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* B0 */ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* C0 */ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* D0 */ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* E0 */ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 /* F0 */ -}; - -#include "cvt2h.h" - -unsigned char sector[32767]; - -main(argc,argv) - int argc; - char *argv[]; -{ - int i,j; - int offset; - int result; - unsigned char byte; - char name[32]; - - - FILE * fd; - - for(i=0;i0;i--) { - if(sector[i] != 0) break; - } - - sprintf(name,"sect%04x.h",0); - cvt2h(sector,i,name); - fclose(fd); - - exit(0); -} - \ No newline at end of file diff --git a/Apps/Source/cpm80.h b/Apps/Source/cpm80.h deleted file mode 100644 index 20d45f51..00000000 --- a/Apps/Source/cpm80.h +++ /dev/null @@ -1,195 +0,0 @@ -/* cpmbios.h 3/11/2012 dwg - added CURDRV */ - -/*************************/ -/* BIOS Memory Locations */ -/*************************/ - -#define CURDRV 0x00004 -#define BIOSAD 0x0e600 - -#define pBOOT 0x0E600 -#define pWBOOT 0x0E603 -#define pCONST 0x0E606 -#define pCONIN 0x0E609 -#define pCONOUT 0x0E60C -#define pLIST 0x0E60F -#define pPUNCH 0x0E612 -#define pREADER 0x0E615 -#define pHOME 0x0E618 -#define pSELDSK 0x0E61B -#define pSETTRK 0x0E61E -#define pSETSEC 0x0E621 -#define pSETDMA 0x0E624 -#define pREAD 0x0E627 -#define pWRITE 0x0E62A -#define pLISTST 0x0E62D -#define pSECTRN 0x0E630 -#define pBNKSEL 0x0E633 -#define pGETLU 0x0E636 -#define pSETLU 0x0E639 -#define pGETINFO 0x0E63C - -struct JMP { - unsigned char opcode; - unsigned int address; -}; - -struct BIOS { - struct JMP boot; - struct JMP wboot; - struct JMP const; - struct JMP conin; - struct JMP conout; - struct JMP list; - struct JMP punch; - struct JMP reader; - struct JMP home; - struct JMP seldsk; - struct JMP settrk; - struct JMP setsec; - struct JMP setdma; - struct JMP read; - struct JMP write; - struct JMP listst; - struct JMP sectrn; - struct JMP bnksel; - struct JMP getlu; - struct JMP setlu; - struct JMP getinfo; - struct JMP rsvd1; - struct JMP rsvd2; - struct JMP rsvd3; - struct JMP rsvd4; - - char diskboot; - char bootdrive; - - char rmj; - char rmn; - char rup; - char rtp; -}; - - -struct DPH { - unsigned int xlt; - unsigned int rv1; - unsigned int rv2; - unsigned int rv3; - unsigned int dbf; - unsigned int dpb; - unsigned int csv; - unsigned int alv; - unsigned char sigl; - unsigned char sigu; - unsigned int current; - unsigned int number; -}; - -struct DPB { - unsigned int spt; - unsigned char bsh; - unsigned char blm; - unsigned char exm; - unsigned int dsm; - unsigned int drm; - unsigned char al0; - unsigned char al1; - unsigned int cks; - unsigned int off; -}; - -/* bioscall.h 3/10/2012 dwg - header file for bdoscall */ - - extern char irega; - extern unsigned int iregbc; - extern unsigned int iregde; - extern unsigned int ireghl; - extern bioscall(); - - -/* bdoscall.h 3/10/2012 dwg - header file for bdoscall */ - - extern char drega; - extern unsigned int dregbc; - extern unsigned int dregde; - extern unsigned int dreghl; - extern bdoscall(); - -/* diagnose.h 5/23/2012 dwg - */ - - extern char hrega; - extern unsigned int hregbc; - extern unsigned int hregde; - extern unsigned int hreghl; - -extern diagnose(); - -/* ctermcap.h 3/11/2012 dwg - declarations for termal capability */ - -extern crtinit(); -extern crtclr(); -extern crtlc(); - -/* cpmbdos.h */ -#define TERMCPM 0 -#define CONIN 1 -#define CWRITE 2 -#define DIRCONIO 6 -#define PRINTSTR 9 -#define RDCONBUF 10 -#define GETCONST 11 -#define RETVERNUM 12 -#define RESDISKSYS 13 -#define SELECTDISK 14 -#define FOPEN 15 -#define FCLOSE 16 -#define SEARCHFIRST 17 -#define SEARCHNEXT 18 -#define FDELETE 19 -#define FREADSEQ 20 -#define FWRITESEQ 21 -#define FMAKEFILE 22 -#define FRENAME 23 -#define RETLOGINVEC 24 -#define RETCURRDISK 25 -#define SETDMAADDR 26 -#define GETALLOCVEC 27 -#define WRPROTDISK 28 -#define GETROVECTOR 29 -#define FSETATTRIB 30 -#define GETDPBADDR 31 -#define SETGETUSER 32 -#define FREADRANDOM 33 -#define FWRITERAND 34 -#define FCOMPSIZE 35 -#define SETRANDREC 36 -#define RESETDRIVE 37 -#define WRRANDFILL 38 - -#define DRIVEA 0 - -/* dphmap.h 5/29/2012 dwg - declaration of DPH MAP structure */ - -struct DPHMAP { - struct DPH * drivea; - struct DPH * driveb; - struct DPH * drivec; - struct DPH * drived; - struct DPH * drivee; - struct DPH * drivef; - struct DPH * driveg; - struct DPH * driveh; -} * pDPHMAP; - -struct DPHMAP * pDPHVEC[MAXDRIVE]; - - -/******************/ -/* eof - dphmap.h */ -/******************/ - -/*****************/ -/* eof - cpm80.h */ -/*****************/ - \ No newline at end of file diff --git a/Apps/Source/cpmappl.h b/Apps/Source/cpmappl.h deleted file mode 100644 index a68ac9f2..00000000 --- a/Apps/Source/cpmappl.h +++ /dev/null @@ -1,8 +0,0 @@ -/* cpmappl.h */ - -extern banner(); - -/*******************/ -/* eof - cpmappl.h */ -/*******************/ - \ No newline at end of file diff --git a/Apps/Source/cpmappl.lib b/Apps/Source/cpmappl.lib deleted file mode 100644 index fa626600..00000000 --- a/Apps/Source/cpmappl.lib +++ /dev/null @@ -1,82 +0,0 @@ -; cpmappl.lib 2/10/2012 dwg - begin 1.6 development -; cpmappl.lib 2/04/2012 dwg - fix typo mov becomes mvi -; cpmappl.lib 2/ 2/2012 dwg - initial version - -; -; Copyright (C) 2011-2012 Douglas Goodall Licensed under GPL Ver 3. -; -; This file is part of NuBiosDWG and is free software: you can -; redistribute it and/or modify it under the terms of the GNU -; General Public License as published by the Free Software Foundation, -; either version 3 of the License, or (at your option) any later version. -; This file is distributed in the hope that it will be useful, -; but WITHOUT ANY WARRANTY; without even the implied warranty of -; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -; GNU General Public License for more details. -; You should have received a copy of the GNU General Public License -; along with it. If not, see . -; - -do$start macro - -start: jmp begin - - public hexref -hexref db '0123456789ABCDEF' - - public id$sig,id$rmj,id$rmn,id$rup,id$rtp,id$mon,id$day,id$yr -id$sig db 'ID' -id$rmj db A$RMJ -id$rmn db A$RMN -id$rup db A$RUP -id$rtp db A$RTP -id$mon db A$MONTH -id$day db A$DAY -id$yr dw A$YEAR -id$argv dw argv - db 0e5h - - - public pre$stk -pre$stk ds 2 - - public begin -begin: lxi h,0 - dad sp - shld pre$stk - lxi sp,stack$top - nop - endm - - -;--------------------------------- - - -do$end macro - lhld pre$stk - sphl - - mvi c,13 - call BDOS - - ret - ds stack$size -stack$top: - - endm - -movfcb macro destn,source - lxi d,destn - lxi h,source - lxi b,LENFCB - ldir - endm - -copyfcb macro fcbname,source - local around - jmp around -fcbname ds 32 -around: - endm - - \ No newline at end of file diff --git a/Apps/Source/cpmbdos.h b/Apps/Source/cpmbdos.h deleted file mode 100644 index ef1f5e26..00000000 --- a/Apps/Source/cpmbdos.h +++ /dev/null @@ -1,53 +0,0 @@ - -#define TERMCPM 0 -#define CONIN 1 -#define CWRITE 2 -#define DIRCONIO 6 -#define PRINTSTR 9 -#define RDCONBUF 10 -#define GETCONST 11 -#define RETVERNUM 12 -#define RESDISKSYS 13 -#define SELECTDISK 14 -#define FOPEN 15 -#define FCLOSE 16 -#define SEARCHFIRST 17 -#define SEARCHNEXT 18 -#define FDELETE 19 -#define FREADSEQ 20 -#define FWRITESEQ 21 -#define FMAKEFILE 22 -#define FRENAME 23 -#define RETLOGINVEC 24 -#define RETCURRDISK 25 -#define SETDMAADDR 26 -#define GETALLOCVEC 27 -#define WRPROTDISK 28 -#define GETROVECTOR 29 -#define FSETATTRIB 30 -#define GETDPBADDR 31 -#define SETGETUSER 32 -#define FREADRANDOM 33 -#define FWRITERAND 34 -#define FCOMPSIZE 35 -#define SETRANDREC 36 -#define RESETDRIVE 37 -#define WRRANDFILL 38 - -#define BDOSDEFDR 0 /* BDOS Default (current) Drive Number */ -#define BDOSDRA 1 -#define BDOSDRB 2 -#define BDOSDRC 3 -#define BDOSDRD 4 -#define BDOSDRE 5 -#define BDOSDRF 6 -#define BDOSDRG 7 -#define BDOSDRH 8 - -struct FCB { - char drive; - char filename[8]; - char filetype[3]; - char filler[24]; -}; - \ No newline at end of file diff --git a/Apps/Source/cpmbdos.lib b/Apps/Source/cpmbdos.lib deleted file mode 100644 index a5c8db6f..00000000 --- a/Apps/Source/cpmbdos.lib +++ /dev/null @@ -1,174 +0,0 @@ -; cpmbdos.lib 1/19/2012 dwg - add READ$CON$BUF (10) -; cpmbdos.lib 1/15/2012 dwg - add more functions - -; -; Copyright (C) 2011-2012 Douglas Goodall Licensed under GPL Ver 3. -; -; This file is part of NuBiosDWG and is free software: you can -; redistribute it and/or modify it under the terms of the GNU -; General Public License as published by the Free Software Foundation, -; either version 3 of the License, or (at your option) any later version. -; This file is distributed in the hope that it will be useful, -; but WITHOUT ANY WARRANTY; without even the implied warranty of -; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -; GNU General Public License for more details. -; You should have received a copy of the GNU General Public License -; along with it. If not, see . -; - -; BDOS function codes - -TERMCPM equ 0 ; return to command line -CREAD equ 1 ; read a character -CWRITE equ 2 ; write a character -PRINTSTR equ 9 ; print string -READ$CON$BUF equ 10 ; read console buffer -RETVERNO equ 12 ; return version number -DSKRESET equ 13 ; disk reset -SELDSK equ 14 ; select disk -FOPEN equ 15 ; open file -FCLOSE equ 16 ; close file -FDELETE equ 19 ; delete file -READSEQ equ 20 ; read sequential -WRITESEQ equ 21 ; write sequential -FMAKE equ 22 ; make file -FRENAME equ 23 ; rename file -RETCURR equ 25 ; return current disk, 0=a -SETDMA equ 26 ; set dma address -WRITERAND equ 34 ; write random record -FCOMPSIZE equ 35 ; compute file size -SETRANDREC equ 36 ; set random record -RESETDRIVE equ 37 ; reset drive -WRITERANDZF equ 40 ; write random with zero fill - -OEMID equ 0E5h - -; File Control Block -DR$OFS equ 0 -F1$OFS equ DR$OFS+BYTESIZE -F2$OFS equ F1$OFS+BYTESIZE -F3$OFS equ F2$OFS+BYTESIZE -F4$OFS equ F3$OFS+BYTESIZE -F5$OFS equ F4$OFS+BYTESIZE -F6$OFS equ F5$OFS+BYTESIZE -F7$OFS equ F6$OFS+BYTESIZE -F8$OFS equ F7$OFS+BYTESIZE -T1$OFS equ F8$OFS+BYTESIZE -T2$OFS equ T1$OFS+BYTESIZE -T3$OFS equ T2$OFS+BYTESIZE -EX$OFS equ T3$OFS+BYTESIZE -S1$OFS equ EX$OFS+BYTESIZE -S2$OFS equ S1$OFS+BYTESIZE -RC$OFS equ S2$OFS+BYTESIZE -D0$OFS equ RC$OFS+BYTESIZE -CR$OFS equ DR$OFS+32 -R0$OFS equ CR$OFS+BYTESIZE -R1$OFS equ R0$OFS+BYTESIZE -R2$OFS equ R1$OFS+BYTESIZE -FCB$LEN equ R2$OFS+BYTESIZE - -; Memory Locations - -BDOS equ 5 ; entry point fo BDOS function calls -PRIFCB equ 5Ch ; primary file control block address -SECFCB equ 6Ch ; secondary file control block address -LENFCB equ 32 ; length of file control block -DEFBUF equ 80h ; address of default buffer - - -EXIT macro - mvi c,TERMCPM - call BDOS - endm - -conin macro - push b ; save context B&C - push d ; save context D&E - push h ; save context H&L - mvi c,CREAD ; set up for console input BDOS call - call BDOS ; call BDOS function entry point - pop h ; restore context H&L - pop d ; restore context D&E - pop b ; restore context B&C - endm - -conout macro char - enter ; save all context regs - mvi c,CWRITE ; set for console output BDOS call - mvi e,char ; place output character in E as required - call bdos ; call BDOS function entry point - leave ; restore all context regs - endm - -conouta macro - enter - mvi c,CWRITE - mov e,a - call bdos - leave - endm - -PRINT macro addr - enter - mvi c,PRINTSTR - lxi d,addr - call BDOS - leave - endm - -PTRPRT macro addr - enter ; save all context registers - lxi h,addr ; load the address parameter into H&L - mov e,m ; pick up LO byte of new pointer - inx h ; bump index register - mov d,m ; pick up HO byte of new pointer - mvi c,PRINTSTR ; assembled pointer used for printstring call - call BDOS - leave ; restore all context registers - endm - - -movfcb macro destn,source - lxi d,destn - lxi h,source - lxi b,LENFCB - ldir - endm - -copyfcb macro fcbname,source - local around - jmp around -fcbname ds 32 -around: - endm - -printf macro parmdata - local around - local string - print string - jmp around -string db parmdata - db '$' -around: - endm - -printmsg macro parmdata - enter - local around - local string - print string - jmp around -string db parmdata - db '$' -around: - leave - endm - -newfcb macro fcbname,drive,filename -fcbname db drive,filename - db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 - endm - - -; eof - cpmbdos.lib - \ No newline at end of file diff --git a/Apps/Source/cpmbind.h b/Apps/Source/cpmbind.h deleted file mode 100644 index ae14800b..00000000 --- a/Apps/Source/cpmbind.h +++ /dev/null @@ -1,684 +0,0 @@ -/* cpmbind.h 5/21/2012 dwg - added b1f0peek and b1f0poke */ -/* cpmbind.h 3/16/2012 dgw - created */ - - -#define CR 0x0d -#define LF 0x0a -#define ESC 27 - -#define BIOSAD 0x0e600 -#define pTermType 0x0E679 - -/*************************/ -/* BIOS Memory Locations */ -/*************************/ - -#define CURDRV 0x00004 -#define BIOSAD 0x0e600 - -#define pBOOT 0x0E600 -#define pWBOOT 0x0E603 -#define pCONST 0x0E606 -#define pCONIN 0x0E609 -#define pCONOUT 0x0E60C -#define pLIST 0x0E60F -#define pPUNCH 0x0E612 -#define pREADER 0x0E615 -#define pHOME 0x0E618 -#define pSELDSK 0x0E61B -#define pSETTRK 0x0E61E -#define pSETSEC 0x0E621 -#define pSETDMA 0x0E624 -#define pREAD 0x0E627 -#define pWRITE 0x0E62A -#define pLISTST 0x0E62D -#define pSECTRN 0x0E630 -#define pBNKSEL 0x0E633 -#define pGETLU 0x0E636 -#define pSETLU 0x0E639 -#define pGETINFO 0x0E63C -#define pB1F0PEEK 0x0E63F -#define pB1F0POKE 0x0E642 - -/* - -struct JMP { - unsigned char opcode; - unsigned int address; -}; - -struct BIOS { - struct JMP boot; - struct JMP wboot; - struct JMP const; - struct JMP conin; - struct JMP conout; - struct JMP list; - struct JMP punch; - struct JMP reader; - struct JMP home; - struct JMP seldsk; - struct JMP settrk; - struct JMP setsec; - struct JMP setdma; - struct JMP read; - struct JMP write; - struct JMP listst; - struct JMP sectrn; - struct JMP bnksel; - struct JMP getlu; - struct JMP setlu; - struct JMP getinfo; - struct JMP b1f0peek; - struct JMP b1f0poke; - struct JMP res1; - struct JMP res2; - - char rmj; - char rmn; - char rup; - char rtp; - char diskboot; - char bootdrive; - char timedate[6]; - char cpufreq; - char platform; - char dioplat; - char vduplt; - unsigned int romsize; - unsigned int ramsize; - char clrramdisk; - char dskyenable; - char uartenable; - char vduenable; - char fdenable; - char fdtrace; - char fdmedia; - char fdmediaalt; - char fdmauto; - char ideenable; - char idetrace; - char ide8bit; - unsigned int idecapacity; - char ppideenable; - char ppidetrace; - char ppide8bit; - unsigned int ppidecapacity; - char ppideslow; - char boottype; - char boot_timeout; - char boot_default; - unsigned int baudrate; - char clkdiv; - char memwait; - char iowait; - char cntlb0; - char cntlb1; - char sdenable; - char sdtrace; - unsigned int sdcapacity; - char sdcsio; - char sdcsiofast; - char defiobyte; - char termtype; - unsigned int revision; - char prpsdenable; - char prpsdtrace; - char prpsdcapacity; - char prpconenable; - unsigned int biossize; -}; - -*/ - -/* - - -*/ - -/* bioscall.h 3/10/2012 dwg - header file for bdoscall */ - - extern char irega; - extern unsigned int iregbc; - extern unsigned int iregde; - extern unsigned int ireghl; - extern bioscall(); - - -/*********************/ -/* BDOS Declarations */ -/*********************/ - -#define TERMCPM 0 -#define CONIN 1 -#define CWRITE 2 -#define DIRCONIO 6 -#define PRINTSTR 9 -#define RDCONBUF 10 -#define GETCONST 11 -#define RETVERNUM 12 -#define RESDISKSYS 13 -#define SELECTDISK 14 -#define FOPEN 15 -#define FCLOSE 16 -#define SEARCHFIRST 17 -#define SEARCHNEXT 18 -#define FDELETE 19 -#define FREADSEQ 20 -#define FWRITESEQ 21 -#define FMAKEFILE 22 -#define FRENAME 23 -#define RETLOGINVEC 24 -#define RETCURRDISK 25 -#define SETDMAADDR 26 -#define GETALLOCVEC 27 -#define WRPROTDISK 28 -#define GETROVECTOR 29 -#define FSETATTRIB 30 -#define GETDPBADDR 31 -#define SETGETUSER 32 -#define FREADRANDOM 33 -#define FWRITERAND 34 -#define FCOMPSIZE 35 -#define SETRANDREC 36 -#define RESETDRIVE 37 -#define WRRANDFILL 38 - -#define DRIVEA 0 - -/* bdoscall.h 3/10/2012 dwg - header file for bdoscall */ - - extern char drega; - extern unsigned int dregbc; - extern unsigned int dregde; - extern unsigned int dreghl; - extern bdoscall(); - -/* std.h 3/11/2012 dwg - c version of std.asm */ - -#define TERM_TTY 0 -#define TERM_ANSI 1 -#define TERM_WYSE 2 -#define TERM_VT52 3 - -#define DEV_MD 0x00 -#define DEV_FD 0x10 -#define DEV_IDE 0x20 -#define DEV_ATAPI 0x30 -#define DEV_PPIDE 0x40 -#define DEV_SD 0x50 -#define DEV_PRPSD 0x60 -#define DEV_PPPSD 0x70 -#define DEV_HDSK 0x80 - -#define PLT_N8VEM 1 -#define PLT_ZETA 2 -#define PLT_N8 3 - - -/* - - -; std.lib 2/21/2012 dwg - added TERM$VT52 - -; TRUE equ 1 -; FALSE equ 00 -; -; PRIMARY HARDWARE PLATFORMS -; PLT$N8VEM equ 1 ; N8VEM ECB Z80 SBC -; PLT$ZETA equ 2 ; ZETA Z80 SBC -; PLT$N8 equ 3 ; N8 (HOME COMPUTER) Z180 SBC -; -; BOOT STYLE -; BT$MENU equ 1 ; WAIT FOR MENU SELECTION AT LOADER PROMPT -; BT$AUTO equ 2 ; AUTO SELECT BOOT$DEFAULT AFTER BOOT$TIMEOUT -; -; VDU PLATFORM SELECTIONS -; -; -; VDUPLT$NONE equ 0 ; NO VDU -; VDUPLT$VDU equ 1 ; ORIGINAL ECB VDU (6545 CHIP) -; VDUPLT$VDUC equ 2 ; ECB VDU COLOR (PENDING HARDWARE DEVELOPMENT) -; VDUPLT$PROPIO equ 3 ; ECB PROPIO (NOT IMPLEMENTED) -; VDUPLT$N8 equ 4 ; N8 ONBOARD VIDEO SUBSYSTEM (NOT IMPLEMENTED) -; -; RAM DISK INITIALIZATION OPTIONS -; CLR$NEVER equ 0 ; NEVER CLEAR RAM DISK -; CLR$AUTO equ 1 ; CLEAR RAM DISK IF INVALID DIR ENTRIES -; CLR$ALWAYS equ 2 ; ALWAYS CLEAR RAM DISK -; -; -; ; DISK MAP SELECTION OPTIONS -; -; DM$ROM equ 1 ; ROM DRIVE PRIORITY -; DM$RAM equ 2 ; RAM DRIVE PRIORITY -; DM$FD equ 3 ; FLOPPY DRIVE PRIORITY -; DM$IDE equ 4 ; IDE DRIVE PRIORITY -; DM$PPIDE equ 5 ; PPIDE DRIVE PRIORITY -; DM$SD equ 6 ; SD DRIVE PRIORITY -; DM$PRPSD equ 7 ; PROPIO SD DRIVE PRIORITY -; -; -; ; FLOPPY DISK MEDIA SELECTIONS (ID'S MUST BE INDEX OF ENTRY IN FCD$TBL) -; -; -; FDM720 equ 0 ; 3.5" FLOPPY, 720KB, 2 SIDES, 80 TRKS, 9 SECTORS -; FDM144 equ 1 ; 3.5" FLOPPY, 1.44MB, 2 SIDES, 80 TRKS, 18 SECTORS -; FDM360 equ 2 ; 5.25" FLOPPY, 360KB, 2 SIDES, 40 TRKS, 9 SECTORS -; FDM120 equ 3 ; 3.5" FLOPPY, 1.2MB, 2 SIDES, 80 TRKS, 15 SECTORS -; -; -; ; DISK PLATFORM SELECTIONS -; -; DIOPLT$NONE equ 0 ; NO DISK IO HARDWARE -; DIOPLT$DISKIO equ 1 ; N8VEM ECB DISK IO BOARD -; DIOPLT$ZETA equ 2 ; ZETA BUILT-IN DISK IO SECTION -; DIOPLT$DIDE equ 3 ; N8VEM ECB DUAL IDE W/ FLOPPY BOARD -; DIOPLT$N8 equ 4 ; N8 BUILT-IN DISK IO SECTION -; DIOPLT$DISKIO3 equ 5 ; N8VEM ECB DISK IO V3 BOARD -; -; CONSOLE DEVICE CHOICES FOR LDRCON AND DBGCON IN CONFIG SETTINGS -; -; CON$UART equ 1 -; CON$VDU equ 2 -; CON$PRP equ 3 -; -; CONSOLE TERMINAL TYPE CHOICES -; -TERM$TTY equ 0 -TERM$ANSI equ 1 -TERM$WYSE equ 2 -TERM$VT52 equ 3 -; -; -; ; SYSTEM GENERATION SETTINGS -; -; SYS$CPM equ 1 ; CPM (IMPLIES BDOS + CCP) -; SYS$ZSYS equ 2 ; ZSYSTEM OS (IMPLIES ZSDOS + ZCPR) -; -; DOS$BDOS equ 1 ; BDOS -; DOS$ZDDOS equ 2 ; ZDDOS VARIANT OF ZSDOS -; DOS$ZSDOS equ 3 ; ZSDOS -; -; CP$CCP equ 1 ; CCP COMMAND PROCESSOR -; CP$ZCPR equ 2 ; ZCPR COMMAND PROCESSOR -; -; CONFIGURE DOS (DOS) AND COMMAND PROCESSOR (CP) BASED ON SYSTEM SETTING (SYS) -; -; -; #IFNDEF BLD$SYS -; SYS equ SYS$CPM -; #ELSE -; SYS equ BLD$SYS -; #ENDIF -; -; #IF (SYS == SYS$CPM) -; DOS equ DOS$BDOS -; CP equ CP$CCP -; #DEFINE OSLBL "CP/M-80 2.2C" -; #ENDIF -; -; #IF (SYS == SYS$ZSYS) -; DOS equ DOS$ZSDOS -; CP equ CP$ZCPR -; #DEFINE OSLBL "ZSYSTEM (ZSDOS 1.2, ZCPR 1.0)" -; #ENDIF -; -; -; ; INCLUDE VERSION AND BUILD SETTINGS -; -; #INCLUDE "ver.inc" ; ADD BIOSVER -; -; -; #INCLUDE "build.inc" ; INCLUDE USER CONFIG, ADD VARIANT, TIMESTAMP, & ROMSIZE -; -; -; #IF (PLATFORM NE PLT$N8) -; -; -; ; N8VEM HARDWARE IO PORT ADDRESSES AND MEMORY LOCATIONS -; MPCL$RAM equ 78H ; BASE IO ADDRESS OF RAM MEMORY PAGER CONFIGURATION LATCH -; MPCL$ROM equ 7CH ; BASE IO ADDRESS OF ROM MEMORY PAGER CONFIGURATION LATCH -; -; -; ; HARDWARE INTERFACES -; -; PIO 82C55 I/O IS DECODED TO PORT 60-67 -; PIOA equ 60H ; PORT A -; PIOB equ 61H ; PORT B -; PIOC equ 62H ; PORT C -; PIOX equ 63H ; PIO CONTROL PORT -; -; 16C550 SERIAL LINE UART -; -; SIO$BASE equ 68H -; SIO$RBR equ SIO$BASE + 0 ; DLAB=0: RCVR BUFFER REG (READ ONLY) -; SIO$THR equ SIO$BASE + 0 ; DLAB=0: XMIT HOLDING REG (WRITE ONLY) -; SIO$IER equ SIO$BASE + 1 ; DLAB=0: INT ENABLE REG -; SIO$IIR equ SIO$BASE + 2 ; INT IDENT REGISTER (READ ONLY) -; SIO$FCR equ SIO$BASE + 2 ; FIFO CONTROL REG (WRITE ONLY) -; SIO$LCR equ SIO$BASE + 3 ; LINE CONTROL REG -; SIO$MCR equ SIO$BASE + 4 ; MODEM CONTROL REG -; SIO$LSR equ SIO$BASE + 5 ; LINE STATUS REG -; SIO$MSR equ SIO$BASE + 6 ; MODEM STATUS REG -; SIO$SCR equ SIO$BASE + 7 ; SCRATCH REGISTER -; SIO$DLL equ SIO$BASE + 0 ; DLAB=1: DIVISOR LATCH (LS) -; SIO$DLM equ SIO$BASE + 1 ; DLAB=1: DIVISOR LATCH (MS) -; #ENDIF ; (PLATFORM NE PLT$N8) -; -; -; #IF (PLATFORM NE PLT$N8) -; -; -; ; Z180 REGISTERS -; -; -; CPU$IOBASE equ 40H ; ONLY RELEVANT FOR Z180 -; CPU$CNTLA0 equ CPU$IOBASE+$00 ;ASCI0 control A -; CPU$CNTLA1 equ CPU$IOBASE+$01 ;ASCI1 control A -; CPU$CNTLB0 equ CPU$IOBASE+$02 ;ASCI0 control B -; CPU$CNTLB1 equ CPU$IOBASE+$03 ;ASCI1 control B -; CPU$STAT0 equ CPU$IOBASE+$04 ;ASCI0 status -; CPU$STAT1 equ CPU$IOBASE+$05 ;ASCI1 status -; CPU$TDR0 equ CPU$IOBASE+$06 ;ASCI0 transmit -; CPU$TDR1 equ CPU$IOBASE+$07 ;ASCI1 transmit -; CPU$RDR0 equ CPU$IOBASE+$08 ;ASCI0 receive -; CPU$RDR1 equ CPU$IOBASE+$09 ;ASCI1 receive -; CPU$CNTR equ CPU$IOBASE+$0A ;CSI/O control -; CPU$TRDR equ CPU$IOBASE+$0B ;CSI/O transmit/receive -; CPU$TMDR0L equ CPU$IOBASE+$0C ;Timer 0 data lo -; CPU$TMDR0H equ CPU$IOBASE+$0D ;Timer 0 data hi -; CPU$RLDR0L equ CPU$IOBASE+$0E ;Timer 0 reload lo -; CPU$RLDR0H equ CPU$IOBASE+$0F ;Timer 0 reload hi -; CPU$TCR equ CPU$IOBASE+$10 ;Timer control -; CPU$ASEXT0 equ CPU$IOBASE+$12 ;ASCI0 extension control (Z8S180) -; CPU$ASEXT1 equ CPU$IOBASE+$13 ;ASCI1 extension control (Z8S180) -; CPU$TMDR1L equ CPU$IOBASE+$14 ;Timer 1 data lo -; CPU$TMDR1H equ CPU$IOBASE+$15 ;Timer 1 data hi -; CPU$RLDR1L equ CPU$IOBASE+$16 ;Timer 1 reload lo -; CPU$RLDR1H equ CPU$IOBASE+$17 ;Timer 1 reload hi -; CPU$FRC equ CPU$IOBASE+$18 ;Free running counter -; CPU$ASTC0L equ CPU$IOBASE+$1A ;ASCI0 Time constant lo (Z8S180) -; CPU$ASTC0H equ CPU$IOBASE+$1B ;ASCI0 Time constant hi (Z8S180) -; CPU$ASTC1L equ CPU$IOBASE+$1C ;ASCI1 Time constant lo (Z8S180) -; CPU$ASTC1H equ CPU$IOBASE+$1D ;ASCI1 Time constant hi (Z8S180) -; CPU$CMR equ CPU$IOBASE+$1E ;Clock multiplier (latest Z8S180) -; CPU$CCR equ CPU$IOBASE+$1F ;CPU control (Z8S180) -; CPU$SAR0L equ CPU$IOBASE+$20 ;DMA0 source addr lo -; CPU$SAR0H equ CPU$IOBASE+$21 ;DMA0 source addr hi -; CPU$SAR0B equ CPU$IOBASE+$22 ;DMA0 source addr bank -; CPU$DAR0L equ CPU$IOBASE+$23 ;DMA0 dest addr lo -; CPU$DAR0H equ CPU$IOBASE+$24 ;DMA0 dest addr hi -; CPU$DAR0B equ CPU$IOBASE+$25 ;DMA0 dest addr bank -; CPU$BCR0L equ CPU$IOBASE+$26 ;DMA0 byte count lo -; CPU$BCR0H equ CPU$IOBASE+$27 ;DMA0 byte count hi -; CPU$MAR1L equ CPU$IOBASE+$28 ;DMA1 memory addr lo -; CPU$MAR1H equ CPU$IOBASE+$29 ;DMA1 memory addr hi -; CPU$MAR1B equ CPU$IOBASE+$2A ;DMA1 memory addr bank -; CPU$IAR1L equ CPU$IOBASE+$2B ;DMA1 I/O addr lo -; CPU$IAR1H equ CPU$IOBASE+$2C ;DMA1 I/O addr hi -; CPU$IAR1B equ CPU$IOBASE+$2D ;DMA1 I/O addr bank (Z8S180) -; CPU$BCR1L equ CPU$IOBASE+$2E ;DMA1 byte count lo -; CPU$BCR1H equ CPU$IOBASE+$2F ;DMA1 byte count hi -; CPU$DSTAT equ CPU$IOBASE+$30 ;DMA status -; CPU$DMODE equ CPU$IOBASE+$31 ;DMA mode -; CPU$DCNTL equ CPU$IOBASE+$32 ;DMA/WAIT control -; CPU$IL equ CPU$IOBASE+$33 ;Interrupt vector load -; CPU$ITC equ CPU$IOBASE+$34 ;INT/TRAP control -; CPU$RCR equ CPU$IOBASE+$36 ;Refresh control -; CPU$CBR equ CPU$IOBASE+$38 ;MMU common base register -; CPU$BBR equ CPU$IOBASE+$39 ;MMU bank base register -; CPU$CBAR equ CPU$IOBASE+$3A ;MMU common/bank area register -; CPU$OMCR equ CPU$IOBASE+$3E ;Operation mode control -; CPU$ICR equ $3F ;I/O control register (not relocated) -; -; N8 ONBOARD I/O REGISTERS -; N8$IOBASE equ $80 -; PIO equ N8$IOBASE+$00 -; PIOA equ PIO+$00 ; PORT A -; PIOB equ PIO+$01 ; PORT B -; PIOC equ PIO+$02 ; PORT C -; PIOX equ PIO+$03 ; PIO CONTROL PORT -; PIO2 equ N8$IOBASE+$04 -; PIO2A equ PIO2+$00 ; PORT A -; PIO2B equ PIO2+$01 ; PORT B -; PIO2C equ PIO2+$02 ; PORT C -; PIO2X equ PIO2+$03 ; PIO CONTROL PORT -; -; RTC equ N8$IOBASE+$08 ;RTC latch and buffer -; FDC equ N8$IOBASE+$0C ;Floppy disk controller -; UTIL equ N8$IOBASE+$10 ;Floppy disk utility -; ACR equ N8$IOBASE+$14 ;auxillary control register -; RMAP equ N8$IOBASE+$16 ;ROM page register -; VDP equ N8$IOBASE+$18 ;Video Display Processor (TMS9918A) -; PSG equ N8$IOBASE+$1C ;Programmable Sound Generator (AY-3-8910) -; -; DEFACR equ $1B -; -; #ENDIF -; -; -; ; CHARACTER DEVICE FUNCTIONS -; -; -; CF$INIT equ 0 -; CF$IN equ 1 -; CF$IST equ 2 -; CF$OUT equ 3 -; CF$OST equ 4 -; -; DISK OPERATIONS -; DOP$READ equ 0 ; READ OPERATION -; DOP$WRITE equ 1 ; WRITE OPERATION -; DOP$FORMAT equ 2 ; FORMAT OPERATION -; DOP$READID equ 3 ; READ ID OPERATION -; -; DISK DRIVER FUNCTIONS -; DF$READY equ 1 -; DF$SELECT equ 2 -; DF$READ equ 3 -; DF$WRITE equ 4 -; DF$FORMAT equ 5 -; -; DISK DEVICES (ONLY FIRST NIBBLE RELEVANT, SECOND NIBBLE MUST BE ZERO) -; DEV$MD equ 000H -; DEV$FD equ 010H -; DEV$IDE equ 020H -; DEV$ATAPI equ 030H -; DEV$PPIDE equ 040H -; DEV$SD equ 050H -; DEV$PRPSD equ 060H -; -; IMG$START equ 00000H ; IMMUTABLE: ROM IMAGE AREA START -; IMG$END equ 08000H ; IMMUTABLE: ROM IMAGE AREA END -; -; PG0$LOC equ 00000H ; IMMUTABLE -; PG0$SIZ equ 00100H ; IMMUTABLE -; PG0$END equ PG0$LOC + PG0$SIZ -; PG0$IMG equ IMG$START ; IMMUTABLE -; LDR$LOC equ PG0$END -; LDR$SIZ equ 02000H - PG0$SIZ ; CONFIGURABLE -; LDR$END equ LDR$LOC + LDR$SIZ -; LDR$IMG equ PG0$IMG + PG0$SIZ -; CPM$LOC equ 0D000H ; CONFIGURABLE: LOCATION OF CPM FOR RUNNING SYSTEM -; CPM$END equ 10000H ; IMMUTABLE: TOP OF MEMORY -; CPM$SIZ equ CPM$END - CPM$LOC ; SIZE OF CPM IMAGE (CCP + BDOS + CBIOS (INCLUDING DATA)) -; CPM$ENT equ CPM$LOC + 01600H ; IMMUTABLE: CPM ENTRY POINT -; CPM$IMG equ LDR$IMG + LDR$SIZ ; START OF CONCATENATED CPM IMAGE -; DAT$SIZ equ DATASIZE ; FROM CONFIG FILE -; DAT$END equ CPM$END -; DAT$LOC equ DAT$END - DAT$SIZ -; BIOS$LOC equ CPM$ENT -; BIOS$END equ DAT$LOC -; BIOS$SIZ equ DAT$LOC - CPM$ENT -; MON$IMG equ CPM$IMG + CPM$SIZ ; LOCATION OF MONITOR BINARY IMAGE IN ROM -; MON$LOC equ 08000H ; LOCATION OF MONITOR FOR RUNNING SYSTEM -; MON$SIZ equ 01000H ; SIZE OF MONITOR BINARY IMAGE -; MON$END equ MON$LOC + MON$SIZ -; MON$DSKY equ MON$LOC ; MONITOR ENTRY (DSKY) -; MON$UART equ MON$LOC + 3 ; MONITOR ENTRY (UART) -; ROMX$LOC equ MON$IMG + MON$SIZ ; LOCATION OF ROM EXTENSION CODE -; -; -; ROMX$SIZ equ 02000H ; FIXED -; ROMX$END equ ROMX$LOC + ROMX$SIZ -; -; -; VDU$LOC equ ROMX$LOC + 0 ; LOCATION OF ROM VDU DRIVER -; -; -; CBIOS$BOOT equ BIOS$LOC + 0 -; CBIOS$WBOOT equ BIOS$LOC + 3 -; CBIOS$CONST equ BIOS$LOC + 6 -; CBIOS$CONIN equ BIOS$LOC + 9 -; CBIOS$CONOUT equ BIOS$LOC + 12 -; CBIOS$LIST equ BIOS$LOC + 15 -; CBIOS$PUNCH equ BIOS$LOC + 18 -; CBIOS$READER equ BIOS$LOC + 21 -; CBIOS$HOME equ BIOS$LOC + 24 -; CBIOS$SELDSK equ BIOS$LOC + 27 -; CBIOS$SETTRK equ BIOS$LOC + 30 -; CBIOS$SETSEC equ BIOS$LOC + 33 -; CBIOS$SETDMA equ BIOS$LOC + 36 -; CBIOS$READ equ BIOS$LOC + 39 -; CBIOS$WRITE equ BIOS$LOC + 42 -; CBIOS$LISTST equ BIOS$LOC + 45 -; CBIOS$SECTRN equ BIOS$LOC + 48 -; -; MEMORY CONFIGURATION -; -; MSIZE equ 59 ; CP/M VERSION MEMORY SIZE IN KILOBYTES -; -; "BIAS" IS ADDRESS OFFSET FROM 3400H FOR MEMORY SYSTEMS -; ; THAN 16K (REFERRED TO AS "B" THROUGHOUT THE TEXT) -; -; BIAS equ (MSIZE-20)*1024 -; CCP equ 3400H+BIAS ; BASE OF CCP -; BDOS equ CCP+806H ; BASE OF BDOS -; BIOS equ CCP+1600H ; BASE OF BIOS -; CCPSIZ equ 00800H -; -; #IF (PLATFORM == PLT$N8VEM) -; -; -; ; #DEFINE PLATFORM$NAME "N8VEM Z80 SBC" -; -; -; ; #ENDIF -; -; -; ; #IF (PLATFORM == PLT$ZETA) -; ; #DEFINE PLATFORM$NAME "ZETA Z80 SBC" -; ; #ENDIF -; -; -; ; #IF (PLATFORM == PLT$N8) -; ; #DEFINE PLATFORM$NAME "N8 Z180 SBC" -; ; #ENDIF -; -; #IF (DSKYENABLE) -; ; #DEFINE DSKYLBL ", DSKY" -; ; #ELSE -; ; #DEFINE DSKYLBL "" -; ; #ENDIF -; -; #IF (VDUENABLE) -; #DEFINE VDULBL ", VDU" -; #ELSE -; #DEFINE VDULBL "" -; #ENDIF -; -; #IF (DIOPLT NE DIOPLT$NONE) -; -; -; #IF (DIOPLT EQ DIOPLT$DISKIO) -; #DEFINE DIOLBL ", DISKIO" -; #ENDIF -; -; -; #IF (DIOPLT EQ DIOPLT$ZETA) -; #DEFINE DIOLBL "" -; #ENDIF -; -; -; #IF (DIOPLT EQ DIOPLT$DIDE) -; #DEFINE DIOLBL ", DUALIDE" -; #ENDIF -; -; -; #IF (DIOPLT EQ DIOPLT$N8) -; #DEFINE DIOLBL "" -; #ENDIF -; -; #IF (DIOPLT EQ DIOPLT$DISKIO3) -; #DEFINE DIOLBL ", DISKIO-V3" -; #ENDIF -; -; #ELSE -; #DEFINE DIOLBL "" -; #ENDIF -; -; -; ; #ENDIF -; -; -; #IF (FDENABLE) -; #IF (FDMAUTO) -; #DEFINE FDLBL ", FLOPPY (AUTOSIZE)" -; #ELSE -; #IF (FDMEDIA == FDM720) -; #DEFINE FDLBL ", FLOPPY (720KB)" -; #ENDIF -; #IF (FDMEDIA == FDM144) -; #DEFINE FDLBL ", FLOPPY (1.44MB)" -; #ENDIF -; #ENDIF -; #ELSE -; #DEFINE FDLBL "" -; #ENDIF -; -; -; #IF (IDEENABLE) -; #DEFINE IDELBL ", IDE" -; #ELSE -; #DEFINE IDELBL "" -; #ENDIF -; -; -; #IF (PPIDEENABLE) -; #DEFINE PPIDELBL ", PPIDE" -; #ELSE -; #DEFINE PPIDELBL "" -; #ENDIF -; -; #IF (SDENABLE) -; #DEFINE SDLBL ", SD CARD" -; #ELSE -; #DEFINE SDLBL "" -; #ENDIF -; -; -; #IF (PRPSDENABLE) -; #DEFINE PRPSDLBL ", PROPIO SD CARD" -; #ELSE -; #DEFINE PRPSDLBL "" -; #ENDIF -; -; -; ; .ECHO "Configuration: " -; ; .ECHO PLATFORM$NAME -; ; .ECHO DSKYLBL -; ; .ECHO VDULBL -; ; .ECHO DIOLBL -; ; .ECHO FDLBL -; ; .ECHO IDELBL -; ; .ECHO PPIDELBL -; ; .ECHO SDLBL -; ; .ECHO PRPSDLBL -; ; .ECHO "\n" -; ; -; -; eof - std.lib - -*/ - \ No newline at end of file diff --git a/Apps/Source/cpmbios.h b/Apps/Source/cpmbios.h deleted file mode 100644 index 9b4764fe..00000000 --- a/Apps/Source/cpmbios.h +++ /dev/null @@ -1,104 +0,0 @@ -/* cpmbios.h 6/ 4/2012 dwg - added bootlu */ -/* cpmbios.h 3/11/2012 dwg - added CURDRV */ - -/*************************/ -/* BIOS Memory Locations */ -/*************************/ - -#define CURDRV 0x00004 -#define BIOSAD 0x0e600 - -#define pBOOT 0x0E600 -#define pWBOOT 0x0E603 -#define pCONST 0x0E606 -#define pCONIN 0x0E609 -#define pCONOUT 0x0E60C -#define pLIST 0x0E60F -#define pPUNCH 0x0E612 -#define pREADER 0x0E615 -#define pHOME 0x0E618 -#define pSELDSK 0x0E61B -#define pSETTRK 0x0E61E -#define pSETSEC 0x0E621 -#define pSETDMA 0x0E624 -#define pREAD 0x0E627 -#define pWRITE 0x0E62A -#define pLISTST 0x0E62D -#define pSECTRN 0x0E630 -#define pBNKSEL 0x0E633 -#define pGETLU 0x0E636 -#define pSETLU 0x0E639 -#define pGETINFO 0x0E63C - -struct JMP { - unsigned char opcode; - unsigned int address; -}; - -struct BIOS { - struct JMP boot; - struct JMP wboot; - struct JMP const; - struct JMP conin; - struct JMP conout; - struct JMP list; - struct JMP punch; - struct JMP reader; - struct JMP home; - struct JMP seldsk; - struct JMP settrk; - struct JMP setsec; - struct JMP setdma; - struct JMP read; - struct JMP write; - struct JMP listst; - struct JMP sectrn; - struct JMP bnksel; - struct JMP getlu; - struct JMP setlu; - struct JMP getinfo; - struct JMP rsvd1; - struct JMP rsvd2; - struct JMP rsvd3; - struct JMP rsvd4; - -/* char diskboot; - char bootdrive; - int bootlu; */ - - char rmj; - char rmn; - char rup; - char rtp; -}; - - -struct DPH { - unsigned int xlt; - unsigned int rv1; - unsigned int rv2; - unsigned int rv3; - unsigned int dbf; - unsigned int dpb; - unsigned int csv; - unsigned int alv; - unsigned char sigl; - unsigned char sigu; - unsigned int current; - unsigned int number; -}; - -struct DPB { - unsigned int spt; - unsigned char bsh; - unsigned char blm; - unsigned char exm; - unsigned int dsm; - unsigned int drm; - unsigned char al0; - unsigned char al1; - unsigned int cks; - unsigned int off; -}; - - \ No newline at end of file diff --git a/Apps/Source/cpmbios.lib b/Apps/Source/cpmbios.lib deleted file mode 100644 index 82c80bea..00000000 --- a/Apps/Source/cpmbios.lib +++ /dev/null @@ -1,137 +0,0 @@ -; cpmbios.lib 2/20/2012 dwg - get$off, get$drm, and get$spt need c=drvnum -; cpmbios.lib 12/26/2011 dwg - - -; Copyright (C) 2011-2012 Douglas Goodall All Rights Reserved. -; For non-commercial use by N8VEM community - -XLT$OFS equ 0 ; Translate Table -RV1$OFS equ XLT$OFS+WORDSIZE ; Reserved Field 1 -RV2$OFS equ RV1$OFS+WORDSIZE ; Reserved Field 2 -RV3$OFS equ RV2$OFS+WORDSIZE ; Reserved Field 3 -DBF$OFS equ RV3$OFS+WORDSIZE ; Directory Buffer -DPB$OFS equ DBF$OFS+WORDSIZE ; Diskk Parameter Block Pointer -CSV$OFS equ DPB$OFS+WORDSIZE ; Checksum Vector -ALV$OFS equ CSV$OFS+WORDSIZE ; Allocation Vector -DPH$LEN equ ALV$OFS+WORDSIZE ; size of normal DPH -LU1$OFS equ ALV$OFS+WORDSIZE ; Logical Unit Signature Byte 1 'L' -LU2$OFS equ LU1$OFS+BYTESIZE ; Logical Unit Signature Byte 2 'U' -CUR$OFS equ LU2$OFS+BYTESIZE ; Current Logical Unit (default) -NLU$OFS equ CUR$OFS+WORDSIZE ; Number of LU's (capacity/9) - - -SPT$OFS equ 0 ; Sectors Per Track -BSH$OFS equ SPT$OFS+WORDSIZE ; Block Shift Factor -BLM$OFS equ BSH$OFS+BYTESIZE ; Data Allocation Block Mask -EXM$OFS equ BLM$OFS+BYTESIZE ; Extend Mask -DSM$OFS equ EXM$OFS+BYTESIZE ; Disk Size Max -DRM$OFS equ DSM$OFS+WORDSIZE ; Number of Directory Entries -AL0$OFS equ DRM$OFS+WORDSIZE ; Allocation bitmask for directories -AL1$OFS equ AL0$OFS+BYTESIZE ; Allocation bitmask for directories -CKS$OFS equ AL1$OFS+BYTESIZE ; Size of Directory Check Vector -OFF$OFS equ CKS$OFS+WORDSIZE ; Number of Reserved Tracks -DPB$LEN equ OFF$OFS+WORDSIZE ; Disk Parameter Block Length - -; BIOS Memory Locations -BIBOOT equ 0E600h -BIWBOOT equ 0E603h -BICONST equ 0E606h -BICONIN equ 0E609h -BICONOUT equ 0E60Ch -BILIST equ 0E60Fh -BIPUNCH equ 0E612h -BIREADER equ 0E615h -BIHOME equ 0E618h -BISELDSK equ 0E61Bh -BISETTRK equ 0E61Eh -BISETSEC equ 0E621h -BISETDMA equ 0E624h -BIREAD equ 0E627h -BIWRITE equ 0E62Ah -BILISTST equ 0E62Dh -BISECTRN equ 0E630h - -; These are rel zero drive number for talking to the BIOS -; BDOS typically uses rel one drive codes - -BIDRVA equ 0 -BIDRVB equ 1 -BIDRVC equ 2 -BIDRVD equ 3 -BIDRVE equ 4 -BIDRVF equ 5 -BIDRVG equ 6 -BIDRVH equ 7 - -; On entry: c=drive number -get$spt macro - push psw - push b - push d - call BISELDSK - lxi d,DPB$OFS - dad d - mov e,m - inx h - mov d,m - xchg - lxi d,SPT$OFS - dad d - mov e,m - inx h - mov d,m - xchg - pop d - pop b - pop psw - endm - -; On entry: c=drive number -get$drm macro - push psw - push b - push d - call BISELDSK - lxi d,DPB$OFS - dad d - mov e,m - inx h - mov d,m - xchg - lxi d,DRM$OFS - dad d - mov e,m - inx h - mov d,m - xchg - pop d - pop b - pop psw - endm - -; On entry, c=drive number -get$off macro - push psw - push b - push d - call BISELDSK - lxi d,DPB$OFS - dad d - mov e,m - inx h - mov d,m - xchg - lxi d,OFF$OFS - dad d - mov e,m - inx h - mov d,m - xchg - pop d - pop b - pop psw - endm - - - -; eof - cpmbios.lib - \ No newline at end of file diff --git a/Apps/Source/cpmname.c b/Apps/Source/cpmname.c deleted file mode 100644 index 0e8c66c4..00000000 --- a/Apps/Source/cpmname.c +++ /dev/null @@ -1,286 +0,0 @@ -/* cpmname.c 5/21/2012 dwg - */ - -#include "applvers.h" -#include "infolist.h" -#include "cnfgdata.h" -#include "syscfg.h" -#include "diagnose.h" -#include "std.h" - -#define HIGHSEG 0xC000 /* memory address of system config */ - -#define GETSYSCFG 0xF000 /* HBIOS function for Get System Configuration */ - -char None[] = "*None*"; -char Unk[] = "*Unknown*"; -char * PltName[] = {None, "N8VEM Z80", "ZETA Z80", "N8 Z180"}; -char * CIOName[] = {"UART", "ASCI", "VDU", "CVDU", "UPD7220", - "N8V", "PRPCON", "PPPCON", Unk, Unk, Unk, Unk, Unk, - "CRT", "BAT", "NUL"}; -char * DIOName[] = {"MD", "FD", "IDE", "ATAPI", "PPIDE", - "SD", "PRPSD", "PPPSD", "HDSK"}; -char * VDAName[] = {None, "VDU", "CVDU", "UPD7220", "N8V"}; -char * EmuName[] = {None, "TTY", "ANSI"}; -char * TermName[] = {"TTY", "ANSI", "WYSE", "VT52"}; -char * DiskMapName[] = {None, "ROM", "RAM", "FD", "IDE", - "PPIDE", "SD", "PRPSD", "PPPSD", "HDSK"}; -char * ClrRamName[] = {"Never", "Auto", "Always"}; -char * FDModeName[] = {None, "DIO", "ZETA", "DIDE", "N8", "DIO3"}; -char * FDMediaName[] = {"720K", "1.44M", "360K", "1.2M", "1.11M"}; -char * IDEModeName[] = {None, "DIO", "DIDE"}; - -char hexchar(val, bitoff) -{ - static char hexmap[] = "0123456789ABCDEF"; - - return hexmap[(val >> bitoff) & 0xF]; -} - -char * fmthexbyte(val, buf) - unsigned char val; - char * buf; -{ - buf[0] = hexchar(val, 4); - buf[1] = hexchar(val, 0); - buf[2] = '\0'; - - return buf; -} - -char * fmthexword(val, buf) - unsigned int val; - char * buf; -{ - buf[0] = hexchar(val, 12); - buf[1] = hexchar(val, 8); - fmthexbyte(val, buf + 2); - - return buf; -} - -char * fmtbool(val) - unsigned char val; -{ - return (val ? "True" : "False"); -} - -char * fmtenable(val) - unsigned char val; -{ - return (val ? "Enabled" : "Disabled"); -} - -putscpm(p) - char * p; -{ - while (*p != '$') - putchar(*(p++)); -} - -pager() -{ - static int line = 1; - int i; - - line++; - printf("\r\n"); - - if(line >= 24) - { - printf("*** Press any key to continue..."); - while (bdos(6, 0xFF) == 0); - putchar('\r'); - for (i = 0; i < 40; i++) {putchar(' ');} - putchar('\r'); - line = 1; - } -} - -prtcfg1(pSysCfg) - struct SYSCFG * pSysCfg; -{ - struct CNFGDATA * pCfg; - char buf[5]; - char buf2[5]; - - pCfg = &(pSysCfg->cnfgdata); - - printf("%s @ %dMHz, RAM=%dMB, ROM=%dMB", - PltName[pCfg->platform], - pCfg->freq, - pCfg->ramsize, - pCfg->romsize); - pager(); - printf("RomWBW Version %d.%d.%d.%d, ", - pCfg->rmj, pCfg->rmn, - pCfg->rup, pCfg->rtp); - putscpm((unsigned int)pSysCfg + (unsigned int)pSysCfg->tstloc); - pager(); - if (pCfg->diskboot) - printf("Disk Boot Device=%s, Unit=%d, LU=%d", - DIOName[pCfg->devunit >> 4], - pCfg->devunit & 0xF, pCfg->bootlu); - else - printf("ROM Boot"); - pager(); - pager(); - - printf("Console: Default=%s:%d, Alternate=%s:%d, Init Baudrate=%d0", - CIOName[(pCfg->defcon) >> 4], pCfg->defcon & 0xF, - CIOName[(pCfg->altcon) >> 4], pCfg->altcon & 0xF, - pCfg->conbaud); - pager(); - printf ("Default Video Display: %s, Default Emulation: %s", - VDAName[(pCfg->defvda) >> 4], EmuName[pCfg->defemu]); - pager(); - printf ("Current Terminal Type: %s", - TermName[pCfg->termtype]); - pager(); - - printf("Default IO Byte=0x%s, Alternate IO Byte=0x%s", - fmthexbyte(pCfg->defiobyte, buf), - fmthexbyte(pCfg->altiobyte, buf2)); - pager(); - printf("Disk Write Caching=%s, Disk IO Tracing=%s", - fmtbool(pCfg->wrtcache), fmtbool(pCfg->dsktrace)); - pager(); - printf("Disk Mapping Priority: %s, Clear RAM Disk: %s", - DiskMapName[pCfg->dskmap], ClrRamName[pCfg->clrramdsk]); - pager(); - pager(); - - printf("DSKY %s", fmtenable(pCfg->dskyenable)); - pager(); - if (pCfg->uartenable) - { - printf("UART Enabled"); - pager(); - if (pCfg->uartcnt >= 1) - printf("UART0 FIFO=%s, AFC=%s, Baudrate=%d0", - fmtbool(pCfg->uart0fifo), fmtbool(pCfg->uart0afc), pCfg->uart0baud); - if (pCfg->uartcnt >= 2) - printf("UART1 FIFO=%s, AFC=%s, Baudrate=%d0", - fmtbool(pCfg->uart1fifo), fmtbool(pCfg->uart1afc), pCfg->uart1baud); - if (pCfg->uartcnt >= 3) - printf("UART2 FIFO=%s, AFC=%s, Baudrate=%d0", - fmtbool(pCfg->uart2fifo), fmtbool(pCfg->uart2afc), pCfg->uart2baud); - if (pCfg->uartcnt >= 4) - printf("UART3 FIFO=%s, AFC=%s, Baudrate=%d0", - fmtbool(pCfg->uart3fifo), fmtbool(pCfg->uart3afc), pCfg->uart3baud); - } - else - printf("UART Disabled"); - pager(); - if (pCfg->ascienable) - { - printf("ASCI Enabled"); - pager(); - printf("ASCI0, Baudrate=%d0", pCfg->asci0baud); - printf("ASCI1, Baudrate=%d0", pCfg->asci1baud); - } - else - printf("ASCI Disabled"); - pager(); - printf("VDU %s", fmtenable(pCfg->vduenable)); - pager(); - printf("CVDU %s", fmtenable(pCfg->cvduenable)); - pager(); - printf("UPD7220 %s", fmtenable(pCfg->upd7220enable)); - pager(); - printf("N8V %s", fmtenable(pCfg->n8venable)); - pager(); - pager(); -} - -prtcfg2(pSysCfg) - struct SYSCFG * pSysCfg; -{ - struct CNFGDATA * pCfg; - char buf[5]; - char buf2[5]; - - pCfg = &(pSysCfg->cnfgdata); - - printf("FD %s, Mode=%s, TraceLevel=%d, Media=%s/%s, Auto=%s", - fmtenable(pCfg->fdenable), FDModeName[pCfg->fdmode], - pCfg->fdtrace, - FDMediaName[pCfg->fdmedia], FDMediaName[pCfg->fdmediaalt], - fmtbool(pCfg->fdmauto)); - pager(); - printf("IDE %s, Mode=%s, TraceLevel=%d, 8bit=%s, Size=%dMB", - fmtenable(pCfg->ideenable), IDEModeName[pCfg->idemode], - pCfg->idetrace, fmtbool(pCfg->ide8bit), pCfg->idecapacity); - pager(); - printf("PPIDE %s, IOBase=0x%s, TraceLevel=%d, 8bit=%s, Slow=%s, Size=%dMB", - fmtenable(pCfg->ppideenable), fmthexbyte(pCfg->ppideiob, buf), - pCfg->ppidetrace, fmtbool(pCfg->ppide8bit), - fmtbool(pCfg->ppideslow), pCfg->ppidecapacity); - pager(); - printf("PRP %s, SD %s, TraceLevel=%d, Size=%dMB, Console %s", - fmtenable(pCfg->prpenable), fmtenable(pCfg->prpsdenable), - pCfg->prpsdtrace, pCfg->prpsdcapacity, - fmtenable(pCfg->prpconenable)); - pager(); - printf("PPP %s, SD %s, TraceLevel=%d, Size=%dMB, Console %s", - fmtenable(pCfg->pppenable), fmtenable(pCfg->pppsdenable), - pCfg->pppsdtrace, pCfg->pppsdcapacity, - fmtenable(pCfg->pppconenable)); - pager(); - printf("HDSK %s, TraceLevel=%d, Size=%dMB", - fmtenable(pCfg->hdskenable), - pCfg->hdsktrace, pCfg->hdskcapacity); - pager(); - pager(); - - printf("PPK %s, TraceLevel=%d", - fmtenable(pCfg->ppkenable), pCfg->ppktrace); - pager(); - printf("KBD %s, TraceLevel=%d", - fmtenable(pCfg->kbdenable), pCfg->kbdtrace); - pager(); - pager(); - - printf("TTY %s", fmtenable(pCfg->ttyenable)); - pager(); - printf("ANSI %s, TraceLevel=%d", - fmtenable(pCfg->ansienable), pCfg->ansitrace); - pager(); -} - -int main(argc,argv) - int argc; - char *argv[]; -{ - struct INFOLIST * pInfoList; - struct SYSCFG * pSysCfg; - - printf("CPMNAME.COM %d/%d/%d v%d.%d.%d (%d)", - A_MONTH,A_DAY,A_YEAR,A_RMJ,A_RMN,A_RUP,A_RTP); - printf(" dwg - Display System Configuration"); - pager(); - pager(); - - pInfoList = bioshl(20, 0, 0); - - putscpm(pInfoList->banptr); - pager(); - pager(); - - pSysCfg = HIGHSEG; - hregbc = GETSYSCFG; /* function = Get System Config */ - hregde = pSysCfg; /* addr of dest (must be high) */ - diagnose(); /* invoke the HBIOS function */ - - if (pSysCfg->marker != CFGMARKER) - { - printf("*** Invalid configuration data ***\r\n"); - return; - } - - prtcfg1(pSysCfg); - prtcfg2(pSysCfg); -} - -/********************/ -/* eof - ccpmname.c */ -/********************/ diff --git a/Apps/Source/ctermcap.c b/Apps/Source/ctermcap.c deleted file mode 100644 index 04baf9c4..00000000 --- a/Apps/Source/ctermcap.c +++ /dev/null @@ -1,99 +0,0 @@ -/* ctermcap.c 3/11/2012 dwg - terminal capbility file */ - -#include "stdio.h" -#include "stdlib.h" -#include "cpmbind.h" -#include "applvers.h" -#include "cnfgdata.h" -#include "syscfg.h" -#include "diagnose.h" - -char termtype; - - - -char wy50row[24] = { ' ', '!', '"', '#', '$', '%', '&', 39, - '(', ')', '*', '+', ',', '-', '.', '/', - '0', '1', '2', '3', '4', '5', '6', '7' }; - -char wy50col[80] = { ' ', '!', '"', '#', '$', '%', '&', 39, - '(', ')', '*', '+', ',', '-', '.', '/', - '0', '1', '2', '3', '4', '5', '6', '7', - '8', '9', ':', ';', '<', '=', '>', '?', - '@', 'A', 'B', 'C', 'D', 'E', 'F', 'G', - 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', - 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', - 'X', 'Y', 'Z', '[', '\\', ']', '^', '_', - 96, 'a', 'b', 'c', 'd', 'e', 'f', 'g', - 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o' }; - - - -crtinit(tt) - char tt; -{ - termtype = tt; -} - -crtclr() -{ - int i; - - switch(termtype) { - case TERM_TTY: - for(i=0;i<43;i++) { - printf("%c%c",CR,LF); - } - break; - case TERM_ANSI: - printf("%c[2J",ESC); - break; - case TERM_WYSE: - printf("%c+",ESC); - break; - case TERM_VT52: - printf("%cJ%cH",ESC,ESC); - break; - }; -} - -crtlc(line,col) -int line; -int col; -{ - int i; - - switch(termtype) { - case TERM_TTY: - break; - case TERM_ANSI: - printf("%c[%d;%d%c",ESC,line,col,0x66); - break; - case TERM_WYSE: - printf("%c=%c%c",ESC,wy50row[line-1],wy50col[col-1]); - break; - case TERM_VT52: - printf("%cY%c%c",ESC,' '+line,' '+col); - break; - }; -} - -/* - -wy50row db ' !"#$%&' - db 39 - db '()*+,-./01234567' - -wy50col db ' !"#$%&' - db 39 - db '()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_' - db 96 - db 'abcdefghijklmno' - -*/ - - -/********************/ -/* eof - ctermcap.c */ -/********************/ - \ No newline at end of file diff --git a/Apps/Source/ctermcap.h b/Apps/Source/ctermcap.h deleted file mode 100644 index ed706792..00000000 --- a/Apps/Source/ctermcap.h +++ /dev/null @@ -1,6 +0,0 @@ -/* ctermcap.h 3/11/2012 dwg - declarations for termal capability */ - -extern crtinit(); /* void crtinit(char termtype); */ -extern crtclr(); /* void crtclr(void); */ -extern crtlc(); /* void crtlc(char line,char column); */ - \ No newline at end of file diff --git a/Apps/Source/cvt2h.c b/Apps/Source/cvt2h.c deleted file mode 100644 index 0ecdc136..00000000 --- a/Apps/Source/cvt2h.c +++ /dev/null @@ -1,45 +0,0 @@ -/* cvt2h.h 7/11/2012 dwg - Copyright (C) 2012 Douglas Goodall */ - -/* This is an include file for a function which takes a pointer, - a length, and a filename, and converts a buffer into a C - header file that can be later incuded in some other compilation. */ - -#include "stdio.h" -#include "visible.h" - -cvt2h(buffer,length,name) - unsigned char * buffer; - int length; - char * name; -{ - FILE * fd; - int i,j,k,l; - char szTemp[32]; - fd = fopen(name,"w"); - fprintf(fd, - "/* %s produced automatically by cvt2h.h */\n",name); - strcpy(szTemp,name); - szTemp[8] = 0; - fprintf(fd, - "unsigned char %s[%d] = {\n\t", - szTemp,length); - for(i=0;i> 8; - device = devunit & 0xf0; - unit = devunit & 0x0f; - if(DEV_FD == device) { - gFDNums[gNumFD] = drive; - gbFD[gNumFD++] = iregbc & 0xff; - } - drive++; - } -} - - -int main(argc,argv) - int argc; - char *argv[] ; -{ - char drive; - int fd0,fd1; - int i; - int spt; - int track; - int tracks; - int bValid; - - sensefd(); - - if(2 != gNumFD) { - printf("Sorry, this version of diskcopy only supports dual drives"); - exit(FAILURE); - } - printf("The copy will be from drive %c: to drive %c:\n", - gFDNums[0]+'A',gFDNums[1]+'A'); - - printf("The media in FD0 is "); - fd0 = diomed(DEV_FD); - switch(fd0) { - case MID_NONE: - printf("Drive is empty"); - break; - case MID_MDROM: - printf("a memory ROM drive"); - break; - case MID_MDRAM: - printf("a memory RAM drive"); - break; - case MID_HD: - printf("an HD drive"); - break; - case MID_FD720: - printf("a 720KB floppy disk"); - tracks = 80 * 2; - break; - case MID_FD144: - printf("a 1.44MB floppy disk"); - tracks = 80 * 2; - break; - case MID_FD360: - printf("a 360KB floppy disk"); - tracks = 40 * 2; - break; - case MID_FD120: - printf("a 120KB floppy disk"); - tracks = 80 * 2; - break; - case MID_FD111: - printf("a 111KB floppy disk"); - tracks = 74 * 2; - break; - default: - printf("an unknown media type"); - break; - } - printf("\n"); - - - - printf("The media in FD1 is "); - fd1 = diomed(DEV_FD+1); - switch(fd1) { - case MID_NONE: - printf("Drive is empty"); - break; - case MID_MDROM: - printf("a memory ROM drive"); - break; - case MID_MDRAM: - printf("a memory RAM drive"); - break; - case MID_HD: - printf("an HD drive"); - break; - case MID_FD720: - printf("a 720KB floppy disk"); - break; - case MID_FD144: - printf("a 1.44MB floppy disk"); - break; - case MID_FD360: - printf("a 360KB floppy disk"); - break; - case MID_FD120: - printf("a 120KB floppy disk"); - break; - case MID_FD111: - printf("a 111KB floppy disk"); - break; - default: - printf("an unknown media type"); - break; - } - printf("\n"); - - if(fd0 != fd1) { - printf("Sorry, media types don't match, as required for diskcopy"); - exit(1); - } - - for(track=0;trackdpb; - spt = pDPB->spt; - ireghl = pSETTRK; - iregbc = track; - bioscall(); - printf("%3d ",track); - rdtrack(0,spt,buffer); - printf("%c",0x0d); - - bValid = FALSE; - for(i=0;idpb; - spt = pDPB->spt; - ireghl = pSETTRK; - iregbc = track; /* Track 0 */ - bioscall(); - printf("%3d ",track); - wrtrack(0,spt,buffer); - printf("%c",0x0d); - - } - - } -} - \ No newline at end of file diff --git a/Apps/Source/doit.c b/Apps/Source/doit.c deleted file mode 100644 index 80af4737..00000000 --- a/Apps/Source/doit.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "stdio.h" - -main() -{ - FILE * fd; - fd = fopen("$$$.SUB","w"); - fprintf(fd,"%ca:getcfg\n",9); - fprintf(fd,"%ca:dump syscfg.bin\n",18); - fprintf(fd,"%ctype a:sect0000.h\n",17); - fclose(fd); -} - \ No newline at end of file diff --git a/Apps/Source/dphdpb.h b/Apps/Source/dphdpb.h deleted file mode 100644 index 01e69831..00000000 --- a/Apps/Source/dphdpb.h +++ /dev/null @@ -1,30 +0,0 @@ - -struct DPH { - unsigned int xlt; - unsigned int rv1; - unsigned int rv2; - unsigned int rv3; - unsigned int dbf; - void * dpb; - void * csv; - void * alv; - /* extension */ - unsigned char sigl; - unsigned char sigu; - unsigned int current; - unsigned int number; -}; - -struct DPB { - unsigned int spt; - unsigned char bsh; - unsigned char blm; - unsigned char exm; - unsigned int dsm; - unsigned int drm; - unsigned char al0; - unsigned char al1; - unsigned int cks; - unsigned int off; -}; - \ No newline at end of file diff --git a/Apps/Source/dphmap.h b/Apps/Source/dphmap.h deleted file mode 100644 index 1fe765b4..00000000 --- a/Apps/Source/dphmap.h +++ /dev/null @@ -1,25 +0,0 @@ -/* dphmap.h 9/4/2012 dwg - expand to include I through L */ -/* dphmap.h 5/29/2012 dwg - declaration of DPH MAP structure */ - -struct DPHMAP { - struct DPH * drivea; - struct DPH * driveb; - struct DPH * drivec; - struct DPH * drived; - struct DPH * drivee; - struct DPH * drivef; - struct DPH * driveg; - struct DPH * driveh; - - struct DPH * drivei; - struct DPH * drivej; - struct DPH * drivek; - struct DPH * drivel; -} * pDPHMAP; - -struct DPHMAP * pDPHVEC[MAXDRIVE]; - - -/******************/ -/* eof - dphmap.h */ -/******************/ \ No newline at end of file diff --git a/Apps/Source/dump.c b/Apps/Source/dump.c deleted file mode 100644 index 77655006..00000000 --- a/Apps/Source/dump.c +++ /dev/null @@ -1,101 +0,0 @@ -/* dump.c 7/11/2012 dwg - - - The purpose of this program is similar to the CP/M dump program - except that in addition to the normal hexadecimal bytes, a field - of ascii bytes to the right are displayed as well. - -*/ - -#include "stdio.h" - - -char visible[256] = { - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 00 */ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 10 */ - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* 20 */ - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* 30 */ - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* 40 */ - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* 50 */ - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* 60 */ - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0, /* 70 */ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 80 */ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 90 */ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* A0 */ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* B0 */ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* C0 */ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* D0 */ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* E0 */ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 /* F0 */ -}; - -#include "cvt2h.h" -#include "cvt2inc.h" - -main(argc,argv) - int argc; - char *argv[]; -{ - int i,j; - int offset; - int result; - unsigned char byte; - unsigned char sector[128]; - char name[32]; - - - FILE * fd; - - banner("DUMP.COM"); - -/* cvt2h(0x0100,12*1024,"dumpcomh.h"); */ - - - if(1 == argc) { - printf("Sorry, no input file specified"); - exit(1); - } - - fd = fopen(argv[1],"r"); - if(NULL == fd) { - printf("Sorry, cannot open input file"); - exit(1); - } - - printf("Dumping %s\n\n",argv[1]); - - offset = 0; - result = fread(sector,sizeof(sector),1,fd); - while(0 < result) { - - sprintf(name,"sect%04x.h",offset); - cvt2h(sector,sizeof(sector),name); - sprintf(name,"sect%04x.inc",offset); - cvt2inc(sector,sizeof(sector),name); - - for(i=0;i<8;i++) { - printf("%04x: ",offset); - - - offset += 16; - for(j=0;j<16;j++) { - printf("%02x ",sector[(i*8)+j]); - } - printf(" "); - for(j=0;j<16;j++) { - byte = sector[(i*8)+j]; - if(1 == visible[byte]) { - printf("%c",byte); - } else { - printf("."); - } - } - printf("\n"); - } - printf("\n"); - result = fread(sector,sizeof(sector),1,fd); - } - fclose(fd); - - exit(0); -} - \ No newline at end of file diff --git a/Apps/Source/dumpcom.h b/Apps/Source/dumpcom.h deleted file mode 100644 index 688a57ba..00000000 --- a/Apps/Source/dumpcom.h +++ /dev/null @@ -1,1542 +0,0 @@ -/* dumpcom.h produced automatically by cvt2h.h Do Not Edit */ - -unsigned char dumpcom.[12288] = { - 0xc3, 0xe4, 0x12, 0x11, 0xdc, 0xff, 0xcd, 0xbe, - 0x26, 0x21, 0x1b, 0x02, 0xe5, 0x21, 0x32, 0x00, - 0x39, 0x5e, 0x23, 0x56, 0xd5, 0xcd, 0x40, 0x0d, - 0xd1, 0xd1, 0xeb, 0x21, 0x26, 0x00, 0x39, 0x73, - 0x23, 0x72, 0x21, 0x30, 0x00, 0x39, 0x5e, 0x23, - 0x56, 0xd5, 0x21, 0x1d, 0x02, 0xe5, 0x21, 0x2a, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, 0xcd, 0xe1, - 0x07, 0xd1, 0xd1, 0xd1, 0x21, 0x30, 0x00, 0x39, - 0x5e, 0x23, 0x56, 0xd5, 0x21, 0x06, 0x00, 0x39, - 0xe5, 0xcd, 0xbc, 0x25, 0xd1, 0xd1, 0x21, 0x00, - 0x00, 0xeb, 0x21, 0x0c, 0x00, 0x39, 0x73, 0x21, - 0x2e, 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, 0x21, - 0x06, 0x00, 0x39, 0xe5, 0x21, 0x56, 0x02, 0xe5, - 0x21, 0x2c, 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, - 0xcd, 0xe1, 0x07, 0xeb, 0x21, 0x08, 0x00, 0x39, - 0xf9, 0x21, 0x00, 0x00, 0xeb, 0x21, 0x24, 0x00, - 0x39, 0x73, 0x23, 0x72, 0xc3, 0x96, 0x01, 0x21, - 0x24, 0x00, 0x39, 0xe5, 0x7e, 0x23, 0x66, 0x6f, - 0x23, 0xeb, 0xe1, 0x73, 0x23, 0x72, 0x21, 0x24, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0x21, 0x2e, 0x00, - 0x39, 0x7e, 0x23, 0x66, 0x6f, 0xcd, 0xc6, 0x27, - 0xca, 0xfd, 0x01, 0x21, 0x2c, 0x00, 0x39, 0x5e, - 0x23, 0x56, 0x21, 0x24, 0x00, 0x39, 0x7e, 0x23, - 0x66, 0x6f, 0x19, 0x5e, 0x16, 0x00, 0xd5, 0x21, - 0x71, 0x02, 0xe5, 0x21, 0x2a, 0x00, 0x39, 0x5e, - 0x23, 0x56, 0xd5, 0xcd, 0xe1, 0x07, 0xd1, 0xd1, - 0xd1, 0x21, 0x24, 0x00, 0x39, 0x5e, 0x23, 0x56, - 0x21, 0x07, 0x00, 0xcd, 0x64, 0x27, 0xe5, 0x21, - 0x07, 0x00, 0xd1, 0xcd, 0x8c, 0x27, 0xca, 0xfa, - 0x01, 0x21, 0x7a, 0x02, 0xe5, 0x21, 0x28, 0x00, - 0x39, 0x5e, 0x23, 0x56, 0xd5, 0xcd, 0xe1, 0x07, - 0xd1, 0xd1, 0xc3, 0x87, 0x01, 0x21, 0x7d, 0x02, - 0xe5, 0x21, 0x28, 0x00, 0x39, 0x5e, 0x23, 0x56, - 0xd5, 0xcd, 0xe1, 0x07, 0xd1, 0xd1, 0x21, 0x26, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, 0xcd, 0x3a, - 0x10, 0xd1, 0xc9, 0x77, 0x00, 0x2f, 0x2a, 0x20, - 0x25, 0x73, 0x20, 0x70, 0x72, 0x6f, 0x64, 0x75, - 0x63, 0x65, 0x64, 0x20, 0x61, 0x75, 0x74, 0x6f, - 0x6d, 0x61, 0x74, 0x69, 0x63, 0x61, 0x6c, 0x6c, - 0x79, 0x20, 0x62, 0x79, 0x20, 0x63, 0x76, 0x74, - 0x32, 0x68, 0x2e, 0x68, 0x20, 0x44, 0x6f, 0x20, - 0x4e, 0x6f, 0x74, 0x20, 0x45, 0x64, 0x69, 0x74, - 0x20, 0x2a, 0x2f, 0x0a, 0x0a, 0x00, 0x75, 0x6e, - 0x73, 0x69, 0x67, 0x6e, 0x65, 0x64, 0x20, 0x63, - 0x68, 0x61, 0x72, 0x20, 0x25, 0x73, 0x5b, 0x25, - 0x64, 0x5d, 0x20, 0x3d, 0x20, 0x7b, 0x0a, 0x09, - 0x00, 0x30, 0x78, 0x25, 0x30, 0x32, 0x78, 0x2c, - 0x20, 0x00, 0x0a, 0x09, 0x00, 0x0a, 0x7d, 0x3b, - 0x0a, 0x00, 0x11, 0x55, 0xff, 0xcd, 0xbe, 0x26, - 0x21, 0x08, 0x05, 0xe5, 0xcd, 0xd3, 0x06, 0xd1, - 0x21, 0x11, 0x05, 0xe5, 0x21, 0x00, 0x30, 0xe5, - 0x21, 0x00, 0x01, 0xe5, 0xcd, 0x03, 0x01, 0xd1, - 0xd1, 0xd1, 0x21, 0x01, 0x00, 0xeb, 0x21, 0xb3, - 0x00, 0x39, 0x7e, 0x23, 0x66, 0x6f, 0xcd, 0x8c, - 0x27, 0xca, 0xc4, 0x02, 0x21, 0x1b, 0x05, 0xe5, - 0xcd, 0xc3, 0x07, 0xd1, 0x21, 0x01, 0x00, 0xe5, - 0xcd, 0x22, 0x15, 0xd1, 0x21, 0x3a, 0x05, 0xe5, - 0x21, 0xb7, 0x00, 0x39, 0x5e, 0x23, 0x56, 0xeb, - 0x23, 0x23, 0x5e, 0x23, 0x56, 0xd5, 0xcd, 0x40, - 0x0d, 0xd1, 0xd1, 0xeb, 0x21, 0x04, 0x00, 0x39, - 0x73, 0x23, 0x72, 0x21, 0x04, 0x00, 0x39, 0x7e, - 0x23, 0xb6, 0xc2, 0xfd, 0x02, 0x21, 0x3c, 0x05, - 0xe5, 0xcd, 0xc3, 0x07, 0xd1, 0x21, 0x01, 0x00, - 0xe5, 0xcd, 0x22, 0x15, 0xd1, 0x21, 0xb5, 0x00, - 0x39, 0x5e, 0x23, 0x56, 0xeb, 0x23, 0x23, 0x5e, - 0x23, 0x56, 0xd5, 0x21, 0x5a, 0x05, 0xe5, 0xcd, - 0xc3, 0x07, 0xd1, 0xd1, 0x21, 0x00, 0x00, 0xeb, - 0x21, 0xa9, 0x00, 0x39, 0x73, 0x23, 0x72, 0x21, - 0x04, 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, 0x21, - 0x01, 0x00, 0xe5, 0x21, 0x80, 0x00, 0xe5, 0x21, - 0x2c, 0x00, 0x39, 0xe5, 0xcd, 0x01, 0x0e, 0xeb, - 0x21, 0x08, 0x00, 0x39, 0xf9, 0x21, 0xa7, 0x00, - 0x39, 0x73, 0x23, 0x72, 0x21, 0x00, 0x00, 0xeb, - 0x21, 0xa7, 0x00, 0x39, 0x7e, 0x23, 0x66, 0x6f, - 0xcd, 0xc6, 0x27, 0xca, 0xf3, 0x04, 0x21, 0xa9, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, 0x21, 0x67, - 0x05, 0xe5, 0x21, 0x0a, 0x00, 0x39, 0xe5, 0xcd, - 0x22, 0x08, 0xd1, 0xd1, 0xd1, 0x21, 0x06, 0x00, - 0x39, 0xe5, 0x21, 0x80, 0x00, 0xe5, 0x21, 0x2a, - 0x00, 0x39, 0xe5, 0xcd, 0x03, 0x01, 0xd1, 0xd1, - 0xd1, 0x21, 0x00, 0x00, 0xeb, 0x21, 0xad, 0x00, - 0x39, 0x73, 0x23, 0x72, 0xc3, 0x9e, 0x03, 0x21, - 0xad, 0x00, 0x39, 0xe5, 0x7e, 0x23, 0x66, 0x6f, - 0x23, 0xeb, 0xe1, 0x73, 0x23, 0x72, 0x21, 0xad, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0x21, 0x08, 0x00, - 0xcd, 0xc6, 0x27, 0xca, 0xc3, 0x04, 0x21, 0xa9, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, 0x21, 0x72, - 0x05, 0xe5, 0xcd, 0xc3, 0x07, 0xd1, 0xd1, 0x21, - 0x10, 0x00, 0xeb, 0x21, 0xa9, 0x00, 0x39, 0xe5, - 0x7e, 0x23, 0x66, 0x6f, 0x19, 0xeb, 0xe1, 0x73, - 0x23, 0x72, 0x21, 0x00, 0x00, 0xeb, 0x21, 0xab, - 0x00, 0x39, 0x73, 0x23, 0x72, 0xc3, 0xef, 0x03, - 0x21, 0xab, 0x00, 0x39, 0xe5, 0x7e, 0x23, 0x66, - 0x6f, 0x23, 0xeb, 0xe1, 0x73, 0x23, 0x72, 0x21, - 0xab, 0x00, 0x39, 0x5e, 0x23, 0x56, 0x21, 0x10, - 0x00, 0xcd, 0xc6, 0x27, 0xca, 0x2a, 0x04, 0x21, - 0xad, 0x00, 0x39, 0x5e, 0x23, 0x56, 0xeb, 0x29, - 0x29, 0x29, 0xeb, 0x21, 0xab, 0x00, 0x39, 0x7e, - 0x23, 0x66, 0x6f, 0x19, 0xeb, 0x21, 0x26, 0x00, - 0x39, 0x19, 0x5e, 0x16, 0x00, 0xd5, 0x21, 0x79, - 0x05, 0xe5, 0xcd, 0xc3, 0x07, 0xd1, 0xd1, 0xc3, - 0xe0, 0x03, 0x21, 0x7f, 0x05, 0xe5, 0xcd, 0xc3, - 0x07, 0xd1, 0x21, 0x00, 0x00, 0xeb, 0x21, 0xab, - 0x00, 0x39, 0x73, 0x23, 0x72, 0xc3, 0x4f, 0x04, - 0x21, 0xab, 0x00, 0x39, 0xe5, 0x7e, 0x23, 0x66, - 0x6f, 0x23, 0xeb, 0xe1, 0x73, 0x23, 0x72, 0x21, - 0xab, 0x00, 0x39, 0x5e, 0x23, 0x56, 0x21, 0x10, - 0x00, 0xcd, 0xc6, 0x27, 0xca, 0xb8, 0x04, 0x21, - 0xad, 0x00, 0x39, 0x5e, 0x23, 0x56, 0xeb, 0x29, - 0x29, 0x29, 0xeb, 0x21, 0xab, 0x00, 0x39, 0x7e, - 0x23, 0x66, 0x6f, 0x19, 0xeb, 0x21, 0x26, 0x00, - 0x39, 0x19, 0x5e, 0x21, 0xa6, 0x00, 0x39, 0x73, - 0x21, 0xa6, 0x00, 0x39, 0x5e, 0x16, 0x00, 0x21, - 0x36, 0x28, 0x19, 0x5e, 0x16, 0x00, 0xd5, 0x21, - 0x01, 0x00, 0xd1, 0xcd, 0x8c, 0x27, 0xca, 0xad, - 0x04, 0x21, 0xa6, 0x00, 0x39, 0x5e, 0x16, 0x00, - 0xd5, 0x21, 0x82, 0x05, 0xe5, 0xcd, 0xc3, 0x07, - 0xd1, 0xd1, 0xc3, 0xb5, 0x04, 0x21, 0x85, 0x05, - 0xe5, 0xcd, 0xc3, 0x07, 0xd1, 0xc3, 0x40, 0x04, - 0x21, 0x87, 0x05, 0xe5, 0xcd, 0xc3, 0x07, 0xd1, - 0xc3, 0x8f, 0x03, 0x21, 0x89, 0x05, 0xe5, 0xcd, - 0xc3, 0x07, 0xd1, 0x21, 0x04, 0x00, 0x39, 0x5e, - 0x23, 0x56, 0xd5, 0x21, 0x01, 0x00, 0xe5, 0x21, - 0x80, 0x00, 0xe5, 0x21, 0x2c, 0x00, 0x39, 0xe5, - 0xcd, 0x01, 0x0e, 0xeb, 0x21, 0x08, 0x00, 0x39, - 0xf9, 0x21, 0xa7, 0x00, 0x39, 0x73, 0x23, 0x72, - 0xc3, 0x44, 0x03, 0x21, 0x04, 0x00, 0x39, 0x5e, - 0x23, 0x56, 0xd5, 0xcd, 0x3a, 0x10, 0xd1, 0x21, - 0x00, 0x00, 0xe5, 0xcd, 0x22, 0x15, 0xd1, 0xc9, - 0x44, 0x55, 0x4d, 0x50, 0x2e, 0x43, 0x4f, 0x4d, - 0x00, 0x64, 0x75, 0x6d, 0x70, 0x63, 0x6f, 0x6d, - 0x2e, 0x68, 0x00, 0x53, 0x6f, 0x72, 0x72, 0x79, - 0x2c, 0x20, 0x6e, 0x6f, 0x20, 0x69, 0x6e, 0x70, - 0x75, 0x74, 0x20, 0x66, 0x69, 0x6c, 0x65, 0x20, - 0x73, 0x70, 0x65, 0x63, 0x69, 0x66, 0x69, 0x65, - 0x64, 0x00, 0x72, 0x00, 0x53, 0x6f, 0x72, 0x72, - 0x79, 0x2c, 0x20, 0x63, 0x61, 0x6e, 0x6e, 0x6f, - 0x74, 0x20, 0x6f, 0x70, 0x65, 0x6e, 0x20, 0x69, - 0x6e, 0x70, 0x75, 0x74, 0x20, 0x66, 0x69, 0x6c, - 0x65, 0x00, 0x44, 0x75, 0x6d, 0x70, 0x69, 0x6e, - 0x67, 0x20, 0x25, 0x73, 0x0a, 0x0a, 0x00, 0x73, - 0x65, 0x63, 0x74, 0x25, 0x30, 0x34, 0x78, 0x2e, - 0x68, 0x00, 0x25, 0x30, 0x34, 0x78, 0x3a, 0x20, - 0x00, 0x25, 0x30, 0x32, 0x78, 0x20, 0x00, 0x20, - 0x20, 0x00, 0x25, 0x63, 0x00, 0x2e, 0x00, 0x0a, - 0x00, 0x0a, 0x00, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, - 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, - 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, - 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, - 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, - 0x2d, 0x2d, 0x2d, 0x00, 0x31, 0x32, 0x33, 0x34, - 0x35, 0x36, 0x37, 0x38, 0x2e, 0x31, 0x32, 0x33, - 0x20, 0x6d, 0x6d, 0x2f, 0x64, 0x64, 0x2f, 0x79, - 0x79, 0x79, 0x79, 0x20, 0x20, 0x56, 0x65, 0x72, - 0x73, 0x69, 0x6f, 0x6e, 0x20, 0x78, 0x2e, 0x78, - 0x2e, 0x78, 0x2e, 0x78, 0x00, 0x53, 0x2f, 0x4e, - 0x20, 0x43, 0x50, 0x4d, 0x38, 0x30, 0x2d, 0x44, - 0x57, 0x47, 0x2d, 0x36, 0x35, 0x34, 0x33, 0x32, - 0x31, 0x20, 0x4c, 0x69, 0x63, 0x65, 0x6e, 0x73, - 0x65, 0x64, 0x20, 0x75, 0x6e, 0x64, 0x65, 0x72, - 0x20, 0x47, 0x50, 0x4c, 0x33, 0x00, 0x43, 0x6f, - 0x70, 0x79, 0x72, 0x69, 0x67, 0x68, 0x74, 0x20, - 0x28, 0x43, 0x29, 0x20, 0x32, 0x30, 0x31, 0x31, - 0x2d, 0x31, 0x32, 0x20, 0x44, 0x6f, 0x75, 0x67, - 0x6c, 0x61, 0x73, 0x20, 0x57, 0x2e, 0x20, 0x47, - 0x6f, 0x6f, 0x64, 0x61, 0x6c, 0x6c, 0x00, 0x11, - 0x80, 0xff, 0xcd, 0xbe, 0x26, 0x21, 0x88, 0x00, - 0x39, 0x5e, 0x23, 0x56, 0xd5, 0x21, 0x85, 0x06, - 0xe5, 0xcd, 0xc3, 0x07, 0xd1, 0xd1, 0x21, 0xdc, - 0x07, 0xe5, 0x21, 0x07, 0x00, 0xe5, 0x21, 0x07, - 0x00, 0xe5, 0x21, 0x89, 0x06, 0xe5, 0xcd, 0xc3, - 0x07, 0xeb, 0x21, 0x08, 0x00, 0x39, 0xf9, 0x21, - 0x00, 0x00, 0xe5, 0x21, 0x00, 0x00, 0xe5, 0x21, - 0x00, 0x00, 0xe5, 0x21, 0x02, 0x00, 0xe5, 0x21, - 0x97, 0x06, 0xe5, 0xcd, 0xc3, 0x07, 0xeb, 0x21, - 0x0a, 0x00, 0x39, 0xf9, 0x21, 0xac, 0x06, 0xe5, - 0xcd, 0xc3, 0x07, 0xd1, 0xc9, 0x25, 0x73, 0x20, - 0x00, 0x25, 0x32, 0x64, 0x2f, 0x25, 0x32, 0x64, - 0x2f, 0x25, 0x34, 0x64, 0x20, 0x20, 0x00, 0x56, - 0x65, 0x72, 0x73, 0x69, 0x6f, 0x6e, 0x20, 0x25, - 0x64, 0x2e, 0x25, 0x64, 0x2e, 0x25, 0x64, 0x2e, - 0x25, 0x64, 0x20, 0x00, 0x43, 0x4f, 0x50, 0x52, - 0x20, 0x44, 0x6f, 0x75, 0x67, 0x6c, 0x61, 0x73, - 0x20, 0x47, 0x6f, 0x6f, 0x64, 0x61, 0x6c, 0x6c, - 0x20, 0x4c, 0x69, 0x63, 0x65, 0x6e, 0x73, 0x65, - 0x64, 0x20, 0x77, 0x2f, 0x47, 0x50, 0x4c, 0x76, - 0x33, 0x0a, 0x00, 0x11, 0x80, 0xff, 0xcd, 0xbe, - 0x26, 0x2a, 0x36, 0x29, 0xe5, 0x21, 0x8a, 0x07, - 0xe5, 0xcd, 0xc3, 0x07, 0xd1, 0xd1, 0x21, 0x88, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, 0x21, 0x06, - 0x00, 0x39, 0xe5, 0xcd, 0xbc, 0x25, 0xd1, 0xd1, - 0x21, 0x04, 0x00, 0x39, 0xe5, 0xcd, 0x15, 0x26, - 0xd1, 0xe5, 0x21, 0x0c, 0x00, 0xd1, 0xeb, 0xcd, - 0xc7, 0x27, 0xca, 0x1e, 0x07, 0x21, 0x8e, 0x07, - 0xe5, 0x21, 0x06, 0x00, 0x39, 0xe5, 0xcd, 0xd8, - 0x25, 0xd1, 0xd1, 0xc3, 0xf8, 0x06, 0x21, 0x04, - 0x00, 0x39, 0xe5, 0x21, 0x90, 0x07, 0xe5, 0xcd, - 0xc3, 0x07, 0xd1, 0xd1, 0x21, 0xdc, 0x07, 0xe5, - 0x21, 0x07, 0x00, 0xe5, 0x21, 0x07, 0x00, 0xe5, - 0x21, 0x94, 0x07, 0xe5, 0xcd, 0xc3, 0x07, 0xeb, - 0x21, 0x08, 0x00, 0x39, 0xf9, 0x21, 0x00, 0x00, - 0xe5, 0x21, 0x00, 0x00, 0xe5, 0x21, 0x00, 0x00, - 0xe5, 0x21, 0x02, 0x00, 0xe5, 0x21, 0xa2, 0x07, - 0xe5, 0xcd, 0xc3, 0x07, 0xeb, 0x21, 0x0a, 0x00, - 0x39, 0xf9, 0x2a, 0x3a, 0x29, 0xe5, 0x21, 0xb7, - 0x07, 0xe5, 0xcd, 0xc3, 0x07, 0xd1, 0xd1, 0x2a, - 0x3c, 0x29, 0xe5, 0x21, 0xbb, 0x07, 0xe5, 0xcd, - 0xc3, 0x07, 0xd1, 0xd1, 0x2a, 0x36, 0x29, 0xe5, - 0x21, 0xbf, 0x07, 0xe5, 0xcd, 0xc3, 0x07, 0xd1, - 0xd1, 0xc9, 0x25, 0x73, 0x0a, 0x00, 0x20, 0x00, - 0x25, 0x73, 0x20, 0x00, 0x25, 0x32, 0x64, 0x2f, - 0x25, 0x32, 0x64, 0x2f, 0x25, 0x34, 0x64, 0x20, - 0x20, 0x00, 0x56, 0x65, 0x72, 0x73, 0x69, 0x6f, - 0x6e, 0x20, 0x25, 0x64, 0x2e, 0x25, 0x64, 0x2e, - 0x25, 0x64, 0x2e, 0x25, 0x64, 0x0a, 0x00, 0x25, - 0x73, 0x0a, 0x00, 0x25, 0x73, 0x0a, 0x00, 0x25, - 0x73, 0x0a, 0x00, 0x11, 0x00, 0x00, 0xcd, 0xbe, - 0x26, 0x21, 0x0a, 0x00, 0x39, 0xe5, 0x21, 0x0a, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, 0x21, 0x59, - 0x0f, 0xe5, 0xcd, 0x79, 0x08, 0xd1, 0xd1, 0xd1, - 0xc9, 0x11, 0x00, 0x00, 0xcd, 0xbe, 0x26, 0x21, - 0x08, 0x00, 0x39, 0x5e, 0x23, 0x56, 0xeb, 0x22, - 0x64, 0x2b, 0x21, 0x0c, 0x00, 0x39, 0xe5, 0x21, - 0x0c, 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, 0x21, - 0x0a, 0x08, 0xe5, 0xcd, 0x79, 0x08, 0xd1, 0xd1, - 0xd1, 0xc9, 0x11, 0x00, 0x00, 0xcd, 0xbe, 0x26, - 0x2a, 0x64, 0x2b, 0xe5, 0x21, 0x0a, 0x00, 0x39, - 0x5e, 0x23, 0x56, 0xd5, 0xcd, 0x71, 0x0f, 0xd1, - 0xd1, 0xc9, 0x11, 0x00, 0x00, 0xcd, 0xbe, 0x26, - 0x21, 0x08, 0x00, 0x39, 0x5e, 0x23, 0x56, 0xeb, - 0x22, 0x66, 0x2b, 0x21, 0x0c, 0x00, 0x39, 0xe5, - 0x21, 0x0c, 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, - 0x21, 0x58, 0x08, 0xe5, 0xcd, 0x79, 0x08, 0xd1, - 0xd1, 0xd1, 0x44, 0x4d, 0x21, 0x00, 0x00, 0xe5, - 0x2a, 0x66, 0x2b, 0xd1, 0x73, 0x60, 0x69, 0xc9, - 0x11, 0x00, 0x00, 0xcd, 0xbe, 0x26, 0x21, 0x08, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, 0x2a, 0x66, - 0x2b, 0x23, 0x22, 0x66, 0x2b, 0x2b, 0xd1, 0x73, - 0x16, 0x00, 0x21, 0xff, 0x00, 0xcd, 0x64, 0x27, - 0xc9, 0x11, 0x38, 0xff, 0xcd, 0xbe, 0x26, 0x21, - 0xd0, 0x00, 0x39, 0x4e, 0x23, 0x46, 0x21, 0x00, - 0x00, 0x22, 0x6c, 0x2b, 0x21, 0xd4, 0x00, 0x39, - 0x5e, 0x23, 0x56, 0xeb, 0x22, 0x6a, 0x2b, 0x21, - 0xd2, 0x00, 0x39, 0xe5, 0x7e, 0x23, 0x66, 0x6f, - 0x23, 0xeb, 0xe1, 0x73, 0x23, 0x72, 0xeb, 0x2b, - 0x5e, 0x16, 0x00, 0xeb, 0x22, 0x68, 0x2b, 0x7c, - 0xb5, 0xca, 0x88, 0x0c, 0x2a, 0x68, 0x2b, 0x11, - 0x25, 0x00, 0xcd, 0x8c, 0x27, 0xca, 0x67, 0x0c, - 0x21, 0x00, 0x00, 0xeb, 0x21, 0x12, 0x00, 0x39, - 0x73, 0x21, 0x01, 0x00, 0x22, 0x6e, 0x2b, 0x21, - 0x20, 0x00, 0x22, 0x70, 0x2b, 0x21, 0x10, 0x27, - 0x22, 0x72, 0x2b, 0x21, 0xd2, 0x00, 0x39, 0xe5, - 0x7e, 0x23, 0x66, 0x6f, 0x23, 0xeb, 0xe1, 0x73, - 0x23, 0x72, 0xeb, 0x2b, 0x5e, 0x16, 0x00, 0xeb, - 0x22, 0x68, 0x2b, 0x11, 0x2d, 0x00, 0xcd, 0x8c, - 0x27, 0xca, 0x1a, 0x09, 0x21, 0x00, 0x00, 0x22, - 0x6e, 0x2b, 0x21, 0xd2, 0x00, 0x39, 0xe5, 0x7e, - 0x23, 0x66, 0x6f, 0x23, 0xeb, 0xe1, 0x73, 0x23, - 0x72, 0xeb, 0x2b, 0x5e, 0x16, 0x00, 0xeb, 0x22, - 0x68, 0x2b, 0x2a, 0x68, 0x2b, 0x11, 0x30, 0x00, - 0xcd, 0x8c, 0x27, 0xca, 0x44, 0x09, 0x21, 0x30, - 0x00, 0x22, 0x70, 0x2b, 0x21, 0xd2, 0x00, 0x39, - 0xe5, 0x7e, 0x23, 0x66, 0x6f, 0x23, 0xeb, 0xe1, - 0x73, 0x23, 0x72, 0xeb, 0x2b, 0x5e, 0x16, 0x00, - 0xeb, 0x22, 0x68, 0x2b, 0x2a, 0x68, 0x2b, 0x11, - 0x2a, 0x00, 0xcd, 0x8c, 0x27, 0xca, 0x7c, 0x09, - 0x2a, 0x6a, 0x2b, 0x23, 0x23, 0x22, 0x6a, 0x2b, - 0x2b, 0x2b, 0x5e, 0x23, 0x56, 0xeb, 0x22, 0x74, - 0x2b, 0x21, 0xd2, 0x00, 0x39, 0xe5, 0x7e, 0x23, - 0x66, 0x6f, 0x23, 0xeb, 0xe1, 0x73, 0x23, 0x72, - 0xeb, 0x2b, 0x5e, 0x16, 0x00, 0xeb, 0x22, 0x68, - 0x2b, 0xc3, 0xc9, 0x09, 0x21, 0x00, 0x00, 0x22, - 0x74, 0x2b, 0xc3, 0x9d, 0x09, 0x21, 0xd2, 0x00, - 0x39, 0xe5, 0x7e, 0x23, 0x66, 0x6f, 0x23, 0xeb, - 0xe1, 0x73, 0x23, 0x72, 0xeb, 0x2b, 0x5e, 0x16, - 0x00, 0xeb, 0x22, 0x68, 0x2b, 0x2a, 0x68, 0x2b, - 0x11, 0xdc, 0x2a, 0x19, 0x23, 0x5e, 0x16, 0x00, - 0x21, 0x04, 0x00, 0xcd, 0x64, 0x27, 0xca, 0xc9, - 0x09, 0x2a, 0x74, 0x2b, 0x11, 0x0a, 0x00, 0xcd, - 0x0d, 0x27, 0xeb, 0x2a, 0x68, 0x2b, 0x19, 0x11, - 0xd0, 0xff, 0x19, 0x22, 0x74, 0x2b, 0xc3, 0x85, - 0x09, 0x2a, 0x68, 0x2b, 0x11, 0x2e, 0x00, 0xcd, - 0x8c, 0x27, 0xca, 0x6f, 0x0a, 0x21, 0xd2, 0x00, - 0x39, 0xe5, 0x7e, 0x23, 0x66, 0x6f, 0x23, 0xeb, - 0xe1, 0x73, 0x23, 0x72, 0xeb, 0x2b, 0x5e, 0x16, - 0x00, 0xeb, 0x22, 0x68, 0x2b, 0x11, 0x2a, 0x00, - 0xcd, 0x8c, 0x27, 0xca, 0x22, 0x0a, 0x2a, 0x6a, - 0x2b, 0x23, 0x23, 0x22, 0x6a, 0x2b, 0x2b, 0x2b, - 0x5e, 0x23, 0x56, 0xeb, 0x22, 0x72, 0x2b, 0x21, - 0xd2, 0x00, 0x39, 0xe5, 0x7e, 0x23, 0x66, 0x6f, - 0x23, 0xeb, 0xe1, 0x73, 0x23, 0x72, 0xeb, 0x2b, - 0x5e, 0x16, 0x00, 0xeb, 0x22, 0x68, 0x2b, 0xc3, - 0x6f, 0x0a, 0x21, 0x00, 0x00, 0x22, 0x72, 0x2b, - 0xc3, 0x43, 0x0a, 0x21, 0xd2, 0x00, 0x39, 0xe5, - 0x7e, 0x23, 0x66, 0x6f, 0x23, 0xeb, 0xe1, 0x73, - 0x23, 0x72, 0xeb, 0x2b, 0x5e, 0x16, 0x00, 0xeb, - 0x22, 0x68, 0x2b, 0x2a, 0x68, 0x2b, 0x11, 0xdc, - 0x2a, 0x19, 0x23, 0x5e, 0x16, 0x00, 0x21, 0x04, - 0x00, 0xcd, 0x64, 0x27, 0xca, 0x6f, 0x0a, 0x2a, - 0x72, 0x2b, 0x11, 0x0a, 0x00, 0xcd, 0x0d, 0x27, - 0xeb, 0x2a, 0x68, 0x2b, 0x19, 0x11, 0xd0, 0xff, - 0x19, 0x22, 0x72, 0x2b, 0xc3, 0x2b, 0x0a, 0x21, - 0x02, 0x00, 0x22, 0x76, 0x2b, 0x2a, 0x68, 0x2b, - 0x11, 0x6c, 0x00, 0xcd, 0x8c, 0x27, 0xca, 0xa2, - 0x0a, 0x21, 0xd2, 0x00, 0x39, 0xe5, 0x7e, 0x23, - 0x66, 0x6f, 0x23, 0xeb, 0xe1, 0x73, 0x23, 0x72, - 0xeb, 0x2b, 0x5e, 0x16, 0x00, 0xeb, 0x22, 0x68, - 0x2b, 0x21, 0x04, 0x00, 0x22, 0x76, 0x2b, 0xc3, - 0xc6, 0x0a, 0x2a, 0x68, 0x2b, 0x11, 0x68, 0x00, - 0xcd, 0x8c, 0x27, 0xca, 0xc6, 0x0a, 0x21, 0xd2, - 0x00, 0x39, 0xe5, 0x7e, 0x23, 0x66, 0x6f, 0x23, - 0xeb, 0xe1, 0x73, 0x23, 0x72, 0xeb, 0x2b, 0x5e, - 0x16, 0x00, 0xeb, 0x22, 0x68, 0x2b, 0x2a, 0x68, - 0x2b, 0xc3, 0x56, 0x0b, 0x21, 0x08, 0x00, 0x22, - 0x78, 0x2b, 0xc3, 0xed, 0x0a, 0x21, 0x0a, 0x00, - 0x22, 0x78, 0x2b, 0xc3, 0xed, 0x0a, 0x21, 0x10, - 0x00, 0x22, 0x78, 0x2b, 0xc3, 0xed, 0x0a, 0x21, - 0xf6, 0xff, 0x22, 0x78, 0x2b, 0x2a, 0x76, 0x2b, - 0xe5, 0x21, 0x14, 0x00, 0x39, 0xe5, 0x2a, 0x78, - 0x2b, 0xe5, 0x2a, 0x6a, 0x2b, 0xe5, 0xcd, 0x8c, - 0x0c, 0xeb, 0x21, 0x08, 0x00, 0x39, 0xf9, 0xeb, - 0x22, 0x7a, 0x2b, 0x2a, 0x76, 0x2b, 0xeb, 0x2a, - 0x6a, 0x2b, 0x19, 0x22, 0x6a, 0x2b, 0xc3, 0x75, - 0x0b, 0x2a, 0x6a, 0x2b, 0x23, 0x23, 0x22, 0x6a, - 0x2b, 0x2b, 0x2b, 0x5e, 0x23, 0x56, 0xeb, 0x22, - 0x7a, 0x2b, 0xe5, 0xcd, 0x15, 0x26, 0xd1, 0x22, - 0x76, 0x2b, 0xc3, 0x83, 0x0b, 0x2a, 0x6a, 0x2b, - 0x23, 0x23, 0x22, 0x6a, 0x2b, 0x2b, 0x2b, 0x5e, - 0x23, 0x56, 0xeb, 0x22, 0x68, 0x2b, 0x2a, 0x68, - 0x2b, 0xe5, 0x21, 0x13, 0x00, 0x39, 0x22, 0x7a, - 0x2b, 0xd1, 0x73, 0xc3, 0x75, 0x0b, 0xcd, 0xf3, - 0x27, 0x06, 0x00, 0x63, 0x00, 0x35, 0x0b, 0x64, - 0x00, 0xe7, 0x0a, 0x6f, 0x00, 0xcc, 0x0a, 0x73, - 0x00, 0x19, 0x0b, 0x75, 0x00, 0xd5, 0x0a, 0x78, - 0x00, 0xde, 0x0a, 0x46, 0x0b, 0x21, 0x12, 0x00, - 0x39, 0xeb, 0x2a, 0x7a, 0x2b, 0xcd, 0xea, 0x27, - 0x22, 0x76, 0x2b, 0x2a, 0x76, 0x2b, 0xeb, 0x2a, - 0x72, 0x2b, 0xcd, 0xc7, 0x27, 0xca, 0x96, 0x0b, - 0x2a, 0x72, 0x2b, 0x22, 0x76, 0x2b, 0x2a, 0x6e, - 0x2b, 0x7c, 0xb5, 0xca, 0xd4, 0x0b, 0xc3, 0xa8, - 0x0b, 0x2a, 0x6c, 0x2b, 0x23, 0x22, 0x6c, 0x2b, - 0x2a, 0x74, 0x2b, 0x2b, 0x22, 0x74, 0x2b, 0x23, - 0xeb, 0x2a, 0x76, 0x2b, 0xcd, 0xc7, 0x27, 0xca, - 0xd4, 0x0b, 0x2a, 0x70, 0x2b, 0xe5, 0x60, 0x69, - 0xcd, 0x9c, 0x26, 0xd1, 0x11, 0xff, 0xff, 0xcd, - 0x8c, 0x27, 0xca, 0xd1, 0x0b, 0x21, 0xff, 0xff, - 0xc9, 0xc3, 0xa1, 0x0b, 0x21, 0x00, 0x00, 0x22, - 0x78, 0x2b, 0xc3, 0xe4, 0x0b, 0x2a, 0x78, 0x2b, - 0x23, 0x22, 0x78, 0x2b, 0x2a, 0x7a, 0x2b, 0x7e, - 0xb7, 0xca, 0x1b, 0x0c, 0x2a, 0x78, 0x2b, 0xeb, - 0x2a, 0x72, 0x2b, 0xcd, 0xc6, 0x27, 0xca, 0x1b, - 0x0c, 0x2a, 0x7a, 0x2b, 0x23, 0x22, 0x7a, 0x2b, - 0x2b, 0x5e, 0x16, 0x00, 0xd5, 0x60, 0x69, 0xcd, - 0x9c, 0x26, 0xd1, 0x11, 0xff, 0xff, 0xcd, 0x8c, - 0x27, 0xca, 0x18, 0x0c, 0x21, 0xff, 0xff, 0xc9, - 0xc3, 0xdd, 0x0b, 0x2a, 0x78, 0x2b, 0xeb, 0x2a, - 0x6c, 0x2b, 0x19, 0x22, 0x6c, 0x2b, 0x2a, 0x6e, - 0x2b, 0x7c, 0xb5, 0xc2, 0x64, 0x0c, 0xc3, 0x38, - 0x0c, 0x2a, 0x6c, 0x2b, 0x23, 0x22, 0x6c, 0x2b, - 0x2a, 0x74, 0x2b, 0x2b, 0x22, 0x74, 0x2b, 0x23, - 0xeb, 0x2a, 0x76, 0x2b, 0xcd, 0xc7, 0x27, 0xca, - 0x64, 0x0c, 0x21, 0x20, 0x00, 0xe5, 0x60, 0x69, - 0xcd, 0x9c, 0x26, 0xd1, 0x11, 0xff, 0xff, 0xcd, - 0x8c, 0x27, 0xca, 0x61, 0x0c, 0x21, 0xff, 0xff, - 0xc9, 0xc3, 0x31, 0x0c, 0xc3, 0x85, 0x0c, 0x2a, - 0x68, 0x2b, 0xe5, 0x60, 0x69, 0xcd, 0x9c, 0x26, - 0xd1, 0x11, 0xff, 0xff, 0xcd, 0x8c, 0x27, 0xca, - 0x7e, 0x0c, 0x21, 0xff, 0xff, 0xc9, 0x2a, 0x6c, - 0x2b, 0x23, 0x22, 0x6c, 0x2b, 0xc3, 0x97, 0x08, - 0x2a, 0x6c, 0x2b, 0xc9, 0xc5, 0x21, 0x00, 0x00, - 0x22, 0x42, 0x29, 0x22, 0x44, 0x29, 0x21, 0x0a, - 0x00, 0x39, 0x7e, 0x32, 0x40, 0x29, 0x47, 0x2b, - 0x56, 0x2b, 0x5e, 0x2b, 0xeb, 0x36, 0x00, 0x22, - 0x3e, 0x29, 0xeb, 0x2b, 0x4e, 0x2b, 0x56, 0x2b, - 0x5e, 0x21, 0x42, 0x29, 0x1a, 0x77, 0x13, 0x23, - 0x05, 0xc2, 0xb4, 0x0c, 0x79, 0xb7, 0xf2, 0xe4, - 0x0c, 0x2f, 0x3c, 0x4f, 0x2a, 0x40, 0x29, 0x11, - 0x41, 0x29, 0x19, 0x7e, 0xb7, 0xf5, 0xf2, 0xe5, - 0x0c, 0x3a, 0x40, 0x29, 0x47, 0x21, 0x42, 0x29, - 0x3e, 0x00, 0x9e, 0x77, 0x23, 0x05, 0xc2, 0xd8, - 0x0c, 0xc3, 0xe5, 0x0c, 0xf5, 0x21, 0x45, 0x29, - 0x16, 0x00, 0x3e, 0x04, 0xf5, 0x5e, 0xeb, 0x06, - 0x08, 0x29, 0x7c, 0x91, 0xda, 0xf9, 0x0c, 0x67, - 0x2c, 0x05, 0xc2, 0xf1, 0x0c, 0xeb, 0x73, 0x2b, - 0xf1, 0x3d, 0xc2, 0xec, 0x0c, 0x5a, 0x16, 0x00, - 0x21, 0x30, 0x0d, 0x19, 0x7e, 0x2a, 0x3e, 0x29, - 0x2b, 0x22, 0x3e, 0x29, 0x77, 0x21, 0x42, 0x29, - 0x06, 0x04, 0xaf, 0xbe, 0xc2, 0xe5, 0x0c, 0x23, - 0x05, 0xc2, 0x1b, 0x0d, 0x2a, 0x3e, 0x29, 0xf1, - 0xf2, 0x2e, 0x0d, 0x2b, 0x36, 0x2d, 0xc1, 0xc9, - 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, - 0x38, 0x39, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, - 0x11, 0x00, 0x00, 0xcd, 0xbe, 0x26, 0xcd, 0x2b, - 0x12, 0x44, 0x4d, 0x7c, 0xb5, 0xc2, 0x54, 0x0d, - 0x21, 0x00, 0x00, 0xc9, 0xc5, 0x21, 0x0c, 0x00, - 0x39, 0x5e, 0x23, 0x56, 0xd5, 0x21, 0x0c, 0x00, - 0x39, 0x5e, 0x23, 0x56, 0xd5, 0xcd, 0x6c, 0x0d, - 0xd1, 0xd1, 0xd1, 0xc9, 0x11, 0x00, 0x00, 0xcd, - 0xbe, 0x26, 0x21, 0x0c, 0x00, 0x39, 0x5e, 0x23, - 0x56, 0xd5, 0xcd, 0x3a, 0x10, 0xd1, 0x21, 0x46, - 0x29, 0x44, 0x4d, 0xc3, 0x8e, 0x0d, 0x60, 0x69, - 0x11, 0x05, 0x00, 0x19, 0x44, 0x4d, 0x78, 0xb1, - 0xc2, 0x9d, 0x0d, 0x21, 0xfa, 0xff, 0x22, 0xc8, - 0x2e, 0x21, 0x00, 0x00, 0xc9, 0x21, 0x0a, 0x00, - 0x39, 0x5e, 0x23, 0x56, 0xd5, 0xc5, 0xcd, 0x84, - 0x25, 0xd1, 0xd1, 0xca, 0xb1, 0x0d, 0xc3, 0x86, - 0x0d, 0x21, 0x03, 0x00, 0x09, 0x5e, 0x23, 0x56, - 0xd5, 0x21, 0x0a, 0x00, 0x39, 0x5e, 0x23, 0x56, - 0xd5, 0xcd, 0xeb, 0x15, 0xd1, 0xd1, 0x22, 0x7c, - 0x2b, 0x11, 0xff, 0xff, 0xcd, 0x8c, 0x27, 0xca, - 0xd6, 0x0d, 0x21, 0x00, 0x00, 0xc9, 0x2a, 0x7c, - 0x2b, 0xe5, 0x21, 0x0e, 0x00, 0x39, 0x5e, 0x23, - 0x56, 0x21, 0x07, 0x00, 0x19, 0xd1, 0x73, 0x21, - 0x01, 0x00, 0xe5, 0x21, 0x0e, 0x00, 0x39, 0x5e, - 0x23, 0x56, 0x21, 0x06, 0x00, 0x19, 0xd1, 0x73, - 0x21, 0x0c, 0x00, 0x39, 0x5e, 0x23, 0x56, 0xeb, - 0xc9, 0x11, 0x00, 0x00, 0xcd, 0xbe, 0x26, 0x21, - 0x08, 0x00, 0x39, 0x4e, 0x23, 0x46, 0x21, 0x00, - 0x00, 0x22, 0x7e, 0x2b, 0xc3, 0x1e, 0x0e, 0x2a, - 0x7e, 0x2b, 0x23, 0x22, 0x7e, 0x2b, 0x2a, 0x7e, - 0x2b, 0xeb, 0x21, 0x0c, 0x00, 0x39, 0x7e, 0x23, - 0x66, 0x6f, 0xcd, 0xc6, 0x27, 0xca, 0x7b, 0x0e, - 0x21, 0x0a, 0x00, 0x39, 0x5e, 0x23, 0x56, 0xeb, - 0x22, 0x82, 0x2b, 0xc3, 0x45, 0x0e, 0x2a, 0x82, - 0x2b, 0x2b, 0x22, 0x82, 0x2b, 0x2a, 0x82, 0x2b, - 0x7c, 0xb5, 0xca, 0x78, 0x0e, 0x21, 0x0e, 0x00, - 0x39, 0x5e, 0x23, 0x56, 0xd5, 0xcd, 0x7f, 0x0e, - 0xd1, 0x22, 0x80, 0x2b, 0x11, 0xff, 0xff, 0xcd, - 0x8c, 0x27, 0xca, 0x69, 0x0e, 0x2a, 0x7e, 0x2b, - 0xc9, 0x2a, 0x80, 0x2b, 0xe5, 0x60, 0x69, 0x23, - 0x44, 0x4d, 0x2b, 0xd1, 0x73, 0xc3, 0x3e, 0x0e, - 0xc3, 0x17, 0x0e, 0x2a, 0x7e, 0x2b, 0xc9, 0x11, - 0x00, 0x00, 0xcd, 0xbe, 0x26, 0x21, 0x08, 0x00, - 0x39, 0x4e, 0x23, 0x46, 0x21, 0x02, 0x00, 0x09, - 0x5e, 0x23, 0x56, 0xd5, 0x60, 0x69, 0x5e, 0x23, - 0x56, 0xe1, 0xcd, 0x1a, 0x28, 0xca, 0x40, 0x0f, - 0x21, 0x06, 0x00, 0x09, 0x5e, 0x16, 0x00, 0x21, - 0x18, 0x00, 0xcd, 0x64, 0x27, 0xca, 0xb4, 0x0e, - 0x21, 0xff, 0xff, 0xc9, 0x21, 0xfb, 0xff, 0xe5, - 0x60, 0x69, 0x11, 0x06, 0x00, 0x19, 0xd1, 0xe5, - 0x6e, 0xcd, 0x64, 0x27, 0xeb, 0xe1, 0x73, 0x60, - 0x69, 0x11, 0x04, 0x00, 0x19, 0x7e, 0x23, 0xb6, - 0xc2, 0xd8, 0x0e, 0xc5, 0xcd, 0x74, 0x12, 0xd1, - 0x21, 0x09, 0x00, 0x09, 0x5e, 0x23, 0x56, 0xd5, - 0x21, 0x04, 0x00, 0x09, 0x5e, 0x23, 0x56, 0xd5, - 0x21, 0x07, 0x00, 0x09, 0x5e, 0x16, 0x00, 0xd5, - 0xcd, 0x93, 0x19, 0xd1, 0xd1, 0xd1, 0x22, 0x84, - 0x2b, 0x11, 0x00, 0x00, 0xeb, 0xcd, 0xac, 0x27, - 0xca, 0x28, 0x0f, 0x2a, 0x84, 0x2b, 0x7c, 0xb5, - 0xc2, 0x11, 0x0f, 0x21, 0x08, 0x00, 0xc3, 0x14, - 0x0f, 0x21, 0x10, 0x00, 0xe5, 0x60, 0x69, 0x11, - 0x06, 0x00, 0x19, 0xd1, 0xe5, 0x6e, 0xcd, 0x74, - 0x27, 0xeb, 0xe1, 0x73, 0x21, 0xff, 0xff, 0xc9, - 0x21, 0x04, 0x00, 0x09, 0x5e, 0x23, 0x56, 0x60, - 0x69, 0x73, 0x23, 0x72, 0x2a, 0x84, 0x2b, 0x19, - 0xeb, 0x21, 0x02, 0x00, 0x09, 0x73, 0x23, 0x72, - 0x60, 0x69, 0xe5, 0x7e, 0x23, 0x66, 0x6f, 0x23, - 0xeb, 0xe1, 0x73, 0x23, 0x72, 0xeb, 0x2b, 0x5e, - 0x16, 0x00, 0x21, 0xff, 0x00, 0xcd, 0x64, 0x27, - 0xc9, 0x11, 0x00, 0x00, 0xcd, 0xbe, 0x26, 0x21, - 0x7e, 0x29, 0xe5, 0x21, 0x0a, 0x00, 0x39, 0x5e, - 0x23, 0x56, 0xd5, 0xcd, 0x71, 0x0f, 0xd1, 0xd1, - 0xc9, 0x11, 0x00, 0x00, 0xcd, 0xbe, 0x26, 0x21, - 0x08, 0x00, 0x39, 0x4e, 0x23, 0x46, 0x60, 0x69, - 0x11, 0x0a, 0x00, 0xcd, 0x8c, 0x27, 0xca, 0xa7, - 0x0f, 0x21, 0x0a, 0x00, 0x39, 0x5e, 0x23, 0x56, - 0xd5, 0x21, 0x0d, 0x00, 0xe5, 0xcd, 0xb6, 0x0f, - 0xd1, 0xd1, 0x11, 0xff, 0xff, 0xcd, 0x8c, 0x27, - 0xca, 0xa7, 0x0f, 0x21, 0xff, 0xff, 0xc9, 0x21, - 0x0a, 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, 0xc5, - 0xcd, 0xb6, 0x0f, 0xd1, 0xd1, 0xc9, 0x11, 0x00, - 0x00, 0xcd, 0xbe, 0x26, 0x21, 0x0a, 0x00, 0x39, - 0x4e, 0x23, 0x46, 0x21, 0x02, 0x00, 0x09, 0x5e, - 0x23, 0x56, 0xd5, 0x60, 0x69, 0x5e, 0x23, 0x56, - 0xe1, 0xcd, 0x1a, 0x28, 0xca, 0xec, 0x0f, 0x21, - 0x08, 0x00, 0x39, 0x5e, 0x23, 0x56, 0x21, 0xff, - 0x00, 0xcd, 0x64, 0x27, 0xe5, 0xc5, 0xcd, 0xb4, - 0x10, 0xd1, 0xd1, 0xc9, 0x21, 0x08, 0x00, 0x39, - 0x5e, 0x23, 0x56, 0xd5, 0x60, 0x69, 0xe5, 0x7e, - 0x23, 0x66, 0x6f, 0x23, 0xeb, 0xe1, 0x73, 0x23, - 0x72, 0xeb, 0x2b, 0xd1, 0x73, 0x16, 0x00, 0x21, - 0xff, 0x00, 0xcd, 0x64, 0x27, 0xc9, 0x11, 0x00, - 0x00, 0xcd, 0xbe, 0x26, 0x21, 0x73, 0x29, 0x44, - 0x4d, 0x60, 0x69, 0x11, 0xec, 0x29, 0xeb, 0xcd, - 0x28, 0x28, 0xca, 0x39, 0x10, 0x60, 0x69, 0x11, - 0x0b, 0x00, 0x19, 0x44, 0x4d, 0x11, 0xf5, 0xff, - 0x19, 0xe5, 0xcd, 0x3a, 0x10, 0xd1, 0xc3, 0x19, - 0x10, 0xc9, 0x11, 0x00, 0x00, 0xcd, 0xbe, 0x26, - 0x21, 0x08, 0x00, 0x39, 0x4e, 0x23, 0x46, 0x21, - 0x00, 0x00, 0x22, 0x86, 0x2b, 0x60, 0x69, 0x11, - 0x06, 0x00, 0x19, 0x7e, 0xb7, 0xca, 0xa7, 0x10, - 0x21, 0x06, 0x00, 0x09, 0x5e, 0x16, 0x00, 0x21, - 0x04, 0x00, 0xcd, 0x64, 0x27, 0xca, 0x75, 0x10, - 0x21, 0xff, 0xff, 0xe5, 0xc5, 0xcd, 0xb4, 0x10, - 0xd1, 0xd1, 0x22, 0x86, 0x2b, 0x21, 0x07, 0x00, - 0x09, 0x5e, 0x16, 0x00, 0xd5, 0xcd, 0x68, 0x17, - 0xd1, 0xeb, 0x2a, 0x86, 0x2b, 0xcd, 0x74, 0x27, - 0x22, 0x86, 0x2b, 0x21, 0x06, 0x00, 0x09, 0x5e, - 0x16, 0x00, 0x21, 0x02, 0x00, 0xcd, 0x64, 0x27, - 0xca, 0xa7, 0x10, 0x21, 0x04, 0x00, 0x09, 0x5e, - 0x23, 0x56, 0xd5, 0xcd, 0x65, 0x23, 0xd1, 0x21, - 0x00, 0x00, 0xeb, 0x21, 0x06, 0x00, 0x09, 0x73, - 0x2a, 0x86, 0x2b, 0xc9, 0x11, 0x00, 0x00, 0xcd, - 0xbe, 0x26, 0x21, 0x08, 0x00, 0x39, 0x4e, 0x23, - 0x46, 0x21, 0x0e, 0x10, 0x22, 0x6e, 0x2a, 0x21, - 0x06, 0x00, 0x09, 0x5e, 0x16, 0x00, 0x21, 0x10, - 0x00, 0xcd, 0x64, 0x27, 0xca, 0xdb, 0x10, 0x21, - 0xff, 0xff, 0xc9, 0x21, 0x06, 0x00, 0x09, 0x5e, - 0x16, 0x00, 0x21, 0x04, 0x00, 0xcd, 0x64, 0x27, - 0xca, 0x4c, 0x11, 0x21, 0x04, 0x00, 0x09, 0x5e, - 0x23, 0x56, 0xd5, 0x60, 0x69, 0x5e, 0x23, 0x56, - 0xe1, 0xcd, 0xea, 0x27, 0x22, 0x88, 0x2b, 0x2a, - 0x88, 0x2b, 0xe5, 0x21, 0x04, 0x00, 0x09, 0x5e, - 0x23, 0x56, 0xd5, 0x21, 0x07, 0x00, 0x09, 0x5e, - 0x16, 0x00, 0xd5, 0xcd, 0x88, 0x1c, 0xd1, 0xd1, - 0xd1, 0xeb, 0x2a, 0x88, 0x2b, 0xcd, 0x9b, 0x27, - 0xca, 0x4c, 0x11, 0x21, 0x10, 0x00, 0xe5, 0x60, - 0x69, 0x11, 0x06, 0x00, 0x19, 0xd1, 0xe5, 0x6e, - 0x26, 0x00, 0xcd, 0x74, 0x27, 0xeb, 0xe1, 0x73, - 0x21, 0x00, 0x00, 0xeb, 0x60, 0x69, 0x73, 0x23, - 0x72, 0x21, 0x02, 0x00, 0x09, 0x73, 0x23, 0x72, - 0x21, 0xff, 0xff, 0xc9, 0x21, 0x0a, 0x00, 0x39, - 0x5e, 0x23, 0x56, 0x21, 0xff, 0xff, 0xcd, 0x8c, - 0x27, 0xca, 0x85, 0x11, 0x21, 0xfb, 0xff, 0xe5, - 0x60, 0x69, 0x11, 0x06, 0x00, 0x19, 0xd1, 0xe5, - 0x6e, 0x26, 0x00, 0xcd, 0x64, 0x27, 0xeb, 0xe1, - 0x73, 0x21, 0x00, 0x00, 0xeb, 0x60, 0x69, 0x73, - 0x23, 0x72, 0x21, 0x02, 0x00, 0x09, 0x73, 0x23, - 0x72, 0x21, 0x00, 0x00, 0xc9, 0x60, 0x69, 0x11, - 0x04, 0x00, 0x19, 0x7e, 0x23, 0xb6, 0xc2, 0x96, - 0x11, 0xc5, 0xcd, 0x74, 0x12, 0xd1, 0x21, 0x09, - 0x00, 0x09, 0x5e, 0x23, 0x56, 0x21, 0x01, 0x00, - 0xcd, 0x8c, 0x27, 0xca, 0xcf, 0x11, 0x21, 0x01, - 0x00, 0xe5, 0x21, 0x0c, 0x00, 0x39, 0xe5, 0x21, - 0x07, 0x00, 0x09, 0x5e, 0x16, 0x00, 0xd5, 0xcd, - 0x88, 0x1c, 0xd1, 0xd1, 0xd1, 0x11, 0x01, 0x00, - 0xcd, 0x9b, 0x27, 0xc2, 0x23, 0x11, 0x21, 0x0a, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0xeb, 0xc9, 0x21, - 0x04, 0x00, 0x09, 0x5e, 0x23, 0x56, 0x60, 0x69, - 0x73, 0x23, 0x72, 0x21, 0x09, 0x00, 0x09, 0x5e, - 0x23, 0x56, 0xd5, 0x21, 0x04, 0x00, 0x09, 0x5e, - 0x23, 0x56, 0xe1, 0x19, 0xeb, 0x21, 0x02, 0x00, - 0x09, 0x73, 0x23, 0x72, 0x21, 0x04, 0x00, 0xe5, - 0x60, 0x69, 0x11, 0x06, 0x00, 0x19, 0xd1, 0xe5, - 0x6e, 0x26, 0x00, 0xcd, 0x74, 0x27, 0xeb, 0xe1, - 0x73, 0x21, 0x0a, 0x00, 0x39, 0x5e, 0x23, 0x56, - 0xd5, 0x60, 0x69, 0xe5, 0x7e, 0x23, 0x66, 0x6f, - 0x23, 0xeb, 0xe1, 0x73, 0x23, 0x72, 0xeb, 0x2b, - 0xd1, 0x73, 0x16, 0x00, 0x21, 0xff, 0x00, 0xcd, - 0x64, 0x27, 0xc9, 0x11, 0x00, 0x00, 0xcd, 0xbe, - 0x26, 0x21, 0x73, 0x29, 0x44, 0x4d, 0x60, 0x69, - 0x11, 0x06, 0x00, 0x19, 0x7e, 0xb7, 0xca, 0x5a, - 0x12, 0x60, 0x69, 0x11, 0x0b, 0x00, 0x19, 0x44, - 0x4d, 0x11, 0xec, 0x29, 0xeb, 0xcd, 0x1a, 0x28, - 0xca, 0x57, 0x12, 0x21, 0x00, 0x00, 0xc9, 0xc3, - 0x36, 0x12, 0x21, 0x00, 0x00, 0xeb, 0x60, 0x69, - 0x73, 0x23, 0x72, 0x21, 0x02, 0x00, 0x09, 0x73, - 0x23, 0x72, 0x21, 0x04, 0x00, 0x09, 0x73, 0x23, - 0x72, 0x60, 0x69, 0xc9, 0x11, 0x00, 0x00, 0xcd, - 0xbe, 0x26, 0x21, 0x08, 0x00, 0x39, 0x4e, 0x23, - 0x46, 0x21, 0x07, 0x00, 0x09, 0x5e, 0x16, 0x00, - 0xd5, 0xcd, 0x93, 0x20, 0xd1, 0xca, 0xaa, 0x12, - 0x21, 0x01, 0x00, 0xeb, 0x21, 0x09, 0x00, 0x09, - 0x73, 0x23, 0x72, 0x60, 0x69, 0x11, 0x08, 0x00, - 0x19, 0xeb, 0x21, 0x04, 0x00, 0x09, 0x73, 0x23, - 0x72, 0xc9, 0x21, 0x00, 0x04, 0xe5, 0xcd, 0xc0, - 0x21, 0xd1, 0x22, 0x8a, 0x2b, 0x7c, 0xb5, 0xca, - 0x90, 0x12, 0x21, 0x00, 0x04, 0xeb, 0x21, 0x09, - 0x00, 0x09, 0x73, 0x23, 0x72, 0x21, 0x02, 0x00, - 0xe5, 0x60, 0x69, 0x11, 0x06, 0x00, 0x19, 0xd1, - 0xe5, 0x6e, 0xcd, 0x74, 0x27, 0xeb, 0xe1, 0x73, - 0x2a, 0x8a, 0x2b, 0xeb, 0x21, 0x04, 0x00, 0x09, - 0x73, 0x23, 0x72, 0xc9, 0x21, 0x64, 0x2b, 0x01, - 0x6a, 0x03, 0x1e, 0x00, 0x73, 0x23, 0x0b, 0x79, - 0xb0, 0xc2, 0xec, 0x12, 0x2a, 0x06, 0x00, 0xf9, - 0x11, 0x00, 0xf8, 0x19, 0x22, 0xca, 0x2e, 0x2a, - 0xf4, 0x29, 0x22, 0xcc, 0x2e, 0xcd, 0x19, 0x13, - 0x0e, 0x11, 0x11, 0xf6, 0x29, 0xcd, 0x05, 0x00, - 0x01, 0x00, 0x00, 0xcd, 0x05, 0x00, 0xc3, 0x08, - 0x13, 0x11, 0x00, 0x00, 0xcd, 0xbe, 0x26, 0x21, - 0x7f, 0x00, 0xe5, 0x21, 0xd4, 0x2b, 0xe5, 0x21, - 0x81, 0x00, 0xe5, 0xcd, 0x4a, 0x26, 0xd1, 0xd1, - 0xd1, 0x21, 0x00, 0x00, 0xe5, 0x3a, 0x80, 0x00, - 0x6f, 0x26, 0x00, 0x11, 0x7f, 0x00, 0xcd, 0x64, - 0x27, 0x11, 0xd4, 0x2b, 0x19, 0xd1, 0x73, 0x21, - 0xfd, 0x14, 0x22, 0x98, 0x2b, 0x21, 0xd4, 0x2b, - 0x44, 0x4d, 0x21, 0x01, 0x00, 0x22, 0x54, 0x2c, - 0x2a, 0x54, 0x2c, 0x11, 0x1e, 0x00, 0xeb, 0xcd, - 0xc6, 0x27, 0xca, 0xe7, 0x14, 0x60, 0x69, 0x5e, - 0x16, 0x00, 0x21, 0x20, 0x00, 0xcd, 0x8c, 0x27, - 0xc2, 0x81, 0x13, 0x60, 0x69, 0x5e, 0x16, 0x00, - 0x21, 0x09, 0x00, 0xcd, 0x8c, 0x27, 0xca, 0x89, - 0x13, 0x60, 0x69, 0x23, 0x44, 0x4d, 0xc3, 0x65, - 0x13, 0x60, 0x69, 0x7e, 0xb7, 0xca, 0xe7, 0x14, - 0x60, 0x69, 0x5e, 0x16, 0x00, 0x21, 0x3e, 0x00, - 0xcd, 0x8c, 0x27, 0xca, 0xa7, 0x13, 0x21, 0x01, - 0x00, 0x22, 0x58, 0x2c, 0xc3, 0xbb, 0x13, 0x60, - 0x69, 0x5e, 0x16, 0x00, 0x21, 0x3c, 0x00, 0xcd, - 0x8c, 0x27, 0xca, 0x98, 0x14, 0x21, 0x00, 0x00, - 0x22, 0x58, 0x2c, 0x60, 0x69, 0x23, 0x44, 0x4d, - 0x5e, 0x16, 0x00, 0x21, 0x20, 0x00, 0xcd, 0x8c, - 0x27, 0xc2, 0xda, 0x13, 0x60, 0x69, 0x5e, 0x16, - 0x00, 0x21, 0x09, 0x00, 0xcd, 0x8c, 0x27, 0xca, - 0xdd, 0x13, 0xc3, 0xbb, 0x13, 0x60, 0x69, 0x22, - 0x56, 0x2c, 0x60, 0x69, 0x23, 0x44, 0x4d, 0x7e, - 0xb7, 0xca, 0x1a, 0x14, 0x60, 0x69, 0x5e, 0x16, - 0x00, 0x21, 0x20, 0x00, 0xcd, 0x8c, 0x27, 0xc2, - 0x08, 0x14, 0x60, 0x69, 0x5e, 0x16, 0x00, 0x21, - 0x09, 0x00, 0xcd, 0x8c, 0x27, 0xca, 0x17, 0x14, - 0x21, 0x00, 0x00, 0xe5, 0x60, 0x69, 0x23, 0x44, - 0x4d, 0x2b, 0xd1, 0x73, 0xc3, 0x1a, 0x14, 0xc3, - 0xe2, 0x13, 0x2a, 0x58, 0x2c, 0xe5, 0xcd, 0x68, - 0x17, 0xd1, 0x2a, 0x58, 0x2c, 0x7c, 0xb5, 0xca, - 0x3d, 0x14, 0x21, 0xb6, 0x01, 0xe5, 0x2a, 0x56, - 0x2c, 0xe5, 0xcd, 0xca, 0x15, 0xd1, 0xd1, 0x22, - 0x58, 0x2c, 0xc3, 0x4d, 0x14, 0x21, 0x00, 0x00, - 0xe5, 0x2a, 0x56, 0x2c, 0xe5, 0xcd, 0xeb, 0x15, - 0xd1, 0xd1, 0x22, 0x58, 0x2c, 0x2a, 0x58, 0x2c, - 0x11, 0xff, 0xff, 0xcd, 0x8c, 0x27, 0xca, 0x95, - 0x14, 0x21, 0xfe, 0x14, 0xe5, 0x21, 0x80, 0x00, - 0xe5, 0xcd, 0xbc, 0x25, 0xd1, 0xd1, 0x2a, 0x56, - 0x2c, 0xe5, 0x21, 0x80, 0x00, 0xe5, 0xcd, 0xd8, - 0x25, 0xd1, 0xd1, 0x21, 0x20, 0x15, 0xe5, 0x21, - 0x80, 0x00, 0xe5, 0xcd, 0xd8, 0x25, 0xd1, 0xd1, - 0x21, 0x80, 0x00, 0xe5, 0x21, 0x09, 0x00, 0xe5, - 0xcd, 0x19, 0x24, 0xd1, 0xd1, 0x21, 0x0a, 0x00, - 0xe5, 0xcd, 0x22, 0x15, 0xd1, 0xc3, 0xe4, 0x14, - 0x60, 0x69, 0xe5, 0x2a, 0x54, 0x2c, 0x23, 0x22, - 0x54, 0x2c, 0x2b, 0x29, 0x11, 0x98, 0x2b, 0x19, - 0xd1, 0x73, 0x23, 0x72, 0x60, 0x69, 0x23, 0x44, - 0x4d, 0x7e, 0xb7, 0xca, 0xe4, 0x14, 0x60, 0x69, - 0x5e, 0x16, 0x00, 0x21, 0x20, 0x00, 0xcd, 0x8c, - 0x27, 0xc2, 0xd2, 0x14, 0x60, 0x69, 0x5e, 0x16, - 0x00, 0x21, 0x09, 0x00, 0xcd, 0x8c, 0x27, 0xca, - 0xe1, 0x14, 0x21, 0x00, 0x00, 0xe5, 0x60, 0x69, - 0x23, 0x44, 0x4d, 0x2b, 0xd1, 0x73, 0xc3, 0xe4, - 0x14, 0xc3, 0xac, 0x14, 0xc3, 0x58, 0x13, 0x21, - 0x98, 0x2b, 0xe5, 0x2a, 0x54, 0x2c, 0xe5, 0xcd, - 0x82, 0x02, 0xd1, 0xd1, 0x21, 0x00, 0x00, 0xe5, - 0xcd, 0x22, 0x15, 0xd1, 0xc9, 0x00, 0x43, 0x61, - 0x6e, 0x27, 0x74, 0x20, 0x6f, 0x70, 0x65, 0x6e, - 0x20, 0x66, 0x69, 0x6c, 0x65, 0x20, 0x66, 0x6f, - 0x72, 0x20, 0x72, 0x65, 0x64, 0x69, 0x72, 0x65, - 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x3a, 0x20, 0x00, - 0x24, 0x00, 0x11, 0x00, 0x00, 0xcd, 0xbe, 0x26, - 0x2a, 0x6e, 0x2a, 0xcd, 0x9c, 0x26, 0x21, 0x00, - 0x00, 0x44, 0x4d, 0x60, 0x69, 0x11, 0x0b, 0x00, - 0xeb, 0xcd, 0xc6, 0x27, 0xca, 0x4d, 0x15, 0x60, - 0x69, 0x23, 0x44, 0x4d, 0x2b, 0xe5, 0xcd, 0x68, - 0x17, 0xd1, 0xc3, 0x33, 0x15, 0x21, 0x08, 0x00, - 0x39, 0x7e, 0x23, 0xb6, 0xca, 0x70, 0x15, 0x21, - 0x18, 0x00, 0xe5, 0xcd, 0x19, 0x24, 0xd1, 0x11, - 0x01, 0x00, 0xcd, 0x64, 0x27, 0xca, 0x70, 0x15, - 0x21, 0x74, 0x15, 0xe5, 0xcd, 0x08, 0x21, 0xd1, - 0xcd, 0x08, 0x13, 0xc9, 0x41, 0x3a, 0x24, 0x24, - 0x24, 0x2e, 0x53, 0x55, 0x42, 0x00, 0x11, 0x00, - 0x00, 0xcd, 0xbe, 0x26, 0x21, 0xfd, 0xff, 0x22, - 0xc8, 0x2e, 0x21, 0xff, 0xff, 0xc9, 0x11, 0x00, - 0x00, 0xcd, 0xbe, 0x26, 0x21, 0x00, 0x00, 0xc9, - 0x63, 0x6f, 0x6e, 0x3a, 0x00, 0x43, 0x4f, 0x4e, - 0x3a, 0x00, 0x6c, 0x73, 0x74, 0x3a, 0x00, 0x4c, - 0x53, 0x54, 0x3a, 0x00, 0x70, 0x72, 0x6e, 0x3a, - 0x00, 0x50, 0x52, 0x4e, 0x3a, 0x00, 0x70, 0x75, - 0x6e, 0x3a, 0x00, 0x50, 0x55, 0x4e, 0x3a, 0x00, - 0x72, 0x64, 0x72, 0x3a, 0x00, 0x52, 0x44, 0x52, - 0x3a, 0x00, 0x11, 0x00, 0x00, 0xcd, 0xbe, 0x26, - 0x21, 0x0a, 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, - 0x21, 0x01, 0x03, 0xe5, 0x21, 0x0c, 0x00, 0x39, - 0x5e, 0x23, 0x56, 0xd5, 0xcd, 0xeb, 0x15, 0xd1, - 0xd1, 0xd1, 0xc9, 0x11, 0x00, 0x00, 0xcd, 0xbe, - 0x26, 0x21, 0x16, 0x2a, 0x22, 0x5a, 0x2c, 0x21, - 0x00, 0x00, 0x22, 0x5e, 0x2c, 0xc3, 0x11, 0x16, - 0x2a, 0x5a, 0x2c, 0x11, 0x08, 0x00, 0x19, 0x22, - 0x5a, 0x2c, 0x2a, 0x5e, 0x2c, 0x23, 0x22, 0x5e, - 0x2c, 0x2a, 0x5e, 0x2c, 0x11, 0x0b, 0x00, 0xeb, - 0xcd, 0xc6, 0x27, 0xca, 0x34, 0x16, 0x2a, 0x5a, - 0x2c, 0x11, 0x04, 0x00, 0x19, 0x5e, 0x23, 0x56, - 0x21, 0x7e, 0x15, 0xcd, 0x8c, 0x27, 0xc2, 0x3e, - 0x16, 0xc3, 0x00, 0x16, 0x21, 0xf8, 0xff, 0x22, - 0xc8, 0x2e, 0x21, 0xff, 0xff, 0xc9, 0x21, 0x88, - 0x2a, 0x44, 0x4d, 0xc3, 0x4e, 0x16, 0x60, 0x69, - 0x11, 0x06, 0x00, 0x19, 0x44, 0x4d, 0x60, 0x69, - 0x7e, 0x23, 0xb6, 0xca, 0x6f, 0x16, 0x21, 0x08, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, 0x60, 0x69, - 0x5e, 0x23, 0x56, 0xd5, 0xcd, 0x84, 0x25, 0xd1, - 0xd1, 0xca, 0x6f, 0x16, 0xc3, 0x46, 0x16, 0x21, - 0x02, 0x00, 0x09, 0x5e, 0x23, 0x56, 0xeb, 0x22, - 0x5c, 0x2c, 0x21, 0x0a, 0x00, 0x39, 0x5e, 0x23, - 0x56, 0x21, 0x03, 0x00, 0xcd, 0x64, 0x27, 0x23, - 0x22, 0x60, 0x2c, 0x2a, 0x60, 0x2c, 0x11, 0x01, - 0x00, 0xcd, 0x64, 0x27, 0xca, 0xb0, 0x16, 0x2a, - 0x5c, 0x2c, 0x5e, 0xd5, 0x2a, 0x5a, 0x2c, 0xd1, - 0x73, 0x7b, 0xb3, 0xc2, 0xb0, 0x16, 0x21, 0xf6, - 0xff, 0x22, 0xc8, 0x2e, 0x21, 0xff, 0xff, 0xc9, - 0x2a, 0x60, 0x2c, 0x11, 0x02, 0x00, 0xcd, 0x64, - 0x27, 0xca, 0xd7, 0x16, 0x2a, 0x5c, 0x2c, 0x23, - 0x5e, 0xd5, 0x2a, 0x5a, 0x2c, 0x23, 0xd1, 0x73, - 0x7b, 0xb3, 0xc2, 0xd7, 0x16, 0x21, 0xf6, 0xff, - 0x22, 0xc8, 0x2e, 0x21, 0xff, 0xff, 0xc9, 0x21, - 0x04, 0x00, 0x09, 0x5e, 0x23, 0x56, 0xd5, 0x2a, - 0x5a, 0x2c, 0x11, 0x06, 0x00, 0x19, 0xd1, 0x73, - 0x23, 0x72, 0x2a, 0x5c, 0x2c, 0x23, 0x23, 0x5e, - 0xd5, 0x2a, 0x5a, 0x2c, 0x23, 0x23, 0xd1, 0x73, - 0x2a, 0x5c, 0x2c, 0x23, 0x23, 0x23, 0x5e, 0xd5, - 0x2a, 0x5a, 0x2c, 0x23, 0x23, 0x23, 0xd1, 0x73, - 0x21, 0x8e, 0x15, 0xe5, 0x2a, 0x5a, 0x2c, 0x11, - 0x04, 0x00, 0x19, 0xd1, 0x73, 0x23, 0x72, 0xc5, - 0x2a, 0x5a, 0x2c, 0xe5, 0x21, 0x10, 0x00, 0x39, - 0x5e, 0x23, 0x56, 0xd5, 0x21, 0x10, 0x00, 0x39, - 0x5e, 0x23, 0x56, 0xd5, 0x21, 0x10, 0x00, 0x39, - 0x5e, 0x23, 0x56, 0xd5, 0x2a, 0x5c, 0x2c, 0x11, - 0x04, 0x00, 0x19, 0x5e, 0x23, 0x56, 0xeb, 0xcd, - 0x9c, 0x26, 0xeb, 0x21, 0x0a, 0x00, 0x39, 0xf9, - 0x21, 0x00, 0x00, 0xcd, 0xc6, 0x27, 0xca, 0x64, - 0x17, 0x21, 0x7e, 0x15, 0xe5, 0x2a, 0x5a, 0x2c, - 0x11, 0x04, 0x00, 0x19, 0xd1, 0x73, 0x23, 0x72, - 0x21, 0xff, 0xff, 0xc9, 0x2a, 0x5e, 0x2c, 0xc9, - 0x11, 0x00, 0x00, 0xcd, 0xbe, 0x26, 0x21, 0x08, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0x21, 0x00, 0x00, - 0xcd, 0xc6, 0x27, 0xc2, 0x8e, 0x17, 0x21, 0x08, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0x21, 0x0b, 0x00, - 0xcd, 0xc7, 0x27, 0xca, 0x98, 0x17, 0x21, 0xfd, - 0xff, 0x22, 0xc8, 0x2e, 0x21, 0xff, 0xff, 0xc9, - 0x21, 0x08, 0x00, 0x39, 0x5e, 0x23, 0x56, 0xeb, - 0x29, 0x29, 0x29, 0x11, 0x16, 0x2a, 0x19, 0x44, - 0x4d, 0x21, 0x06, 0x00, 0x09, 0x5e, 0x23, 0x56, - 0xd5, 0x21, 0x04, 0x00, 0x09, 0x5e, 0x23, 0x56, - 0xeb, 0xcd, 0x9c, 0x26, 0xd1, 0xeb, 0x21, 0x08, - 0x00, 0x39, 0x73, 0x23, 0x72, 0x21, 0x00, 0x00, - 0xeb, 0x21, 0x03, 0x00, 0x09, 0x73, 0x21, 0x02, - 0x00, 0x09, 0x73, 0x21, 0x01, 0x00, 0x09, 0x73, - 0x60, 0x69, 0x73, 0x21, 0x7e, 0x15, 0xeb, 0x21, - 0x04, 0x00, 0x09, 0x73, 0x23, 0x72, 0x21, 0x08, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0xeb, 0xc9, 0x11, - 0x00, 0x00, 0xcd, 0xbe, 0x26, 0x21, 0x62, 0x2c, - 0x44, 0x4d, 0xc3, 0x05, 0x18, 0x60, 0x69, 0x11, - 0x27, 0x00, 0x19, 0x44, 0x4d, 0x60, 0x69, 0x11, - 0x9a, 0x2d, 0xeb, 0xcd, 0x28, 0x28, 0xca, 0x1f, - 0x18, 0x60, 0x69, 0x11, 0x25, 0x00, 0x19, 0x7e, - 0xb7, 0xca, 0x29, 0x18, 0xc3, 0xfd, 0x17, 0x21, - 0xf9, 0xff, 0x22, 0xc8, 0x2e, 0x21, 0xff, 0xff, - 0xc9, 0xc5, 0x21, 0x0a, 0x00, 0x39, 0x5e, 0x23, - 0x56, 0xd5, 0xcd, 0x2d, 0x24, 0xd1, 0xd1, 0x22, - 0x9a, 0x2d, 0x11, 0xff, 0xff, 0xcd, 0x8c, 0x27, - 0xca, 0x4d, 0x18, 0x21, 0xfa, 0xff, 0x22, 0xc8, - 0x2e, 0x21, 0xff, 0xff, 0xc9, 0x2a, 0x9a, 0x2d, - 0x11, 0xff, 0x00, 0xcd, 0x8c, 0x27, 0xca, 0x5f, - 0x18, 0xcd, 0x50, 0x25, 0x22, 0x9a, 0x2d, 0x2a, - 0x9a, 0x2d, 0xe5, 0xcd, 0x5f, 0x25, 0xd1, 0x21, - 0x0a, 0x00, 0x39, 0x5e, 0x23, 0x56, 0x21, 0x00, - 0x02, 0xcd, 0x64, 0x27, 0xca, 0x81, 0x18, 0xc5, - 0x21, 0x13, 0x00, 0xe5, 0xcd, 0x19, 0x24, 0xd1, - 0xd1, 0xc5, 0x21, 0x0f, 0x00, 0xe5, 0xcd, 0x19, - 0x24, 0xd1, 0xd1, 0x11, 0xff, 0x00, 0xcd, 0x8c, - 0x27, 0xca, 0xc7, 0x18, 0x21, 0x0a, 0x00, 0x39, - 0x5e, 0x23, 0x56, 0x21, 0x00, 0x03, 0xcd, 0x64, - 0x27, 0xca, 0xb7, 0x18, 0xc5, 0x21, 0x16, 0x00, - 0xe5, 0xcd, 0x19, 0x24, 0xd1, 0xd1, 0x11, 0xff, - 0x00, 0xcd, 0x8c, 0x27, 0xca, 0xc4, 0x18, 0x21, - 0xff, 0xff, 0x22, 0xc8, 0x2e, 0xcd, 0x78, 0x25, - 0x21, 0xff, 0xff, 0xc9, 0xc3, 0xea, 0x18, 0x21, - 0x0a, 0x00, 0x39, 0x5e, 0x23, 0x56, 0x21, 0x00, - 0x05, 0xcd, 0x64, 0x27, 0x11, 0x00, 0x05, 0xcd, - 0x8c, 0x27, 0xca, 0xea, 0x18, 0x21, 0xfb, 0xff, - 0x22, 0xc8, 0x2e, 0xcd, 0x78, 0x25, 0x21, 0xff, - 0xff, 0xc9, 0x21, 0x00, 0x00, 0xeb, 0x21, 0x21, - 0x00, 0x09, 0x73, 0x23, 0x72, 0x21, 0x23, 0x00, - 0x09, 0x73, 0x21, 0x24, 0x00, 0x09, 0x73, 0x2a, - 0x9a, 0x2d, 0xeb, 0x21, 0x26, 0x00, 0x09, 0x73, - 0x60, 0x69, 0xe5, 0x21, 0x10, 0x00, 0x39, 0x5e, - 0x23, 0x56, 0x21, 0x06, 0x00, 0x19, 0xd1, 0x73, - 0x23, 0x72, 0x21, 0x0a, 0x00, 0x39, 0x5e, 0x23, - 0x56, 0x21, 0x03, 0x00, 0xcd, 0x64, 0x27, 0x23, - 0xeb, 0x21, 0x25, 0x00, 0x09, 0x73, 0x21, 0x5d, - 0x19, 0xe5, 0x21, 0x10, 0x00, 0x39, 0x5e, 0x23, - 0x56, 0x21, 0x04, 0x00, 0x19, 0xd1, 0x73, 0x23, - 0x72, 0x21, 0x0a, 0x00, 0x39, 0x5e, 0x23, 0x56, - 0x21, 0x00, 0x08, 0xcd, 0x64, 0x27, 0xca, 0x56, - 0x19, 0xc5, 0xcd, 0x37, 0x1f, 0xd1, 0xcd, 0x78, - 0x25, 0x21, 0x00, 0x00, 0xc9, 0x11, 0x00, 0x00, - 0xcd, 0xbe, 0x26, 0x21, 0x08, 0x00, 0x39, 0x4e, - 0x23, 0x46, 0xcd, 0xed, 0x1f, 0x21, 0x26, 0x00, - 0x09, 0x5e, 0x16, 0x00, 0xd5, 0xcd, 0x5f, 0x25, - 0xd1, 0xc5, 0x21, 0x10, 0x00, 0xe5, 0xcd, 0x19, - 0x24, 0xd1, 0xd1, 0xcd, 0x78, 0x25, 0x21, 0x00, - 0x00, 0xeb, 0x21, 0x25, 0x00, 0x09, 0x73, 0x21, - 0x00, 0x00, 0xc9, 0x11, 0x00, 0x00, 0xcd, 0xbe, - 0x26, 0x21, 0x08, 0x00, 0x39, 0x5e, 0x23, 0x56, - 0xeb, 0x29, 0x29, 0x29, 0x11, 0x16, 0x2a, 0x19, - 0x44, 0x4d, 0x21, 0x0c, 0x00, 0x39, 0x5e, 0x23, - 0x56, 0xd5, 0x21, 0x0c, 0x00, 0x39, 0x5e, 0x23, - 0x56, 0xd5, 0x21, 0x06, 0x00, 0x09, 0x5e, 0x23, - 0x56, 0xd5, 0x60, 0x69, 0x5e, 0x16, 0x00, 0xeb, - 0x29, 0x11, 0xca, 0x2a, 0x19, 0x5e, 0x23, 0x56, - 0xeb, 0xcd, 0x9c, 0x26, 0xd1, 0xd1, 0xd1, 0xc9, - 0x11, 0x00, 0x00, 0xcd, 0xbe, 0x26, 0x21, 0x00, - 0x00, 0x44, 0x4d, 0x21, 0x08, 0x00, 0x39, 0x5e, - 0x23, 0x56, 0xeb, 0x22, 0x9c, 0x2d, 0x2a, 0x9c, - 0x2d, 0x11, 0x26, 0x00, 0x19, 0x5e, 0x16, 0x00, - 0xd5, 0xcd, 0x5f, 0x25, 0xd1, 0x2a, 0x9c, 0x2d, - 0x11, 0x24, 0x00, 0x19, 0x7e, 0xb7, 0xca, 0x53, - 0x1a, 0x2a, 0x9c, 0x2d, 0x11, 0x24, 0x00, 0x19, - 0x5e, 0x16, 0x00, 0xd5, 0x21, 0x80, 0x00, 0xd1, - 0xeb, 0xcd, 0xea, 0x27, 0x44, 0x4d, 0xeb, 0x21, - 0x0c, 0x00, 0x39, 0x7e, 0x23, 0x66, 0x6f, 0xcd, - 0x29, 0x28, 0xca, 0x36, 0x1a, 0x21, 0x0c, 0x00, - 0x39, 0x5e, 0x23, 0x56, 0x42, 0x4b, 0xc5, 0x21, - 0x0c, 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, 0x2a, - 0x9c, 0x2d, 0xe5, 0xcd, 0xfe, 0x1a, 0xd1, 0xd1, - 0xd1, 0xca, 0x53, 0x1a, 0xcd, 0x78, 0x25, 0x21, - 0x00, 0x00, 0xc9, 0x21, 0x0c, 0x00, 0x39, 0x5e, - 0x23, 0x56, 0x60, 0x69, 0xcd, 0xea, 0x27, 0x11, - 0x07, 0x00, 0xeb, 0xcd, 0x4f, 0x27, 0x22, 0x9e, - 0x2d, 0x7c, 0xb5, 0xca, 0xa7, 0x1a, 0x2a, 0x9e, - 0x2d, 0xe5, 0x21, 0x0c, 0x00, 0x39, 0x5e, 0x23, - 0x56, 0x60, 0x69, 0x19, 0xe5, 0x2a, 0x9c, 0x2d, - 0xe5, 0xcd, 0xad, 0x20, 0xd1, 0xd1, 0xd1, 0x22, - 0xa0, 0x2d, 0x7c, 0xb5, 0xca, 0xa7, 0x1a, 0xcd, - 0x78, 0x25, 0x2a, 0x9e, 0x2d, 0xeb, 0x2a, 0xa0, - 0x2d, 0xcd, 0xea, 0x27, 0x11, 0x07, 0x00, 0xeb, - 0xcd, 0x3f, 0x27, 0x50, 0x59, 0x19, 0xc9, 0x2a, - 0x9e, 0x2d, 0x11, 0x07, 0x00, 0xeb, 0xcd, 0x3f, - 0x27, 0x50, 0x59, 0x19, 0x44, 0x4d, 0x60, 0x69, - 0xeb, 0x21, 0x0c, 0x00, 0x39, 0x7e, 0x23, 0x66, - 0x6f, 0xcd, 0x28, 0x28, 0xca, 0xf2, 0x1a, 0x21, - 0x0c, 0x00, 0x39, 0x5e, 0x23, 0x56, 0x60, 0x69, - 0xcd, 0xea, 0x27, 0xe5, 0x21, 0x0c, 0x00, 0x39, - 0x5e, 0x23, 0x56, 0x60, 0x69, 0x19, 0xe5, 0x2a, - 0x9c, 0x2d, 0xe5, 0xcd, 0xfe, 0x1a, 0xd1, 0xd1, - 0xd1, 0xca, 0xf2, 0x1a, 0xcd, 0x78, 0x25, 0x60, - 0x69, 0xc9, 0xcd, 0x78, 0x25, 0x21, 0x0c, 0x00, - 0x39, 0x5e, 0x23, 0x56, 0xeb, 0xc9, 0x11, 0x00, - 0x00, 0xcd, 0xbe, 0x26, 0x21, 0x08, 0x00, 0x39, - 0x4e, 0x23, 0x46, 0xc5, 0xcd, 0xfa, 0x1f, 0xd1, - 0xca, 0x17, 0x1b, 0x21, 0xff, 0xff, 0xc9, 0x21, - 0x0c, 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, 0x21, - 0x0c, 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, 0x21, - 0x24, 0x00, 0x09, 0x5e, 0x16, 0x00, 0x21, 0x80, - 0x00, 0x19, 0xe5, 0xcd, 0x4a, 0x26, 0xd1, 0xd1, - 0xd1, 0x21, 0x24, 0x00, 0x09, 0x5e, 0x16, 0x00, - 0x21, 0x0c, 0x00, 0x39, 0x7e, 0x23, 0x66, 0x6f, - 0x19, 0x11, 0x7f, 0x00, 0xcd, 0x64, 0x27, 0xeb, - 0x21, 0x24, 0x00, 0x09, 0x73, 0x7b, 0xb3, 0xc2, - 0x6b, 0x1b, 0x60, 0x69, 0x11, 0x21, 0x00, 0x19, - 0xe5, 0x7e, 0x23, 0x66, 0x6f, 0x23, 0xeb, 0xe1, - 0x73, 0x23, 0x72, 0x21, 0x00, 0x00, 0xc9, 0x11, - 0x00, 0x00, 0xcd, 0xbe, 0x26, 0x3a, 0xa3, 0x2d, - 0xb7, 0xc2, 0xdf, 0x1b, 0x21, 0xff, 0x00, 0x7d, - 0x32, 0xa2, 0x2d, 0x21, 0x00, 0x00, 0x7d, 0x32, - 0xa4, 0x2d, 0x7d, 0x32, 0xa3, 0x2d, 0x21, 0xa2, - 0x2d, 0xe5, 0x21, 0x0a, 0x00, 0xe5, 0xcd, 0x19, - 0x24, 0xd1, 0xd1, 0x21, 0x0a, 0x00, 0xe5, 0x21, - 0x02, 0x00, 0xe5, 0xcd, 0x19, 0x24, 0xd1, 0xd1, - 0x3a, 0xa4, 0x2d, 0x6f, 0x26, 0x00, 0x11, 0x1a, - 0x00, 0xcd, 0x8c, 0x27, 0xca, 0xc2, 0x1b, 0x21, - 0x00, 0x00, 0x7d, 0x32, 0xa3, 0x2d, 0x21, 0x00, - 0x00, 0xc9, 0x3a, 0xd2, 0x2a, 0x6f, 0xe5, 0x3a, - 0xa3, 0x2d, 0x6f, 0x23, 0x7d, 0x32, 0xa3, 0x2d, - 0x26, 0x00, 0x11, 0xa2, 0x2d, 0x19, 0x23, 0xd1, - 0x73, 0x21, 0x02, 0x00, 0x22, 0xa4, 0x2e, 0x3a, - 0xa3, 0x2d, 0x6f, 0x26, 0x00, 0x44, 0x4d, 0xeb, - 0x21, 0x0c, 0x00, 0x39, 0x7e, 0x23, 0x66, 0x6f, - 0xcd, 0xc7, 0x27, 0xca, 0xff, 0x1b, 0x21, 0x0c, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0x42, 0x4b, 0xc5, - 0x21, 0x0c, 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, - 0x2a, 0xa4, 0x2e, 0x11, 0xa2, 0x2d, 0x19, 0xe5, - 0xcd, 0x4a, 0x26, 0xd1, 0xd1, 0xd1, 0x60, 0x69, - 0xeb, 0x2a, 0xa4, 0x2e, 0x19, 0x22, 0xa4, 0x2e, - 0x60, 0x69, 0xeb, 0x3a, 0xa3, 0x2d, 0x6f, 0xeb, - 0xcd, 0xea, 0x27, 0x7d, 0x32, 0xa3, 0x2d, 0x60, - 0x69, 0xc9, 0x11, 0x00, 0x00, 0xcd, 0xbe, 0x26, - 0x21, 0x0a, 0x00, 0x39, 0x4e, 0x23, 0x46, 0x21, - 0x00, 0x00, 0x22, 0xa6, 0x2e, 0xc3, 0x4f, 0x1c, - 0x2a, 0xa6, 0x2e, 0x23, 0x22, 0xa6, 0x2e, 0x2a, - 0xa6, 0x2e, 0xeb, 0x21, 0x0c, 0x00, 0x39, 0x7e, - 0x23, 0x66, 0x6f, 0xcd, 0xc6, 0x27, 0xca, 0x84, - 0x1c, 0x21, 0x08, 0x00, 0x39, 0x5e, 0x23, 0x56, - 0xd5, 0xcd, 0x19, 0x24, 0xd1, 0xe5, 0x60, 0x69, - 0x23, 0x44, 0x4d, 0x2b, 0xd1, 0x73, 0x16, 0x00, - 0x21, 0x1a, 0x00, 0xcd, 0x8c, 0x27, 0xc2, 0x84, - 0x1c, 0xc3, 0x48, 0x1c, 0x2a, 0xa6, 0x2e, 0xc9, - 0x11, 0x00, 0x00, 0xcd, 0xbe, 0x26, 0x21, 0x08, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0xeb, 0x29, 0x29, - 0x29, 0x11, 0x16, 0x2a, 0x19, 0x44, 0x4d, 0x21, - 0x0c, 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, 0x21, - 0x0c, 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, 0x21, - 0x06, 0x00, 0x09, 0x5e, 0x23, 0x56, 0xd5, 0x21, - 0x01, 0x00, 0x09, 0x5e, 0x16, 0x00, 0xeb, 0x29, - 0x11, 0xd3, 0x2a, 0x19, 0x5e, 0x23, 0x56, 0xeb, - 0xcd, 0x9c, 0x26, 0xd1, 0xd1, 0xd1, 0xc9, 0x11, - 0x00, 0x00, 0xcd, 0xbe, 0x26, 0x21, 0x00, 0x00, - 0x44, 0x4d, 0x21, 0x08, 0x00, 0x39, 0x5e, 0x23, - 0x56, 0xeb, 0x22, 0xa8, 0x2e, 0x2a, 0xa8, 0x2e, - 0x11, 0x26, 0x00, 0x19, 0x5e, 0x16, 0x00, 0xd5, - 0xcd, 0x5f, 0x25, 0xd1, 0x2a, 0xa8, 0x2e, 0x11, - 0x24, 0x00, 0x19, 0x7e, 0xb7, 0xca, 0x4a, 0x1d, - 0x2a, 0xa8, 0x2e, 0x11, 0x24, 0x00, 0x19, 0x5e, - 0x16, 0x00, 0xd5, 0x21, 0x80, 0x00, 0xd1, 0xeb, - 0xcd, 0xea, 0x27, 0x44, 0x4d, 0xeb, 0x21, 0x0c, - 0x00, 0x39, 0x7e, 0x23, 0x66, 0x6f, 0xcd, 0x29, - 0x28, 0xca, 0x2d, 0x1d, 0x21, 0x0c, 0x00, 0x39, - 0x5e, 0x23, 0x56, 0x42, 0x4b, 0xc5, 0x21, 0x0c, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, 0x2a, 0xa8, - 0x2e, 0xe5, 0xcd, 0x02, 0x1e, 0xd1, 0xd1, 0xd1, - 0xca, 0x4a, 0x1d, 0xcd, 0x78, 0x25, 0x21, 0xff, - 0xff, 0xc9, 0x21, 0x0c, 0x00, 0x39, 0x5e, 0x23, - 0x56, 0x60, 0x69, 0xcd, 0xea, 0x27, 0x11, 0x07, - 0x00, 0xeb, 0xcd, 0x4f, 0x27, 0x22, 0xaa, 0x2e, - 0x7c, 0xb5, 0xca, 0xab, 0x1d, 0x2a, 0xaa, 0x2e, - 0xe5, 0x21, 0x0c, 0x00, 0x39, 0x5e, 0x23, 0x56, - 0x60, 0x69, 0x19, 0xe5, 0x2a, 0xa8, 0x2e, 0xe5, - 0xcd, 0xb5, 0x20, 0xd1, 0xd1, 0xd1, 0x22, 0xac, - 0x2e, 0x7c, 0xb5, 0xca, 0xab, 0x1d, 0xcd, 0x78, - 0x25, 0x2a, 0xaa, 0x2e, 0xeb, 0x2a, 0xac, 0x2e, - 0xcd, 0xea, 0x27, 0x11, 0x07, 0x00, 0xeb, 0xcd, - 0x3f, 0x27, 0x50, 0x59, 0x19, 0x44, 0x4d, 0x7c, - 0xb5, 0xc2, 0xa8, 0x1d, 0x21, 0xff, 0xff, 0xc9, - 0x60, 0x69, 0xc9, 0x2a, 0xaa, 0x2e, 0x11, 0x07, - 0x00, 0xeb, 0xcd, 0x3f, 0x27, 0x50, 0x59, 0x19, - 0x44, 0x4d, 0x60, 0x69, 0xeb, 0x21, 0x0c, 0x00, - 0x39, 0x7e, 0x23, 0x66, 0x6f, 0xcd, 0x28, 0x28, - 0xca, 0xf6, 0x1d, 0x21, 0x0c, 0x00, 0x39, 0x5e, - 0x23, 0x56, 0x60, 0x69, 0xcd, 0xea, 0x27, 0xe5, - 0x21, 0x0c, 0x00, 0x39, 0x5e, 0x23, 0x56, 0x60, - 0x69, 0x19, 0xe5, 0x2a, 0xa8, 0x2e, 0xe5, 0xcd, - 0x02, 0x1e, 0xd1, 0xd1, 0xd1, 0xca, 0xf6, 0x1d, - 0xcd, 0x78, 0x25, 0x60, 0x69, 0xc9, 0xcd, 0x78, - 0x25, 0x21, 0x0c, 0x00, 0x39, 0x5e, 0x23, 0x56, - 0xeb, 0xc9, 0x11, 0x00, 0x00, 0xcd, 0xbe, 0x26, - 0x21, 0x08, 0x00, 0x39, 0x4e, 0x23, 0x46, 0xc5, - 0xcd, 0xfa, 0x1f, 0xd1, 0x11, 0x00, 0x00, 0xeb, - 0xcd, 0xc6, 0x27, 0xca, 0x22, 0x1e, 0x21, 0xff, - 0xff, 0xc9, 0x21, 0x0c, 0x00, 0x39, 0x5e, 0x23, - 0x56, 0xd5, 0x21, 0x24, 0x00, 0x09, 0x5e, 0x16, - 0x00, 0x21, 0x80, 0x00, 0x19, 0xe5, 0x21, 0x0e, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, 0xcd, 0x4a, - 0x26, 0xd1, 0xd1, 0xd1, 0xc5, 0x21, 0x22, 0x00, - 0xe5, 0xcd, 0x19, 0x24, 0xd1, 0xd1, 0x22, 0xc8, - 0x2e, 0x7c, 0xb5, 0xca, 0x5a, 0x1e, 0x21, 0xff, - 0xff, 0xc9, 0x21, 0x24, 0x00, 0x09, 0x5e, 0x16, - 0x00, 0x21, 0x0c, 0x00, 0x39, 0x7e, 0x23, 0x66, - 0x6f, 0x19, 0x11, 0x7f, 0x00, 0xcd, 0x64, 0x27, - 0xeb, 0x21, 0x24, 0x00, 0x09, 0x73, 0x7b, 0xb3, - 0xc2, 0x8c, 0x1e, 0x60, 0x69, 0x11, 0x21, 0x00, - 0x19, 0xe5, 0x7e, 0x23, 0x66, 0x6f, 0x23, 0xeb, - 0xe1, 0x73, 0x23, 0x72, 0x21, 0x00, 0x00, 0xc9, - 0x11, 0x00, 0x00, 0xcd, 0xbe, 0x26, 0x21, 0x0a, - 0x00, 0x39, 0x4e, 0x23, 0x46, 0x21, 0x0c, 0x00, - 0x39, 0x5e, 0x23, 0x56, 0xeb, 0x22, 0xae, 0x2e, - 0x2a, 0xae, 0x2e, 0x2b, 0x22, 0xae, 0x2e, 0x23, - 0x7c, 0xb5, 0xca, 0xe6, 0x1e, 0x60, 0x69, 0x5e, - 0x16, 0x00, 0x21, 0x0a, 0x00, 0xcd, 0x8c, 0x27, - 0xca, 0xd0, 0x1e, 0x21, 0x0d, 0x00, 0xe5, 0x21, - 0x02, 0x00, 0xe5, 0xcd, 0x19, 0x24, 0xd1, 0xd1, - 0x60, 0x69, 0x23, 0x44, 0x4d, 0x2b, 0x5e, 0x16, - 0x00, 0xd5, 0x21, 0x02, 0x00, 0xe5, 0xcd, 0x19, - 0x24, 0xd1, 0xd1, 0xc3, 0xa8, 0x1e, 0x21, 0x0c, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0xeb, 0xc9, 0x11, - 0x00, 0x00, 0xcd, 0xbe, 0x26, 0x21, 0x0a, 0x00, - 0x39, 0x4e, 0x23, 0x46, 0x21, 0x0c, 0x00, 0x39, - 0x5e, 0x23, 0x56, 0xeb, 0x22, 0xb0, 0x2e, 0x2a, - 0xb0, 0x2e, 0x2b, 0x22, 0xb0, 0x2e, 0x23, 0x7c, - 0xb5, 0xca, 0x2e, 0x1f, 0x60, 0x69, 0x23, 0x44, - 0x4d, 0x2b, 0x5e, 0x16, 0x00, 0xd5, 0x21, 0x0a, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0xd5, 0xcd, 0x19, - 0x24, 0xd1, 0xd1, 0xc3, 0x07, 0x1f, 0x21, 0x0c, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0xeb, 0xc9, 0x11, - 0x00, 0x00, 0xcd, 0xbe, 0x26, 0x21, 0x08, 0x00, - 0x39, 0x4e, 0x23, 0x46, 0xc5, 0x21, 0x23, 0x00, - 0xe5, 0xcd, 0x19, 0x24, 0xd1, 0xd1, 0x60, 0x69, - 0x11, 0x21, 0x00, 0x19, 0x7e, 0x23, 0xb6, 0xc2, - 0x67, 0x1f, 0x21, 0x00, 0x00, 0xeb, 0x21, 0x24, - 0x00, 0x09, 0x73, 0x21, 0x00, 0x00, 0xc9, 0x60, - 0x69, 0x11, 0x21, 0x00, 0x19, 0xe5, 0x7e, 0x23, - 0x66, 0x6f, 0x2b, 0xeb, 0xe1, 0x73, 0x23, 0x72, - 0xc5, 0xcd, 0xfa, 0x1f, 0xd1, 0xca, 0x84, 0x1f, - 0x21, 0xff, 0xff, 0xc9, 0x21, 0x00, 0x01, 0x22, - 0xb2, 0x2e, 0x2a, 0xb2, 0x2e, 0x11, 0x80, 0x00, - 0xeb, 0xcd, 0x29, 0x28, 0xca, 0xb7, 0x1f, 0x2a, - 0xb2, 0x2e, 0x2b, 0x22, 0xb2, 0x2e, 0x5e, 0x16, - 0x00, 0x21, 0x1a, 0x00, 0xcd, 0x9b, 0x27, 0xca, - 0xb4, 0x1f, 0x2a, 0xb2, 0x2e, 0x23, 0x22, 0xb2, - 0x2e, 0xc3, 0xb7, 0x1f, 0xc3, 0x8a, 0x1f, 0x2a, - 0xb2, 0x2e, 0x11, 0x80, 0xff, 0x19, 0xeb, 0x21, - 0x24, 0x00, 0x09, 0x73, 0x16, 0x00, 0x21, 0x80, - 0x00, 0xcd, 0x8c, 0x27, 0xca, 0xe9, 0x1f, 0x60, - 0x69, 0x11, 0x21, 0x00, 0x19, 0xe5, 0x7e, 0x23, - 0x66, 0x6f, 0x23, 0xeb, 0xe1, 0x73, 0x23, 0x72, - 0x21, 0x00, 0x00, 0xeb, 0x21, 0x24, 0x00, 0x09, - 0x73, 0x21, 0x00, 0x00, 0xc9, 0x11, 0x00, 0x00, - 0xcd, 0xbe, 0x26, 0x21, 0x00, 0x00, 0x22, 0xb4, - 0x2e, 0xc9, 0x11, 0x00, 0x00, 0xcd, 0xbe, 0x26, - 0x21, 0x08, 0x00, 0x39, 0x4e, 0x23, 0x46, 0x21, - 0x80, 0x00, 0xe5, 0x21, 0x1a, 0x00, 0xe5, 0xcd, - 0x19, 0x24, 0xd1, 0xd1, 0x2a, 0xb4, 0x2e, 0x50, - 0x59, 0xcd, 0x9b, 0x27, 0xc2, 0x2f, 0x20, 0x21, - 0x21, 0x00, 0x09, 0x5e, 0x23, 0x56, 0x2a, 0xb6, - 0x2e, 0xcd, 0x9b, 0x27, 0xca, 0x8f, 0x20, 0xc5, - 0x21, 0x21, 0x00, 0xe5, 0xcd, 0x19, 0x24, 0xd1, - 0xd1, 0x22, 0xc8, 0x2e, 0x11, 0x01, 0x00, 0xcd, - 0x8c, 0x27, 0xc2, 0x51, 0x20, 0x2a, 0xc8, 0x2e, - 0x11, 0x04, 0x00, 0xcd, 0x8c, 0x27, 0xca, 0x73, - 0x20, 0x21, 0x00, 0x00, 0x22, 0xc8, 0x2e, 0x21, - 0x1a, 0x00, 0xe5, 0x21, 0x80, 0x00, 0xe5, 0x21, - 0x80, 0x00, 0xe5, 0xcd, 0x2e, 0x26, 0xd1, 0xd1, - 0xd1, 0x21, 0x00, 0x00, 0x22, 0xb4, 0x2e, 0x21, - 0x01, 0x00, 0xc9, 0x2a, 0xc8, 0x2e, 0x7c, 0xb5, - 0xca, 0x7f, 0x20, 0x21, 0xff, 0xff, 0xc9, 0x60, - 0x69, 0x22, 0xb4, 0x2e, 0x21, 0x21, 0x00, 0x09, - 0x5e, 0x23, 0x56, 0xeb, 0x22, 0xb6, 0x2e, 0x21, - 0x00, 0x00, 0xc9, 0x11, 0x00, 0x00, 0xcd, 0xbe, - 0x26, 0x21, 0x08, 0x00, 0x39, 0x5e, 0x23, 0x56, - 0xeb, 0x29, 0x29, 0x29, 0x11, 0x18, 0x2a, 0x19, - 0x5e, 0x16, 0x00, 0xeb, 0xc9, 0xcd, 0xdc, 0x26, - 0x0e, 0x21, 0xc3, 0xba, 0x20, 0xcd, 0xdc, 0x26, - 0x0e, 0x22, 0xc5, 0x2a, 0x5f, 0x2b, 0xeb, 0x21, - 0x80, 0x00, 0x19, 0x22, 0x5f, 0x2b, 0x0e, 0x1a, - 0xcd, 0x05, 0x00, 0xc1, 0xc5, 0x2a, 0x5d, 0x2b, - 0xeb, 0xcd, 0x05, 0x00, 0xb7, 0xc2, 0xf3, 0x20, - 0x2a, 0x5d, 0x2b, 0x11, 0x21, 0x00, 0x19, 0x34, - 0xc2, 0xe5, 0x20, 0x23, 0x34, 0x2a, 0x61, 0x2b, - 0x2b, 0x22, 0x61, 0x2b, 0x7d, 0xb4, 0xc2, 0xbb, - 0x20, 0xc1, 0xc9, 0xfe, 0x01, 0xca, 0x03, 0x21, - 0xfe, 0x04, 0xca, 0x03, 0x21, 0x6f, 0x26, 0x00, - 0x22, 0xc8, 0x2e, 0xc1, 0x2a, 0x61, 0x2b, 0xc9, - 0x11, 0xd8, 0xff, 0xcd, 0xbe, 0x26, 0x21, 0x04, - 0x00, 0x39, 0xe5, 0x21, 0x32, 0x00, 0x39, 0x5e, - 0x23, 0x56, 0xd5, 0xcd, 0x2d, 0x24, 0xd1, 0xd1, - 0x44, 0x4d, 0xc5, 0xcd, 0x5f, 0x25, 0xd1, 0x21, - 0x04, 0x00, 0x39, 0xe5, 0x21, 0x13, 0x00, 0xe5, - 0xcd, 0x19, 0x24, 0xd1, 0xd1, 0x44, 0x4d, 0xcd, - 0x78, 0x25, 0x60, 0x69, 0x11, 0xff, 0x00, 0xcd, - 0x8c, 0x27, 0xca, 0x4f, 0x21, 0x21, 0xff, 0xff, - 0x22, 0xc8, 0x2e, 0x21, 0xff, 0xff, 0xc9, 0x21, - 0x00, 0x00, 0xc9, 0x11, 0x00, 0x00, 0xcd, 0xbe, - 0x26, 0x21, 0x08, 0x00, 0x39, 0x4e, 0x23, 0x46, - 0x21, 0xfc, 0xff, 0x09, 0x5e, 0x23, 0x56, 0xeb, - 0x2b, 0x29, 0x29, 0x22, 0xc0, 0x2e, 0xc5, 0xcd, - 0x65, 0x23, 0xd1, 0x21, 0x0a, 0x00, 0x39, 0x5e, - 0x23, 0x56, 0xd5, 0xcd, 0xc0, 0x21, 0xd1, 0x22, - 0xbe, 0x2e, 0x7c, 0xb5, 0xca, 0xbc, 0x21, 0x2a, - 0xbe, 0x2e, 0x50, 0x59, 0xcd, 0x9b, 0x27, 0xca, - 0xbc, 0x21, 0x21, 0x0a, 0x00, 0x39, 0x5e, 0x23, - 0x56, 0x2a, 0xc0, 0x2e, 0xcd, 0x29, 0x28, 0xca, - 0xa8, 0x21, 0x2a, 0xc0, 0x2e, 0xc3, 0xb0, 0x21, - 0x21, 0x0a, 0x00, 0x39, 0x5e, 0x23, 0x56, 0xeb, - 0xe5, 0x2a, 0xbe, 0x2e, 0xe5, 0xc5, 0xcd, 0x4a, - 0x26, 0xd1, 0xd1, 0xd1, 0x2a, 0xbe, 0x2e, 0xc9, - 0x11, 0x00, 0x00, 0xcd, 0xbe, 0x26, 0x21, 0x08, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0xeb, 0x23, 0x23, - 0x23, 0x11, 0x02, 0x00, 0xeb, 0xcd, 0x4f, 0x27, - 0x23, 0x22, 0xc4, 0x2e, 0x2a, 0xbc, 0x2e, 0x22, - 0xc2, 0x2e, 0x7c, 0xb5, 0xc2, 0xf3, 0x21, 0x21, - 0xb8, 0x2e, 0x22, 0xc2, 0x2e, 0x22, 0xba, 0x2e, - 0x22, 0xbc, 0x2e, 0x2a, 0xc2, 0x2e, 0x23, 0x23, - 0x5e, 0x23, 0x56, 0x42, 0x4b, 0xc3, 0x0e, 0x22, - 0x60, 0x69, 0x22, 0xc2, 0x2e, 0x21, 0x02, 0x00, - 0x09, 0x5e, 0x23, 0x56, 0x42, 0x4b, 0x21, 0x02, - 0x00, 0x09, 0x5e, 0x23, 0x56, 0xd5, 0x60, 0x69, - 0xd1, 0xcd, 0x9b, 0x27, 0xca, 0x8d, 0x22, 0x21, - 0x02, 0x00, 0x09, 0x5e, 0x23, 0x56, 0xd5, 0x60, - 0x69, 0x5e, 0x23, 0x56, 0xeb, 0x29, 0x29, 0x50, - 0x59, 0x19, 0xd1, 0xcd, 0x8c, 0x27, 0xca, 0x8d, - 0x22, 0x21, 0x02, 0x00, 0x09, 0x5e, 0x23, 0x56, - 0xd5, 0x2a, 0xbc, 0x2e, 0xd1, 0xcd, 0x8c, 0x27, - 0xca, 0x5c, 0x22, 0x21, 0x02, 0x00, 0x09, 0x5e, - 0x23, 0x56, 0xeb, 0x23, 0x23, 0x5e, 0x23, 0x56, - 0xeb, 0x22, 0xbc, 0x2e, 0x21, 0x02, 0x00, 0x09, - 0x5e, 0x23, 0x56, 0xeb, 0x5e, 0x23, 0x56, 0xd5, - 0x60, 0x69, 0xd1, 0xe5, 0x7e, 0x23, 0x66, 0x6f, - 0x19, 0xeb, 0xe1, 0x73, 0x23, 0x72, 0x21, 0x02, - 0x00, 0x09, 0x5e, 0x23, 0x56, 0xeb, 0x23, 0x23, - 0x5e, 0x23, 0x56, 0x21, 0x02, 0x00, 0x09, 0x73, - 0x23, 0x72, 0xc3, 0x0e, 0x22, 0x60, 0x69, 0x5e, - 0x23, 0x56, 0x2a, 0xc4, 0x2e, 0xcd, 0x1a, 0x28, - 0xca, 0x1a, 0x23, 0x60, 0x69, 0x5e, 0x23, 0x56, - 0x2a, 0xc4, 0x2e, 0xcd, 0x8c, 0x27, 0xca, 0xbd, - 0x22, 0x21, 0x02, 0x00, 0x09, 0x5e, 0x23, 0x56, - 0xd5, 0x2a, 0xc2, 0x2e, 0x23, 0x23, 0xd1, 0x73, - 0x23, 0x72, 0xc3, 0x02, 0x23, 0x2a, 0xc4, 0x2e, - 0x29, 0x29, 0x50, 0x59, 0x19, 0x22, 0xbc, 0x2e, - 0x2a, 0xbc, 0x2e, 0xe5, 0x2a, 0xc2, 0x2e, 0x23, - 0x23, 0xd1, 0x73, 0x23, 0x72, 0x21, 0x02, 0x00, - 0x09, 0x5e, 0x23, 0x56, 0xd5, 0x2a, 0xbc, 0x2e, - 0x23, 0x23, 0xd1, 0x73, 0x23, 0x72, 0x60, 0x69, - 0x5e, 0x23, 0x56, 0x2a, 0xc4, 0x2e, 0xcd, 0xea, - 0x27, 0xe5, 0x2a, 0xbc, 0x2e, 0xd1, 0x73, 0x23, - 0x72, 0x2a, 0xc4, 0x2e, 0xeb, 0x60, 0x69, 0x73, - 0x23, 0x72, 0x2a, 0xc2, 0x2e, 0x22, 0xbc, 0x2e, - 0x21, 0x00, 0x00, 0xeb, 0x21, 0x02, 0x00, 0x09, - 0x73, 0x23, 0x72, 0x60, 0x69, 0x11, 0x04, 0x00, - 0x19, 0xc9, 0x60, 0x69, 0xeb, 0x2a, 0xbc, 0x2e, - 0xcd, 0x8c, 0x27, 0xca, 0x61, 0x23, 0x21, 0x00, - 0x04, 0xe5, 0xcd, 0x16, 0x25, 0xd1, 0x44, 0x4d, - 0x11, 0xff, 0xff, 0xcd, 0x8c, 0x27, 0xca, 0x3d, - 0x23, 0x21, 0x00, 0x00, 0xc9, 0x21, 0x00, 0x01, - 0xeb, 0x60, 0x69, 0x73, 0x23, 0x72, 0x21, 0x00, - 0x00, 0xeb, 0x21, 0x02, 0x00, 0x09, 0x73, 0x23, - 0x72, 0x60, 0x69, 0x11, 0x04, 0x00, 0x19, 0xe5, - 0xcd, 0x65, 0x23, 0xd1, 0x2a, 0xbc, 0x2e, 0x44, - 0x4d, 0xc3, 0x00, 0x22, 0xc9, 0x11, 0x00, 0x00, - 0xcd, 0xbe, 0x26, 0x21, 0x08, 0x00, 0x39, 0x5e, - 0x23, 0x56, 0x21, 0xfc, 0xff, 0x19, 0x22, 0xc6, - 0x2e, 0x2a, 0xc6, 0x2e, 0x23, 0x23, 0x7e, 0x23, - 0xb6, 0xca, 0x88, 0x23, 0x21, 0xff, 0xff, 0xc9, - 0x2a, 0xbc, 0x2e, 0x44, 0x4d, 0xc3, 0x99, 0x23, - 0x21, 0x02, 0x00, 0x09, 0x5e, 0x23, 0x56, 0x42, - 0x4b, 0x60, 0x69, 0xeb, 0x2a, 0xc6, 0x2e, 0xcd, - 0x29, 0x28, 0xc2, 0xb8, 0x23, 0x21, 0x02, 0x00, - 0x09, 0x5e, 0x23, 0x56, 0xd5, 0x2a, 0xc6, 0x2e, - 0xd1, 0xeb, 0xcd, 0x29, 0x28, 0xca, 0xec, 0x23, - 0x21, 0x02, 0x00, 0x09, 0x5e, 0x23, 0x56, 0xd5, - 0x60, 0x69, 0xd1, 0xeb, 0xcd, 0x1a, 0x28, 0xca, - 0xe9, 0x23, 0x2a, 0xc6, 0x2e, 0x50, 0x59, 0xeb, - 0xcd, 0x29, 0x28, 0xc2, 0xec, 0x23, 0x21, 0x02, - 0x00, 0x09, 0x5e, 0x23, 0x56, 0xd5, 0x2a, 0xc6, - 0x2e, 0xd1, 0xeb, 0xcd, 0x28, 0x28, 0xc2, 0xec, - 0x23, 0xc3, 0x90, 0x23, 0x21, 0x02, 0x00, 0x09, - 0x5e, 0x23, 0x56, 0xd5, 0x2a, 0xc6, 0x2e, 0x23, - 0x23, 0xd1, 0x73, 0x23, 0x72, 0x2a, 0xc6, 0x2e, - 0xeb, 0x21, 0x02, 0x00, 0x09, 0x73, 0x23, 0x72, - 0x60, 0x69, 0x22, 0xbc, 0x2e, 0x21, 0x00, 0x00, - 0xc9, 0xcd, 0xdc, 0x26, 0xcd, 0x1c, 0x24, 0xeb, - 0xc9, 0xcd, 0xdc, 0x26, 0x2a, 0x5d, 0x2b, 0x44, - 0x4d, 0x2a, 0x5f, 0x2b, 0xeb, 0xcd, 0x05, 0x00, - 0xeb, 0x6f, 0xaf, 0x67, 0xc9, 0xc5, 0x21, 0x04, - 0x00, 0x39, 0x4e, 0x23, 0x46, 0x23, 0x5e, 0x23, - 0x56, 0x6b, 0x62, 0x36, 0x00, 0x23, 0x3e, 0x0b, - 0x36, 0x20, 0x23, 0x3d, 0xc2, 0x40, 0x24, 0x3e, - 0x04, 0x36, 0x00, 0x23, 0x3d, 0xc2, 0x49, 0x24, - 0xeb, 0x79, 0xb0, 0xca, 0xf1, 0x24, 0x0a, 0xfe, - 0x20, 0xca, 0x61, 0x24, 0xfe, 0x09, 0xc2, 0x65, - 0x24, 0x03, 0xc3, 0x56, 0x24, 0xc5, 0x16, 0x00, - 0x0a, 0xcd, 0x0a, 0x25, 0xda, 0x7e, 0x24, 0xd6, - 0x30, 0x5f, 0x7a, 0x87, 0x87, 0x87, 0x82, 0x82, - 0x83, 0x57, 0x03, 0xc3, 0x68, 0x24, 0xfe, 0x2f, - 0xc2, 0x88, 0x24, 0x03, 0xf1, 0xc3, 0x8b, 0x24, - 0xc1, 0x16, 0xff, 0x03, 0x0a, 0xfe, 0x3a, 0x0b, - 0x3e, 0x00, 0xc2, 0xb6, 0x24, 0x0a, 0xe6, 0x7f, - 0xfe, 0x41, 0xda, 0xf1, 0x24, 0xfe, 0x5b, 0xd2, - 0xa7, 0x24, 0xd6, 0x40, 0xc3, 0xb3, 0x24, 0xfe, - 0x61, 0xda, 0xf1, 0x24, 0xfe, 0x7b, 0xd2, 0xf1, - 0x24, 0xd6, 0x60, 0x77, 0x03, 0x03, 0x23, 0x1e, - 0x08, 0x1c, 0x0a, 0x03, 0xfe, 0x2e, 0xca, 0xd1, - 0x24, 0xb7, 0xca, 0xea, 0x24, 0x1d, 0xca, 0xb9, - 0x24, 0xcd, 0xf8, 0x24, 0x77, 0x23, 0xc3, 0xba, - 0x24, 0x1d, 0x7b, 0x85, 0x6f, 0x7c, 0xce, 0x00, - 0x67, 0x1e, 0x03, 0x0a, 0x03, 0xb7, 0xca, 0xea, - 0x24, 0xcd, 0xf8, 0x24, 0x77, 0x23, 0x1d, 0xc2, - 0xdb, 0x24, 0x26, 0x00, 0x6a, 0x7a, 0xb7, 0xc1, - 0xc9, 0x21, 0xff, 0xff, 0x7c, 0xb7, 0xc1, 0xc9, - 0xfe, 0x2a, 0xc2, 0x01, 0x25, 0x0b, 0x3e, 0x3f, - 0xc9, 0xfe, 0x61, 0xd8, 0xfe, 0x7b, 0xd0, 0xd6, - 0x20, 0xc9, 0xfe, 0x30, 0xd8, 0xfe, 0x3a, 0xd2, - 0x14, 0x25, 0xb7, 0xc9, 0x37, 0xc9, 0x21, 0x02, - 0x00, 0x39, 0x5e, 0x23, 0x56, 0x2a, 0xf4, 0x29, - 0x19, 0xda, 0x3a, 0x25, 0xeb, 0x2a, 0xca, 0x2e, - 0x7d, 0x93, 0x7c, 0x9a, 0xda, 0x3a, 0x25, 0x2a, - 0xf4, 0x29, 0xeb, 0x22, 0xf4, 0x29, 0xeb, 0x7c, - 0xb5, 0xc9, 0x21, 0xff, 0xff, 0xaf, 0x3d, 0xc9, - 0x21, 0x02, 0x00, 0x39, 0x7d, 0x96, 0x5f, 0x7c, - 0x23, 0x9e, 0x57, 0xeb, 0x22, 0xca, 0x2e, 0xc9, - 0xcd, 0xdc, 0x26, 0x0e, 0x20, 0x1e, 0xff, 0xcd, - 0x05, 0x00, 0x6f, 0x26, 0x00, 0xb7, 0xc9, 0xcd, - 0xdc, 0x26, 0x0e, 0x20, 0x1e, 0xff, 0xcd, 0x05, - 0x00, 0x32, 0xdb, 0x2a, 0x3a, 0x5d, 0x2b, 0xfe, - 0xff, 0xc8, 0x0e, 0x20, 0x5f, 0xc3, 0x05, 0x00, - 0xcd, 0xdc, 0x26, 0x0e, 0x20, 0x3a, 0xdb, 0x2a, - 0x5f, 0xc3, 0x05, 0x00, 0x21, 0x05, 0x00, 0x39, - 0xc5, 0x01, 0xff, 0x7f, 0xc3, 0x98, 0x25, 0x21, - 0x07, 0x00, 0x39, 0xc5, 0x46, 0x2b, 0x4e, 0x2b, - 0x56, 0x2b, 0x5e, 0x2b, 0x7e, 0x2b, 0x6e, 0x67, - 0xeb, 0x78, 0xb1, 0xca, 0xb6, 0x25, 0x1a, 0x96, - 0xc2, 0xb6, 0x25, 0x1a, 0xb7, 0xca, 0xb6, 0x25, - 0x13, 0x23, 0x0b, 0xc3, 0xa1, 0x25, 0xc1, 0x6f, - 0x9f, 0x67, 0xb5, 0xc9, 0x21, 0x05, 0x00, 0x39, - 0x56, 0x2b, 0x5e, 0x2b, 0x7e, 0x2b, 0x6e, 0x67, - 0xe5, 0x1a, 0x77, 0xb7, 0xca, 0xd4, 0x25, 0x13, - 0x23, 0xc3, 0xc9, 0x25, 0xe1, 0x7c, 0xb5, 0xc9, - 0x21, 0x05, 0x00, 0x39, 0xc5, 0x01, 0xff, 0x7f, - 0xc3, 0xec, 0x25, 0x21, 0x07, 0x00, 0x39, 0xc5, - 0x46, 0x2b, 0x4e, 0x2b, 0x56, 0x2b, 0x5e, 0x2b, - 0x7e, 0x2b, 0x6e, 0x67, 0xe5, 0xaf, 0xbe, 0xca, - 0xfe, 0x25, 0x23, 0xc3, 0xf6, 0x25, 0x78, 0xb1, - 0xca, 0x0f, 0x26, 0x1a, 0x77, 0xb7, 0xca, 0x0f, - 0x26, 0x13, 0x23, 0x0b, 0xc3, 0xfe, 0x25, 0x77, - 0xe1, 0xc1, 0x7c, 0xb5, 0xc9, 0x21, 0x02, 0x00, - 0x39, 0x7e, 0x23, 0x66, 0x6f, 0x11, 0x00, 0x00, - 0xaf, 0xbe, 0xca, 0x2a, 0x26, 0x13, 0x23, 0xc3, - 0x21, 0x26, 0xeb, 0x7d, 0xb4, 0xc9, 0xc5, 0x21, - 0x04, 0x00, 0x39, 0x5e, 0x23, 0x56, 0x23, 0x4e, - 0x23, 0x46, 0x23, 0x6e, 0xeb, 0x78, 0xb1, 0xca, - 0x48, 0x26, 0x73, 0x23, 0x0b, 0xc3, 0x3d, 0x26, - 0xc1, 0xc9, 0xc5, 0x21, 0x09, 0x00, 0x39, 0x46, - 0x2b, 0x4e, 0x2b, 0x56, 0x2b, 0x5e, 0x2b, 0x7e, - 0x2b, 0x6e, 0x67, 0xba, 0xda, 0x86, 0x26, 0xc2, - 0x6a, 0x26, 0x7d, 0xbb, 0xda, 0x86, 0x26, 0xca, - 0x9a, 0x26, 0x09, 0xeb, 0x09, 0xaf, 0xc6, 0x03, - 0xea, 0x7a, 0x26, 0xeb, 0x1b, 0x2b, 0xed, 0xb8, - 0xc1, 0xc9, 0x1b, 0x2b, 0x1a, 0x77, 0x0b, 0x78, - 0xb1, 0xc2, 0x7a, 0x26, 0xc1, 0xc9, 0xaf, 0xc6, - 0x03, 0xea, 0x90, 0x26, 0xed, 0xb0, 0xc1, 0xc9, - 0x7e, 0x12, 0x13, 0x23, 0x0b, 0x78, 0xb1, 0xc2, - 0x90, 0x26, 0xc1, 0xc9, 0xe9, 0xe1, 0xc5, 0x44, - 0x4d, 0x21, 0x00, 0x00, 0x39, 0xeb, 0x39, 0xf9, - 0xd5, 0xdd, 0xe5, 0xfd, 0xe5, 0x60, 0x69, 0xcd, - 0x9c, 0x26, 0xfd, 0xe1, 0xdd, 0xe1, 0xeb, 0xe1, - 0xf9, 0xc1, 0xeb, 0x7c, 0xb5, 0xc9, 0xe1, 0xc5, - 0x44, 0x4d, 0x21, 0x00, 0x00, 0x39, 0xeb, 0x39, - 0xf9, 0xd5, 0x21, 0xb6, 0x26, 0xe5, 0x60, 0x69, - 0xe9, 0x7e, 0x12, 0x23, 0x13, 0x0b, 0x78, 0xb1, - 0xc2, 0xd1, 0x26, 0xc9, 0xd1, 0x21, 0x02, 0x00, - 0x39, 0xaf, 0xc6, 0x03, 0xea, 0xeb, 0x26, 0xdd, - 0xe5, 0xfd, 0xe5, 0xc5, 0xd5, 0x11, 0x5d, 0x2b, - 0x06, 0x06, 0x7e, 0x12, 0x23, 0x13, 0x05, 0xc2, - 0xf2, 0x26, 0x21, 0xff, 0x26, 0xe3, 0xe9, 0xc1, - 0xaf, 0xc6, 0x03, 0xea, 0x0a, 0x27, 0xfd, 0xe1, - 0xdd, 0xe1, 0x7c, 0xb5, 0xc9, 0xc5, 0x44, 0x4d, - 0x21, 0x00, 0x00, 0x3e, 0x10, 0x29, 0xeb, 0x29, - 0xeb, 0xd2, 0x1d, 0x27, 0x09, 0x3d, 0xc2, 0x15, - 0x27, 0xc1, 0x7d, 0xb4, 0xc9, 0xeb, 0x7b, 0xe6, - 0x1f, 0x5f, 0xca, 0x4c, 0x27, 0x7c, 0xb4, 0xf2, - 0x57, 0x27, 0x7c, 0x37, 0x1f, 0x67, 0x7d, 0x1f, - 0x6f, 0x1d, 0xc2, 0x32, 0x27, 0xb4, 0xc9, 0xeb, - 0x7b, 0xe6, 0x1f, 0x5f, 0xca, 0x4c, 0x27, 0x29, - 0x1d, 0xc2, 0x47, 0x27, 0x7d, 0xb4, 0xc9, 0xeb, - 0x7b, 0xe6, 0x1f, 0x5f, 0xca, 0x4c, 0x27, 0x7c, - 0xb7, 0x1f, 0x67, 0x7d, 0x1f, 0x6f, 0x1d, 0xc2, - 0x57, 0x27, 0xb4, 0xc9, 0x7c, 0xa2, 0x67, 0x7d, - 0xa3, 0x6f, 0xb4, 0xc9, 0x7c, 0x2f, 0x67, 0x7d, - 0x2f, 0x6f, 0xb4, 0xc9, 0x7c, 0xb2, 0x67, 0x7d, - 0xb3, 0x6f, 0xb4, 0xc9, 0x7c, 0xaa, 0x67, 0x7d, - 0xab, 0x6f, 0xb4, 0xc9, 0x7c, 0xb5, 0xca, 0xa5, - 0x27, 0xc3, 0x96, 0x27, 0x7d, 0x93, 0xc2, 0x96, - 0x27, 0x7c, 0x92, 0xca, 0xa5, 0x27, 0x21, 0x00, - 0x00, 0xaf, 0xc9, 0x7d, 0x93, 0xc2, 0xa5, 0x27, - 0x7c, 0x92, 0xca, 0x96, 0x27, 0x21, 0x01, 0x00, - 0x7d, 0xb4, 0xc9, 0xeb, 0x7c, 0xaa, 0xfa, 0xbe, - 0x27, 0x7d, 0x93, 0x7c, 0x9a, 0x3f, 0x3e, 0x00, - 0xce, 0x00, 0x6f, 0x26, 0x00, 0xc9, 0x7a, 0x07, - 0xe6, 0x01, 0x6f, 0x26, 0x00, 0xc9, 0xeb, 0x7c, - 0xaa, 0xfa, 0xd8, 0x27, 0x7d, 0x93, 0x7c, 0x9a, - 0x3e, 0x00, 0xce, 0x00, 0x6f, 0x26, 0x00, 0xc9, - 0x7c, 0x07, 0xe6, 0x01, 0x6f, 0x26, 0x00, 0xc9, - 0x7d, 0x2f, 0x6f, 0x7c, 0x2f, 0x67, 0x23, 0x7d, - 0xb4, 0xc9, 0xeb, 0x7d, 0x93, 0x6f, 0x7c, 0x9a, - 0x67, 0xb5, 0xc9, 0xeb, 0xe1, 0xc5, 0x42, 0x4b, - 0x5e, 0x23, 0x56, 0x1b, 0x7a, 0xb7, 0xfa, 0x13, - 0x28, 0x23, 0x79, 0xbe, 0xca, 0x0d, 0x28, 0x23, - 0x23, 0x23, 0xc3, 0xfb, 0x27, 0x23, 0x78, 0xbe, - 0xc2, 0x08, 0x28, 0x23, 0x7e, 0x23, 0x66, 0x6f, - 0xc1, 0xe9, 0xeb, 0x7d, 0x93, 0x7c, 0x9a, 0x3e, - 0x00, 0x3f, 0xce, 0x00, 0x6f, 0x26, 0x00, 0xc9, - 0xeb, 0x7d, 0x93, 0x7c, 0x9a, 0x3e, 0x00, 0xce, - 0x00, 0x6f, 0x26, 0x00, 0xc9, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01, 0x01, - 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, - 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, - 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, - 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, - 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, - 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, - 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, - 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, - 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, - 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, - 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, - 0x01, 0x01, 0x01, 0x01, 0x01, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x8b, 0x05, - 0xb4, 0x05, 0xdd, 0x05, 0x06, 0x06, 0x42, 0xd6, - 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x72, 0x00, - 0x00, 0x00, 0x00, 0x72, 0x2b, 0x00, 0x02, 0x00, - 0x77, 0x00, 0x00, 0x01, 0x03, 0x77, 0x2b, 0x00, - 0x02, 0x03, 0x61, 0x00, 0x00, 0x01, 0x09, 0x61, - 0x2b, 0x00, 0x02, 0x09, 0x78, 0x00, 0x00, 0x01, - 0x05, 0x78, 0x2b, 0x00, 0x02, 0x05, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x01, 0x00, 0x00, 0x01, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x86, 0x29, 0x01, 0x01, 0x00, 0x01, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01, - 0x02, 0x00, 0x01, 0x00, 0xe5, 0x31, 0xd2, 0x32, - 0xd2, 0x2e, 0x07, 0x03, 0x00, 0x00, 0x04, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xce, 0x36, 0x00, 0x3f, - 0x3f, 0x3f, 0x3f, 0x3f, 0x3f, 0x3f, 0x3f, 0x3f, - 0x3f, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, - 0x01, 0x00, 0x8e, 0x15, 0x02, 0x00, 0x00, 0x02, - 0x01, 0x00, 0x8e, 0x15, 0x02, 0x00, 0x00, 0x02, - 0x01, 0x00, 0x8e, 0x15, 0x02, 0x00, 0x00, 0x01, - 0x00, 0x01, 0x5d, 0x19, 0x62, 0x2c, 0x00, 0x00, - 0x00, 0x00, 0x7e, 0x15, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x7e, 0x15, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x7e, 0x15, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x7e, 0x15, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x7e, 0x15, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x7e, 0x15, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x7e, 0x15, 0x00, 0x00, 0x0e, 0x10, - 0x02, 0x02, 0x01, 0x00, 0x8e, 0x15, 0x00, 0x03, - 0x00, 0x00, 0x8e, 0x15, 0x03, 0x00, 0x00, 0x00, - 0x8e, 0x15, 0x01, 0x01, 0x00, 0x01, 0xef, 0x17, - 0x98, 0x15, 0x70, 0x2a, 0x02, 0x00, 0x9d, 0x15, - 0x70, 0x2a, 0x02, 0x00, 0xa2, 0x15, 0x76, 0x2a, - 0x05, 0x00, 0xa7, 0x15, 0x76, 0x2a, 0x05, 0x00, - 0xac, 0x15, 0x76, 0x2a, 0x05, 0x00, 0xb1, 0x15, - 0x76, 0x2a, 0x05, 0x00, 0xb6, 0x15, 0x76, 0x2a, - 0x04, 0x00, 0xbb, 0x15, 0x76, 0x2a, 0x04, 0x00, - 0xc0, 0x15, 0x7c, 0x2a, 0x03, 0x00, 0xc5, 0x15, - 0x7c, 0x2a, 0x03, 0x00, 0x00, 0x00, 0x82, 0x2a, - 0x00, 0x00, 0x7e, 0x15, 0xd8, 0x19, 0x6f, 0x1b, - 0x32, 0x1c, 0x0a, 0x7e, 0x15, 0xcf, 0x1c, 0xef, - 0x1e, 0xef, 0x1e, 0x00, 0x00, 0x20, 0x20, 0x20, - 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x30, 0x30, - 0x30, 0x30, 0x30, 0x20, 0x20, 0x20, 0x20, 0x20, - 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, - 0x20, 0x20, 0x20, 0x20, 0x20, 0x90, 0x40, 0x40, - 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, - 0x40, 0x40, 0x40, 0x40, 0x40, 0x0c, 0x0c, 0x0c, - 0x0c, 0x0c, 0x0c, 0x0c, 0x0c, 0x0c, 0x0c, 0x40, - 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, 0x09, 0x09, - 0x09, 0x09, 0x09, 0x09, 0x01, 0x01, 0x01, 0x01, - 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, - 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, - 0x40, 0x40, 0x40, 0x40, 0x01, 0x40, 0x0a, 0x0a, - 0x0a, 0x0a, 0x0a, 0x0a, 0x02, 0x02, 0x02, 0x02, - 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, - 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, - 0x40, 0x40, 0x40, 0x40, 0x20, 0xb6, 0x26, 0xeb, - 0xd5, 0x2e, 0x2a, 0x00, 0x94, 0x29, 0x00, 0x00, - 0x00, 0x00, 0x15, 0xd7, 0x06, 0x00, 0x01, 0x00, - 0x30, 0x00, 0x10, 0x27, 0x01, 0x00, 0x01, 0x00, - 0x01, 0x00, 0x43, 0xd6, 0x03, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x04, 0xd2, 0x2e, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xfd, 0x14, 0xd5, 0x2b, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x20, 0x53, 0x54, 0x44, - 0x4c, 0x49, 0x42, 0x2e, 0x48, 0x00, 0x4d, 0x01, - 0x00, 0x00, 0x34, 0x04, 0x00, 0x05, 0x00, 0x06, - 0x00, 0x07, 0x00, 0x08, 0x00, 0x09, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x4d, 0x59, 0x44, 0x55, - 0x4d, 0x50, 0x20, 0x20, 0x43, 0x4f, 0x4d, 0x00, - 0x00, 0x00, 0x3b, 0x0a, 0x00, 0x0b, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x43, 0x20, 0x20, 0x20, - 0x20, 0x20, 0x20, 0x20, 0x4c, 0x49, 0x42, 0x01, - 0x00, 0x00, 0x80, 0x10, 0x00, 0x11, 0x00, 0x12, - 0x00, 0x13, 0x00, 0x14, 0x00, 0x15, 0x00, 0x16, - 0x00, 0x17, 0x00, 0x00, 0x43, 0x20, 0x20, 0x20, - 0x20, 0x20, 0x20, 0x20, 0x4c, 0x49, 0x42, 0x02, - 0x00, 0x00, 0x15, 0x18, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x2e, 0x2a, 0x82, 0x2a, 0x03, 0x00, - 0x02, 0x00, 0x00, 0x44, 0x55, 0x4d, 0x50, 0x43, - 0x4f, 0x4d, 0x20, 0x48, 0x20, 0x20, 0x04, 0x00, - 0x00, 0x28, 0x80, 0x02, 0x81, 0x02, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x27, 0x28, 0x02, 0x00, 0x00, 0x02, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x62, 0x2c, 0x08, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xd2, 0x32, 0xb8, 0x2e, 0x00, 0x00, - 0x00, 0x00, 0xb8, 0x2e, 0x01, 0x01, 0xce, 0x32, - 0x00, 0x00, 0x06, 0xd0, 0xce, 0x2e, 0x01, 0x01, - 0x00, 0x00, 0x30, 0x30, 0x2c, 0x20, 0x30, 0x78, - 0x30, 0x30, 0x2c, 0x20, 0x0d, 0x0a, 0x09, 0x30, - 0x78, 0x30, 0x30, 0x2c, 0x20, 0x30, 0x78, 0x30, - 0x30, 0x2c, 0x20, 0x30, 0x78, 0x62, 0x38, 0x2c, - 0x20, 0x30, 0x78, 0x32, 0x65, 0x2c, 0x20, 0x30, - 0x78, 0x30, 0x31, 0x2c, 0x20, 0x30, 0x78, 0x30, - 0x31, 0x2c, 0x20, 0x30, 0x78, 0x63, 0x65, 0x2c, - 0x20, 0x30, 0x78, 0x33, 0x32, 0x2c, 0x20, 0x0d, - 0x0a, 0x09, 0x30, 0x78, 0x30, 0x30, 0x2c, 0x20, - 0x30, 0x78, 0x30, 0x30, 0x2c, 0x20, 0x30, 0x78, - 0x30, 0x36, 0x2c, 0x20, 0x30, 0x78, 0x64, 0x30, - 0x2c, 0x20, 0x30, 0x78, 0x63, 0x65, 0x2c, 0x20, - 0x30, 0x78, 0x32, 0x65, 0x2c, 0x20, 0x30, 0x78, - 0x30, 0x31, 0x2c, 0x20, 0x30, 0x78, 0x30, 0x31, - 0x2c, 0x20, 0x0d, 0x0a, 0x09, 0x30, 0x78, 0x30, - 0x30, 0x2c, 0x20, 0x30, 0x78, 0x30, 0x30, 0x2c, - 0x20, 0x30, 0x78, 0x33, 0x30, 0x2c, 0x20, 0x30, - 0x78, 0x33, 0x30, 0x2c, 0x20, 0x30, 0x78, 0x32, - 0x63, 0x2c, 0x20, 0x30, 0x78, 0x32, 0x30, 0x2c, - 0x20, 0x30, 0x78, 0x33, 0x30, 0x2c, 0x20, 0x30, - 0x78, 0x37, 0x38, 0x2c, 0x20, 0x0d, 0x0a, 0x09, - 0x30, 0x20, 0x30, 0x78, 0x32, 0x30, 0x2c, 0x20, - 0x30, 0x78, 0x33, 0x30, 0x2c, 0x20, 0x30, 0x78, - 0x37, 0x38, 0x2c, 0x20, 0x30, 0x78, 0x33, 0x32, - 0x2c, 0x20, 0x30, 0x78, 0x33, 0x30, 0x2c, 0x20, - 0x30, 0x78, 0x32, 0x63, 0x2c, 0x20, 0x30, 0x78, - 0x32, 0x30, 0x2c, 0x20, 0x0d, 0x0a, 0x09, 0x30, - 0x78, 0x33, 0x30, 0x2c, 0x20, 0x30, 0x78, 0x37, - 0x38, 0x2c, 0x20, 0x30, 0x78, 0x33, 0x33, 0x2c, - 0x20, 0x30, 0x78, 0x33, 0x30, 0x2c, 0x20, 0x30, - 0x78, 0x32, 0x63, 0x2c, 0x20, 0x30, 0x78, 0x32, - 0x30, 0x2c, 0x20, 0x30, 0x78, 0x33, 0x30, 0x2c, - 0x20, 0x30, 0x78, 0x37, 0x38, 0x2c, 0x20, 0x0d, - 0x0a, 0x09, 0x30, 0x78, 0x33, 0x37, 0x2c, 0x20, - 0x30, 0x78, 0x33, 0x38, 0x2c, 0x20, 0x30, 0x78, - 0x32, 0x63, 0x2c, 0x20, 0x30, 0x78, 0x32, 0x30, - 0x2c, 0x20, 0x30, 0x78, 0x33, 0x30, 0x2c, 0x20, - 0x30, 0x78, 0x37, 0x38, 0x2c, 0x20, 0x30, 0x78, - 0x33, 0x33, 0x2c, 0x20, 0x30, 0x78, 0x33, 0x32, - 0x2c, 0x20, 0x0d, 0x0a, 0x09, 0x30, 0x78, 0x32, - 0x63, 0x2c, 0x20, 0x30, 0x78, 0x32, 0x30, 0x2c, - 0x20, 0x30, 0x78, 0x33, 0x30, 0x2c, 0x20, 0x30, - 0x78, 0x37, 0x38, 0x2c, 0x20, 0x30, 0x78, 0x33, - 0x33, 0x2c, 0x20, 0x30, 0x78, 0x33, 0x30, 0x2c, - 0x20, 0x30, 0x78, 0x32, 0x63, 0x2c, 0x20, 0x30, - 0x20, 0x0d, 0x0a, 0x09, 0x30, 0x78, 0x32, 0x30, - 0x2c, 0x20, 0x30, 0x78, 0x30, 0x64, 0x2c, 0x20, - 0x30, 0x78, 0x30, 0x61, 0x2c, 0x20, 0x30, 0x78, - 0x30, 0x39, 0x2c, 0x20, 0x30, 0x78, 0x33, 0x30, - 0x2c, 0x20, 0x30, 0x78, 0x37, 0x38, 0x2c, 0x20, - 0x30, 0x78, 0x33, 0x32, 0x2c, 0x20, 0x30, 0x78, - 0x33, 0x30, 0x2c, 0x20, 0x0d, 0x0a, 0x09, 0x30, - 0x78, 0x32, 0x63, 0x2c, 0x20, 0x30, 0x78, 0x32, - 0x30, 0x2c, 0x20, 0x30, 0x78, 0x33, 0x30, 0x2c, - 0x20, 0x30, 0x78, 0x37, 0x38, 0x2c, 0x20, 0x30, - 0x78, 0x33, 0x30, 0x2c, 0x20, 0x30, 0x78, 0x36, - 0x34, 0x2c, 0x20, 0x30, 0x78, 0x32, 0x63, 0x2c, - 0x20, 0x30, 0x78, 0x32, 0x30, 0x2c, 0x20, 0x0d, - 0x0a, 0x09, 0x30, 0x78, 0x33, 0x30, 0x2c, 0x20, - 0x30, 0x78, 0x37, 0x38, 0x2c, 0x20, 0x30, 0x78, - 0x33, 0x30, 0x2c, 0x20, 0x30, 0x78, 0x36, 0x31, - 0x2c, 0x20, 0x30, 0x78, 0x32, 0x63, 0x2c, 0x20, - 0x30, 0x78, 0x32, 0x30, 0x2c, 0x20, 0x30, 0x78, - 0x33, 0x30, 0x2c, 0x20, 0x30, 0x78, 0x37, 0x38, - 0x2c, 0x20, 0x0d, 0x0a, 0x09, 0x30, 0x78, 0x33, - 0x30, 0x2c, 0x20, 0x30, 0x78, 0x33, 0x39, 0x2c, - 0x20, 0x30, 0x78, 0x32, 0x63, 0x2c, 0x20, 0x30, - 0x78, 0x32, 0x30, 0x2c, 0x20, 0x30, 0x78, 0x33, - 0x30, 0x2c, 0x20, 0x30, 0x78, 0x37, 0x38, 0x33, - 0x38, 0x2c, 0x20, 0x30, 0x78, 0x33, 0x33, 0x2c, - -}; - \ No newline at end of file diff --git a/Apps/Source/dumpmac.asm b/Apps/Source/dumpmac.asm deleted file mode 100644 index 103e7c82..00000000 --- a/Apps/Source/dumpmac.asm +++ /dev/null @@ -1,108 +0,0 @@ -; dumpmac.asm 2/1/2012 dwg - dump macro, declaration and implementation - - maclib portab - maclib globals - maclib hardware - maclib z80 - maclib cpmbdos - maclib printers - - cseg - -; e=char on entry - public x$pr$vis -x$pr$vis: - enter - lxi h,x$visibool - mvi d,0 - dad d - mov a,m - cpi 0 - jz do$dot - mvi c,2 - call BDOS - jmp x$pr$fini -do$dot: - conout '.' -x$pr$fini: - leave - ret - - public x$dump -x$dump: shld x$dump$tmp - call pr$h$word - conout ':' - conout ' ' - mvi b,16 -x$d$lp1: - mov a,m - inx h - xchg - mov l,a - call pr$h$byte - conout ' ' - xchg - dcr b - jnz x$d$lp1 - conout ' ' - conout ' ' - mvi b,16 - lhld x$dump$tmp -x$d$lp2: - mov a,m - inx h - mov e,a - call x$pr$vis - dcr b - jnz x$d$lp2 - conout CR - conout LF - lhld x$dump$tmp - ret - - -; display a number of lines of sixteen bytes in hex with leading address -; and ascii - public x$dump$multi -x$dump$multi: - push h ; save display address in case x$dump changes it - call x$dump ; call actual dump routine for 16 bytes - pop h ; restore display address - lxi d,16 ; get ready to increment it by 16 bytes - dad d ; here we go, HL = new load address - dcr c ; decrement line counter - jnz x$dump$multi ; do more as necessary - ret - - - dseg - -x$dump$tmp ds 2 - - public x$visibool -x$visibool: -; 0 1 2 3 4 5 6 7 8 9 A B C D E F -; - - - - - - - - - - - - - - - - -vb$00 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 -vb$10 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 -vb$20 db 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 ; "#$%&'()*+,-./ -vb$30 db 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 ;0123456789:;<=>? -vb$40 db 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 ;@ABCDEFGHIJKLMNO -vb$50 db 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 ;PQRSTUVWXYZ[\]^_ -vb$60 db 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 ;`abcdefghijklmno -vb$70 db 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0 ;pqrstuvwxyz{|}~ -vb$80 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 -vb$90 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 -vb$a0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 -vb$b0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 -vb$c0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 -vb$d0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 -vb$e0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 -vb$f0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 - -; eof - dumpmac.asm - - - - - \ No newline at end of file diff --git a/Apps/Source/dwg-apps.man b/Apps/Source/dwg-apps.man deleted file mode 100644 index 0944e85b..00000000 --- a/Apps/Source/dwg-apps.man +++ /dev/null @@ -1,16 +0,0 @@ -dwg-apps.man 7/22/2012 dwg - 2.0 Apps - Command syntax - -banker display version and specifics of bnk1, bnk0... -cpmname [-a] display values in syscfg and cnfgdata -setlabel edit drive label of current drive (interactive) -map displays current drives, mapping, and LU labels -map changes LU of specified drive to specified LU # -meta display and/or edit metadata of current drive -rem used in submit file to add remarks -sysgen writes default system onto current drive -sysgen writes specified file onto current drive -sysgen write specified file to specified drive -termtype display and or edit terminal type -view display tables of current and next 3 drives -view { A: | B: | C: | D: | E: | F: | G: | H: } dsply specified & nxt 3 drvs - \ No newline at end of file diff --git a/Apps/Source/editor.c b/Apps/Source/editor.c deleted file mode 100644 index 7f3d0d15..00000000 --- a/Apps/Source/editor.c +++ /dev/null @@ -1,103 +0,0 @@ -/* editor.c 11/18/2012 dwg - */ - - -#include "std.h" -#include "applvers.h" -#include "diagnose.h" -#include "cpmbdos.h" -#include "cpmbios.h" -#include "bdoscall.h" - - -#define VDA_N8 4 -#define VDAINI 0x40 -#define VDAQRY 0x41 -#define VDARES 0x42 -#define VDASCS 0x43 - - -int vdaini(devunit,vidmode,bitmapp) - unsigned int devunit; - unsigned int vidmode; - unsigned int bitmapp; -{ - hregbc = (VDAINI << 8) | devunit; - hregde = vidmode; - hreghl = bitmapp; - diagnose(); - return hrega; -} - - -bitlook() -{ - unsigned char *p; - int ascii,row; - - p = 0x8000; - for(ascii=0;ascii<256;ascii++) { - printf("ascii = 0x%02x ",ascii); - for(row=0l;row<8;row++) { - printf("0x%02x ",*p++); - } - printf("\n"); - } -} - - -int vdaqry(devunit,bitmapp) - unsigned int devunit; - unsigned int bitmapp; -{ - hregbc = (VDAQRY << 8) | devunit; - hreghl = bitmapp; - diagnose(); - return hrega; -} - - -flip() -{ - unsigned char * p; - unsigned char byte; - int offs; - int retcode; - - retcode = vdaqry(VDA_N8 << 4,0x8000); - - p = 0x8000; - for(offs=0;offs<256*8;offs++) { - byte = *p; - byte = byte ^ 255; - *p = byte; - p++; - } - -/* bitlook(); */ - - vdaini(VDA_N8 << 4, 0, 0x8000); -} - - -int main(argc,argv) - int argc; - char *argv[]; -{ - int bRunning; - - bRunning = 1; - while(1 == bRunning) { - - crtlc ( - dregbc = 1; - bdoscall(); - switch(drega) { - case 'f': flip(); break; - case 3: bRunning = 0; break; - default: printf("%c",7); break; - } - } - - flip(); -} - \ No newline at end of file diff --git a/Apps/Source/ffgetlu.lib b/Apps/Source/ffgetlu.lib deleted file mode 100644 index 24dad41d..00000000 --- a/Apps/Source/ffgetlu.lib +++ /dev/null @@ -1,12 +0,0 @@ -; ffsetlu.lib 1/24/2012 dwg - -ffgetlu macro - mvi c,RETCURR - call BDOS - mov c,a - call BISELDSK - lxi d,16+2 - dad d - mov a,m - endm -; eof - ffsetlu - \ No newline at end of file diff --git a/Apps/Source/ffhaslu.lib b/Apps/Source/ffhaslu.lib deleted file mode 100644 index e9e84b31..00000000 --- a/Apps/Source/ffhaslu.lib +++ /dev/null @@ -1,25 +0,0 @@ -; ffhaslu.lib 1/22/2012 dwg - macro to detect drive with logical unit support - -ffhaslu macro - local ret$false,fini - mvi c,RETCURR - call BDOS - mov c,a - call BISELDSK - lxi d,16 ; offset to end of DPH - dad d ; calc offset of 1st signature byte - mov a,m ; pick up first sig byte which s/b 'L' - cpi 'L' - jnz ret$false ; if it wasn't, indicate to caller no LU - inx h ; bump ptr to 2nd signature byte - mov a,m ; pick up second sig byte which s/b 'U' - cpi 'U' - jnz ret$false ; if it wasn't, indicate to caller no LU - mvi a,TRUE ; otherwise indicate presence of LU support - jmp fini ; finish up macro -ret$false: - mvi a,FALSE ; prepare negative response for caller -fini: - endm - - \ No newline at end of file diff --git a/Apps/Source/ffnumlu.lib b/Apps/Source/ffnumlu.lib deleted file mode 100644 index 1f1048a5..00000000 --- a/Apps/Source/ffnumlu.lib +++ /dev/null @@ -1,13 +0,0 @@ -; ffnumlu.lib 1/22/2012 dwg - macro to get number of logical units - -ffnumlu macro - mvi c,RETCURR - call BDOS - mov c,a - call BISELDSK - lxi d,16+2+2 ; offset to end of DPH - dad d ; calc offset of 1st signature byte - mov a,m - endm - -; eof - ffnumlu.lib diff --git a/Apps/Source/ffsetlu.lib b/Apps/Source/ffsetlu.lib deleted file mode 100644 index fe1db586..00000000 --- a/Apps/Source/ffsetlu.lib +++ /dev/null @@ -1,22 +0,0 @@ -; ffsetlu.lib 2/12/2012 dwg - review for use in superfmt -; ffsetlu.lib 1/24/2012 dwg - - -; enter with desired LU in A reg -ffsetlu macro - enter - push psw - mvi c,RETCURR - call BDOS - mov c,a - call BISELDSK ; uses c parameter (drive) - lxi d,16+2 - dad d - pop psw - mov m,a ; put slice into CURRENT - mvi c,13 - call BDOS - leave - endm - -; eof - ffsetlu - \ No newline at end of file diff --git a/Apps/Source/findfile.asm b/Apps/Source/findfile.asm deleted file mode 100644 index d8ceb21a..00000000 --- a/Apps/Source/findfile.asm +++ /dev/null @@ -1,1088 +0,0 @@ -; findfile.asm 7/21/2012 dwg - added keystroke scan terminate -; findfile.asm 7/19/2012 dwg - for 2.0.0.0 B22 -; findfile.asm 2/20.2012 dwg - add RESET$DISK before exit for ZDOS -; findfile.asm 2/17/2012 dwg - review for release 1.5.1.0 -; findfile.asm 2/11/2012 dwg - make ident compliant -; findfile.asm 1/30/2012 dwg - use new do$start and do$end macros -; findfile.asm 1/22/2012 dwg - find a file on any slice - -; Copyright (C) 2011-2012 Douglas Goodall Licensed under GPL Ver 3. -; -; This file is part of NuBiosDWG and is free software: you can -; redistribute it and/or modify it under the terms of the GNU -; General Public License as published by the Free Software Foundation, -; either version 3 of the License, or (at your option) any later version. -; This file is distributed in the hope that it will be useful, -; but WITHOUT ANY WARRANTY; without even the implied warranty of -; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -; GNU General Public License for more details. -; You should have received a copy of the GNU General Public License -; along with it. If not, see . - - maclib portab - maclib globals - maclib stdlib - maclib cpmbios - maclib cpmbdos - maclib bioshdr - maclib printers - maclib banner - maclib terminal - maclib applvers - maclib version -; maclib ffhaslu -; maclib ffnumlu -; maclib ffsetlu -; maclib ffgetlu -; maclib z80 -; maclib memory -; maclib cpmappl -; maclib identity - -; identity.lib 2/19/2012 dwg - add ify macro -; identity.lib 2/17/2012 dwg - Program Identity Declarations - - extrn x$ident - -ident macro file1fcb - lxi h,file1fcb - call x$ident - endm - -ify macro progname,bool - local done - local file - local fini - ident file - jmp fini - newfcb file,0,progname -fini: mvi a,bool - cpi TRUE - jnz done - conout CR - conout LF -done: - endm - - -identx macro file1fcb - local openok - local identend - - local ldrive,lcolon,lname,ldot,lext,lterm - - mvi c,FOPEN - lxi d,file1fcb - call BDOS - cpi 255 - jnz openok - - memcpy lname,file1fcb+1,8 - mvi a,',' - sta ldot - memcpy lext,file1fcb+9,3 - mvi a,'$' - sta lterm - print lname - printf ' -- File Not Found' - jmp identend -openok: - - mvi c,SETDMA - lxi d,buffer - call BDOS - - mvi c,READSEQ - lxi d,file1fcb - call BDOS - - mvi c,FCLOSE - lxi d,file1fcb - call BDOS - - lxi d,d$prog - mvi c,9 - call BDOS - - conout ',' - conout ' ' - lda p$rmj - mov l,a - mvi h,0 - call pr$d$word - conout '.' - lda p$rmn - mov l,a - call pr$d$word - conout '.' - lda p$rup - mov l,a - call pr$d$word - conout '.' - lda p$rtp - mov l,a - call pr$d$word - conout ',' - conout ' ' - - lda p$mon - mov l,a - call pr$d$word - conout '/' - lda p$day - mov l,a - call pr$d$word - conout '/' - lhld p$year - call pr$d$word - conout ',' - conout ' ' - - lxi d,d$prod - mvi c,9 - call BDOS - conout ',' - conout ' ' - - lxi d,d$orig - mvi c,9 - call BDOS - conout ',' - conout ' ' - - lxi d,d$ser - mvi c,9 - call BDOS - conout ',' - conout ' ' - - lxi d,d$name - mvi c,9 - call BDOS - jmp identend - -ldrive ds 1 -lcolon ds 1 -lname ds 8 -ldot ds 1 -lext ds 3 -lterm ds 1 - -identend: - endm - -idata macro - jmp around$bandata -argv dw prog,dat,prod,orig,ser,myname,0 -prog db 'IDENT.COM $' - date - serial - product - originator - oriname -uuid db '777A67C2-4A92-42D4-80FE-C96FD6483BD2$' - db 'buffer-->' - public buffer,p$start,p$hexrf,p$sig - public p$rmj,p$rmn,p$rup,p$rtp - public p$mon,p$day,p$year -buffer ds 1 -p$start ds 2 -p$hexrf ds 16 -p$sig ds 2 -p$rmj ds 1 -p$rmn ds 1 -p$rup ds 1 -p$rtp ds 1 -p$mon ds 1 -p$day ds 1 -p$year ds 2 -p$argv ds 2 -p$e5 ds 1 -p$pr$st ds 2 -p$code1 ds 3 ; begin: lxi h,0 -p$code2 ds 1 ; dad sp -p$code3 ds 3 ; shld pre$stk -p$code4 ds 3 ; lxi sp,stack$top -p$code5 ds 1 ; nop -p$code6 ds 3 ; jmp around$bandata -p$prog ds 2 ; dw prog -p$dat ds 2 ; dw dat -p$prod ds 2 ; dw prod -p$orig ds 2 ; dw orig -p$ser ds 2 ; dw ser -p$nam ds 2 ; dw nam -p$term ds 2 ; dw 0 -d$prog ds 8+1+3+1 ; db '12345678.123$' -d$date ds 2+1+2+1+4+1 ; db ' 2/11/2012$' -d$ser ds 6+1 ; db '654321$' -d$prod ds 5+1 ; db 'CPM80$' -d$orig ds 3+1 ; db 'DWG$' -d$name ds 1+7+1+1+1+1+7+1 ; db ' Douglas W. Goodall$' -d$uuid ds 37 ; unique user identification -d$term2 ds 1 ; can be set to zero or dollar sign -p$len equ $-buffer -p$rsvd ds 128-p$len - db '<--buffer' -crlf db CR,LF,'$' -around$bandata: - - endm - -; eof - identity.lib - - - -; cpmappl.lib 2/10/2012 dwg - begin 1.6 development -; cpmappl.lib 2/04/2012 dwg - fix typo mov becomes mvi -; cpmappl.lib 2/ 2/2012 dwg - initial version - -; -; Copyright (C) 2011-2012 Douglas Goodall Licensed under GPL Ver 3. -; -; This file is part of NuBiosDWG and is free software: you can -; redistribute it and/or modify it under the terms of the GNU -; General Public License as published by the Free Software Foundation, -; either version 3 of the License, or (at your option) any later version. -; This file is distributed in the hope that it will be useful, -; but WITHOUT ANY WARRANTY; without even the implied warranty of -; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -; GNU General Public License for more details. -; You should have received a copy of the GNU General Public License -; along with it. If not, see . -; - -do$start macro - -start: jmp begin - - public hexref -hexref db '0123456789ABCDEF' - - public id$sig,id$rmj,id$rmn,id$rup,id$rtp,id$mon,id$day,id$yr -id$sig db 'ID' -id$rmj db A$RMJ -id$rmn db A$RMN -id$rup db A$RUP -id$rtp db A$RTP -id$mon db A$MONTH -id$day db A$DAY -id$yr dw A$YEAR -id$argv dw argv - db 0e5h - - - public pre$stk -pre$stk ds 2 - - public begin -begin: lxi h,0 - dad sp - shld pre$stk - lxi sp,stack$top - nop - endm - - -;--------------------------------- - - -do$end macro - lhld pre$stk - sphl - - mvi c,13 - call BDOS - - ret - ds stack$size -stack$top: - - endm - -movfcb macro destn,source - lxi d,destn - lxi h,source - lxi b,LENFCB - ldir - endm - -copyfcb macro fcbname,source - local around - jmp around -fcbname ds 32 -around: - endm - - -; memory.lib 2/17/2012 dwg - review for release 1.5.1.0 -; memory.lib 2/11/2012 dwg - review for release 1.5 -; memory.lib 2/04/2012 dwg - adjust for new macros -; memory.lib 1/13/2012 dwg - POSIX memcpy and memset - - extrn x$memcpy - extrn x$memset - -memcpy macro dst,src,siz - lxi d,dst ; load 1st positional parameter into reg - lxi h,src ; load 2nd positional parameter into reg - lxi b,siz ; load 3rd positional parameter into reg - call x$memcpy ; call actual routine in see memory.asm - endm - -memset macro dst,data,siz - lxi h,dst ; load 1st positional parameter into reg - mvi a,data ; load 2nd positional parameter into reg - lxi b,siz ; load 3rd positional parameter into reg - call x$memset ; call actual routine in see memory.asm - endm - -; eof - memory.lib - - -; @CHK MACRO USED FOR CHECKING 8 BIT DISPLACMENTS -; -@CHK MACRO ?DD ;; USED FOR CHECKING RANGE OF 8-BIT DISP.S - IF (?DD GT 7FH) AND (?DD LT 0FF80H) - 'DISPLACEMENT RANGE ERROR - Z80 LIB' - ENDIF - ENDM -LDX MACRO ?R,?D - @CHK ?D - DB 0DDH,?R*8+46H,?D - ENDM -LDY MACRO ?R,?D - @CHK ?D - DB 0FDH,?R*8+46H,?D - ENDM -STX MACRO ?R,?D - @CHK ?D - DB 0DDH,70H+?R,?D - ENDM -STY MACRO ?R,?D - @CHK ?D - DB 0FDH,70H+?R,?D - ENDM -MVIX MACRO ?N,?D - @CHK ?D - DB 0DDH,36H,?D,?N - ENDM -MVIY MACRO ?N,?D - @CHK ?D - DB 0FDH,36H,?D,?N - ENDM -LDAI MACRO - DB 0EDH,57H - ENDM -LDAR MACRO - DB 0EDH,5FH - ENDM -STAI MACRO - DB 0EDH,47H - ENDM -STAR MACRO - DB 0EDH,4FH - ENDM - -LXIX MACRO ?NNNN - DB 0DDH,21H - DW ?NNNN - ENDM -LXIY MACRO ?NNNN - DB 0FDH,21H - DW ?NNNN - ENDM -LDED MACRO ?NNNN - DB 0EDH,5BH - DW ?NNNN - ENDM -LBCD MACRO ?NNNN - DB 0EDH,4BH - DW ?NNNN - ENDM -LSPD MACRO ?NNNN - DB 0EDH,07BH - DW ?NNNN - ENDM -LIXD MACRO ?NNNN - DB 0DDH,2AH - DW ?NNNN - ENDM -LIYD MACRO ?NNNN - DB 0FDH,2AH - DW ?NNNN - ENDM -SBCD MACRO ?NNNN - DB 0EDH,43H - DW ?NNNN - ENDM -SDED MACRO ?NNNN - DB 0EDH,53H - DW ?NNNN - ENDM -SSPD MACRO ?NNNN - DB 0EDH,73H - DW ?NNNN - ENDM -SIXD MACRO ?NNNN - DB 0DDH,22H - DW ?NNNN - ENDM -SIYD MACRO ?NNNN - DB 0FDH,22H - DW ?NNNN - ENDM -SPIX MACRO - DB 0DDH,0F9H - ENDM -SPIY MACRO - DB 0FDH,0F9H - ENDM -PUSHIX MACRO - DB 0DDH,0E5H - ENDM -PUSHIY MACRO - DB 0FDH,0E5H - ENDM -POPIX MACRO - DB 0DDH,0E1H - ENDM -POPIY MACRO - DB 0FDH,0E1H - ENDM -EXAF MACRO - DB 08H - ENDM -EXX MACRO - DB 0D9H - ENDM -XTIX MACRO - DB 0DDH,0E3H - ENDM -XTIY MACRO - DB 0FDH,0E3H - ENDM - -LDI MACRO - DB 0EDH,0A0H - ENDM -LDIR MACRO - DB 0EDH,0B0H - ENDM -LDD MACRO - DB 0EDH,0A8H - ENDM -LDDR MACRO - DB 0EDH,0B8H - ENDM -CCI MACRO - DB 0EDH,0A1H - ENDM -CCIR MACRO - DB 0EDH,0B1H - ENDM -CCD MACRO - DB 0EDH,0A9H - ENDM -CCDR MACRO - DB 0EDH,0B9H - ENDM - -ADDX MACRO ?D - @CHK ?D - DB 0DDH,86H,?D - ENDM -ADDY MACRO ?D - @CHK ?D - DB 0FDH,86H,?D - ENDM -ADCX MACRO ?D - @CHK ?D - DB 0DDH,8EH,?D - ENDM -ADCY MACRO ?D - @CHK ?D - DB 0FDH,8EH,?D - ENDM -SUBX MACRO ?D - @CHK ?D - DB 0DDH,96H,?D - ENDM -SUBY MACRO ?D - @CHK ?D - DB 0FDH,96H,?D - ENDM -SBCX MACRO ?D - @CHK ?D - DB 0DDH,9EH,?D - ENDM -SBCY MACRO ?D - @CHK ?D - DB 0FDH,9EH,?D - ENDM -ANDX MACRO ?D - @CHK ?D - DB 0DDH,0A6H,?D - ENDM -ANDY MACRO ?D - @CHK ?D - DB 0FDH,0A6H,?D - ENDM -XORX MACRO ?D - @CHK ?D - DB 0DDH,0AEH,?D - ENDM -XORY MACRO ?D - @CHK ?D - DB 0FDH,0AEH,?D - ENDM -ORX MACRO ?D - @CHK ?D - DB 0DDH,0B6H,?D - ENDM -ORY MACRO ?D - @CHK ?D - DB 0FDH,0B6H,?D - ENDM -CMPX MACRO ?D - @CHK ?D - DB 0DDH,0BEH,?D - ENDM -CMPY MACRO ?D - @CHK ?D - DB 0FDH,0BEH,?D - ENDM -INRX MACRO ?D - @CHK ?D - DB 0DDH,34H,?D - ENDM -INRY MACRO ?D - @CHK ?D - DB 0FDH,34H,?D - ENDM -DCRX MACRO ?D - @CHK ?D - DB 0DDH,035H,?D - ENDM -DCRY MACRO ?D - @CHK ?D - DB 0FDH,35H,?D - ENDM - -NEG MACRO - DB 0EDH,44H - ENDM -IM0 MACRO - DB 0EDH,46H - ENDM -IM1 MACRO - DB 0EDH,56H - ENDM -IM2 MACRO - DB 0EDH,5EH - ENDM - - -BC EQU 0 -DE EQU 2 -HL EQU 4 -IX EQU 4 -IY EQU 4 -DADC MACRO ?R - DB 0EDH,?R*8+4AH - ENDM -DSBC MACRO ?R - DB 0EDH,?R*8+42H - ENDM -DADX MACRO ?R - DB 0DDH,?R*8+09H - ENDM -DADY MACRO ?R - DB 0FDH,?R*8+09H - ENDM -INXIX MACRO - DB 0DDH,23H - ENDM -INXIY MACRO - DB 0FDH,23H - ENDM -DCXIX MACRO - DB 0DDH,2BH - ENDM -DCXIY MACRO - DB 0FDH,2BH - ENDM - -BIT MACRO ?N,?R - DB 0CBH,?N*8+?R+40H - ENDM -SETB MACRO ?N,?R - DB 0CBH,?N*8+?R+0C0H - ENDM -RES MACRO ?N,?R - DB 0CBH,?N*8+?R+80H - ENDM - -BITX MACRO ?N,?D - @CHK ?D - DB 0DDH,0CBH,?D,?N*8+46H - ENDM -BITY MACRO ?N,?D - @CHK ?D - DB 0FDH,0CBH,?D,?N*8+46H - ENDM -SETX MACRO ?N,?D - @CHK ?D - DB 0DDH,0CBH,?D,?N*8+0C6H - ENDM -SETY MACRO ?N,?D - @CHK ?D - DB 0FDH,0CBH,?D,?N*8+0C6H - ENDM -RESX MACRO ?N,?D - @CHK ?D - DB 0DDH,0CBH,?D,?N*8+86H - ENDM -RESY MACRO ?N,?D - @CHK ?D - DB 0FDH,0CBH,?D,?N*8+86H - ENDM - -JR MACRO ?N - DB 18H,?N-$-1 - ENDM -JRC MACRO ?N - DB 38H,?N-$-1 - ENDM -JRNC MACRO ?N - DB 30H,?N-$-1 - ENDM -JRZ MACRO ?N - DB 28H,?N-$-1 - ENDM -JRNZ MACRO ?N - DB 20H,?N-$-1 - ENDM -DJNZ MACRO ?N - DB 10H,?N-$-1 - ENDM - -PCIX MACRO - DB 0DDH,0E9H - ENDM -PCIY MACRO - DB 0FDH,0E9H - ENDM - -RETI MACRO - DB 0EDH,4DH - ENDM -RETN MACRO - DB 0EDH,45H - ENDM - -INP MACRO ?R - DB 0EDH,?R*8+40H - ENDM -OUTP MACRO ?R - DB 0EDH,?R*8+41H - ENDM -INI MACRO - DB 0EDH,0A2H - ENDM -INIR MACRO - DB 0EDH,0B2H - ENDM -IND MACRO - DB 0EDH,0AAH - ENDM -INDR MACRO - DB 0EDH,0BAH - ENDM -OUTI MACRO - DB 0EDH,0A3H - ENDM -OUTIR MACRO - DB 0EDH,0B3H - ENDM -OUTD MACRO - DB 0EDH,0ABH - ENDM -OUTDR MACRO - DB 0EDH,0BBH - ENDM - - -RLCR MACRO ?R - DB 0CBH, 00H + ?R - ENDM -RLCX MACRO ?D - @CHK ?D - DB 0DDH, 0CBH, ?D, 06H - ENDM -RLCY MACRO ?D - @CHK ?D - DB 0FDH, 0CBH, ?D, 06H - ENDM -RALR MACRO ?R - DB 0CBH, 10H+?R - ENDM -RALX MACRO ?D - @CHK ?D - DB 0DDH, 0CBH, ?D, 16H - ENDM -RALY MACRO ?D - @CHK ?D - DB 0FDH, 0CBH, ?D, 16H - ENDM -RRCR MACRO ?R - DB 0CBH, 08H + ?R - ENDM -RRCX MACRO ?D - @CHK ?D - DB 0DDH, 0CBH, ?D, 0EH - ENDM -RRCY MACRO ?D - @CHK ?D - DB 0FDH, 0CBH, ?D, 0EH - ENDM -RARR MACRO ?R - DB 0CBH, 18H + ?R - ENDM -RARX MACRO ?D - @CHK ?D - DB 0DDH, 0CBH, ?D, 1EH - ENDM -RARY MACRO ?D - @CHK ?D - DB 0FDH, 0CBH, ?D, 1EH - ENDM -SLAR MACRO ?R - DB 0CBH, 20H + ?R - ENDM -SLAX MACRO ?D - @CHK ?D - DB 0DDH, 0CBH, ?D, 26H - ENDM -SLAY MACRO ?D - @CHK ?D - DB 0FDH, 0CBH, ?D, 26H - ENDM -SRAR MACRO ?R - DB 0CBH, 28H+?R - ENDM -SRAX MACRO ?D - @CHK ?D - DB 0DDH, 0CBH, ?D, 2EH - ENDM -SRAY MACRO ?D - @CHK ?D - DB 0FDH, 0CBH, ?D, 2EH - ENDM -SRLR MACRO ?R - DB 0CBH, 38H + ?R - ENDM -SRLX MACRO ?D - @CHK ?D - DB 0DDH, 0CBH, ?D, 3EH - ENDM -SRLY MACRO ?D - @CHK ?D - DB 0FDH, 0CBH, ?D, 3EH - ENDM -RLD MACRO - DB 0EDH, 6FH - ENDM -RRD MACRO - DB 0EDH, 67H - ENDM - -; ffsetlu.lib 1/24/2012 dwg - -ffgetlu macro - mvi c,RETCURR - call BDOS - mov c,a - call BISELDSK - lxi d,16+2 - dad d - mov a,m - endm -; eof - ffsetlu - - -; ffsetlu.lib 2/12/2012 dwg - review for use in superfmt -; ffsetlu.lib 1/24/2012 dwg - - -; enter with desired LU in A reg -ffsetlu macro - enter - push psw - mvi c,RETCURR - call BDOS - mov c,a - call BISELDSK ; uses c parameter (drive) - lxi d,16+2 - dad d - pop psw - mov m,a ; put slice into CURRENT - mvi c,13 - call BDOS - leave - endm - -; eof - ffsetlu - - -; ffhaslu.lib 1/22/2012 dwg - macro to detect drive with logical unit support - -ffhaslu macro - local ret$false,fini - mvi c,RETCURR - call BDOS - mov c,a - call BISELDSK - lxi d,16 ; offset to end of DPH - dad d ; calc offset of 1st signature byte - mov a,m ; pick up first sig byte which s/b 'L' - cpi 'L' - jnz ret$false ; if it wasn't, indicate to caller no LU - inx h ; bump ptr to 2nd signature byte - mov a,m ; pick up second sig byte which s/b 'U' - cpi 'U' - jnz ret$false ; if it wasn't, indicate to caller no LU - mvi a,TRUE ; otherwise indicate presence of LU support - jmp fini ; finish up macro -ret$false: - mvi a,FALSE ; prepare negative response for caller -fini: - endm - - - -; ffnumlu.lib 1/22/2012 dwg - macro to get number of logical units - -ffnumlu macro - mvi c,RETCURR - call BDOS - mov c,a - call BISELDSK - lxi d,16+2+2 ; offset to end of DPH - dad d ; calc offset of 1st signature byte - mov a,m - endm - -; eof - ffnumlu.lib - - - -prfilnam macro fcb - local fnbuf,fnext,prfnfini - memcpy fnbuf,fcb+1,8 - memcpy fnext,fcb+9,3 - - lda fnext - ani 07fh - sta fnext - - lda fnext+1 - ani 07fh - sta fnext+1 - - lda fnext+2 - ani 07fh - sta fnext+2 - - mvi c,9 - lxi d,fnbuf - call BDOS - - jmp prfnfini - -fnbuf db 0,0,0,0,0,0,0,0 - db '.' -fnext db 0,0,0,' $' -prfnfini: - endm - - - do$start - - - jmp around$bandata -argv dw prog,dat,prod,orig,ser,myname,0 -prog db 'FINDFILE.COM$' - date - serial - product - originator - oriname -uuid db '107CDD27-2E4D-4340-A324-BEB13054E67B$' -around$bandata: - - - crtinit - crtclr - crtlc 1,1 - sbanner argv -; version wrnmsg,errmsg - - lda 80h - cpi 0 - jnz no$usage - print crlf - printf 'usage - findfile ' - jmp all$done -no$usage: - - - memcpy work$fcb,PRIFCB,32 - - printf 'Finding: ' - memcpy PRIFCB,work$fcb,16 - - mvi a,'$' - sta PRIFCB+9 - print PRIFCB+1 - conout '.' - memcpy PRIFCB,work$fcb,16 - mvi a,'$' - sta PRIFCB+12 - print PRIFCB+9 - print crlf - - ffhaslu - cpi TRUE - jz do$lu - memcpy PRIFCB,work$fcb,32 - mvi c,FOPEN - lxi d,PRIFCB - call BDOS - cpi 255 - jnz single$true - jmp all$done -single$true: - printf 'Found' - jmp all$done - -do$lu: - ffgetlu - sta entry$lu - ; - ffnumlu - sta lu$cnt - ; - mov l,a - mvi h,0 - call pr$d$word - printf ' Logical Units Detected' - print crlf - - mvi a,0 - sta lu$num -loop: - printf 'Scanning Logical Unit ' - lda lu$num - mov l,a - mvi h,0 - call pr$d$word - conout ' ' - - ; set the Logical Unit - lda lu$num - ffsetlu - - ; test for the target file - memcpy PRIFCB,work$fcb,32 - mvi c,FOPEN - lxi d,PRIFCB - call BDOS - sta retcode - - lda retcode - cpi 255 - jz not$yet - conout CR - prfilnam PRIFCB - printf ' ' - printf 'Found on Logical Unit ' - lda lu$num - mov l,a - mvi h,0 - call pr$d$word - conout ',' - conout '(' - lda drv$num - mov c,a - call BISELDSK - lxi b,0 - call BISETTRK - lxi b,11 - call BISETSEC - lxi b,buffer - call BISETDMA - call BIREAD - - mvi a,'$' - sta buffer+128-8-1 - print buffer+128-8-1-16 - conout ')' - - mvi c,FCLOSE - lxi d,PRIFCB - call BDOS - conout LF -not$yet: - conout CR - - ; Check for key hit interrupt scan - mvi c,11 ; get console status - caLL BDOS - cpi 0 - jz nyok ; jump if no key hit - jmp abort ; gracefully exit loop -nyok: - - - lda lu$num - inr a - sta lu$num - ; - lda lu$cnt - dcr a - sta lu$cnt - cpi 0 - jnz loop - - printf ' ' - -abort: conout cr - printf 'Scan Completed ' - -all$done: - lda entry$lu - ffsetlu - - mvi c,RESET$DRIVE ; call to logout drive - lxi d,0ffh - call BDOS - - do$end - - -wrnmsg db 'By the way, this program is newer than the BIOS$' - -errmsg db 'Sorry, this program requires a newer BIOS$' - -crlf db CR,LF -term db '$' - -drv$num ds 1 ; drive code of current drive -lu$cnt ds 1 ; number of slices on drive -lu$num ds 1 ; slice index -entry$lu ds 1 -retcode ds 1 - -work$fcb ds 64 -buffer ds 80h - - - end start diff --git a/Apps/Source/flip.c b/Apps/Source/flip.c deleted file mode 100644 index bb740907..00000000 --- a/Apps/Source/flip.c +++ /dev/null @@ -1,98 +0,0 @@ -/* flip.c 11/17/2012 dwg - reverse the contrast */ - -#include "std.h" -#include "applvers.h" -#include "diagnose.h" - -#define VDA_N8 4 -#define VDAINI 0x40 -#define VDAQRY 0x41 -#define VDARES 0x42 -#define VDASCS 0x43 - -int vdaini(devunit,vidmode,bitmapp) - unsigned int devunit; - unsigned int vidmode; - unsigned int bitmapp; -{ - hregbc = (VDAINI << 8) | devunit; - printf("hregbc = 0x%04x\n",hregbc); - hregde = vidmode; - printf("hregde = 0x%04x\n",hregde); - hreghl = bitmapp; - printf("hreghl = 0x%04x\n",hreghl); - diagnose(); - printf("VDAINI called, return code was 0x%02x\n",hrega); - return hrega; -} - -bitlook() -{ - unsigned char *p; - int ascii,row; - - p = 0x8000; - for(ascii=0;ascii<256;ascii++) { - printf("ascii = 0x%02x ",ascii); - for(row=0l;row<8;row++) { - printf("0x%02x ",*p++); - } - printf("\n"); - } -} - -int vdaqry(devunit,bitmapp) - unsigned int devunit; - unsigned int bitmapp; -{ - hregbc = (VDAQRY << 8) | devunit; - printf("hregbc = 0x%04x\n",hregbc); - hreghl = bitmapp; - - if(hreghl != 0x8000) printf("vdaqry says hl != 0x8000\n"); - - diagnose(); - printf("VDAQRY called, status was 0x%02x\n",hrega); - printf(" video mode was 0x%02x\n",hregbc & 255); - printf(" row count was 0x%02x(%d)\n", - (hregde >> 8),(hregde >> 8) ); - printf(" column count was 0x%02x(%d)\n", - hregde & 255, hregde & 255); - -/* if(0 != bitmapp) { - printf("vdaqry called with bitmap pointer\n"); - bitlook(); - } -*/ - - return hrega; -} - - -int main(argc,argv) - int argc; - char *argv[]; -{ - unsigned char * p; - unsigned char byte; - int offs; - int retcode; - - printf("flip.com(c) 11/15/2012 dwg - \n\n"); - - retcode = vdaqry(VDA_N8 << 4,0x8000); - - p = 0x8000; - for(offs=0;offs<256*8;offs++) { - byte = *p; - byte = byte ^ 255; - *p = byte; - p++; - } - -/* bitlook(); */ - - vdaini(VDA_N8 << 4, 0, 0x8000); -} - - \ No newline at end of file diff --git a/Apps/Source/form.c b/Apps/Source/form.c deleted file mode 100644 index 8bae233c..00000000 --- a/Apps/Source/form.c +++ /dev/null @@ -1,107 +0,0 @@ -/* form.c 8/21/2012 dwg - */ - - -#define MAXDRIVE 8 -#include "cpm80.h" -#include "cpmbdos.h" -#include "bdoscall.h" -#include "cpmappl.h" -#include "applvers.h" -#include "cnfgdata.h" -#include "syscfg.h" - - -#define BDOS 5 /* memory address of BDOS invocation */ -#define HIGHSEG 0x0C000 /* memory address of system config */ -#define GETSYSCFG 0x0F000 /* HBIOS function for Get System Configuration */ - - -struct SYSCFG * pSYSCFG = HIGHSEG; - -#define FRMFLDS 2 -#define FRSTLIN 6 -#define VISCOL 3 -#define VISSIZ 6 -#define VALCOL (VISCOL+VISSIZ+4) -#define VALSIZ 32 - -struct FORM { - int visline; - int viscol; - int vissize; - char visible[VISSIZ+1]; - int valline; - int valcol; - char value[VALSIZ+1]; -} form[FRMFLDS] = { - { FRSTLIN, VISCOL, VISSIZ, "field1", FRSTLIN, VALCOL, "default1" }, - { FRSTLIN+1, VISCOL, VISSIZ, "field2", FRSTLIN+1, VALCOL, "default2" } -}; - - -int main(argc,argv) - int argc; - char *argv[]; -{ - int i,j; - char buffer[VALSIZ+2]; - - hregbc = GETSYSCFG; /* function = Get System Config */ - hregde = HIGHSEG; /* addr of dest (must be high) */ - diagnose(); /* invoke the NBIOS function */ - pSYSCFG = HIGHSEG; - - crtinit(pSYSCFG->cnfgdata.termtype); - crtclr(); - crtlc(0,0); - - banner("FORM"); - - for(i=0;i -#include "ascii.h" - -main() -{ - printf("%c",ASCII_FF); -} - \ No newline at end of file diff --git a/Apps/Source/getcfg.c b/Apps/Source/getcfg.c deleted file mode 100644 index 72fa186d..00000000 --- a/Apps/Source/getcfg.c +++ /dev/null @@ -1,333 +0,0 @@ -/* test.c 7/23/2012 dwg - */ - -#include "stdio.h" -#include "applvers.h" -#include "ctermcap.h" - -/* declarations for HBIOS access */ -extern char hrega; -extern unsigned int hregbc; -extern unsigned int hregde; -extern unsigned int hreghl; -extern diagnose(); - -/* declaration dir BIOS and BDOS and low level calls */ -extern char xrega; -extern unsigned int xregbc; -extern unsigned int xregde; -extern unsigned int xreghl; -extern asmif(); /* asmif(0x0E6**,bc,de,hl); */ - -#define BDOS 5 /* memory address of BDOS invocation */ -#define PRIFCB 0x5C /* memory address of primary FCB */ -#define SECFCB 0x6C /* memory address of secondary FCB */ -#define DEFBUF 0x80 /* memory address of default buffer */ -#define HIGHSEG 0x0C000 /* memory address of system config */ - -#define GETSYSCFG 0x0F000 /* HBIOS function for Get System Configuration */ - -#define TERMCPM 0 /* BDOS function for System Reset */ -#define CONIN 1 /* BDOS function for Console Input */ -#define CWRITE 2 /* BDOS function for Console Output */ -#define DIRCONIO 6 /* BDOS function for Direct Console I/O */ -#define PRINTSTR 9 /* BDOS function for Print String */ -#define RDCONBUF 10 /* BDOS function for Buffered Console Read */ -#define GETCONST 11 /* BDOS function for Get Console Status */ -#define RETVERNUM 12 /* BDOS function for Return Version Number */ -#define RESDISKSYS 13 /* BDOS function for Reset Disk System */ -#define SELECTDISK 14 /* BDOS function for Select Disk */ -#define FOPEN 15 /* BDOS function for File Open */ -#define FCLOSE 16 /* BDOS function for File Close */ -#define SEARCHFIRST 17 /* BDOS function for Search First */ -#define SEARCHNEXT 18 /* BDOS function for Search Next */ -#define FDELETE 19 /* BDOS function for File Delete */ -#define FREADSEQ 20 /* BDOS function for File Read Sequential */ -#define FWRITESEQ 21 /* BDOS function for File Write Sequential */ -#define FMAKEFILE 22 /* BDOS function for File Make */ -#define FRENAME 23 /* BDOS function for File Rename */ -#define RETLOGINVEC 24 /* BDOS function for Return Login Vector */ -#define RETCURRDISK 25 /* BDOS function for Return Current Disk */ -#define SETDMAADDR 26 /* BDOS function for Set DMA Address */ -#define GETALLOCVEC 27 /* BDOS function for Get Allocation Vector */ -#define WRPROTDISK 28 /* BDOS function for Write Protect Disk */ -#define GETROVECTOR 29 /* BDOS function for Get Read Only Vector */ -#define FSETATTRIB 30 /* BDOS function for File Set Attribute */ -#define GETDPBADDR 31 /* BDOS function for Get DPB Address */ -#define SETGETUSER 32 /* BDOS function for Set & Get User Number */ -#define FREADRANDOM 33 /* BDOS function for File Read Random */ -#define FWRITERAND 34 /* BDOS function for File Write Random */ -#define FCOMPSIZE 35 /* BDOS function for File Compare Size */ -#define SETRANDREC 36 /* BDOS function for Set Random Record # */ -#define RESETDRIVE 37 /* BDOS function for Reset Drive */ -#define WRRANDFILL 38 /* BDOS function for Write Random w/ Fill */ - -#define BDOSDEFDR 0 /* BDOS Default (current) Drive Number */ -#define BDOSDRA 1 /* BDOS Drive A: number */ -#define BDOSDRB 2 /* BDOS Drive B: number */ -#define BDOSDRC 3 /* BDOS Drive C: number */ -#define BDOSDRD 4 /* BDOS Drive D: number */ -#define BDOSDRE 5 /* BDOS Drive E: number */ -#define BDOSDRF 6 /* BDOS Drive F: number */ -#define BDOSDRG 7 /* BDOS Drive G: number */ -#define BDOSDRH 8 /* BDOS Drive H: number */ - -#define BIOSDRA 0 /* BIOS Drive A: number */ -#define BIOSDRB 1 /* BIOS Drive B: number */ -#define BIOSDRC 2 /* BIOS Drive C: number */ -#define BIOSDRD 3 /* BIOS Drive D: number */ -#define BIOSDRE 4 /* BIOS Drive E: number */ -#define BIOSDRF 5 /* BIOS Drive F: number */ -#define BIOSDRG 6 /* BIOS Drive G: number */ -#define BIOSDRH 7 /* BIOS Drive H: number */ - -struct FCB { - char drive; /* BDOS Drive Code */ - char filename[8]; /* space padded file name */ - char filetype[3]; /* space padded file extension */ - char filler[24]; /* remainder of FCB */ -}; - -struct FCB * pPriFcb = PRIFCB; /* pointer to Primary FCB structure */ - -struct FCB * pSecFcb = SECFCB; /* pointer to secondary FCB structure */ - -struct { - char length; /* length of commad tail */ - char tail[127]; /* command tail */ -} * pDefBuf = DEFBUF; - - -#define CURDRV 0x00004 -#define BIOSAD 0x0e600 /* base address of BIOS jumps */ - -/* addresses of BIOS jumps */ -#define pBOOT 0x0E600 -#define pWBOOT 0x0E603 -#define pCONST 0x0E606 -#define pCONIN 0x0E609 -#define pCONOUT 0x0E60C -#define pLIST 0x0E60F -#define pPUNCH 0x0E612 -#define pREADER 0x0E615 -#define pHOME 0x0E618 -#define pSELDSK 0x0E61B -#define pSETTRK 0x0E61E -#define pSETSEC 0x0E621 -#define pSETDMA 0x0E624 -#define pREAD 0x0E627 -#define pWRITE 0x0E62A -#define pLISTST 0x0E62D -#define pSECTRN 0x0E630 -#define pBNKSEL 0x0E633 -#define pGETLU 0x0E636 -#define pSETLU 0x0E639 -#define pGETINFO 0x0E63C - -struct JMP { - unsigned char opcode; /* JMP opcode */ - unsigned int address; /* JMP address */ -}; - -struct BIOS { - struct JMP boot; - struct JMP wboot; - struct JMP const; - struct JMP conin; - struct JMP conout; - struct JMP list; - struct JMP punch; - struct JMP reader; - struct JMP home; - struct JMP seldsk; - struct JMP settrk; - struct JMP setsec; - struct JMP setdma; - struct JMP read; - struct JMP write; - struct JMP listst; - struct JMP sectrn; - struct JMP bnksel; - struct JMP getlu; - struct JMP setlu; - struct JMP getinfo; - struct JMP rsvd1; - struct JMP rsvd2; - struct JMP rsvd3; - struct JMP rsvd4; - - char rmj; - char rmn; - char rup; - char rtp; - -} * pBIOS = 0xe600; - -/* pointer based Disk Parameter Block structure */ -struct DPB { - unsigned int spt; - unsigned char bsh; - unsigned char blm; - unsigned char exm; - unsigned int dsm; - unsigned int drm; - unsigned char al0; - unsigned int cks; - unsigned int off; -} * pDPB; - -/* pointer based Disk Parameter Header structure */ -struct DPH { - unsigned int xlt; - unsigned int rv1; - unsigned int rv2; - unsigned int rv3; - unsigned int dbf; - struct DPB * pDpb; - unsigned int csv; - unsigned int alv; - unsigned char sigl; - unsigned char sigu; - unsigned int current; - unsigned int number; -} * pDPH; - -/* pointer based Information List structure */ -struct INFOLIST { - int version; - void * banptr; - void * varloc; - void * tstloc; - void * dpbmap; - void * dphmap; - void * ciomap; -} * pINFOLIST; - -/* pointer based Configuration Data structure */ -struct CNFGDATA { - unsigned char rmj; - unsigned char rmn; - unsigned char rup; - unsigned char rtp; - unsigned char diskboot; - unsigned char devunit; - unsigned int bootlu; - unsigned char hour; - unsigned char minute; - unsigned char second; - unsigned char month; - unsigned char day; - unsigned char year; - unsigned char freq; - unsigned char platform; - unsigned char dioplat; - unsigned char vdumode; - unsigned int romsize; - unsigned int ramsize; - unsigned char clrramdk; - unsigned char dskyenable; - unsigned char uartenable; - unsigned char vduenable; - unsigned char fdenable; - unsigned char fdtrace; - unsigned char fdmedia; - unsigned char fdmediaalt; - unsigned char fdmauto; - unsigned char ideenable; - unsigned char idetrace; - unsigned char ide8bit; - unsigned int idecapacity; - unsigned char ppideenable; - unsigned char ppidetrace; - unsigned char ppide8bit; - unsigned int ppidecapacity; - unsigned char ppideslow; - unsigned char boottype; - unsigned char boottimeout; - unsigned char bootdefault; - unsigned int baudrate; - unsigned char ckdiv; - unsigned char memwait; - unsigned char iowait; - unsigned char cntlb0; - unsigned char cntlb1; - unsigned char sdenable; - unsigned char sdtrace; - unsigned int sdcapacity; - unsigned char sdcsio; - unsigned char sdcsiofast; - unsigned char defiobyte; - unsigned char termtype; - unsigned int revision; - unsigned char prpsdenable; - unsigned char prpsdtrace; - unsigned int prpsdcapacity; - unsigned char prpconenable; - unsigned int biossize; - unsigned char pppenable; - unsigned char pppsdenable; - unsigned char pppsdtrace; - unsigned int pppsdcapacity; - unsigned char pppconenable; - unsigned char prpenable; -} * pCNFGDATA; - - -struct JMP_TAG { - unsigned char opcode; - unsigned int address; -}; - - -/* pointer based System Configuration structure */ -struct SYSCFG { - struct JMP_TAG jmp; - void * cnfloc; - void * tstloc; - void * varloc; - struct CNFGDATA cnfgdata; - char filler[256-3-2-2-2-sizeof(struct CNFGDATA)]; -} * pSYSCFG = HIGHSEG; - - -main(argc,argv) - int argc; - char *argv[]; -{ - FILE * fd; - - hregbc = GETSYSCFG; /* function = Get System Config */ - hregde = HIGHSEG; /* addr of dest (must be high) */ - diagnose(); /* invoke the NBIOS function */ - - printf("TT is %d\n",pSYSCFG->cnfgdata.termtype); - - crtinit(pSYSCFG->cnfgdata.termtype); - crtclr(); - crtlc(0,0); - - printf( - "GETCFG.COM %d/%d/%d %d.%d.%d.%d dwg - Elegantly Expressed CP/M Program\n", - A_MONTH,A_DAY,A_YEAR, - pBIOS->rmj,pBIOS->rmn,pBIOS->rup,pBIOS->rtp); - - fd = fopen("syscfg.bin","w"); - fwrite(HIGHSEG,1,256,fd); - fclose(fd); - - - - asmif(pGETINFO,0,0,0); /* get addr of the information list */ - pINFOLIST = xreghl; /* set base pointer of the structure */ - - asmif(BDOS,RETCURRDISK,0,0); /* get current drive into xrega */ - asmif(pSELDSK,xrega,0,0); /* get DPH of current drive */ - pDPH = xreghl; /* establish addressability to DPH */ - pDPB = pDPH->pDpb; /* establish addressability to DPB */ - -/* printf("spt is %d\n",pDPB->spt); */ /* demonstrate DPB access */ - - - -} - - \ No newline at end of file diff --git a/Apps/Source/globals.h b/Apps/Source/globals.h deleted file mode 100644 index 58976394..00000000 --- a/Apps/Source/globals.h +++ /dev/null @@ -1,18 +0,0 @@ -/****************************************************************/ -/* globals.h 9/4/2012 dwg - increase MAXDRIVE to 12 */ -/* globals.h 3/11/2012 dwg - add BIOS_ADDR */ -/* globals.h 3/11/2012 dwg - declarations common to all modules */ -/****************************************************************/ - -#define CR 0x0d -#define LF 0x0a -#define ESC 27 - -#define BIOSAD 0x0e600 -#define INFLSTV 1 - -#define MAXDRIVE 12 - -/*******************/ -/* eof - globals.h */ -/*******************/ \ No newline at end of file diff --git a/Apps/Source/globals.lib b/Apps/Source/globals.lib deleted file mode 100644 index 152e55f4..00000000 --- a/Apps/Source/globals.lib +++ /dev/null @@ -1,18 +0,0 @@ -; globals.lib 7/19/2012 dwg - update for 2.0.0.0 B22 -; globals.lib 1/18/2012 dwg - program globals - -ENGLISH equ TRUE -SPANISH equ FALSE - -MAX$LABEL equ 16 -STACK$SIZE equ 512 - -COLON equ ':' - -stack macro - ds STACK$SIZE -stack$top: - endm - -; eof - globals.lib - \ No newline at end of file diff --git a/Apps/Source/hardware.lib b/Apps/Source/hardware.lib deleted file mode 100644 index 3503e99e..00000000 --- a/Apps/Source/hardware.lib +++ /dev/null @@ -1,16 +0,0 @@ -; hardware.lib 1/18/2012 dwg - hardware declarations -HASZ80 equ TRUE - -; I/O address of Zeta RTC -zeta$rtc equ 70h -; write bit definitions -z$rtc$ce equ 10h -z$rtc$we equ 20h -z$rtc$clk equ 40h -z$rtc$inp equ 80h -; read bit definitions -z$rtc$out equ 01h -z$rtc$cfg equ 40h - -; eof - hardware.lib - \ No newline at end of file diff --git a/Apps/Source/hbios.asm b/Apps/Source/hbios.asm deleted file mode 100644 index 50d43a0f..00000000 --- a/Apps/Source/hbios.asm +++ /dev/null @@ -1,18 +0,0 @@ -; hbios.asm 7/19/2012 dwg - - -CFGVERS equ 0 - - public xgetsc -xgetsc: - enter - mvi b,0F0h - mvi c,CFGVERS - lxi d,8000h - db 0cfh ; rst 8 - lxi h,8000h - leave - ret - - - END - \ No newline at end of file diff --git a/Apps/Source/hbios.h b/Apps/Source/hbios.h deleted file mode 100644 index e56562c8..00000000 --- a/Apps/Source/hbios.h +++ /dev/null @@ -1,48 +0,0 @@ -/* hbios.h 7/4/2012 dgw - */ - -/* CIO */ - -/* Character Input (CIOIN) */ - -/* Character Output (CIOOUT) */ - -/* Character Input Status (CIOIST) */ - -/* Character Output Status (CIOOST) */ - -/* DIO */ - -/* Disk Read (DIORD) */ - -/* Disk Write (DIOWR) */ - -/* Disk Status (DIOST) */ - -/* Disk Media (DIOMED) */ - -/* Disk Idetify (DIOID) */ - -/* Disk Get Buffer Address (DIOGBA) */ - - - - -/* - extern char hrega; - extern unsigned int hregbc; - extern unsigned int hregde; - extern unsigned int hreghl; - extern diagnose(); -*/ - - - - - -/*****************/ -/* eof - hbios.h */ -/*****************/ - - - - \ No newline at end of file diff --git a/Apps/Source/hbios.lib b/Apps/Source/hbios.lib deleted file mode 100644 index 166327be..00000000 --- a/Apps/Source/hbios.lib +++ /dev/null @@ -1,3 +0,0 @@ -; hbios.lib 7/19/2012 dwg - - extrn xgetsc - \ No newline at end of file diff --git a/Apps/Source/hello.c b/Apps/Source/hello.c deleted file mode 100644 index daff6af1..00000000 --- a/Apps/Source/hello.c +++ /dev/null @@ -1,333 +0,0 @@ -/* test.c 7/21/2012 dwg - */ - -#include "stdio.h" -#include "applvers.h" - -/* declarations for HBIOS access */ -extern char hrega; -extern unsigned int hregbc; -extern unsigned int hregde; -extern unsigned int hreghl; -extern diagnose(); - -/* declaration dir BIOS and BDOS and low level calls */ -extern char xrega; -extern unsigned int xregbc; -extern unsigned int xregde; -extern unsigned int xreghl; -extern asmif(); /* asmif(0x0E6**,bc,de,hl); */ - -#define BDOS 5 /* memory address of BDOS invocation */ -#define PRIFCB 0x5C /* memory address of primary FCB */ -#define SECFCB 0x6C /* memory address of secondary FCB */ -#define DEFBUF 0x80 /* memory address of default buffer */ -#define HIGHSEG 0x0C000 /* memory address of system config */ - -#define GETSYSCFG 0x0F000 /* HBIOS function for Get System Configuration */ - -#define TERMCPM 0 /* BDOS function for System Reset */ -#define CONIN 1 /* BDOS function for Console Input */ -#define CWRITE 2 /* BDOS function for Console Output */ -#define DIRCONIO 6 /* BDOS function for Direct Console I/O */ -#define PRINTSTR 9 /* BDOS function for Print String */ -#define RDCONBUF 10 /* BDOS function for Buffered Console Read */ -#define GETCONST 11 /* BDOS function for Get Console Status */ -#define RETVERNUM 12 /* BDOS function for Return Version Number */ -#define RESDISKSYS 13 /* BDOS function for Reset Disk System */ -#define SELECTDISK 14 /* BDOS function for Select Disk */ -#define FOPEN 15 /* BDOS function for File Open */ -#define FCLOSE 16 /* BDOS function for File Close */ -#define SEARCHFIRST 17 /* BDOS function for Search First */ -#define SEARCHNEXT 18 /* BDOS function for Search Next */ -#define FDELETE 19 /* BDOS function for File Delete */ -#define FREADSEQ 20 /* BDOS function for File Read Sequential */ -#define FWRITESEQ 21 /* BDOS function for File Write Sequential */ -#define FMAKEFILE 22 /* BDOS function for File Make */ -#define FRENAME 23 /* BDOS function for File Rename */ -#define RETLOGINVEC 24 /* BDOS function for Return Login Vector */ -#define RETCURRDISK 25 /* BDOS function for Return Current Disk */ -#define SETDMAADDR 26 /* BDOS function for Set DMA Address */ -#define GETALLOCVEC 27 /* BDOS function for Get Allocation Vector */ -#define WRPROTDISK 28 /* BDOS function for Write Protect Disk */ -#define GETROVECTOR 29 /* BDOS function for Get Read Only Vector */ -#define FSETATTRIB 30 /* BDOS function for File Set Attribute */ -#define GETDPBADDR 31 /* BDOS function for Get DPB Address */ -#define SETGETUSER 32 /* BDOS function for Set & Get User Number */ -#define FREADRANDOM 33 /* BDOS function for File Read Random */ -#define FWRITERAND 34 /* BDOS function for File Write Random */ -#define FCOMPSIZE 35 /* BDOS function for File Compare Size */ -#define SETRANDREC 36 /* BDOS function for Set Random Record # */ -#define RESETDRIVE 37 /* BDOS function for Reset Drive */ -#define WRRANDFILL 38 /* BDOS function for Write Random w/ Fill */ - -#define BDOSDEFDR 0 /* BDOS Default (current) Drive Number */ -#define BDOSDRA 1 /* BDOS Drive A: number */ -#define BDOSDRB 2 /* BDOS Drive B: number */ -#define BDOSDRC 3 /* BDOS Drive C: number */ -#define BDOSDRD 4 /* BDOS Drive D: number */ -#define BDOSDRE 5 /* BDOS Drive E: number */ -#define BDOSDRF 6 /* BDOS Drive F: number */ -#define BDOSDRG 7 /* BDOS Drive G: number */ -#define BDOSDRH 8 /* BDOS Drive H: number */ - -#define BIOSDRA 0 /* BIOS Drive A: number */ -#define BIOSDRB 1 /* BIOS Drive B: number */ -#define BIOSDRC 2 /* BIOS Drive C: number */ -#define BIOSDRD 3 /* BIOS Drive D: number */ -#define BIOSDRE 4 /* BIOS Drive E: number */ -#define BIOSDRF 5 /* BIOS Drive F: number */ -#define BIOSDRG 6 /* BIOS Drive G: number */ -#define BIOSDRH 7 /* BIOS Drive H: number */ - -struct FCB { - char drive; /* BDOS Drive Code */ - char filename[8]; /* space padded file name */ - char filetype[3]; /* space padded file extension */ - char filler[24]; /* remainder of FCB */ -}; - -struct FCB * pPriFcb = PRIFCB; /* pointer to Primary FCB structure */ - -struct FCB * pSecFcb = SECFCB; /* pointer to secondary FCB structure */ - -struct { - char length; /* length of commad tail */ - char tail[127]; /* command tail */ -} * pDefBuf = DEFBUF; - - -#define CURDRV 0x00004 -#define BIOSAD 0x0e600 /* base address of BIOS jumps */ - -/* addresses of BIOS jumps */ -#define pBOOT 0x0E600 -#define pWBOOT 0x0E603 -#define pCONST 0x0E606 -#define pCONIN 0x0E609 -#define pCONOUT 0x0E60C -#define pLIST 0x0E60F -#define pPUNCH 0x0E612 -#define pREADER 0x0E615 -#define pHOME 0x0E618 -#define pSELDSK 0x0E61B -#define pSETTRK 0x0E61E -#define pSETSEC 0x0E621 -#define pSETDMA 0x0E624 -#define pREAD 0x0E627 -#define pWRITE 0x0E62A -#define pLISTST 0x0E62D -#define pSECTRN 0x0E630 -#define pBNKSEL 0x0E633 -#define pGETLU 0x0E636 -#define pSETLU 0x0E639 -#define pGETINFO 0x0E63C - -struct JMP { - unsigned char opcode; /* JMP opcode */ - unsigned int address; /* JMP address */ -}; - -struct BIOS { - struct JMP boot; - struct JMP wboot; - struct JMP const; - struct JMP conin; - struct JMP conout; - struct JMP list; - struct JMP punch; - struct JMP reader; - struct JMP home; - struct JMP seldsk; - struct JMP settrk; - struct JMP setsec; - struct JMP setdma; - struct JMP read; - struct JMP write; - struct JMP listst; - struct JMP sectrn; - struct JMP bnksel; - struct JMP getlu; - struct JMP setlu; - struct JMP getinfo; - struct JMP rsvd1; - struct JMP rsvd2; - struct JMP rsvd3; - struct JMP rsvd4; - - char rmj; - char rmn; - char rup; - char rtp; - -} * pBIOS = 0xe600; - -/* pointer based Disk Parameter Block structure */ -struct DPB { - unsigned int spt; - unsigned char bsh; - unsigned char blm; - unsigned char exm; - unsigned int dsm; - unsigned int drm; - unsigned char al0; - unsigned int cks; - unsigned int off; -} * pDPB; - -/* pointer based Disk Parameter Header structure */ -struct DPH { - unsigned int xlt; - unsigned int rv1; - unsigned int rv2; - unsigned int rv3; - unsigned int dbf; - struct DPB * pDpb; - unsigned int csv; - unsigned int alv; - unsigned char sigl; - unsigned char sigu; - unsigned int current; - unsigned int number; -} * pDPH; - -/* pointer based Information List structure */ -struct INFOLIST { - int version; - void * banptr; - void * varloc; - void * tstloc; - void * dpbmap; - void * dphmap; - void * ciomap; -} * pINFOLIST; - -/* pointer based Configuration Data structure */ -struct CNFGDATA { - unsigned char rmj; - unsigned char rmn; - unsigned char rup; - unsigned char rtp; - unsigned char diskboot; - unsigned char devunit; - unsigned int bootlu; - unsigned char hour; - unsigned char minute; - unsigned char second; - unsigned char month; - unsigned char day; - unsigned char year; - unsigned char freq; - unsigned char platform; - unsigned char dioplat; - unsigned char vdumode; - unsigned int romsize; - unsigned int ramsize; - unsigned char clrramdk; - unsigned char dskyenable; - unsigned char uartenable; - unsigned char vduenable; - unsigned char fdenable; - unsigned char fdtrace; - unsigned char fdmedia; - unsigned char fdmediaalt; - unsigned char fdmauto; - unsigned char ideenable; - unsigned char idetrace; - unsigned char ide8bit; - unsigned int idecapacity; - unsigned char ppideenable; - unsigned char ppidetrace; - unsigned char ppide8bit; - unsigned int ppidecapacity; - unsigned char ppideslow; - unsigned char boottype; - unsigned char boottimeout; - unsigned char bootdefault; - unsigned int baudrate; - unsigned char ckdiv; - unsigned char memwait; - unsigned char iowait; - unsigned char cntlb0; - unsigned char cntlb1; - unsigned char sdenable; - unsigned char sdtrace; - unsigned int sdcapacity; - unsigned char sdcsio; - unsigned char sdcsiofast; - unsigned char defiobyte; - unsigned char termtype; - unsigned int revision; - unsigned char prpsdenable; - unsigned char prpsdtrace; - unsigned int prpsdcapacity; - unsigned char prpconenable; - unsigned int biossize; - unsigned char pppenable; - unsigned char pppsdenable; - unsigned char pppsdtrace; - unsigned int pppsdcapacity; - unsigned char pppconenable; - unsigned char prpenable; -} * pCNFGDATA; - - -struct JMP_TAG { - unsigned char opcode; - unsigned int address; -}; - - -/* pointer based System Configuration structure */ -struct SYSCFG { - struct JMP_TAG jmp; - void * cnfloc; - void * tstloc; - void * varloc; - struct CNFGDATA cnfgdata; - char filler[256-3-2-2-2-sizeof(struct CNFGDATA)]; -} * pSYSCFG = HIGHSEG; - - -main(argc,argv) - int argc; - char *argv[]; -{ - - - hregbc = GETSYSCFG; /* function = Get System Config */ - hregde = HIGHSEG; /* addr of dest (must be high) */ - diagnose(); /* invoke the NBIOS function */ - pSYSCFG = HIGHSEG; - - crtinit(pSYSCFG->cnfgdata.termtype); - crtclr(); - crtlc(0,0); - -/* printf("TT is %d\n",pSYSCFG->cnfgdata.termtype); */ - - - printf( - "TEST.COM %d/%d/%d %d.%d.%d.%d dwg - Elegantly Expressed CP/M Program\n", - A_MONTH,A_DAY,A_YEAR, - pBIOS->rmj,pBIOS->rmn,pBIOS->rup,pBIOS->rtp); - - asmif(pGETINFO,0,0,0); /* get addr of the information list */ - pINFOLIST = xreghl; /* set base pointer of the structure */ - - asmif(BDOS,RETCURRDISK,0,0); /* get current drive into xrega */ - asmif(pSELDSK,xrega,0,0); /* get DPH of current drive */ - pDPH = xreghl; /* establish addressability to DPH */ - pDPB = pDPH->pDpb; /* establish addressability to DPB */ - -/* printf("spt is %d\n",pDPB->spt); */ /* demonstrate DPB access */ - - hregbc = GETSYSCFG; /* function = Get System Config */ - hregde = HIGHSEG; /* addr of dest (must be high) */ - diagnose(); /* invoke the NBIOS function */ - -/* printf("TT is %d\n",pSYSCFG->cnfgdata.termtype); */ - - -} - - \ No newline at end of file diff --git a/Apps/Source/help.c b/Apps/Source/help.c deleted file mode 100644 index 0541cc1e..00000000 --- a/Apps/Source/help.c +++ /dev/null @@ -1,11 +0,0 @@ -#include -#include - -int main(argc,argv) - int argc; - char * argv[]; -{ - printf("Help World!!\n"); - return 0; -} - \ No newline at end of file diff --git a/Apps/Source/ident.asm b/Apps/Source/ident.asm deleted file mode 100644 index 9840c850..00000000 --- a/Apps/Source/ident.asm +++ /dev/null @@ -1,64 +0,0 @@ - title 'Ident - Display Program Identification' - -; ident.asm 2/21/2012 dwg - review for release 2.0.0.0 -; ident.asm 2/19.2012 dwg - review for release 1.5.1.0 -; ident.asm 2/19/2012 dwg - remove test* & analyse & ws-shim -; ident.asm 2/18/2012 dwg - drives,map and slice become map -; ident.asm 2/14/2012 dwg - superfmt becomes multifmt -; ident.asm 2/13/2012 dwg - add disk -; ident.asm 2/12/2012 dwg - add cleardir and superfmt -; ident.asm 2/11/2012 dwg - Display the Ident of a program file - -; Copyright (C) 2011-2012 Douglas Goodall Licensed under GPL Ver 3. -; -; This file is part of NuBiosDWG and is free software: you can -; redistribute it and/or modify it under the terms of the GNU -; General Public License as published by the Free Software Foundation, -; either version 3 of the License, or (at your option) any later version. -; This file is distributed in the hope that it will be useful, -; but WITHOUT ANY WARRANTY; without even the implied warranty of -; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -; GNU General Public License for more details. -; You should have received a copy of the GNU General Public License -; along with it. If not, see . - - maclib portab - maclib globals - maclib cpmbdos - maclib cpmappl - maclib applvers - maclib banner - maclib printers - maclib dumpmac - maclib memory - maclib identity - - do$start - - idata - - sbanner argv - - ify 'ACCESS COM',TRUE -; ify 'ASSIGN COM',TRUE -; ify 'CPMNAME COM',TRUE -; ify 'ERASE COM',TRUE - ify 'FINDFILECOM',TRUE -; ify 'HEADER COM',TRUE - ify 'IDENT COM',TRUE - ify 'SETLABELCOM',TRUE -; ify 'MAP COM',TRUE -; ify 'METAVIEWCOM',TRUE -; ify 'MULTIFMTCOM',TRUE - ify 'NOACCESSCOM',TRUE -; ify 'PAUSE COM',TRUE -; ify 'REM COM',TRUE -; ify 'REQ1PARMCOM',TRUE -; ify 'STOP COM',TRUE -; ify 'TERMTYPECOM',TRUE -; ify 'WRITESYSCOM',FALSE - - do$end - - end - \ No newline at end of file diff --git a/Apps/Source/identity.asm b/Apps/Source/identity.asm deleted file mode 100644 index 858d7727..00000000 --- a/Apps/Source/identity.asm +++ /dev/null @@ -1,196 +0,0 @@ -; identity.asm 2/17/2012 dwg - Program Identity Declarations - - maclib portab - maclib globals - maclib stdlib - maclib cpmbios - maclib cpmbdos - maclib memory - maclib printers - - public x$ident -x$ident: - shld lfcbptr ; save pointer to fcb - - mvi c,FOPEN - lhld lfcbptr - xchg - call BDOS - cpi 255 - jnz openok - -;;; memcpy lname,file1fcb+1,8 - mvi c,8 - lxi d,lname - lhld lfcbptr - inx h - call x$memcpy - - mvi a,',' - sta ldot - -;;; memcpy lext,file1fcb+9,3 - mvi c,3 - lhld lfcbptr - lxi d,9 - dad d - lxi d,lext - call x$memcpy - - - mvi a,'$' - sta lterm - print lname - printf ' -- File Not Found' - mvi a,FAILURE - jmp fini -openok: - - mvi c,SETDMA - lxi d,buffer - call BDOS - - mvi c,READSEQ - lhld lfcbptr - xchg - call BDOS - - - mvi c,SETDMA - lxi d,buffer+128 - call BDOS - - mvi c,READSEQ - lhld lfcbptr - xchg - call BDOS - - mvi c,FCLOSE - lhld lfcbptr - xchg - call BDOS - - lxi d,d$prog - mvi c,9 - call BDOS - - conout ',' - conout ' ' - lda p$rmj - mov l,a - mvi h,0 - call pr$d$word - conout '.' - lda p$rmn - mov l,a - call pr$d$word - conout '.' - lda p$rup - mov l,a - call pr$d$word - conout '.' - lda p$rtp - mov l,a - call pr$d$word - conout ',' - conout ' ' - - lda p$mon - mov l,a - call pr$d$word - conout '/' - lda p$day - mov l,a - call pr$d$word - conout '/' - lhld p$year - call pr$d$word - conout ',' - conout ' ' - - lxi d,d$prod - mvi c,9 - call BDOS - conout ',' - conout ' ' - - lxi d,d$orig - mvi c,9 - call BDOS - conout ',' - conout ' ' - - lxi d,d$ser - mvi c,9 - call BDOS - conout ',' - conout ' ' - - lda d$term2 - cpi '$' - jnz do$name - conout ' ' - lxi d,d$uuid+19 - jmp do$any -do$name: - lxi d,d$name -do$any: - mvi c,9 - call BDOS - - mvi a,SUCCESS ; set return code -fini: - ret - -lfcbptr ds 2 -ldrive ds 1 -lcolon ds 1 -lname ds 8 -ldot ds 1 -lext ds 3 -lterm ds 1 - - db 'buffer-->' -buffer ds 1 -p$start ds 2 -p$hexrf ds 16 -p$sig ds 2 -p$rmj ds 1 -p$rmn ds 1 -p$rup ds 1 -p$rtp ds 1 -p$mon ds 1 -p$day ds 1 -p$year ds 2 -p$argv ds 2 -p$e5 ds 1 -p$pr$st ds 2 -p$code1 ds 3 ; begin: lxi h,0 -p$code2 ds 1 ; dad sp -p$code3 ds 3 ; shld pre$stk -p$code4 ds 3 ; lxi sp,stack$top -p$code5 ds 1 ; nop -p$code6 ds 3 ; jmp around$bandata -p$prog ds 2 ; dw prog -p$dat ds 2 ; dw dat -p$prod ds 2 ; dw prod -p$orig ds 2 ; dw orig -p$ser ds 2 ; dw ser -p$nam ds 2 ; dw nam -p$term ds 2 ; dw 0 -d$prog ds 8+1+3+1 ; db '12345678.123$' -d$date ds 2+1+2+1+4+1 ; db ' 2/11/2012$' -d$ser ds 6+1 ; db '654321$' -d$prod ds 5+1 ; db 'CPM80$' -d$orig ds 3+1 ; db 'DWG$' -d$name ds 1+7+1+1+1+1+7+1 ; db ' Douglas W. Goodall$' -d$uuid ds 36 ; unique user identification -d$term2 ds 1 ; can be set to zero or dollar sign -p$len equ $-buffer -p$rsvd ds 256-p$len - db '<--buffer' - dw p$len -crlf db CR,LF,'$' - -; eof - identity.asm - \ No newline at end of file diff --git a/Apps/Source/identity.lib b/Apps/Source/identity.lib deleted file mode 100644 index b66e6c3e..00000000 --- a/Apps/Source/identity.lib +++ /dev/null @@ -1,191 +0,0 @@ -; identity.lib 2/19/2012 dwg - add ify macro -; identity.lib 2/17/2012 dwg - Program Identity Declarations - - extrn x$ident - -ident macro file1fcb - lxi h,file1fcb - call x$ident - endm - -ify macro progname,bool - local done - local file - local fini - ident file - jmp fini - newfcb file,0,progname -fini: mvi a,bool - cpi TRUE - jnz done - conout CR - conout LF -done: - endm - - -identx macro file1fcb - local openok - local identend - - local ldrive,lcolon,lname,ldot,lext,lterm - - mvi c,FOPEN - lxi d,file1fcb - call BDOS - cpi 255 - jnz openok - - memcpy lname,file1fcb+1,8 - mvi a,',' - sta ldot - memcpy lext,file1fcb+9,3 - mvi a,'$' - sta lterm - print lname - printf ' -- File Not Found' - jmp identend -openok: - - mvi c,SETDMA - lxi d,buffer - call BDOS - - mvi c,READSEQ - lxi d,file1fcb - call BDOS - - mvi c,FCLOSE - lxi d,file1fcb - call BDOS - - lxi d,d$prog - mvi c,9 - call BDOS - - conout ',' - conout ' ' - lda p$rmj - mov l,a - mvi h,0 - call pr$d$word - conout '.' - lda p$rmn - mov l,a - call pr$d$word - conout '.' - lda p$rup - mov l,a - call pr$d$word - conout '.' - lda p$rtp - mov l,a - call pr$d$word - conout ',' - conout ' ' - - lda p$mon - mov l,a - call pr$d$word - conout '/' - lda p$day - mov l,a - call pr$d$word - conout '/' - lhld p$year - call pr$d$word - conout ',' - conout ' ' - - lxi d,d$prod - mvi c,9 - call BDOS - conout ',' - conout ' ' - - lxi d,d$orig - mvi c,9 - call BDOS - conout ',' - conout ' ' - - lxi d,d$ser - mvi c,9 - call BDOS - conout ',' - conout ' ' - - lxi d,d$name - mvi c,9 - call BDOS - jmp identend - -ldrive ds 1 -lcolon ds 1 -lname ds 8 -ldot ds 1 -lext ds 3 -lterm ds 1 - -identend: - endm - -idata macro - jmp around$bandata -argv dw prog,dat,prod,orig,ser,myname,0 -prog db 'IDENT.COM $' - date - serial - product - originator - oriname -uuid db '777A67C2-4A92-42D4-80FE-C96FD6483BD2$' - db 'buffer-->' - public buffer,p$start,p$hexrf,p$sig - public p$rmj,p$rmn,p$rup,p$rtp - public p$mon,p$day,p$year -buffer ds 1 -p$start ds 2 -p$hexrf ds 16 -p$sig ds 2 -p$rmj ds 1 -p$rmn ds 1 -p$rup ds 1 -p$rtp ds 1 -p$mon ds 1 -p$day ds 1 -p$year ds 2 -p$argv ds 2 -p$e5 ds 1 -p$pr$st ds 2 -p$code1 ds 3 ; begin: lxi h,0 -p$code2 ds 1 ; dad sp -p$code3 ds 3 ; shld pre$stk -p$code4 ds 3 ; lxi sp,stack$top -p$code5 ds 1 ; nop -p$code6 ds 3 ; jmp around$bandata -p$prog ds 2 ; dw prog -p$dat ds 2 ; dw dat -p$prod ds 2 ; dw prod -p$orig ds 2 ; dw orig -p$ser ds 2 ; dw ser -p$nam ds 2 ; dw nam -p$term ds 2 ; dw 0 -d$prog ds 8+1+3+1 ; db '12345678.123$' -d$date ds 2+1+2+1+4+1 ; db ' 2/11/2012$' -d$ser ds 6+1 ; db '654321$' -d$prod ds 5+1 ; db 'CPM80$' -d$orig ds 3+1 ; db 'DWG$' -d$name ds 1+7+1+1+1+1+7+1 ; db ' Douglas W. Goodall$' -d$uuid ds 37 ; unique user identification -d$term2 ds 1 ; can be set to zero or dollar sign -p$len equ $-buffer -p$rsvd ds 128-p$len - db '<--buffer' -crlf db CR,LF,'$' -around$bandata: - - endm - -; eof - identity.lib - \ No newline at end of file diff --git a/Apps/Source/infolist.h b/Apps/Source/infolist.h deleted file mode 100644 index a98c004b..00000000 --- a/Apps/Source/infolist.h +++ /dev/null @@ -1,16 +0,0 @@ -/* infolist.h 6/7/2012 dwg - BIOS Information Structure version 2 */ - -struct INFOLIST { - int version; - void * banptr; - void * varloc; - void * tstloc; - void * dpbmap; - void * dphmap; - void * ciomap; -}; - -/********************/ -/* eof - infolist.h */ -/********************/ - \ No newline at end of file diff --git a/Apps/Source/label.c b/Apps/Source/label.c deleted file mode 100644 index dc7e3cb2..00000000 --- a/Apps/Source/label.c +++ /dev/null @@ -1,124 +0,0 @@ -/* label.c 67/10/2012 dwg - */ - -#include "stdio.h" -#include "cpmbios.h" -#include "bioscall.h" -#include "cpmbdos.h" -#include "bdoscall.h" -#include "metadata.h" -#include "banner.h" - -struct FCB * pPRIFCB; -struct FCB * pSECFCB; -struct DPH * pDPH; -struct DPB * pDPB; - -testdrive(drive) - int drive; -{ - ireghl = pSELDSK; - iregbc = drive; - bioscall(); - pDPH = ireghl; - pDPB = pDPH->dpb; - if(0 == pDPB->off) { - printf("Sorry Drive %c: has no prefix area and cannot be labeled", - drive+'A'); - exit(1); - } - -} - -interactive(drive) - int drive; -{ - int i; - - struct { - char size; - char len; - char data[16]; - } rdcons; - - testdrive(drive); - ireghl = pGETLU; - iregbc = drive; - bioscall(); - if(1 == irega) { - printf("interactive(%d) says drive %c: can't have label",drive,drive); - printf("%c",7); - exit(1); - - } - rdsector(drive,0,11,&metadata,0); - printf("Old label = "); - for(i=0;i<16;i++) { - printf("%c",metadata.label[i]); - } - - printf("\nNew label = "); - rdcons.size=16; - rdcons.len =0; - dregbc = RDCONBUF; - dregde = &rdcons; - bdoscall(); - - if(0 < rdcons.len) { - memset(metadata.label,' ',16); - memcpy(metadata.label,rdcons.data,rdcons.len); - wrsector(drive,0,11,&metadata,0); - } - -} - -noninteractive(drive,label) - int drive; - char * label; -{ - int i; - - testdrive(drive); - - rdsector(drive,0,11,&metadata,0); - memset(metadata.label,' ',16); - for(i=0;idrive-1); - exit(0); - } - } - break; - default: - noninteractive(pPRIFCB->drive-1,0x85); - break; - } - exit(0); -} - \ No newline at end of file diff --git a/Apps/Source/labelib.asm b/Apps/Source/labelib.asm deleted file mode 100644 index 85afc81e..00000000 --- a/Apps/Source/labelib.asm +++ /dev/null @@ -1,217 +0,0 @@ -; labelib.asm 2/22/2012 dwg - label library function implementation -; label.asm 2/11/2012 dwg - make ident compliant -; label.asm 2/11/2012 dwg - begin 1.6 enhancements -; label.asm 2/04/2012 dwg - use new macros for benefits -; label.asm 1/20/2012 dwg - label a drive or slice - -; -; Copyright (C) 2011-2012 Douglas Goodall Licensed under GPL Ver 3. -; -; This file is part of NuBiosDWG and is free software: you can -; redistribute it and/or modify it under the terms of the GNU -; General Public License as published by the Free Software Foundation, -; either version 3 of the License, or (at your option) any later version. -; This file is distributed in the hope that it will be useful, -; but WITHOUT ANY WARRANTY; without even the implied warranty of -; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -; GNU General Public License for more details. -; You should have received a copy of the GNU General Public License -; along with it. If not, see . -; - - - maclib portab - maclib globals - maclib cpmbios - maclib cpmbdos - maclib bioshdr - maclib hardware - maclib z80 - maclib memory -; maclib applvers -; maclib cpmappl - maclib printers - maclib metadata -; maclib banner - maclib stdlib -; maclib ffhaslu -; maclib identity - - - - cseg - - public x$label -x$label: - mov a,c - sta drive$num - - get$off - mov a,h - ora l - jnz off$ok - printf 'Sorry, you can only label drives with reserved tracks' - jmp main$exit -off$ok: - - lda drive$num - mov c,a - lxi h,buffer - call x$g$meta - - lda DEFBUF ! mov c,a - cpi 0 ! jnz x$lab2 - -; ; Interactive label functionality here... - -prompt: - ; signature exists so label should be displayable - - print old$lbl - -; print label - lxi h,buffer - lxi d,meta$label - dad d - push h - pop d - mvi c,PRINTSTR - call BDOS - - print crlf - print new$lbl - - mvi c,READ$CON$BUF - lxi d,rcbuff - call BDOS - lda rclen - cpi 0 - jnz length$ok - jmp main$exit -length$ok: - inr a - sta DEFBUF - mvi a,' ' - sta DEFBUF+1 - mov c,a - mvi b,0 - lxi h,rcdata - lxi d,DEFBUF+2 - ldir - - print crlf - - lda drive$num - mov c,a - ; fall through to code below - - -;;; not$interactive: - - public x$lab2 -x$lab2: -; This routine can be used interactively or non-interactively. -; You can set up the default buffer at 80h and call x$lab2, -; or you can call x$label and it will interactively redo the label. -; - mov a,c - sta drive$num - - - lxi h,buffer - lxi d,meta$label - dad d - mvi a,' ' - lxi b,meta$label$len ; max length of label - call x$memset - - lda DEFBUF ; pick up length of command tail - cpi 18 ; compare with max size of label - jc lenok ; jump if size is within limits - mvi a,17 ; specify maximum size - sta DEFBUF ; and poke into default buffer size byte - -lenok: lda DEFBUF ; pick up command tail size byte - dcr a ; decrement - - mov c,a ; move to c reg as counter - mvi b,0 - - lxi h,buffer - lxi d,meta$label - dad d - xchg - lxi h,DEFBUF+2 ; set source index for move - ldir - - lxi h,buffer - lxi d,meta$term - dad d - mvi a,'$' - mov m,a - - lda drive$num - mov c,a - - lxi h,buffer - call x$u$meta - cpi FAILURE - jz write$prot$err - - lxi h,buffer - call x$p$meta - - print suc$msg - - jmp main$exit - -write$prot$err: - print wr$prot$msg - jmp main$exit - -readerr: - print rd$err$msg - jmp main$exit - -writeerr: - print wr$err$msg - jmp main$exit - -dontboth: - print usage$msg - -main$exit: - ret - - dseg - -suc$msg db 'Label Written Successfully$' -rd$err$msg db 'Sorry, cannot read label sector$' -wr$err$msg db 'Sorry, cannot write label sector$' -wr$prot$msg db 'Sorry, metadata is write protected$' -usage$msg db 'usage - label