09       .OPT NO LIST
10 ;  SAVE #D1:CIO.M65
20 ;
30 ;
40 ;  LOAD #D1:PERHNDLR.M65
50 ;
60 ;  *= $E4C1
70       .PAGE "CIO"
80        LIST  
90       .LOCAL 
0100 CIOCHR = ICAX6Z
0110 ICIDNO = ICAX5Z
0120 ICSPRZ = ICAX3Z
0130 ;
058561 ICIO LDX #0   Init CIO
058563   LDA #$FF    clear all
058565   STA ICHID,X iocb's placing
058568   LDA # <IIN-1 ; $ff in ichid
058570   STA ICPTL,X and address of
058573   LDA # >IIN-1 iocb not open
058575   STA ICPTH,X minus one in
058578   TXA         icptl/h
058579   CLC 
058580   ADC #$10    next Iocb
058582   TAX 
058583   CMP #$80    til done
058585   BCC ICIO+2
058587   RTS 
058588 IIN LDY #133  iocb not open
058590   RTS 
058591 CIO STA CIOCHR Save output chr
058593   STX ICIDNO  Save iocb index
058595   TXA 
058596   AND #$0F    Verify iocb num.
058598   BNE ?CIERR1
058599 ;
058600   CPX #$80
058602   BCC ?IOC1
058603 ;
058604 ?CIERR1 LDY #134 iocb no. err
058606   JMP ?CIRTN1
058607 ;
058609 ?IOC1 LDY #0
058611 ?IOC1A LDA ICHID,X Copy bytes
058614   STA ICHIDZ,Y zero to 11 of
058617   INX         the iocb to the
058618   INY         zero page iocb
058619   CPY #12     (ichid-icax2)
058621   BCC ?IOC1A
058622 ;
058623   LDA ICHIDZ
058625   CMP #127
058627   BNE ?CMDCHECK
058628 ;
058629   LDA ICCOMZ
058631   CMP #12     Close?
058633   BEQ ?CICLOS
058634 ;
058635   LDA HNDLOD
058638   BNE ?GOTDEV
058639 ;
058640 ERR130 LDY #130 No device err
058641 ;
058642 ?JYEXIT JMP ?CIRTN1
058643 ;
058645 ?GOTDEV JSR INITPD Load per'al
058648   BMI ?JYEXIT handler for open
058649 ; compute internal vector
058650 ?CMDCHECK LDY #132 Xio syntax
058652   LDA ICCOMZ
058654   CMP #3      Open?
058656   BCC ?CIERR4 Err if less
058657 ; move cmd to zpage for index
058658   TAY 
058659   CPY #14     Special cmd?
058661   BCC ?IOC2   No
058662 ;
058663   LDY #14     Set spec index
058664 ;
058665 ?IOC2 STY ICCOMT save vector
058667   LDA ?COMTAB-3,Y get offset
058670   BEQ ?CIOPEN go if open cmd
058671 ;
058672   CMP #2      Close?
058674   BEQ ?CICLOS
058675 ;
058676   CMP #8      Status or Spec?
058678   BCS ?CISTSP
058679 ;
058680   CMP #4      Read?
058682   BEQ ?CIREAD
058683 ;
058684   JMP ?CIWRIT Must be write
058685 ;
058686 ;  find dev hdlr in hdlr adrtab
058687 ?CIOPEN LDA ICHIDZ exec open
058689   CMP #$FF
058691   BEQ ?IOC6
058692 ;
058693   LDY #129    Already open!
058695 ?CIERR4 JMP ?CIRTN1 exit
058696 ;
058698 ?IOC6 LDA HNDLOD
058701   BNE ?POLL
058702 ;   go find device
058703   JSR ?DEVSRC device search
058706   BCS ?POLL   go if not found
058707 ;
058708   LDA #0
058710   STA DVSTAT
058713   STA DVSTAT+1
058714 ;   compute hdlr entry point
058715 IOC7
058716   JSR ?COMENT exit if
058719   BCS ?CIERR4 compute error
058720 ;   Go to handler for init
058721   JSR ?GOHAND via indir jump
058722 ;
058723 ;  Store putbyt-1 into iocb
058724   LDA #11     simulate put chr
058726   STA ICCOMT
058728   JSR ?COMENT compute entry
058731   LDA ICSPRZ  move value to
058733   STA ICPTLZ  put byte address
058735   LDA ICSPRZ+1
058737   STA ICPTHZ
058739   JMP ?CIRTN2 return to user
058740 ;
058742 ?POLL JSR PDOPENPOLL Poll periph.
058745   JMP ?CIRTN1 ;   for open
058746 ;
058747 ;
058748 ?CICLOS LDY #1 ;  Exec close
058750   STY ICSTAZ
058752   JSR ?COMENT compute entry
058755   BCS ?CICLO2 ignore error
058756 ;
058757   JSR ?GOHAND to hdlr for cls
058758 ;
058760 ?CICLO2 LDA #$FF set iocb free
058762   STA ICHIDZ
058764   LDA # >IIN-1 set putbyt to
058766   STA ICPTHZ  point to err
058768   LDA # <IIN-1
058770   STA ICPTLZ
058772   JMP ?CIRTN2 to user
058773 ; Status/special do implied
058774 ; open if req and go to device
058775 ?CISTSP LDA ICHIDZ handler id?
058777   CMP #$FF
058779   BNE ?CIST1  yes
058780 ; iocb free, do implied open
058781   JSR ?DEVSRC find dev in tble
058784   BCS ?CIERR4
058785 ; compute & go to hdlr entry
058786 ?CIST1 JSR ?COMENT
058789   JSR ?GOHAND
058790 ; restore handler index
058791 ; do implied close
058792   LDX ICIDNO  Recover index
058794   LDA ICHID,X get hdlr id
058797   STA ICHIDZ  restore zpage
058799   JMP ?CIRTN2 return
058800 ;
058801 ; Execute get command
058802 ?CIREAD LDA ICCOMZ Get cmd
058804   AND ICAX1Z  Is read legal
058806   BNE ?RCI1A  Yes
058807 ;
058808   LDY #131    Iocb write only
058810 ?RCI1B JMP ?CIRTN1
058811 ;
058812 ;  comp & check entry point
058813 ?RCI1A JSR ?COMENT
058816   BCS ?RCI1B
058817 ;  get record or characters
058818   LDA ICBLLZ  Single byte get
058820   ORA ICBLLZ+1 or put?
058822   BNE ?RCI3   No
058823 ;
058824   JSR ?GOHAND Yes
058827   STA CIOCHR
058829   JMP ?CIRTN2
058830 ;  loop to fill buffer or
058831 ;  to end record
058832 ?RCI3 JSR ?GOHAND to hdlr get
058835   STA CIOCHR  save byte
058837   BMI ?RCI4   end if error
058838 ;
058839   LDY #0
058841   STA (ICBALZ),Y byte to user
058843   JSR ?INCBFP bufr and inc ptr
058844 ;
058846   LDA ICCOMZ  Is cmd get
058848   AND #2      record?
058850   BNE ?RCI1   No.
058851 ;
058852   LDA CIOCHR  Check for end
058854   CMP #155    of line
058856   BNE ?RCI1   No
058857 ;
058858   JSR ?DECBFL Yes, dec bufrlen
058861   JMP ?RCI4   end transfer
058862 ;
058863 ; check buffer full
058864 ?RCI1 JSR ?DECBFL dec length
058867   BNE ?RCI3   cont if non 0
058868 ; bufr full rec not ended
058869   LDA ICCOMZ  discard bytes
058871   AND #2      til end record
058873   BNE ?RCI4
058874 ; loop to wait for eol
058875 ?RCI6 JSR ?GOHAND get byte
058878   STA CIOCHR  save
058880   BMI ?CIREAD.6 go if error
058881 ; text record wait for eol
058882   LDA CIOCHR
058884   CMP #155
058886   BNE ?RCI6
058887 ; end record buffer full
058888   LDA #137    Truncated record
058890   STA ICSTAZ
058891 ;
058892 ?CIREAD.6 JSR ?DECPTR
058895   LDY #0
058897   LDA #155
058899   STA (ICBALZ),Y
058901   JSR ?INCBFP
058902 ;
058903 ; transfer done
058904 ?RCI4 JSR ?SUBBFL set final
058907   JMP ?CIRTN2 buffer length
058908 ;
058909 ;
058910 ?CIWRIT LDA ICCOMZ Exec PUT
058912   AND ICAX1Z
058914   BNE ?WCI1A
058915 ;
058916   LDY #135    IOCB read only
058918 ?WCI1B JMP ?CIRTN1
058919 ;
058921 ?WCI1A JSR ?COMENT
058924   BCS ?WCI1B
058925 ;
058926   LDA ICBLLZ  bufrlen=0?
058928   ORA ICBLHZ
058930   BNE ?WCI3   No
058931 ;
058932   LDA CIOCHR  set char
058934   INC ICBLLZ  set len
058936   BNE ?WCI4   transfer 1 byte
058937 ; loop to send bytes to hdlr
058938 ?WCI3 LDY #0
058940   LDA (ICBALZ),Y get byte
058942   STA CIOCHR  save
058943 ;
058944 ?WCI4 JSR ?GOHAND put byte
058947   PHP 
058948   JSR ?INCBFP inc bufr ptr
058951   JSR ?DECBFL dec bufr len
058954   PLP 
058955   BMI ?WCI5   end if error
058956 ;
058957   LDA ICCOMZ  is cmd putrec?
058959   AND #2
058961   BNE ?WCI1   No
058962 ;
058963   LDA CIOCHR  Got eol?
058965   CMP #155
058967   BEQ ?WCI5   Yes
058968 ;
058969 ?WCI1 LDA ICBLLZ
058971   ORA ICBLHZ
058973   BNE ?WCI3
058974 ; bufr empty, record not full
058975   LDA ICCOMZ
058977   AND #2      put bytes?
058979   BNE ?WCI5   yes end
058980 ; buffer empty text record
058981   LDA #155    send eol
058983   JSR ?GOHAND
058984 ;
058986 ?WCI5 JSR ?SUBBFL set real len
058989   JMP ?CIRTN2 exit
058990 ;
058992 ?CIRTN1 STY ICSTAZ Set status
058993 ;
058994 ?CIRTN2 LDY ICIDNO Finish CIO
058996   LDA ICBAL,Y operation
058999   STA ICBALZ
059001   LDA ICBAH,Y
059004   STA ICBAHZ
059006   LDX #0
059008   STX HNDLOD
059011 ?CIRT3 LDA ICHIDZ,X Copy
059013   STA ICHID,Y zero page back
059016   INX         to iocb
059017   INY 
059018   CPX #12
059020   BCC ?CIRT3
059021 ; restore a x y
059022   LDA CIOCHR
059024   LDX ICIDNO  recover x entry
059026   LDY ICSTAZ
059028   RTS 
059029 ?COMENT LDY ICHIDZ Calc hndler
059031   CPY #34     entry point.
059033   BCC ?COM1   Go if valid
059034 ;
059035   LDY #133    iocb not open
059037   BCS ?COM2   Go always
059038 ;
059039 ?COM1 LDA HATABS+1,Y get lsb
059042   STA ICSPRZ  to pointer
059044   LDA HATABS+2,Y and msb
059047   STA ICSPRZ+1
059049   LDY ICCOMT  get cmd code
059051   LDA ?COMTAB-3,Y and offset
059054   TAY         get low byte of
059055   LDA (ICSPRZ),Y vec from hdlr
059057   TAX         and save
059058   INY         get hi byte
059059   LDA (ICSPRZ),Y
059061   STA ICSPRZ+1
059063   STX ICSPRZ
059065   CLC         flag ok
059066 ?COM2 RTS 
059067 ?DECBFL LDA ICBLLZ Decrement
059069   BNE ?DECBF1 buffer length
059070 ;
059071   DEC ICBLHZ
059072 ;
059073 ?DECBF1 DEC ICBLLZ
059075   LDA ICBLLZ  Return Z flag if
059077   ORA ICBLHZ  done
059079   RTS 
059080 ?DECPTR LDA ICBALZ Decrement
059082   BNE ?DECPT1 buffer pointer
059083 ;
059084   DEC ICBAHZ
059085 ;
059086 ?DECPT1 DEC ICBALZ
059088   RTS 
059089 ?INCBFP INC ICBALZ Increment
059091   BNE ?INCBF1 buffer pointer
059092 ;
059093   INC ICBAHZ
059094 ;
059095 ?INCBF1 RTS 
059096 ?SUBBFL LDX ICIDNO Set final
059098   SEC         buffer length
059099   LDA ICBLL,X bufrlen=
059102   SBC ICBLLZ  bufrlen-working
059104   STA ICBLLZ  ;  byte count
059106   LDA ICBLH,X
059109   SBC ICBLHZ
059111   STA ICBLHZ
059113   RTS 
059114 ?GOHAND LDY #146 Not implem.
059116   JSR ?CIJUMP Exec handler
059119   STY ICSTAZ  command
059121   CPY #0
059123   RTS 
059124 ?CIJUMP TAX   Invoke device
059125   LDA ICSPRZ+1 handler via
059127   PHA         indirect jump
059128   LDA ICSPRZ
059130   PHA 
059131   TXA         restore a
059132   LDX ICIDNO  Recover x entry
059134   RTS 
059135 ?DEVSRC SEC   Get device num
059136   LDY #1      and strip Ascii
059138   LDA (ICBALZ),Y plus one
059140   SBC #'1     If device now
059142   BMI ?DEFAULT less than 0 or
059143 ;
059144   CMP #9      more than 8,
059146   BCC ?GOTNUM
059147 ;
059148 ?DEFAULT LDA #0 make it 0
059149 ;
059150 ?GOTNUM STA ICDNOZ
059152   INC ICDNOZ  Final no. 1-9
059153 ;  find device
059154   LDY #0
059156   LDA (ICBALZ),Y
059158 ERR130B BEQ ?CIERR2
059159 ;
059160   LDY #33
059162 ?DEVS1 CMP HATABS,Y
059165   BEQ ?DEVS2
059167   DEY 
059168   DEY 
059169   DEY 
059170   BPL ?DEVS1
059171 ;
059172 ?CIERR2 LDY #130 Unknown dev
059174   SEC         flag error
059175   RTS 
059176 ?DEVS2 TYA    found device
059177   STA ICHIDZ  save and return
059179   CLC         flag ok
059180   RTS 
059181 ?COMTAB .BYTE 0,4,4,4 Maps cmd
059185   .BYTE 4,6,6,6 to offset for
059189   .BYTE 6,2,8,10 vectr in hdlr
