 lib environment
 sttl Text, swap, and low level fork
 pag
 name lfork
 global lfork,coptsk,asntxt,settxt,fretxt
 global swpout,doswap,doswa9,alswap,freswp
 global stxsm,sussm,rstump

*
* lfork
*
* Low level fork routine.  All new task info
* is set up in new task address space and memory.
*

lfork inc gentid+1 make new task id
 bne lfork1
 inc gentid generate new task id
 bpl lfork1
 clr gentid set back to 0
 bra lfork repeat
lfork1 ldu #0 pointer to new task structure
 ldd gentid get task id
 ldx tsktab point to task table
lfork2 tst tsstat,x get status of this entry
 bne lfork3 is it used?
 cmpu #0 have we found an emty entry?
 bne lfork4
 tfr x,u save entry position
 bra lfork4
lfork3 cmpd tstid,x check task id
 beq lfork if same, start all over
lfork4 leax TSKSIZ,x get to next entry
 cmpx tskend end of table?
 bne lfork2
 cmpu #0 did we find an entry?
 beq lfork8
 ldx utask point to current task entry
 bsr coptsk copy task data
 sts umark0 save stacks
lfork5 ldb usizes get total stack & data
 addb usized
 cmpb corcnt have enough core?
 bls lfork6
 sts umark2 mark stack position
 ldx utask point to task
 lda umapno get map number
 pshs u,x,a save new and old task pointers
 tst MAXMAP any memory maps?
 beq 00f
 clr umapno zero map number
00 lda #TCREAT set status to create
 sta tsstat,x
 clrb no free memory
 tfr u,x get new task
 stx utask temp change of utask
 jsr swpout swap it out
 puls u,x,a restore task pointers
 sta umapno reset map number
 stx utask reset real utask pointer
 lda tsmode,u get modes
 ora #TSWAPO show swapped
 sta tsmode,u
 lda #TRUN set back to run
 sta tsstat,x in old task
 lda tsmode,x invalidate map
 ora #TNOMAP
 sta tsmode,x
 bra lfork7 go exit
lfork6 lbsr dupum duplicate user space
lfork7 tfr u,x
 jsr putrun put on ready list
 ldd #0 return 0 to old task
 rts return
lfork8 ldx #tskofl point to message
 lbra blowup blowup system!


 pag
*
* coptsk
*
* Copy old task table entry to new entry.  X is
* pointing to old entry, U is pointing to new.
*

coptsk ldd tsuid,x get user id
 std tsuid,u
 lda tssize,x get swap image size
 sta tssize,u
 lda tsutop,x get user top
 sta tsutop,u set in new
 ldy tstext,x get text pointer
 sty tstext,u
 beq copts2 active text segment?
 inc txcnt,y update reference counts
 inc txlref,y
copts2 ldb tsact,x copy scheduling info
 stb tsact,u
 ldb tsprb,x get priority bias
 stb tsprb,u set in new task
 ldd tstty,x give same tty
 std tstty,u
 lda #TRUN set status to running
 sta tsstat,u
 lda #TCORE show in memory
 sta tsmode,u
 ldd tstid,x get old task id
 std tstidp,u set as parent task id
 ldd gentid get new task id
 std tstid,u set in new entry
 ldd #0
 stb tsage,u
 std tsalrm,u set alarm count
 ldx ucrdir update direct reference
 inc frefct,x
 ldx #ufiles point to open files
 ldb #UNFILS set count
copts4 ldy 0,x get file pointer
 beq copts5 null?
 inc ofrfct,y update file reference count
copts5 leax 2,x get to next file
 decb dec the count
 bne copts4 loop til done
 rts return

 pag

*
* asntxt
*
* Assign a task a text table entry.  If one exists -
* link up to it, else make new entry.  There is some
* pretty hairy stuff in here since swapping may need
* to take place.  On entry, Y points to fdn of file,
* and B has text size.
*

asntxt pshs b,y save args
 ldx txttab point to text table
 ldd #0 set up null pointer
 pshs d
 ldb stxt get text entry count
 pshs b save it
 ldd 4,s get fdn
asntx2 cmpd txfpt,x look for same fdn
 beq asntx5
 tst txfpt,x free table entry here?
 bne asntx4
 tst 1,s have we found an empty slot yet?
 bne asntx4 if so - skip
 stx 1,s else - save this guy
asntx4 leax TXSSIZ,x get to next text entry
 dec 0,s dec the count
 bne asntx2 end of list?
 puls b clean up stack
 ldx 0,s++ get empty slot pointer
 bne settxt was there one empty?
 ldx #nomtxt point to blowup message
 jmp blowup blow away system!
asntx5 leas 3,s clean up stack
 ldb 0,s get text size
 stb usizet
 inc txcnt,x bump text ref count
 ldu utask point to task entry
 stx tstext,u set text pointer
asntx6 tst txlref,x any loaded references to text?
 beq asntx7
 inc txlref,x show this guys reference
 pshs x save text ptr
 lda txsiz,x get text size
 leax txmap,x point to mem map
 ldy #umem point to user mem map
asnt65 ldb 0,x+ get segment
 stb 0,y+ transfer to user map
 deca dec count
 bne asnt65
 puls x reset text pointer
 puls b,y,pc return
asntx7 puls b,y clean up stack
 sts umark2 for swap too
 ldx utask point to task
 ldb #1 set to free memory
 jsr swpout swap out this guy
 ldu utask point to task entry
 lda tsmode,u set mode to 'swapped'
 ora #TSWAPO
 sta tsmode,u save new modes
 jmp change go change tasks
 pag

*
* settxt
*
* Setup a new text table entry.  Only called from above.
*

settxt clr txlref,x zero loaded ref counter
 lda #1 set ref count to 1
 sta txcnt,x
 puls b get text size
 stb txsiz,x save in entry
 stb usizet save in user block
 puls d get fdn
 std txfpt,x save in entry
 ldb txsiz,x reset text size
 pshs x save entry
 clra make size 16 bits
 jsr alswap allocate swap space
 ldx 0,s point to text entry
 sty txadr,x save swap address in entry
 ldb txsiz,x get text size
 jsr mktxt make text map
 cmpd #0 did we have to swap - expand?
 beq settx4 if 0 - we did not
 lda usized get data size (expanded form)
 ldx 0,s get text pointer
 suba txsiz,x put back to real data size
 sta usized
 lda txsiz,x get real text size
 sta usizet reset in ublock
 ldu utask point to task entry
 lda tssize,u get swap size
 suba usizet remove text size
 sta tssize,u save new
 lda usizet get text size
 ldu #umem point to user map
 leax txmap,x point to text map
settx2 ldb 0,u+ copy to text map
 stb 0,x+
 deca dec text count
 bne settx2 finished?
settx4 ldx 0,s reset text pointer
 ldd #0 set up to read in file
 std uipos
 std uistrt set start address
 ldd #BHDSIZ set binary header size
 std uipos2 this is file position
 ldd usarg3 get byte size of text
 std uicnt
 lda #1 set user space
 sta uiosp
 ldy txfpt,x get fdn
 jsr filrd read in text from file
 ldx utask point to task entry
 lda tsmode,x get task modes
 ora #TLOCK lock task in core (temporary)
 sta tsmode,x
 ldx 0,s get text entry
 ldb #1 set write flag
 lda txsiz,x get text size
 ldy txadr,x get swap address
 leax txmap,x point to text memory map
 ldu utask get task pointer
 jsr doswap swap out text
 ldy utask point to task entry
 lda tsmode,y get task modes
 anda #!TLOCK unlock task
 sta tsmode,y save new modes
 puls x point to text entry
 ldu txfpt,x point to fdn
 inc frefct,u bump its reference count
 lda fstat,u get fdn status
 ora #FTEXT set text bit
 sta fstat,u save new status
 stx tstext,y set text pointer in task entry
 inc txlref,x bump loaded reference count
 rts return
 pag

*
* fretxt
*
* Free the text entry associated with the current task.
*

fretxt ldx utask point to task
 ldy tstext,x get text entry
 bne fretx2 is there one?
fretx1 rts return
fretx2 bsr decref dec the reference count
 ldd #0 zero out entries
 std tstext,x text pointer in task
 dec txcnt,y dec the text ref count
 bne fretx1 is this last ref?
 ldx txfpt,y point to its fdn
 std txfpt,y zero fdn pointer in entry
 ldu txadr,y get swap address
 ldb txsiz,y get swap size
 jsr freswp free up swap space
 clr txsiz,y zero text size
 lda fstat,x get fdn status
 anda #!FTEXT clear text bit
 sta fstat,x save new status
 jmp frefdn free up the fdn

*
* decref
*
* Decrement the 'loaded' reference counter in the text entry
* pointed at by Y.  X points to task.
*

decref cmpy #0 is there a text entry?
 bne decre2
decre1 rts return
decre2 lda txlref,y get loaded ref count
 beq decre1 if no loaded - return
 dec txlref,y dec the loaded counter
 bne decre1 last one?
 jmp frtxm go free text's memory

 pag

*
* swpout
*
* Swap out the task whose text entry is in X.  B will be
* non-zero if we should free up the memory after the swap.
*

swpout lda tssize,x get swap image size
 cmpa #NBLKS system error check
 bhi swpou9
 pshs d,x save info
 tfr a,b get size in b
 clra make 16 bits
 jsr alswap allocate swap space
 ldx 2,s get the task
 sty tsswap,x save the swap address
 ldy tstext,x point to text entry
 beq swpou3 no text?
 bsr decref dec loaded reference
swpou3 lda tsmode,x get task modes
 ora #TLOCK set lock bit (temporary)
 sta tsmode,x save new modes
 ldb #1 set write flag
 lda 0,s get size count
 ldy tsswap,x get swap address
 ldx #0 set for user mem swap
 ldu 2,s get task pointer
 bsr doswap do the actual swap out
 tst 1,s should we free memory?
 beq swpou4
 lda 0,s get size
 ldu 2,s get task pointer
 jsr frems go free memory
swpou4 ldx 2,s point to task
 lda tsmode,x get task modes
 anda #!(TLOCK|TCORE) set new modes
 ora #TNOMAP invalidate memory map
 sta tsmode,x
 clr tsage,x reset age counter
 tst rdytci swapper waiting for someone?
 beq swpou6
 clr rdytci clear out the flag
 ldy #rdytci point to it
 jsr wakeup wakeup those sleeping
swpou6 puls d,x,pc return
swpou9 pshs x save task entry
 ldx #sysser point to message
 jmp blowup bye bye!

 pag

*
* doswap
*
* Do actual task swap.  If B is zero, swap in, else swap out.
* A has the segment count for swap.  If X is non-zero, we
* are doing a text segment swap and X points to text map.
* Y contains the swap address (not the disk address!).
*

doswap pshs d,x,y,u save all args
 lda #$20 "swap out"
 tstb check direction
 bne 0f
 lda #$40 "swap in"
0 ora LIGHTS
 sta LIGHTS
doswa1 ldy #swpbuf point to swap buffer header
 lda bfflag,y get flags
 bita #BFALOC is it busy?
 beq doswa2
 ora #BFREQ set request bit
 sta bfflag,y save new flags
 ldb #SWAPPR-1 set priority
 jsr sleep sleep for buffer header
 bra doswa1 repeat test
doswa2 lda #BFALOC set buffer busy bit
 tst 1,s are we reading?
 bne doswa3
 ora #BFRWF set read flag
doswa3 sta bfflag,y save new flags
 ldb 0,s get size
 clra make 16 bits
 std bfxfc,y save as transfer count
 ldd sswd get swap device number
 std bfdvn,y set in buffer
 clr bfxadr,y *** Controller Specific ***
 ldd #swppag point to swap page map
 std bfadr,y set in buffer
 ldd 4,s get swap address
 subd #1 remove address bias
 clr 0,-s save space
 aslb multiply by 8
 rola
 rol 0,s
 aslb
 rola
 rol 0,s
 aslb
 rola
 rol 0,s
 addd swpbeg+1 add to start address
 std bfblck,y save block number
 puls a get hi part
 adca swpbeg finish calc
 sta bfblch,y save hi part
 ldu 6,s get task entry
 ldd 0,s get size and r/w flag
 ldx 2,s get map pointer
 bne doswa6 text map here?
 jsr sussm setup user map stuff for swap
 bra doswa7
doswa6 jsr stxsm set up text map for swap
doswa7 ldx #blktab point to block device table
 lda sswd get swap major device number
 ldb #BLKSIZ set entry size
 mul calculate position in list
 leax d,x point to entry
 ldy #swpbuf point to buffer header
 jsr [blkio,x] go do actual transfer
 pshs y,cc
 seti mask interrupts
dosw75 lda bfflag,y check for io done
 bita #BFIOF
 bne doswa8
 ldb #SWAPPR-1 set priority
 jsr sleep wait for io
 ldy 1,s reset buffer ptr
 bra dosw75
doswa8 puls y,cc reset regs
 lda bfflag,y get flags
 bita #BFERR swap error?
 bne doswa9
 bita #BFRWF were we reading?
 beq dosw82
 ldx 2,s check for text type
 bne dosw82
 jsr rstump reset user map info
dosw82 lda bfflag,y get flags
 bita #BFREQ someone need buffer?
 beq dosw85
 jsr wakeup if so - wake them up
dosw85 clr bfflag,y clear out buffer flags
 lda #!$20 "swap out"
 tst 1,s check direction
 bne 0f
 lda #!$40 "swap in"
0 pshs a
 lda LIGHTS
 anda ,s+
 sta LIGHTS
 puls d,x,y,u,pc return
doswa9 ldx #swerms point to message
 jmp blowup blow away system!

 pag

*
* alswap
*
* Allocate swap space.  On entry, D has block count.
* If no space - blowup system.  Return swap address
* in Y.  Note that the swap addresses run from 1 thru
* the number of blocks reserved for swap.  To calc
* device address, add swap address to 'swpbeg'-1.
*

alswap ldx #swpmap point to swap map
alswa2 ldu 2,x check for 0 count
 beq alswa3
 cmpd 2,x search for high enough count
 bls alswa4 enough here?
 leax 4,x move to next entry
 cmpx swpend end of swap table?
 bne alswa2
alswa3 ldx #nswpsp point to message
 jmp blowup blowup system!
alswa4 ldu 0,x get block number
 pshs u save it
 leau d,u rip off blocks needed
 stu 0,x save new block number of group
 pshs d save count
 ldd 2,x get group count
 subd 0,s++ subtract off what we are taking
 std 2,x save as new group count
 beq alswa6 any left?
 puls y,pc return address in Y
alswa6 leax 4,x remove entry by compacting table
 cmpx swpend end of table?
 beq alswa8
 ldd 0,x get an entry
 std -4,x move it down
 ldd 2,x
 std -2,x
 bne alswa6 zero block count here?
alswa8 puls y,pc return block
 pag

*
* freswp
*
* Free up swap space.  Block count is in B and swap
* address is in U.  Preserve X and Y.  If overflow
* swap table - blow up system!
*

freswp clra sign extend count
 pshs d,x,y,u save all regs
 ldx #swpmap point to swap map
 ldd 6,s get swap address
fresw2 ldu 0,x check for zero count in group
 beq fresw4
 cmpd 0,x check gap
 blo fresw4
 leax 4,x move to next group
 cmpx swpend end of swap table?
 bne fresw2
fresw3 ldx #swtofl point to message
 jmp blowup system!
fresw4 cmpx #swpmap start of map?
 beq fresw6
 ldd -4,x check if contiguous to previous
 addd -2,x
 cmpd 6,s
 bne fresw6
 ldd 0,s get count
 addd -2,x add to previous count
 std -2,x save as new count
 addd -4,x check if we can combine more
 cmpd 0,x
 bne fres55 finished?
 ldd 2,x get next count
 beq fres55 finished?
 addd -2,x add it to previous
 std -2,x save new count
fresw5 leax 4,x compact table
 ldd 0,x move data down
 std -4,x
 ldd 2,x
 std -2,x
 bne fresw5 last element?
fres55 puls d,x,y,u,pc return
fresw6 ldd 0,x end of list?
 beq fresw8
 ldd 6,s get address
 addd 0,s add to count
 cmpd 0,x contig with upper group?
 bne fresw7
 ldd 6,s get address
 std 0,x save as new start address
 ldd 0,s get count
 addd 2,x add to previous count
 std 2,x
 puls d,x,y,u,pc return
fresw7 pshs x save position
 ldx swpend get to table end
 leax -4,x back up an entry
 ldd 0,x is table full?
 bne fresw3
fres75 ldd -4,x move entries up one
 std 0,x
 ldd -2,x
 std 2,x
 leax -4,x back up one
 cmpx 0,s finished?
 bne fres75
 puls x reset stack
fresw8 cmpx swpend end of table?
 beq fresw3 if so - blowup
 ldd 6,s get address
 std 0,x set in table
 ldd 0,s get count
 std 2,x set in table
 puls d,x,y,u,pc return

 pag

*
* stxsm
*
* Set up text segment memory map.
*

stxsm ldu #swppag point to swap map
stxsm2 ldb 0,x+ transefr segments to map
 stb 0,u+
 deca dec the count
 bne stxsm2
 lda DSKTRM mark end of list
 sta 0,u
 rts return

*
* sussm
*
* Set up regular swap (data & stack space) memory map.
*

sussm pshs u save task ptr
 ldu #swppag point to swap map
 tstb are we reading
 beq sussm5 if so - jump ahead
 puls y get task pointer
 lda tsutop,y get user block segment
 jsr mapxbf map into XBUFFER
 ldy #XBUFFR+(usizet-USRLOC<<12) point to size info
 ldx #XBUFFR+(umem-USRLOC<<12) point to mem map
 lda 0,y+ get text size
 leax a,x skip text pages
 lda 0,y+ get data size
 beq sussm3
sussm2 ldb 0,x+ get a segment
 stb 0,u+ transfer it
 deca dec the count
 bne sussm2
sussm3 lda 0,y get stack size
 pshs a save count
 nega
 ldx #XBUFFR+(umem-USRLOC<<12) point to mem map
 leax NBLKS,x point to end of map
 leax a,x back up to stack start
sussm4 ldb 0,x+ get segment
 stb 0,u+
 dec 0,s dec the count
 bne sussm4
 lda DSKTRM mark end of list
 sta 0,u
 puls a,pc return
sussm5 ldx swpptr get segment pointer
 leas 2,s clean stack
 lda swpisz get size count
 bra stxsm2 go transfer map

*
* rstump
*
* Reset user map after swap in of data and stack
*

rstump pshs y save pointer
 ldx #swppag point to map
 lda swpisz get swap size
 deca bias it
 leax a,x point to last segment (user block)
 lda 0,x get the segment
 jsr mapxbf map into XBUFFER
 ldy #XBUFFR+(usizet-USRLOC<<12) point to size info
 ldx #swppag point to swap map
 ldu #XBUFFR+(umem-USRLOC<<12) point to user map
 lda 0,y+ get text size
 leau a,u skip text part
 lda 0,y+ get data size
 beq rstum3
rstum2 ldb 0,x+ transfer data segs
 stb 0,u+
 deca dec the count
 bne rstum2
rstum3 ldu #XBUFFR+(umem-USRLOC<<12) point to user map
 leau NBLKS,u point to end of map
 lda 0,y get stack size
 nega back up to stack start
 leau a,u
 lda 0,y get stack size
rstum4 ldb 0,x+ transfer stack segs
 stb 0,u+
 deca dec the count
 bne rstum4
 ldx XBUFFR+(utask-USRLOC<<12) get task pointer
 stb tsutop,x set user top
 tst MAXMAP any maps in system
 beq rstum6 no - don't worry about this!
 ldb XBUFFR+(umapno-USRLOC<<12) get map number
 bne rstum6
 jsr getmap get new map number
 stb XBUFFR+(umapno-USRLOC<<12) set map number
 stb XBUFFR+(urelod-USRLOC<<12) set reload flag
rstum6 puls y,pc return
