;*************************************************************************** ; ; ; EEEEEEEEEE OOOOOOO SSSSSSSS 5555555555 ; ; EE OO OO SS SS 55 ; ; EE OO OO SS 55 ; ; EEEEEEEE OO OO SSSSSSSS XXXXXX 555555555 ; ; EE OO OO SS 55 ; ; EE OO OO SS 55 ; ; EE OO OO SS 55 ; ; EE OO OO SS SS 55 55 ; ; EEEEEEEEEE OOOOOOO SSSSSSSS 55555555 ; ; ; ;*************************************************************************** ;EOS-5 COMMENTED ASSEMBLY LISTING. ;VERSION HISTORY ; 2 9908.17 Richard F. Drushel Fixed description of PCB/DCB- ; wiping code in __SCAN_ACTIVE, ; __HARD_INIT, and __SOFT_INIT. ; 1 9508.08 Richard F. Drushel Fixed some comments in light of ; Coleco tech manual. Renamed all ; *public* symbols with Coleco ; names from EOS6 source code. ; Added caveats and disclaimers. ; 0 9208.10 Richard F. Drushel Original code regenerated from ; personal commented disassembly ; listing 8808.xx. Binary code ; verified identical to ROM code ; in both R59 and R80 ADAMs. ; Labels reflect absolute address ; locations of code. Z80-6801 ; synch errors and total ADAMnet ; device list from "ADAM Technical ; Manual" (Coleco, 1984). Some ; comments need to be changed to ; reflect info in the tech manual. ;*************************************************************************** ;Source code regenerated 1992 by Richard F. Drushel ;Comments (c) 1988, 1992, 1995, 1999 by Richard F. Drushel ;All rights reserved. ;Source code formatted for Z80ASM+ assembler (SLR) ;*************************************************************************** ;Some notes on the proper usage of this assembly listing. ; This regenerated source code for EOS-5 represents a huge investment ;of time and intellectual effort on my part. It forms the basis for all ;my operating systems development for the Coleco ADAM. Writing all the ;comments, with only the partial descriptions available in "The Hacker's ;Guide to ADAM" books (some of them patently *wrong*), taught me how (and ;how *not*) to write Z80 code. I'm somewhat reluctant to let it out in ;this easy-to-misuse form. But I'm doing it nonetheless. The ADAM community ;needs technical information readily available, and everything else is out ;of print (including the ADAM Technical Manual with its source listings ;of EOS-6 and OS-7). ; For this courtesy, I'd ask a few favors in return. They'll make me ;feel better, they'll help you become a better programmer, and they'll ;make my job of supporting *your* software easier under the "new" EOS I've ;been working on since 1992, and which has had a partial debut in the ;ADAMserve Serially-Linked Device Protocol. ; (1) Respect the integrity of EOS. Operating systems have defined ;entrances and defined exits, but what goes on in between is a "black box" ;that you're not supposed to fool around in. Read, memorize, and accept ;as your programming religion the following paragraph from the first page ;of Coleco's EOS-6 source code: ; This absolute listing was generated to ease software ; development on ADAM. This listing provides the location ; of both released and unreleased entry points. Released ; entry points begin immediately in this file with the jump ; table and end before the first code segment listed. ; Released entry points include the jump table, common data ; areas (EOS_COMN), common data tables, and equates which ; describe the released data structures. Direct access ; to code segments is STRONGLY DISCOURAGED and may make ; your application incompatible with some ADAMs. There is ; more than one version of EOS on the market at this time ; and updates are planned. ;This means: *ALWAYS* go through the jump table. Except for the ;actual internal entry points from the jump table (e.g. __READ_BLOCK), ;all other internal labels in my code have the form Annnnn, where nnnnn ;is a number 0-65535. These are not the Coleco names for these internal ;references, but I've left them in my raw disassembly form, to clearly ;distinguish them from public symbols. There is no guarantee that these ;internal symbols will have the same value in a future version of EOS; ;the public symbols will *always* be the same. ; (2) Don't write directly to the hardware. Use EOS function calls ;to set the video mode and do device I/O. Don't access the VDP at the ;port I/O level. Don't write directly to DCBs to do ADAMnet device I/O. ;If your code bypasses EOS, it can't be supported by an ADAM emulator ;without enormous effort. ; (3) If you make your own changes to EOS, as a part of your own ;learning/hacking experience, please *don't* spread them around ;promiscuously. If you've found an improvement, by all means share ;it with the community; but let's try to keep some control over EOS ;versionitis. TDOS is bad enough :-) ; (4) If you have suggestions for improvement, please let me know. ;Be aware, however, that I've already done alot of the obvious things ;(replacing needless absolute JPs with JRs, importing shorter versions ;of file and device I/O from EOS-7, ADAMnet emulator code for non- ;ADAMnet hardware, EOS RAMdisk). ; (5) If you find bugs in my comments, I'd like to hear about them. ;I think I'm a little confused about some of the sound data structures, ;but even the EOS-6 comments are confusing. ; (6) Don't make any money off of this, either code or in publishing, ;without asking me first. The days of commercial gain from ADAM software ;are *over*, as far as I'm concerned. ; (7) Have *fun* with your ADAM! ;Richard F. Drushel, Ph.D. ;3353 Mayfield Road ;Cleveland Heights, Ohio 44118-1329 U.S.A. ;(216) 397-0684 ;rfd@po.cwru.edu ;*************************************************************************** ;Note: EOS function calls marked with an asterisk (*) indicate direct calls ;to the routine in memory, NOT through the jump table. This must have been ;done just to frustrate anyone who might try to disassemble it. ;*************************************************************************** EOS_CODE EQU 57344 ORG EOS_CODE ;*************************************************************************** ;Externals and equates go here. COLD_START_ADDR EQU 51200 ;boot block DTA FCB_S EQU 54160 ;FCB0 THREE1K_BLKS EQU 54272 ;DTA0 ;*************************************************************************** ;EOS Function 78: WRITE VRAM. ; On entry, DE=VRAM target address to write, HL=RAM source address of ; data, BC=number of bytes to write. __WRITE_VRAM: PUSH BC ;save byte count EX DE,HL ;HL=VRAM target address to write CALL A57833 ;ENABLE VRAM WRITE subroutine LD L,C ;L=VDP data port (190) returned by subrt POP BC ;restore byte count EX DE,HL ;HL=RAM source address, E=VDP data port LD A,C ;A=lobyte of byte count LD C,E ;C=VDP data port LD D,B ;D=hibyte of byte count INC D ;D=D+1 (needed for later DEC) LD B,A ;B=lobyte of byte count (for OUTI) OR A ;B=0? (even multiples of 256) JR Z,A57366 ;YES, so get next 256 A57360: OUTI ;send (HL) out (C), HL=HL+1, B=B-1 NOP NOP ;wait a bit JR NZ,A57360 ;B not zero, so keep sending data A57366: DEC D ;B=0, so one less unit of 256 to send JR NZ,A57360 ;keep sending if D not zero RET ;B and D both zero (count done), so EXIT ;*************************************************************************** ;EOS Function 79: READ VRAM. ; On entry, DE=VRAM address to read, HL=RAM target address to receive ; data, BC=number of bytes to read. __READ_VRAM: PUSH BC ;save byte count EX DE,HL ;HL=VRAM address to read CALL A57831 ;ENABLE VRAM READ subroutine LD L,C ;L=VDP data port (190) returned by subrt POP BC ;restore byte count EX DE,HL ;HL=RAM target address, E=VDP data port LD A,C ;A=lobyte of byte count LD C,E ;C=VDP data port LD D,B ;D=hibyte of byte count INC D ;D=D+1 (needed for later DEC) LD B,A ;B=lobyte of byte count OR A ;B=0? (even multiples of 256) JR Z,A57392 ;YES, so get next 256 A57386: INI ;read (C) into (HL), HL=HL+1, B=B-1 NOP NOP ;wait a bit JR NZ,A57386 ;B not zero, so keep reading data A57392: DEC D ;B=0, so one less unit of 256 to send JR NZ,A57386 ;keep sending if D not zero RET ;B and D both zero (count done), so EXIT ;*************************************************************************** ;EOS Function 80: WRITE VDP REGISTER 0-7. ; On entry, B=register number to write (0-7), C=data byte to send. If ; register written was 0 or 1, the data byte sent is stored in RAM at ; 64865 (0) or 64866 (1). __WRITE_REGISTER: LD E,C ;E=data LD A,(VDP_CTRL_PORT) ;A=VDP control port (191) LD C,A OUT (C),E ;send data out (191) LD A,B ;A=register # OR 128 ;set bit 7 OUT (C),A ;send register # out (191) LD A,B ;A=register number OR A ;was it register 0? LD A,E ;A=data sent JR NZ,A57417 ;NO, but was it register 1? LD (VDP_REG_0),A ;YES, so save register 0 data in RAM RET ;*************************************************************************** A57417: DEC B ; RET NZ ;EXIT if register 1 wasn't written LD (VDP_REG_1),A ;save register 1 data in RAM RET ;*************************************************************************** ;EOS Function 81: READ VDP REGISTER 8. __READ_REGISTER: LD A,(VDP_CTRL_PORT) ;A=VDP control port (191) LD C,A IN A,(C) ;read port LD (VDP_STATUS_BYTE),A ;save it in RAM RET ;*************************************************************************** ;EOS Function 82: FILL VRAM WITH 1 CHARACTER (in A). ; On entry, A=character to fill, DE=number of times to fill, HL=VRAM ; address to write. __FILL_VRAM: PUSH AF ;save character CALL A57833 ;ENABLE VRAM WRITE subroutine POP HL ;get back character in H A57438: OUT (C),H ;send char out VDP data port (from subrt) DEC DE ;decrement counter LD A,D OR E ;is DE=zero? JR NZ,A57438 ;NO, so keep sending RET ;*************************************************************************** ;EOS Function 83: INITIALIZE VRAM TABLE. ; On entry, A=code for which table to initialize: (0) sprite attribute ; table, (1) sprite generator table, (2) pattern name table, (3) pattern ; generator table, (4) color table. HL=VRAM address of table. __INIT_TABLE: LD C,A LD B,0 ;BC=table code LD IX,VRAM_ADDR_TABLE ;RAM table of pointers to VRAM tables ADD IX,BC ADD IX,BC ;offset code*2 into table LD (IX+0),L LD (IX+1),H ;store HL in RAM table LD A,(VDP_REG_0) ;A=current VDP register 0 BIT 1,A ;test bit 1 JR Z,57509 ;set=graphics mode 2 (hires) LD A,C ;clear=any other mode, so get table code CP 3 ;pattern generator table? JR Z,A57481 ;YES CP 4 ;color table? JR Z,A57495 ;YES JR A57509 ;sprite attrib, gen or patt name tables ;*************************************************************************** A57481: LD B,4 ;B=register 4 for Fn80 (PATTERN GENERATOR) LD A,L OR H ;is HL=zero? JR NZ,A57491 ;NO LD C,3 ;YES, so C=3=data to send for Fn80 JR A57531 ;write it ;*************************************************************************** A57491: LD C,7 ;HL<>0, so C=7=data to send for Fn80 JR A57531 ;write it ;*************************************************************************** A57495: LD B,3 ;B=register 3 for Fn80 (COLOR TABLE) LD A,L OR H ;is HL=zero? JR NZ,A57505 ;NO LD C,127 ;YES, so C=127=data to send for Fn80 JR A57531 ;write it ;*************************************************************************** A57505: LD C,255 ;HL<>0, so C=255=data to send for Fn80 JR A57531 ;write it ;*************************************************************************** A57509: LD IY,A57535 ;IY=base of data table ADD IY,BC ADD IY,BC ;offset 2*code # into table LD A,(IY+0) ;A=table lobyte (# times to HL=HL/2) LD B,(IY+1) ;B=table hibyte (reg to write in Fn80) A57523: SRL H RR L ;HL=HL/2 DEC A ;decrement counter JR NZ,A57523 ;not done yet, so keep dividing LD C,L ;done, so C=L=data to send for Fn80 A57531: CALL WRITE_REGISTER ;Fn80: WRITE VDP REGISTER 0-7 RET ;*************************************************************************** ;DATA TABLE FOR Function 83: INITIALIZE VRAM TABLE. ; VRAM register divisor 2^n A57535: DB 7,5 ;sprite attribute table 5 7 (128) DB 11,6 ;sprite generator table 6 11 (2048) DB 10,2 ;pattern name table 2 10 (1024) DB 11,4 ;pattern generator table 4 11 (2048) DB 6,3 ;color table 3 6 (64) ;*************************************************************************** ;EOS Function 84: PUT TABLE TO VRAM. ; On entry, A=table code (see Fn83), HL=table address in RAM, DE=entry ; number in table, IY=number of entries to be moved. __PUT_VRAM: CALL A57557 ;TABLE OFFSET subroutine JP WRITE_VRAM ;Fn78: WRITE VRAM ;*************************************************************************** ;EOS Function 85: GET TABLE FROM VRAM. ; On entry, A=table code (see Fn83), HL=table address in RAM, DE=entry ; number in table, IY=number of entries to be moved. __GET_VRAM: CALL A57557 ;TABLE OFFSET subroutine JP READ_VRAM ;Fn79: READ VRAM ;*************************************************************************** ;TABLE OFFSET subroutine. ; On entry, A=table code (see Fn83), HL=table address in RAM, DE=entry ; number in table, IY=number of entries to be moved. On exit, HL is ; untouched, DE=offset into RAM table, BC=number of bytes to move. A57557: PUSH IY ;save # entries to move LD C,A ;save table code CP 4 ;color table? JR NZ,A57572 ;NO LD A,(VDP_REG_0) ;YES, so A=current register 0 AND 2 ;mask out all but bit 1 JR Z,A57591 ;bit 1 cleared LD A,C ;bit 1 set=graphics mode 2; get table code A57572: CP 2 ;pattern name table? JR Z,A57591 ;YES EX DE,HL ;NO, so HL=entry number DE (orig. HL safe) ADD HL,HL ;HL*2 ADD HL,HL ;HL*4 OR A ;sprite attribute table? JR Z,A57583 ;YES, so no more offset ADD HL,HL ;HL*8 A57583: EX DE,HL ;result: DE=DE*4 or *8; HL untouched EX (SP),HL ;since IY on stack, HL=IY, old HL on stack ADD HL,HL ;HL*2 ADD HL,HL ;HL*4 JR Z,A57590 ;sprite attrib table? YES=no more offset ADD HL,HL ;HL*8 A57590: EX (SP),HL ;result: stack=IY*4 or *8, HL untouched A57591: LD A,C ;A=table code LD BC,VRAM_ADDR_TABLE ;RAM table of pointers to VRAM tables PUSH HL ;save original entry HL LD H,0 LD L,A ;HL=table code ADD HL,HL ;HL*2 ADD HL,BC ;plus base of RAM table=offset LD A,(HL) ;A=lobyte of address in RAM table INC HL ;point to hibyte LD H,(HL) ;H=hibyte of address in RAM table LD L,A ;HL=VRAM table address ADD HL,DE ;add offset amount in DE computed above EX DE,HL ;DE=offset address in VRAM POP HL ;HL still=entry value (RAM source table) POP BC ;BC from stack=entry IY*4 or *8 RET ;*************************************************************************** ;EOS Function 86: CALCULATE OFFSET INTO SPRITE ATTRIBUTE TABLE. ; On entry, D=Y-coordinate of pattern position, E=X-coordinate. D and E ; are signed 8-bit numbers (-128 to +127). On exit, DE=(Y*32)+X. __CALC_OFFSET: PUSH HL BIT 7,D ;D<0? (sign bit set) JR Z,A57619 ;YES LD H,255 ;NO, so H=255 JR A57621 ;*************************************************************************** A57619: LD H,0 ;D<0 signed, so H=0 A57621: LD L,D ;HL=D (sign bit clear) or HL=65280+D (set) ADD HL,HL ;HL*2 ADD HL,HL ;HL*4 ADD HL,HL ;HL*8 ADD HL,HL ;HL*16 ADD HL,HL ;HL*32; result is HL=D*32 BIT 7,E ;E<0? (sign bit set) JR Z,A57635 ;YES LD D,255 ;NO, so D=255 JR A57637 ;*************************************************************************** A57635: LD D,0 ;E<0 signed, so H=0 A57637: ADD HL,DE ;result is HL=(D*32)+E EX DE,HL ;DE=offset POP HL RET ;*************************************************************************** ;EOS Function 87: POINT TO PATTERN POSITION. ; On entry, DE=signed 16-bit number (X-coordinate or Y-coordinate of ; pattern). On exit, DE ranges from -128 to +127. __PX_TO_PTRN_POS: PUSH HL PUSH BC LD B,3 ;number of times to (DE=DE/2) A57645: SRA D RR E ;DE=DE/2 DJNZ A57645 ;keep dividing 'til B=0 POP BC LD HL,65408 ;HL=1111 1111 1000 0000 binary BIT 7,D ;is DE<0? (sign bit set) JR NZ,A57665 ;NO ADD HL,DE ;YES, so HL=HL+DE; was there a carry? POP HL ;restore entry HL RET NC ;no carry, so EXIT LD E,127 ;carry, so DE=+127 RET ;*************************************************************************** A57665: LD H,0 ;zero out sign extension in H ADD HL,DE ;HL=HL+DE; was there a carry? POP HL ;restore entry HL RET C ;carry, so EXIT LD E,128 ;no carry, so DE=-128 RET ;*************************************************************************** ;EOS Function 88: LOAD ASCII CHARACTER SET FROM ROM TO VDP. __LOAD_ASCII: LD DE,(PATTRNGENTBL) ;DE=VRAM addr of pattern generator table LD HL,0 ;HL=ASCII code of 1st character to load LD BC,128 ;# of character patterns to load ;fall thru to Fn77: PUT ASCII CHAR TO VDP ;************************************************************************** ;EOS Function 77: PUT ASCII CHARACTER PATTERN TO VDP. ; On entry, HL=code of first character pattern to load, BC=number of ; patterns, DE=VRAM address of pattern generator table. __PUT_ASCII: ADD HL,HL ;HL*2 ADD HL,HL ;HL*4 ADD HL,HL ;HL*8 -- 8 bytes per pattern (offset) PUSH BC ;save BC on stack EX (SP),HL ;effectively, HL=BC, old HL on stack ADD HL,HL ;HL*2 ADD HL,HL ;HL*4 ADD HL,HL ;HL*8 -- total bytes to load = # char*8 EX (SP),HL ;effectively, old HL back, BC*8 on stack POP BC ;BC=BC*8 from stack LD IX,0 ADD IX,SP ;IX=address of old stack LD SP,TEMP_STACK ;address of temporary stack PUSH IX ;save address of old stack LD A,(CUR_BANK) ;A=current memory configuration PUSH AF ;save it LD A,(MEM_CNFG00) ;memory configuration 0: EOS -- RAM PUSH BC ;save pattern count CALL SWITCH_MEM ;Fn76: BANK SWITCH MEMORY (to A) POP BC ;get back pattern count PUSH DE ;save VRAM addr of pattern gen table LD DE,(258) ;DE=addr of char set patterns in EOS ROM ADD HL,DE ;add offset so HL=EOS addr of 1st pattern POP DE ;restore VRAM addr of pattern gen table CALL WRITE_VRAM ;Fn78: WRITE VRAM POP AF ;get back original memory configuration CALL SWITCH_MEM ;Fn76: BANK SWITCH MEMORY (to A) POP HL ;get back old stack address LD SP,HL ;point SP at old stack RET ;*************************************************************************** ;EOS Function 76: BANK SWITCH MEMORY (to A). ; On entry, A=memory configuration (0-15). Memory configurations decode ; as follows: ; lower 32K upper 32K ; 0 SmartWriter or EOS RAM ; 1 RAM RAM ; 2 expansion RAM RAM ; 3 OS-7 plus 24K RAM RAM ; 4 SmartWriter or EOS expansion ROM (center slot) ; 5 RAM expansion ROM (center slot) ; 6 expansion RAM expansion ROM (center slot) ; 7 OS-7 plus 24K RAM expansion ROM (center slot) ; 8 SmartWriter or EOS expansion RAM ; 9 RAM expansion RAM ;10 expansion RAM expansion RAM ;11 OS-7 plus 24K RAM expansion RAM ;12 SmartWriter or EOS cartridge ROM ;13 RAM cartridge ROM ;14 expansion RAM cartridge ROM ;15 OS-7 plus 24K RAM cartridge ROM ; In order to select the SmartWriter ROM, an OUT (63),0 must be executed ;first. To select the EOS ROM, use OUT (63),2. __SWITCH_MEM: LD B,A LD A,(MEM_SWITCH_PORT) ;A=memory switch port (127) LD C,A OUT (C),B ;do the switch LD A,B LD (CUR_BANK),A ;save new memory configuration as current RET ;*************************************************************************** ;EOS Function 75: GET I/O PORTS FROM OS-7. ; The OS-7 ROM contains the ColecoVision game cartridge operating system. ; The values retrieved are stored in RAM as follows: ;64551 memory switch port 127 ;64552 ADAMnet reset port 63 ;64553 VDP control port 191 ;64554 VDP data port 190 ;64555 game controller 1 port 252 ;64556 game controller 2 port 255 ;64557 strobe set port 128 ;64558 strobe reset port 192 ;64559 sound port 255 __PORT_COLLECTION: LD A,(CUR_BANK) ;A=current memory configuration PUSH AF ;save it LD A,(MEM_CNFG03) ;memory configuration 3: ;lower 32K=OS-7 plus 24K RAM ;upper 32K=RAM CALL SWITCH_MEM ;Fn76: BANK SWITCH MEMORY (to A) LD HL,VDP_CTRL_PORT ;HL=RAM address of VDP control port LD A,(7491) ;get port from OS-7 LD (HL),A ;save it in RAM INC HL ;HL=RAM address of VDP data port (64554) LD A,(7495) ;get port from OS-7 LD (HL),A ;save it in RAM INC HL ;HL=RAM addr of game contrl 1 port (64555) LD A,(4427) ;get port from OS-7 LD (HL),A ;save it in RAM INC HL ;HL=RAM addr of game contrl 2 port (64556) LD A,(4433) ;get port from OS-7 LD (HL),A ;save it in RAM INC HL ;HL=RAM address of strobe set port (64557) LD A,(4439) ;get port from OS-7 LD (HL),A ;save it in RAM INC HL ;HL=RAM addr of strobe reset port (64558) LD A,(4456) ;get port from OS-7 LD (HL),A ;save it in RAM INC HL ;HL=RAM address of sound port (64559) LD A,(398) ;get port from OS-7 LD (HL),A ;save it in RAM POP AF ;restore old memory configuration CALL SWITCH_MEM ;Fn76: BANK SWITCH MEMORY (to A) RET ;*************************************************************************** ;EOS Function 89: WRITE VRAM SPRITE ATTRIBUTE TABLE. ; On entry, A=number of sprites to write, HL=address of sprite order table ; in RAM, DE=address of RAM copy of sprite attribute table. __WR_SPR_ATTRIBUTE: PUSH AF PUSH HL LD HL,(SPRITEATTRTBL) ;HL=VRAM addr of sprite attribute table CALL A57833 ;ENABLE WRITE VRAM; return C=VDP data port POP HL POP AF LD B,A ;save count of sprites to write A57808: LD A,(HL) ;A=sprite ID # from order table ADD A,A ;A*2 ADD A,A ;A*4 INC HL ;point to next entry in order table PUSH HL ;save address LD L,A LD H,0 ;HL=offset into table ADD HL,DE ;DE=offset addr in RAM sprite attr table LD A,B ;restore A=count of sprites to write LD B,4 ;4 bytes to send per sprite A57820: OUTI ;send a byte at (HL) out VDP data port NOP NOP ;wait a bit JR NZ,A57820 ;send the next byte LD B,A ;restore B=count of sprites to write POP HL ;HL=address of next entry in order table DJNZ A57808 ;send the next sprite RET ;all requested were sent; exit ;*************************************************************************** ;ENABLE VRAM READ/WRITE subroutines. ; On entry, HL=VRAM address to read/write. On exit, C=VDP data port (190). ; Unfortunately, these subroutines have overlapping reading frames: ; (1) Function 79 (read VRAM) enters at 57831: ;57831 AF XOR A ;zero out A for reads ;57832 C23E40 JP NZ,16446 ;never jumps because ZF=1 after XOR A ;continues at 57835 ; (2) Functions 78 (write VRAM), 82 (fill VRAM with 1 character (in A)), ; and 89 (write VRAM sprite attribute table) enter at 57833: ;57831 AFC2 ;unused ;57833 3E40 LD A,64 ;A=64 for writes; continues at 57835 A57831: XOR A DB 194 A57833: LD A,64 LD BC,(VDP_CTRL_PORT) ;B=VDP data port, C=VDP control port OUT (C),L ;send lobyte of VRAM address OR H ;set bit 6 of H (writes) or not (reads) OUT (C),A ;send hibyte of VRAM address LD C,B ;VDP data port in C RET ;*************************************************************************** ;DATA TABLE FOR Function 90: READ GAME CONTROLLERS. ; Offset into the table is the actual data returned by the controller. ; Value at the offset is the decoded value. ; DATA IN: DECODED TO: A57846: DB 15 ; 0 15 = nothing DB 6 ; 1 6 DB 1 ; 2 1 DB 3 ; 3 3 DB 9 ; 4 9 DB 0 ; 5 0 DB 10 ; 6 10 = * DB 12 ; 7 12 = Super-Action controller button? DB 2 ; 8 2 DB 11 ; 9 11 = # DB 7 ; 10 7 DB 13 ; 11 13 = Super-Action controller button? DB 5 ; 12 5 DB 4 ; 13 4 DB 8 ; 14 8 DB 15 ; 15 15 = nothing (this is an error) ;*************************************************************************** ;READ AND DEBOUNCE GAME CONTROLLER subroutine. ; On entry, A=controller to read (0=player 2, 1=player 1). On exit, D= ; decoded keypad value (0-15), B=right button status (0=not pressed, 64= ; pressed), H=left button status (0=not pressed, 64=pressed), L=joystick ; position, E=previous value of spinner. A57862: LD C,A ;save controller number to read LD A,I ;get current interrupt status register ;NOTE: parity flag set if INT disabled PUSH AF ;save interrupt status DI ;disable maskable INT (if not already) LD A,C ;restore A=controller to read LD BC,(STROBE_SET_PORT) ;B=strobe reset port, C=strobe set port OUT (C),A ;read request LD D,B ;save strobe reset port in D LD HL,SPIN_SW0_CT ;HL=address of spinner 1 LD BC,(CONTROLLER_0_PORT) ;B=controller 2 port, C=controller 1 port OR A ;are we reading controller 1 or 2? JR NZ,A57887 ;#1, so reset spinner 1 INC HL ;#2, so point to spinner 2 LD C,B ;C=controller 2 port A57887: XOR A ;A=0 LD E,(HL) ;E=old spinner value LD (HL),A ;new spinner value=0 LD B,D ;restore B=strobe reset port IN A,(C) ;read controller port into A CPL ;1's complement A LD H,0 LD L,A ;HL=1's complement A LD A,C ;save controller port in A LD C,B ;C=saved strobe reset port OUT (C),A ;debounce controller by sending the port # LD C,A ;save controller port in C POP AF ;restore entry flags JP PO,A57907 ;at entry, maskable INTs were disabled, ;so leave them disabled EI ;otherwise, enable interrupts A57907: LD A,L ;restore saved 1's complement of 1st read PUSH AF ;save it again AND 64 ;mask out all but bit 6 LD B,A ;save it in B (RIGHT BUTTON) LD A,L ;restore saved 1's complement of 1st read AND 15 ;select low nibble of byte (table offset) LD L,A ;save it in L PUSH DE LD DE,A57846 ;DE=base of keypad decoding data table ADD HL,DE ;point HL to data in table POP DE LD D,(HL) ;D=decoded value from table (KEYPAD) IN A,(C) ;read controller port again CPL ;1's complement A PUSH AF ;save it LD L,A ;put it in L AND 64 ;mask out all but bit 6 LD H,A ;save it in H (LEFT BUTTON) LD A,L ;restore saved 1's complement of A AND 15 ;select low nibble of byte LD L,A ;save it in L (JOYSTICK) POP AF ;get 1's complement of 2nd read off stack LD C,A ;put it in C POP AF ;get 1's complement of 1st read off stack RET ;exit ;*************************************************************************** ;EOS Function 90: READ GAME CONTROLLERS. ; On entry, IX=address of 10-byte RAM table to hold controller data (joy- ; stick, left button, right button, decoded keypad, spinner for player 2, ; followed by player 1), A=weird code for which controller(s) to read: ; BITS 1,0: ; 00 none ; 01 controller 2 ; 10 controller 1 ; 11 controller 2, then controller 1 ; BIT 7: ; 1 add old EOS spinner value to old in RAM data table ; 0 don't update RAM spinner ; NOTE: This routine must be called TWICE in succession with the same ; controller code in order to update the RAM table ONCE. See discussion ; under STORE CONTROLLER DATA IN RAM TABLE subroutine. ; Coleco programmer documentation for EOS-7 refers to CONTROLLER_0 and ; CONTROLLER_1. These in fact correspond to the ports which are marked "2" ; (player 2) and "1" (player 1) on the ADAM console, respectively. I will ; use the console/player designations. __POLLER: LD HL,PERSONAL_DEBOUNCE_TABLE ;HL=base of controller input data in EOS LD C,A ;save controller read code in C AND 1 ;is it controller 2? JR Z,A57982 ;NO DEC A ;YES... CALL A57956 ;read controller 2 BIT 1,C ;do we also read controller 1? RET Z ;NO (clear) so exit having read just #2 A57954: LD A,1 ;YES so A=1 (READ/DEBOUNCE code for #1) A57956: PUSH BC ;resave controller read code PUSH HL ;save EOS table position CALL A57862 ;READ/DEBOUNCE GAME CONTROLLER subrt LD C,H ;C=left button status LD A,L ;A=joystick position POP HL ;restore EOS table position CALL A57995 ;STORE CONTROLLER DATA IN RAM subroutine POP BC ;restore controller read code BIT 7,C ;update RAM spinner with EOS data? JR Z,A57979 ;NO, so exit LD A,E ;YES, so A=old EOS spinner value ADD A,(IX+0) ;add it to RAM spinner LD (IX+0),A ;save new spinner in RAM table A57979: INC IX ;point to next RAM controller block RET ;*************************************************************************** A57982: BIT 1,C ;do we read controller 1? RET Z ;NO (clear), so exit having read nothing LD DE,4 ;YES (set), so skip over controller 2 ADD HL,DE ;HL=65118 (EOS data for controller 1) INC DE ;length of RAM table entry=5 ADD IX,DE ;point IX to RAM table for controller 1 JP A57954 ;go back ;*************************************************************************** ;STORE CONTROLLER DATA IN RAM TABLE subroutine. ; On entry, HL=address of EOS table for controller data (either player 2 ; or player 1 4-byte block), IX=address of similar RAM table (but 5 bytes ; per player block, spinner last), A=joystick position, C=left button ; status, B=right button status, D=keypad status. On exit, IX points to ; spinner data byte. NOTE: This routine alternately updates either the ; EOS or the RAM table. The first call updates EOS, and the second ; compares the incoming data with that previously stored in EOS. The RAM ; table will only be updated if the two match. Therefore, Function 90 ; must be called TWICE in succession in order to update the RAM table ONCE. A57995: CALL A58007 ;store joystick data (entry A) in RAM LD A,C ;A=left button status CALL A58007 ;store it LD A,B ;A=right button status CALL A58007 ;store it LD A,D ;A=decoded keypad A58007: CP (HL) ;compare it with previous value in EOS JR NZ,A58015 ;different, so update EOS but not RAM LD (IX+0),A ;same, so update RAM and... OR 128 ;set bit 7 of data (make it different) A58015: LD (HL),A ;update EOS INC IX ;point to next EOS INC HL ;point to next RAM RET ;*************************************************************************** ;EOS Function 91: UPDATE SPINNER 1 AND 2. __UPDATE_SPINNER: LD BC,(CONTROLLER_0_PORT) ;B=controller 2 port, C=controller 1 port IN A,(C) ;read controller 1 port LD HL,SPIN_SW0_CT ;HL=address of spinner 1 BIT 4,A ;was it spun? (bit 4 clear) JR NZ,A58040 ;NO, so check spinner 2 AND 32 ;YES, but which way? (bit 5) JR NZ,A58039 ;UP (bit 5 set) so increment spinner DEC (HL) ;DOWN (bit 5 clear) so decrement spinner DEC (HL) ;down 2 and up 1 equals down 1 A58039: INC (HL) A58040: LD C,B ;C=controller 2 port IN A,(C) ;read controller 2 port INC HL ;HL=65113 (address of spinner 2) BIT 4,A ;was it spun? (bit 4 clear) RET NZ ;NO, so exit AND 32 ;YES, but which way? (bit 5) JR NZ,A58053 ;UP (bit 5 set) so increment spinner DEC (HL) ;DOWN (bit 5 clear) so decrement spinner RET ;**************************************************************************** A58053: INC (HL) ;increment spinner RET ;*************************************************************************** ;UPDATE SIMPLE NOTE subroutine. ; On entry, IX=output table address. On exit, ZF=1 if the note is over, ; ZF=0 if not. A58055: LD A,(IX+7) ;A=freq step size byte from output table OR A ;is it zero? JR NZ,A58070 ;NO, so UPDATE FREQUENCY-SWEPT NOTE LD A,(IX+5) ;YES, so A=note length byte DEC A ;one less clock tick; is it zero? RET Z ;YES, so exit LD (IX+5),A ;NO, so save new length in output table RET ;*************************************************************************** ;UPDATE FREQUENCY-SWEPT NOTE subroutine. ; On entry, IX=output table address. On exit, ZF=1 if the note is over, ; ZF=0 if not. A58070: PUSH IX ;save output table address... POP HL ;and get it back in HL LD DE,6 ;offset ADD HL,DE ;point to byte IX+6: freq step period (4 ;bits), 1st freq step period (4 bits) CALL __DECLSN ;*Fn92: DECREMENT LOW NIBBLE OF (HL) ;1st freq step period is decremented RET NZ ;not time to step yet, so exit CALL __MSNTOLSN ;*Fn94: HIGH NIBBLE OF (HL) TO LOW NIBBLE ;time to step! so move freq step period ;down to lower 4 bits (still in upper 4) ;all later freq steps have this duration DEC HL ;back up to IX+5: note length LD A,(HL) ;A=note length DEC A ;one less clock tick; is it zero? RET Z ;YES, so exit LD (HL),A ;NO, so save new length in output table DEC HL DEC HL ;back up 2 to IX+3: freq bits F2-F9 LD A,(IX+7) ;A=frequency step size CALL __ADD816 ;*Fn95: ADD A TO WORD AT HL ;add the frequency step, also incrementing ;the low freq bits F0-F1 in byte IX+4 INC HL ;point to IX+4: freq bits in low nibble RES 2,(HL) ;clear bit 2 of frequency OR 255 ;A=255, ZF=0 RET ;*************************************************************************** ;UPDATE VOLUME-SWEPT NOTE subroutine. ; On entry, IX=output table address. On exit, ZF=1 if the note is over, ; ZF=0 if not. A58103: LD A,(IX+8) ;A=vol step size/vol step # byte OR A ;is it zero? (unused) RET Z ;YES, so exit PUSH IX ;save output table address... POP HL ;and get it back in HL LD DE,9 ;offset ADD HL,DE ;point HL at byte IX+9: vol step period ;(4 bits), 1st vol step period (4 bits) CALL __DECLSN ;*Fn92: DECREMENT LOW NIBBLE OF (HL) ;1st vol step period is decremented RET NZ ;not time to step yet, so exit CALL __MSNTOLSN ;*Fn94: HIGH NIBBLE OF (HL) TO LOW NIBBLE ;time to step! so move vol step period ;down to low nibble (still in upper) ;all later steps will have this duration DEC HL ;back up to IX+8: vol step size/step # CALL __DECLSN ;*Fn92: DECREMENT LOW NIBBLE OF (HL) ;one less step; is it zero? JR Z,A58149 ;YES, so zero out the byte and exit LD A,(HL) ;NO, so get it back in A (size old, # new) AND 240 ;mask out lower 4 bits (leaves size) LD E,A ;save in in A DEC HL DEC HL DEC HL ;back up 4 to byte IX+4: volume (4 bits), DEC HL ;low bits of frequency (4 bits) LD A,(HL) ;get it in A AND 240 ;mask out lower 4 bits (leaves volume) ADD A,E ;add step size to volume LD E,A ;save it in E LD A,(HL) ;get back vol/freq byte AND 15 ;mask out upper 4 bits (leaves freq) OR E ;merge in new volume as upper 4 bits LD (HL),A ;save it back in output table OR 255 ;A=255, ZF=0 RET ;*************************************************************************** A58149: LD (HL),0 ;zero out vol step size/step # byte RET ;*************************************************************************** ;SEND NOTE VOLUME subroutine. ; On entry, IX=output table address, C=voice-dependent volume base as in ; the following table: ; 144 [1001 0000] -- voice 1 ; 176 [1011 0000] -- voice 2 ; 208 [1101 0000] -- voice 3 ; 240 [1111 0000] -- noise volume ; 224 [1110 0000] -- periodic noise ; 228 [1110 0100] -- white noise A58152: LD A,(IX+4) ;A=volume/frequency byte BIT 4,C ;is bit 4 set? (voice 1,2,3, noise vol) JR Z,A58163 ;NO, so skip the shifting RRCA ;YES, so get volume RRCA RRCA RRCA ;volume in lower 4 bits, freq in upper 4 A58163: AND 15 ;wipe out upper 4 bits OR C ;add voice-dependent base JP A58893 ;SEND DATA (in A) OUT SOUND PORT subrt ;*************************************************************************** ;SEND NOTE FREQUENCY subroutine. ; On entry, IX=output table address, D=voice-dependent frequency base as in ; the following table: ; 128 [1000 0000] -- voice 1 ; 160 [1010 0000] -- voice 2 ; 192 [1100 0000] -- voice 3 A58169: LD A,(IX+3) ;A=frequency byte (high 8 bits) AND 15 ;mask out upper 4 bits OR D ;merge with voice-dependent frequency base CALL A58893 ;SEND DATA (in A) OUT SOUND PORT subrt LD A,(IX+3) ;get back frequency byte AND 240 ;this time, mask out lower 4 bits LD D,A ;save it in D LD A,(IX+4) ;A=vol/freq byte (low nibble is freq) AND 15 ;mask out upper 4 bits OR D ;merge with other frequency bits RRCA RRCA RRCA RRCA ;effectively, swap nibbles JP A58893 ;SEND DATA (in A) OUT SOUND PORT subrt ;*************************************************************************** ;EOS Function 92: DECREMENT LOW NIBBLE OF (HL). ; On exit, the low nibble of (HL) is decremented, A=new value of low ; nibble, and ZF=1 if it is now zero. __DECLSN: XOR A ;A=0 RRD ;move low nibble of (HL) into A SUB 1 ;decrement it PUSH AF ;save it with flags RLD ;move decremented nibble back to (HL) POP AF ;restore nibble value in A with flags RET ;*************************************************************************** ;EOS Function 93: DECREMENT HIGH NIBBLE OF (HL). ; On exit, the high nibble of (HL) is decremented, A=new value of high ; nibble, and ZF=1 if it is now zero. This function is not used anywhere ; in EOS-5. __DECMSN: XOR A ;A=0 RLD ;move high nibble of (HL) into A SUB 1 ;decrement it PUSH AF ;save it with flags RRD ;move decremented nibble back to (HL) POP AF ;restore nibble value in A with flags RET ;*************************************************************************** ;EOS Function 94: HIGH NIBBLE OF (HL) TO LOW NIBBLE. ; On exit, the high nibble of (HL) is moved to the low nibble, with the ; original high nibble unchanged. __MSNTOLSN: LD A,(HL) ;A=memory byte AND 240 ;mask out low nibble LD B,A ;save it in B RRCA RRCA RRCA RRCA ;shift the high nibble down to low OR B ;merge in the original high nibble LD (HL),A ;put it back in memory RET ;*************************************************************************** ;EOS Function 95: ADD A TO WORD AT HL. ; On entry, A=data to add, (HL)=lobyte of word, (HL+1)=hibyte of word. On ; exit, A is added to word, and HL still points to the lobyte. __ADD816: LD B,0 ;B=0 BIT 7,A ;is bit 7 set? (>=128) JR Z,A58235 ;NO, so no carry to hibyte DEC B ;YES, so maybe a carry; B=255 A58235: ADD A,(HL) ;add A to lobyte of word LD (HL),A ;save lobyte sum INC HL ;point to hibyte LD A,(HL) ;get it in A ADC A,B ;add B to hibyte for carry LD (HL),A ;save hibyte sum DEC HL ;point back to lobyte RET ;*************************************************************************** ;GET ADDRESS OF OUTPUT TABLE (in IX) subroutine. ; On entry, B=code for voice (1=noise, 2=voice1, 3=voice2, 4=voice3). On ; exit, IX=address of output table for the requested voice, HL points to ; hibyte of output table address in voice table. A58243: LD HL,(PTR_TO_LST_OF_SND_ADDRS) ;HL=address of voice list DEC HL DEC HL ;back up 2 (gives required offset) LD C,B LD B,0 ;BC=B RLC C ;BC*2 RLC C ;BC*4 ADD HL,BC ;offset into voice table LD E,(HL) ;E=lobyte of output table address INC HL ;point to hibyte LD D,(HL) ;D=hibyte of output table address PUSH DE ;save it on stack POP IX ;get it back in IX RET ;*************************************************************************** ;GET SPECIAL EFFECTS NOTE EXECUTION ADDRESS (in HL) subroutine. ; On entry, IX=output table address. On exit, if the current note is ; special effects, HL=execution address, and A=62. If there is no note, ; A=255. A is unpredictable if the note is anything other than special ; effects. A58263: LD A,(IX+0) ;A=current note from output table CP 255 ;is it 255? (no note) RET Z ;YES, so exit AND 63 ;mask out upper 2 bits CP 62 ;is it 62? (special effects) RET NZ ;NO, so exit PUSH IX ;YES, so save output table address... POP HL ;and get it back in HL INC HL ;point to lobyte of execution address LD E,(HL) ;get it in E INC HL ;point to hibyte LD D,(HL) ;get it in D EX DE,HL ;swap execution address into HL RET ;*************************************************************************** ;EOS Function 96: SOUND INITIALIZATION. ; On entry, B=number of voices to initialize (1-4), HL=address of song ; table with the following format: ; address of noise note table (lobyte, hibyte) ; address of noise output table (lobyte, hibyte) ; ...same for voices 1,2,3. ; On exit, the current note of each voice in the output table and the saved ; control sound are set to null (255), and the EOS voice table pointers are ; set to 58342 (address of another null). __SOUND_INIT: LD (PTR_TO_LST_OF_SND_ADDRS),HL ;save voice table address in RAM INC HL INC HL ;point ahead 2 to output table address LD E,(HL) ;get lobyte of address INC HL ;point to hibyte LD D,(HL) ;get hibyte of address EX DE,HL ;save output table address in HL LD DE,10 ;length of note entry in table=10 bytes LD A,255 ;code for no note being played=255 A58297: LD (HL),A ;save it as first byte of note entry ADD HL,DE ;point to next note in output table DJNZ A58297 ;keep initializing 'til all voices done LD (HL),0 ;end with a zero to show no more voices LD HL,A58342 ;HL=address of null sound (58342)=255 LD (PTR_TO_S_ON_0),HL ;noise pointer LD (PTR_TO_S_ON_1),HL ;voice 1 pointer LD (PTR_TO_S_ON_2),HL ;voice 2 pointer LD (PTR_TO_S_ON_3),HL ;voice 3 pointer LD (SAVE_CTRL),A ;saved control sound=255 ;falls through to Fn97: SOUND OFF ;*************************************************************************** ;EOS Function 97: SOUND OFF. ; On exit, the three voices and the noise channel are turned off. __TURN_OFF_SOUND: LD A,(SOUNDPORT) ;A=sound port LD C,A ;save it in C LD A,159 ;volume off voice 1 OUT (C),A ;send it LD A,191 ;volume off voice 2 OUT (C),A ;send it LD A,223 ;volume off voice 3 OUT (C),A ;send it LD A,255 ;volume off noise channel OUT (C),A ;send it RET ;*************************************************************************** ;NULL SOUND FOR EOS VOICE TABLE INITIALIZATION. A58342: DB 255 ;*************************************************************************** ;EOS Function 98: START VOICE. ; On entry, B=number of the voice to start (1=noise, 2=voice1, 3=voice2, ; 4=voice3. On exit, the first note of that voice is ready to play. __PLAY_IT: PUSH BC ;save voice number CALL A58243 ;GET ADDR OF OUTPUT TABLE (in IX) subrt LD A,(IX+0) ;A=current note from output table AND 63 ;mask out voice bits (leaving song #) ;7-6=voice; 5-0=song # POP BC ;restore voice number CP B ;is it already started? (same) RET Z ;YES, so exit LD (IX+0),B ;NO, so put voice # in output table DEC HL ;back up 2 in song table to get note DEC HL ;table addr (HL set by subroutine) LD D,(HL) DEC HL LD E,(HL) ;DE=note table address LD (IX+1),E LD (IX+2),D ;put it in the output table CALL A58610 ;NOTE, REST, REPEAT OR END subroutine JR A58490 ;LOAD POINTERS TO VOICE OUTPUT TABLES sub ;RET is here ;*************************************************************************** ;EOS Function 99: SOUND. ; On entry, all necessary voice tables must have been properly set up and ; initialized. __SOUNDS: LD A,159 ;off volume voice 1 LD C,144 ;volume base voice 1 LD D,128 ;frequency base voice 1 LD IX,(PTR_TO_S_ON_1) ;IX=address of voice 1 output table CALL A58454 ;PLAY A NOTE subroutine LD A,191 ;off volume voice 2 LD C,176 ;volume base voice 2 LD D,160 ;frequency base voice 2 LD IX,(PTR_TO_S_ON_2) ;IX=address of voice 2 output table CALL A58454 ;PLAY A NOTE subroutine LD A,223 ;off volume voice 3 LD C,208 ;volume base voice 3 LD D,192 ;frequency base voice 3 LD IX,(PTR_TO_S_ON_3) ;IX=address of voice 3 output table CALL A58454 ;PLAY A NOTE subroutine LD A,255 ;off volume noise channel LD C,240 ;volume base noise channel LD IX,(PTR_TO_S_ON_0) ;IX=address of noise output table LD E,(IX+0) ;get current note in E INC E ;is it 255? (no note) JR NZ,A58432 ;NO, it's OK CALL A58893 ;YES, so SEND DATA (in A) OUT SOUND PORT JR A58469 ;CHECK IF EACH VOICE IS DONE subroutine ;*************************************************************************** A58432: CALL A58152 ;SEND NOTE VOLUME subroutine LD A,(IX+4) ;A=note vol/freq byte from output table AND 15 ;mask out upper 4 bits (leaves 0 0 F0 F1) LD HL,SAVE_CTRL ;HL=address of saved control sound CP (HL) ;is it the same? JR Z,A58469 ;YES, so CHECK IF EACH VOICE IS DONE subrt LD (HL),A ;NO, so update with current value LD C,224 ;volume base for periodic nose CALL A58152 ;SEND NOTE VOLUME subroutine JR A58469 ;CHECK IF EACH VOICE IS DONE subroutine ;*************************************************************************** ;PLAY A NOTE subroutine. ; On entry, IX=address of output table, A=off volume for voice, C=volume ; base for voice, D=frequency base for voice. On exit, if the current ; note=255 (no note), the current voice is turned off. Otherwise, the ; note is played. A58454: LD E,(IX+0) ;E=current note from output table INC E ;is it 255? (no note) JR NZ,A58463 ;NO, note is OK JP A58893 ;YES, so SEND DATA (in A) OUT SOUND PORT ;*************************************************************************** A58463: CALL A58152 ;SEND NOTE VOLUME subroutine JP A58169 ;SEND NOTE FREQUENCY subroutine ;*************************************************************************** ;CHECK IF EACH VOICE IS DONE subroutine. A58469: LD B,1 ;code for noise channel CALL A58243 ;GET ADDR OF OUTPUT TABLE (in IX) subrt A58474: LD A,0 ;A=0 CP (IX+0) ;is it the end of the output table? RET Z ;YES, so exit CALL A58573 ;NO, so FINISH PLAY AND CHECK IF DONE sub LD DE,10 ;length of output table entry ADD IX,DE ;point to next entry JR A58474 ;keep going 'til end of table ;*************************************************************************** ;LOAD POINTERS TO VOICE OUTPUT TABLES subroutine. A58490: PUSH IX LD HL,A58342 ;address of null sound LD (PTR_TO_S_ON_0),HL ;init noise pointer LD (PTR_TO_S_ON_1),HL ;init voice 1 pointer LD (PTR_TO_S_ON_2),HL ;init voice 2 pointer LD (PTR_TO_S_ON_3),HL ;init voice 3 pointer LD B,1 CALL A58243 ;GET ADDR OF OUTPUT TABLE (in IX) subrt A58512: LD A,(IX+0) ;A=current note OR A ;is it zero? (end of output table) JR Z,A58549 ;YES, so exit INC A ;NO, but is it 255? (no note) JR Z,A58542 ;YES, so point to next note LD A,(IX+0) ;NO, this note's OK, so get it back AND 192 ;select voice bits (7-6) RLCA RLCA RLCA ;effectively, A=voice*2 LD E,A LD D,0 ;DE=voice offset LD HL,PTR_TO_S_ON_0 ;base of pointers to voice output tables ADD HL,DE ;select sound (DE=0,1,2,3) PUSH IX ;save output table address... POP DE ;and get it back in DE LD (HL),E ;lobyte of address to EOS table INC HL ;point to next slot LD (HL),D ;hibyte of address to EOS table A58542: LD DE,10 ;length of output table entry ADD IX,DE ;offset to next entry JR A58512 ;keep going ;*************************************************************************** A58549: POP IX RET ;*************************************************************************** ;EOS Function 100: END SPECIAL EFFECTS. ; On entry, IX=output table address, HL=address of next special effects ; note, DE=?. __EFFECT_OVER: LD (IX+1),L LD (IX+2),H ;store next note exec addr in output table LD A,(DE) ;get A from (DE) AND 63 ;mask out upper 2 bits LD B,A ;save it in B LD A,(IX+0) ;get old note AND 192 ;mask out lower 6 bits OR B ;merge with B LD (IX+0),A ;save it back in output table JR A58595 ;copy next note to output table ;*************************************************************************** ;FINISH PLAY AND CHECK IF DONE subroutine. ; If the note is special effects, it is executed. If not, volume and ; frequency sweeps and note lengths are updated. If the note is over, the ; next note from the note table is loaded into the output table. Otherwise, ; nothing happens. A58573: CALL A58263 ;GET SPECIAL FX NOTE EXEC ADDRESS (in HL) CP 255 ;was there a note? RET Z ;NO, so exit CP 62 ;YES, but was it special effects? JR NZ,A58588 ;NO, a regular note LD DE,7 ;YES, it was special effects ADD HL,DE ;offset 7 from address JP (HL) ;play the special effects note ;*************************************************************************** A58588: CALL A58103 ;UPDATE VOLUME-SWEPT NOTE subroutine CALL A58055 ;UPDATE SIMPLE NOTE subroutine RET NZ ;note not over, so exit A58595: LD A,(IX+0) ;note is done! get old note PUSH AF ;save it CALL A58610 ;NOTE, REST, REPEAT OR END subroutine POP BC ;restore old note LD A,(IX+0) ;get new note from output table CP B ;is it the same voice and kind? RET Z ;YES, so exit JR A58490 ;NO, so LOAD POINTERS TO ;VOICE OUTPUT TABLES subroutine ;*************************************************************************** ;NOTE, REST, REPEAT OR END subroutine. ; On entry, IX=address of output table. On exit, the output table is set ; up to play the next note. A58610: LD A,(IX+0) ;A=current note from output table AND 63 ;mask out voice bits, leaving song # PUSH AF ;save song # LD (IX+0),255 ;initialize current note to null LD L,(IX+1) LD H,(IX+2) ;HL=address of next note in note table LD A,(HL) ;A=next note LD B,A ;save it in B BIT 5,A ;is bit 5 set? (REST) JR Z,A58660 ;NO, it's a NOTE, REPEAT or END PUSH BC ;YES, so save rest on stack AND 31 ;mask out lower 5 bits (get rest length) INC HL ;point to next note in note table LD (IX+1),L ;(rest note is 1 byte long) LD (IX+2),H ;save addr of next note in output table LD (IX+4),240 ;put volume in output table LD (IX+5),A ;put length in output table LD (IX+7),0 LD (IX+8),0 ;zero out volume and frequency sweeps JP A58860 ;EXIT ;*************************************************************************** ;REPEAT SONG. A58660: BIT 4,A ;is bit 4 set? (END or REPEAT) JR Z,A58678 ;NO, it's a NOTE BIT 3,A ;YES, so it bit 3 set? (REPEAT) JR Z,A58672 ;NO, so END the voice POP BC ;YES, so restore the voice number ;to REPEAT JP __PLAY_IT ;*Fn98: START VOICE ;*************************************************************************** ;END VOICE. A58672: LD A,255 ;A=null value for output table PUSH AF ;save it JP A58860 ;EXIT ;*************************************************************************** ;SPECIAL EFFECTS NOTE. ; If the note is special effects, the programmer must supply the address of ; a RAM routine to set up the effect. With no examples to study, I can ; only guess at how this works. It seems, however, that this setup routine ; has 2 parts: the first (at the address stored in the special effects ; note) does the setup for playing the current note. This setup must exit ; with a RET instruction, which returns to 58712, with another execution ; address base in IY. (I don't know if the return IY is the same as the ; entry IY.) The exit return address (58860) is saved on the stack, and ; then a branch is made to IY+7. Presumably this second routine does some ; setup for the next special effects note. A58678: AND 60 ;mask out bits 7-6, 1-0 CP 4 ;is it 4? (bit 2 set=SPECIAL EFFECTS) JR NZ,A58723 ;NO, it's something else POP IY ;YES, IY=song #/old flags (pushed as AF) PUSH IY ;save it PUSH BC ;B has 1st byte of note from note table INC HL ;point HL to 2nd byte LD E,(HL) ;E=lobyte of special effects execute addr LD (IX+1),E ;save it in output table INC HL ;point to 3rd byte of note table LD D,(HL) ;D=hibyte of special effects execute addr LD (IX+2),D ;save it in output table INC HL ;point to start of next note in note table PUSH IY ;save song #/old flags POP AF ;restore A=song #, old flags PUSH DE ;save special effects execution address POP IY ;get it back in IY LD DE,A58712 ;return address PUSH DE ;save it JP (IY) ;set up the special effects note ;*************************************************************************** A58712: LD DE,7 ;DE=7 ADD IY,DE ;offset from IY (but what is IY?) LD DE,A58860 ;return address PUSH DE ;save it JP (IY) ;do something else... ;*************************************************************************** ;SIMPLE NOTE. A58723: PUSH BC ;save current note LD A,B ;get it in A AND 3 ;mask out bits 7-2 OR A ;is it zero? (SIMPLE NOTE) JR NZ,A58762 ;NO, more complex INC HL ;YES, so point ahead 4 to start of next INC HL ;note in note table INC HL ;(simple note is 4 bytes long) INC HL LD (IX+1),L LD (IX+2),H ;save addr of next note in output table DEC HL ;back up 1 LD DE,5 ;DE=5 (offset into output table) CALL A58883 ;DE=IX+DE subroutine LD BC,3 ;number of bytes to copy LDDR ;copy note table data to output table LD (IX+7),0 LD (IX+8),0 ;zero out unused parts of output table JR A58860 ;EXIT ;*************************************************************************** ;FREQUENCY-SWEPT NOTE. A58762: CP 1 ;is it 1? (frequency-swept note) JR NZ,A58792 ;NO, it's something else LD DE,6 ;length of frequency-swept note=6 bytes ADD HL,DE ;get address of next note from note table LD (IX+1),L LD (IX+2),H ;save address in output table DEC HL ;back up 1 in note table INC E ;offset=6 into output table CALL A58883 ;DE=IX+DE subroutine LD BC,5 ;number of bytes to copy LDDR ;copy note table data to output table LD (IX+8),0 ;zero out unused parts of output table JR A58860 ;EXIT ;*************************************************************************** ;VOLUME-SWEPT/NOISE NOTE. ; Volume-swept notes are voices 1,2,3; noise notes are voice 0. A58792: CP 2 ;is it 2? (VOLUME-SWEPT/NOISE) JR NZ,A58834 ;NO, it's something else LD DE,6 ;length of note=6 bytes (5 for NOISE) ADD HL,DE ;point to start of next note in note table POP AF ;restore A=byte 1 of current note saved ;way back when (58632) as BC PUSH AF ;save it again AND 192 ;mask out bits 5-0; is it noise? (voice 0) JR NZ,A58807 ;NO, it's VOLUME-SWEPT DEC HL ;YES, it's NOISE, so back up 1 A58807: LD (IX+1),L LD (IX+2),H ;save address of next note in note table DEC HL ;back up 1 LD E,9 ;offset into output table=9 CALL A58883 ;DE=IX+DE subroutine LD BC,2 ;number of bytes to copy LDDR ;copy vol step bytes to IX+8, IX+9 XOR A ;A=0 LD (DE),A ;zero out IX+7 (freq step size byte) DEC DE ;back up 2 DEC DE ;(freq length, freq step length unchanged) LD C,3 ;number of bytes to copy LDDR ;copy note length, volume, frequency JR A58860 ;EXIT ;*************************************************************************** ;VOLUME- AND FREQUENCY-SWEPT NOTE. A58834: LD DE,8 ;length of vol+freq swept note=8 bytes ADD HL,DE ;point to start of next note in note table LD (IX+1),L LD (IX+2),H ;save address of next note in output table DEC HL ;back up 1 PUSH IX ;save base of output table... POP IY ;and get it back in IY INC E ;DE=9 ADD IY,DE ;offset into output table PUSH IY ;save it... POP DE ;and get it back in DE LD BC,7 ;number of bytes to move LDDR ;copy note table data to output table ;*************************************************************************** ;SOUND SETUP EXIT. A58860: PUSH IX ;save address of output table... POP HL ;and get it back in HL POP AF ;restore 1st byte of note from note table POP BC ;restore 1st byte of current note (output) CP 255 ;is it null? RET Z ;YES, so exit LD D,A ;NO, so D=1st byte of note from note table AND 63 ;mask out voice bits, leaving note type CP 4 ;is it 4? (special effects) JR NZ,A58877 ;NO LD B,62 ;YES, so B=62 A58877: LD A,D ;A=1st byte of note from note table AND 192 ;get the voice bits (mask out 5-0) OR B ;set the voice bits LD (HL),A ;save voice/song at byte 0 in output table RET ;*************************************************************************** ;DE=IX+DE subroutine. ; On exit, DEout=IYin+DEin. A58883: PUSH IX POP IY ;IY=IX ADD IY,DE ;IY=IY+DE PUSH IY POP DE ;DE=IY RET ;*************************************************************************** ;SEND DATA (in A) OUT SOUND PORT subroutine. ; On entry and exit, A=data to send. A58893: PUSH BC LD B,A ;B=data to send LD A,(SOUNDPORT) ;get sound port... LD C,A ;in C OUT (C),B ;send the data LD A,B ;restore A with data POP BC RET ;*************************************************************************** ;EOS Function 69: FIND FILE (NO TYPE). ; On entry, A=device number, DE=address of filename string (10 characters ; max for name, then filetype byte , then hex 03), HL=address ; of 23-byte buffer to contain the directory entry (no date bytes). The ; routine reads the directory and looks for the first match to the file ; name string. The 10-character filenames must match, but the filetype ; bytes need not. On exit, if a match was found, the buffer at HL contains ; the directory entry, BCDE=start block of file, and ZF=1. Otherwise, ; ZF=0 and A=error code. __FILE_QUERY: SCF ;set carry flag JR A58909 ;jump into next routine ;*************************************************************************** ;EOS Function 52: FIND FILE (WITH TYPE). ; On entry, A=device number, DE=address of filename string (10 characters ; max for name, then filetype byte , then hex 03), HL=address ; of 23-byte buffer to contain the directory entry (no date bytes). The ; routine reads the directory and looks for the first match to the file ; name string. Unlike Fn69, both the 10-character filenames and the file ; type bytes must match. On exit, if a match was found, the buffer at HL ; contains the directory entry, BCDE=start block of file, and ZF=1. ; Otherwise, ZF=0 and A=error code. __QUERY_FILE: SCF CCF ;effectively, clear carry flag A58909: PUSH HL PUSH IX PUSH AF ;save device # JR C,A58916 ;if Fn69 (find file, no type) A is nonzero XOR A ;if Fn52 (find file, with type) A=0 A58916: LD (FILENAME_CMPS),A ;save A as filename comparison ;zero=type must match, anything else=name only POP AF ;restore A=device # LD (USER_BUF),HL ;save address of directory entry buffer LD IX,(FCB_HEAD_ADDR) ;IX=address of FCB0 LD H,D LD L,E ;HL=address of filename string CALL __SCAN_FOR_FILE ;*Fn68: READ DIRECTORY FOR FILE JR NZ,A58957 ;file not found, so error exit ZF=0 PUSH DE ;file found! FCB0 bytes 33-34 have offset PUSH BC ;address of matching entry in DTA0 LD DE,(USER_BUF) ;DE=directory entry buffer address LD L,(IX+33) LD H,(IX+34) ;HL=address of directory entry in DTA0 LD BC,23 ;23 bytes to move LDIR ;copy directory entry into user buffer POP BC POP DE ;BCDE=start block of file XOR A ;A=0, ZF=1 LD (FILENAME_CMPS),A ;file name comparison=0 (type must match) A58957: POP IX POP HL RET ;*************************************************************************** ;EOS Function 53: UPDATE DIRECTORY ENTRY. ; On entry, HL=address of 23-byte buffer containing a directory entry (no ; date bytes), DE=address of filename string, and FCB0 is set up to read ; the directory block(s). On exit, if the file already exists, the entry ; is updated, A=0 and ZF=1. Otherwise, ZF=0 and A=error code. __SET_FILE: PUSH BC PUSH DE PUSH HL PUSH IX LD (USER_BUF),HL ;save address of buffer with new entry LD IX,(FCB_HEAD_ADDR) ;IX=address of FCB0 LD H,D LD L,E ;HL=address of filename string CALL __SCAN_FOR_FILE ;*Fn68: READ DIRECTORY FOR FILE JR NZ,A59018 ;file not found, so error exit ZF=0 LD HL,(USER_BUF) ;found! so restore HL=entry buffer address LD E,(IX+33) ;Fn68 returns DTA offset addr of match LD D,(IX+34) ;in FCB0 bytes 33-34, so get this in DE LD BC,23 ;length of entry LDIR ;copy updated entry to DTA0 LD A,(IX+23) ;A=device # LD HL,(FCB_DATA_ADDR) ;HL=address of DTA0 LD E,(IX+25) LD D,(IX+26) LD C,(IX+27) LD B,(IX+28) ;BCDE=block number to write CALL __WRITE_BLOCK ;*Fn66: WRITE BLOCK JR NZ,A59018 ;write failed, so error exit ZF=0 XOR A ;write OK, so exit A=0, ZF=1 A59018: POP IX POP HL POP DE POP BC RET ;*************************************************************************** ;EOS Function 51: CREATE FILE. ; On entry, A=device number, BCDE=length of file in bytes (BC=hiword, DE= ; loword), HL=address of filename string. If BCDE=0, the file will not ; attempt to reuse deleted file space, thus allowing for maximum file size. ; On exit, if create was successful, an entry for the file is added to the ; directory, "BLOCKS LEFT" is updated, ZF=1 and A=0. Otherwise, ZF=0 and ; A=error code. __MAKE_FILE: PUSH IY PUSH IX PUSH HL PUSH DE PUSH BC LD IX,(FCB_HEAD_ADDR) ;IX=address of FCB0 LD (IX+24),0 ;zero out I/O mode byte LD (IX+23),A ;save device # in FCB0 LD (USER_NAME),HL ;save address of filename string LD A,B OR C ;is BC=zero? JR NZ,A59059 ;NO, so check if file too big LD A,E ;YES, so check DE OR D ;is DE=zero? JR NZ,A59059 ;NO, so check if file too big SET 5,(IX+24) ;YES, BCDE=zero, set bit 5 I/O mode byte ;(don't resuse deleted files) JR A59091 ;skip size check ;*************************************************************************** ;FILE SIZE CHECK. ; Maximum file size is 254 blocks (leaves 1 for boot and 1 for directory). A59059: LD E,D LD D,C LD C,B LD B,0 ;effectively, BCDE/256 SRL C RR D RR E ;BCDE/512 SRL C RR D RR E ;BCDE/1024 (converts bytes to blocks) LD A,C OR A ;is C=0? (blocks less than 255) JP NZ,A59794 ;NO, so exit error 11 (FILE TOO BIG) INC DE ;add 1 to DE (if DE was 255, now it's 0) LD A,E OR D ;is DE=0? (did we want a 255-block file) JP Z,A59794 ;YES, so exit error 11 (FILE TOO BIG) LD (BLOCKS_REQ),DE ;save loword of file length in blocks ;*************************************************************************** A59091: LD DE,0 LD (BLOCKS_REQ+2),DE ;zero out hiword of file length in blocks LD (DIR_BLOCK_NO),DE ;directory block number=0 XOR A LD (FOUND_AVAIL_ENT),A ;zero out found entry byte LD (IX+25),1 LD (IX+26),A LD (IX+27),A LD (IX+28),A ;block to read=1 (directory) LD (IX+13),1 LD (IX+14),A LD (IX+15),A LD (IX+16),A ;start block=1 LD DE,(FCB_DATA_ADDR) ;DE=address of DTA0 LD (IX+33),E LD (IX+34),D ;save address of DTA0 in FCB0 LD (BUF_START),DE ;DTA0 is also buffer start LD HL,1024 ;length of buffer=1024 ADD HL,DE ;point to end of buffer LD (BUF_END),HL ;save buffer end address LD A,(IX+23) ;A=device # LD L,(IX+33) LD H,(IX+34) ;HL=transfer address LD E,(IX+25) LD D,(IX+26) LD C,(IX+27) LD B,(IX+28) ;BCDE=block to read CALL __READ_BLOCK ;*Fn65: READ BLOCK JP NZ,A59785 ;read failed, so error exit ZF=0 LD IY,(FCB_DATA_ADDR) ;read OK, so IY=address of DTA0 LD A,(IY+12) ;A=directory size byte from volume entry AND 127 ;mask out bit 7 LD (IX+29),A ;save max length of directory in FCB0 LD (IX+30),0 LD (IX+31),0 LD (IX+32),0 CALL A61493 ;VERIFY DIRECTORY CHECK CODE subroutine JP NZ,A59785 ;check failed, so error exit ZF=0 LD B,38 ;check OK, so 38 more entries to check A59212: LD L,(IX+33) LD H,(IX+34) ;HL=address of DTA0 (1st dir entry) LD DE,26 ;length of dir entry ADD HL,DE ;point to next entry LD (IX+33),L LD (IX+34),H ;save this address in FCB0 A59228: LD L,(IX+33) LD H,(IX+34) ;HL=entry address from FCB0 PUSH HL ;save it... POP IY ;and get it back in IY LD A,(IY+12) ;A=attribute byte of file LD C,A ;save in in C BIT 0,A ;is bit 0 set? (NOT A FILE) JP NZ,A59399 ;YES, so we're at BLOCKS LEFT (last entry) ;see if we found a free entry BIT 5,(IX+24) ;NO, but is bit 5 of I/O mode byte set? ;(don't reuse deleted files) JR NZ,A59307 ;YES, so keep looking BIT 2,C ;NO, but is bit 2 of file attribute set? ;(file deleted) JR Z,A59292 ;NO, file exists, so check if it has the ;same name as the one we want to create ;*************************************************************************** ;DELETED FILE SIZE CHECK. LD L,(IY+17) ;YES, file is deleted, see how big it is LD H,(IY+18) ;HL=file length from entry (blocks free) LD DE,(BLOCKS_REQ) ;DE=file length in blocks (blocks needed) OR A ;clear CF SBC HL,DE ;is free less than needed? JR C,A59307 ;YES, not enough blocks, so keep looking LD HL,FOUND_AVAIL_ENT ;NO, enough room; HL=found entry byte addr BIT 0,(HL) ;is bit 0 set? (FOUND A FREE ENTRY) JR NZ,A59307 ;YES, so keep looking SET 0,(HL) ;NO, so set the found entry byte LD E,(IX+25) LD D,(IX+26) ;DE=loword of last block read LD (DIR_BLOCK_NO),DE ;save this directory block number JR A59307 ;keep looking ;*************************************************************************** ;FILENAME CHECK. A59292: LD E,(IX+33) LD D,(IX+34) ;DE=offset into DTA0 of dir entry (name) LD HL,(USER_NAME) ;HL=address of filename string to compare CALL A61524 ;FILENAME COMPARISON WITHOUT TYPE subrt JP Z,A59798 ;file already exists, so error 6 exit A59307: DJNZ A59212 ;keep looking 'til all checked or end ;*************************************************************************** ;MULTIPLE DIRECTORY BLOCK HANDLER. LD HL,(BUF_START) ;all the way through without finding ;BLOCKS LEFT, so there must be more ;directory blocks. HL=buffer start addr LD (IX+33),L LD (IX+34),H ;save buffer start address in FCB0 INC (IX+25) ;point to next directory block LD A,(IX+32) ;get hiword/hibyte of dir size CP (IX+28) ;is it less than last block read? JP C,A59389 ;YES, so no more directory LD A,(IX+31) ;NO, so get hiword/lobyte of dir size CP (IX+27) ;is it less than last block read? JP C,A59389 ;YES, so no more directory LD A,(IX+30) ;NO, so get loword/hibyte of dir size CP (IX+26) ;is it less than last block read? JP C,A59389 ;YES, so no more directory LD A,(IX+29) ;NO, so get loword/lobyte of dir size CP (IX+25) ;is it less than last block read? JP C,A59389 ;YES, so no more directory LD A,(IX+23) ;NO, still dir blocks left, so A=device # LD L,(IX+33) LD H,(IX+34) ;HL=address of DTA0 from FCB0 LD E,(IX+25) LD D,(IX+26) LD C,(IX+27) LD B,(IX+28) ;BCDE=block to read CALL __READ_BLOCK ;*Fn65: READ BLOCK JP NZ,A59785 ;read failed, so error exit ZF=0 LD B,39 ;read OK... JP A59228 ;so read 39 more files ;*************************************************************************** ;NO MORE DIRECTORY BLOCKS TO READ...DID WE FIND ANYTHING? A59389: LD HL,FOUND_AVAIL_ENT ;HL=address of found entry byte BIT 0,(HL) ;is bit 0 set? (FOUND A FREE ENTRY) JP Z,A59802 ;NO, we read the whole thing without luck ;exit error 12 JR A59406 ;YES, we found something ;*************************************************************************** ;"BLOCKS LEFT" REACHED...DID WE FIND ANYTHING? A59399: LD HL,FOUND_AVAIL_ENT ;HL=address of found entry byte BIT 0,(HL) ;is bit 0 set? (FOUND A FREE ENTRY) JR Z,A59506 ;NO, but see if there's room at the end ;to make a new one A59406: RES 0,(HL) ;YES, so clear the found entry byte LD L,(IX+25) LD H,(IX+26) ;HL=next block number LD DE,(DIR_BLOCK_NO) ;DE=last directory block number read OR A ;clear CF SBC HL,DE ;HL=HL-DE; is next the same as last? LD HL,(BUF_START) ;HL=address of buffer start LD (IX+33),L LD (IX+34),H ;set buffer start address in FCB0 JR Z,A59468 ;next block same as last, so skip reading LD (IX+25),E ;next block not same as last, so read next LD (IX+26),D ;save new current block in FCB0 LD BC,0 ;zero out BC LD A,(IX+23) ;A=device # CALL __READ_BLOCK ;*Fn65: READ BLOCK JP NZ,A59785 ;read failed; error exit ZF=0 JR A59468 ;read OK, so get new entry slot ;*************************************************************************** ;FIND THE FREE ENTRY (AGAIN) AND UPDATE IT. A59452: LD L,(IX+33) LD H,(IX+34) ;HL=old DTA0 offset address LD DE,26 ;length of directory entry ADD HL,DE ;point to next entry LD (IX+33),L LD (IX+34),H ;save address in FCB0 A59468: PUSH HL ;save DTA0 offset address... POP IY ;and get it back in IY BIT 2,(IY+12) ;is bit 2 of attribute byte set? (DELETED) JR Z,A59452 ;NO, so keep looking LD L,(IY+17) ;YES, so see how big it is LD H,(IY+18) ;HL=length of deleted file in blocks LD DE,(BLOCKS_REQ) ;DE=requested file length in blocks PUSH HL OR A ;clear CF SBC HL,DE ;is free length less than requested? POP HL JR C,A59452 ;YES, not enough room, so keep looking LD (BLOCKS_REQ),HL ;NO, so enough room; save requested length CALL A59839 ;SET UP NEW DIRECTORY ENTRY subroutine JP NZ,A59785 ;bad filename error 14, so exit JP A59761 ;setup OK, so write the new block ;*************************************************************************** ;MOVE "BLOCKS LEFT" TO MAKE ROOM FOR NEW ENTRY. A59506: LD A,(IX+28) ;get hiword/hibyte of last block read CP (IX+32) ;is it less than max dir block? JR C,A59544 ;YES, so there's room to add an entry LD A,(IX+27) ;NO, get hiword/lobyte of last block read CP (IX+31) ;is it less than max dir block? JR C,A59544 ;YES, so there's room LD A,(IX+26) ;NO, get loword/hibyte of last block read CP (IX+30) ;is it less than max dir block? JR C,A59544 ;YES, so there's room LD A,(IX+25) ;NO, get loword/lobyte of last block read CP (IX+29) ;is it less than max dir block? JR C,A59544 ;YES, so there's room LD A,B ;NO, we're at the last directory block CP 1 ;but is BLOCKS LEFT in slot #39? (last) ;(B was counter from 39 to 0) JP Z,A59806 ;YES, so exit error 13 (NO MORE ROOM) A59544: LD L,(IY+17) LD H,(IY+18) ;NO, so HL=length of free space in blocks BIT 5,(IX+24) ;is bit 5 of I/O mode byte set? ;(don't reuse deleted files) JR Z,A59568 ;NO, so skip ahead LD A,H ;YES, so there's got to be free space at OR L ;the end; is there any? JP Z,A59806 ;NO, so exit error 13 (NO MORE ROOM) LD (BLOCKS_REQ),HL ;YES, so save file length in blocks=HL RES 5,(IX+24) ;clear bit 5 of I/O mode byte ;(no need for this toggle anymore) A59568: LD DE,(BLOCKS_REQ) ;DE=requested file length in blocks OR A ;clear CF SBC HL,DE ;HL=HL-DE; is free space less than needed? JP C,A59806 ;YES, so exit error 13 (NO MORE ROOM) LD (NEW_HOLE_SIZE),HL ;NO, there's room, so save difference ;between free and needed as new hole size LD HL,BLOCKS_REQ ;point HL to requested file length LD A,(IY+13) ;A=loword/lobyte of file start block ADD A,(HL) ;add requested file length to get new hole ;start block INC HL ;point to next file start block byte LD (NEW_HOLE_START),A ;save new hole start block loword/lobyte LD A,(IY+14) ;get file start block loword/hibyte ADC A,(HL) ;continue addition INC HL ;point to next file start block byte LD (65046+1),A ;save new hole start block loword/hibyte LD A,(IY+15) ;get file start block hiword/lobyte ADC A,(HL) ;continue addition INC HL ;point to next file start block byte LD (65046+2),A ;save new hole start block hiword/lobyte LD A,(IY+16) ;get file start block hiword/hibyte ADC A,(HL) ;continue addition INC HL ;HL=65040 addr of file name str$ pointer ;(this instruction is unnecessary) LD (65046+3),A ;save new hole start block hiword/hibyte PUSH BC ;save dir entry counter CALL A59839 ;SET UP NEW DIRECTORY ENTRY subroutine POP BC ;restore dir entry counter JP NZ,A59785 ;bad filename error, so exit LD L,(IX+33) LD H,(IX+34) ;filename OK, so HL=address of DTA0 LD DE,26 ;length of dir entry ADD HL,DE ;point to next entry LD (IX+33),L LD (IX+34),H ;store new entry address DJNZ A59710 ;decrement counter and... ;if "BLOCKS LEFT" was not the last entry ;in the block, then B>0 so put new "BLOCKS ;LEFT" in next dir slot. If is was the ;last entry, B=0 and we must write the ;current block, then read in the next ;block to put "BLOCKS LEFT" on it ;*************************************************************************** ;NEW ENTRY AND "BLOCKS LEFT" ON DIFFERENT BLOCKS. LD A,(IX+23) ;A=device # LD HL,(BUF_START) ;HL=address of buffer start LD E,(IX+25) LD D,(IX+26) LD C,(IX+27) LD B,(IX+28) ;BCDE=block number to write CALL __WRITE_BLOCK ;*Fn66: WRITE BLOCK JP NZ,A59785 ;write failed, so exit error ZF=0 LD HL,(BUF_START) ;HL=address of buffer start LD (IX+33),L LD (IX+34),H ;store buffer start address in FCB0 INC (IX+25) ;point to next directory block LD A,(IX+23) ;A=device # LD L,(IX+33) LD H,(IX+34) ;HL=transfer address (DTA0) LD E,(IX+25) LD D,(IX+26) LD C,(IX+27) LD B,(IX+28) ;BCDE=block number to read CALL __READ_BLOCK ;*Fn65: READ BLOCK JR NZ,A59785 ;read failed, so error exit ZF=0 LD L,(IX+33) LD H,(IX+34) ;HL=start of DTA0 (first dir entry) ;*************************************************************************** ;UPDATE "BLOCKS LEFT" ENTRY. A59710: PUSH HL ;save address of dir entry... POP IY ;and get it back in IY LD HL,(NEW_HOLE_SIZE) ;HL=new hole size in blocks LD (IY+17),L LD (IY+18),H ;save it in dir entry (blocks used) LD A,(NEW_HOLE_START) ;A=new hole start block loword/lobyte LD (IY+13),A ;save it in dir entry (start block) LD A,(65046+1) ;A=new hole start block loword/hibyte LD (IY+14),A ;save it in dir entry LD A,(65046+2) ;A=new hole start block hiword/lobyte LD (IY+15),A ;save it in dir entry LD A,(65046+3) ;A=new hole start block hiword/hibyte LD (IY+16),A ;save it in dir entry LD (IY+12),1 ;set file attribute to 1 (NOT A FILE) PUSH IY ;save dir entry address... POP DE ;and get it back in DE LD HL,A62504 ;start transfer address=BLOCKS LEFT data ;from EOS RAM table LD BC,12 ;length of name LDIR ;move BLOCKS LEFT entry to DTA0 A59761: LD A,(IX+23) ;A=device # LD HL,(BUF_START) ;HL=buffer start address LD E,(IX+25) LD D,(IX+26) LD C,(IX+27) LD B,(IX+28) ;BCDE=block number to write CALL __WRITE_BLOCK ;*Fn66: WRITE BLOCK JR NZ,A59785 ;write failed, so exit error ZF=1 XOR A ;create file successful, so A=0, ZF=1 A59785: OR A ;update ZF for OK or error POP BC POP DE POP HL POP IX POP IY RET ;*************************************************************************** A59794: LD A,11 ;FILE TOO BIG error JR A59785 ;*************************************************************************** A59798: LD A,6 ;FILE ALREADY EXISTS error JR A59785 ;*************************************************************************** A59802: LD A,12 ;DIRECTORY FULL error JR A59785 ;*************************************************************************** A59806: LD A,13 ;NO MORE ROOM error JR A59785 ;*************************************************************************** ;CHECK FILENAME LENGTH subroutine. ; On entry, HL=address of filename string, terminated with hex 03. On ; exit, if the string is at least 1 and less than 12 characters long, then ; BC=length of string, A=0 and ZF=1. Otherwise, ZF=0 and A=14 (BAD FILE ; NAME error). A59810: PUSH HL LD B,12 ;max length of filename string=12 LD C,1 ;initialize character counter A59815: LD A,(HL) ;get a character CP 3 ;is it hex 03? (logical end) JR Z,A59829 ;YES, but were there other characters? INC C ;NO, so increment counter INC HL ;point to next character DJNZ A59815 ;keep going 'til 12 are examined; ;if there are too many, we fall through... A59824: LD A,14 ;A=14 (BAD FILE NAME error) OR A ;ZF=0 for error exit POP HL RET ;*************************************************************************** A59829: LD A,C ;A=character count CP 1 ;was it just 1? JR Z,A59824 ;YES, so too few characters error LD B,0 ;NO, string OK, so zero out B (BC=count) XOR A ;A=0, ZF=1 for OK exit POP HL RET ;*************************************************************************** ;SET UP NEW DIRECTORY ENTRY subroutine. ; On entry, IY=offset address of entry in DTA0. On exit, if the filename ; was too long or short, ZF=1 and A=14 (BAD FILENAME error). Otherwise, ; the new entry is written to DTA0 and ZF=1, A=0. A59839: PUSH IY ;save entry offset address... POP DE ;and get it back in DE LD HL,(USER_NAME) ;HL=address of file name string CALL A59810 ;CHECK FILENAME LENGTH subroutine JP NZ,A59903 ;too long or short, so error 14 exit LDIR ;name OK, so move filename string to DTA0 ;length in BC returned by check subroutine LD A,16 ;file attribute=00010000 (user file) LD (IY+12),A ;set it into directory entry LD BC,(BLOCKS_REQ) ;BC=requested length of file LD (IY+17),C LD (IY+18),B ;set file length in dir entry LD (IY+19),1 LD (IY+20),0 ;used length=1 LD (IY+21),0 LD (IY+22),0 ;last byte count=0 LD A,(EOS_YEAR) ;A=current file creation year LD (IY+23),A ;set it into dir entry LD A,(EOS_MONTH) ;A=current file creation month LD (IY+24),A ;set it into dir entry LD A,(EOS_DAY) ;A=current file creation day LD (IY+25),A ;set it into dir entry XOR A ;A=0, ZF=1 for OK exit A59903: RET ;*************************************************************************** ;EOS Function 48: OPEN FILE. ; On entry, A=device number, HL=address of filename string, B=I/O mode. ; I/O mode decodes as follows: 1=read, 2=write, 3=random (read/write), ; 4=execute. The file must have already been created with Fn51 (create ; file). On exit, if the open was successful, ZF=1 and A=file number. ; If the file was not opened for write alone, the DTA contains the first ; block of the file. If the opened file is only 1 block long, bit 7 of ; the FCB I/O mode byte (24) is set. If the open was unsuccessful, ZF=0 ; and A=error code. __OPEN_FILE: PUSH IY PUSH HL PUSH IX PUSH DE PUSH AF PUSH BC LD IX,(FCB_HEAD_ADDR) ;IX=address of FCB0 LD DE,35 ;length of FCB=35 ADD IX,DE ;point IX to FCB1 LD IY,(FCB_DATA_ADDR) ;IY=address of DTA0 LD DE,1024 ;length of DTA=1024 ADD IY,DE ;point to DTA1 LD B,1 ;file number 1 A59932: LD A,(IX+24) ;get I/O mode byte from FCB OR A ;is this FCB already in use? JR Z,A59966 ;NO, so we'll use it LD DE,35 ;YES, so point to next FCB and DTA ADD IX,DE ;IX=address of next FCB LD DE,1024 ADD IY,DE ;IY=address of next DTA INC B ;next file number... LD A,B ;in A CP 3 ;is it 3? JR C,A59932 ;NO, so we've still got FCBs to look at POP BC ;YES, so all FCBs in use, error exit POP AF POP DE POP IX POP HL POP IY LD A,7 ;A=7 (TOO MANY OPEN FILES error) OR A ;clear ZF for error exit RET ;*************************************************************************** A59966: LD (BUF_START),IY ;save DTA as buffer start POP AF ;restore entry I/O mode (from BC) LD (IX+24),A ;save it in FCB POP AF ;restore device number LD (IX+23),A ;save it in FCB PUSH BC ;save file number (in B) PUSH HL ;save filename string address... POP DE ;and get it back in DE PUSH IX ;save FCB address... POP HL ;and get it back in HL LD A,(IX+23) ;A=device # CALL __QUERY_FILE ;*Fn52: FIND FILE (WITH TYPE) JP NZ,A60152 ;file not found, so error exit ZF=0 CALL __MODE_CHECK ;found! so *Fn67: CHECK FILE I/O MODE JP NZ,A60152 ;check failed, so error exit ZF=0 ;*************************************************************************** ;CALCULATE LAST BLOCK OF FILE. ; Adds used length (1 word, bytes 19-20) to start block (2 words, bytes ; 13-16) and saves 2-word result (bytes 29-32). Since this sum is the ; block AFTER the last block, 1 is subtracted from the 2 words at 29-32. LD A,(IX+19) ;check OK, so get lobyte of used length ADD A,(IX+13) ;add it to loword/lobyte of start block LD (IX+29),A ;save it in FCB (last block loword/lobyte) LD A,(IX+14) ;get loword/hibyte of start block ADC A,(IX+20) ;add it to hibyte of used length LD (IX+30),A ;save it in FCB (last block loword/hibyte) LD A,(IX+15) ;get hiword/lobyte of start block ADC A,0 ;propagate any carry LD (IX+31),A ;save it in FCB (last block hiword/lobyte) LD A,(IX+16) ;get hiword/hibyte of start block ADC A,0 ;propagate any carry LD (IX+32),A ;save it in FCB (last block hiword/hibyte) LD A,(IX+29) ;get last file block loword/lobyte SUB 1 ;subtract 1 LD (IX+29),A ;save it back in FCB LD A,(IX+30) ;get last file block loword/hibyte SBC A,0 ;propagate any carry LD (IX+30),A ;save it back in FCB LD A,(IX+31) ;get last file block hiword/lobyte SBC A,0 ;propagate any carry LD (IX+31),A ;save it back in FCB LD A,(IX+32) ;get last file block hiword/hibyte SBC A,0 ;propagate any carry LD (IX+32),A ;save it back in FCB ;*************************************************************************** LD DE,(BUF_START) ;get buffer start address (actually DTAn) LD (IX+33),E LD (IX+34),D ;save it in FCB LD A,(IX+13) ;get loword/lobyte of start block LD (IX+25),A ;save it in FCB LD A,(IX+14) ;get loword/hibyte of start block LD (IX+26),A ;save it in FCB LD A,(IX+15) ;get hiword/lobyte of start block LD (IX+27),A ;save it in FCB LD A,(IX+16) ;get hiword/hibyte of start block LD (IX+28),A ;save it in FCB LD A,(IX+24) ;get I/O mode byte AND 7 ;mask out bits 7-3 CP 2 ;is it 2? (open for write alone) JR Z,A60147 ;YES, so exit without reading 1st block XOR A ;NO, so A=0 CP (IX+20) ;is hibyte of used length=0? ;(used length less than 256 blocks?) JR NZ,A60124 ;YES, so read in 1st block of file INC A ;NO, so A=1 CP (IX+19) ;is lobyte of used length=1? ;(file is [256*n]+1 blocks long, n>0) JR NZ,A60124 ;NO, so read in 1st block of file SET 7,(IX+24) ;YES, so set bit 7 of I/O mode byte ;before reading 1st block of file ;(last physical block of file is in DTA) A60124: LD A,(IX+23) ;A=device # LD HL,(BUF_START) ;HL=buffer start address LD E,(IX+25) LD D,(IX+26) LD C,(IX+27) LD B,(IX+28) ;BCDE=block number to read CALL __READ_BLOCK ;*Fn65: READ BLOCK JR NZ,A60152 ;read failed, so error exit ZF=0 A60147: XOR A ;A=0 for OK exit POP BC ;restore file number (in B) LD A,B ;pass it back from subroutine in A JR A60157 ;exit OK ZF=1 ;*************************************************************************** A60152: LD (IX+24),0 ;zero out I/O mode byte (disallocate FCB) POP BC A60157: POP DE POP IX POP HL POP IY RET ;*************************************************************************** ;EOS Function 49: CLOSE FILE. ; On entry, A=file number. On exit, if the close was successful, ZF=1 and ; A=0. If the file was opened for writing, the contents of the DTA are ; written to the file, and the directory entry updated. If the close was ; unsuccessful, ZF=0 and A=error code. __CLOSE_FILE: PUSH IX PUSH HL PUSH DE PUSH BC OR A ;file number 0? JR Z,A60252 ;YES, so BAD FILE NUMBER error CP 3 ;file number less than 3? JR NC,A60252 ;NO, so BAD FILE NUMBER error LD B,A ;YES, file number OK, so save it in B LD IX,(FCB_HEAD_ADDR) ;IX=address of FCB0 LD HL,(FCB_DATA_ADDR) ;HL=address of DTA0 A60184: LD DE,35 ;length of FCB=35 ADD IX,DE ;IX=address of next FCB LD DE,1024 ;length of DTA ADD HL,DE ;point HL to next file DTA DJNZ A60184 ;keep going 'til we're there LD A,(IX+24) ;we're there! A=I/O mode byte from FCB OR A ;is it zero? (FCB not in use) JR Z,A60252 ;YES, so no file to close! exit error AND 64 ;NO, there's a file to close; bit 6 set? ;(data in DTA waiting to be written) JR Z,A60242 ;NO, so just disallocate FCB and exit LD (FILE_NAME_ADDR),IX ;YES, so we have to write the last block ;to the file. ;set address of filename at start of FCB LD A,(IX+23) ;A=device # LD E,(IX+25) LD D,(IX+26) LD C,(IX+27) LD B,(IX+28) ;BCDE=block number to write CALL __WRITE_BLOCK ;*Fn66: WRITE BLOCK JR NZ,A60261 ;write failed, so error exit ZF=0 LD A,(IX+23) ;write OK, so restore A=device # PUSH IX ;save FCB address... POP HL ;and get it back in HL LD DE,(FILE_NAME_ADDR) ;DE=address of filename CALL __SET_FILE ;*Fn53: UPDATE DIRECTORY ENTRY A60242: LD (IX+24),0 ;disallocate FCB by zeroing out I/O mode POP BC POP DE POP HL POP IX RET ;*************************************************************************** A60252: POP BC POP DE POP HL POP IX LD A,9 ;A=9 (BAD FILE NUMBER error) OR A ;clear ZF for error exit RET ;*************************************************************************** A60261: POP BC POP DE POP HL POP IX OR A ;clear ZF for other error exit (A=code) RET ;*************************************************************************** ;EOS Function 50: RESET FILE. ; On entry, A=file number. On exit, if reset was successful, ZF=1 and A=0. ; The current DTA is written to the file (if opened for write), and then ; the first block of the file is read into the DTA (if not opened for ; write alone). If reset failed, ZF=0 and A=error code. __RESET_FILE: PUSH IX PUSH DE PUSH BC PUSH HL OR A ;file number zero? JP Z,A60423 ;YES, so BAD FILE NUMBER error CP 3 ;file number less than 3? JP NC,A60423 ;NO, so BAD FILE NUMBER error LD B,A ;YES, file number OK, so save it in B LD IX,(FCB_HEAD_ADDR) ;IX=address of FCB0 LD HL,(FCB_DATA_ADDR) ;HL=address of DTA0 A60290: LD DE,35 ;length of FCB=35 ADD IX,DE ;point IX to next FCB LD DE,1024 ;length of DTA=1024 ADD HL,DE ;point HL to next file DTA DJNZ A60290 ;keep going 'til we're there LD A,(IX+24) ;we're there! A=I/O mode byte from FCB OR A ;is it zero? (FCB not in use) JR Z,A60423 ;YES, so no file to reset! error exit AND 64 ;NO, there's a file to reset; bit 6 set? ;(data in DTA waiting to be written) JR Z,A60335 ;NO, so skip ahead LD A,(IX+23) ;YES, so write the data; A=device # LD E,(IX+25) LD D,(IX+26) LD C,(IX+27) LD B,(IX+28) ;BCDE=block number to write CALL __WRITE_BLOCK ;*Fn66: WRITE BLOCK JR NZ,A60432 ;write failed, so error exit ZF=0 RES 6,(IX+24) ;write OK, so clear bit 6 ;(no data waiting to write) A60335: RES 7,(IX+24) ;clear bit 7 ;(last block of file not in DTA) LD A,(IX+13) ;get loword/lobyte of start block LD (IX+25),A ;save it in FCB LD A,(IX+14) ;get loword/hibyte of start block LD (IX+26),A ;save it in FCB LD A,(IX+15) ;get hiword/lobyte of start block LD (IX+27),A ;save it in FCB LD A,(IX+16) ;get hiword/hibyte of start block LD (IX+28),A ;save it in FCB LD (IX+33),L LD (IX+34),H ;save DTA (from HL) in FCB LD A,(IX+24) ;get I/O mode byte AND 7 ;mask out upper 5 bits CP 2 ;is it 2? (open for write alone) JR NZ,A60396 ;NO, so read in first block of the file LD (IX+21),0 ;YES,so... LD (IX+22),0 ;set last byte to zero LD (IX+19),1 LD (IX+20),0 ;set used length to 1 block JR A60416 ;skip first block read and exit OK ;*************************************************************************** A60396: LD A,(IX+23) ;A=device # LD E,(IX+25) LD D,(IX+26) LD C,(IX+27) LD B,(IX+28) ;BCDE=block number to read CALL __READ_BLOCK ;*Fn65: READ BLOCK JR NZ,A60432 ;read failed, so error exit ZF=0 A60416: POP HL ;read OK, so exit POP BC POP DE POP IX XOR A ;A=0, ZF=1 for OK exit RET ;*************************************************************************** A60423: POP HL POP BC POP DE POP IX LD A,9 ;A=9 (BAD FILE NUMBER error) OR A ;clear ZF for error exit RET ;*************************************************************************** A60432: POP HL POP BC POP DE POP IX OR A ;clear ZF for error exit (A=code) RET ;*************************************************************************** ;EOS Function 54: READ FILE. ; On entry, A=file number, BC=number of bytes to read from the file, HL= ; address of read buffer to receive the data (not the same as file manager ; DTA). The file must already have been opened by Fn48 (open file). On ; exit, if the read was successful, ZF=1, A=0, BC=same as entry, and FCB ; bytes 33-34 point to the end of the read buffer. Otherwise, ZF=0, A= ; error code. If A=9 (BAD FILE NUMBER) or A=10 (INPUT PAST END), BC=number ; of bytes actually read from the file; for other errors, BC is unknown. __READ_FILE: PUSH BC PUSH DE PUSH HL PUSH IX LD (USER_BUF),HL ;save read buffer address LD (BYTES_REQ),BC ;save bytes requested to read LD (FNUM),A ;save file number LD (BYTES_TO_GO),BC ;set bytes left to read=bytes requested OR A ;file number zero? JP Z,A60799 ;YES, so BAD FILE NUMBER error CP 3 ;file number less than 3? JP NC,A60799 ;NO, so BAD FILE NUMBER error LD B,A ;YES, so B=file number (offset counter) LD IX,(FCB_HEAD_ADDR) ;IX=address of FCB0 LD HL,(FCB_DATA_ADDR) ;HL=address of DTA0 A60475: LD DE,35 ;length of FCB=35 ADD IX,DE ;point IX to next FCB LD DE,1024 ;length of DTA=1024 ADD HL,DE ;point HL to next file DTA DJNZ A60475 ;keep going 'til we're there LD (BUF_START),HL ;we're here! save DTA as buffer start addr ADD HL,DE ;compute buffer end address... LD (BUF_END),HL ;and save it (buffer is 1024 bytes long) PUSH IX ;save FCB address... POP HL ;and get it back in HL CALL __MODE_CHECK ;*Fn67: CHECK FILE I/O MODE JP NZ,A60801 ;check failed, so error exit ZF=0 ;*************************************************************************** ;COPY DATA FROM DTA TO READ BUFFER. ; Data is copied 1024 bytes at a time, except when fewer are requested. ; At the end each 1024-byte transfer, the read buffer start address (65030) ; is adjusted upward for the next copy. A60502: BIT 7,(IX+24) ;check OK; was bit 7 of I/O mode byte set? ;(last physical block of file in DTA) JP NZ,A60715 ;YES, so INPUT PAST END CHECK LD HL,(BUF_END) ;NO, so HL=buffer end address LD E,(IX+33) LD D,(IX+34) ;DE=DTA start from FCB OR A ;clear CF SBC HL,DE ;HL=buffer size (end-start); is it zero? JR Z,A60560 ;YES, so we're done with this block ;read in the next one LD B,H ;NO, so keep working with current block LD C,L ;BC=HL (buffer size) LD DE,(BYTES_TO_GO) ;DE=bytes left to read OR A ;clear CF SBC HL,DE ;compare buffer size with bytes left: ;are there more bytes than buffer? JP NC,A60650 ;NO, so read the last bytes and exit LD HL,(BYTES_TO_GO) ;YES, so restore HL=to bytes left to read OR A ;clear CF SBC HL,BC ;HL=new bytes left (old-buffer size) LD (BYTES_TO_GO),HL ;save new bytes left LD L,(IX+33) LD H,(IX+34) ;HL=DTA from FCB LD DE,(USER_BUF) ;DE=read buffer address LDIR ;move BC bytes from DTA to read buffer ;(remember, BC=buffer size) LD (USER_BUF),DE ;set new read buffer start=old end ;*************************************************************************** ;READ NEXT BLOCK OF FILE. ; This only occurs if more than 1024 bytes are requested from the file. A60560: LD HL,(BUF_START) ;HL=buffer start address LD (IX+33),L LD (IX+34),H ;store buffer start address in FCB INC (IX+25) ;point to next block of file JR NZ,A60587 ;we can stop if not zero INC (IX+26) ;sorry, must propagate carry JR NZ,A60587 ;we can stop if not zero INC (IX+27) ;sorry, must propagate carry JR NZ,A60587 ;we can stop if not zero INC (IX+28) ;sorry, must propagate carry A60587: LD A,(IX+23) ;A=device # LD HL,(BUF_START) ;HL=buffer start address LD E,(IX+25) LD D,(IX+26) LD C,(IX+27) LD B,(IX+28) ;BCDE=block number to read CALL __READ_BLOCK ;*Fn65: READ BLOCK JP NZ,A60801 ;read failed, so error exit ZF=0 LD A,(IX+32) ;read OK, get hiword/hibyte of last block CP (IX+28) ;is it same as current? JR NZ,A60647 ;NO, so more blocks to read LD A,(IX+31) ;YES, so get hiword/lobyte of last block CP (IX+27) ;is it same as current? JR NZ,A60647 ;NO, so more blocks to read LD A,(IX+30) ;YES, so get loword/hibyte of last block CP (IX+26) ;is it same as current? JR NZ,A60647 ;NO, so more blocks to read LD A,(IX+29) ;YES, so get loword/lobyte of last block CP (IX+25) ;is it same as current? JR NZ,A60647 ;NO, so more blocks to read SET 7,(IX+24) ;YES, so the last physical block of the ;file has been read in. ;set bit 7 of I/O mode byte to flag this A60647: JP A60502 ;keep reading 'til all bytes read ;*************************************************************************** ;COPY LAST 1024 BYTES (OR LESS) OF DATA TO READ BUFFER. A60650: LD A,(IX+32) ;get hiword/hibyte of last block CP (IX+28) ;is it same as current? JR NZ,A60682 ;NO, so copy rest of data LD A,(IX+31) ;YES, so get hiword/lobyte of last block CP (IX+27) ;is it same as current? JR NZ,A60682 ;NO, so copy rest of data LD A,(IX+30) ;YES, so get loword/hibyte of last block CP (IX+26) ;is it same as current? JR NZ,A60682 ;NO, so copy rest of data LD A,(IX+29) ;YES, so get loword/lobyte of last block CP (IX+25) ;is it same as current? JR Z,A60711 ;NO, but it's the last block we'll read ;copy and exit A60682: LD BC,(BYTES_TO_GO) ;YES, it's the last block, BC=bytes left LD L,(IX+33) LD H,(IX+34) ;HL=transfer start from FCB LD DE,(USER_BUF) ;DE=read buffer start address LDIR ;move rest of data to read buffer LD (IX+33),L LD (IX+34),H ;set FCB pointer to end of read buffer POP IX POP HL POP DE POP BC XOR A ;A=0, ZF=1 for OK exit RET ;*************************************************************************** ;INPUT PAST END CHECK. ; If more bytes have been requested than the file is long, error 10 (I/O ; PAST END) is returned, with BC=number of bytes actually read. A60711: SET 7,(IX+24) ;set bit 7 of I/O mode byte ;(last physical block of file is in DTA) A60715: LD HL,(BUF_START) ;HL=buffer start address LD E,(IX+21) LD D,(IX+22) ;DE=last byte count from FCB ADD HL,DE ;HL=computed address of buffer end LD E,(IX+33) LD D,(IX+34) ;DE=transfer start address from FCB OR A ;clear CF SBC HL,DE ;HL=number of bytes left to copy LD B,H LD C,L ;save byte count in BC; was it zero? JR Z,A60780 ;YES, so exit error 10 (I/O PAST END) LD DE,(BYTES_TO_GO) ;NO, so get bytes left to read OR A ;clear CF SBC HL,DE ;is the # of bytes to copy from DTA less ;than total # of bytes left to read? JR NC,A60682 ;NO (probably equal), so finish copy and ;exit OK LD HL,(BYTES_TO_GO) ;YES, but this is an error; copy what data ;we have to read buffer and exit ;reset HL=bytes left to read OR A ;clear CF SBC HL,BC ;(old total bytes left)-(bytes left in ;1024-byte buffer)=(new total bytes left) LD (BYTES_TO_GO),HL ;save new bytes left to read LD L,(IX+33) LD H,(IX+34) ;get transfer start from FCB LD DE,(USER_BUF) ;DE=read buffer address LDIR ;copy data to from DTA to read buffer LD HL,(BYTES_REQ) ;HL=bytes requested to read LD BC,(BYTES_TO_GO) ;BC=bytes left to read OR A ;clear CF SBC HL,BC ;HL=number of bytes actually read LD B,H LD C,L ;save it in BC A60780: LD A,10 ;A=10 (I/O PAST END error) A60782: POP IX POP HL POP DE INC SP ;get entry BC off stack... INC SP ;without disturbing exit BC OR A ;clear zero flag for return status RET ;EXIT ;*************************************************************************** ;UNUSED ERROR HANDLER. ; This routine returns error code 21, but it is not called anywhere in ; EOS-5. What the error signifies is unknown, though presumably it has ; something to do with file I/O. A60790: POP IX POP HL POP DE POP BC LD A,21 ;A=21 (unknown error code) OR A ;clear ZF for error exit RET ;EXIT ;*************************************************************************** A60799: LD A,9 ;A=9 (BAD FILE NUMBER error) A60801: LD HL,(BYTES_REQ) ;HL=bytes requested to read LD BC,(BYTES_TO_GO) ;BC=bytes left to read OR A ;clear CF SBC HL,BC ;HL=number of bytes actually read LD B,H LD C,L ;save it in BC JR A60782 ;error exit ;*************************************************************************** ;EOS Function 55: WRITE FILE. ; On entry, A=file number, BC=number of bytes to write to the file, HL= ; address of write buffer to send the data (not the same as file manager ; DTA). The file must already have been opened by Fn48 (open file). On ; exit, if the write was successful, ZF=1 and A=0. Otherwise, ZF=0 and ; A=error code. __WRITE_FILE: PUSH BC PUSH DE PUSH HL PUSH IX LD (USER_BUF),HL ;save write buffer address LD (BYTES_REQ),BC ;save bytes requested to write LD (FNUM),A ;save file number LD (BYTES_TO_GO),BC ;bytes left to write=bytes requested OR A ;file number zero? JP Z,A61116 ;YES, so BAD FILE NUMBER error CP 3 ;file number less than 3? JP NC,A61116 ;NO, so BAD FILE NUMBER error LD B,A ;B=file number LD IX,(FCB_HEAD_ADDR) ;IX=address of FCB0 LD DE,35 ;length of FCB=35 A60851: ADD IX,DE ;point IX to next FCB DJNZ A60851 ;offset until IX=addr of correct FCB LD B,A ;set B back to file number LD DE,1024 ;length of DTA LD HL,(FCB_DATA_ADDR) ;HL=address of DTA0 A60862: ADD HL,DE ;point HL to next file DTA DJNZ A60862 ;offset until correct file DTA is reached LD (BUF_START),HL ;save it as write buffer start address ADD HL,DE ;length=1024 LD (BUF_END),HL ;save write buffer end address PUSH IX ;save FCB address... POP HL ;and get it back in HL CALL __MODE_CHECK ;*Fn67: CHECK FILE I/O MODE JP NZ,A61118 ;check failed, so error exit ZF=0 ;*************************************************************************** ;COPY DATA FROM WRITE BUFFER TO DTA. ; Data is copied 1024 bytes at a time, except when fewer are requested. At ; the end each 1024-byte transfer, the write buffer start address (65030) ; is adjusted upward for the next copy. A60881: LD A,(IX+20) ;check OK, so get hibyte of used length CP (IX+18) ;is it less than allocated length? JR C,A60901 ;YES, so not last block of file LD A,(IX+19) ;NO, so get lobyte of used length CP (IX+17) ;is it less than allocated length? JR C,A60901 ;YES, so not last block of file SET 7,(IX+24) ;NO, so this is the last available block; ;set bit 7 of I/O mode byte to flag this A60901: LD HL,(BUF_END) ;HL=write buffer end address LD E,(IX+33) LD D,(IX+34) ;DE=DTA offset from FCB OR A ;clear CF SBC HL,DE ;HL=room left in DTA LD B,H LD C,L ;save it in BC LD DE,(BYTES_TO_GO) ;DE=bytes left to write OR A ;clear CF SBC HL,DE ;are there more bytes left to write from ;the write buffer than there is room in ;the DTA? JP NC,A61075 ;NO, so write the last block and exit OK LD A,B ;YES, so more than 1 block left to write OR C ;is BC=0? (no more room in DTA) JR Z,A60956 ;YES, so write the block, reset and cont. LD HL,(BYTES_TO_GO) ;NO, still room, so HL=bytes left to write OR A ;clear CF SBC HL,BC ;compute new bytes left to write... LD (BYTES_TO_GO),HL ;and save it LD E,(IX+33) LD D,(IX+34) ;get DTA offset address from FCB LD HL,(USER_BUF) ;HL=address of write buffer LDIR ;move last bytes from write buffer to DTA LD (USER_BUF),HL ;reset HL to write buffer offset SET 6,(IX+24) ;set bit 6 of I/O mode byte ;(data waiting to write) A60956: BIT 7,(IX+24) ;is bit 7 of I/O mode byte set? ;(last physical block of file in DTA) JR Z,A60971 ;NO, so write the block and continue POP IX ;YES, the file is too short, so error exit POP HL POP DE POP BC LD A,10 ;A=10 (I/O PAST END error) OR A ;clear ZF for error exit RET ;*************************************************************************** ;WRITE BLOCK TO FILE AND POINT TO NEXT BLOCK. A60971: INC (IX+19) ;increment used length lobyte; any carry? JR NZ,A60979 ;NO, so continue INC (IX+20) ;YES, so add carry to used length hibyte A60979: LD A,(IX+23) ;A=device number LD HL,(BUF_START) ;HL=buffer start address LD E,(IX+25) LD D,(IX+26) LD C,(IX+27) LD B,(IX+28) ;BCDE=block number to write CALL __WRITE_BLOCK ;*Fn66: WRITE BLOCK JP NZ,A61118 ;write failed, so error exit ZF=0 RES 6,(IX+24) ;write OK, so clear bit 6 of I/O mode byte ;(no data waiting to write) LD HL,(BUF_START) ;HL=buffer start address LD (IX+33),L LD (IX+34),H ;store buffer start address in FCB LD (IX+21),0 LD (IX+22),0 ;zero out last byte counter INC (IX+25) ;increment loword/lobyte of next block JR NZ,A61042 ;no carry, so continue INC (IX+26) ;carry, so add it to loword/hibyte JR NZ,A61042 ;no carry, so continue INC (IX+27) ;carry, so add it to hiword/lobyte JR NZ,A61042 ;no carry, so continue INC (IX+28) ;carry, so add it to hiword/hibyte A61042: LD A,(IX+24) ;A=I/O mode byte from FCB AND 7 ;mask out upper 5 bits CP 3 ;is it 3? (open for read+write) JP NZ,A60881 ;NO, so COPY DATA FROM WRITE BUFFER TO DTA ;*************************************************************************** ;APPEND DATA TO FILE. LD A,(IX+23) ;YES, so read next block of file ;and append data to it; A=dev # LD HL,(BUF_START) ;HL=write buffer start address LD E,(IX+25) LD D,(IX+26) LD C,(IX+27) LD B,(IX+28) ;BCDE=block number to read CALL __READ_BLOCK ;*Fn65: READ BLOCK JR NZ,A61118 ;read failed, so error exit ZF=0 A61075: LD BC,(BYTES_TO_GO) ;BC=bytes left to write LD L,(IX+21) LD H,(IX+22) ;HL=last byte count for current block ADD HL,BC ;HL=bytes left+block last byte count LD (IX+21),L LD (IX+22),H ;save new last byte count LD E,(IX+33) LD D,(IX+34) ;DE=target transfer address from FCB LD HL,(USER_BUF) ;HL=address of user buffer LDIR ;copy bytes left from write buffer to DTA LD (IX+33),E LD (IX+34),D ;set FCB data to end-of-transfer address SET 6,(IX+24) ;set bit 6 of I/O mode byte ;(data waiting to write) XOR A ;A=0, ZF=1 for OK exit JR A61119 ;skip over error handler ;*************************************************************************** A61116: LD A,9 ;A=9 (BAD FILE NUMBER error) A61118: OR A ;clear ZF for error exit A61119: POP IX POP HL POP DE POP BC RET ;*************************************************************************** ;EOS Function 56: SET CURRENT DATE. ; On entry, B=current day, C=current month, D=current year. __SET_DATE: PUSH AF LD A,B LD (EOS_DAY),A ;set current day LD A,C LD (EOS_MONTH),A ;set current month LD A,D LD (EOS_YEAR),A ;set current year POP AF RET ;*************************************************************************** ;EOS Function 57: GET CURRENT DATE. ; On exit, B=current day, C=current month, D=current year. If no date has ; been set (0/0/0), ZF=0 and A=4 (NO DATE SET error). Otherwise, ZF=1 and ; A=0. __GET_DATE: LD A,(EOS_DAY) ;get current day LD B,A ;into B LD A,(EOS_MONTH) ;get current month LD C,A ;into C LD A,(EOS_YEAR) ;get current year LD D,A ;into D OR B OR C ;was there a date set? JR Z,A61158 ;NO (all 3 zero) XOR A ;YES, so A=0, ZF=1 for OK exit RET ;*************************************************************************** A61158: LD A,4 ;A=4 (NO DATE SET error) OR A ;ZF=0 for error exit RET ;*************************************************************************** ;EOS Function 46: INITIALIZE FILE MANAGER. ; On entry, DE=address of DTA0, HL=address of FCB0. On exit, the I/O mode ; byte (24) of FCB0, FCB1 and FCB2 is set to zero. __FMGR_INIT: LD (FCB_DATA_ADDR),DE ;address of DTA0=DE LD (FCB_HEAD_ADDR),HL ;address of FCB0=HL PUSH BC PUSH DE PUSH IX LD B,3 ;loop 3 times LD DE,35 ;length of FCB=35 LD IX,(FCB_HEAD_ADDR) ;IX=address of FCB0 A61182: LD (IX+24),0 ;zero out I/O mode byte ADD IX,DE ;point IX to next FCB DJNZ A61182 ;loop back 3 times POP IX POP DE POP BC RET ;*************************************************************************** ;EOS Function 68: READ DIRECTORY FOR FILE. ; On entry, A=device number, HL=address of filename string. On exit, if ; file was found, ZF=1, A=0, BCDE=start block of file, and FCB0 bytes 33-34 ; contain the address of the matching entry in DTA0. Otherwise, ZF=0 and ; A=error code. __SCAN_FOR_FILE: PUSH HL PUSH IX PUSH IY LD (USER_NAME),HL ;save address of file name string LD IX,(FCB_HEAD_ADDR) ;IX=address of FCB0 LD (IX+23),A ;set device # LD (IX+25),1 ;block to read=1 (directory) LD (IX+26),0 LD (IX+27),0 LD (IX+28),0 LD DE,(FCB_DATA_ADDR) ;DE=address of DTA0 LD (IX+33),E LD (IX+34),D ;save it in FCB0 (current DTA offset addr) LD HL,FILE_COUNT ;HL=address of file count LD (HL),0 ;zero out count LD A,(IX+23) ;A=device # LD HL,(FCB_DATA_ADDR) ;HL=address of DTA0 LD E,(IX+25) LD D,(IX+26) LD C,(IX+27) LD B,(IX+28) ;BCDE=block to read CALL __READ_BLOCK ;*Fn65: READ BLOCK JP NZ,A61478 ;read failed, so error exit ZF=0 PUSH HL ;save DTA offset address... POP IY ;and get it back in IY ;we should be pointing at VOLUME entry LD A,(IY+12) ;A=volume size byte AND 127 ;mask out bit 8 LD (IX+29),A ;save volume size loword/lobyte in FCB0 LD (IX+30),0 ;zero out loword/hibyte LD (IX+31),0 ;zero out hiword/lobyte LD (IX+32),0 ;zero out hiword/hibyte CALL A61493 ;VERIFY DIRECTORY CHECK CODE subroutine JP NZ,A61478 ;bad code, so error exit ZF=0 LD A,(IX+33) ;code OK, so get lobyte of current DTA ;offset address ADD A,26 ;point ahead to next dir entry (DIRECTORY) LD (IX+33),A ;save new lobyte in FCB0 LD A,(IX+34) ;get hibyte ADC A,0 ;propagate any carry from lobyte add LD (IX+34),A ;save new hibyte in FCB0 LD HL,FILE_COUNT ;HL=address of file count INC (HL) ;we've looked at first entry LD B,38 ;38 more to look at JR A61393 ;keep looking ;*************************************************************************** ;READ DIRECTORIES WITH MORE THAN 1 BLOCK. ; On entry, bytes 32-29 of FCB0 contain the maximum directory size. Since ; the directory also begins at block 1, this is also the last directory ; block number. A61318: INC (IX+25) ;point to next directory block to read ;NOTE: any carry is not propagated through ;other 3 bytes, thus 255+1=0 ;thus physical max dirsize=255 blocks LD A,(IX+32) ;get max block hiword/hibyte CP (IX+28) ;is it less than next block? JP C,A61484 ;YES, so error 5 exit LD A,(IX+31) ;NO, so get max block hiword/lobyte CP (IX+27) ;is it less than next block? JP C,A61484 ;YES, so error 5 exit LD A,(IX+30) ;NO, so get max block loword/hibyte CP (IX+26) ;is it less than next block? JP C,A61484 ;YES, so error 5 exit LD A,(IX+29) ;NO, so get max block loword/lobyte CP (IX+25) ;is it less than next block? JP C,A61484 ;YES, so error 5 exit LD A,(IX+23) ;NO, next block OK, get device # from FCB0 LD HL,(FCB_DATA_ADDR) ;HL=address of DTA0 LD E,(IX+25) LD D,(IX+26) LD C,(IX+27) LD B,(IX+28) ;BCDE=next block to read CALL __READ_BLOCK ;*Fn65: READ BLOCK JP NZ,A61478 ;read failed, so error exit ZF=0 LD DE,(FCB_DATA_ADDR) ;DE=address of DTA0 LD (IX+33),E LD (IX+34),D ;save it in FCB0 LD B,39 ;39 files to read ;*************************************************************************** A61393: LD HL,FILE_COUNT ;HL=address of file count INC (HL) ;count to next file LD E,(IX+33) LD D,(IX+34) ;DE=DTA offset addr (current entry start) LD L,12 LD H,0 ;HL=12 ADD HL,DE ;offset to attribute byte BIT 0,(HL) ;is bit 0 set? (NOT A FILE) JR NZ,A61484 ;YES, so BLOCKS LEFT and end of directory ;error exit ZF=0 BIT 2,(HL) ;is bit 2 set? (DELETED FILE) JR NZ,A61435 ;YES, file is deleted, so skip over it LD HL,(USER_NAME) ;NO, it's a real file, so get address of ;file name string LD A,(FILENAME_CMPS) ;A=file name comparison byte OR A ;is it zero? JR Z,A61430 ;YES, so COMPARE FILE NAMES WITH TYPE sub CALL A61524 ;NO, so COMPARE FILE NAMES WITHOUT TYPE JR A61433 ;skip COMPARE WITH TYPE subrt and continue ;*************************************************************************** A61430: CALL A61523 ;COMPARE FILE NAMES WITH TYPE subroutine A61433: JR Z,A61456 ;names match! so get start block and exit A61435: LD A,(IX+33) ;no match, look again; A=DTA offset lobyte ADD A,26 ;point to next directory entry LD (IX+33),A ;save new lobyte in FCB0 LD A,(IX+34) ;get hibyte ADC A,0 ;propagate any carry from lobyte add LD (IX+34),A ;save new hibyte DJNZ A61393 ;keep looking 'til all 38 are looked at JP A61318 ;we reached the end of the directory ;block without finding BLOCKS LEFT, so ;directory must have multiple blocks. ;get next directory block and keep looking ;*************************************************************************** A61456: PUSH DE ;match! save addr of file entry in DTA... POP IY ;and get it back in IY LD E,(IY+13) LD D,(IY+14) LD C,(IY+15) LD B,(IY+16) ;BCDE=starting block from directory entry POP IY POP IX POP HL XOR A ;A=0, ZF=1 RET ;exit OK ;*************************************************************************** A61478: POP IY POP IX POP HL RET ;error exit with ZF=0, A=error code ;*************************************************************************** A61484: POP IY POP IX POP HL LD A,5 ;A=5 (NO MORE DIRECTORY error) ;this could also be called FILE NOT FOUND OR A ;clear ZF RET ;*************************************************************************** ;VERIFY DIRECTORY CHECK CODE subroutine. ; On entry, IY=base of DTA0, which contains the first directory block. On ; exit, if check code is 55AA00FF, ZF=1 and A=0. Otherwise, ZF=1 and A=24 ; (NON-EOS VOLUME error). A61493: PUSH IY PUSH BC PUSH HL LD HL,A62439 ;HL=addr of 4-byte code in volume entry ;in disk initialization data table LD B,4 ;B=number of bytes to compare A61502: LD A,(HL) ;get a byte from the data table CP (IY+13) ;does it match what's in DTA0? JR NZ,A61519 ;NO, so error 24 exit INC HL ;YES, so point to next byte in data table INC IY ;point to next byte in DTA0 DJNZ A61502 ;keep comparing 'til all 4 bytes checked XOR A ;they match! OK exit A=0, ZF=1 A61514: POP HL POP BC POP IY RET ;*************************************************************************** A61519: LD A,24 ;no match! A=24 (NON-EOS VOLUME), ZF=0 JR A61514 ;error exit ;*************************************************************************** ;FILENAME COMPARISON subroutines. ; On entry, HL=filename address, DE=address of directory entry in DTA0. On ; exit, if the names match, ZF=1 and A=0. Otherwise, ZF=0 and A=8 (MATCH ; NOT FOUND error). Unfortunately, this routine has 2 entry points with ; overlapping reading frames. ; (1) Return error if any mismatched characters, including filetype. Fn52 ; (find file, with type) results in a call to this routine. Enters at ; 61523: ;61523 E637 AND 55 ;clears CF; continue at 61525 ; (2) Allows the filetype byte to mismatch; otherwise returns error. Fn69 ; (find file, no type) results in a call to this routine. Enters at ; 61524: ;61523 E6 ;unused ;61524 37 SCF ;sets CF; continues at 61525 A61523: DB 230 A61524: SCF PUSH HL PUSH DE PUSH BC PUSH AF ;save status of CF LD B,12 ;B=number of bytes to compare A61531: LD A,(HL) ;get character from string CP 3 ;is it the end? (hex 03=logical end) JR Z,A61559 ;YES, so see if the dir entry also ends LD A,(DE) ;NO, so get character from dir entry CP (HL) ;does it match the string? JR NZ,A61547 ;NO, but that may not be fatal... INC HL ;YES, so point to next character in string INC DE ;point to next character in dir entry DJNZ A61531 ;keep going 'til all are compared POP BC ;all 12 match, so exit OK JR A61565 ;*************************************************************************** A61547: POP AF ;restore status of CF JR NC,A61570 ;CF clear (strict match), so exit error 8 INC HL ;CF set (type can mismatch), so point to ;next character in string INC DE ;point to next character in dir entry LD A,(HL) ;get character from string CP 3 ;is it the end? JR NZ,A61570 ;NO, so exit error 8 JR A61560 ;YES, skip to see if dir entry also ends ;*************************************************************************** A61559: POP BC A61560: LD A,(DE) ;get character from directory entry CP 3 ;is it the end? JR NZ,A61570 ;NO, so exit error 8 A61565: POP BC ;YES, so exit OK POP DE POP HL XOR A ;A=0, ZF=1 RET ;exit OK ;*************************************************************************** A61570: POP BC POP DE POP HL LD A,8 ;A=8 (MATCH NOT FOUND error) OR A ;clear ZF RET ;exit error ;*************************************************************************** ;EOS Function 64: CHECK IF FILE IS OPEN. ; On entry, HL=address of file name string. On exit, if the file is open, ; ZF=1, A=0 and B=lower 3 bits of the I/O mode byte from the FCB (read, ; write, execute). Otherwise, ZF=0 and A=5 (FILE NOT OPEN error). __CHECK_FCB: PUSH IX PUSH DE PUSH HL ;save filename string address LD HL,(FCB_HEAD_ADDR) ;HL=address of FCB0 XOR A ;A=0 A61585: INC A ;increment file number counter LD (FILE_NUMBR),A ;save new file number LD DE,35 ;length of FCB=35 ADD HL,DE ;point to next FCB PUSH HL ;save address... POP IX ;and get it back in IX LD A,(IX+24) ;A=I/O mode byte AND 7 ;mask out upper 5 bits CP 0 ;is it zero? JR Z,A61623 ;YES, it's empty, so skip to next FCB EX DE,HL ;NO, so DE=address of FCB POP HL ;restore HL=filename string address PUSH HL ;save filename string address PUSH DE ;save FCB address LD BC,12 ;length of filename A61612: LD A,(DE) ;get character from FCB CP 3 ;is is hex 03? (end) JR Z,A61636 ;YES, but does string also end? CPI ;NO, so does it match the string at HL? INC DE ;point to next character in FCB JR Z,A61612 ;YES, so keep comparing POP HL ;NO, mismatch, so look at next FCB ;HL=FCB address (saved as DE) A61623: LD A,(FILE_NUMBR) ;A=file number CP 2 ;is it 2? JR NZ,A61585 ;NO, so look at next FCB A61630: POP HL ;YES, so no more FCBs (get HL off stack) LD A,5 ;A=5 (FILE NOT OPEN error) OR A ;clear ZF for error exit JR A61653 ;*************************************************************************** A61636: LD A,(HL) ;get character from filename string CP 3 ;is it hex 03? (end) POP HL ;HL=FCB address (saved as DE) JR NZ,A61630 ;NO, so mismatch error exit LD A,(IX+24) ;YES, so A=I/O mode byte from FCB AND 7 ;mask out upper 5 bits LD B,A ;save it in B XOR A ;A=0, ZF=1 for OK exit LD A,(FILE_NUMBR) ;A=file number POP DE A61653: POP DE POP IX RET ;*************************************************************************** ;EOS Function 67: CHECK FILE I/O MODE. ; On entry, IX=address of FCB, HL=address of directory entry. On exit, ; IX and HL have their entry values. This routine determines if the ; attribute of the file will permit the I/O type requested. If the mode ; check was OK, ZF=1 and A=0. Otherwise, ZF=0 and A=error code (17=BAD ; I/O MODE, 20=FILE ACCESS DENIED). __MODE_CHECK: PUSH IY PUSH HL ;save dir entry address LD A,(IX+24) ;A=I/O mode byte AND 7 ;mask out upper 5 bits CP 0 ;is it zero? JR Z,A61700 ;YES, so exit error 17 (BAD I/O MODE) CP 5 ;NO, but is less than 5? JR NC,A61700 ;NO, so exit error 17 (BAD I/O MODE) LD HL,A61707-1 ;YES (4,3,2,1) so point HL at mask table ADD A,L ;offset into table LD L,A ;HL=A61706+A JR NC,A61681 ;no carry from add, so skip ahead INC H ;carry, so add it to hibyte (not as stupid ;as it might seem, since you don't know ;the real address as you write the code, ;only after you assemble it A61681: POP IY ;IY=dir entry address (saved as HL) PUSH IY ;save it again LD A,(IY+12) ;A=file attribute from dir entry AND (HL) ;mask out all but appropriate bit (if set) JR NZ,A61696 ;bit set, so error 20 (FILE ACCESS DENIED) POP HL ;bit was clear; get back HL=dir entry addr POP IY XOR A ;A=0, ZF=1 for OK exit RET ;*************************************************************************** A61696: LD A,20 ;A=20 (FILE ACCESS DENIED error) JR A61702 A61700: LD A,17 ;A=17 (BAD I/O MODE error) A61702: POP HL POP IY OR A ;ZF=0 for error exit RET ;*************************************************************************** ;TABLE OF FILE ATTRIBUTE BIT MASKS. A61707: DB 20H ;0010 0000 ;read protected DB 40H ;0100 0000 ;write protected DB 80H ;1000 0000 ;delete protected DB 02H ;0000 0010 ;execute protected ;*************************************************************************** ;EOS Function 58: RENAME FILE. ; On entry, A=device number, DE=address of old filename string, HL=address ; of new filename string. On exit, if the rename was successful, ZF=1 and ; A=0. Otherwise, ZF=0 and A=error code. __RENAME_FILE: PUSH BC PUSH AF PUSH DE PUSH HL EX DE,HL ;swap new filename address into DE LD HL,QUERY_BUFFER ;HL=query buffer address CALL __QUERY_FILE ;*Fn52: FIND FILE (WITH TYPE) JR Z,A61768 ;found! we can't use this name, so exit POP HL ;not found, so we'll use it POP DE ;DE restored as old filename address POP AF PUSH AF PUSH DE PUSH HL LD HL,QUERY_BUFFER ;HL=query buffer address CALL __QUERY_FILE ;*Fn52: FIND FILE (WITH TYPE) JR NZ,A61768 ;old file not found, so error exit LD DE,QUERY_BUFFER ;found, so DE=query buffer address POP HL ;HL=address of new filename string PUSH HL LD BC,12 ;length of name=12 LDIR ;copy new name to old entry in query buffr POP HL POP DE POP AF PUSH AF PUSH DE PUSH HL LD HL,QUERY_BUFFER ;HL=query buffer address CALL __SET_FILE ;*Fn53: UPDATE DIRECTORY ENTRY JR NZ,A61768 ;update failed, so error exit ZF=0 XOR A ;update OK, so A=0, ZF=1 for OK exit POP HL POP DE POP BC POP BC RET ;*************************************************************************** A61768: OR A ;clear ZF for error exit POP HL POP DE POP BC POP BC RET ;*************************************************************************** ;EOS Function 59: DELETE FILE. ; On entry, A=device number, HL=address of filename string for file to ; delete. On exit, if the delete was successful, ZF=1 and A=0. Otherwise, ; ZF=0 and A=error code. __DELETE_FILE: PUSH DE PUSH HL PUSH AF EX DE,HL ;swap filename string into DE LD HL,QUERY_BUFFER ;HL=query buffer address CALL __QUERY_FILE ;*Fn52: FIND FILE (WITH TYPE) JR NZ,A61815 ;file not found, so error exit ZF=0 LD A,(QUERY_BUFFER+12) ;A=attribute byte (12) of file in buffer BIT 7,A ;is bit 7 set? (locked) JR NZ,A61812 ;YES, so exit error 16 OR 4 ;NO, so set bit 3 (deleted) LD (QUERY_BUFFER+12),A ;set new attribute back into query buffer POP AF ;restore A=device # POP DE ;restore DE=address of filename string PUSH DE PUSH AF CALL __SET_FILE ;*Fn53: UPDATE DIRECTORY ENTRY JR NZ,A61815 ;update failed, so error exit ZF=0 XOR A ;update OK, so A=0, ZF=1 POP HL ;get AF off stack without altering flags POP HL POP DE RET ;*************************************************************************** A61812: LD A,16 ;A=16 (FILE LOCKED error) OR A ;ZF=0 for error exit A61815: POP HL ;get AF off stack without altering flags POP HL POP DE RET ;*************************************************************************** ;EOS Function 65: READ BLOCK. ; On entry, A=device number, BCDE=block to read (BC=hiword, DE=loword), HL= ; data transfer address (DTA). On exit, if the read was successful, ZF=1. ; If not, ZF=0 and A=22 (I/O ERROR) or other error code. Oddly, this ; routine reads the block, checks the device status, then rereads the ; block. This cannot be for data integrity, as no verify operation is per- ; formed on the data (e.g. load same block into 2 places and compare them). ; The extra reading time is not noticeable from disk drives, but probably ; is significant for the tape drives. Why the routine does this I don't ; know. By comparison, Fn66 (write block) writes the block once, followed ; by a status check. ; Note added 9508.08: According to Chris Braymen, who has done extensive ; investigation into the workings of ADAMnet at the 6801 level, the double ; read is actually necessary (for technical reasons which I don't know). ; I can say that, at ADAMcon 05, while playing with his ADAMnet RAMdisk, ; I NOPed out the CALL for the second read, and no data was transferred. ; Restoring the CALL, it worked. __READ_BLOCK: PUSH BC PUSH DE PUSH HL PUSH IX PUSH IY PUSH AF LD A,2 ;number of times to retry the read LD (RETRY_COUNT),A ;save retry count A61832: POP AF ;restore A=device # PUSH AF ;save it again CALL __RD_1_BLK ;*Fn19: READ 1 BLOCK JR Z,A61853 ;read OK (A=0), so continue, check status CP 155 ;read failed, but was error 155? JR Z,A61853 ;YES, so continue, check status PUSH HL ;NO, so enter retry loop; save DTA LD HL,RETRY_COUNT ;HL=address of retry count DEC (HL) ;one less chance to count POP HL ;restore HL=DTA JR Z,A61914 ;no more retry chances, so error 22 exit JR A61832 ;still some chances, so keep trying ;*************************************************************************** A61853: LD B,2 ;count for status request retries A61855: POP AF ;restore A=device # PUSH AF ;save it CALL __REQUEST_STATUS ;*Fn26: REQUEST DEVICE (in A) STATUS JR Z,A61870 ;status 0 (done OK), so ... CP 155 ;not zero, but is it 155? (busy but OK) JR Z,A61855 ;YES, so keep waiting 'til it's done DJNZ A61855 ;NO, so error; decrement retry count JR A61914 ;no more status retries, so error 22 exit ;*************************************************************************** A61870: POP AF ;restore A=device # PUSH AF ;save it again CALL A61989 ;GET NODE TYPE DATA OF DEVICE (in A) subrt CP 0 ;is it zero? JR NZ,A61914 ;NO, so error 22 exit LD A,2 ;YES, so retry count=2 LD (RETRY_COUNT),A ;save retry count POP AF ;restore A=device # POP IY POP IX POP HL ;restore HL=DTA POP DE POP BC ;restore BCDE=block to read PUSH BC A61893: PUSH AF CALL __RD_1_BLK ;*Fn19: READ 1 BLOCK JR Z,A61911 ;success! so exit OK PUSH HL ;read failed, so enter retry loop LD HL,RETRY_COUNT ;HL=address of retry count DEC (HL) ;one less chance to read... POP HL JR Z,A61910 ;this was our last chance, so exit ;error code in A returned by Fn19 POP AF JR A61893 ;let's try it again ;*************************************************************************** A61910: OR A ;clear ZF for error exit A61911: POP BC ;get AF off stack without altering flags POP BC RET ;*************************************************************************** A61914: POP IY POP IY POP IX POP HL POP DE POP BC LD A,22 ;A=22 (I/O ERROR) RET ;*************************************************************************** ;EOS Function 66: WRITE BLOCK. ; On entry, A=device number, BCDE=block to write (BC=hiword, DE=loword), ; HL=data transfer address (DTA). On exit, if the write was successful, ; ZF=1. If not, ZF=0 and A=22 (I/O ERROR). Unlike Fn65 (read block), ; this routine only writes the block once. __WRITE_BLOCK: PUSH BC PUSH IY PUSH AF ;save device # LD A,2 ;retry count=2 LD (RETRY_COUNT),A ;save retry count A61935: POP AF ;restore device # PUSH AF ;save it again CALL __WR_1_BLOCK ;*Fn44: WRITE 1 BLOCK JR Z,A61956 ;write OK (A=0), so continue, check status CP 155 ;write failed but was error 155? JR Z,A61956 ;YES, so continue, check status PUSH HL ;NO, so entry retry loop LD HL,RETRY_COUNT ;HL=address of retry count DEC (HL) ;one less chance to write... POP HL JR Z,A61982 ;this was our last chance, so exit JR A61935 ;let's try it again ;*************************************************************************** A61956: LD B,2 ;B=retry count for status request A61958: POP AF ;restore A=device # PUSH AF ;save it again CALL __REQUEST_STATUS ;*Fn26: REQUEST DEVICE (in A) STATUS JR Z,A61973 ;status OK (A=0), so continue CP 155 ;status not zero, but is it 155? (busy) JR Z,A61958 ;YES, so keep waiting 'til it's done DJNZ A61958 ;NO, so decrement retry count and hope... JR A61982 ;no more retries left, so exit error 22 ;*************************************************************************** A61973: POP AF ;restore A=device # PUSH AF ;save it again CALL A61989 ;GET NODE TYPE DATA OF DEVICE (in A) subrt CP 0 ;is it zero? JR Z,A61984 ;YES, so exit OK A61982: LD A,22 ;A=22 (I/O ERROR), ZF already 0 A61984: POP BC POP IY POP BC RET ;*************************************************************************** ;GET NODE TYPE DATA OF DEVICE (in A) subroutine. ; On entry, A=device number, IY=address of DCB. On exit, if the device ; number is greater than 15, A returns the high nibble of the node type ; byte from the DCB. If the device number is 15 or less, A returns the ; low nibble of the node type byte. This routine handles tape 1 and tape ; 2, which share the same DCB. A61989: SRL A ;A/2 SRL A ;A/4 SRL A ;A/8 SRL A ;A/16 (high nibble moved to low) CP 0 ;is it zero? LD A,(IY+20) ;A=node type byte from DCB JR NZ,A62008 ;NO, so make A=upper nibble of node type AND 15 ;YES, so make A=lower nibble of node type JR A62016 ;exit (how about just RET?) ;*************************************************************************** A62008: SRL A ;A/2 SRL A ;A/4 SRL A ;A/8 SRL A ;A/16 (high nibble moved to low) A62016: RET ;*************************************************************************** ;EOS Function 63: TRIM FILE. ; On entry, A=device number, DE=address of filename to trim. On exit, any ; excess blocks allocated to the file (but not actually used by it) are ; deallocated. If the next directory entry is BLOCKS LEFT, the free blocks ; are allocated for use by subsequent files. Otherwise, the space is ; wasted. __TRIM_FILE: PUSH HL PUSH IX PUSH IY PUSH DE PUSH AF LD HL,FCB_BUFFER ;HL=base of FCB buffer CALL __QUERY_FILE ;*Fn52: FIND FILE (WITH TYPE) JP NZ,A62234 ;file not found, so error exit LD IX,FCB_BUFFER ;IX=base of FCB buffer LD E,(IX+19) LD D,(IX+20) ;DE=number of blocks actually used LD L,(IX+17) LD H,(IX+18) ;HL=allocated length of file in blocks OR A ;clear CF SBC HL,DE ;HL=HL-DE LD A,H OR L ;did HL=DE? JP Z,A62225 ;YES, so no trim needed -- exit OK LD (NEW_HOLE_SIZE),HL ;NO, so new hole size in blocks=HL LD (IX+17),E LD (IX+18),D ;make allocated length=actual used length LD A,(FILE_COUNT) ;A=file count (# of files in directory) LD B,39 ;B=maximum number of files A62071: SUB B ;have we reached the maximum? JR Z,A62110 ;YES, we're at the last file in directory JR NC,A62071 ;NO, not yet, so keep subtracting LD IX,(FCB_HEAD_ADDR) ;we're past the end; IX=address of FCB0 LD E,(IX+33) LD D,(IX+34) ;DE=address of dir entry in DTA0 PUSH DE ;save it LD BC,26 ;26 bytes to move PUSH BC ;save byte count LD HL,FCB_BUFFER ;HL=base of FCB buffer LDIR ;move dir entry from FCB buffer to DTA0 POP DE ;DE=26 (saved as BC) POP HL ;HL=old DE=byte offset into DTA0 ADD HL,DE ;point to next directory entry PUSH HL ;save this address... POP IY ;and get it back in IY BIT 0,(IY+12) ;is bit 0 of file attribute byte set? ;(not a file) JR Z,A62202 ;NO, it's a regular file, so we can't ;add any free blocks to BLOCKS LEFT JR A62170 ;YES, so we're at BLOCKS LEFT ;add in the freed-up blocks ;*************************************************************************** A62110: LD A,(FILE_COUNT) ;A=file count LD (MOD_FILE_COUNT),A ;mod file count=file count POP AF ;restore A=device # POP DE ;restore DE=address of filename to trim PUSH DE ;save device # again PUSH AF ;save filename address again LD HL,FCB_BUFFER ;HL=base of FCB buffer CALL __SET_FILE ;*Fn53: UPDATE DIRECTORY ENTRY JR NZ,A62234 ;update failed, so error exit ZF=0 POP AF ;update OK, so restore device # POP DE ;clear stack LD DE,A62504 ;DE=address of BLOCKS LEFT in data table PUSH DE ;save it PUSH AF ;save device # LD HL,FCB_BUFFER ;HL=base of FCB buffer CALL __QUERY_FILE ;*Fn52: FIND FILE (WITH TYPE) LD IX,(FCB_HEAD_ADDR) ;IX=address of FCB0 LD L,(IX+33) LD H,(IX+34) ;HL=address of dir entry in DTA0 PUSH HL ;save it on stack... POP IY ;and get it back in IY BIT 0,(IY+12) ;is bit 0 of attrib byte set? (not a file) JR Z,A62234 ;NO, it's a regular file, so error exit LD HL,FILE_COUNT ;YES (BLOCKS LEFT), so HL=file count addr LD A,(MOD_FILE_COUNT) ;A=mod file count INC A ;one more file counted CP (HL) ;compare file count and mod file count+1 JR NZ,A62225 ;NOT EQUAL, so exit OK A62170: LD L,(IY+17) ;EQUAL, so... LD H,(IY+18) ;HL=allocated length in blocks LD DE,(NEW_HOLE_SIZE) ;DE=new hole size in blocks ADD HL,DE ;add this length to the new hole size LD (IY+17),L LD (IY+18),H ;put this new size as the allocated length LD L,(IY+13) LD H,(IY+14) ;HL=start block loword OR A ;clear CF SBC HL,DE ;deduct the hole size from the start block LD (IY+13),L LD (IY+14),H ;save new start block loword A62202: LD A,(IX+23) ;A=device # LD HL,(FCB_DATA_ADDR) ;HL=address of DTA0 LD E,(IX+25) LD D,(IX+26) LD C,(IX+27) LD B,(IX+28) ;BCDE=block number to write CALL __WRITE_BLOCK ;*Fn66: WRITE BLOCK JR NZ,A62234 ;write failed, so error exit ZF=0 A62225: POP DE ;write OK POP DE POP IY POP IX POP HL XOR A ;A=0, AF=1 for OK exit RET ;*************************************************************************** A62234: OR A ;clear ZF for error exit POP DE POP DE POP IY POP IX POP HL RET ;*************************************************************************** ;EOS Function 47: INITIALIZE DIRECTORY. ; On entry, A=device number, C=number of directory blocks to initialize, ; DE=length of volume in blocks, HL=address of new volume name string. If ; the name is longer than 12 characters, it is truncated. On exit, if the ; initialization was successful, ZF=1 and A=0. Otherwise, ZF=0 and A=error ; code. __INIT_TAPE_DIR: PUSH IY PUSH BC PUSH DE PUSH HL LD (DEVICE_ID),A ;save device # LD A,C ;A=number of dir blocks to init LD (SECTORS_TO_INIT),A ;save it in RAM PUSH HL ;save address of new volume name string CALL A62383 ;SCRAMBLE DTA0 subroutine LD HL,A62426 ;base of data table for directory init LD DE,(FCB_DATA_ADDR) ;DE=address of DTA0 LD BC,104 ;length of init table LDIR ;move init table to DTA0 POP HL ;restore address of new volume name string LD DE,(FCB_DATA_ADDR) ;DE=base of DTA0 LD B,12 ;max length of name A62278: LD A,(HL) ;get character from new volume name string CP 3 ;is it hex 03? (end) JR Z,A62291 ;YES, so copy it to DTA0 and continue LD (DE),A ;NO, but copy name character to DTA0 and.. INC HL ;point to next character in string INC DE ;point to next slot in DTA0 DJNZ A62278 ;keep going 'til end or 12 copied LD A,3 ;no end reached, so we'll truncate name DEC DE ;back up to byte 11 in DTA0 A62291: LD (DE),A ;put in hex 03 (end) LD IY,(FCB_DATA_ADDR) ;IY=base of DTA0 LD A,(SECTORS_TO_INIT) ;A=number of blocks to initialize OR 128 ;set bit 7 LD (IY+12),A ;copy it to volume entry (MAX DIR LENGTH) POP HL POP DE ;restore new length of volume POP BC ;restore C=max directory length PUSH BC PUSH DE PUSH HL LD (IY+17),E LD (IY+18),D ;set new length of volume PUSH DE ;save it LD DE,78 ;length of VOLUME, BOOT, DIRECTORY entries ADD IY,DE ;point to BLOCKS LEFT entry POP DE ;restore new length of volume LD (IY-9),C ;DIRECTORY entry--allocated length=C LD (IY-7),C ;DIRECTORY entry--actual length=C INC C ;increment C LD (IY+13),C ;BLOCKS LEFT entry--start block=after DIR LD B,0 ;BC=C EX DE,HL ;swap length of volume into HL OR A ;clear CF SBC HL,BC ;number of free blocks=total-dir LD (IY+17),L LD (IY+18),H ;allocate free blocks to BLOCKS LEFT LD A,1 ;A=1 LD (SECTOR_NO),A ;block to initialize=A CALL A62405 ;WRITE INITIALIZED DIRECTORY BLOCK subrt JR NZ,A62377 ;write failed, so error exit ZF=0 LD A,(SECTORS_TO_INIT) ;write OK, so get # of blocks to init LD B,A ;put it in B DEC B ;one less block...are we done? JR Z,A62376 ;YES, no more blocks, so exit OK ZF=1 CALL A62383 ;NO, more to go, so SCRAMBLE DTA0 subrt A62365: LD HL,SECTOR_NO ;HL=address of block to initialize INC (HL) ;point to next block CALL A62405 ;WRITE INITIALIZED DIRECTORY BLOCK subrt JR NZ,A62377 ;write failed, so error exit ZF=0 DJNZ A62365 ;write OK, so keep initializing 'til done A62376: XOR A ;all blocks initialized, exit OK A=0, ZF=1 A62377: POP HL POP DE POP BC POP IY RET ;*************************************************************************** ;SCRAMBLE DTA0 subroutine. ; On entry, DTA0 may or may not contain a directory block previously read ; in from a device. Every byte but the last is moved up 1, and the first ; is zeroed out. This makes the block unintelligible as a directory entry, ; if that is what it contained on entry. A better (though slower) approach ; would have been to zero out the whole DTA. A62383: PUSH BC PUSH DE PUSH HL LD HL,(FCB_DATA_ADDR) ;HL=address of DTA0 LD DE,(FCB_DATA_ADDR) ;DE=address of DTA0 INC DE ;point up 1 LD BC,1023 ;bytes to move LD (HL),0 ;zero out old 1st byte LDIR ;move 1023 bytes from (HL) up 1 POP HL POP DE POP BC RET ;*************************************************************************** ;WRITE INITIALIZED DIRECTORY BLOCK subroutine. ; On entry, DTA0 contains a block of data destined for a directory. This ; data is written to the appropriate block of the directory. If write was ; successful, ZF=1 and A=0. Otherwise, ZF=0 and A=error code. A62405: PUSH BC LD HL,(FCB_DATA_ADDR) ;HL=address of DTA0 LD A,(SECTOR_NO) ;A=block to initialize LD E,A ;save it as loword/lobyte LD D,0 ;zero out BCD LD BC,0 ;BCDE=block number to write LD A,(DEVICE_ID) ;A=device number CALL __WRITE_BLOCK ;*Fn66: WRITE BLOCK POP BC RET ;*************************************************************************** ;DIRECTORY INITIALIZATION DATA. A62426: DB " " DB 80H ; A62439: DB 55H,0AAH,00H,0FFH ;EOS directory check DW 0,0,0 DB 0,0,0 A62452: DB "BOOT",3," " DB 88H ; DW 0,0,1,1,0 DB 0,0,0 A62478: DB "DIRECTORY",3," " DB 0C8H ; DW 1,0,128,1,1024 DB 0,0,0 A62504: DB "BLOCKS LEFT",3 DB 01H ;not a file DW 0,0,0,0,0 DB 57H,07H,11H ;EOS revision date ;*************************************************************************** ;EOS Function 70: POSITION FILE. ; Not implemented in EOS-5. Used in EOS-7 to move the read/write pointer ; in a random-access file. SmartBASIC 1.0 provides its own routine to do ; this; SmartBASIC 2.0 requires the EOS-7 routine. __POSIT_FILE: ;*************************************************************************** ;EOS Function 71: EOS1. ; Not implemented in EOS-5. In EOS-7, it is a consolidated master block ; I/O routine, part of the space-saving rewrite to add a third 1024-byte ; buffer. __EOS_1: ;*************************************************************************** ;EOS Function 72: EOS2. ; Not implemented in EOS-5. In EOS-7, it is a block I/O subroutine. __EOS_2: ;*************************************************************************** ;EOS Function 73: EOS3. ; Not implemented in either EOS-5 or EOS-7. What it was supposed to do is ; anybody's guess. __EOS_3: ;*************************************************************************** ;EOS Function 74: INCORRECT EOS VERSION ERROR. ; EOS-5 leaves several of its functions unimplemented. This might not be ; true in some later, suped-up version of EOS. Programs written to utilize ; these extra functions would bomb if run under earlier, incompatible ; versions of EOS. Consequently, jump table entries for routines which ; never got off the drawing board in EOS-5 point here to return an error ; code (A=23). This allows the incompatible program to terminate nicely ; with an error message, rather than just locking up the system when the ; call to a non-existent routine sends the program counter off to never- ; never land. Under EOS-5, Fn70 (position file), Fn71 (EOS1), Fn72 (EOS2), ; Fn73 (EOS3) remain unimplemented, and are redirected here. On exit, ZF=0 ; and A=23 (INCORRECT EOS VERSION error). ; Note added 9508.08: I believe that the label CV_A stands for ; "ColecoVision Alpha", possibly refering to the OS7 ROM (which contains ; a character set). The comments in the EOS6 source say ; RETURN ERROR CODES UNTIL THESE ROUTINES ARE WRITTEN ; ; 10/12/83 VSB ; 10/14/83 RPD changed __EOS_4 to __CV_A ; so I suspect that this was a debugging trap during EOS code development. __CV_A: LD A,23 ;A=23 (INCORRECT EOS VERSION error) OR A ;clear ZF for error RET ;*************************************************************************** ;EOS Functions 12/13: FIND/GET DCB ADDRESS (in IY). ; On entry, A=device number. On exit, if the device exists, ZF=1, A=device ; number and IY=DCB address. Otherwise, ZF=0 and A=1 (NON-EXISTENT DEVICE ; error). __FIND_DCB: __GET_DCB_ADDR: PUSH BC PUSH DE LD C,A ;save device number in C LD IY,(CURRENT_PCB) ;IY=address of current PCB LD B,(IY+3) ;B=number of valid DCBs XOR A ;A=0 CP B ;are there any valid DCBs? JR Z,A62573 ;NO, so error and EXIT LD DE,4 ;YES, so skip over PCB and... ADD IY,DE ;point to base of first DCB (64892) LD DE,21 ;length of each DCB LD A,C ;A=device number AND 15 ;zero out upper 4 bits A62559: CP (IY+16) ;is this the right one? (IY+16 has dev#) JR Z,A62570 ;YES, so OK exit ZF=1 ADD IY,DE ;NO, so point to next DCB DJNZ A62559 ;keep looking until all have been searched JR A62573 ;couldn't find the requested DCB, so EXIT ;*************************************************************************** A62570: LD A,C ;restore A=device # JR A62576 ;*************************************************************************** A62573: LD A,1 ;error code=1 (NON-EXISTENT DEVICE error) OR A ;clear zero flag A62576: POP DE POP BC RET ;on OK exit, IY points to base of DCB ;*************************************************************************** ;EOS Function 26: REQUEST DEVICE (in A) STATUS. ; On entry, A=device number. On exit, if the device exists, A=status ; returned by ADAMnet, with ZF=1 if A=128, ZF=0 otherwise. If the device ; does not exist, ZF=0 and A=1 (NON-EXISTENT DEVICE error). __REQUEST_STATUS: CALL __FIND_DCB ;*Fn12/13: FIND/GET DCB ADDRESS (in IY) JR NZ,A62599 ;device doesn't exist, so error exit ZF=0 ;how about RET NZ? LD (IY+0),1 ;device exists, so make status request ;write 1 to status byte tells ADAMnet to ;return the status of the device A62588: BIT 7,(IY+0) ;is bit 7 of status byte set? (status ;request completed; read byte for status) JR Z,A62588 ;NO, still working on request, try again LD A,(IY+0) ;YES, so get status in A CP 128 ;is it 128? (OK) A62599: RET ;*************************************************************************** ;EOS Function 60: READ DEVICE (in A) NODE TYPE. ; On entry, A=device number. On exit, if the device exists, ZF=1 and A= ; node type byte. If the device doesn't exist, ZF=0 and A=1 (NON-EXISTENT ; DEVICE error). ; The node type byte contains ADAMnet status information for each device. ; Unfortunately, there are 2 physical devices mapped to each node, with the ; high nibble and low nibble of the node type byte showing the status of ; the 2 devices, respectively. Devices which share DCBs also share node ; type bytes, hence tape 1 and tape 2 are shared, but disk 1 and disk 2 are ; separate. For tape 1, disk 1 and disk 2, the low nibble contains the ; status information; for tape 2, the high nibble. Returned values of the ; nibbles decode as follows: ; 0 No Error (everything is OK) ; 1 CRC Error (block corrupt; data failed cyclic redundancy check) ; 2 Missing Block (attempt to access past physical end of medium) ; 3 Missing Media (not in drive or drive door open) ; 4 Missing Drive (not connected or not turned on) ; 5 Write-Protected (write-protect tab covered) ; 6 Drive Error (controller or seek failure) __RD_DEV_DEP_STAT: PUSH IY CALL __FIND_DCB ;*Fn12/13: FIND/GET DCB ADDRESS (in IY) JR NZ,A62611 ;device doesn't exist, so error exit ZF=0 XOR A ;device exists, so A=0 (set ZF=1) LD A,(IY+20) ;A=device node type byte A62611: POP IY RET ;*************************************************************************** ;CHECK IF DEVICE (IN A) IS READY subroutine. ; On entry, A=device number, IY=DCB address. On exit, ZF=1 and A=entry ; device number if device is ready (status=0 or bit 7 of status set). ; Otherwise, ZF=0 and A=2 (DEVICE NOT READY error). A62614: PUSH BC LD C,A ;save device # in C LD A,(IY+0) ;get status byte from DCB CP 0 ;is it zero? JR Z,A62629 ;YES, so exit OK BIT 7,(IY+0) ;NO, but is bit 7 set? JR Z,A62633 ;NO, not ready, so error exit A62629: XOR A ;YES, we're ready; A=0, ZF=1 LD A,C ;restore device # JR A62636 ;exit OK ;*************************************************************************** A62633: INC A ;clears ZF (not obvious, but it does) LD A,2 ;A=2 (DEVICE NOT READY error) A62636: POP BC RET ;*************************************************************************** ;CHECK IF DEVICE I/O IS DONE subroutine. ; On entry, IY=DCB address. On exit, ZF=1 and A=0 if device I/O is ; finished (status not zero). Otherwise, ZF=0 and A=3 (I/O NOT DONE ; error). A62638: LD A,(IY+0) ;read DCB status byte OR A ;is it zero? JR NZ,A62648 ;NO, so all done LD A,3 ;YES, A=3 (I/O NOT DONE error) OR A ;clear ZF RET ;error exit ;*************************************************************************** A62648: XOR A ;A=0 and ZF set RET ;exit OK ;*************************************************************************** ;EOS Function 20: READ KEYBOARD. ; On exit, if read was successful, ZF=1 and A=character typed. If not, ; ZF=0 and A=error code. __RD_KBD: PUSH BC PUSH DE CALL __START_RD_KBD ;*Fn40: START READ KEYBOARD JR NZ,A62664 ;start failed, so error exit ZF=0 LD C,A ;start OK, so A62658: LD A,C CALL __END_RD_KBD ;*Fn9: END READ KEYBOARD JR NC,A62658 ;not done yet, so keep trying A62664: POP DE ;read ended, so exit OK POP BC RET ;*************************************************************************** ;EOS Function 27: REQUEST KEYBOARD STATUS. ; On exit, A=status. ZF=1 if A=128, otherwise ZF=0. __REQ_KBD_STAT: LD A,1 ;device 1=keyboard JP __REQUEST_STATUS ;*Fn26: REQUEST DEVICE (in A) STATUS ;*************************************************************************** ;EOS Function 40: START READ KEYBOARD. ; On exit, if start was successful, ZF=1 and A=1 (device number). Other- ; wise, ZF=0 and A=error code (1=NON-EXISTENT DEVICE, 2=DEVICE NOT READY). __START_RD_KBD: PUSH BC PUSH DE LD A,1 ;1=keyboard LD DE,KEYBOARD_BUFFER ;DE=address of keyboard buffer LD BC,1 ;1 character to read CALL __START_RD_CH_DEV ;*Fn39: START READ CHARACTER DEVICE (in A) POP DE POP BC RET ;*************************************************************************** ;EOS Function 9: END READ KEYBOARD. ; On exit, if end was successful, ZF=1 and A=character typed. Otherwise, ; ZF=0 and CF reflects various error conditions. CF=0 if not done reading, ; CF=1 if done but I/O error (code in A). __END_RD_KBD: LD A,1 ;1=keyboard CALL __END_RD_CH_DEV ;*Fn8: END READ CHARACTER DEVICE (in A) JR NC,A62715 ;not done reading, so error exit CF=0 JR Z,A62709 ;done! so get character and exit OK CP 140 ;bad end, but was it 140? JR NZ,A62706 ;NO, so error exit CF=1, ZF=0 CALL __START_RD_KBD ;YES, so *Fn40: START READ KEYBOARD JR Z,A62714 ;start OK, so clear CF and exit A62706: SCF ;start failed, so CF=1 JR A62715 ;error exit ZF=0 (how about RET?) ;*************************************************************************** A62709: LD A,(KEYBOARD_BUFFER) ;A=last character typed (from kybd buffer) JR A62715 ;exit OK (how about RET?) ;*************************************************************************** A62714: OR A ;adjust ZF and clear CF A62715: RET ;*************************************************************************** ;EOS Function 18: PRINT CHARACTER (in A). ; On entry, A=character to send to the line printer. On exit, if the ; print was successful, ZF=1 and A=0. Otherwise, ZF=0 and A=error code. __PR_CH: PUSH BC PUSH DE PUSH HL PUSH IY LD (PRINT_BUFFER),A ;put A as 1st character in print buffer LD A,3 ;hex 03=logical end-of-buffer LD (PRINT_BUFFER+1),A ;terminate buffer LD HL,PRINT_BUFFER ;HL=address of print buffer CALL __PR_BUFF ;*Fn17: PRINT BUFFER (at HL) POP IY POP HL POP DE POP BC RET ;*************************************************************************** ;EOS Function 17: PRINT BUFFER (at HL). ; On entry, HL=address of a print buffer terminated by hex 03. The logical ; buffer may be of any length, but only 16 characters at a time may be ; printed (physical length). On exit, if printing ended successfully, ZF=1 ; and A=0. Otherwise, ZF=0 and A=error code. __PR_BUFF: PUSH BC PUSH DE PUSH HL PUSH IY LD A,2 ;2=printer CALL __FIND_DCB ;*Fn12/13: FIND/GET DCB ADDRESS (in IY) JR NZ,A62808 ;device doesn't exist, so error exit ZF=0 CALL A62614 ;device exists, so CHECK IF DEVICE (IN A) ;IS READY subroutine JR NZ,A62808 ;device not ready, so error exit ZF=0 A62758: LD BC,0 ;device ready, so zero out char counter LD E,L LD D,H ;DE=buffer start address A62763: LD A,3 ;hex 03=logical end-of-buffer character CP (HL) ;is it the logical end? JR Z,A62792 ;YES, so now let's print to logical end INC HL ;NO, so point to next character INC C ;count next character LD A,C ;save it in A CP 16 ;is it 16? (physical buffer max) JR NZ,A62763 ;NO, so keep counting EX DE,HL ;YES, so print full buffer: HL=start A62776: LD A,2 ;device 2=printer CALL __WR_CH_DEV ;*Fn45: WRITE CHARACTER DEVICE (in A) JR Z,A62789 ;write OK, so get next 16 characters CP 134 ;write failed; is it still printing? (134) JR NZ,A62808 ;NO, so error exit ZF=0 JR A62776 ;YES, so keep trying 'til it's done ;*************************************************************************** A62789: EX DE,HL ;HL=new buffer start=old buffer end JR A62758 ;print the next 16 character in the buffer ;*************************************************************************** A62792: EX DE,HL ;HL=buffer start, DE=last char address XOR A ;A=0 CP C ;have we emptied the logical buffer? JR Z,A62808 ;YES, so OK exit ZF=1, A=0 A62797: LD A,2 ;NO, still some to print, so get device # CALL __WR_CH_DEV ;*Fn45: WRITE CHARACTER DEVICE (in A) JR Z,A62808 ;write OK, so exit ZF=1, A=0 CP 134 ;write failed; is it still printing? (134) JR Z,A62797 ;YES, so keep trying 'til it's done A62808: POP IY ;NO, so error exit ZF=0 POP HL POP DE POP BC RET ;*************************************************************************** ;THIS SECTION OF CODE DUPLICATES Fn37, BUT IS NOT USED ANYWHERE IN EOS-5. A62814 LD (PRINT_BUFFER),A ;put A as 1st character in print buffer LD A,3 ;hex 03=logical end-of-buffer LD (PRINT_BUFFER+1),A ;terminate buffer LD HL,PRINT_BUFFER ;HL=address of print buffer CALL __START_PR_BUFF ;*Fn36: START PRINT BUFFER (at HL) RET ;*************************************************************************** ;EOS Function 37: START PRINT CHARACTER (in A). ; On entry, A=character to print. On exit, if start was successful, ZF=1 ; and A=0. Otherwise, ZF=0 and A=error code. __START_PR_CH: LD (PRINT_BUFFER),A ;put A as 1st character in print buffer LD A,3 ;hex 03=logical end-of-buffer LD (PRINT_BUFFER+1),A ;terminate buffer LD HL,PRINT_BUFFER ;HL=address of print buffer CALL __START_PR_BUFF ;*Fn36: START PRINT BUFFER (at HL) RET ;*************************************************************************** ;EOS Function 6: END PRINT CHARACTER (in A). ; On exit, if end was successful, ZF=1. If not, ZF=0 and CF reflects ; various error conditions. CF=0 if not done printing, CF=1 if done but ; I/O error (code in A). __END_PR_CH: CALL __END_PR_BUFF ;*Fn5: END PRINT BUFFER (at HL) RET ;*************************************************************************** ;EOS Function 36: START PRINT BUFFER (at HL). ; On entry, HL=address of a print buffer terminated by hex 03. The logical ; buffer may be of any length, but only 16 characters at a time may be ; printed (physical length). If start was OK, ZF=1 and A=0. Otherwise, ; ZF=0 and A=error code. __START_PR_BUFF: PUSH BC PUSH DE PUSH HL PUSH IY LD A,2 ;2=printer CALL __FIND_DCB ;*Fn12/13: FIND/GET DCB ADDRESS (in IY) JR NZ,A62898 ;device doesn't exist, so error exit ZF=0 CALL A62614 ;device exists, so CHECK IF DEVICE (IN A) ;IS READY subroutine JR NZ,A62808 ;device not ready, so error exit ZF=0 LD BC,0 ;device ready, so zero out char counter LD E,L LD D,H ;DE=buffer start address A62870: LD A,3 ;hex 03=logical end-of-buffer character CP (HL) ;is it the logical end? JR Z,A62890 ;YES, so now let's print to logical end INC HL ;NO, so point to next character INC C ;count next character LD A,C ;save it in A CP 16 ;is it 16? (physical end) JR NZ,A62870 ;NO, so keep counting EX DE,HL ;YES, so print full buffer: HL=start LD A,2 ;device 2=printer CALL __START_WR_CH_DEV ;*Fn42: start write character dev (in A) JR A62898 ;exit with ZF reflecting status of start ;*************************************************************************** A62890: EX DE,HL ;HL=new buffer start=old buffer end XOR A ;A=0 CP C ;have we emptied the logical buffer? LD A,2 ;device 2=printer CALL NZ,__START_WR_CH_DEV ;NO, so *Fn42: start write char dev (in A) A62898: POP IY ;exit with ZF reflecting start status POP HL POP DE POP BC RET ;*************************************************************************** ;EOS Function 5: END PRINT BUFFER (at HL). ; On exit, if end was successful, ZF=1. If not, ZF=0 and CF reflects ; various error conditions. CF=0 if not done printing, CF=1 if done but ; I/O error (code in A). __END_PR_BUFF: PUSH IY LD A,2 ;device 2=printer CALL __FIND_DCB ;*Fn12/13: FIND/GET DCB ADDRESS (in IY) CALL __END_WR_CH_DEV ;*Fn11: END WRITE CHARACTER DEVICE (in A) JR NC,A62927 ;not done writing, so error exit CF=0 JR Z,A62927 ;done! so OK exit CP 134 ;bad end; was it 134? JR NZ,A62927 ;NO, so I/O error exit ZF=0 LD (IY+0),3 ;YES, so request write OR A ;adjust ZF, clear CF A62927: POP IY RET ;*************************************************************************** ;EOS Function 28: REQUEST PRINTER STATUS. ; On exit, A=status. ZF=1 if A=128, otherwise ZF=0. __REQ_PR_STAT: LD A,2 ;device number 2=printer JP __REQUEST_STATUS ;*Fn26: REQUEST DEVICE (in A) STATUS ;*************************************************************************** ;EOS Function 29: REQUEST TAPE STATUS. ; On exit, A=status. ZF=1 if A=128, otherwise ZF=0. __REQ_TAPE_STAT: LD A,8 ;device number 8=tape 1/2 JP __REQUEST_STATUS ;*Fn26: REQUEST DEVICE (in A) STATUS ;*************************************************************************** ;EOS Function 2: CONSOLE INITIALIZATION. ; On entry, B=number of columns (X) for screen, C=number of lines (Y), D= ; column of upper left corner (X-min), E=line of upper left column (Y-min), ; HL=VRAM address of name table. Note: This routine is not used by ; SmartBASIC, though its own routine is almost identical. __CONS_INIT: INC B ;one more to see if we've gone too far INC C ;ditto LD (NUM_LINES),BC ;65183=# of lines, 65184=# of columns LD (UPPER_LEFT),DE ;65185=upper left line, 65186=column LD (CURSOR),DE ;65189=current cursor line, 65190=column LD (PTRN_NAME_TBL),HL ;VRAM address of name table=HL LD A,D LD (X_MIN),A ;X min=upper left column ADD A,B DEC A LD (X_MAX),A ;X max=(X min)+number of columns-1 LD A,E LD (Y_MIN),A ;Y min=upper left line ADD A,C DEC A LD (Y_MAX),A ;Y max=(Y min)+number of lines-1 LD A,32 LD (OLDCHAR_),A ;old character=space LD A,95 ;character=underline CALL A63450 ;DISPLAY CHARACTER IN A ON SCREEN subrt RET ;*************************************************************************** ;EOS Function 3: DISPLAY CHARACTER OR CONTROL CHARACTER ON SCREEN. ; On entry, character to display is in A. If the character is ^\ (28), ; D=column, E=line to quickmove the cursor to. Note: This routine is ; not used by SmartBASIC, though its own routine is almost identical. ; The control character handling routines, however, are different. __CONS_OUT: PUSH AF PUSH BC PUSH HL PUSH IX PUSH IY PUSH DE LD HL,A63502 ;HL=addr of data table of control chars LD BC,12 ;length of table=12 CPIR ;compare table with character in A JR NZ,A63023 ;not found, so just print regular char LD HL,A63514 ;HL=jump table addr for control char print ADD HL,BC ADD HL,BC ;offset into table LD B,A ;temporarily store character in B LD A,(HL) ;get lobyte of execute address INC HL ;point to hibyte LD H,(HL) ;get hibyte of execute address in H LD L,A ;put lobyte in L JP (HL) ;jump to execute address in HL ;*************************************************************************** ;EOS Function 1: CONSOLE DISPLAY OF NON-CONTROL CHARACTER (in A). ; On entry, A=character to display. Performs line wraparound and screen ; scroll up if necessary. Note: This routine is not used by SmartBASIC, ; though its own routine is almost identical. __CONS_DISP: PUSH AF PUSH BC PUSH HL PUSH IX PUSH IY PUSH DE A63023: CALL A63450 ;DISPLAY CHARACTER (IN A) ON SCREEN subrt LD HL,(CURSOR) ;L=cursor line, H=cursor column INC H ;move cursor to next column LD A,(X_MAX) ;A=X max CP H ;have we gone too far right? JR NC,A63056 ;NO, so print cursor at next position LD A,(X_MIN) ;YES: A=X min LD H,A ;put cursor back at start column INC L ;go to next line LD A,(Y_MAX) ;A=Y max CP L ;have we gone too far down? JR NC,A63056 ;NO, so print cursor at next position DEC L ;YES: back up to screen bottom PUSH HL ;save cursor coordinates CALL A63469 ;READ OLD CHARACTER AT CURRENT CURSOR X,Y CALL A63380 ;PRINT OLD CHARACTER AND SCROLL UP 1 LINE POP HL ;get back cursor coordinates A63056: LD (CURSOR),HL ;save current cursor line and column A63059: CALL A63472 ;READ OLD CHARACTER AT CURRENT CURSOR X,Y A63062: LD A,95 ;cursor character=underline CALL A63450 ;DISPLAY CHARACTER (IN A) ON SCREEN subrt A63067: POP DE POP IY POP IX POP HL POP BC POP AF RET ;*************************************************************************** ;CARRIAGE RETURN ^M (13) subroutine. ; The cursor is moved to the far left of the screen, on the same line. A63076: CALL A63447 ;DISPLAY OLD CHARACTER ON SCREEN subrt LD A,(X_MIN) ;A=X min LD (CURSOR+1),A ;cursor column=X min LD HL,(CURSOR) ;L=cursor line, H=cursor column JP A63059 ;READ NEXT OLD CHARACTER AND PRINT CURSOR ;*************************************************************************** ;UP ARROW (160) subroutine. ; The cursor is moved up 1 line in the same column. If the cursor was ; already at the first line, nothing happens. A63091: LD HL,(CURSOR) ;L=cursor line, H=cursor column LD A,(Y_MIN) ;A=Y min CP L ;are we at the first line? JR Z,A63067 ;YES, so EXIT without doing anything DEC L ;NO, so back cursor up 1 line A63101: CALL A63447 ;DISPLAY OLD CHARACTER ON SCREEN subrt JP A63056 ;PRINT CURSOR AT NEW X,Y (H,L) ;*************************************************************************** ;LINE FEED ^J (10) OR DOWN ARROW (162) subroutine. ; The cursor is moved down 1 line in the same column. If the cursor was ; already at the last line, line feed scrolls up the screen; down arrow ; does nothing. A63107: LD HL,(CURSOR) ;L=cursor line, H=cursor column LD A,(Y_MAX) ;A=Y max CP L ;are we at the last line? JR Z,A63120 ;YES, so scroll up 1 line if line feed INC L ;NO, so move cursor down 1 line JP A63101 ;PRINT OLD CHARACTER AND PRINT CURSOR ;*************************************************************************** A63120: LD A,10 CP B ;is it line feed? JR NZ,A63067 ;NO, so EXIT with no screen scroll CALL A63380 ;YES, so SCROLL UP 1 LINE subroutine LD HL,(CURSOR) ;L=cursor line, H=cursor column JP A63059 ;READ NEXT OLD CHARACTER AND PRINT CURSOR ;*************************************************************************** ;RIGHT ARROW (161) subroutine. ; The cursor is moved right one column on the same line. If the cursor ; was already at right margin, then it hops down to the next line at the ; left margin. If the cursor was on the last line, however, the screen is ; not scrolled up. A63134: LD HL,(CURSOR) ;L=cursor line, H=cursor column LD A,(X_MAX) ;A=X max CP H ;are we at the last column? JR Z,A63147 ;YES, so hop to next line at far left INC H ;NO, so move cursor right 1 column JP A63101 ;PRINT OLD CHARACTER AND PRINT CURSOR ;*************************************************************************** A63147: LD A,(Y_MAX) ;A=Y max CP L ;are we at the last line? JR Z,A63067 ;YES, so EXIT (can't scroll up) INC L ;NO, so move cursor down 1 line LD A,(X_MIN) ;A=X min LD H,A ;cursor column=X min JP A63101 ;PRINT OLD CHARACTER AND PRINT CURSOR ;*************************************************************************** ;LEFT ARROW (163) OR BACKSPACE ^H (8) subroutine. ; The cursor is moved left one column on the same line. If the cursor was ; already at the left margin, it hops up to the previous line at the right ; margin. If the cursor was on the first line, however, the screen is not ; scrolled down. A63161: LD HL,(CURSOR) ;L=cursor line, H=cursor column LD A,(X_MIN) ;A=X min CP H ;are we at the first column? JR Z,A63174 ;YES, so hop up 1 line at far right DEC H ;NO, so move cursor left 1 column JP A63101 ;PRINT OLD CHARACTER AND PRINT CURSOR ;*************************************************************************** A63174: LD A,(Y_MIN) ;A=Y min CP L ;are we at the first line? JR Z,A63067 ;YES, so exit (can't scroll down) DEC L ;NO, so move cursor up 1 line LD A,(X_MAX) ;A=X max LD H,A ;cursor column=X max JP A63101 ;PRINT OLD CHARACTER AND PRINT CURSOR ;*************************************************************************** ;FORM FEED ^L (12) subroutine. ; The entire screen is erased. The cursor is placed at the upper left ; corner. A63188: LD A,(NUM_LINES) ;A=number of lines LD B,A ;in B for counter LD HL,(UPPER_LEFT) ;L=line of upper left corner, H=column CALL A63308 ;ERASE B LINES STARTING AT H,L subroutine LD A,32 LD (OLDCHAR_),A ;old char=space; fall into next routine ;*************************************************************************** ;HOME (128) subroutine. ; The cursor is placed at the upper left corner. A63203 CALL A63447 ;DISPLAY OLD CHARACTER ON SCREEN LD HL,(UPPER_LEFT) ;L=line of upper left corner, H=column JP A63056 ;PRINT CURSOR AT NEW X,Y (H,L) ;*************************************************************************** ;SYNCHRONOUS IDLE ^V (22) subroutine. ; The physical screen line is erased from the current cursor position to ; the end of the line. The cursor is not moved. A63212: CALL A63334 ;ERASE TO END OF CURRENT LINE subroutine JP A63062 ;PRINT CURSOR ;*************************************************************************** ;CANCEL ^X (24) subroutine. ; The physical screen line is erased from the current cursor position to ; the end of the line. All lines below the current line are also erased. ; The cursor is not moved. A63218: CALL A63334 ;ERASE TO END OF CURRENT LINE subroutine LD HL,(CURSOR) ;L=cursor line, H=cursor column INC L ;down to next line LD A,(Y_MIN) ;A=Y min LD C,A ;in C LD A,(NUM_LINES) ;A=number of lines ADD A,C ;A=line number of last screen line SUB L ;A=lines left between current and bottom JP Z,A63062 ;no lines left, so exit LD B,A ;B=lines left (for counter) LD A,(X_MIN) ;A=X min LD H,A ;new cursor column at far left CALL A63308 ;ERASE B LINES STARTING AT H,L subroutine JP A63062 ;PRINT CURSOR ;*************************************************************************** ;FILE SEPARATOR ^\ (28) subroutine. ; This routine is used to "quick move" the cursor to any position on the ; screen. On entry, D=column (X), E=line (Y) to move to. The cursor is ; moved to these coordinates if they are not out of range. A63248: LD A,(X_MIN) ;A=X min CP D ;is it at the left margin? JR Z,A63257 ;YES, so keep checking JP NC,A63067 ;NO, too far left (right falls through) A63257: LD A,(X_MAX) ;A=X max CP D ;is it at the right margin? JR Z,A63266 ;YES, so keep checking JP C,A63067 ;NO, too far right (left falls through) A63266: LD A,(Y_MIN) ;A=Y min CP E ;is it at the top? JR Z,A63275 ;YES, so keep checking JP NC,A63067 ;NO, too far up (below falls through) A63275: LD A,(Y_MAX) ;A=Y max CP E ;is it at the bottom? JR Z,A63284 ;YES, so JP C,A63067 ;NO, too far down (above falls through) A63284: EX DE,HL ;HL=new cursor coordinates JP A63101 ;PRINT OLD CHARACTER AND PRINT CURSOR ;*************************************************************************** ;FILL LINE BUFFER WITH SPACES STARTING AT HL subroutine. ; On entry, HL=address of position in line buffer to start filling with ; spaces, B=number of spaces to fill. It jumps into the next routine, ; bypassing the setup for erasing the entire buffer. A63288: PUSH HL PUSH BC JR A63299 ;*************************************************************************** ;FILL ENTIRE LINE BUFFER WITH SPACES. A63292: PUSH HL PUSH BC LD HL,LINEBUFFER_ ;HL=address of line buffer LD B,32 ;number of characters to fill in buffer A63299: LD A,32 ;character=space A63301: LD (HL),A ;put it in buffer INC HL ;point to next slot DJNZ A63301 ;keep filling 'til count is zero POP BC POP HL RET ;*************************************************************************** ;ERASE B LINES STARTING AT H,L subroutine. ; On entry, B=number of lines to erase, HL=current cursor position. A63308: CALL A63292 ;FILL ENTIRE LINE BUFFER WITH SPACES subrt LD A,(NUM_COLUMNS) ;A=number of columns LD C,A ;in C A63315: PUSH BC ;save it PUSH HL ;save current cursor position (H,L) CALL A63484 ;GET VRAM ADDR OF current CURSOR X,Y IN DE LD B,0 ;BC=C (number of bytes to write) LD HL,LINEBUFFER_ ;HL=address of line buffer CALL WRITE_VRAM ;Fn78: WRITE VRAM POP HL ;restore cursor position INC L ;down to next line POP BC ;restore count of lines to erase DJNZ A63315 ;keep going until all lines are erased RET ;*************************************************************************** ;ERASE TO END OF CURRENT LINE subroutine. A63334: CALL A63353 ;READ REST OF LINE FROM VRAM INTO BUFFER PUSH HL ;save line buffer start address PUSH BC ;C=# of char read (from READ REST OF LINE) LD B,C ;B=count of bytes to write CALL A63288 ;FILL LINE BUFFER WITH SPACES START AT HL POP BC ;restore C=# char replaced by with spaces POP HL ;restore HL=line buffer start address LD A,32 LD (OLDCHAR_),A ;old character=space JP WRITE_VRAM ;Fn78: WRITE VRAM ;*************************************************************************** ;READ REST OF CURRENT LINE FROM VRAM INTO LINE BUFFER subroutine. ; On exit, C=number of characters between the cursor and the physical end ; of the line, and the line buffer contains those characters. A63353: LD HL,(CURSOR) ;L=cursor line, H=cursor column LD A,(X_MAX) ;A=X max INC A SUB H ;A=number of columns to fill with spaces LD C,A ;in C CALL A63484 ;GET VRAM ADDR OF CURRENT CURSOR X,Y IN DE LD HL,LINEBUFFER_ ;HL=address of line buffer LD B,0 ;BC=C (count of bytes to read) PUSH BC PUSH HL PUSH DE CALL READ_VRAM ;Fn79: READ VRAM POP DE POP HL POP BC RET ;*************************************************************************** ;SCROLL UP 1 LINE subroutine. ; On exit, the cursor is positioned at the lower left corner of the screen. A63380: CALL A63447 ;DISPLAY OLD CHARACTER ON SCREEN subrt LD HL,(UPPER_LEFT) ;L=line of upper left corner, H=column PUSH HL ;save upper left corner coordinates ;this is where we start copying to CALL A63484 ;GET VRAM ADDR OF CURRENT CURSOR X,Y IN DE POP HL ;get back upper left corner coordinates LD A,(NUM_LINES) ;A=number of lines LD B,A ;in B DEC B ;one less for count A63396: PUSH BC ;save count PUSH DE ;save VRAM address INC L ;point to next line for source PUSH HL ;save new source cursor coordinates ;this is where we copy from CALL A63484 ;GET VRAM ADDR OF CURRENT CURSOR X,Y IN DE PUSH DE ;save new source VRAM address LD A,(NUM_COLUMNS) ;A=number of columns LD C,A ;in C LD B,0 ;BC=C (count of columns to read) PUSH BC ;save it LD HL,LINEBUFFER_ ;HL=address of line buffer CALL READ_VRAM ;Fn79: READ VRAM (current line to move) POP BC ;restore BC=column read count POP DE ;restore DE=source VRAM address POP HL ;restore HL=source line coordinates EX (SP),HL ;save this on stack ;now HL=VRAM address of target line EX DE,HL ;DE=VRAM address of target line ;HL=source VRAM address PUSH HL ;save source VRAM address LD HL,LINEBUFFER_ ;HL=address of line buffer CALL WRITE_VRAM ;Fn78: WRITE VRAM (old line moved up 1) POP DE ;DE=source VRAM address ;this becomes target for next loop cycle POP HL ;HL=source line coordinates ;these become target for next loop cycle POP BC ;restore count of lines to erase DJNZ A63396 ;decrement it and keep going 'til done CALL A63292 ;FILL ENTIRE LINE BUFFER WITH SPACES subrt LD HL,LINEBUFFER_ ;HL=address of line buffer LD A,(NUM_COLUMNS) ;A=number of columns LD C,A ;B=0, so BC=A (number of bytes to write) JP WRITE_VRAM ;Fn78: WRITE VRAM (erase the last line) ;*************************************************************************** ;DISPLAY OLD CHARACTER ON SCREEN subroutine. ; This is also used to display any character in A by entry at A63450. A63447: LD A,(OLDCHAR_) ;A=old character A63450: PUSH HL LD HL,(CURSOR) ;L=cursor line, H=cursor column CALL A63484 ;GET VRAM ADDR OF CURRENT CURSOR X,Y IN DE LD HL,LINEBUFFER_ ;HL=address of line buffer LD (HL),A ;put A into line buffer LD BC,1 ;1 character to write CALL WRITE_VRAM ;Fn78: WRITE VRAM POP HL RET ;*************************************************************************** ;READ OLD CHARACTER AT CURRENT CURSOR X,Y subroutine. ; The result is stored at 65145. A63469: LD HL,(CURSOR) ;L=cursor line, H=cursor column A63472: CALL A63484 ;GET VRAM ADDR OF CURRENT CURSOR X,Y IN DE LD BC,1 ;1 byte to read LD HL,OLDCHAR_ ;HL=address of old character JP READ_VRAM ;Fn79: READ VRAM ;*************************************************************************** ;GET VRAM ADDRESS OF CURRENT CURSOR X,Y IN DE subroutine. ; On entry, H=current cursor column, L=current cursor line. On exit, DE= ; VRAM address of these coordinates in the name table. NOTE: To use this ; routine in 40-column text mode, it must be altered to multiply by 40 ; instead of 32. (E.g. save L*8 and then add it to L*32.) A63484: LD E,H ;save cursor column in E LD H,0 ;zero out L (HL=L) ADD HL,HL ;L*2 ADD HL,HL ;L*4 ADD HL,HL ;L*8 ADD HL,HL ;L*16 ADD HL,HL ;L*32 LD D,0 ;zero out D (DE=E=saved cursor column) ADD HL,DE ;HL=(32*cursor line)+cursor column LD DE,(PTRN_NAME_TBL) ;DE=VRAM address of name table ADD HL,DE ;HL=offset address EX DE,HL ;put it in DE RET ;*************************************************************************** ;DATA TABLE OF CONTROL CHARACTERS FOR SCREEN PRINTING. A63502: DB 08H ;backspace ^H (8) DB 0DH ;carriage return ^M (13) DB 0AH ;line feed ^J (10) DB 0CH ;form feed ^L (12) DB 80H ;home (128) DB 16H ;synchronous idle ^V (22) DB 18H ;cancel ^X (24) DB 1CH ;file separator ^\ (28) DB 0A0H ;up arrow (160) DB 0A2H ;down arrow (162) DB 0A3H ;left arrow (163) DB 0A1H ;right arrow (161) ;*************************************************************************** ;VECTOR TABLE FOR PROCESSING CONTROL CHARACTERS. ; *** Note that the vectors are in reverse order from the above table!! A63514: DW A63134 ;right arrow (161) DW A63161 ;left arrow (163) DW A63107 ;down arrow (162) DW A63091 ;up arrow (160) DW A63248 ;file separator ^\ (28) DW A63218 ;cancel ^X (24) DW A63212 ;synchronous idle ^V (22) DW A63203 ;home (128) DW A63188 ;form feed ^L (12) DW A63107 ;line feed ^J (10) DW A63076 ;carriage return ^M (13) DW A63161 ;backspace ^H (8) ;*************************************************************************** ;EOS Function 0: EOS START/INITIALIZATION. ; This routine is jumped to by a powerup boot program located in page 0 of ; the SmartWriter ROM. (When the Z80A CPU is reset, the program counter is ; forced to 0000, and execution begins there. ADAM is hardwired so that ; this accesses the SmartWriter ROM.) On entry, 8K of EOS have already ; been copied from the EOS ROM to the upper 32K of RAM (starting at 57344). ; The EOS ROM is still switched in as the lower 32K. Function 0 sets up ; the EOS stack, moves up the EOS data tables by 1 byte (why I don't know), ; sets the revision number byte to 5, gets the I/O ports from OS-7, turns ; off the sound, fills all 16K of VRAM with zeroes, then bank switches the ; lower 32K to RAM. After further setup, it tries to load a bootstrap ; program from either disk (1, then 2) or tape (1, then 2). If a boot is ; successfully loaded, the routine jumps to it at 51200; otherwise, the ; routine jumps to Function 61 (go to SmartWriter). Note that tape 1 and ; tape 2 share the same DCB, and the node type byte of the tape DCB shows ; whether tape 2 is available (hex 03) or not (hex 33). __EOS_START: LD SP,EOS_STACK ;SP points to top of EOS stack LD BC,327 ;number of bytes to move with LDIR LD DE,CLEAR_RAM_START+1 ;new start of EOS RAM table LD HL,CLEAR_RAM_START ;old start of EOS RAM table XOR A LD (HL),A ;zero out old start LDIR ;move old EOS RAM table to 64865-65192 ;this effectively scrambles any old EOS ;version which might have been in RAM LD A,5 LD (REV_NUM),A ;set EOS revision=5 CALL PORT_COLLECTION ;Fn75: GET I/O PORTS FROM OS-7 CALL TURN_OFF_SOUND ;Fn97: SOUND OFF LD A,0 ;character to fill VRAM=0 LD HL,0 ;fill from start of VRAM LD DE,16384 ;16K to fill CALL FILL_VRAM ;Fn82: FILL VRAM WITH 1 CHARACTER (in A) LD A,(MEM_CNFG01) ;A=memory configuration 1 ;lower 32K RAM, upper 32K RAM CALL SWITCH_MEM ;Fn76: BANK SWITCH MEMORY (to A) CALL __HARD_INIT ;*Fn15: HARD INITIALIZATION (COLD BOOT) LD DE,THREE1K_BLKS ;DE=start of DTA block (dir, file1, file2) LD HL,FCB_S ;HL=start of FCB block (0, 1, 2) CALL __FMGR_INIT ;*Fn46: INITIALIZE FILE MANAGER LD A,8 ; LD (CURRENT_DEV),A ;current device=tape 1 LD A,4 ;but let's try disk 1 anyway... CALL __REQUEST_STATUS ;*Fn26: REQUEST DEVICE (in A) STATUS JR NZ,A63622 ;disk 1 doesn't exist, so try disk 2 LD A,4 ;disk 1 available! CALL __FIND_DCB ;*Fn12/13: FIND/GET DCB ADDRESS (in IY) LD A,(IY+20) ;A=node type from DCB AND 15 ;zero out upper 4 bits (get lower nibble) CP 3 ;is it 3? LD A,4 ;restore device number JR C,A63688 ;less than 3 (OK), so let's read disk 1 A63622: LD A,5 ;3 or greater (error), so try disk 2 CALL __REQUEST_STATUS ;*Fn26: REQUEST DEVICE (in A) STATUS JR NZ,A63645 ;disk 2 doesn't exist either; try tape 1 LD A,5 ;disk 2 available! CALL __FIND_DCB ;*Fn12/13: FIND/GET DCB ADDRESS (in IY) LD A,(IY+20) ;A=node type from DCB AND 15 ;zero out upper 4 bits (get lower nibble) CP 3 ;is it 3? LD A,5 ;restore device number JR C,A63688 ;less than 3 (OK), so let's read disk 2 A63645: LD A,8 ;3 or greater (error), so let's try tapes CALL __REQUEST_STATUS ;*Fn26: REQUEST DEVICE (in A) STATUS JR NZ,A63682 ;no tape drives exist!! ;we have no recourse but SmartWriter... LD A,8 ;tapes available! CALL __FIND_DCB ;*Fn12/13: FIND/GET DCB ADDRESS (in IY) LD A,(IY+20) ;A=node type from DCB PUSH AF ;save it AND 15 ;zero out upper 4 bits (get lower nibble) CP 3 ;is it 3? JR C,A63685 ;less than 3 (OK), so let's read tape 1 POP AF ;3 or greater (error), so let's try tape 2 ;restore node type byte SRL A ;A/2 SRL A ;A/4 SRL A ;A/8 SRL A ;A/16 -- get high nibble CP 3 ;is it 3? LD A,24 ;device=tape 2 JR C,A63688 ;less than 3 (OK), so let's read tape 2 A63682: JP _GOTO_WP ;3 or greater (error), so ;Fn61: GO TO SmartWriter ;*************************************************************************** A63685: POP AF ;clear stack (if necessary) LD A,8 ;device 8=tape 1 A63688: LD (CURRENT_DEV),A ;current dev=A (enter here for other devs) A63691: LD HL,COLD_START_ADDR ;HL=data transfer area for boot program LD BC,0 ;hiword of block to read=0 LD A,(CURRENT_DEV) ;A=current device LD DE,0 ;loword of block to read=0 CALL __RD_1_BLK ;*Fn19: READ 1 BLOCK JP Z,A63727 ;read OK, so run the boot program at 51200 LD C,A ;read failed, so save error code in C LD A,(CURRENT_DEV) ;A=current device AND 15 ;zero out upper 4 bits of device number CP 8 ;is it a tape? (08h=tape 1, 18h=tape 2) JR NZ,A63691 ;NO, so try the read again (infinite loop) LD A,C ;YES, so get error code from C CP 155 ;is it 155? JR Z,A63691 ;YES, so try the read again JP A63682 ;NO, so roundabout jump to SmartWriter ;why not just JP _GOTO_WP? ;*************************************************************************** A63727: LD A,(CURRENT_DEV) ;A=current device LD B,A ;B=current device JP COLD_START_ADDR ;jump to block 0 program read in at 51200 ;*************************************************************************** ;EOS Function 15: HARD INITIALIZATION (COLD BOOT). ; Current PCB address is set to 65216. After a hard reset of ADAMnet, the ; old PCB, DCBs, and RESERVED_BYTE are zeroed out (addresses 65216-65535). ; The Z80A and master 6801 clocks are synchronized, and ADAMnet is scanned ; for devices, creating new DCBs as active devices are found. __HARD_INIT: PUSH BC PUSH DE PUSH HL PUSH IY LD HL,PCB ;HL=address of PCB LD (CURRENT_PCB),HL ;save it in RAM CALL __HARD_RESET_NET ;*Fn16: HARD RESET ADAMnet CALL __DLY_AFT_HRD_RES ;*Fn4: DELAY AFTER HARD RESET LD HL,PCB ;HL=current PCB address LD DE,PCB+1 ;DE=new PCB address LD BC,319 ;count of bytes to wipe LD (HL),0 ;zero out old PCB status byte LDIR ;wipe RAM by sequential copy of zeroes A63764: CALL __SYNC ;*Fn43: SYNCH Z80A & MASTER 6801 CLOCKS JR NZ,A63764 ;synch failed, but keep trying CALL __SCAN_ACTIVE ;*Fn30: SCAN ADAMnet FOR DEVICES POP IY POP HL POP DE POP BC RET ;*************************************************************************** ;EOS Function 31: SOFT INITIALIZATION (WARM BOOT). ; On entry, HL=new PCB address. This routine is like Function 15 (cold ; boot) with two exceptions. First, the new PCB address is supplied on ; entry, not automatically set to 65216. Second, it zeroes out the PCB ; and the DCBs, but *not* the RESERVED_BYTE (65535). The significance of ; this latter difference is not clear. __SOFT_INIT: PUSH BC PUSH DE PUSH HL PUSH IY LD (CURRENT_PCB),HL ;save new PCB address=HL CALL __HARD_RESET_NET ;*Fn16: HARD RESET ADAMnet CALL __DLY_AFT_HRD_RES ;*Fn4: DELAY AFTER HARD RESET LD HL,(CURRENT_PCB) ;HL=current PCB address LD E,L LD D,H ;DE=HL=current PCB address INC DE ;new PCB address=1 above old LD BC,318 ;count of bytes to move LD (HL),0 ;zero out first byte of old PCB LDIR ;wipe RAM by sequential copy of zeroes A63805: CALL __SYNC ;*Fn43: SYNCH Z80A & MASTER 6801 CLOCKS JR NZ,A63805 ;synch failed, but keep trying CALL __SCAN_ACTIVE ;*Fn30: SCAN ADAMnet FOR DEVICES POP IY POP HL POP DE POP BC RET ;*************************************************************************** ;EOS Function 16: HARD RESET ADAMnet. ; Sends 15 out the reset port (63), waits a bit, then sends 0. __HARD_RESET_NET: LD A,(NET_RESET_PORT) ;A=ADAMnet reset port (63) LD C,A ;save it in C LD A,15 OUT (C),A ;send 15 out port 63 LD A,0 ;A=0 A63829: NOP NOP NOP ;delay a bit DEC A ;A=255,254,253,... JR NZ,A63829 ;wait for 256 idle loop cycles XOR A ;A=0 OUT (C),A ;send 0 out port 63 RET ;*************************************************************************** ;EOS Function 4: DELAY AFTER HARD RESET. ; This do-nothing loop seem unnecessarily complicated, but its complexity ; is probably due to its history. The necessary delay time was probably ; determined empirically, and this programming structure allows loops of ; varying lengths to be constructed simply by changing B and DE. __DLY_AFT_HRD_RES: PUSH BC PUSH DE LD B,1 ;1 time through big loop A63843: LD DE,1 ;DE=1 (make bigger for longer delay) A63846: DEC DE ;DE=0 (decrement counter) LD A,D OR E ;is DE=0? JR NZ,A63846 ;NO, so keep idling DJNZ A63843 ;YES, little loop done; is big loop done? POP DE ;NO, so exit POP BC RET ;*************************************************************************** ;EOS Function 43: SYNCHRONIZE Z80A and MASTER 6801 CLOCKS. ; On exit, ZF=1 and A=0 if synch was OK. If synch failed, ZF=0 and A=18 ; (SYNCH1 FAILED) or A=19 (SYNCH2 FAILED). __SYNC: PUSH IY PUSH HL PUSH BC PUSH DE LD IY,(CURRENT_PCB) ;IY=address of current PCB LD (IY+3),0 ;zero out device # byte of PCB LD (IY+0),1 ;request status of Z80A LD DE,0 ;DE=0 LD B,2 ;number of times through status read loop A63878: DEC DE ;DE=255,254,253,... LD A,D OR E ;is DE=0? JR NZ,A63893 ;NO, so read status LD DE,0 ;YES, so why reset it? DJNZ A63893 ;go through the read loop again LD A,18 ;A=18 (SYNCH1 FAILED error) OR A ;clear ZF JR A63941 ;exit error ;*************************************************************************** A63893: LD A,(IY+0) ;read processor status byte CP 129 ;is it 129? (in synch) JR NZ,A63878 ;NO, so keep polling until it is LD (IY+0),2 ;YES, so request master 6801 status LD DE,0 ;DE=0 LD B,2 ;number of times through status read loop A63909: DEC DE ;DE=255,254,253,... LD A,D OR E ;is DE=0? JR NZ,A63924 ;NO, so read status LD DE,0 ;YES, so why reset it? DJNZ A63924 ;go through the read loop again LD A,19 ;A=19 (SYNCH2 FAILED error) OR A ;clear ZF JR A63941 ;exit error ;*************************************************************************** A63924: LD A,(IY+0) ;read processor status byte CP 130 ;is it 130? (in synch) JR NZ,A63909 ;NO, so keep polling until it is PUSH IY ;save PCB address... POP HL ;in HL LD (IY+1),L LD (IY+2),H ;save PCB address in PCB XOR A ;A=0, ZF=1 for OK exit A63941: POP DE POP BC POP HL POP IY RET ;*************************************************************************** ;EOS Function 30: SCAN ADAMnet FOR DEVICES. ; All DCBs are zeroed. The device count in the PCB is zeroed. ADAMnet ; is scanned for devices 1-15. If the device is active (status=128), a ; new 21-byte DCB is allocated, and the PCB device count is incremented. ; Otherwise, scanning continues. On exit, PCB byte 3 has the number of ; active devices, and the DCBs follow consecutively. Note: tape 1 ; (device 8) and tape 2 (device 24) share the same DCB. __SCAN_ACTIVE: PUSH BC PUSH DE PUSH HL PUSH IY PUSH IX LD HL,(CURRENT_PCB) ;HL=address of current PCB LD DE,4 ADD HL,DE ;offset to start of DCB space LD E,L LD D,H ;DE=DCB start address... INC DE ;plus 1 LD BC,314 ;count of bytes to wipe LD (HL),0 ;zero out old first byte LDIR ;wipe RAM by sequential copy of zeroes LD IY,(CURRENT_PCB) ;IY=address of current PCB LD DE,4 ADD IY,DE ;IY=DCB start address LD IX,(CURRENT_PCB) ;IX=address of current PCB LD (IX+3),1 ;add first device LD A,1 ;device #1=keyboard A63990: PUSH AF ;save it LD (IY+16),A ;byte 16 is device # LD (IY+0),1 ;request status of device A63998: BIT 7,(IY+0) ;is bit 7 set? (new status ready to read?) JR Z,A63998 ;NO, so keep waiting for status LD A,(IY+0) ;YES, so get status in A CP 128 ;is it 128? JR Z,A64022 ;YES, so add it to active list POP AF ;NO, restore device # INC A ;try next device CP 16 ;all done? (max 15) JR NZ,A63990 ;NO, so keep looking DEC (IX+3) ;YES, so adjust device count JR A64039 ;exit ;*************************************************************************** A64022: INC (IX+3) ;one more active device LD DE,21 ;length of DCB=21 ADD IY,DE ;offset to start of next DCB POP AF ;restore device # INC A ;try next device CP 16 ;all done? (max=15) JR NZ,A63990 ;NO, so keep looking DEC (IX+3) ;YES, so adjust device count A64039: POP IX POP IY POP HL POP DE POP BC RET ;*************************************************************************** ;EOS Function 25: RELOCATE PCB (to HL). ; On entry, HL=new address of PCB. __RELOC_PCB: PUSH IY LD IY,(CURRENT_PCB) ;IY=address of current PCB LD (IY+1),L LD (IY+2),H ;save new PCB address in old PCB LD (IY+0),3 ;request relocation A64063: LD A,(IY+0) ;read status CP 131 ;is it 131? (relocate finished) JR NZ,A64063 ;NO, so keep reading LD (CURRENT_PCB),HL ;YES, so save new PCB address POP IY RET ;*************************************************************************** ;EOS Function 14: GET PCB ADDRESS (in IY). ; On exit, IY=current PCB address. __GET_PCB_ADDR: LD IY,(CURRENT_PCB) ;IY=address of current PCB RET ;*************************************************************************** ;EOS Function 33: SOFT RESET KEYBOARD. __SOFT_RES_KBD: LD A,1 ;1=keyboard JR __SOFT_RES_DEV ;*Fn32: SOFT RESET DEVICE (in A) ;*************************************************************************** ;EOS Function 34: SOFT RESET PRINTER. __SOFT_RES_PR: LD A,2 ;2=printer JR __SOFT_RES_DEV ;*Fn32: SOFT RESET DEVICE (in A) ;*************************************************************************** ;EOS Function 35: SOFT RESET TAPE. __SOFT_RES_TAPE: LD A,8 ;8=tape 1/2 JR __SOFT_RES_DEV ;*Fn32: SOFT RESET DEVICE (in A) ;omit this! ;*************************************************************************** ;EOS Function 32: SOFT RESET DEVICE (in A). ; On entry, A=device number. On exit, A=128 and ZF=1 if device is reset ; and ready for use. ZF=0 if device doesn't exist or is busy. __SOFT_RES_DEV: PUSH IY CALL __FIND_DCB ;*Fn12/13: FIND/GET DCB ADDRESS (in IY) JR NZ,A64120 ;device doesn't exist; error exit CALL A62614 ;CHECK IF DEVICE (IN A) IS READY subrt JR NZ,A64120 ;in use, so error exit LD (IY+0),2 ;request reset of device (IY=DCB address) A64109: BIT 7,(IY+0) ;is status code ready to read yet? JR Z,A64109 ;NO (bit 7 clear) so keep waiting LD A,(IY+0) ;YES, so get status in A CP 128 ;it 128? (reset and ready for use) A64120: POP IY RET ;*************************************************************************** ;EOS Function 21: READ KEYBOARD STATUS BYTE. __RD_KBD_RET_CODE: LD A,1 ;1=keyboard JR __RD_RET_CODE ;*Fn23: READ DEVICE (in A) STATUS BYTE ;*************************************************************************** ;EOS Function 22: READ PRINTER STATUS BYTE. __RD_PR_RET_CODE: LD A,2 ;2=printer JR __RD_RET_CODE ;*Fn23: READ DEVICE (in A) STATUS BYTE ;*************************************************************************** ;EOS Function 24: READ TAPE STATUS BYTE. __RD_TAPE_RET_CODE: LD A,8 ;8=tape 1/2 JR __RD_RET_CODE ;*Fn23: READ DEVICE (in A) STATUS BYTE ;omit this! ;*************************************************************************** ;EOS Function 23: READ DEVICE (in A) STATUS BYTE. ; On entry, A=device number. On exit, if the device does not exist, ZF=0. ; Otherwise, ZF=1 and A=status byte from DCB. __RD_RET_CODE: PUSH IY CALL __FIND_DCB ;*Fn12/13: FIND/GET DCB ADDRESS (in IY) JR NZ,A64145 ;device dosn't exist; error exit LD A,(IY+0) ;A=status byte A64145: POP IY RET ;*************************************************************************** ;EOS Function 61: GO TO SmartWriter. ; Bank switches to the SmartWriter ROM, then jumps to the first byte of ; code at address 256. __GOTO_WP: LD A,(MEM_CNFG00) ;A=memory configuration 0 ;lower 32K=SmartWriter ROM, upper 32K=RAM CALL SWITCH_MEM ;Fn76: BANK SWITCH MEMORY (to A) JP 256 ;jump to first byte of SmartWriter code ;*************************************************************************** ;EOS Function 62: READ EOS. ; Not implemented in EOS-5. Presumably this routine was intended to read ; in a fresh copy of the current operating system from the EOS ROM (which ; can hold up to 4 different 8K EOS versions). A user program not needing ; EOS routines could use the space for itself, then restore EOS when done. ; Perhaps. __READ_EOS: RET ; Note added 9508.08: the EOS6 source has the following interesting note, ; followed by a block of commented-out code. Here are both note and code ; in their entirety: ; CODE FROM HERE TO END OF EOS_UTIL WAS INSERTED AFTER THE ; REV. 06 ROM WAS BURNED. IT HAS BEEN COMMENTED OUT TO MAINTAIN ; COMPATIBILITY WITH THAT ROM. ; ; END ; ;EOS_CODE_START EQU 00800H ;EOS_SIZE EQU 02000H-800H ;EOS_DEST EQU 0E000H+800H ; ; LD A,0 ;BANK SWITCH IN THE BOOT ROMS ; OUT (7FH),A ; (I HOPE) ; ; LD HL,EOS_CODE_START ;WHERE DOES EOS SIT IN BOOT ROMS ; LD DE,EOS_DEST ;WHERE EOS GOES ; LD BC,EOS_SIZE ;HOW BIG EOS IS ; LDIR ;MOVE EOS INTO PLACE ; ; LD A,3 ;BANK SWITCH IN OS_7 ; OUT (7FH),A ; (I KNOW) ; ; RET ; The amazing things about this code are that ; (1) it doesn't copy all of EOS (it skips the first 2048 bytes); ; (2) if it's supposed to be copying EOS-5, it starts in the middle of the ; file I/O routines (address 59392); ; (3) it ends by bank-switching in OS-7/24K RAM for the low 32K. ; The only possible explanations are that ; (1) it's a hook for Super Games, which need EOS block I/O routines, ; but which use OS-7 for video and sound; or ; (2) it's expecting an ADAM with a different version of EOS in ROM. ; EOS-7 is almost but not quite 2K shorter than EOS-5; perhaps it ; was anticipated that it would be shorter in the release version. ;*************************************************************************** ;EOS Function 19: READ 1 BLOCK. ; On entry, A=device number, BCDE=block number to read (BC=hiword, DE= ; loword), HL=data transfer address (DTA). On exit, ZF=1 if read was ; successful, ZF=0 if not. __RD_1_BLK: PUSH IY PUSH AF ;save device # CALL __START_RD_1_BLOCK ;*Fn38: START READ 1 BLOCK JR NZ,A64173 ;start failed, error exit ZF=0 A64166: POP AF ;restore device # PUSH AF ;save it again CALL __END_RD_1_BLOCK ;*Fn7: END READ 1 BLOCK JR NC,A64166 ;not done reading, so keep waiting A64173: POP IY ;we're done, so pop AF off stack without ;destroying current flags POP IY RET ;*************************************************************************** ;EOS Function 44: WRITE 1 BLOCK. ; On entry, A=device number, BCDE=block number to write (BC=hiword, DE= ; loword), HL=data transfer address (DTA). On exit, ZF=1 if write was ; successful, ZF=0 and A=error code if not. __WR_1_BLOCK: PUSH IY PUSH AF ;save device # CALL __START_WR_1_BLOCK ;*Fn41: START WRITE 1 BLOCK JR NZ,A64193 ;start failed, error exit ZF=0 A64186: POP AF ;restore device # PUSH AF ;save it again CALL __END_WR_1_BLOCK ;*Fn10: END WRITE 1 BLOCK JR NC,A64186 ;not done writing, so keep waiting A64193: POP IY ;we're done, so pop AF off stack without ;destroying current flags POP IY RET ;*************************************************************************** ;EOS Function 38: START READ 1 BLOCK. ; On entry, A=device number, BCDE=block number to read (BC=hiword, DE= ; loword), HL=data transfer address (DTA). On exit, ZF=1 if start was ; successful, ZF=0 and A=error code (1=NON-EXISTENT DEVICE, 2=DEVICE NOT ; READY) if not. __START_RD_1_BLOCK: PUSH BC PUSH DE PUSH HL PUSH IY CALL __FIND_DCB ;*Fn12/13: FIND/GET DCB ADDRESS (in IY) JR NZ,A64220 ;device doesn't exist, error exit ZF=0 CALL A62614 ;CHECK IF DEVICE (IN A) IS READY subrt JR NZ,A64220 ;device not ready, so error exit ZF=0 CALL A64312 ;SET UP DCB FOR I/O OPERATION subrt LD (IY+0),4 ;request read A64220: POP IY POP HL POP DE POP BC RET ;*************************************************************************** ;EOS Function 7: END READ 1 BLOCK. ; On entry, A=device number. On exit, CF=1 if the I/O attempt has ended, ; with ZF=1 for ended successfully, ZF=0 for I/O error. If I/O is still ; in progress, CF=0. Error codes in A may be 1=NON-EXISTENT DEVICE, 3= ; I/O NOT DONE. (Exit from bit 7 clear test has A=0, which usually means ; OK.) __END_RD_1_BLOCK: PUSH IY CALL __FIND_DCB ;*Fn12/13: FIND/GET DCB ADDRESS (in IY) SCF ;set CF JR NZ,A64252 ;device doesn't exist, error exit ZF=0 CALL A62638 ;CHECK IF DEVICE I/O IS DONE subroutine JR NZ,A64252 ;I/O not done, so error exit ZF=0, CF=0 OR A ;I/O done, CF=0 (already clear from subrt) BIT 7,(IY+0) ;is bit 7 of DCB status byte set? JR Z,A64252 ;NO, so error exit ZF=1, CF=0 LD A,(IY+0) ;A=status byte CP 128 ;is it 128? (successfully ended) SCF ;set CF A64252: POP IY RET ;*************************************************************************** ;EOS Function 41: START WRITE 1 BLOCK. ; On entry, A=device number, BCDE=block number to write (BC=hiword, DE= ; loword), HL=data transfer address (DTA). On exit, ZF=1 if start was ; successful, ZF=0 and A=error code if not. __START_WR_1_BLOCK: PUSH BC PUSH DE PUSH HL PUSH IY CALL __FIND_DCB ;*Fn12/13: FIND/GET DCB ADDRESS (in IY) JR NZ,A64277 ;device doesn't exist, error exit ZF=0 CALL A62614 ;CHECK IF DEVICE (IN A) IS READY subrt JR NZ,A64277 ;device not ready, so error exit ZF=0 CALL A64312 ;SET UP DCB FOR I/O OPERATION subrt LD (IY+0),3 ;request write A64277: POP IY POP HL POP DE POP BC RET ;*************************************************************************** ;EOS Function 10: END WRITE 1 BLOCK. ; On entry, A=device number. On exit, CF=1 if the I/O attempt has ended, ; with ZF=1 if successful, ZF=0 for I/O error. If I/O is still in progress, ; CF=0. Error codes in A may be 1=NON-EXISTENT DEVICE, 3=I/O NOT DONE. ; (Exit from bit 7 clear test has A=0, which usually means OK.) __END_WR_1_BLOCK: PUSH IY CALL __FIND_DCB ;*Fn12/13: FIND/GET DCB ADDRESS (in IY) SCF ;set CF JR NZ,A64309 ;device doesn't exist, so error exit ZF=0 CALL A62638 ;CHECK IF DEVICE I/O IS DONE subroutine JR NZ,A64309 ;I/O not done, so error exit ZF=0, CF=0 OR A ;I/O done, CF=0 (already cleared by subrt) BIT 7,(IY+0) ;is bit 7 of DCB status byte set? JR Z,A64309 ;NO, so error exit ZF=1, CF=0 LD A,(IY+0) ;A=status byte CP 128 ;is it 128? (successfully ended) SCF ;set CF A64309: POP IY RET ;*************************************************************************** ;SET UP DCB FOR I/O OPERATION subroutine. ; On entry, A=device #, BCDE=block number to access (BC=hiword, DE=loword), ; HL=data transfer address (DTA), IY=DCB address. The transfer buffer ; length (DCB bytes 4-3) is set to the maximum length (bytes 18-17). BCDE ; is copied to bytes 8-5, HL is copied to bytes 2-1. While byte 3 is set ; to the device number, byte 9 contains the upper nibble of the device ; number. This is how one DCB is made to function for both tape 1 (device ; hex 08) and tape 2 (device hex 18). Note, however, that disk 1 and disk ; 2 have separate DCBs. A64312: PUSH AF ;save device # SRL A ;A/2 SRL A ;A/4 SRL A ;A/8 SRL A ;A/16 new A=upper nibble of entry A LD (IY+9),A ;put it in the DCB LD A,(IY+17) ;lobyte maximum buffer length... LD (IY+3),A ;...is lobyte DTA length LD A,(IY+18) ;hibyte maximum buffer length... LD (IY+4),A ;...is hibyte DTA length LD (IY+5),E ;loword,lobyte of block number=E LD (IY+6),D ;loword,hibyte=D LD (IY+7),C ;hiword,lobyte=C LD (IY+8),B ;hiword,hibyte=B LD (IY+1),L ;loword DTA start=L LD (IY+2),H ;hiword DTA start=H POP AF ;restore device # RET ;*************************************************************************** ;UNUSED EOS FUNCTION: READ FROM CHARACTER DEVICE (IN A). ; This routine is not found in the jump table, though whether by intention ; (i.e., it doesn't work) or oversight I don't know. It is the complement ; to Function 45 (write character device (in A)). On entry, A=device ; number, DE=buffer start address, BC=buffer length. On exit, ZF=1 and A=0 ; if read successful, ZF=0 and A=error code (1,2,3) if not. A64356: LD (DEVICE_ID),A ;device number=A CALL __START_RD_CH_DEV ;Fn39: START READ CHARACTER DEVICE (in A) JR NZ,A64372 ;read failed, so EXIT ZF=0 (try RET NZ?) A64364: LD A,(DEVICE_ID) ;restore device number in A CALL __END_RD_CH_DEV ;Fn8: END READ CHARACTER DEVICE (in A) JR NC,A64364 ;not done yet, so keep reading A64372: RET ;*************************************************************************** ;EOS Function 45: WRITE CHARACTER DEVICE (in A). ; On entry, A=device number, HL=buffer start address, BC=buffer length. ; On exit, ZF=1 and A=0 if write was successful, ZF=0 and A=error code ; (1,2,3) if not. __WR_CH_DEV: LD (DEVICE_ID),A ;device number=A CALL __START_WR_CH_DEV ;*Fn42: start write character dev (in A) JR NZ,A64389 ;write failed, so EXIT ZF=0 (try RET NZ?) A64381: LD A,(DEVICE_ID) ;restore device number in A CALL __END_WR_CH_DEV ;*Fn10: END WRITE CHARACTER DEVICE (in A) JR NC,A64381 ;not done yet, so keep writing A64389: RET ;*************************************************************************** ;EOS Function 39: START READ CHARACTER DEVICE (in A). ; On entry, A=device number, DE=buffer start address, BC=buffer length. ; On exit, ZF=1 and A=0 if start was OK. Otherwise, ZF=0 and A=error code ; (1,2). __START_RD_CH_DEV: PUSH IY CALL __FIND_DCB ;*Fn12/13: FIND/GET DCB ADDRESS (in IY) JR NZ,A64418 ;device doesn't exist, error exit ZF=0 CALL A62614 ;CHECK IF DEVICE (IN A) IS READY subrt JR NZ,A64418 ;device not ready, so error exit ZF=0 LD (IY+1),E ;device ready! now set up DCB LD (IY+2),D ;buffer start address=DE LD (IY+3),C LD (IY+4),B ;buffer length=BC LD (IY+0),4 ;request read A64418: POP IY RET ;*************************************************************************** ;EOS Function 8: END READ CHARACTER DEVICE (in A). ; On entry, A=device number. On exit, CF=1 if the I/O attempt has ended, ; with ZF=1 for ended successfully, ZF=0 for I/O error. If I/O is still ; in progress, CF=0. Error codes in A may be 1=NON-EXISTENT DEVICE, 3= ; I/O NOT DONE. (Exit from bit 7 clear test has A=0, which usually means ; OK.) __END_RD_CH_DEV: PUSH IY CALL __FIND_DCB ;*Fn12/13: FIND/GET DCB ADDRESS (in IY) SCF ;set CF JR NZ,A64447 ;device doesn't exist, exit ZF=0, CF=1 CALL A62638 ;CHECK IF DEVICE I/O IS DONE subroutine JR NZ,A64447 ;not done, so error exit ZF=0, CF=0 OR A ;clear CF (already cleared by DONE subrt) BIT 7,(IY+0) ;is bit 7 of status byte set? JR Z,A64447 ;NO, so error exit ZF=1, CF=0 LD A,(IY+0) ;YES, so get status byte in A CP 128 ;is it 128? (end successful) SCF ;set CF A64447: POP IY RET ;*************************************************************************** ;EOS Function 42: START WRITE CHARACTER DEVICE (in A). ; On entry, A=device number, HL=buffer start address, BC=buffer length. ; On exit, ZF=1 and A=0 if start was OK. Otherwise, ZF=0 and A=error code ; (1,2). __START_WR_CH_DEV: PUSH IY CALL __FIND_DCB ;*Fn12/13: FIND/GET DCB ADDRESS (in IY) JR NZ,A64478 ;device doesn't exist, so error exit ZF=0 CALL A62614 ;CHECK IF DEVICE (IN A) IS READY subrt JR NZ,A64478 ;device not ready, so error exit ZF=0 LD (IY+3),C ;device ready! now set up DCB LD (IY+4),B ;buffer length=BC LD (IY+1),L LD (IY+2),H ;buffer start=HL LD (IY+0),3 ;request write A64478: POP IY RET ;*************************************************************************** ;EOS Function 11: END WRITE CHARACTER DEVICE (in A). ; On entry, A=device number. On exit, CF=1 if the I/O attempt has ended, ; with ZF=1 for ended successfully, ZF=0 for I/O error. If I/O is still ; in progress, CF=0. Error codes in A may be 1=NON-EXISTENT DEVICE, 3= ; I/O NOT DONE. (Exit from bit 7 clear test has A=0, which usually means ; OK.) __END_WR_CH_DEV: PUSH IY CALL __FIND_DCB ;*Fn12/13: FIND/GET DCB ADDRESS (in IY) SCF ;set CF JR NZ,A64507 ;device doesn't exist, exit ZF=0, CF=1 CALL A62638 ;CHECK IF DEVICE I/O IS DONE subroutine JR NZ,A64507 ;not done, so error exit ZF=0, CF=0 OR A ;clear CF (already cleared by DONE subrt) BIT 7,(IY+0) ;is bit 7 of status byte set? JR Z,A64507 ;NO, so error exit ZF=1, CF=0 LD A,(IY+0) ;get status byte CP 128 ;is it 128? (end successful) SCF ;set CF A64507: POP IY RET ;*************************************************************************** ;UNUSED DATA? A64510: DB 255 ;*************************************************************************** EOS_GLB_TBL: ;*************************************************************************** ;INTERRUPT VECTOR TABLE. ; This table is used to set up page zero during the powerup boot routine ; found in the SmartWriter ROM. INT_VCTR_TBL: VECTOR_08H: RET ;RST 08H DW 0 VECTOR_10H: RET ;RST 10H DW 0 VECTOR_18H: RET ;RST 18H DW 0 VECTOR_20H: RET ;RST 20H DW 0 VECTOR_28H: RET ;RST 28H DW 0 VECTOR_30H: RET ;RST 30H DW 0 VECTOR_38H: RET ;RST 38H ;shouldn't this be RETI? DW 0 VECTOR_66H: RETN ;NMI routine DB 0 ;*************************************************************************** ;MEMORY CONFIGURATION TABLE: ; In order to select the SmartWriter ROM, an OUT (63),0 must be executed ; first. To select the EOS ROM, use OUT (63),2. SWITCH_TABLE: ; lower 32K upper 32K MEM_CNFG00: DB 0 ;SmartWriter or EOS RAM MEM_CNFG01: DB 1 ;RAM RAM MEM_CNFG02: DB 2 ;expansion RAM RAM MEM_CNFG03: DB 3 ;OS-7 plus 24K RAM RAM MEM_CNFG04: DB 4 ;SmartWriter or EOS expansion ROM MEM_CNFG05: DB 5 ;RAM expansion ROM MEM_CNFG06: DB 6 ;expansion RAM expansion ROM MEM_CNFG07: DB 7 ;OS-7 plus 24K RAM expansion ROM MEM_CNFG08: DB 8 ;SmartWriter or EOS expansion RAM MEM_CNFG09: DB 9 ;RAM expansion RAM MEM_CNFG0A: DB 10 ;expansion RAM expansion RAM MEM_CNFG0B: DB 11 ;OS-7 plus 24K RAM expansion RAM MEM_CNFG0C: DB 12 ;SmartWriter or EOS cartridge ROM MEM_CNFG0D: DB 13 ;RAM cartridge ROM MEM_CNFG0E: DB 14 ;expansion RAM cartridge ROM MEM_CNFG0F: DB 15 ;OS-7 plus 24K RAM cartridge ROM ;*************************************************************************** ;I/O PORTS. PORT_TABLE: MEM_SWITCH_PORT: DB 7FH ;memory switch port (127) NET_RESET_PORT: DB 3FH ;ADAMnet reset port (63) VDP_CTRL_PORT: DB 0BFH ;VDP control port (191) VDP_DATA_PORT: DB 0BEH ;VDP data port (190) CONTROLLER_0_PORT: DB 0FCH ;game controller 1 port (252) CONTROLLER_1_PORT: DB 0FFH ;game controller 2 port (255) STROBE_SET_PORT: DB 80H ;strobe set port (128) STROBE_RESET_PORT: DB 0C0H ;strobe reset port (192) SOUNDPORT: DB 0FFH ;sound port (255) ;*************************************************************************** ;EOS JUMP TABLE: EOS FUNCTIONS 0-100. ; Function names (with modification) from "The Hacker's Guide to ADAM ; Volume I" by Peter and Ben Hinkle (1986). ; Function labels from Coleco's EOS6 source code. EOS_JMP_TBL: _EOS_START: JP __EOS_START ;0 EOS START/INITIALIZATION _CONS_DISP: JP __CONS_DISP ;1 CONSOLE DISPLAY OF NON-CONTROL CHAR (in A) _CONS_INIT: JP __CONS_INIT ;2 CONSOLE INITIALIZATION _CONS_OUT: JP __CONS_OUT ;3 DISPLAY CHAR (in A) ON SCREEN (CTRL OR NOT) _DLY_AFT_HRD_RES: JP __DLY_AFT_HRD_RES ;4 DELAY AFTER HARD RESET _END_PR_BUFF: JP __END_PR_BUFF ;5 END PRINT BUFFER (at HL) _END_PR_CH: JP __END_PR_CH ;6 END PRINT CHARACTER (in A) _END_RD_1_BLOCK: JP __END_RD_1_BLOCK ;7 END READ 1 BLOCK _END_RD_CH_DEV: JP __END_RD_CH_DEV ;8 END READ CHARACTER DEVICE (in A) _END_RD_KBD: JP __END_RD_KBD ;9 END READ KEYBOARD _END_WR_1_BLOCK: JP __END_WR_1_BLOCK ;10 END WRITE 1 BLOCK _END_WR_CH_DEV: JP __END_WR_CH_DEV ;11 END WRITE CHARACTER DEVICE (in A) _FIND_DCB: JP __FIND_DCB ;12 FIND DCB _GET_DCB_ADDR: JP __GET_DCB_ADDR ;13 GET DCB ADDRESS (in IY) _GET_PCB_ADDR: JP __GET_PCB_ADDR ;14 GET PCB ADDRESS (in IY) _HARD_INIT: JP __HARD_INIT ;15 HARD INITIALIZATION (COLD BOOT) _HARD_RESET_NET: JP __HARD_RESET_NET ;16 HARD RESET ADAMnet _PR_BUFF: JP __PR_BUFF ;17 PRINT BUFFER (at HL) _PR_CH: JP __PR_CH ;18 PRINT CHARACTER (in A) _RD_1_BLOCK: JP __RD_1_BLK ;19 READ 1 BLOCK _RD_KBD: JP __RD_KBD ;20 READ KEYBOARD _RD_KBD_RET_CODE: JP __RD_KBD_RET_CODE ;21 READ KEYBOARD STATUS BYTE _RD_PR_RET_CODE: JP __RD_PR_RET_CODE ;22 READ PRINTER STATUS BYTE _RD_RET_CODE: JP __RD_RET_CODE ;23 READ DEVICE (in A) STATUS BYTE _RD_TAPE_RET_CODE: JP __RD_TAPE_RET_CODE ;24 READ TAPE STATUS BYTE _RELOC_PCB: JP __RELOC_PCB ;25 RELOCATE PCB (to HL) _REQUEST_STATUS: JP __REQUEST_STATUS ;26 REQUEST DEVICE (in A) STATUS _REQ_KBD_STAT: JP __REQ_KBD_STAT ;27 REQUEST KEYBOARD STATUS _REQ_PR_STAT: JP __REQ_PR_STAT ;28 REQUEST PRINTER STATUS _REQ_TAPE_STAT: JP __REQ_TAPE_STAT ;29 REQUEST TAPE STATUS _SCAN_ACTIVE: JP __SCAN_ACTIVE ;30 SCAN ADAMnet FOR DEVICES _SOFT_INIT: JP __SOFT_INIT ;31 SOFT INITIALIZATION (WARM BOOT) _SOFT_RES_DEV: JP __SOFT_RES_DEV ;32 SOFT RESET DEVICE (in A) _SOFT_RES_KBD: JP __SOFT_RES_KBD ;33 SOFT RESET KEYBOARD _SOFT_RES_PR: JP __SOFT_RES_PR ;34 SOFT RESET PRINTER _SOFT_RES_TAPE: JP __SOFT_RES_TAPE ;35 SOFT RESET TAPE _START_PR_BUFF: JP __START_PR_BUFF ;36 START PRINT BUFFER (at HL) _START_PR_CH: JP __START_PR_CH ;37 START PRINT CHARACTER (in A) _START_RD_1_BLOCK: JP __START_RD_1_BLOCK ;38 START READ 1 BLOCK _START_RD_CH_DEV: JP __START_RD_CH_DEV ;39 START READ CHARACTER DEVICE (in A) _START_RD_KBD: JP __START_RD_KBD ;40 START READ KEYBOARD _START_WR_1_BLOCK: JP __START_WR_1_BLOCK ;41 START WRITE 1 BLOCK _START_WR_CH_DEV: JP __START_WR_CH_DEV ;42 START WRITE CHARACTER DEVICE (in A) _SYNC: JP __SYNC ;43 SYNCHRONIZE Z80A AND MASTER 6801 CLOCKS _WR_1_BLOCK: JP __WR_1_BLOCK ;44 WRITE 1 BLOCK _WR_CH_DEV: JP __WR_CH_DEV ;45 WRITE CHARACTER DEVICE (in A) _FMGR_INIT: JP __FMGR_INIT ;46 INITIALIZE FILE MANAGER _INIT_TAPE_DIR: JP __INIT_TAPE_DIR ;47 INITIALIZE DIRECTORY _OPEN_FILE: JP __OPEN_FILE ;48 OPEN FILE _CLOSE_FILE: JP __CLOSE_FILE ;49 CLOSE FILE _RESET_FILE: JP __RESET_FILE ;50 RESET FILE _MAKE_FILE: JP __MAKE_FILE ;51 CREATE FILE _QUERY_FILE: JP __QUERY_FILE ;52 FIND FILE (WITH TYPE) _SET_FILE: JP __SET_FILE ;53 UPDATE DIRECTORY ENTRY _READ_FILE: JP __READ_FILE ;54 READ FILE _WRITE_FILE: JP __WRITE_FILE ;55 WRITE FILE _SET_DATE: JP __SET_DATE ;56 SET CURRENT DATE _GET_DATE: JP __GET_DATE ;57 GET CURRENT DATE _RENAME_FILE: JP __RENAME_FILE ;58 RENAME FILE _DELETE_FILE: JP __DELETE_FILE ;59 DELETE FILE _RD_DEV_DEP_STAT: JP __RD_DEV_DEP_STAT ;60 READ DEVICE (in A) NODE TYPE _GOTO_WP: JP __GOTO_WP ;61 GO TO SmartWriter _READ_EOS: JP __READ_EOS ;62 READ EOS [not implemented in EOS-5] _TRIM_FILE: JP __TRIM_FILE ;63 TRIM FILE _CHECK_FCB: JP __CHECK_FCB ;64 CHECK IF FILE IS OPEN _READ_BLOCK: JP __READ_BLOCK ;65 READ BLOCK _WRITE_BLOCK: JP __WRITE_BLOCK ;66 WRITE BLOCK _MODE_CHECK: JP __MODE_CHECK ;67 CHECK FILE I/O MODE _SCAN_FOR_FILE: JP __SCAN_FOR_FILE ;68 READ DIRECTORY FOR FILE _FILE_QUERY: JP __FILE_QUERY ;69 FIND FILE (NO TYPE) _POSIT_FILE: JP __POSIT_FILE ;70 POSITION FILE [not implemented in EOS-5] _EOS_1: JP __EOS_1 ;71 EOS1 [not implemented in EOS-5] _EOS_2: JP __EOS_2 ;72 EOS2 [not implemented in EOS-5] _EOS_3: JP __EOS_3 ;73 EOS3 [not implemented in EOS-5] _CV_A: JP __CV_A ;74 INCORRECT EOS VERSION ERROR PORT_COLLECTION: JP __PORT_COLLECTION ;75 GET I/O PORTS FROM OS-7 SWITCH_MEM: JP __SWITCH_MEM ;76 BANK SWITCH MEMORY (to A) PUT_ASCII: JP __PUT_ASCII ;77 PUT ASCII CHARACTER PATTERN TO VDP WRITE_VRAM: JP __WRITE_VRAM ;78 WRITE VRAM READ_VRAM: JP __READ_VRAM ;79 READ VRAM WRITE_REGISTER: JP __WRITE_REGISTER ;80 WRITE VDP REGISTER 0-7 READ_REGISTER: JP __READ_REGISTER ;81 READ VDP REGISTER 8 FILL_VRAM: JP __FILL_VRAM ;82 FILL VRAM WITH 1 CHARACTER (in A) INIT_TABLE: JP __INIT_TABLE ;83 INITIALIZE VRAM TABLE PUT_VRAM: JP __PUT_VRAM ;84 PUT TABLE TO VRAM GET_VRAM: JP __GET_VRAM ;85 GET TABLE FROM VRAM CALC_OFFSET: JP __CALC_OFFSET ;86 CALCULATE OFFSET INTO SPRITE ATTRIB TABLE PX_TO_PTRN_POS: JP __PX_TO_PTRN_POS ;87 POINT TO PATTERN POSITION LOAD_ASCII: JP __LOAD_ASCII ;88 LOAD ASCII CHARACTER SET FROM ROM TO VDP WR_SPR_ATTRIBUTE: JP __WR_SPR_ATTRIBUTE ;89 WRITE VRAM SPRITE ATTRIBUTE TABLE POLLER: JP __POLLER ;90 READ GAME CONTROLLERS UPDATE_SPINNER: JP __UPDATE_SPINNER ;91 UPDATE SPINNER 1 AND 2 DECLSN: JP __DECLSN ;92 DECREMENT LOW NIBBLE OF (HL) DECMSN: JP __DECMSN ;93 DECREMENT HIGH NIBBLE OF (HL) MSNTOLSN: JP __MSNTOLSN ;94 HIGH NIBBLE OF (HL) TO LOW NIBBLE ADD816: JP __ADD816 ;95 ADD A TO WORD AT HL SOUND_INIT: JP __SOUND_INIT ;96 SOUND INITIALIZATION TURN_OFF_SOUND: JP __TURN_OFF_SOUND ;97 SOUND OFF PLAY_IT: JP __PLAY_IT ;98 START VOICE SOUNDS: JP __SOUNDS ;99 SOUND EFFECT_OVER: JP __EFFECT_OVER ;100 END SPECIAL EFFECT NOTE ;*************************************************************************** ;UNUSED DATA? DB 255 ;*************************************************************************** EOS_GLB_RAM: CLEAR_RAM_START: ;*************************************************************************** ;VIDEO AND MEMORY DATA. REV_NUM: DS 1 ;EOS revision number VDP_MODE_WORD: VDP_REG_0: DS 1 ;current contents of VDP register 0 VDP_REG_1: DS 1 ;current contents of VDP register 1 VDP_STATUS_BYTE: DS 1 ;VDP status byte VRAM_ADDR_TABLE: SPRITEATTRTBL: DS 2 ;VRAM address of sprite attribute table SPRITEGENTBL: DS 2 ;VRAM address of sprite generator table PATTRNNAMETBL: DS 2 ;VRAM address of pattern name table PATTRNGENTBL: DS 2 ;VRAM address of pattern generator table COLORTABLE: DS 2 ;VRAM address of color table CUR_BANK: DS 1 ;current memory configuration (from last bank switch) ;*************************************************************************** ;FILE CONTROL DATA. DEFAULT_BT_DEV: CURRENT_DEV: DS 1 ;current device number CURRENT_PCB: DS 2 ;address of current PCB DEVICE_ID: DS 1 ;device number FILE_NAME_ADDR: DS 2 ;address of filename string KEYBOARD_BUFFER: DS 1 ;keyboard buffer (last key pressed) PRINT_BUFFER: DS 16 ;printer buffer SECTORS_TO_INIT: DS 1 ;number of blocks to initialize SECTOR_NO: DS 4 ;block to initialize DCB_IMAGE: DS 21 ;DCB image [not used in EOS-5] QUERY_BUFFER: DS 26 ;query buffer FCB_BUFFER: DS 26 ;FCB buffer FILE_COUNT: DS 1 ;file count MOD_FILE_COUNT: DS 1 ;mod file count RETRY_COUNT: DS 1 ;retry count FILE_NUMBR: DS 1 ;file number FILENAME_CMPS: DS 1 ;file name comparison status byte ;(0=name and file type must match, anything ;else=only name must match) DIR_BLOCK_NO: DS 2 ;directory block number FOUND_AVAIL_ENT: DS 1 ;found entry status byte ;(1=matching entry found, 0 if not) BLK_STRT_PTR: VOL_BLK_SZ: DS 4 ;volume block size [not used in EOS-5] EOS_YEAR: DS 1 ;current file creation year EOS_MONTH: DS 1 ;current file creation month EOS_DAY: DS 1 ;current file creation day FMGR_DIR_ENT: DS 26 ;file manager directory entry [not used in EOS-5] FCB_HEAD_ADDR: DS 2 ;address of FCB0 (FCB1 offset 35, FCB2 offset 70) FCB_DATA_ADDR: DS 2 ;address of DTA0 (DTA1 offset 1024, DTA2 offset 2048) FNUM: DS 1 ;file number (01 or 02) BYTES_REQ: DS 2 ;bytes requested to read/write BYTES_TO_GO: DS 2 ;bytes left to read/write USER_BUF: DS 2 ;read/write buffer address BUF_START: DS 2 ;buffer start address BUF_END: DS 2 ;buffer end address BLOCKS_REQ: DS 4 ;file length in blocks USER_NAME: DS 2 ;filename string address START_BLOCK: DS 4 ;start block [not used in EOS-5] NEW_HOLE_START: DS 4 ;new hole start block NEW_HOLE_SIZE: DS 2 ;new hole size in blocks ;*************************************************************************** ;EOS STACK. STACK_START: DS 60 ;bottom to top of EOS stack EOS_STACK: ;*************************************************************************** ;GAME CONTROLLER DATA. ; This seemingly illogical setup was verified by examining SmartBASIC's ; PDL routines. "The Hacker's Guide to ADAM Volume I" is incorrect on ; this point--they are clearly following the ColecoVision Technical ; Manual here. The game controller data structures are different between ; EOS and OS-7. SPIN_SW0_CT: DS 1 ;spinner player 1 SPIN_SW1_CT: DS 1 ;spinner player 2 PERSONAL_DEBOUNCE_TABLE: DS 1 ;joystick player 2 DS 1 ;left button player 2 DS 1 ;right button player 2 DS 1 ;keypad player 2 DS 1 ;joystick player 1 DS 1 ;left button player 1 DS 1 ;right button player 1 DS 1 ;keypad player 1 ;*************************************************************************** ;TEMPORARY STACK USED BY FUNCTION 77: PUT ASCII CHARACTER TO VDP. DS 12 ;bottom to top -- at maximum usage, stack contains: ;65132-33 old stack pointer ;65130-31 old memory configuration and flags ;65128-29 return address 57726 after call to Fn78 ;65126-27 BC register saved by Fn78 ;65124-25 return addr 57349 after call to ENABLE VRAM WRITE ;65122-23 0000 (unused) TEMP_STACK: ;*************************************************************************** ;SOUND DATA. PTR_TO_LST_OF_SND_ADDRS: DS 2 ;address of voice table PTR_TO_S_ON_0: DS 2 ;address of noise output table PTR_TO_S_ON_1: DS 2 ;address of voice 1 output table PTR_TO_S_ON_2: DS 2 ;address of voice 2 output table PTR_TO_S_ON_3: DS 2 ;address of voice 3 output table SAVE_CTRL: DS 1 ;saved control sound ;*************************************************************************** ;VIDEO DISPLAY DATA. ; Note: SmartBASIC does not use this space, since it does not call EOS ; to display characters. OLDCHAR_: DS 1 ;old character (at current cursor position) X_MIN: DS 1 ;X min (column) X_MAX: DS 1 ;X max (column) Y_MIN: DS 1 ;Y min (line) Y_MAX: DS 1 ;Y max (line) LINEBUFFER_: DS 33 ;line buffer NUM_LINES: DS 1 ;number of lines NUM_COLUMNS: DS 1 ;number of columns UPPER_LEFT: DS 1 ;screen upper left corner line (Y) DS 1 ;screen upper left corner column (X) PTRN_NAME_TBL: DS 2 ;address of name table CURSOR: DS 1 ;current cursor position line (Y) DS 1 ;current cursor column (X) ;*************************************************************************** ;DATA UNUSED IN EOS-5. ; This space was reserved for future versions of EOS. Some of it is used ; in EOS-7. DB 0 DS 24 ;*************************************************************************** EOS_PCB_DCB: ;*************************************************************************** ;PROCESSOR CONTROL BLOCK (PCB). ; The PCB is a 4-byte block, usually at address 65216 but relocatable, used ; by the master 6801 ADAMnet controller to keep track of devices. PCB: DS 1 ;processor status byte DS 2 ;address of PCB start (65216) DS 1 ;number of active devices (number of DCBs) ; Reading byte 0 returns status information from ADAMnet; the meaning of ; individual status bits is uncertain. Writing to byte 0 requests the ; following operations: ;data function ; 1 synchronize the Z80 clock ; 2 synchronize the master 6801 clock ; 3 relocate PCB ;*************************************************************************** ;DEVICE CONTROL BLOCKS (DCBs). ; Each DCB is 21 bytes long, with a maximum of 15 devices, in ascending ; order of primary device number. (Device numbers may be greater than 15, ; however. See tape DCB.) The number of DCBs depends upon how many valid ; devices were attached to ADAMnet at startup. ;offset meaning ; 0 status byte ; 1-2 buffer start address (lobyte, hibyte) ; 3-4 buffer length (lobyte, hibyte) ; 5-8 block number accessed (loword, hiword in lobyte, hibyte format) ; 9 high nibble of device number ;10-15 always zero (unknown purpose) ; 16 device number ;17-18 maximum block length (lobyte, hibyte) ; 19 device type (0 for block device, 1 for character device) ; 20 node type (see Function 60 for details) ; Reading byte 0 returns status information from ADAMnet; the meaning of ; individual status bits is uncertain. Empirically, anything with bit 7 ; clear means that nothing has happened yet (the command is still being ; processed); 80h means success, 9Bh means timeout (i.e. there is no ; ADAMnet device corresponding to the device number you were trying to ; access), anything else is some kind of error or not-ready condition. ; Writing to byte 0 requests the following operations: ;data function ; 1 return current status ; 2 soft reset ; 3 write ; 4 read ; ADAMnet device numbers decode as follows: ;number device type ; 0 master 6801 ADAMnet controller - ; 1 keyboard 1 ; 2 ADAM printer 1 ; 3 Copywriter 1 ?? ; 4 disk drive 1 0 ; 5 disk drive 2 0 ; 6 disk drive 3 0 ; 7 disk drive 4 0 ; 8 tape drive 1 0 ; 9 tape drive 3 0 ; 10 -- unused -- - ; 11 Non-ADAMlink modem 1 ?? ; 12 Hi-resolution monitor 1 ?? ; 13 ADAM parallel interface 1 ; 14 ADAM serial interface 1 ; 15 Gateway ??? ; 24 tape drive 2 0 ; 25 tape drive 4 0 ; 26 expansion RAM disk drive - ;Device Notes: ; 0 The master 6801 uses the PCB as its DCB. ; 3 Projected dot matrix printer? ; 6,7 Third-party modified disk drive EPROMs to change ADAMnet device ; ID. ; 8,24 Tape 1 and tape 2 share the same DCB. ; 9,25 Projected. Tape3 and tape 4 would have shared the same DCB. ; 11,12 Projected but probably never designed or built. ; 13 The prototype ADAM parallel interface, never released. ; SmartBASIC 2.0 has routines to access it as PR #4. ; 14 The prototype ADAM serial interface, never released. Smart- ; BASIC 2.0 has routines to access it as IN #2 and PR #2. ; 15 This always appears as the last DCB, and always with a not- ; ready status (see __SCAN_ACTIVE code). Presumably would have ; been used to network ADAMs via ADAMnet. ; 26 Used as a third-party RAMdisk device ID. Not used by Coleco. ; Probably derived from an error in interpreting SmartBASIC 1.0's ; drive-to-device table. 1A hex is the first byte of code after ; the table, which only has entries for D1-D6. The fetch routine, ; however, accepts D7, so it returns code as data. ;*************************************************************************** DCBS: DS 15*21 ;DCBs ;*************************************************************************** RESERVED_BYTE: DS 1 ;reserved byte for "fast DMA" (unimplemented) ;This is the end of EOS (address 65535, 0FFFFh). ;*************************************************************************** ;EOS DIRECTORY STRUCTURE. ; Each entry consists of 26 bytes. Directories begin at block 1, and may ;be up to 255 blocks long. Entries for files have the following format: ;bytes 0-11 Filename specification. A valid filename consists of up to 10 ; characters, followed by a type byte, terminated with hex 03. ; The type byte can be A, a, H, or h (ASCII or hex, lowercase for ; backups). ; 12 File attribute. Set bits in the attribute byte map as follows: ; 0 not a file (used for BLOCKS LEFT) ; 1 execute protected (can't be opened for execution) ; 2 deleted file ; 3 system file (hidden from SmartBASIC CATALOG) ; 4 user file ; 5 read-protected ; 6 write-protected (read only) ; 7 delete protected ; 13-16 Start block. Stored loword, hiword. ; 17-18 Allocated length. Includes any unused "holes" which may be ; tacked on at the end. ; 19-20 Used length. Actual length of file, discounting unused "holes" ; at the end. ; 21-22 Number of bytes used in last allocated block of file. Thus, to ; compute file length in bytes, (allocated-used-1)*1024+lastbyte. ; 23 Creation year. There is no set rule for how to represent the ; year. One common method is (year-1900); thus 1987 would be hex ; 57. This wastes the values hex 00-53 (since ADAM appeared in ; 1983). I propose that these be interpreted as (year+2000). ; 24 Creation month. Range hex 01-0C. ; 25 Creation day. Range hex 01-1F. ; Four special entries are found in the directory of every EOS disk. The ;first three are always: ; VOLUME. bytes 0-11 volume name ; 12 attribute=hex 80 (delete protected) ; 13-16 hex 55AA00FF directory check for EOS format ; 17-18 disk size in blocks ; BOOT. bytes 0-11 BOOT ; 12 attribute=hex 88 (delete protected, system ; file) ; 17-18 allocated length=1 block ; 19-20 used length=1 block ; 21-22 lastbyte=0 (means 1024, i.e. the whole block) ; DIRECTORY. bytes 0-11 DIRECTORY ; 12 attribute=hex C8 (delete and write pretected, ; system file) ; 13-16 start block (default=1) ; 17-18 maximum size of directory in blocks ; 19-20 current size of directory in blocks ; The last entry of every directory in EOS-5 is: ; BLOCKS LEFT. bytes 0-11 BLOCKS LEFT ; 12 attribute=hex 01 (not a file) ; 13-16 first free block in largest contiguous ; cluster of free blocks at the end of the ; storage medium ; 17-18 total number of free blocks (contiguous or ; not) ; 19-20 used length always 0 ; 23-25 EOS version date=hex 570711 ; This date does not conform to the pattern ; described above. In "The Hacker's Guide To ; ADAM Vol. II", Ben Hinkle suggests that this ; should be read as 7/11/1957, perhaps the ; birthdate of one of the programmers. ; Note: EOS-7 does not use BLOCKS LEFT to keep track of free blocks. ;*************************************************************************** ;EOS FILE CONTROL BLOCK (FCB) STRUCTURE. ; EOS sets up areas of RAM to store data about open files, called file ;control blocks (FCBs). EOS-5 has 3 FCBs: 1 for the system, and 2 for user ;files (3 in EOS-7). FCBs are contiguous 35-byte blocks set up as follows: ; bytes 0-22 from EOS directory entry (no date bytes) ; 23 EOS device # using the FCB ; 24 I/O mode byte. The set bits are mapped as follows: ; 7 current block in buffer is the last block ; of the file ; 6 data in buffer is waiting to be written ; to the file. Makes EOS write the data ; before loading a new block into the buffer. ; 5 file won't reuse deleted file space ; 4 unused ; 3 unused ; 2 open for execute ; 1 open for write ; 0 open for read ; Bits 5,2,1,0 are set by the caller; bits 7,6 are set ; and used internally by EOS. Files can be opened for ; read, write, read-write or execute; an error results ; if read, write and execute are simultaneously set. ; 25-28 current block for I/O. Loword, hiword. ; 29-32 last block of file. Loword, hiword. ; 33-34 address of I/O buffer (DTA). This area is also used in ; EOS-7 by Fn70 (POSITION FILE) and Fn50 (RESET FILE) to ; store the byte offset into the current DTA. ; ;****************************************************************************** ;EOS ERROR CODES. ; These are returned in A with ZF=0 upon return after an error. I have ;selected likely names based upon what seems to be going wrong when they are ;issued. In some cases, I have provided alternate names which may be more ;meaningful or explanatory. The recently-obtained "ADAM Technical Manual" ;(Coleco, 1984) lists the actual assembly symbols used for these errors. ; code meaning Coleco symbol ; [0 No Error] --- ; 1 Non-Existent Device DCB_NOT_FOUND ; 2 Device Not Ready DCB_BUSY ; 3 I/O Not Done (I/O Not Over) DCB_IDLE_ERR ; 4 No Date Set NO_DATE_ERR ; 5 No More Directory (File Not Found) [Fn68] NO_FILE_ERR ; File Not Open [Fn64] ; 6 File Already Exists FILE_EXISTS_ERR ; 7 Too Many Open Files NO_FCB_ERR ; 8 Match Not Found MATCH_ERR ; 9 Bad File Number BAD_FNUM_ERR ; 10 I/O Past End EOF_ERR ; 11 File Too Big TOO_BIG_ERR ; 12 Directory Full FULL_DIR_ERR ; 13 No More Room (Disk Full) FULL_TAPE_ERR ; 14 Bad File Name FILE_NM_ERR ; 15 [unused; see error 5] RENAME_ERR ; 16 File Locked (File Write Protected) DELETE_ERR ; 17 Bad I/O Mode RANGE_ERR ; 18 Synch 1 Failed CANT_SYNC1 ; 19 Synch 2 Failed CANT_SYNC2 ; 20 File Access Denied PRT_ERR ; 21 [unknown, unimplemented] RQ_TP_STAT_ERR ; 22 I/O Error DEVICE_DEPD_ERR ; 23 Incorrect EOS Version PROG_NON_EXIST ; 24 Non-EOS Volume NO_DIR_ERR ;Error notes: ; 5,15 Due to a possible typographical error by a programmer, two ; different errors are allocated to 5, while 15 is unused. ; Since SmartBASIC treats 5 as "File Not Found", this suggests ; that "File Not Open" should have been 15. ; 7 SmartBASIC calls this "No Buffers Available". ; 12,13 SmartBASIC does not differentiate between these, lumping them ; both together as "No More Room". ; 20 PRT_ERR means "Protected Error". ; 21 RQ_TP_STAT_ERR means "Request Tape Status Error". It appears ; only in an orphaned code fragment. ; 22 DEVICE_DEPD_ERR means "Device-Dependent Error". ;***************************************************************************