*
*
*
 TITLE I/O PACKAGE FOR EPA INC. (C) 1977 SOFTWARE DYNAMICS
 NAM IOPACK
 TABS 12,21,39,40
 OPT WI=132,DE=66,LF
*
*
*
*
*  BY STEFAN DEMETRESCU
*  NEW DRIVERS CARE OF RICK GROS
*
EDITDATE EQU $A13 MMDD IN HEX FORMAT

**ASSEMBLY CONTROL STUFF
*
 PCC 1 PRINT ALL THE CONTROL CARDS
 PSR 1 PRINT ANY SKIPPED RECORDS
 PCA 1 PRINT CONDITIONAL ASSEMBLY STUFF
*
*
* SYSTEM CONSTANTS
*
*
XCLOSE EQU $EC24
KYSTAT EQU $E051
TDEBUG EQU $E018
KBDIN EQU $E003
*
* DRIVER ROUTINE ENTRY POINTS
*
:OPEN EQU 0  OPEN FILE
:CLOSE EQU 3  CLOSE FILE
:READA EQU 6  READ ASCII
:WRITEA EQU 9  WRITE ASCII
:READB EQU 12  READ BINARY
:WRITEB EQU 15  WRITE BINARY
:POSIT EQU 18  POSITION
:CREATE EQU 21
:RENAME EQU 24
:DELETE EQU 27
*
* USEFUL ASCII CHARS
*
PUNCHOFF EQU $14
PUNCHON EQU $12
XOFF EQU $13
XON EQU $11
EOF EQU $1C
EOR EQU $1E
CR EQU $D
LF EQU $A
TAB EQU $9
BLANK EQU $20
CONTROLB EQU $2  ^B (SET BREAKPOINT)
CONTROLS EQU $13  ^S (SINGLE STEP)
CONTROLT EQU $14  ^T (TRACE)
CONTROLG EQU 7  ^G (GO)
ESCAPE EQU $1B  ESCAPE (OPERATOR ABORT)
BACKSPACE EQU 8
RUBOUT EQU $7F
*
* MAX # OF CHANNELS
*
CHMAX EQU 8
 FIN
 IF 4*CHMAX>$FF
 +ERROR+ CHMAX TOO BIG
 FIN
*
* ERROR CODES
*
:IPOKE EQU 25 ILLEGAL POKE
*
:CHTBIG EQU 50  CHANNEL # IS TO BIG
:CHBUSY EQU 51  CHANNEL IS ALREADY OPEN
:ILDEVN EQU 52  ILLEGAL DEVICE NAME
:FILNFND EQU 53 ILE NOT FOUND
:CANTOPEN EQU 54 CAN'T OPEN
:CANTCRE EQU 55 CAN'T CREATE
:ICHAIN EQU 56  CHAIN ERROR
:IRENAME EQU 57  CAN'T RENAME
:IDELETE EQU 58  CAN'T DELETE
:CLOSED EQU 59  CHANNEL IS ALREADY CLOSED
:IPOSITION EQU 60 POSITIONING ERROR
:EOFHIT EQU 61  EOF HIT ON OUTPUT FILE
:ILDVOP EQU 62  ILLEGAL DEVICE OPERATION
:IBFOVF EQU 63  INPUT BUFFER OVERFLOW
*
 PAGE --- MEMORY SIZE CALCULATIONS ---
BASIC EQU 0
ASM EQU 1
METAM EQU 2
PROG EQU BASIC
*
* DEVICE SPECIFIERS
*
SYSTEM EQU 1 
SYSDISK EQU 1
LPT EQU 1
*
* CODE SIZE ESTIMATES
*
S:IOPACKAGE EQU $3D7
S:BASICODE EQU $45
S:SYSTEM EQU $130
S:ACIA EQU $40
S:SYSDISK EQU $D5
S:LPT EQU $40
*
* INTERESTING CONSTANTS
*
VSDEPTH EQU 50  VALUE STACK DEPTH
FNDEPTH EQU 20  MAX NUMBER OF NESTED FOR-NEXT LOOPS
GSBDEPTH EQU 10  GOSUB/RETURN STACK SIZE
CATSIZ EQU 132  MAX SIZE OF CONCATENATED STRINGS
STKESZ EQU 6  6 BYTES PER VALUE (MACHINE STACK ENTRY
FSTKESZ EQU 16  16 BYTES PER NEXTED FOR-NEXT LOOP
GSTKESZ EQU 2  2 BYTE ENTRIES FOR THE GOSUB STACK
*
*
* MEMORY SIZE SPECIFICATION
*
 IFUND MEMSIZE
MEMSIZE EQU 32
 FIN
K EQU 1024
IOSIZE SET S:IOPACKAGE  BASIC SIZE OF I/O PKG
 IF PROG=BASIC
IOSIZE SET IOSIZE+S:BASICODE ADD SIZE OF BASIC CODE
IOSIZE SET IOSIZE+CATSIZ+4  ADD SIZE OF CATENATION BUFFER
IOSIZE SET IOSIZE+FNDEPTH*FSTKESZ  ADD SIZE OF FOR-NEXT STACK
IOSIZE SET IOSIZE+GSBDEPTH*GSTKESZ+1  ADD SIZE OF GOSUB STACK
IOSIZE SET IOSIZE+26+2+2 ADD SIZE OF SWITCH BLOCK
 FIN
IOSIZE SET IOSIZE+SLOP+VSDEPTH*STKESZ+1  ADD SIZE OF VALUE STACK
IOSIZE SET IOSIZE+CRT*S:CRT+FLOPPY*S:FLOPPY
IOPBASE EQU MEMSIZE*K-IOSIZE
 PAGE --- IO PACKAGE ENTRY POINTS ---
ENTRYPOINT EQU $100 PROGRAM STARTUP ENTRY POINT
IOERROR EQU $103  ENTRY POINT IN RTP FOR IO ERROR HANDLING
 ORG $106
 FDB IOPBASE
 JMP OPEN
 JMP CLOSE
 JMP CREATE
 JMP DELETE
 JMP RENAME
 JMP CHAIN
 JMP RASCII
 JMP RBIN
 JMP WASCII
 JMP WBIN
 JMP POSITION
 JMP EXIT
 JMP EOF$
 JMP GETCOL
 JMP IORST
 JMP DATE
 JMP TIME
 FDB STACK
 FDB STACKM  STACK MAX
  FDB SWBLOCK
 JMP DEBUG  DEBUG ENTRY POINT (BASIC)
DBGRET RTS   DEBUG RETURN POINT
 JMP ERROR  ERROR PROCESSOR ENTRY POINT (BASIC)
 JMP LINE  ESCAPE ENTRY POINT (BASIC)
 FDB CATBUF  CATENATION BUFFER (BASIC)
 FDB CATSIZ  CATINATION BUFFER MAX SIZE (BASIC)
 FDB FSTACK  FOR-STACK (BASIC)
 FCB FNDEPTH  FOR-STACK MAX ENTRY COUNT (BASIC)
 FDB GOSUBSTK
 FDB GOSUBMAX
 FIN
 IF PROG=BASIC
 PAGE --- RUNTIME INITIALIZATION ROUTINE ---
 ORG IOPBASE-S:RUNST
SS:RUNST EQU *
*
* RUNSTART - START HERE FOR RUNTIME PACKAGE
*
RUNSTART EQU *
 ORG MEMSIZE*K-3 PUT JUMP TO HERE AS LAST 3 BYTES OF MEMORY
 JMP RUNSTART
 ORG RUNSTART
 LDAB #26 GET SIZE OF SWITCH BLOCK TO CLEAR IT
 LDX #SWBLOCK+4 GET STARTING ADDR
SWCLR CLR 0,X CLEAR ALL SWITCHES
 INX
 DECB
 BNE SWCLR
 LDX #CATBUF+4 COPY LOAD FILE NAME INTO CATBUF
 STX NAMEP
 LDX #$71 POINTER TO NAME
RUNS0 LDAA 0,X
 INX
 ANDA #$7F
 CMPA #',
 BNE RUNS0
 STX STRADD
 CLRB
RUNS1 LDX STRADD COPY THE NAME INTO THE CATBUF
 LDAA 0,X
 INX
 STX STRADD
 CMPA #'; NAME ENDS WITH A ";" OR A <CR>
 BEQ RUNS2 B/ FOUND SWITCHES, END OF NAME
 CMPA #CR
 BEQ RUNS3 B/ FOUND NO SWITCHES, END OF NAME
 INCB
 LDX NAMEP
 STAA 0,X
 INX
 STX NAMEP
 BRA RUNS1
RUNS2 EQU * SWITCHES FOUND
RUNS3 EQU * END OF NAME FOUND, NO SWITCHES
 STAB SIZE
 JSR $100 START THE INITIALIZER (BASIC RTP)
 FCB $11 VERSION NUMBER
 FCB $81 BASIC OPCODE = START INLINE CODE EXECUTION
 LDX #CATBUF+4 LOAD ADDR OF BUFFER WHERE FILE NAME IS
 LDAA SIZE GET SIZE
 JSR CHAIN GO CHAIN
*
*
*
SA:RUNST EQU *-SS:RUNST
 IF SA:RUNST>S:RUNST
 +ERROR+ RUNTIME INITIALIZATION ROUTINE TOO BIG FOR ESTIMATED SIZE
 FIN
 FIN
 PAGE --- EXTERNALLY RECOGNIZED SPACE ---
*
* SET THE I/O PACKAGE ADDRESS
*
 ORG IOPBASE
 FDB EDITDATE PUT EDIT DATE AS FIRST BYTE
 DO PROG=BASIC
*
* THIS IS THE CATENATION BUFFER
*
CATBUF RMB CATSIZ+4  4 OVERHEAD BYTES
*
* THIS IS THE FOR-NEXT STACK
*
 RMB FNDEPTH*FSTKESZ
FSTACK EQU *-1  POINTS TO THE LAST BYTE OF FOR-NEXT STACK
*
* THIS IS THE GOSUB STACK
*
GOSUBMAX RMB GSBDEPTH*GSTKESZ
GOSUBSTK RMB 1  FOR THOSE TEMPTED TO USE 'LDS GOSUBSTK'
*
* THIS IS THE SWITCH BLOCK STRING
* FIRST TWO BYTES ARE MAX LENGTH
* NEXT TWO BYTES ARE CUR LENGTH
*
SWBLOCK FDB 26
 FDB 26
 RMB 26
 FIN
*
* THIS IS THE VALUE STACK
*
 RMB 25 SLOP FOR DEBUGGER AND INTERRUPTS
STACKM RMB VSDEPTH*STKESZ
STACK RMB 1  FOR PEOPLE WHO USE 'LDS STACK'
 PAGE --- I/O TABLES ---
*
* I/O TABLES
*
*
SS:IOPACKAGE SET *
*
DRIVER FDB 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 FDB 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
 FDB 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
 FDB 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
 IF 4*CHMAX>*-DRIVER
 +ERROR+ DRIVER TABLE TOO SMALL
 FIN
 ORG DRIVER
 FDB CRTDR
 RMB 4*CHMAX-2
*
:DRIVER EQU 0
:EOF EQU 2
:COLCNT EQU 3
*
DEVNAM EQU *
 IF CRT
 FCC 'CRT:'
 FCB 0
 FIN
*
 IF FLOPPY
UNIT0 EQU *-1
 FCC 'D0:'
 FCB 0
UNIT1 EQU *-1
 FCC 'D1:'
 FCB 0
 FIN
*
 IF PRINTER
 FCC 'LPT:'
 FCB 0
 FIN
*
 ORG *-1 MARK END OF TABLE
 FCB -1
*
DEVADD EQU *
 IF CRT
 FDB CRTDR
 FIN
*
 IF FLOPPY
 FDB DDR,DDR
 FIN
 IF PRINTER
 FDB LPTDR
 FIN
 PAGE --- PACKAGE TEMPS ---
*
* TEMPS FOR IO PACKAGE
*
*
LOOPCT RMB 1
ATEMP RMB 1
BTEMP RMB 1
NAMEP RMB 2 POINTER TO FILE NAME
SIZE RMB 1 SIZE OF FILE NAME
CHECKSUM RMB 1  LOADER CHECKSUM
LOADADDR RMB 2  START ADDRESS OF PROGRAM
CHANEL RMB 1 HOLDS CHANNEL # FOR CURRENT OPERATION
CHPTR RMB 2  REMEMBER EOF ADDRESS HERE
STEMP RMB 2
STRADD RMB 2
TWORD RMB 2
TEMPX RMB 2
LINEFLAGS FCB 0 STATUS FLAGS (SEE BASIC MANUAL)
LOADPTR RMB 2 NEXT ADDRESS TO STORE INTO FOR BINARY LOADER
RNAMEP RMB 2 TEMP NAMEP
RSIZE RMB 1 TEMP SIZE
*
 PAGE
IOERR CLRA  CLEAR UPPER BYTE
 JSR IOERROR
*
 PAGE --- MAJOR CHANNEL OPERATIONS ---
* OPEN, X HAS POINTER TO STRING. "DEVNAME:FILENAME"
* A HAS STRING LENGTH, B HAS CHANNEL NUMBER
* CLEAR COLUMN COUNT, EOF FLAG, & SET DRIVER ADDRESS
* IF NAME NOT FOUND, COMPLAIN
* IF CHANNEL # TOO BIG, COMPLAIN
* IF CHANNEL ALREADY OPEN, COMPLAIN
*
OPEN BSR OPENOK SEE IF OK TO OPEN
 FDB IOERR
 JSR :OPEN,X
 FDB IOERR
OFINISH LDX STEMP GET PTR TO DEV ADDR
 LDAA 0,X GET ADDR IN A,B
 LDAB 1,X
 LDX CHPTR
 STAA :DRIVER,X SAVE IN OPEN CHANNEL TABLE
 STAB :DRIVER+1,X
 RTS
*
*
CREATE BSR OPENOK SEE IF OK
 FDB IOERR
 JSR :CREATE,X GO CREATE
 FDB IOERR
 BRA OFINISH OPEN THE CHANNEL
*
*
* OPENOK - RET TO *(CALL+2/3) IF ERROR (B=ERR#)
* RET CALL+4/5 IF NO ERR X=PTR TO JP TBL FOR DEV
*   NAMEP=FILE NAME START
*   SIZE=NAME SIZE
*
OPENOK JSR CHOK SEE IF CH# IS OK
 FDB ERRET
 STX STRADD SAVE NAME
 JSR INDEX4 GET DEV INDEX
 FDB DRIVER
 TST :DRIVER,X OPEN ALREADY?
 BNE ALLOPEN ERR IF SO
 STX CHPTR SAVE PTR
 CLR :COLCNT,X CLEAR COL COUNT
 CLR :EOF,X CLEAR EOF FLAG
 BRA GETDEV STRIP AND MATCH THE DEV NAME
*
ALLOPEN EQU *
 LDAB #:CHBUSY GET ERR#
 JMP ERRET
*
* GETDEV - ERR RET B=ERR
* NO ERR:
*  NAMEP=NAME START
*  SIZE=NAME SIZE
*  STEMP=ADDR OF ADDR OF JMP TABLE FOR DEV
*
* ENTRY: X=STRING ADDR, A=SIZE
*
GETDEVX STX STRADD
GETDEV PSHA
 LDX #DEVADD-2 INIT SRCH PTR
 STX STEMP
 LDX #DEVNAM-1
RSTRT STX TWORD SAVE PTR TO NAME LIST
 PULA GET SIZE
 STA SIZE SAVE IT 
 PSH A SAVE IT FOR ANOTHER DAY
 LDX STEMP INC THE DEV ADDR PTR
RSTRT1 CPX #UNIT1
 BNE RSTRT2
 LDAA #1
 STAA UNITNO
RSTRT2 PULA  GET SIZE
 STAA SIZE SAVE IT
 PSHA  SAVE IT FOR ANOTHER DAY
 LDX STEMP INC THE DEV ADDR PTR
 INX
 INX
 STX STEMP
 LDX STRADD GET STRING ADDR
NBYTE STX NAMEP
 LDX TWORD
 INX
 STX TWORD
 LDAA 0,X LOAD UP CHAR
 BLE FND DONE WITH NAME - FOUND
 LDX NAMEP GET PTR TO NAME
 CMPA 0,X SAME?
 BNE NNAME IF NOT, GET NEXT NAME
 DEC SIZE
 INX  PT TO NEXT CHAR
 BRA NBYTE TRY NEXT CHAR
*
* FOUND MATCH
*
FND TST SIZE GONE NEGATIVE?
 BLT NNAME IF SO, GET NEXT NAME
*
* NAME IS OK
*  NAMEP=PTR TO NAME, SIZE=SIZE, STEMP=PTR TO DEV TABLE
*  X=PTR TO JMP TABLE
*
 PULA  GET THE SIZE
DEVOUT LDX STEMP GET PTR TO DEV TBL
 LDX 0,X PT TO DEV TBL
*
* OKRET - GET RET ADDR, ADD 2, PUSH BACK AND RETURN
* (I.E. SKIP OVER ERROR ADDR)
* SAVE ALL REGS
*
OKRET STAA ATEMP SAVE A,B
 STAB BTEMP
 PULA  GET RET ADDR
 PULB
 ADDB #2
 ADCA #0 ADD 2
 PSHB  PUT BACK
 PSHA
 LDAA ATEMP GET A,B BACK
 LDAB BTEMP
 RTS
*
*
*
* NNAME - GET NEXT NAME
*
*
NNAME LDX TWORD SEE IF END OF TBL
NNAMEL INX
 TST 0,X END?
 BGT NNAMEL LOOP UNTIL NAME DONE
 BEQ RSTRT IF =0, DO NEXT NAME
 PULA  NO DEV FOUND
ILINT LDA B #:ILDEVN GET ERROR #
 BEQ NNAME1 LENGTH ON NAME IS ZERO, ERROR
 LDX STRADD
 STX NAMEP
 STAA SIZE
 LDX #DDR
 CLR UNITNO SET THE UNIT NUMBER
 BRA OKRET
NNAME1 LDAB #:ILDEVN GET ERROR #
*
*
* ERRET - GO TO THE ADDRESS POINTED TO BY TOS
*
* DESTROY X
*
ERRET TSX  PT TO PTR
 LDX 0,X GET ADDR
 INS  POP IT
 INS
 LDX 0,X GET LOC TO JMP
 JMP 0,X JMP THERE
*
*
* CHOK - SEE IF CHANNEL # IS OK - IF SO, SAVE IN CHANEL
* ELSE, ERROR
*
CHOK CMPB #CHMAX-1
 BHI CHERR ERR IF NOT IN RANGE
 STAB CHANEL SAVE CH#
 BRA OKRET OK RETURN
*
CHERR LDAB #:CHTBIG
 BRA ERRET ERROR
*
*
* OCHOK - SEE IF THE CH# IS OK AND OPEN
*
* IF SO, SAVE ADDR OF CHANNEL ENTRY IN CHPTR AND CH# IN CHANEL
*
*
* EXIT: X=PTR TO CHANNEL ENTRY, A=SAME AS ON ENTRY
*
OCHOK BSR CHOK SEE IF # IS OK
 FDB ERRET
 JSR INDEX4
 FDB DRIVER GET DEV PTR
 STX CHPTR SAVE
 TST :DRIVER,X SEE IF CLOSED
 BNE OKRET OK IF OPEN
 LDAB #:CLOSED
 BRA ERRET
 PAGE
*
* POSITION
*
POSITION STX NAMEP SAVE PTR TO POSITION
 JSR OCHOK SEE IF OPEN
 FDB IOERR
 LDX :DRIVER,X GET DRIVER ADDR
 JSR :POSIT,X
 FDB IOERR
 LDX CHPTR
 STAB :EOF,X SAVE NEW FLAG
 RTS  RET
*
* CLOSE
*
CLOSE JSR OCHOK SEE IF OPEN
 FDB IOERR
 LDX :DRIVER,X GET DRIVER EDDR
 STX TWORD SAVE
 LDX CHPTR
 CLR :DRIVER,X CLEAR DRIVER ADDR
 CLR :DRIVER+1,X
 LDX TWORD POINT TO DRIVER
 JSR :CLOSE,X
 FDB IOERR
 TSTB
 BEQ NORET OK IF NO EOF
 LDAB #:EOFHIT ERROR
 JMP IOERR
*
*
RENAME EQU *
 PULB  GET SIZE
 STAB RSIZE
 PULB  GET ADDRESS
 STAB RNAMEP
 PULB
 STAB RNAMEP+1
 JSR GETDEVX DECODE THE DEVICE
 FDB IOERR
 JSR :RENAME,X
 FDB IOERR
 RTS
*
DELETE EQU *
 JSR GETDEVX
 FDB IOERR
 JSR :DELETE,X
 FDB IOERR
NORET RTS
 PAGE --- CHANNEL STATUS INFORMATION ---
*
* EOF CHECK
*
EOF$ JSR OCHOK SEE IF OPEN
 FDB IOERR
 LDAA :EOF,X  GET THE EOF FLAG
 RTS
*
* GET THE COLUMN
*
GETCOL JSR OCHOK IS CHANNEL OPEN?
 FDB IOERR
 LDAA :COLCNT,X
 RTS
 PAGE --- ASCII READ/WRITE ---
*
* READ ASCII
*
RASCI2 LDAB CHANEL READ ANOTHER CHAR
RASCII JSR OCHOK SEE IF OPEN
 FDB IOERR
 LDAA :EOF,X
 BEQ RASCI1
RASCI0 LDAA #CR  EOF WAS HIT
 CLR :COLCNT,X CLEAR COLUMN COUNT
 RTS
*
RASCI1 LDX :DRIVER,X LD DRIVER ADDR
 JSR :READA,X
 FDB IOERR
 ANDA #$7F  MASK OFF HIGH BIT
 BEQ RASCI2 IGNORE NULLS
 CMPA #LF
 BEQ RASCI2 IGNORE LINEFEEDS FOR THE COMPILER (TEMP KLUDGE)
 BSR UPPERCASE
 LDX CHPTR PT TO EOF FLAG
 STAB :EOF,X SAVE EOF FLAG
 BNE RASCI0 RET A CR IF EOF
* BSR SETCOL
* RTS
*
SETCOL CMPA #CR A CR?
 BEQ CLRCOL IF SO, CLEAR COLUMN COUNT
 CMPA #BLANK A CTRL CHAR?
 BLT RETCOL IF SO, DO NOTHING
 CMPA #RUBOUT RUBOUT?
 BEQ RETCOL IF SO, DON'T INC
 INC :COLCNT,X INC THE COLUMN COUNT
 RTS
*
CLRCOL CLR :COLCNT,X CLEAR COUNT
RETCOL RTS
*
RASCI6 LDAB #:EOFHIT  END OF FILE HIT
 JMP IOERR
*
* WRITE ASCII
*
WASCII JSR OCHOK SEE IF OPEN
 FDB IOERR
 BSR UPPERCASE
 CMPA #CR KLUGE FOR FDOS CONVENTIONS
 BNE WASCI1
 LDAA #LF
 BSR WASCI1
 LDAA #CR
 LDX CHPTR
 BSR WASCI1
 CLRA
 LDX CHPTR
 BSR WASCI1
 RTS
WASCI1 BSR SETCOL FOOL WITH THE COLUMN COUNT
 LDAB :EOF,X SEE IF EOF HIT
 BNE RASCI6 IF SO, ERROR
 LDX :DRIVER,X
 JSR :WRITEA,X
 FDB IOERR
 LDX CHPTR
 STAB :EOF,X SAVE NEW FLAG
 BNE RASCI6
 RTS
*
UPPERCASE ANDA #$7F CONVERT CHAR TO UPPER CASE
 CMPA #$7A SMALL "Z"
 BHI UPPERC1
 CMPA #$60 (SMALL "A") - 1
 BLS UPPERC1
 SUBA #$20
UPPERC1 RTS
 PAGE --- BINARY READ/WRITE ---
*
* READ BINARY
*
RBIN JSR OCHOK CHECK IF OPEN
 FDB IOERR
 CLR :COLCNT,X  CLEAR THE COLUMN COUNT
 LDAA :EOF,X  SEE IF EOF HIT
 BEQ RBIN1  NO, NOT YET
REOF CLRA   YES, RETURN NULLS
 RTS
*
RBIN1 LDX :DRIVER,X LOAD DRIVER ADDR
 JSR :READB,X  GO READ
 FDB IOERR
 LDX CHPTR  IF EOF HIT, SET FLAG
 STAB :EOF,X
 BNE REOF
 RTS
*
RBIN5 LDAB #:EOFHIT  END OF FILE HIT ON OUTPUT
 JMP IOERR
*
WBIN JSR OCHOK CK IF OPEN CHANNEL
 FDB IOERR ERR IF NO
 CLR :COLCNT,X  CLEAR THE COLUMN COUNT
 LDAB :EOF,X
 BNE RBIN5  EOF HIT ON OUTPUT
 LDX :DRIVER,X  GET DRIVER ADDRESS
 JSR :WRITEB,X  GO WRITE IT
 FDB IOERR
 LDX CHPTR  EOF HIT, SET FLAG & COMPLAIN
 STAB :EOF,X
 BNE RBIN5 ERR IF EOF
 RTS
 IF PROG=BASIC
 PAGE --- BASIC ROUTINES ---
SS:BASICODE SET *
*
* DEBUG EXIT
*
DEBUG JMP IDB
*
* ERROR ROUTINE
*
ERROR RTS
*
* LINE
* RETURN LINE FLAGS
*
LINE BSR CKCHAR GET THE CHAR
 ORAA LINEFLAGS ADD PREVIOUS FLAGS
 CLR LINEFLAGS CLEAR
RETNOW RTS  RETURN THE FLAGS
*
* CHECK IF CHAR COMING FROM TERM, IF SO, SEE IF A CTRL CHAR
*
CKCHAR EQU *
 LDAA CRTACIA IS A CHARACTER WAITING?
 RORA
 BCS GOTCH B/ YES
 CLRA  ELSE, NO CHAR
 RTS
*
GOTCH JSR CRTIN GET THE CHAR
 TAB  GET IN RIGHT REG
* FALL INTO LINECK
*
*
* LINECK -- CHECK (B) FOR ^S, ^T, ^G, ESCAPE
* RETURNS (A)=0 IF NONE OF THEM
* ELSE RETURNS LINE$ FLAG BITS FOR RUNTIME PACKAGE IN (A)
* LEAVES (B) ALONE
*
LINECK LDAA #$80  ASSUME OPERATOR ABORT CODE
 CMPB #ESCAPE
 BEQ LINECKR
 LSRA
 CMPB #CONTROLT
 BEQ LINECKR
 LSRA
 CMPB #CONTROLB
 BEQ LINECKR
 LSRA
 CMPB #CONTROLS
 BEQ LINECKR
 LSRA
 CMPB #CONTROLG
 BEQ LINECKR
 CLRA   NONE OF THE ABOVE, FLAG SO
LINECKR RTS   EXIT WITH LINE FLAGS IN (A)
*

SA:BASICODE SET *-SS:BASICODE
 IF SA:BASICODE>S:BASICODE
 +ERROR+ BASIC CODE SIZE > ESTIMATED
 FIN
*
 ELSE
SA:BASICODE SET 0
 FIN
 PAGE --- MISC ROUTINES ---
*
* EXIT
* CLOSES ALL OPEN CHANNELS & FLUSHES THE BUFFERS
* ALSO DOES A RESET THEN EXITS TO OPERATING SYSTEM
EXIT BSR EXITS
 JMP FDOS
*
EXITS LDX #DRIVER-4
 LDAA #CHMAX
 STAA LOOPCT
 STX CHPTR
EXIT1 LDX CHPTR
 INX
 INX
 INX
 INX
 STX CHPTR
 LDAA :DRIVER,X
 BEQ EXIT2
 STAA TEMPX
 LDAA :DRIVER+1,X
 STAA TEMPX+1
 CLR :DRIVER,X
 CLR :DRIVER+1,X
 LDX TEMPX
 JSR :CLOSE,X
 FDB IOERR DO NOT IGNORE ERR
EXIT2 DEC LOOPCT
 BNE EXIT1
* BRA RESET
*
* RESET
*
IORST LDAB #(CHMAX)*4
 LDX #DRIVER
 CLRA
 STAA LINEFLAGS TO PREVENT CONFUSION AT START UP
RESET1 STAA 0,X  CLEAR THE TABLES
 INX
 DECB
 BNE RESET1
 IF CRT
 LDX #CRTDR  OPEN CHANNEL 0 FOR CONSOLE DEVICE
 ELSE
 +ERROR+ CAN'T TURN OFF SYSTEM TERMINAL
 FIN
 STX DRIVER
 JSR :OPEN,X
 FDB *+2 NO ERROR POSSIBLE
 RTS
*
DATE LDX #DATE$
 LDAA #DATEL
 RTS
*
TIME LDX #TIME$
 LDAA #TIMEL
 RTS
*
DATE$ FCC "9-11-77"
DATEL EQU *-DATE$
TIME$ FCC "2:05 PM"
TIMEL EQU *-TIME$
 PAGE --- CHAIN ---
*
* CHAIN THE MOTHER
*
CHAIN PSHA   REMEMBER THE STRING LENGTH
 STX STRADD  FILE NAME
 BSR EXITS
 LDX STRADD
 PULA
 LDAB #1
 JSR OPEN
 LDX #0
 STX LOADADDR
*
* HERE WE GO...
*
LOAD EQU *
 LDAB #1 GET CH #
 JSR EOF$ EOF?
 TSTA
 BNE LOADE ERR IF SO
 LDAB #1 LOAD CH#
 JSR RASCII READ A CH
 CMPA #'S  LOOK FOR A LEADING 'S' CODE
 BNE LOAD  THIS WASN'T IT, IGNORE IT
 LDAB #1
 JSR RASCII
 CMPA #'9  DONE?
 BEQ LOADX  B/ YES
 CMPA #'1  DATA BLOCK?
 BNE LOAD  B/ NO, IGNORE
 CLR CHECKSUM
 BSR LBYTE  GET BYTE COUNT + 2 (FOR ADDRESS)
 SUBA #2
 STAA LOOPCT  SAVE # OF BYTES TO READ
 BSR LBYTE  GET ADDRESS HIGH BYTE
 STAA LOADPTR
 BSR LBYTE
 STAA LOADPTR+1
 LDX LOADADDR
 BNE LOAD1
 LDX LOADPTR  SAVE ADDRESS OF FIRST BYTE (START ADDRESS)
 STX LOADADDR
LOAD1 BSR LBYTE  GET DATA BYTE
 DEC LOOPCT  ALL DATA BYTES LOADED?
 BEQ LOADC  YES, GO CHECK CHECKSUM
 LDAB LOADPTR SEE IF HE'S TRYING TO LOAD OVER US
 CMPB #IOPBASE/$100 COMPARE HIGHER BYTES
 BHI LOADPOKE ERROR IF POKING THE IO PACKAGE
 BNE AOK IF < THEN IT'S OK, ELSE CHECK LOWER 8 BITS
 LDAB #IOPBASE&$FF GET LOWER BITS
 CMPB LOADPTR+1
 BLS LOADPOKE ERROR IF POKING
* HE'S NOT POKING US
AOK LDX LOADPTR
 STAA 0,X  STORE THE BYTE
 INX
 STX LOADPTR
 BRA LOAD1
*
LOADC INC CHECKSUM  CHECK SUM OK?
 BEQ LOAD  YES, GO LOOK FOR ANOTHER RECORD
LOADE LDAB #:ICHAIN  CHECKSUM, CHAIN ERROR
 SK2
LOADPOKE LDAB #:IPOKE ILLEGAL POKE
 JMP IOERR
*
LOADX EQU *
 LDAB #1 LOAD CHANNEL #
 JSR CLOSE CLOSE THE MOTHER
 LDX LOADADDR GET LOAD ADDRESS
 JMP 0,X GO,GO,GO
*
LBYTE LDAB #1
 JSR RASCII  GET A BYTE
 BSR ISDIG  IS IT A DIGIT?
 BCC LOADE2  ERROR
 ASLA
 ASLA
 ASLA
 ASLA
 PSHA
 LDAB #1
 JSR RASCII
 BSR ISDIG  THIS BETTER BE A DIGIT TOO
 BCC LOADE2
 PULB
 ABA
 TAB
 ADDB CHECKSUM
 STAB CHECKSUM
 RTS
*
LOADE2 INS  WIND BACK STACK
 INS
 BRA LOADE
*
ISDIG CMPA #'9
 BLS IS0TO9
 CMPA #'G
 BCS ISATOF
ISDNO CLC
 RTS
*
IS0TO9 CMPA #'0
 BCS ISDNO
 SUBA #'0
 SEC
 RTS
ISATOF CMPA #'A
 BCS ISDNO
 SUBA #'A-10
 SEC
 RTS
 PAGE --- INDEXING ROUTINES ---
*
* INDEXING SUBROUTINE
* B HAS INDEX, ADDRESS OF TABLE IS AT RETURN ADDRESS
* SKIP RETURN WITH X = ADDRESS OF ENTRY
* INDEX1 IS FOR 1 BYTE ENTRIES
* INDEX2 IS FOR 2 BYTE ENTRIES
*
INDEX4 ASLB
INDEX2 ASLB
INDEX1 TSX
 STAA ATEMP SAVE A FOR LATER
 LDX 0,X  GET ADDRESS OF THE VECTOR
 LDX 0,X  GET THE VECTOR ADDRESS
 STX TEMPX
 CLRA   ADD IN THE DISPLACEMENT
 ADDB TEMPX+1
 ADCA TEMPX
 STAB TEMPX+1
 STAA TEMPX
 PULA   NOW DOCTOR UP THE RETURN ADDRESS
 PULB
 ADDB #2
 ADCA #0
 PSHB
 PSHA
 LDX TEMPX
 LDAA ATEMP GET SAVED A REG
 RTS
*
SA:IOPACKAGE EQU *-SS:IOPACKAGE-SA:BASICODE+5 +5 FOR ILLDVOP
 IF SA:IOPACKAGE>S:IOPACKAGE
 +ERROR+ MAIN SECTION SIZE>ESTIMATED SIZE
 FIN
 PAGE --- DEVICE DRIVERS ---
*
* DRIVER ENTRIES:
*
* 0 OPEN
* 3 CLOSE
* 6 READ ASCII
* 9 WRITE ASCII
* C READ BINARY
* F WRITE BINARY
* 12 POSITION
* 15 CREATE
* 18 RENAME
* 1B DELETE
*
* FOR RENAME,DELETE,OPEN,CREATE:
*
* ENTER: NAMEP=PTR TO START OF NAME
*  SIZE=SIZE OF NAME
*  DEV:NAME
*      ^
*      1
*      -- NAMEP
*
* FOR CLOSE:
*
* EXIT: B=0 NO EOF
*  B#0 EOF
*
* FOR POSITION:
*
* ENTER: NAMEP=PTR TO 4 BYTE POSITION
* EXIT: SAME AS CLOSE
*
* FOR BREAD,AREAD:
*
* EXIT: A=CHAR, SAME AS CLOSE
*
* FOR BWRITE,AWRITE:
*
* ENTER: A=CHAR
* EXIT: SAME AS CLOSE
*
* SYSTEM CONSTANT
*
IOPORT EQU #FC32
*
H:KBDIN EQU 0
H:DPYOUT EQU 2
H:RDIN EQU 4
H:WRTOUT EQU 6
H:DSKIN EQU 8
H:DSKOUT EQU 10
H:PRINT EQU 12
*
IO:IO EQU 0
IO:STAT EQU 2
IO:CTRL EQU 4
*
* STATUS AND CONTROL BITS
*
ST:EOF EQU 1
ST:OVER EQU 2
ST:BUSY EQU $80
*
CT:REW EQU 1
*
* SYS DISK INTERESTING VARIABLES
*
OCNTR EUQ  $FC0D
OSIZE EQU $FC09
*
ILLDVOP LDAB #:ILDVOP ILLEGAL DEVICE OPERATION
 JMP ERRET
*
 IF CRT
 PAGE
SS:CRT SET *
TTY0BUF RMB 100 INPUT BUFFER
TTY0MAX EQU *
TTY0PT RMB 2
*
*
SYSTERMDR JMP TTY0OP  OPEN
 JMP TTY0CL  CLOSE
 JMP TTY0RA  READ ASCII
 JMP TTY0WA  WRITE ASCII
 JMP TTY0RB  READ BINARY
 JMP TTY0WB  WRITE BINARY
 JMP ILLDVOP  POSITION
 JMP TTY0OP CREATE LIKE OPEN
 JMP ILLDVOP
 JMP ILLDVOP
*
TTY0OP EQU *
 LDX #TTY0MAX INITIALIZE THE BUFFER
 STX TTY0PT
TTY0CL,CBOKR CLRB  NO EOF HIT
 JMP OKRET
*
TTY0RA LDX TTY0PT  TTY INPUT
 CPX #TTY0MAX
 BEQ TTY0RA1
 LDAA 0,X
 INX
 CMPA #CR
 BNE TTY0RA0
 LDX #TTY0MAX
TTY0RA0 STX TTY0PT
 BRA CBOKR
*
TTY0RA1 LDX #TTY0BUF GET PTR TO CHAR BUFFER
TTY0RA2 BSR CRTIN GET A CHAR
 ANDA #$7F
 TAB
 IF PROG=BASIC
 CMPA #ESCAPE
 BNE TTY0RA7
 LDAB #:OPABORT
 JMP ERRET
TTY0RA7 JSR LINECK
 TSTA
 BEQ TTY0RA5
 ORAA LINEFLAGS
 STAA LINEFLAGS
 BRA TTY0RA2
 FIN
*
TTY0RA5 TBA
 CMPA #RUBOUT
 BNE TTY0RA6
 CPX #TTY0BUF
 BEQ TTY0RA2
 DEX
 LDAA 0,X
 BSR CRTOUT
 BRA TTY0RA2
*
ACIAPUTIC STX TEMPX SAVE X
 LDX IOPORT 
 LDX H:DPYOUT,X GO PRINT THE CHAR
 BRA ACIAFIN
*
ACIAGETC STX TMEPX 
 LDX IOPORT
 LDX H:KBDIN,X
ACIAFIN JSR IO:IO,X
 LDX TEMPX GET X BACK
 RTS
*
CRTIN LDAA CRTACIA
 RORA  DATA COME YET?
 BCC CRTIN B/ NO
 LDAA CRTACIA+1
 ANDA #$7F
 RTS
*
CRTOUT PSHA
CRTOUT1 LDAA CRTACIA
 BITA #2 OUTPUT REGISTER READY?
 BEQ CRTOUT1 B/ NO
 PULA
 STAA CRTACIA+1
 RTS
*
TTY0RA6 CMPA #BACKSPACE  CHECK FOR RUBOUT CHAR
 BNE TTY0RA3
 CPX #TTY0BUF
 BEQ TTY0RA2
 DEX
 BSR CRTOUT   ECHO THE BACKSPACE
 LDAA #BLANK
 BSR CRTOUT
 LDAA #BACKSPACE
 BSR CRTOUT
 BRA TTY0RA2
*
TTY0RA3 BSR CRTOUT   ECHO IT
 STAA 0,X
 INX
 CPX #TTY0MAX
 BEQ TTY0RA4
 CMPA #CR
 BNE TTY0RA2
 LDAA #LF SHOVE OUT LF
 BSR CRTOUT
TTY0RA4 LDX #TTY0BUF
 STX TTY0PT
 JMP TTY0RA
*
TTY0WA ANDA #$7F
 BSR CRTOUT PRT THE CHAR
 CMPA #CR
 BNE TTY0WA1
 LDAB #15
 CLRA
TTY0WA0 BSR CRTOUT
 DECB
 BNE TTY0WA0
TTY0WB BSR CRTOUT
TTY0WA1 SK2
*
TTY0RB BSR CRTIN
 JMP CBOKR
*
SA:CRT SET *-SS:CRT
 IF SA:CRT>S:CRT
 +ERROR+ CRT DRIVER > ESTIMATED SIZE
 FIN
 FIN
 IF FLOPPY
 PAGE
SS:FLOPPY EQU *
UNITNO RMB 1 DISK UNIT NUMBER
OSTRBUF RMB 5
ISTRBUF RMB 5
OCHNL RMB 1
ICHNL RMB 1
IUNITNO RMB 1
OUNITNO RMB 1
*
DDR JMP DKOPEN
 JMP DKCLOSE
 JMP DKRASCII
 JMP DKWASCII
 JMP DKRBIN
 JMP DKWBIN
 JMP DKPOS
 JMP DKCREATE
 JMP ILLDVOP
 JMP ILLDVOP
*
DKCLOSE LDAA CHANEL
 CMPA OCHNL
 BNE DKCLOSE2 B/ DO NOTHING ON READ CHANNEL
DKCLOSE0 LDAA OCNTR PURGE THE OUTPUT BUFFER
 BEQ DKCLOSE1 B/ DONE WITH PURGE
 CLRA
 JSR WRT
 BRA DKCLOSE0
DKCLOSE1 LDAA ITRK
 PSHA
 LDAA ISCTR
 PSHA
 LDAA ICNTR
 PSHA
 CLR ICNTR
 LDAA OUNITNO
 LDX #OSTRBUF
 JSR CLW00
 PULA
 STAA ICNTR
 PULA
 STAA ISCTR
 PULA
 STAA ITRK
DKCLOSE2 CLRB  NO EOF
 JMP OKRET
*
DKRASCII JSR RI GO GET A BYTE
 ANDA #$7F
 CLRB  NO EOF HIT
 JMP OKRET
*
DKRBIN JSR RI READ A BYTE
 CLRB NO EOF HIT
 JMP OKRET
*
DKOPEN LDAA CHANEL
 STAA ICHNL
 LDAA UNITNO
 STAA IUNITNO
 LDX #ISTRBUF
 JSR STRMOV
 LDAA UNITNO
 LDX #ISTRBUF
 CLR ICNTR
 JSR OPR00
 CLR ICNTR
 JMP OKRET
*
DKWASCII ANDA #$7F
 JSR WRT
 CLRB  NO EOF HIT
 JMP OKRET
*
DKWBIN JSR WRT
 CLRB  NO EOF
 JMP OKRET
*
DKCREATE LDAA CHANEL
 STAA OCHNL
 LDAA UNITNO
 STAA OUNITNO
 LDX #OSTRBUF
 BSR STRMOV
 LDAA ITRK SAVE THE INPUT STUFF
 PSHA
 LDAA ISCTR
 PSHA
 LDAA ICNTR
 PSHA
 CLR ICNTR SO THAT THE DIRECTORY READS OK
 LDAA OUNITNO
 LDX #OSTRBUF
 JSR OPW00
 CLR OCNTR
 PULA  RESTORE INPUT STUFF
 STAA ICNTR
 PULA
 STAA ISCTR
 PULA
 STAA ITRK
 JMP OKRET
*
DKPOS LDX NAMEP
 LDAA 0,X
 ORAA 1,X
 ORAA 2,X
 ORAA 3,X
 BNE DKPOS2 B/ POSITION TO OTHER THAN 0 (REWIND), ERROR
 LDAA IUNITNO
 LDX #ISTRBUF
 CLR ICNTR
 JSR OPR00
 CLR ICNTR
 CLRB  NO EOF
 JMP OKRET
DKPOS2 LDAB #:IPOSITION
 JMP ERRET
STRMOV STX TEMPX
 LDAB #5
STRMOV1 LDX NAMEP
 LDAA 0,X
 INX
 STX NAMEP
 LDX TEMPX
 STAA 0,X
 INX
 STX TEMPX
 DECB
 BNE STRMOV1
 RTS
*
*  THIS ROUTINE OPENS A FILE FOR READING
*  CALLING SEQUENCE
*  LDAA N = UNIT NO. 0 OR 1
*  LDX LOC = FILE NAME LOCATION
*  JSR OPR00
OPR00 STAA OPR001
 STX OPR01
 LDX #*
 JMP SFD00
OPR01 FDB 0
 LDX SFD004
 LDAA 6,X     TRACK
 LDAB 7,X     SECTOR
 BNE OPR02
 DECA
 LDAB #26
 BRA OPR03
OPR02 DECB
OPR03 STAA ITRK
 STAB ISCTR
 LDX 8,X
 STX ISIZE
 RTS
OPR001 RMB 1
*  THIS ROUTINE OPENS A NEW FILE FOR WRITING
*  CALLING SEQUENCE
*  LDAA N = UNIT NO. 0 OR 1
*  JSR OPW00
OPW00 LDX #*
 JMP SFD00
 FDB OPW001
 LDX SFD004
 LDAA 6,X
 STAA OTRK
 LDAA 7,X
 STAA OSCTR
 CLR OCNTR
 LDX #$7FFF
 STX OSIZE
 RTS
OPW001 FCB ,,,,     DUMMY FILE NAME
*  THIS ROUTINE SEARCHES FILE DIRECTORY FOR
*  MATCH WITH CANDITATE NAME OR END OF FILE
*  DIRECTORY MARK.
*  CALLING SEQUENCE
*  LDAA N-UNIT NO. 1 OR 0
*  LDX #*
*  JMP SFD00
*  FDB LOC1=CANDIDATE NAME LOCATION
*  RETURNS WITH FCB NO. IN ACC A, NEGATIVE IF
*  MATCH FOUND.
SFD00 STAA SFD001
 INX
 INX
 INX
 INX
 INX
 INX
 STX SFD002
 INX
 INX
 STX SFD006
 LDX SFD002
 LDX X
 STX SFD002
 LDAA #3
 STAA ISCTR
 LDX #0
 STX SFD009
 STX SFD011
 LDX #$FFFF
 STX ISIZE
 CLR ITRK
SFD01 LDAA SFD001
 LDX #*
 JMP RDS00
SFD02 FDB SFD016
 CLR SFD008
 INC SFD008
 LDX SFD02
 STX SFD004     FCB NAME POINTER
SFD03 LDAA 5,X
 CMPA #$FF
 BEQ SFD05A
 LDAB #5
 LDX SFD002
 STX SFD013
 LDX SFD004
 STX SFD015
SFD04 LDX SFD013
 LDAA X
 INX
 STX SFD013
 LDX SFD015
 CMPA X
 BNE SFD06
 INX
 STX SFD015
 DECB
 BNE SFD04
SFD05 LDAA SFD008
 ORAA #$80
 BRA SFD05A+3
SFD05A LDAA SFD008
 LDX SFD006
 JMP X
SFD06 LDAA SFD008
 CMPA #11
 BEQ SFD07
 INC SFD008
 LDX SFD004
 INX
 INX
 INX
 INX
 INX
 INX
 INX
 INX
 INX
 INX
 INX
 STX SFD004
 JMP SFD03
SFD07 LDX SFD004
 LDAA 6,X
 STAA SFD009     TRACK
 LDAA 7,X
 STAA SFD010     SECTOR
 LDAA 8,X
 STAA SFD011     SIZE
 LDAA 9,X
 STAA SFD012
 JMP SFD01
SFD001 RMB 1     UNIT NO.
SFD002 RMB 2     CANDIDATE NAME LOCATION
SFD004 RMB 2     SECTOR FCB LOCATION
SFD006 RMB 2     RETURN POINT
SFD008 RMB 1     FCB COUNT/SECTOR
SFD009 RMB 1     TRACK
SFD010 RMB 1     SECTOR
SFD011 RMB 1     SIZE MS
SFD012 RMB 1     SIZE LS
SFD013 RMB 2     XSAVE
SFD015 RMB 2     XSAVE
SFD016 RMB 128     FILE DIRECTORY SECTOR
*  THIS ROUTINE READS A SECTOR
*  FROM DISC. CALLING SEQUENCE
*     LDAA N
*     LDX #*
*     JMP RDS00
*     FDB LOC
*     WHERE N IS THE UNIT NUMBER
*     LOC IS THE DESTINATION LOCATION.
RDS00 ASLA
 ASLA
 ASLA
 ASLA
 ASLA
 ASLA
 LDAB ISCTR
 ANDB #$1F
 ABA
 STAA ISCTR
 INX
 INX
 INX
 INX
 INX
 INX
 STX RDS001
 INX
 INX
 STX RDS003
 LDX RDS001
 LDX X
 STX RDS001
 LDAB #128
 STAB RDS005
RDS01 JSR RI
 LDX RDS001
 STAA X
 INX
 STX RDS001
 DEC RDS005
 BNE RDS01
 LDX RDS003
 JMP X
RDS001 RMB 2     DESTINATION LOCATION
RDS003 RMB 2     RETURN POINT
RDS005 RMB 1     BYTE COUNTER
*  THIS ROUTINE WRITES A SECTOR
*  TO DISC. CALLING SEQUENCE
*     LDAA N
*     LDX #*
*     JMP WRS00
*     FDB LOC
*     WHERE N IS THE UNIT NUMBER
*     LOC IS THE ORIGIN LOCATION.
WRS00 ASLA
 ASLA
 ASLA
 ASLA
 ASLA
 ASLA
 LDAB OSCTR
 ANDB #$1F
 ABA
 CLR OCNTR
 STAA OSCTR
 INX
 INX
 INX
 INX
 INX
 INX
 STX WRS001
 INX
 INX
 STX WRS003
 LDX WRS001
 LDX X
 STX WRS001
 LDAB #128
 STAB WRS005
WRS01 LDX WRS001
 LDAA X
 INX
 STX WRS001
 JSR WRT
 DEC WRS005
 BNE WRS01
 LDX WRS003
 JMP X
WRS001 RMB 2     ORIGIN LOCATION
WRS003 RMB 2     RETURN POINT
WRS005 RMB 1     BYTE COUNTER
*
*  THIS ROUTINE CLOSES A WRITTEN FILE
*  CALLING SEQUENCE
*  LDAA N = UNIT NO. 0 OR 1
*  LDX LOC = LOCATION OF NEW FILE NAME
*  JSR CLW00
*  ATTRIBUTE WILL BE SET TO '00'.
CLW00 STAA CLW005
 STX CLW01
 LDX #*
 JMP SFD00
CLW01 FDB 0
 LDX SFD004
 STX CLW003
 LDAB #5
CLW02 LDX CLW01
 LDAA X
 INX
 STX CLW01
 LDX CLW003
 STAA X
 INX
 STX CLW003
 DECB
 BNE CLW02
 CLR X
 INX
 INX
 INX
 LDAA #$7F
 SUBA OSIZE
 STAA X
 INX
 LDAA #$FF
 SUBA OSIZE+1
 INCA
 STAA X
 INX
 LDAA #$40
 STAA X
 LDX OTRK
 STX CLW006
 LDX ITRK
 STX OTRK
 LDX #$7FFF
 STX OSIZE
 LDX SFD004
 LDAB SFD008
 CMPB #11
 BNE CLW05
 LDAA CLW005
 LDX #*
 JMP WRS00
 FDB SFD016
 LDAB #1
CLW04 LDX #SFD016
 JMP CLW06
CLW05 INX
 INX
 INX
 INX
 INX
 INX
 INX
 INX
 INX
 INX
 INX
CLW06 LDAA #$2A
 STAA X
 STAA 1,X
 STAA 2,X
 STAA 3,X
 STAA 4,X
 LDAA #$FF
 STAA 5,X
 LDAA CLW006
 STAA 6,X
 LDAA CLW006+1
 ANDA #$1F
 STAA 7,X
 LDAA CLW005
 LDX #*
 JMP WRS00
 FDB SFD016
 RTS
CLW003 RMB 2     NEW FILE NAME
CLW005 RMB 1     UNIT NO. 0 OR 1
CLW006 RMB 2     NEXT BEGINNING TRACK/SECTOR
*
**********************************************
* SUBROUTINES TO REPLACE EDOSII
* EPROM FOR DISK DRIVER 
**********************************************
*
*  8/10/77 BY DA CARLSON
*   VER 1.0
DKDID  EQU $EC00
DKDIC  EQU $EC01
DKCOD  EQU $EC02
DKCOC  EQU $EC03
DKDOD  EQU $EC06
DKDOC  EQU $EC07
*
***************************************
* SUBROUTINE TO SET UP PIA'S AND RESET
* DRIVE ELECTRONICS.
*****************************************
*
RESET EQU *
  CLR DKDIC  SET DIRECTIONS
  CLR DKCOC
  CLR DKDOC
  CLR DKDID
  LDA A #$FF
  STA A DKCOD  SET UP FOR OUTPUTS
  STA A DKDOD  SET UP FOR OUTPUTS
  LDA A #$4    SET DATA IN CNTRL
  STA A DKDIC
  STA A DKDOC SET DATA OUT CNTRL
  LDA A #$2C   SET CMD OUT CNTRL
  STA A DKCOC
  LDA A #$80   ISSUE CLEAR ELECTRONICS
  STA A DKCOD
  LDA A #$0C
  JSR LOOP
  RTS
*
******************************************
* SUBROUTINE TO ISSUE (A) CMD & LOOP ON BUSY
**********************************************
*
LOOP EQU *
  LDA B DKDID  CLEAR BUSY
  STA A DKCOD  ISSUE CMD
LOOP1 LDA A DKDIC DONE?
  BPL LOOP1    NO.
  LDA B DKDID  YES-CLR BUSY
  RTS          EXIT
*
********************************************
* SUBROUTINE TO CHECK IF A DISK,
* ELSE ERROR 3
********************************************
*
CHK EQU *
  LDA A DKDID
  AND A #$20
  BNE CHK2
  RTS
CHK2 LDA A #3  ERROR
CHK1 ORAA #$30
 JSR $F018
 JMP $D005
*
**********************************************
* SUBROUTINE TO RESET ERROR FLAG
**********************************************
*
RFLAG EQU *
  LDA A #$A
  STA A DKCOD
  RTS
*
**********************************************
*SUBROUTINE TO READ AN 8-BIT BYTE FROM
*DISK & RETURN IT IN A-REGISTER. IF EOF,
*CARRY IS SET.
**********************************************
*
TEMP RMB 10
RI EQU *
  TST ICNTR  COUNT = 0
  BNE RI10   NO!
RI5 LDX #ITRK
  JSR INCDA
  LDX ISIZE DECR & CHK IFILE SIZE
  DEX
  BNE RI3
  CLR ICNTR
  SEC SET EOF
  RTS
RI3 STX ISIZE
  LDA A ISCTR XMIT U/S
  JSR XUS
  JSR CHK  MAKE SURE A DISK
  LDA A #128  SET CNTR =128
  STA A ICNTR
  LDA A #5  SET TRY COUNT =5
  STA A TEMP+4
  LDA A ITRK  SEEK TRACK
  JSR SEEK
RI6 LDA A #2  READ DATA
  JSR LOOP
  LDA A DKDID DD MARK ?
  AND A #$80
  BEQ RI4 NO.
  JSR RFLAG  YES - RESET FLAG
  BRA RI5  GO TO NEXT SECTOR
RI4 LDA A DKDID  CRC ERROR
  AND A #$8
  BEQ RI10  NO.
  JSR RFLAG YES-RESET FLAG
  DEC TEMP+4 DECR TRIES
  BNE RI6  TRY AGAIN
  LDA A #1  CAN'T READ MEDIA
RI10 LDA A #$3C  SET CMD CNTRL
  STA A DKCOC
  LDA A #$40  SET FOR READ DATA
  STA A DKCOD
  LDA A DKDID  READ DATA
  PSH A
  LDA A #$2C   RESET CMD CNTRL
  STA A DKCOC
  LDA A #$40   STROBE BFR
  STA A DKCOD
  CLR   DKCOD
  DEC  ICNTR   DECR READ CNTR
  PUL A
  CLC
  RTS
*
******************************************
*SUBROUTINE TO WRITE A BYTE TO DISK
*EXPECTS BYTE IN A-REGISTER
******************************************
*
WRT EQU *
  STA A DKDOD  OUTPUT DATA
  LDA A #$30
  STA A DKCOD
  INC   OCNTR   INCR BFR COUNT
  LDA A OCNTR   =128?
  CMP A #128
  BEQ WRT4      YES
  RTS           NO-EXIT
WRT4  CLR OCNTR CLR COUNT
WRT1  LDA A OSCTR XMIT U/S
  JSR XUS
  JSR CHK   MAKE SURE A DISK
  LDA A #5  SET TRY COUNT =5
  STA A TEMP+4
  LDA A OTRK  SEEK TRACK
  JSR SEEK
WRT2  LDA A #4  WRITE DATA
  JSR LOOP
  LDA A #6    READ FOR CRC
  JSR LOOP
  LDA A DKDID  CRC ERROR?
  AND A #8
  BEQ WRT3  NO.
  JSR RFLAG YES RESET FLAG
  DEC TEMP+4  DECR TRY COUNT
  BNE WRT2    TRY AGAIN
  LDA A #$E   WRITE AS DD
  JSR LOOP
  JSR WRTN    INCR DA & CHK SIZE
  BRA WRT1
WRT3  JSR WRTN
  RTS
*
**********************************************
*SUBROUTINE TO INCR DA &CHK OFILE SIZE
**********************************************
*
WRTN EQU *
  LDX #OTRK
  JSR INCDA
  LDX OSIZE 
  DEX
  STX OSIZE
  BMI WRTN1
  RTS
WRTN1 LDA A #2
  JMP CHK1
*
************************************************
*SUBROUTINE TO INCR DA 
*TRACK IN 0,X, SECTOR IN 1,X
************************************************
*
INCDA EQU *
  INC 1,X
  LDA A 1,X SECTOR =27?
  AND A #$1F
  CMP A #27
  BEQ INCDB  YES
  RTS        NO
INCDB  LDA A 1,X
  AND A #$C1  SET SCTR =1
  STA A 1,X
 INC 0,X INCR TRACK
  RTS
*
*************************************************
*SUBROUTINE TO XMIT UNIT/SECTOR (LOGICAL)
* BYTE
*************************************************
*
XUS EQU *
  PSH A EXTRACT LOG SCTR
  AND A #$1F
  LDX #TBL  GET TABLE PNTR
  STX TEMP+4 
  CLR B MAKE INTO SCTR PNTR
  ADD A TEMP+5
  ADC B TEMP+4
  STA A TEMP+5
  STA B TEMP+4
  LDX TEMP+4
  PUL B MERGE UNIT & PHYS SCTR
  AND B #$C0
  LDA A 0,X
  ABA
  STA A DKDOD ISSUE IT
  LDA A #$20
  STA A DKCOD
  RTS
*
**************************************************
* SUBROUTINE TO SEEK TRACK IN A 
**************************************************
*
SEEK EQU *
  STA A DKDOD
  LDA A #$10
  STA A DKCOD
  LDA A #$8
  JMP LOOP
*
ISIZE RMB 2  IFILE SIZE
ITRK RMB  1   IFILE TRACK
ISCTR RMB 1   IFILE SECTOR
ICNTR RMB 1   IFILE BUFFER COUNTER
OSIZE RMB 2   OFILE SIZE
OTRK  RMB 1   OFILE TRACK
OSCTR RMB 1   OFILE SECTOR
OCNTR RMB 1   OFILE BUFFER COUNTER
*
**********************************************
*PHYSICAL SECTOR TABLE. IS IN ORDER
* OF LOGICAL SECTOR NUMBER
***********************************************
*
TBL EQU *-1
  FCB $1
  FCB $A
  FCB $13
  FCB $2
  FCB $B
  FCB $14
  FCB $3
  FCB $C
  FCB $15
  FCB $4
  FCB $D
  FCB $16
  FCB $5
  FCB $E
  FCB $17
  FCB $6
  FCB $F
  FCB $18
  FCB $7
  FCB $10
  FCB $19
  FCB $8
  FCB $11
  FCB $1A
  FCB $9
  FCB $12
*
*
SA:FLOPPY SET *-SS:FLOPPY
 IF SA:FLOPPY>S:FLOPPY
 +ERROR+ DISK DRIVER > ESTIMATED SIZE
 FIN
 FIN
*
* CHECK OVERALL LENGTH
*
 IF *>>MEMSIZE*K
 +ERROR+ IO PACKAGE TOO BIG FOR MEMSIZE SPECIFIED
 +ERROR+ RE-CHECK ALL SIZE ESTIMATES
 FIN
*
* CHECK WASTED SPACE
*
 IF *+$80<<MEMSIZE*K
 +ERROR+ TOO MUCH WASTED SPACE IN I/O PACKAGE
 +ERROR+ RE-CHECK ALL SIZE ESTIMATES
 FIN
  END
