         nam   IOMan
         ttl   OS-9 Level Two V2.00.01 I/O Manager module

         ifp1
         use   defsfile
         endc

* edition $0C = Stock OS-9 Level Two Vr. 02.00.01 IOMan
* edition $0D = IO Queue sort bug fixed
edition  set   $0C

tylg     set   Systm+Objct
atrv     set   ReEnt+rev
rev      set   $01

         mod   eom,name,tylg,atrv,IOManEnt,size

u0000    rmb   0
size     equ   .

name     fcs   /IOMan/
         fcb   edition

IOManEnt equ   *
* allocate device table
         ldx   <D.Init
         lda   DevCnt,x
         ldb   #DEVSIZ
         mul
         pshs  b,a
         lda   PollCnt,x
         ldb   #POLSIZ
         mul
         pshs  b,a
         addd  2,s
         addd  #$0018
         addd  #$00FF                  bring up to next page
         clrb
         os9   F$SRqMem
         bcs   Crash
         leax  ,u
L0033    clr   ,x+
         subd  #$0001
         bhi   L0033
         stu   <D.DevTbl
         ldd   ,s++
         std   <D.CLTb
         ldd   ,s++
         leax  d,u
         stx   <D.PolTbl
         ldd   <D.CLTb
         leax  d,x
         stx   <D.CLTb
         ldx   <D.PthDBT
         os9   F$All64
         bcs   Crash
         stx   <D.PthDBT
         os9   F$Ret64
         leax  >L06A2,pcr
         stx   <D.Poll
         leay  <L0067,pcr
         os9   F$SSvc
         rts

Crash    jmp   <D.Crash

L0067    fcb   $7F
         fdb   UsrIO-*-2

         fcb   F$Load
         fdb   FLoad-*-2

         fcb   I$Detach
         fdb   IDetach0-*-2

         fcb   F$PErr
         fdb   FPerr-*-2

         fcb   F$IOQu+$80
         fdb   FIOQu-*-2

         fcb   $FF
         fdb   SysIO-*-2

         fcb   F$IRQ+$80
         fdb   FIRQ-*-2

         fcb   F$IODel+$80
         fdb   FIODel-*-2

         fcb   F$NMLink
         fdb   FNMLink-*-2

         fcb   F$NMLoad
         fdb   FNMLoad-*-2

         fcb   $80

FIODel   ldx   R$X,u
         ldu   <D.Init
         ldb   DevCnt,u
         ldu   <D.DevTbl
L008E    ldy   V$DESC,u
         beq   L009F
         cmpx  V$DESC,u
         beq   L00A6
         cmpx  V$DRIV,u
         beq   L00A6
         cmpx  V$FMGR,u
         beq   L00A6
L009F    leau  DEVSIZ,u
         decb
         bne   L008E
         clrb
         rts
L00A6    comb
         ldb   #E$ModBsy
         rts

L00AA    lsra
         rorb
         lsra
         rorb
         lsra
         rorb
         lsra
         rorb
         lsra
         rorb
         anda  #$00
         cmpb  #$3F
         rts

UsrIODis fdb   IAttach-UsrIODis
         fdb   IDetach-UsrIODis
         fdb   UIDup-UsrIODis
         fdb   IUsrCall-UsrIODis
         fdb   IUsrCall-UsrIODis
         fdb   IMakDir-UsrIODis
         fdb   IChgDir-UsrIODis
         fdb   IDelete-UsrIODis
         fdb   UISeek-UsrIODis
         fdb   UIRead-UsrIODis
         fdb   UIWrite-UsrIODis
         fdb   UIRead-UsrIODis
         fdb   UIWrite-UsrIODis
         fdb   UIGetStt-UsrIODis
         fdb   UISeek-UsrIODis
         fdb   UIClose-UsrIODis
         fdb   IDeletX-UsrIODis

SysIODis fdb   IAttach-SysIODis
         fdb   IDetach-SysIODis
         fdb   SIDup-SysIODis
         fdb   ISysCall-SysIODis
         fdb   ISysCall-SysIODis
         fdb   IMakDir-SysIODis
         fdb   IChgDir-SysIODis
         fdb   IDelete-SysIODis
         fdb   SISeek-SysIODis
         fdb   SIRead-SysIODis
         fdb   SIWrite-SysIODis
         fdb   SIRead-SysIODis
         fdb   SIWrite-SysIODis
         fdb   SIGetStt-SysIODis
         fdb   SISeek-SysIODis
         fdb   SIClose-SysIODis
         fdb   IDeletX-SysIODis

UsrIO    leax  <UsrIODis,pcr
         bra   L0105
SysIO    leax  <SysIODis,pcr
L0105    cmpb  #I$DeletX
         bhi   L0114
         pshs  b
         lslb
         ldd   b,x
         leax  d,x
         puls  b
         jmp   ,x
L0114    comb
         ldb   #E$UnkSvc
         rts

IAttach  ldb   #$17
L011A    clr   ,-s
         decb
         bpl   L011A
         stu   <$16,s                  save caller regs
         lda   R$A,u
         sta   $09,s
         ldx   <D.Proc
         stx   <$14,s                  save proc desc
         leay  <P$DATImg,x
         ldx   <D.SysPrc
         stx   <D.Proc
         ldx   R$X,u
         lda   #Devic+0
         os9   F$SLink
         bcs   L0163
         stu   $04,s                   save pointer to dev desc
         ldy   <$16,s                  get caller regs
         stx   R$X,y
         lda   M$Port,u
         sta   $0B,s                   save extended port addr
         ldd   M$Port+1,u
         std   $0C,s                   save port addr
         ldd   M$PDev,u
         leax  d,u                     point to driver name in desc
         lda   #Drivr+0
         os9   F$Link                  link to driver
         bcs   L0163
         stu   ,s                      save pointer to driver
         ldu   4,s                     get dev desc ptr
         ldd   M$FMgr,u
         leax  d,u                     point to fmgr name in desc
         lda   #FlMgr+0
         os9   F$Link                  link to fmgr
L0163    ldx   <$14,s                  get proc desc
         stx   <D.Proc
         bcc   L0178
L016A    stb   <$17,s                  save error in B on stack
         leau  ,s                      point U at stack
         os9   I$Detach                detach
         leas  $17,s                   clean up stack
         comb
         puls  pc,b
L0178    stu   6,s                     save pointer to fmgr
         ldx   <D.Init
         ldb   DevCnt,x
         lda   DevCnt,x
         ldu   <D.DevTbl
L0182    ldx   V$DESC,u
         beq   L01BF
         cmpx  4,s                     compare to dev desc on stack
         bne   L019D
         ldx   V$STAT,u                get static
         bne   L019B
         pshs  a
         lda   V$USRS,u
         beq   L0197
         os9   F$IOQu
L0197    puls  a
         bra   L0182
L019B    stu   $0E,s                   save static storage
L019D    ldx   V$DESC,u
         ldy   M$Port+1,x
         cmpy  $0C,s                   same port?
         bne   L01BF
         ldy   M$Port,x
         cmpy  $0B,s                   same port?
         bne   L01BF
         ldx   V$DRIV,u
         cmpx  ,s                      same driver?
         bne   L01BF
         ldx   V$STAT,u
         stx   $02,s                   save static
         tst   V$USRS,u
         beq   L01BF
         sta   $0A,s
L01BF    leau  DEVSIZ,u
         decb
         bne   L0182
         ldu   $0E,s                   get static storage
         lbne  L0270
         ldu   <D.DevTbl
L01CC    ldx   V$DESC,u
         beq   L01DD
         leau  DEVSIZ,u
         deca
         bne   L01CC
         ldb   #E$DevOvf
         bra   L016A
L01D9    ldb   #E$BMode
         bra   L016A
L01DD    ldx   $02,s
         lbne  L0267
         stu   $0E,s
         ldx   ,s                      get ptr to driver
         ldd   M$Mem,x                 get driver mem size
         addd  #$00FF                  round to next page
         clrb
         os9   F$SRqMem                allocate driver mem
         lbcs  L016A
         stu   $02,s                   save ptr to mem
L01F6    clr   ,u+                     clear driver mem
         subd  #$0001
         bhi   L01F6
         ldd   $0B,s                   get port addr
         lbsr  L00AA
         std   <$12,s
         ldu   #$0000
         tfr   u,y
         stu   <$10,s
         ldx   <D.SysDAT
L020F    ldd   ,x++
         cmpd  <$12,s
         beq   L0247
         cmpd  #$333E
         bne   L0223
         sty   <$10,s
         leau  -$02,x
L0223    leay  >$2000,y
         bne   L020F
         ldb   #E$NoRam
         cmpu  #$0000
         lbeq  L016A
         ldd   <$12,s
         std   ,u
         ldx   <D.SysPrc
         lda   P$State,x
         ora   #ImgChg
         sta   P$State,x
         os9   F$ID
         ldy   <$10,s
L0247    sty   <$10,s
         ldd   $0C,s
         anda  #$1F
         addd  <$10,s
         ldu   $02,s
         clr   ,u
         std   $01,u
         ldy   $04,s
         ldx   ,s
         ldd   $09,x
         jsr   d,x
         lbcs  L016A
         ldu   $0E,s
L0267    ldb   #$08
L0269    lda   b,s
         sta   b,u
         decb
         bpl   L0269
L0270    ldx   $04,u
         ldb   $07,x
         lda   $09,s
         anda  $0D,x
         ldx   ,u
         anda  $0D,x
         cmpa  $09,s
         lbne  L01D9
         inc   $08,u
         bne   L0288
         dec   $08,u
L0288    ldx   <$16,s
         stu   $08,x
         leas  <$18,s
         clrb
         rts

IDetach  ldu   R$U,u                   get ptr to dev tbl entry
         ldx   V$DESC,u
         ldb   V$USRS,u
         bne   L02A2
         pshs  u,b
         ldu   V$STAT,u
         pshs  u
         bra   L02DE
L02A2    lda   #$FF
         cmpa  $08,u
         lbeq  L0367
         dec   $08,u
         lbne  L0349
         ldx   <D.Init
         ldb   DevCnt,x
         pshs  u,b
         ldx   $02,u
         clr   $02,u
         clr   $03,u
         ldy   <D.DevTbl
L02BF    cmpx  $02,y
         beq   L033F
         leay  $09,y
         decb
         bne   L02BF
         ldy   <D.Proc
         ldb   ,y
         stb   $08,u
         ldy   $04,u
         ldu   ,u
         exg   x,u
         ldd   $09,x
         leax  d,x
         pshs  u
         jsr   $0F,x
L02DE    puls  u
         ldx   $01,s                   get ptr to dev tbl
         ldx   ,x                      load X with driver addr
         ldd   M$Mem,x                 get static storage size
         addd  #$00FF                  round up one page
         clrb
         os9   F$SRtMem                return mem
         ldx   $01,s                   get ptr to dev tbl
         ldx   V$DESC,x
         ldd   $0E,x
         beq   L033F
         lbsr  L00AA
         beq   L033F
         tfr   d,x
         ldb   ,s
         pshs  x,b
         ldu   <D.DevTbl
L0302    cmpu  $04,s
         beq   L0317
         ldx   $04,u
         beq   L0317
         ldd   $0E,x
         beq   L0317
         lbsr  L00AA
         cmpd  $01,s
         beq   L033D
L0317    leau  $09,u
         dec   ,s
         bne   L0302
         ldx   D.SysPrc
         ldu   <D.SySDAT
         ldy   #$0008
L0325    ldd   ,u++
         cmpd  $01,s
         beq   L0332
         leay  -$01,y
         bne   L0325
         bra   L033D
L0332    ldd   #$333E
         std   -$02,u
         lda   $0C,x
         ora   #$10
         sta   $0C,x
L033D    leas  $03,s
L033F    puls  u,b
         ldx   $04,u
         clr   $04,u
         clr   $05,u
         clr   $08,u
L0349    ldd   <D.Proc
         pshs  b,a
         ldd   <D.SysPrc
         std   <D.Proc
         ldy   ,u
         ldu   $06,u
         os9   F$UnLink
         leau  ,y
         os9   F$UnLink
         leau  ,x
         os9   F$UnLink
         puls  b,a
         std   <D.Proc
L0367    lbsr  L0606
         clrb
         rts

UIDup    bsr   LocFrPth
         bcs   L038C
         pshs  x,a
         lda   R$A,u
         lda   a,x
         bsr   L0385
         bcs   L0381
         puls  x,b
         stb   R$A,u
         sta   b,x
         rts
L0381    puls  pc,x,a

SIDup    lda   R$A,u
L0385    lbsr  GetPDesc
         bcs   L038C
         inc   PD.CNT,y
L038C    rts

* Locate a free path in D.Proc
LocFrPth ldx   <D.Proc
         leax  <P$Path,x
         clra
L0393    tst   a,x
         beq   L03A0
         inca
         cmpa  #NumPaths
         bcs   L0393
         comb
         ldb   #E$PthFul
         rts
L03A0    andcc #^Carry
         rts

IUsrCall bsr   LocFrPth
         bcs   L03B5
         pshs  u,x,a
         bsr   ISysCall
         puls  u,x,a
         bcs   L03B5
         ldb   R$A,u
         stb   a,x
         sta   R$A,u
L03B5    rts

ISysCall pshs  b
         ldb   R$A,u
         bsr   AllcPDsc
         bcs   L03CA
         puls  b
         lbsr  CallFMgr
         bcs   L03D9
         lda   PD.PD,y
         sta   R$A,u
         rts
L03CA    puls  pc,a

IMakDir  pshs  b
         ldb   #DIR.+WRITE.
L03D0    bsr   AllcPDsc
         bcs   L03CA
         puls  b
         lbsr  CallFMgr
L03D9    pshs  b,cc
         ldu   PD.DEV,y
         os9   I$Detach
         lda   PD.PD,y
         ldx   <D.PthDBT
         os9   F$Ret64
         puls  pc,b,cc

IChgDir  pshs  b
         ldb   R$A,u
         orb   #DIR.
         bsr   AllcPDsc
         bcs   L03CA
         puls  b
         lbsr  CallFMgr
         bcs   L03D9
         ldu   <D.Proc
         ldb   PD.MOD,y
         bitb  #PWRIT.+PREAD.+WRITE.+READ.
         beq   IChgExec
         ldx   PD.DEV,y
         stx   <P$DIO,u
         inc   V$USRS,x
         bne   IChgExec
         dec   V$USRS,x
IChgExec bitb  #PEXEC.+EXEC.
         beq   IChgRts
         ldx   PD.DEV,y
         stx   <P$DIO+6,u
         inc   V$USRS,x
         bne   IChgRts
         dec   V$USRS,x
IChgRts  clrb
         bra   L03D9

IDelete  pshs  b
         ldb   #WRITE.
         bra   L03D0

IDeletX  ldb   #DIR.+EXEC.+UPDAT.
         pshs  b
         ldb   R$A,u
         bra   L03D0

* allocate path descriptor
AllcPDsc ldx   <D.Proc
         pshs  u,x
         ldx   <D.PthDBT
         os9   F$All64
         bcs   L0499
         inc   PD.CNT,y
         stb   PD.MOD,y
         ldx   <D.Proc
         ldb   P$Task,x
         ldx   R$X,u                   X points to pathlist
L0442    os9   F$LDABX
         leax  1,x
         cmpa  #$20                    skip over spaces
         beq   L0442
         leax  -1,x                    back up
         stx   R$X,u                   save back pointer
         ldb   PD.MOD,y
         cmpa  #'/                     leading slash?
         beq   L046F                   yep...
         ldx   <D.Proc
         bitb  #EXEC.                  exec. dir relative?
         beq   L0460                   nope...
         ldx   <P$DIO+6,x
         bra   L0463
L0460    ldx   <P$DIO,x
L0463    beq   L049E
         ldd   D.SysPrc
         std   <D.Proc
         ldx   $04,x
         ldd   $04,x
         leax  d,x
L046F    pshs  y                       save off path desc ptr in Y
         os9   F$PrsNam
         puls  y                       restore path desc ptr
         bcs   L049E
         lda   PD.MOD,y
         os9   I$Attach                attach to device
         stu   PD.DEV,y                save dev tbl entry
         bcs   L04A0
         ldx   V$DESC,u
* copy options from dev desc to path desc
         leax  <M$Opt,x
         ldb   ,x+                     get options count
         leau  <PD.OPT,y
         cmpb  #$20
         bls   L0495
         ldb   #$1F
L0491    lda   ,x+
         sta   ,u+
L0495    decb
         bpl   L0491
         clrb
L0499    puls  u,x
         stx   <D.Proc
         rts

L049E    ldb   #E$BPNam
L04A0    pshs  b
         lda   ,y
         ldx   <D.PthDBT
         os9   F$Ret64
         puls  b
         coma
         bra   L0499

* System to User Path routine
*
* Returns:
*    A = user path #
*    X = path table in path desc. of current proc.
S2UPth   lda   R$A,u
         cmpa  #NumPaths
         bcc   L04BF                   illegal path number
         ldx   <D.Proc
         leax  <P$Path,x
         andcc #^Carry
         lda   a,x
         bne   L04C2
L04BF    comb
         ldb   #E$BPNum
L04C2    rts

UISeek   bsr   S2UPth                  get user path #
         bcc   GtPDClFM                get PD, call FM
         rts

SISeek   lda   R$A,u
GtPDClFM bsr   GetPDesc
         lbcc  CallFMgr
         rts

UIRead   bsr   S2UPth                  get user path #
         bcc   L04D8
         rts

SIRead   lda   R$A,u
L04D8    pshs  b
         ldb   #EXEC.+READ.
L04DC    bsr   GetPDesc
         bcs   L0529
         bitb  PD.MOD,y
         beq   L0527
         ldd   R$Y,u                   get count from user
         beq   L0516
         addd  R$X,u                   update buffer pointer
         bcs   L051B
         subd  #$0001                  subract 1 from count
         lsra
         lsra
         lsra
         lsra
         lsra
         ldb   R$X,u
         lsrb
         lsrb
         lsrb
         lsrb
         lsrb
         pshs  b
         suba  ,s+
         ldx   <D.Proc
         leax  <P$DATImg,x
         lslb
         leax  b,x
L0507    pshs  a
         ldd   ,x++
         cmpd  #$333E
         puls  a
         beq   L051B
         deca
         bpl   L0507
L0516    puls  b
         lbra  CallFMgr
L051B    ldb   #E$Read
         lda   ,s
         bita  #WRITE.
         beq   L0529
         ldb   #E$Write
         bra   L0529
L0527    ldb   #E$BMode
L0529    com   ,s+
         rts

UIWrite  bsr   S2UPth                  get user path #
         bcc   L0533
         rts

SIWrite  lda   R$A,u
L0533    pshs  b
         ldb   #WRITE.
         bra   L04DC

* get path descriptor
* Passed:   A = path number
* Returned: Y = address of path desc for path num
GetPDesc pshs  x
         ldx   <D.PthDBT
         os9   F$Find64
         puls  x
         lbcs  L04BF
L0546    rts

UIGetStt lbsr  S2UPth                  get user path #
         ldx   <D.Proc
         bcc   L0553
         rts

SIGetStt lda   R$A,u
         ldx   <D.SysPrc
L0553    pshs  x,b,a
         lda   R$B,u                   get func code
         sta   1,s                     place func code on stack
         puls  a                       get path off stack
         lbsr  GtPDClFM
         puls  x,a
         pshs  u,y,b,cc
         ldb   <$20,y
         cmpb  #$04
         beq   L0570
         tsta                          SS.Opt?
         beq   SSOpt
         cmpa  #SS.DevNm
         beq   SSDevNm
L0570    puls  pc,u,y,b,cc

SSOpt    lda   <D.SysTsk
         ldb   P$Task,x
         leax  <PD.OPT,y
SSCopy   ldy   #32
         ldu   R$X,u
         os9   F$Move
         leas  2,s
         clrb
         puls  pc,u,y

SSDevNm  lda   <D.SysTsk
         ldb   P$Task,x
         pshs  b,a
         ldx   PD.DEV,y
         ldx   V$DESC,x
         ldd   M$Name,x
         leax  d,x
         puls  b,a
         bra   SSCopy

UIClose  lbsr  S2UPth                  get user path #
         bcs   L0546
         pshs  b
         ldb   R$A,u
         clr   b,x                     zero path entry
         puls  b
         bra   L05AA

SIClose  lda   R$A,u
L05AA    bsr   GetPDesc
         bcs   L0546
         dec   PD.CNT,y
         tst   PD.CPR,y
         bne   L05B6
         bsr   CallFMgr
L05B6    tst   PD.CNT,y
         bne   L0546
         lbra  L03D9
L05BD    os9   F$IOQu
         comb
         ldb   <$19,x
         bne   L05D1
L05C6    ldx   <D.Proc
         ldb   P$ID,x
         clra
         lda   PD.CPR,y
         bne   L05BD
         stb   PD.CPR,y
L05D1    rts

CallFMgr pshs  u,y,x,b
         bsr   L05C6
         bcs   L05EE
         stu   PD.RGS,y
         lda   <$20,y
         ldx   PD.DEV,y
         ldx   V$FMGR,x
         ldd   M$Exec,x
         leax  d,x
         ldb   ,s                      get B off stack
         subb  #$83
         lda   #$03
         mul
         jsr   d,x
L05EE    pshs  b,cc
         bsr   L0606
         ldy   $05,s                   get Y off stack
         lda   <$20,y
         ldx   <D.Proc
         lda   P$ID,x
         cmpa  PD.CPR,y
         bne   L0602
         clr   PD.CPR,y
L0602    puls  b,cc
         puls  pc,u,y,x,a
L0606    pshs  y,x
         ldy   <D.Proc
         lda   <P$IOQN,y
         beq   L061D
         clr   <P$IOQN,y
         ldb   #S$Wake
         os9   F$Send
         os9   F$GProcP
         clr   P$IOQP,y
L061D    clrb
         puls  pc,y,x

FIRQ     ldx   R$X,u                   get ptr to IRQ packet
         ldb   ,x                      get flip byte
         ldx   $01,x                   get mask/priority bytes
         clra
         pshs  cc
         pshs  x,b
         ldx   <D.Init
         ldb   PollCnt,x
         ldx   <D.PolTbl
         ldy   R$X,u
         beq   L0671
         tst   $01,s                   test mask byte on stack
         beq   L069C
         decb
         lda   #POLSIZ
         mul
         leax  d,x                     point to last entry in table
         lda   Q$MASK,x
         bne   L069C
         orcc  #FIRQMask+IRQMask
L0646    ldb   $02,s                   get priority byte on stack
         cmpb  -$01,x                  compare to priority of prev entry
         bcs   L0659
         ldb   #$09
L064E    lda   ,-x
         sta   $09,x
         decb
         bne   L064E
         cmpx  <D.PolTbl
         bhi   L0646
L0659    ldd   R$D,u
         std   Q$POLL,x
         ldd   ,s++                    get flip/byte off stack
         sta   Q$FLIP,x                store flip
         stb   Q$MASK,x                store mask
         ldb   ,s+                     get priority off stack
         stb   Q$PRTY,x
         ldd   R$Y,u                   get IRQ SVC entry
         std   Q$SERV,x
         ldd   R$U,u                   get IRQ static storage ptr
         std   Q$STAT,x
         puls  pc,cc
* Remove the ISR
L0671    leas  $04,s                   clean up stack
         ldy   R$U,u
L0676    cmpy  Q$STAT,x
         beq   L0682
         leax  POLSIZ,x
         decb
         bne   L0676
         clrb
         rts
L0682    pshs  b,cc
         orcc  #FIRQMask+IRQMask
         bra   L068F
* Move prev poll entry up one
L0688    ldb   POLSIZ,x
         stb   ,x+
         deca
         bne   L0688
L068F    lda   #POLSIZ
         dec   $01,s                   dec poll count on stack
         bne   L0688
L0695    clr   ,x+
         deca
         bne   L0695
         puls  pc,a,cc
L069C    leas  $04,s
L069E    comb
         ldb   #E$Poll
         rts

L06A2    ldy   <D.PolTbl
         ldx   <D.Init
         ldb   PollCnt,x
         bra   L06B0
L06AB    leay  $09,y
         decb
         beq   L069E
L06B0    lda   [,y]
         eora  $02,y
         bita  $03,y
         beq   L06AB
         ldu   $06,y
         pshs  y,b
         jsr   [<$04,y]
         puls  y,b
         bcs   L06AB
         rts

FNMLoad  pshs  u
         ldx   R$X,u
         lbsr  L0765
         bcs   L071C
         ldy   ,s
         stx   $04,y
         ldy   ,u
         ldx   $04,u
         ldd   #$0006
         os9   F$LDDDXY
         puls  y
         exg   y,u
         bra   L06F9

FNMLink  ldx   <D.Proc
         leay  <P$DATImg,x
         pshs  u
         ldx   R$X,u
         lda   R$A,u
         os9   F$FModul
         bcs   L071C
         leay  ,u
         puls  u
         stx   R$X,u
L06F9    std   R$D,u
         ldx   $06,y
         beq   L0703
         bitb  #$80
         beq   L0719
L0703    leax  $01,x
         beq   L0709
         stx   $06,y
L0709    ldx   $04,y
         ldy   ,y
         ldd   #$000B
         os9   F$LDDDXY
         bcs   L0718
         std   $06,u
L0718    rts
L0719    comb
         ldb   #$D1
L071C    puls  pc,u

FLoad    pshs  u
         ldx   R$X,u
         bsr   L0765
         bcs   L0749
         puls  y
L0728    pshs  y
         stx   $04,y
         ldy   ,u
         ldx   $04,u
         ldd   #$0006
         os9   F$LDDDXY
         ldx   ,s
         std   $01,x
         leax  ,u
         os9   F$ELink
         bcs   L0749
         ldx   ,s
         sty   $06,x
         stu   $08,x
L0749    puls  pc,u

IDetach0 pshs  u
         ldx   R$X,u
         bsr   L0765
         bcs   L0763
         puls  y
         ldd   <D.Proc
         pshs  y,b,a
         ldd   $08,y
         std   <D.Proc
         bsr   L0728
         puls  x
         stx   <D.Proc
L0763    puls  pc,u
L0765    os9   F$AllPrc
         bcc   L076B
         rts

L076B    leay  ,u
         ldu   #$0000
         pshs  u,y,x,b,a
         leas  <-$11,s
         clr   $07,s
         stu   ,s
         stu   $02,s
         ldu   <D.Proc
         stu   $04,s
         clr   $06,s
         lda   $0A,u
         sta   $0A,y
         sta   $0B,y
         lda   #EXEC.
         os9   I$Open
         lbcs  L0820
         sta   $06,s
         stx   <$13,s
         ldx   <$15,s
         os9   F$AllTsk
         lbcs  L0820
         stx   <D.Proc
L07A1    ldx   <$15,s
         lda   $0A,x
         adda  #$08
         bcc   L07AC
         lda   #$FF
L07AC    sta   $0A,x
         sta   $0B,x
         ldd   #$0009
         ldx   $02,s
         lbsr  L08A7
         bcs   L0820
         ldu   <$15,s
         lda   $06,u
         ldb   <D.SysTsk
         leau  $08,s
         pshs  x
         ldx   $04,s
         os9   F$Move
         puls  x
         ldd   ,u
         cmpd  #M$ID12
         bne   L081E
         ldd   $02,u
         subd  #$0009
         lbsr  L08A7
         bcs   L0820
         ldx   $04,s
         lda   $0A,x
         ldy   <$15,s
         sta   $0A,y
         sta   $0B,y
         leay  <$40,y
         tfr   y,d
         ldx   $02,s
         os9   F$VModul
         bcc   L07FC
         cmpb  #$E7
         beq   L0802
         bra   L0820
L07FC    ldd   $02,s
         addd  $0A,s
         std   $02,s
L0802    ldd   <$17,s
         bne   L07A1
         ldd   $04,u
         std   <$11,s
         ldx   ,u
         ldd   ,x
         std   <$17,s
         ldd   $06,u
         addd  #$0001
         beq   L07A1
         std   $06,u
         bra   L07A1
L081E    ldb   #$CD
L0820    stb   $07,s
         ldd   $04,s
         beq   L0828
         std   <D.Proc
L0828    lda   $06,s
         beq   L082F
         os9   I$Close
L082F    ldd   $02,s
         addd  #$1FFF
         lsra
         lsra
         lsra
         lsra
         lsra
         sta   $02,s
         ldb   ,s
         beq   L085E
         lsrb
         lsrb
         lsrb
         lsrb
         lsrb
         subb  $02,s
         beq   L085E
         ldx   <$15,s
         leax  <$40,x
         lsla
         leax  a,x
         clra
         tfr   d,y
         ldu   <D.BlkMap
L0856    ldd   ,x++
         clr   d,u
         leay  -$01,y
         bne   L0856
L085E    ldx   <$15,s
         lda   ,x
         os9   F$DelPrc
         ldd   <$17,s
         bne   L0873
         ldb   $07,s
         stb   <$12,s
         comb
         bra   L08A2
L0873    ldu   <D.ModDir
         ldx   <$11,s
         ldd   <$17,s
         leau  -$08,u
L087D    leau  $08,u
         cmpu  <D.ModEnd
         bcs   L088C
         comb
         ldb   #$DD
         stb   <$12,s
         bra   L08A2
L088C    cmpx  $04,u
         bne   L087D
         cmpd  [,u]
         bne   L087D
         ldd   $06,u
         beq   L089E
         subd  #$0001
         std   $06,u
L089E    stu   <$17,s
         clrb
L08A2    leas  <$11,s
         puls  pc,u,y,x,b,a
L08A7    pshs  y,x,b,a
         addd  $02,s
         std   $04,s
         cmpd  $08,s
         bls   L0908
         addd  #$1FFF
         lsra
         lsra
         lsra
         lsra
         lsra
         cmpa  #$07
         bhi   L08E8
         ldb   $08,s
         lsrb
         lsrb
         lsrb
         lsrb
         lsrb
         pshs  b
         exg   b,a
         subb  ,s+
         lsla
         ldu   <$1D,s
         leau  <$40,u
         leau  a,u
         clra
         tfr   d,x
         ldy   <D.BlkMap
         clra
         clrb
L08DC    tst   ,y+
         beq   L08ED
L08E0    addd  #$0001
         cmpy  <D.BlkMap+2
         bne   L08DC
L08E8    comb
         ldb   #$CF
         bra   L0912
L08ED    inc   -$01,y
         std   ,u++
         pshs  b,a
         ldd   $0A,s
         addd  #$2000
         std   $0A,s
         puls  b,a
         leax  -$01,x
         bne   L08E0
         ldx   <$1D,s
         os9   F$SetTsk
         bcs   L0912
L0908    lda   $0E,s
         ldx   $02,s
         ldy   ,s
         os9   I$Read
L0912    leas  $04,s
         puls  pc,x

ErrMess  fcc   /ERROR #/
         fcb   $2F,$3A,$30
         fcb   $0D
ErrMessL equ   *-ErrMess

FPerr    ldx   <D.Proc
         lda   <P$Path+2,x             get stderr path num
         beq   L0968
         leas  -ErrMessL,s             make space on stack for err mess
         leax  <ErrMess,pcr
         leay  ,s
L092F    lda   ,x+
         sta   ,y+
         cmpa  #$0D
         bne   L092F
         ldb   R$B,u
L0939    inc   $07,s
         subb  #$64
         bcc   L0939
L093F    dec   $08,s
         addb  #$0A
         bcc   L093F
         addb  #$30
         stb   $09,s
         ldx   <D.Proc
         ldu   P$SP,x
         leau  -ErrMessL,u
         lda   <D.SysTsk
         ldb   $06,x
         leax  ,s
         ldy   #ErrMessL
L0959    os9   F$Move
         leax  ,u
         ldu   <D.Proc
         lda   <P$Path+2,u
         os9   I$WritLn
         leas  ErrMessL,s              restore stack
L0968    rts

FIOQu    ldy   <D.Proc
L096C    lda   <P$IOQN,y
         beq   L098F
         cmpa  R$A,u
         bne   L098A
         clr   <P$IOQN,y
         os9   F$GProcP
         lbcs  L09EF
         clr   P$IOQP,y
         ldb   #S$Wake
         os9   F$Send
         ldu   <D.Proc
         bra   L0998
L098A    os9   F$GProcP
         bcc   L096C
L098F    lda   R$A,u
         ldu   <D.Proc
         os9   F$GProcP
         bcs   L09EF
L0998    leax  ,y
         lda   <P$IOQN,y
         beq   L09BA
         os9   F$GProcP
         bcs   L09EF
         ldb   P$Age,u

         ifeq  edition-$0C

* Note:  the following line is a bug
         cmpd  P$Age,y

         else

         cmpb  P$Age,y

         endc

         bls   L0998
         ldb   P$ID,u
         stb   <P$IOQN,x
         ldb   P$ID,x
         stb   P$IOQP,u
         clr   P$IOQP,y
         exg   y,u
         bra   L0998
L09BA    lda   P$ID,u
         sta   <P$IOQN,y
         lda   P$ID,y
         sta   P$IOQP,u
         ldx   #$0000
         os9   F$Sleep
         ldu   <D.Proc
         lda   P$IOQP,u
         beq   L09ED
         os9   F$GProcP
         bcs   L09ED
         lda   <P$IOQN,y
         beq   L09ED
         lda   <P$IOQN,u
         sta   <P$IOQN,y
         beq   L09ED
         clr   <P$IOQN,u
         os9   F$GProcP
         bcs   L09ED
         lda   P$IOQP,u
         sta   P$IOQP,y
L09ED    clr   P$IOQP,u
L09EF    rts

         emod
eom      equ   *
         end
