        TITLE   SDOS/MT Version 1.2 Copyright (C) 1980 Software Dynamics
        PAGE    Things To Do
;>>>>> to assemble, refer to SDxxMT12.DO, on the Components pack <<<<<
        with    wi=105,de=51
mtsubversion    equ     'd      (other versions are lurking in the field)

; Short run problems:
;    (none known)

; SDMT12D.ASM 11/20/82
;    Cleaned up known bugs in SDMT12C:
;       There is now a UCB:OLDENCRYPTEDKEY for each user
;       Checks properly for UserSpace > Size(Defaultprogram)
;       Now uses SDOS11g "SYSCALL:GETSERIALNUMBER" in decrypting loader
;       Modified SYSCALL:DELAY logic to use SETFUSE and TESTFUSE; this
;          speeds up scheduler when a job is waiting for time to pass.
;       Added SYSCALL:JOBCONTROL calls to allow extra jobs to spun off
;          in user spaces that have no terminals attached.
;    Big effort to improve performance and responsiveness by several means:
;       Single character I/O path efficiency enhanced by better coding
;       Dedicated a page to each user for efficient allocation by ALLOCATE1PAGE
;       Modified READA to allocate only 1 page, no matter what size reply buffer
;       Added IOQUANTUMTICKS, COMPUTEQUANTUMTICKS, CRASHINFOPTR to /MT prims table
;       Added IOQ for I/O bound users, and "fair" policy scheduler to ensure
;          no job starves to death, and each gets equal portions of CPU
;    Other trivia in prepartion for SDMT13.ASM

; Things to do over the long run:

; add spooler [version 1.3 ?]

; verify that SELECTBANK is in ROM (by checking that what the I/O package
;    passes as an address is the same as that referenced by the boot ROM)
;    [do a flow analysis of the MT primitives at MT initialization;
;    version 2.0 ?]
        PAGE    Templates & Equates
        INCLUDE SDOS11DEFS.ASM
        IFUND   M6800
M6800   EQU     1
M6801   EQU     0
M6809   EQU     0
        FIN     M6800

        IFUND   MTVERSION
MTVERSION       EQU     $12     1.2 in hex
        FIN

LINEFLAGS       EQU     $F0     user's lineflags
USERSPSAVE      EQU     $F1     location of stack pointer in each user's space

LOAD:TYPE0      EQU     0
                IF      M6809
LOAD:TYPE1      EQU     2
                ELSE
LOAD:TYPE1      EQU     1
                FIN
LOAD:TYPE2      EQU     2
LOAD:TYPE3      EQU     3
LOAD:ENCRYPTED  EQU     5
TOPOINTER       EQU     TEMPX

capmap:refcount equ     0       references to this object
capmap:queue    equ     1       first user queued on this object

queue:head      equ     0       head of queue
queue:tail      equ     1       tail of queue

; Job State definitions
js:free equ 0 this job available to be used
js:busy equ 1 this job is not free to be used
js:dying       equ     2       this job is dead, but doesn't know it yet

                ORG     0

                RMB     1       user 1 will get this channel
ERRMSGCHANNEL   RMB     1       channel to use for reading errormsgs.sys
LOADCHANNEL     RMB     1       channel to use for loading programs
AVAILABLECHANNELS EQU   *       channels available for general usage
CLOCKCHANNEL    RMB     1       channel to use for reading the clock in INIT
                page    User Control Block Definitions
                ORG     $0

UCB:SCB         RMB     128     user's syscall block
UCB:JOBSTATE    RMB     1       indicates whether job is free, busy or dying
UCB:BUFFER      RMB     1       address of working buffer for syscall
UCB:BUFFERSIZE  RMB     1       size of working buffer
UCB:NEXTONQ     RMB     1       next UCB on current queue
UCB:CHANNELMAP  RMB     2       name of logical to physical channel map
UCB:USERNUMBER  RMB     1       user number
UCB:USERSCB     RMB     2       address of syscall block in userspace
UCB:GIVERPLEN   RMB     1       <>0 --> return RPLEN to user
UCB:LOGCHANNEL  RMB     1       user is logging to this real channel
UCB:CHAN0       RMB     1       real channel 0 for this user
UCB:LFCHAN      RMB     1       channel to use for getting lineflags
*                               contains channel to talk to user
*                               if = :FF, no terminal attached to this job
UCB:LFNEXT      RMB     1       points to next ucb in system
UCB:DELAY       RMB     2       delay time increment when in delay queue
UCB:PNEEDED     RMB     1       number of pages being waited for
UCB:LASTERROR   RMB     2       last error for this user
UCB:TOPMEM      RMB     2       top of user space
UCB:USERCHAN    RMB     1       user's channel number, this operation
UCB:USERWRBUF   RMB     2       user's wrbuf, this operation
UCB:USERWRLEN   RMB     2       user's wrlen, this operation
UCB:USERRPLEN   RMB     2       user's rplen, this operation
UCB:USERRDBUF   RMB     2       user's rdbuf, this operation
UCB:USERRDLEN   RMB     2       user's rdlen, this operation
UCB:STACKP      RMB     2       system stack pointer for this user
UCB:QUEUEERR    RMB     2       holding tank for errors while queued
UCB:VTFLAG      RMB     1       <>0 if current channel is vt device
UCB:LINEFLAGS   RMB     1       lineflags hint for user
UCB:ALLOCATEDPAGECNT RMB 1      contains # pages in variable size allocation
UCB:ALLOCATEDPAGESBASE RMB 1    page number of 1st page of variable allocation
UCB:PERMANENTPAGEBUSY RMB 1     <>0 --> permanent page has been allocated
UCB:PERMANENTPAGE RMB   1       page permanently allocated as buffer
UCB:USERCPUBOUND RMB    1       <>0 --> user has not recently done VT I/O
UCB:REMAININGQUANTUM RMB 1      = # ticks left in user's time slice
UCB:OLDKEYENCRYPTED RMB 8       old key encrypted application suite signature
UCB:JOBCAPABILITY RMB   16      holds capability that matches this job
UCB:CHANNELMAPT RMB     32      maps user channel #s to actual channel #s
*                               1st byte is max count of user channels
*                               bytes 1-31 hold actual channel numbers
*                               User channel 0 is held in UCB:CHAN0
UCB:CONSOLELEN  RMB     1       length of console name, which follows
UCB:CONSOLESTR  RMB     0       variable length string
                if      *>/256
                ?? UCB displacements not addressable by 6800/6801 ??
                fin
                ORG     UCB:SCB+512 force convenient page bound
UCB:STACK       RMB     0       top of system stack for this user
UCB:SIZE        EQU     *-UCB:SCB
        PAGE    Virtual Terminal Driver information unique to /MT
CC:WRITEANOWAIT EQU     $30     write ascii to VT device with no wait
CC:SETTIMESHARE EQU     $31     say that MT is running and get prims
CC:WRITEBNOWAIT EQU     $33     write binary to VT device with no wait

SC:ATTENTIONCK  EQU     $30     see if a particular VT device has attention
SC:ALLSTATUS    EQU     $33     see if any VT device has changed status
SC:GETLINEFLAGSHINT     EQU     $34     get lineflags hint--dont reset in DCB

VT:PRINTER      EQU     $20
VT:CONSOLE      EQU     $40
                PAGE    Variables
                ORG     $20

SYSCALLX        FDB     OPCODES&$FF00
DECBUF          RMB     3       conversion buffer for DERR
ERRORNUMBER     RMB     2       this MUST follow DECBUF!!
ERRORADDRESS    RMB     2       for use in debugging
LASTERROR       RMB     2       last internal error
USERLASTERROR   RMB     2       last error for current user
TOPMEM          RMB     2       top of memory for current user
TSTEMP          RMB     2
PAGEBASE        RMB     1       used for buffer allocation
                FCB     0
THISCOUNT       RMB     1
LASTBASE        RMB     1
LASTCOUNT       RMB     1
NPAGES          RMB     1
                FCB     0
NAMESCANNEDCNT  RMB     2       bytes scanned off user-supplied filename
STRINGBUFFER    RMB     6       ASCII buffer for DERR
BUFFER          RMB     2       for GET1BYTES and GET2BYTES
STARTADDRESS    RMB     2       execution start address for LOAD and CHAIN
LOADCOUNT       RMB     2       size of load block remaining to be loaded
USERLOADADDRESS RMB     2       where to load into user space
PAGEMAPINDEX    FDB     PAGEMAP&$FF00   for fiddling with the page map
POINTERINBUFFER RMB     2       temporary buffer pointer for display error
MAPSIZE         FCB     0       size of bufferspace, in pages
PAGEMAPBASE     FDB     PAGEMAP+ENDOFTIMESHARE//256
NUMUSERS        FCB     0       number of users, this invocation
ucbchain        FDB     0       head of list of ucbs chained thru UCB:LFNEXT
NUMPAGES        FCB     0       number of pages available for allocation
DERRCRFLAG      FCB     0       put a CR on the end of an error message
DELAYADJUST     RMB     2       amount by which to adjust delay queue
capslot         rmb     1       capability slot number matches below
captablex       fdb     captable        used for indexing into the capability table
capmapx         fdb     capmap  used for indexing into the capability map
loginexists     fcb     0       1 -> LOGIN program exists
                page
DECRYPTBUFPTR FDB DECRYPTBUFFER POINTER TO SCAN DECRYPTBUFFER

NKEYS   FCB     CHANGED TYPE 5 RECORD: KEY COUNT

OKTODECRYPTFLAG FCB     CHANGED 1 --> OK TO DECRYPT THIS MODULE

ucbpointer      rmb     2       used to scan all ucbs
                PAGE
SERVICEDIO      FCB     0                      bit n sez user n was serviced recently
CURRENTUSER     FCB     1                      number of current user
CURRENTUCB      FDB     FIRSTUCB               address of current user's UCB
RUNQ            fcb     FIRSTUCB/256,changed   ready-to-run queue
IOQ             FDB     0                      queue for users doing I/O
INPUTQ          FDB     0                      waiting-for-input queue
OUTPUTQ         FDB     0                      waiting-for-output queue
SPACEQ          FDB     0                      waiting-for-space queue
DELAYQ          FDB     0                      delay user queue
QUEUE:UCB       FDB     0                      used in queue management
        PAGE    Timesharing Primitives
SDOSMTSTATUSCHANGED RMB 1       0 --> no change in any user status
;  Note: SDOSMTSTATUSCHANGED is set by VT driver, who knows its location
;  is 1 byte preceding the WRBUF specified on a CC:SETTIMESHARE call.

*       Timesharing primitives reside in the I/O package.  The following
*       vector is filled in by the Initialize Timesharing SYSCALL, establishing
*       a connection between SDOS/MT and the I/O package.

USERSPACESYSCALL        RMB     3       where the user goes for syscalls
USERSELECT      RMB     3       select a user address space for subsequent use
USERCURRENTSIZE RMB     3       get size of user space; returns in (A,B)
RETURNTOUSER    RMB     3       return to user space selected above
SETQUANTUM      RMB     3       set quantum (60 Hz clock) for this user
COPYTOSYSTEM.BIG RMB    3       copy from selected user space to system space
COPYTOUSER.BIG  RMB     3       copy from system space to selected user space
COPYUSERTODX    RMB     3       copy two bytes from selected user space to D & X
COPYATOUSER     RMB     3       copy A to selected user space (addressed by X)
COPYDTOUSER     RMB     3       copy D to selected user space (addressed by X)
COPYUSERTOA     RMB     3       copy byte from user space to (A)
SETFUSE         RMB     3       set delay timer to (X)
TESTFUSE        RMB     3       read remaining delay time to (X)
CRASHINFOPTR    FDB     $C000   default: where /MT should place crash information
IOQUANTUMTICKS  FCB     3       default time slice for I/O users
CPUQUANTUMTICKS FCB     6       default time slice for compute-bound users
SIZETSPRIMS     EQU     *-USERSPACESYSCALL

                IF      *>/$F0
                ? page zero capacity exceeded ?
                FIN
                PAGE    Allocation Tables
                ORG     $100

; The pagemap must begin on a page boundary and is used by SD/MT to keep 
; track of which user (or the system, for that matter) owns which
; dynamically attainable pages.  Each byte corresponds to a page in the
; 680x address space; the value of a byte indicates the current status of
; the corresponding page: =0 means the page is available, =$4x means the
; page has been allocated to user x, any other value means to leave that
; page alone.  The map is assembled with all pages "taken", and the
; initialize code suitably alters the map, so that the correct pages are
; available.

PAGEMAP RPT     256
                FCB     $FF

; The device map is indexed by a real channel number and holds the
; device type information: vt:console, vt:printer, or 0.

DEVICEMAP
        rmb     256

; The captable must begin on a page boundary and is used by SD/MT to
; keep track of the capabilities in use within SD/MT.  Each slot of 16
; bytes is used to record a 16-byte capability to an object.
; This table is managed using capmap, below.

captable        rmb     8*4*16  8 users x 4 slots/user x 16 bytes/slot
        page
; The capmap must begin on a page boundary and is used by SD/MT to keep
; track of the capability slots contained in captable.  Each 2-byte entry
; in capmap corresponds to a 16-byte slot in captable.  The first byte of
; each capmap entry is a reference count, indicating the number of lock
; requests made against this object.  The second byte of the capmap
; entry is the msb of the ucb address of the first user enqueued for this
; object (0 -> none in queue); subsequent users are linked to the first user
; (with the ucb:nextonq field).

capmap  rpt     8*4
        fcb     0,0

; The channelstack is a stack of available real channels (not necessarily
; all available in a given configuration).  When a real channel is needed,
; it is removed from the top of the stack; when no longer needed, it is
; returned to the top of the stack.  A check is made for stack underflow,
; but no check is made for stack overflow.  Channel 255 is not available:
; it is used to indicate a closed channel.

channelstackp   fdb     channelstack
channelstackc   fcb     257-availablechannels

channelstack    fcb     0
                rpt     256-availablechannels
                fcb     *-channelstack+availablechannels-1

CONTEXTBLOCK    RMB     16      holds user context while unwinding stack
targetcap       rmb     16      capability which is target of search


DECRYPTBUFFER     ; THIS IS WHERE CHUNKS OF 8 BYTES GET READ FOR DECRYPTION
        fcb     0,1,2,3,4,5,6,7 Loader decryption area
DECRYPTBUFFEREND  ; END OF DECRYPT BUFFER

NEWKEYENCRYPTED ; ENCRYPTED VERSION OF KEY USED TO LOAD THIS FILE
        FCB     0,0,0,0,0,0,0,0 SPACE TO HOLD 8 BYTE KEY

ILKCAP          ; SEED FOR INTERLOCK CAPABILITY SUPPLIED BY ILK.CREATE
        RMB     16

        PAGE    Internal SYCALL control blocks
*       INTERNAL SYSCALL CONTROL BLOCKS

BYTEMODE        EQU     0       used by READA

DISPOUT ; used to write error number on console
        FCB     SYSCALL:WRITEA,READA:SCLEN,CHANGED,IGNORED
        FDB     STRINGBUFFER,CHANGED    BUFFER ADDRESS & LENGTH

DISPREADB3      ; USED TO READ POINTER FROM ERRORMSGS.SYS
        FCB     SYSCALL:READB,READB:SCLEN,ERRMSGCHANNEL,IGNORED
        FDB     IGNORED,IGNORED WRBUF,WRLEN
        FDB     CHANGED,DISPPOS1+1,3    REPLY LENGTH, BUFFER ADDRESS & LENGTH

DISPPOS1        ; THESE 4 BYTES GET MODIFIED BY DISPREADB3, DISPUSERERROR
        FCB     0,CHANGED,CHANGED,CHANGED

DISPGETCHAR     ; USED TO READ ERROR MESSAGE FROM ERRORMSGS.SYS
        FCB     SYSCALL:READA,READA:SCLEN,ERRMSGCHANNEL,BYTEMODE
        FDB     IGNORED,IGNORED WRBUF,WRLEN
        FDB     CHANGED,BUFFER,1        rplen, rdbuf, rdlen

GETDEVTYP       ; used to get device type of channel just opened
        FCB     SYSCALL:STATUS,STATUS:SCLEN,CHANGED,SC:GETTYPE
        FDB     IGNORED,IGNORED
        FDB     CHANGED,BUFFER,1        rplen, rdbuf, rdlen

DUMPBUFFERS     ; used to dump the device buffers at EXIT
        FCB     SYSCALL:CONTROL,CONTROL:SCLEN,CHANGED,CC:DUMPBUFFERS
        PAGE
ATTENTIONCK     ; used to check for attention on a virtual terminal device
        FCB     SYSCALL:STATUS,STATUS:SCLEN,CHANGED,SC:ATTENTIONCK
        FDB     IGNORED,IGNORED
        FDB     CHANGED,BUFFER,1

CKANYLINE       ; has the status of any port changed?
                ; ASSERT: real channel 0 is open to user 1's console
        FCB     SYSCALL:STATUS,STATUS:SCLEN,0,SC:ALLSTATUS
        FDB     IGNORED,IGNORED
        FDB     CHANGED,BUFFER,1

READYLINE       ; used to stage an input line
        FCB     SYSCALL:CONTROL,CONTROL:SCLEN,CHANGED,CC:ACTIVATIONCK

GETLINEFLAGS    ; get virtual terminal line flags hint for this user
        FCB     SYSCALL:STATUS,STATUS:SCLEN,CHANGED,SC:GETLINEFLAGSHINT
        FDB     IGNORED,IGNORED
        FDB     CHANGED,BUFFER,1

CLOSELOGCHAN    ; used to close the log channel and the real console
        FCB     SYSCALL:CLOSE,CLOSE:SCLEN,CHANGED

OPENLFCHAN      ; used to open the real console
        FCB     SYSCALL:OPEN,OPEN:SCLEN,CHANGED,IGNORED
        FDB     CHANGED,CHANGED
        FDB     CHANGED,NAMESCANNEDCNT,2

SETKILLPROOF    ; used to killproof a user console
        FCB     SYSCALL:CONTROL,CONTROL:SCLEN,CHANGED,CC:KILLPROOF

CLEARKILLPROOF  ; used to killenable a user console
        FCB     SYSCALL:CONTROL,CONTROL:SCLEN,CHANGED,CC:KILLENABLE
        PAGE
LOADOPEN                ; used for opening load module file
        FCB     SYSCALL:OPEN,OPEN:SCLEN,LOADCHANNEL,IGNORED
        FDB     CHANGED,CHANGED wrbuf, wrlen
        FDB     CHANGED,NAMESCANNEDCNT,2        rplen, rdbuf, rdlen

LOADGETPOS      FCB     SYSCALL:STATUS  USED BY LOADER TO PERFORM A "SKIP N BYTES" LOADER COMMAND
        FCB     STATUS:SCLEN
        FCB     LOADCHANNEL
        FCB     SC:GETPOS
        FDB     IGNORED,IGNORED WRBUF,WRLEN
        FDB     CHANGED RPLEN: EXPECTED VALUE OF 4
        FDB     LOADFILEPOS     PLACE TO PUT LOAD FILE POSITION
        FDB     4       SIZE OF LOAD FILE POSITION BUFFER
*
LOADFILEPOS     ; CURRENT POSITION OF LOAD FILE
        FCB     CHANGED,CHANGED,CHANGED,CHANGED
*
GETSERIALNUMBER ; syscall to read serialnumber for decrypting loader
        FCB     SYSCALL:GETSERIALNUMBER
        FCB     GETSERIALNUMBER:SCLEN
        FCB     IGNORED,IGNORED
        FDB     IGNORED,IGNORED WRBUF,WRLEN
        FDB     CHANGED         EXPECTED VALUE OF 8
        FDB     ROMSERIALNUMBER,8

ROMSERIALNUMBER ; holds ROM serial number for decrypting loader to inspect
        FDB     CHANGED,CHANGED,CHANGED,CHANGED
*
FILLDECRYPTBUFFER ; SYSCALL BLOCK TO READ 8 BYTES INTO DECRYPTBUFFER
         FCB     SYSCALL:READB,READB:SCLEN
         FCB     LOADCHANNEL,IGNORED
         FDB     IGNORED,IGNORED
         FDB     CHANGED         EXPECTED VALUE IS 8
         FDB     DECRYPTBUFFER,8

LOADMULTIPLEOF8  ; SYSCALL BLOCK TO LOAD MULTIPLE OF 8 BYTES
         FCB     SYSCALL:READB,READB:SCLEN
         FCB     LOADCHANNEL,IGNORED
         FDB     IGNORED,IGNORED
         FDB     CHANGED         EXPECTED VALUE = OPTIMIZEDLOADCOUNT
LOADADDRESS ; THIS IS WHERE LOADER WILL PLACE NEXT LOADED BYTE
         FDB     CHANGED         REPLY BUFFER
OPTIMIZEDLOADCOUNT ; THIS IS NUMBER OF BYTES TO LOAD
         FDB     CHANGED         ALWAYS A MULTIPLE OF 8
        PAGE
GET1BYTE        ; SYSCALL BLOCK USED TO READ 1 BYTE FROM LOADCHANNEL INTO BUFFER
        FCB     SYSCALL:READB,READB:SCLEN
        FCB     LOADCHANNEL,IGNORED
        FDB     IGNORED,IGNORED
        FDB     CHANGED RPLEN: EXPECTED VALUE OF 1
        FDB     BUFFER,1        WHERE TO PLACE REPLY

OPENERRMSGS     ; open the errormsgs.sys file
        FCB     SYSCALL:OPEN,OPEN:SCLEN,ERRMSGCHANNEL,IGNORED
        FDB     ERRMSGFILENAME,LENERRMSGFILENAME
        FDB     CHANGED,NAMESCANNEDCNT,2

ERRMSGFILENAME
        FCC     'ERRORMSGS.SYS'
LENERRMSGFILENAME       EQU     *-ERRMSGFILENAME

CLOSEERRMSGS
        FCB     SYSCALL:CLOSE,CLOSE:SCLEN,ERRMSGCHANNEL

console fcc     'CONSOLE:'
lconsole equ    *-console
        page
; the following are used for indexing into tables;
;   (x) -> table; indexfor<xxx> must be valid
;   the carry bit is preserved

ldaindex
        if      m6809
indexforlda equ *+3
        lda     >0,x
        else
indexforlda equ *+1
        lda     0,x
        fin
        rts

staindex
        if      m6809
indexforsta equ *+3
        sta     >0,x
        else
indexforsta equ *+1
        sta     0,x
        fin
        rts
        PAGE    Serially Reusable Loader Code
decrypt1        ; do "decrypt step"
        staa    0,x
        ldaa    1,x     EOR with this byte of key
        rora            shift right, saving carry from left
Key1    equ     *+1
        eora    #$16    $16 is red herring
        staa    1,x
        ldaa    2,x     EOR with this byte of key
        rora            shift right, saving carry from left
Key2    equ     *+1
        eora    #$73    $73 is red herring
        staa    2,x
        ldaa    3,x     EOR with this byte of key
        rora            shift right, saving carry from left
Key3    equ     *+1
        eora    #$F6    $F6 is red herring
        staa    3,x
        ldaa    4,x     EOR with this byte of key
        rora            shift right, saving carry from left
Key4    equ     *+1
        eora    #$09    $09 is red herring
        staa    4,x
        ldaa    5,x     EOR with this byte of key
        rora            shift right, saving carry from left
Key5    equ     *+1
        eora    #$56    $56 is red herring
        staa    5,x
        ldaa    6,x     EOR with this byte of key
        rora            shift right, saving carry from left
Key6    equ     *+1
        eora    #$ED    $ED is red herring
        staa    6,x
        ldaa    7,x     EOR with this byte of key
        rora            shift right, saving carry from left
Key7    equ     *+1
        eora    #$41    $41 is red herring
        staa    7,x
        decb            down count # iterations
        bne     decryptloop     b/ more to do
        jmp     decryptrts      all done, go clean up and exit!
        page
*       Decrypt -- Undoes Encrypt
*       Decryption key is stored inline in locations KEY0, KEY1, ... KEY7
*       Block of 8 bytes at (X) is decrypted in place
*
Decrypt ; Do the encryption in reverse, literally
*       ldab    #64     64 iterations of reverse encryption required
        ldab    key7    do 8 + 2 lsb of key iterations
        andb    #3
        addb    #8
        bsr     eorall8bytes    unscramble least significant byte
        staa    7,x     do first decryption iteration
decryptloop ; right shift current value and EOR with key
        rora            Shift encrypted "encrypt" bit into carry...
        ldaa    0,x     EOR with this byte of key
        rora            shift right, saving carry from left
Key0    equ     *+1
        eora    #$92    92 is red herring
MTCHKSUMBASE    ; ALL CODE FROM HERE TO END OF MT IS CHECKSUMMED!!
        bmi     decrypt1        b/ encrypt bit was 1, go do "decrypt step"
decrypt0 ; "encrypt" bit was 0, right shift current value and EOR with randomizer
        eora    key0    undo "eora key" done by decryptloop
        anda    #$7F    force MSB to be zero
        eora    #$55    EOR with randomizer byte
        staa    0,x     (Note: MSB(Randomizer) must be zero)
        ldaa    1,x     EOR with this byte of key
        rora            shift right, saving carry from left
        eora    #$A6
        staa    1,x
        ldaa    2,x     EOR with this byte of key
        rora            shift right, saving carry from left
        eora    #$0A
*** note: perhaps could speed up this loop, by doing LDD/STD, and using
*** ADDD instead of EORx; would by ~8 cycles/byte instead of 12~
        staa    2,x
        ldaa    3,x     EOR with this byte of key
        rora            shift right, saving carry from left
        eora    #$9C
        staa    3,x
        ldaa    4,x     EOR with this byte of key
        rora            shift right, saving carry from left
        eora    #$E3
        staa    4,x
        ldaa    5,x     EOR with this byte of key
        rora            shift right, saving carry from left
        eora    #$57
        staa    5,x
        ldaa    6,x     EOR with this byte of key
        rora            shift right, saving carry from left
        eora    #$AC
        staa    6,x
        ldaa    7,x     EOR with this byte of key
        rora            shift right, saving carry from left
        eora    #$39
        staa    7,x
        decb            down count # iterations
        bne     decryptloop     b/ more iterations to try
decryptrts
        bsr     eorall8bytes    now unscramble Most significant byte
        staa    0,x
        rts             decryption complete, result is in Result
        page
Eorall8bytes ; Compute XOR of all 8 bytes
        ldaa    4,x     Why are the index displacements all mixed up?
        eora    7,x     Because it puzzles the hell out of whoever...
        eora    5,x     attempts to dis-assemble it!
        eora    0,x
        eora    2,x
        eora    6,x
        eora    1,x
        eora    3,x     so Most sig byte of result depends on all 64 bits
        rts
        page    Optimized CopyToUser and CopyToSystem routines
CopyToSystem ; (X) contains user address, (Y) system address, (D) = count
;  This routine optimizes the best for transfers of 1 byte,
;    which need the optimization the most.  We also handle 0 and 2.
;  This optimization primarily speeds up little I/O requests.
        if      m6800
        cmpb    #1                     1 byte copy ?
        beq     CopyToSystem.1         b/ appears to be.
        cmpb    #2                     copy 2 bytes ?
        lbhi    copytosystem.big       b/ copy >2, go do it!
        blo     CopyToSystem.0         b/ seems to be zero byte copy
CopyToSystem.2
        tsta
        lbne    copytosystem.big
        else    (m6801!m6809)
        cmpd    #1                     1 byte copy ?
        beq     CopyToSystem.1         b/ yes, go handle
        cmpd    #2                     copy 2 bytes ?
        lbhi    copytosystem.big       b/ copy >2, go do it!
        blo     CopyToSystem.0         b/ Copy 0 bytes
CopyToSystem.2
        fin
        jsr     copyusertodx           fetch byte pair (MUST NOT DAMAGE TEMPX!)
        if      (m6800!m6801)
        std     [tempx]
        else    (m6809)
        std     ,y
        fin
        rts

CopyToSystem.1 ; copy 1 byte
        if      m6800
        tsta
        lbne    copytosystem.big
        fin
        jsr     copyusertoa
        if      (m6800!m6801)
        sta     [tempx]
        else    (m6809)
        sta     ,y
        fin
        rts

CopyToSystem.0 ; copy 0 bytes
        if      m6800
        tsta
        lbne    copytosystem.big
        fin
        rts
        page
CopyToUser ; (X) contains system address, (Y) user address, (D) = count
;  This routine optimizes the best for transfers of 1 byte,
;     which need the optimization the most.  We also handle 0 and 2.
;  This optimization primarily speeds up return of status results.
        if      m6800
        cmpb    #1                     1 byte copy ?
        beq     CopyToUser.1           b/ appears to be.
        cmpb    #2                     copy 2 bytes ?
        lbhi    copytouser.big         b/ copy >2, go do it!
        blo     CopyToUser.0           b/ seems to be zero byte copy
CopyToUser.2
        tsta
        lbne    copytouser.big
        else    (m6801!m6809)
        cmpd    #1                     1 byte copy ?
        beq     CopyToUser.1           b/ yes, go handle
        cmpd    #2                     copy 2 bytes ?
        lbhi    CopyToUser.big         b/ copy >2, go do it!
        blo     CopyToUser.0           b/ Copy 0 bytes
CopyToUser.2
        fin
        ldd     ,x                     fetch byte pair to store
        if      m6800!m6801
        ldx     tempx
        else
        tfr     y,x
        fin
        jsr     copydtouser            store byte pair
        rts

CopyToUser.1 ; copy 1 byte
        if      m6800
        tsta
        lbne    copytouser.big
        fin
        lda     ,x                     fetch byte to store
        if      m6800!m6801
        ldx     tempx
        else
        tfr     y,x
        fin
        jsr     copyatouser
        rts

CopyToUser.0 ; copy 0 bytes
        if      m6800
        tsta
        lbne    copytouser.big
        fin
        rts
        page    Checksum and Program Identification
MTMSG   FCC     'SDOS/MT Version '
        FCB     '0+((MTVERSION/$10)&$F)
        FCB     '.
        FCB     '0+((MTVERSION/$1)&$F)
        IFUND   MTSUBVERSION
        ELSE
        FCB     MTSUBVERSION
        FIN
        FCC     ', '
COPYRIGHT       FCC     'Copyright (C) 1980 Software Dynamics'
                FCB     ASCII:CR
COPYRIGHTEND    EQU     *
MTCHKSUM        FCB     0       this gets set to a value that makes the sum=0
        page    Tables
*
*       SYSCALL MINIMUM SIZE,+ N-WAY OPCODE BRANCH TABLE
*
OPCODES
   OPEN:SCLEN,#OPEN,IGNORED                OPEN FILE
   CREATE:SCLEN,#CREATE,IGNORED            CREATE A NEW FILE
   CLOSE:SCLEN,#CLOSE,IGNORED              CLOSE A FILE
   RENAME:SCLEN,#RENAME,IGNORED            RENAME A FILE
   DELETE:SCLEN,#DELETE,IGNORED            DELETE A FILE
   LOAD:SCLEN,#LOAD,IGNORED                LOAD A FILE INTO MEMORY
   CHAIN:SCLEN,#CHAIN,IGNORED              CHAIN TO A FILE
   CREATELOG:SCLEN,#CREATELOG,IGNORED      CREATE A FILE FOR OUTPUT ON LOG CHANNEL
   CLOSELOG:SCLEN,#CLOSELOG,IGNORED        CLOSE LOG OUTPUT FILE
   DISKDEFAULT:SCLEN,#ERRNOTTS,IGNORED     SET DISK DEFAULT DEVICE *** error ***
   READA:SCLEN,#READA,IGNORED              READ ASCII BYTES FROM A FILE
   READB:SCLEN,#READB,IGNORED              READ BINARY BYTES FROM A FILE
   WRITEA:SCLEN,#WRITEA,IGNORED            WRITE ASCII BYTES TO A FILE
   WRITEB:SCLEN,#WRITEB,IGNORED            WRITE BINARY BYTES TO A FILE
   CONTROL:SCLEN,#CONTROL,IGNORED          PERFORM A CONTROL OPERATION ON AN I/O CHANNEL
   STATUS:SCLEN,#STATUS,IGNORED            READ STATUS FROM AN I/O CHANNEL
   WAITDONE:SCLEN,#SYSCALLEXIT,IGNORED     WAIT FOR I/O CHANNEL OPERATION DONE *** no-op ***
   EXIT:SCLEN,#EXIT,IGNORED                GIVE CONTROL BACK TO THE OPERATING SYSTEM
   ERROREXIT:SCLEN,#ERROREXIT,IGNORED      EXIT TO SYSTEM WITH ERROR CODE
   SETERROR:SCLEN,#SETERROR,IGNORED        REPORT AN ERROR TO THE SYSTEM
   GETERROR:SCLEN,#GETERROR,IGNORED        RETURN THE LAST ERROR CODE
   DISPERROR:SCLEN,#DERR,IGNORED           DISPLAY USER'S LAST ERROR
   KILLPROOF:SCLEN,#KILLPROOF,IGNORED      MAKE USER PROGRAM KILL-PROOF
   KILLENABLE:SCLEN,#KILLENABLE,IGNORED    MAKE USER PROGRAM KILLABLE
   DEBUG:SCLEN,#ERRNOTTS,IGNORED           CALL SYSTEM DEBUGGER *** error ***
   ATTNCHECK:SCLEN,#ATTNCHECK,IGNORED      OPERATOR ATTENTION CHECK
   ISCONSOLE:SCLEN,#ISCONSOLE,IGNORED      IS CHANNEL ZERO OPEN TO CONSOLE PREDICATE
   INTERLOCK:SCLEN,#INTERLOCK,IGNORED      PERFORM INTERLOCK FUNCTIONS
   DELAY:SCLEN,#DELAY,IGNORED              DELAY USER AT 60 Hz RESOLUTION
   +0,#ERRILLSYSCALL,IGNORED               READ LOGICAL UNIT NUMBER
   GETSERIALNUMBER:SCLEN,#USERGETSERIALNUMBER,IGNORED GET SERIAL NUMBER
   JOBCONTROL:SCLEN,#JOBCONTROL,IGNORED    PERFORM JOB CONTROL FUNCTIONS
OPCODEMAX       EQU     (*-OPCODES)/4-1
        page    Syscall Handler: Exit back to user
SYSCALL.ERRILLSYSCALL
        LDX     #ERR:ILLEGALSYSCALL
        JMP     USERERRORED

SYSCALLEXIT
        JSR     RELEASEALLPAGES get rid of all user pages
        LDAA    UCB:GIVERPLEN,X    return reply length to user, if requested
        BEQ     SYSCALLEXIT.1   B/ not requested
        IF      M6800!M6801
        LDD     UCB:USERSCB,X
        ADDD    #SCBLK:RPLEN
        STD     TEMPX
        LDD     SCBLK:RPLEN,X
        LDX     TEMPX
        ELSE    (M6809)
        LDD     SCBLK:RPLEN,X
        LDX     UCB:USERSCB,X
        LEAX    SCBLK:RPLEN,X
        FIN
        JSR     COPYDTOUSER
SYSCALLEXIT.1
        JSR     RETURNTOUSER    return to user with fruits of labor
*       JMP     SYSCALLENTRY
        page    Syscall Handler: Front Door
SYSCALLENTRY ; user issued a system call, service it!
; assert: Carry bit in user context is cleared by USERSPACESYSCALL
        LDX     CURRENTUCB      save remainder of user's quantum
        STA     UCB:REMAININGQUANTUM,X
        JSR     GETXFROMUSERCONTEXT fetch user's X from his context (return D & X)
        LDX     CURRENTUCB      fetch user's syscall block
        STD     UCB:USERSCB,X
        LDX     UCB:USERSCB,X
        JSR     COPYUSERTODX
        CMPA    #OPCODEMAX      IS THE OPCODE LEGAL?
        BHI     SYSCALL.ERRILLSYSCALL B/ NO
        ASLA                    MULTIPLY OPCODE VALUE BY 4
        ASLA
        IF      OPCODEMAX*4>>255
        ?ERROR  OPCODE INDEXING WON'T WORK
        FIN
        STAA    SYSCALLX+1      LOCATE OPCODE TABLE SLOT CORRESPONDING TO OPCODE
        CLRA
        ANDB    #%01111111
        LDX     CURRENTUCB
        IF      M6809
        TFR     X,Y
        ELSE
        STX     TEMPX
        FIN
        LDX     UCB:USERSCB,X
        JSR     COPYTOSYSTEM
        PAGE
SYSCALLVALIDATE ; inspect system call block for "reasonableness"
        LDX     CURRENTUCB      ; validate the syscall block
        LDAA    SCBLK:WLEN,X    COPY SYSCALL BLOCK LENGTH TO (A)
        ANDA    #%01111111      MASK OFF WAIT FLAG
        CMPA    #SCBLK:RDLEN+2
        BHS     SYSCALLVR       B/ reply buffer has been supplied
        CLR     UCB:GIVERPLEN,X no RDBUF, so no RPLEN desired
        CMPA    #SCBLK:WRLEN+2  validate write buffer, if given
        BHS     SYSCALLVW       B/ write data buffer has been supplied
        BRA     SYSCALLVO       go validate the opcode

SYSCALLVR ; validate reply buffer
        STA     UCB:GIVERPLEN,X flag 'please fill in SCBLK:RPLEN'
        CLR     SCBLK:RPLEN,X   zero reply length as convenience for later code
        CLR     SCBLK:RPLEN+1,X
        LDD     SCBLK:RDLEN,X   don't care how squirrelly the RDBUF is if 0 RDLEN
        BEQD    SYSCALLVW       B/ RDLEN=0
        ADDD    SCBLK:RDBUF,X
        BCS     SYSCALL.ERRBADREADBUF
        CMPD    TOPMEM
        BHI     SYSCALL.ERRBADREADBUF
SYSCALLVW
        LDD     SCBLK:WRLEN,X   don't care how squirrelly the WRBUF is if 0 WRLEN
        BEQD    SYSCALLVO       B/ 0 WRLEN
        ADDD    SCBLK:WRBUF,X
        BCS     SYSCALL.ERRBADWRITEBUF
        CMPD    TOPMEM
        BHI     SYSCALL.ERRBADWRITEBUF
SYSCALLVO ; validate opcode
        LDAA    SCBLK:WLEN,X    COPY SYSCALL BLOCK LENGTH TO (A)
        ANDA    #%01111111      MASK OFF WAIT FLAG
        LDX     SYSCALLX        GRAB POINTER TO OPCODE TABLE SLOT
        CMPA    OPCODES&$FF,X   IS SIZE OF SYSCALL BLOCK >= NECESSARY MINIMUM ?
        BLO     SYSCALL.ERRSYSCALLTOOSHORT B/ NO, YOU DIE!
        JSR     [(OPCODES&$FF)+1,X] GO DO THE SYSCALL
        LBCC    SYSCALLEXIT     do a no-error exit
        JMP     USERERRORED     else bitch about situation

SYSCALL.ERRBADREADBUF
        LDX     #ERR:BADREADBUF
        JMP     USERERRORED

SYSCALL.ERRBADWRITEBUF
        LDX     #ERR:BADWRITEBUF
        JMP     USERERRORED

SYSCALL.ERRSYSCALLTOOSHORT
        LDX     #ERR:SYSCALLTOOSHORT
        JMP     USERERRORED
        PAGE
ERRILLSYSCALL
        JSR     ERRET
        FDB     ERR:ILLEGALSYSCALL

ERRSYSCALLTOOSHORT
        JSR     ERRET
        FDB     ERR:SYSCALLTOOSHORT

ERRBADWRITEBUF
        JSR     ERRET
        FDB     ERR:BADWRITEBUF

ERRBADREADBUF
        JSR     ERRET
        FDB     ERR:BADREADBUF

ERRNOTTS
        JSR     ERRET
        FDB     ERR:NOTUNDERTIMESHARE
        PAGE    Job Scheduler
SAVEPLACE
*       Remember return address in context of this user and go find something
*       else to do.  The remembered return address will receive control at
*       some later time.
        JSR     SAVECONTEXT
        STS     UCB:STACKP,X    remember this context
*       JMP     POLLFORUSER

POLLFORUSER
        tst     sdosmtstatuschanged    any status change for any user ?
        beq     pfu.0                  b/ no, skip expensive stuff
        clr     sdosmtstatuschanged    acknowledge we have seen status changes
pfu.i ; search input queue for jobs whose input is now complete
        jsr     examineinputq          go look for a user which is ready
        bcs     pfu.cklineflags        b/ no more input-complete jobs
        std     currentucb             give this job a complete I/O slice
        ldx     currentucb
        ldab    ioquantumticks
        stab    ucb:remainingquantum,x
        ldd     currentucb
        jsr     addioq                 this job ready, stuff in fast-service q
        bra     pfu.i                  and go see if more jobs are ready

pfu.cklineflags ; status change may have been due to line flags or ^C^C
        JSR     CHECKLINEFLAGS         see if anyone twitched
pfu.0 ; no status changes left to service
        JSR     EXAMINEOUTPUTQ         look for output complete
        BCC     PFU.1                  (queue is normally empty)
        JSR     EXAMINESPACEQ          look for space available
        BCC     PFU.1                  (queue is normally empty)
        JSR     EXAMINEDELAYQ          see if anyone's time is up
        BCC     PFU.1                  (queue is normally empty)
        JSR     EXAMINEIOQ             look for I/O bound user who needs a turn
        BCC     PFU.1
        CLR     SERVICEDIO             obviously, no high priority work to do
        JSR     REMRUNQ                see if there's any user to run
        TSTA                           UCB's are on page boundaries
        BEQ     POLLFORUSER            B/ none to run--keep looking
PFU.1 ; user specified by (D) is ready to run!
        STD     CURRENTUCB             we should serve this user for awhile
        JSR     FETCHCONTEXT
        TST     RUNQ                   anybody in RUNQ ?
        BEQ     PFU.2                  b/ no, serve this guy
        BITA    SERVICEDIO             has user recieved good service recently?
        BEQ     PFU.2                  b/ no
        LDD     CURRENTUCB             yes, stick him back on IOQ
        JSR     ADDIOQFRONT            give this guy 1st shot at next service
        CLR     SERVICEDIO             ensure that all I/O bound users get turn
        JSR     REMRUNQ                give guy on runq some time
        STD     CURRENTUCB             serve this guy!
        JSR     FETCHCONTEXT           get his context
PFU.2 ; this user has not gotten good service recently
        ORAA    SERVICEDIO             mark him as having obtained good service
        STAA    SERVICEDIO
        LDX     CURRENTUCB
        LDAA    UCB:REMAININGQUANTUM,X = time this user should get
        LDB     OUTPUTQ                anybody in fast service queues ?
        ORAB    SPACEQ
        ORAB    DELAYQ
        ORAB    IOQ
        BNE     PFU.4                  b/ yes, ensure that system is responsive
        TST     RUNQ                   somebody else in run queue ?
        BNE     PFU.3                  b/ yes, use given time slice
        LDA     CPUQUANTUMTICKS        nobody else needs service!
        BRA     PFU.3                  so give this guy excellent service

PFU.4 ; (A) contains time slice desired, but fast service q's contain users
        CMPA    IOQUANTUMTICKS         is slice too big ?
        BLE     PFU.3                  b/ no
        LDAA    IOQUANTUMTICKS         yes, trim to keep response time down
PFU.3 ; time slice for user has been trimmed to appropriate amount
        LDAB    IOQUANTUMTICKS         get time slice abort threshold
        LDX     #TIMESLICEABORTED      where to go when time slice up
        JSR     SETQUANTUM             tell /MT primitives all about it...
        LDAA    CURRENTUSER
        JSR     USERSELECT
        LDX     CURRENTUCB
        LDS     UCB:STACKP,X           fetch this user's system environment
        LDA     UCB:JOBSTATE,X         is this guy a dead duck ?
        CMPA    #JS:DYING
        LBEQ    JOBCONTROL.MERCYKILLING b/ yes, issue the coup de grace
        LDX     UCB:QUEUEERR,X         see if reason to croak now
        LBNE    ERRORINQ               go rap him on the fingers!
        LDX     CURRENTUCB
        OKRTS                   go back to where ah came frum
        PAGE
CHECKLINEFLAGS ; only called if VT driver signals 'status has changed'
        LDX     #CKANYLINE      see if anyone's twitched
        JSR     SYSCALL$
        BCC     CHECKLINEFLAGS.DOIT     B/ got something
        JSR     GOCATATONIC             gasp..choke...die....

CHECKLINEFLAGS.DOIT
        TST     BUFFER                  see if worth looking further
        BNE     CHECKLINEFLAGS.DOIT.1
        RTS

CHECKLINEFLAGS.DOIT.1
        LDA     UCBCHAIN
CHECKLINEFLAGS.DOIT.2
        STA     CURRENTUCB
        JSR     GETUSERLFCHANNEL
        BEQ     CHECKLINEFLAGS.DOIT.3   b/ no LF channel, so don't ask for lineflags
        LDX     #GETLINEFLAGS
        STA     SCBLK:PARAMS,X          plug in the user's console channel
        JSR     SYSCALL$                get the lineflags hint
        BCS     CHECKLINEFLAGS.KABLOOIE something's wrong!!
        LDA     BUFFER                  get the hint
        LDX     CURRENTUCB
        STA     UCB:LINEFLAGS,X         save the hint
CHECKLINEFLAGS.DOIT.3
        LDA     UCB:LFNEXT,X
        BNE     CHECKLINEFLAGS.DOIT.2   go look at the next user, if any more
        RTS                             all done
        page
CHECKLINEFLAGS.KABLOOIE

; If we're here, we probably got hit with an ERR:PROGRAMKILLED, so we'll
; pretend that's what we got.  Now that it's agreed that the user was
; ^C'd, remember the actual error, move him from the delay or interlock
; blocked queue (if he was there) to the run queue, and then go check the
; status of the next user.  The other queue-checking routines will eventually
; remove the errored user and dump him in the run queue, where he will
; be received into the clutches of USERDIED (heh, heh!) via POLLFORUSER

        TXD
        LDX     CURRENTUCB              save whatever happened for the user
        STD     UCB:QUEUEERR,X
        CLR     UCB:LINEFLAGS,X         (just to be tidy)
        JSR     ILK.CTLC.UNBLOCK        call this just in case...
        JSR     DELAY.CTLC.UNBLOCK      ...and this one, too, in case...
        LDX     CURRENTUCB
        BRA     CHECKLINEFLAGS.DOIT.3   go look for the next user

GETUSERLFCHANNEL ; returns UCB:LFCHAN in (A)
; Z bit set --> this job has no LFCHAN
        LDX     CURRENTUCB
        LDA     UCB:LFCHAN,X
        CMPA    #$FF                   is it open ?
        RTS
        page
TIMESLICEABORTED ; system is forcing user to relinquish control
;  (a) contains number of quantum ticks that user hasn't burned yet

        LDX     CURRENTUCB      save remaining quantum
        STA     UCB:REMAININGQUANTUM,X
        BLE     TIMESLICEEXPIRED b/ quantum really did expire
        PSHA                    user didn't get all of allocated time slice!
        LDA     CURRENTUSER     so remember that good service is still needed
        STA     INDEXFORLDA
        LDX     #USERNUMBERTOUSERBIT
        JSR     LDAINDEX
        COMA                    (reset SERVICEDIO bit)
        ANDA    SERVICEDIO
        STA     SERVICEDIO
        PULA
        CMPA    IOQUANTUMTICKS  safe to put this guy in fast service Q ?
        BGT     TIMESLICEABORTED.CPU b/ no
        LDD     CURRENTUCB      put user in I/O service Q
        JSR     ADDIOQFRONT
        BRA     TIMESLICE.1     and wait for scheduler to start him again

TIMESLICEABORTED.CPU ; put guy on front of RUN Q
        LDD     CURRENTUCB
        JSR     ADDRUNQFRONT
        BRA     TIMESLICE.1
        PAGE
*       Come here when the quantum has expired.  The current user is moved to
*       the end of the RUN Q and another ready-to-run user is sought.  If
*       there is only the one user ready to run (only one on the RUN Q) then
*       he will be selected again.

TIMESLICEEXPIRED ; user's time slice is exhausted, (A) holds overrun
        LDX     CURRENTUCB      did user do any terminal I/O ?
        TST     UCB:USERCPUBOUND,X
        BNE     TIMESLICE.CPUBOUND
        ADDA    IOQUANTUMTICKS  yes, set user up for I/O time slice
        STA     UCB:REMAININGQUANTUM,X
        LDD     CURRENTUCB
        JSR     ADDIOQ          put him on I/O queue for fast service
        BRA     TIMESLICE.1

TIMESLICE.CPUBOUND ; this guy clearly wants to eat CPU cycles
        ADDA    CPUQUANTUMTICKS  set him up for looong time slice...
        STA     UCB:REMAININGQUANTUM,X but cheat of for his overrun
        LDD     CURRENTUCB      but make him low priority
        JSR     ADDRUNQ
TIMESLICE.1 ; put guy to sleep till scheduler wakes him
        JSR     SAVEPLACE       this user resumes here for next quantum
        BCS     TIMESLICE.USERDIED
NEWTIMESLICE ; guy woke up, run him!
        LDX     CURRENTUCB      assume this guy will be a bad guy...
        LDA     #1
        STA     UCB:USERCPUBOUND,X and if he's good, we'll relent!
*       BRA     RUNTHISUSER
        PAGE
RUNTHISUSER ; start up the currently selected user
        BSR     RETURNLINEFLAGS give user line flags hint at start of timeslice
        tst     sdosmtstatuschanged any change to user statuses ?
        LBEQ    RETURNTOUSER    b/ no, scheduling decision is correct!
        ldx     currentucb      oops, job choice needs to be re-considered
        lda     ucb:remainingquantum,x fake as though ABORTTIMESLICE occurred
        jmp     timesliceaborted

TIMESLICE.USERDIED
        JMP     USERDIED               go hold a funeral service

RETURNLINEFLAGS
        LDX     CURRENTUCB
        LDA     UCB:LINEFLAGS,X
        LDX     #LINEFLAGS
        JMP     COPYATOUSER             give him the current hint

        PAGE    Error Handling
*       MT ERROR HANDLING
*
*       ERRET -- CALLED VIA A JSR WITH IN-LINE 2-BYTE ERROR CODE
*               ERROR CODE IS LOADED INTO (X)
*               CARRY IS SET TO INDICATE ERROR CONDITION
*               AND A RTS IS PERFORMED
*               IF CALLING ROUTINE HAS NO BCS/BCC AFTER JSR,
*               ERRET AUTOMATICALLY POPS THE STACK ONE SUBROUTINE LEVEL
*               AND LOOKS AGAIN FOR A BCS
*               ***NOTE: THIS MEANS TOP LEVEL (USER!) MUST HAVE BCC/BCS!***
*
ERRET   PULX            GET RETURN ADDRESS TO (X)
        STX     ERRORADDRESS    THIS HELPS WHEN WE'RE DEBUGGING SDOS
        LDX     0,X     GET ERROR CODE INTO (X)
ERRORINX        ; ENTRY POINT IF ERROR CODE IS ALREADY IN (X)
        STX     LASTERROR       SAVE THE ERROR CODE
        BRA     ERRORED         SKIP INTO BCC/BCS STACK POP LOOP
ERRETL  ; POP RETURN ADDRESS FROM THE STACK
        LEAS    2,S
ERRORED ; NOW FAKE "RTS" UNTIL BCC/BCS ENCOUNTERED
        LDX     0,S     GRAB RETURN ADDRESS
        LDAA    0,X     DOES RETURN ADDRESS POINT TO BCS/BCC ?
        IF      M6809
        CMPA    #$10    CHECK FOR LBCC/LBCS
        BNE     *+4
        LDA     1,X
        FIN     M6809
        ANDA    #\%1    (MASK OFF "INVERT BRANCH CONDITION" BIT)
        CMPA    #$24    (BCS OPCODE)
        BNE     ERRETL  NO, SIMULATE "BCS TO A RTS"
        LDX     LASTERROR       GET THE ERROR CODE AGAIN
        ERRORRTS        SET THE CARRY AND EXIT
        PAGE
ERRORSAVE       ; SAVE THE ERROR CODE IN (X)
        STX     LASTERROR
        ERRORRTS        AND EXIT

ERRORINQ        ; save the error code in LASTERROR and clear the queueerr field
        STX     LASTERROR
        LDX     CURRENTUCB
        CLR     UCB:QUEUEERR,X
        CLR     UCB:QUEUEERR+1,X
        BRA     ERRORED
        PAGE
FIREBREAK       ; last-ditch firebreak
        BCS     FIREBREAK.1     need this to stop the stack un-winder
FIREBREAK.1
        BSR     GOCATATONIC     I should never be here--roll up eyes and go mum

GOCATATONIC

;  JSR here to roll over and die
;  (X) contains error code

;  Places crash info at CRASHINFOPTR specified by SDOS/MT primitive table
;     @CRASHINFO+0   MT Version, Revision
;     @CRASHINFO+2   Error Code
;     @CRASHINFO+4   Return Address

        nop                     shut down the world
        sei                     and die
        txd
        ldx     crashinfoptr
        std     2,x             save error code
        LDAA    #MTVERSION      save version and subversion for same reason
        IFUND   MTSUBVERSION
        CLRB
        ELSE
        LDAB    #MTSUBVERSION
        FIN
        STD     0,x
        puld                    fetch return address
        std     4,x             save it, too...
        BRA     *               whizzzz...
        PAGE
*
*       USER SPACE ERROR HANDLING
*
*       USERERRORED
*               IF CALLING ROUTINE HAS NO BCS/BCC AFTER JSR,
*               ERRET AUTOMATICALLY POPS THE USER'S STACK ONE SUBROUTINE LEVEL
*               AND LOOKS AGAIN FOR A BCS
*               ***NOTE: THIS MEANS TOP LEVEL (USER!) MUST HAVE BCC/BCS!***
*
USERERRORED
        STX     LASTERROR
        CPX     #ERR:PROGRAMKILLED      see if he was ^C^C'ed
        BNE     UE.3
USERDIED ; User died via ^C^C
; Assert: can't get here if UCB:LFCHAN=$FF!
        JSR     RELEASEALLPAGES         make room for exit
        JSR     CLOSECONSOLE            get rid of any do files
        JSR     OPENCONSOLE
        JSR     CLOSELOG
        BCS     UE.4
UE.4    LDX     #ERR:PROGRAMKILLED
        JMP     EXIT1                   he loses!!

UE.3    JSR     SAVEUSERCONTEXT leave context PC on top of user stack
        LDX     LASTERROR               let user in on our little secret
        JSR     SETXINSAVEDUSERCONTEXT
        BRA     UE.1

UE.2
        JSR     POPDXFROMUSERSTACK      pop one return level

UE.1
        JSR     GETDXFROMUSERSTACK      look at instruction following return.  If not...
        IF      M6809
        CMPA    #$10
        BNE     *+4
        TFR     B,A                     this was a lbcc/lbcs
        FIN     M6809
        JSR     COPYUSERTODX    ...bcr/bcs then pop one return level and look again.
        ANDA    #\%1    ignore "invert branch condition"
        CMPA    #$24    is this a bcc/bcs?
        BNE     UE.2    B/ nope!
        JSR     RESTOREUSERCONTEXT      restore user's context to top of pruned stack
        JMP     SYSCALLEXIT
        PAGE    System context management
*       Frequently-used fields of the current UCB are kept in a context area
*       to avoid juggling the X register a lot.  This routine and the
*       SAVECONTEXT routine, below, set up and tear down the context area
*       as attention is focused and unfocused on a particular user.
*       Returns (A) containing mask for User bit in SERVICEDIO byte

FETCHCONTEXT
        LDX     CURRENTUCB
        LDD     UCB:LASTERROR,X assert: (x) -> current user's UCB
        STD     USERLASTERROR
        LDD     UCB:TOPMEM,X
        STD     TOPMEM
        LDAA    UCB:USERNUMBER,X
        STAA    CURRENTUSER
        STAA    INDEXFORLDA
        LDX     #USERNUMBERTOUSERBIT
        JMP     LDAINDEX

USERNUMBERTOUSERBIT
        +%00000001
        +%00000010
        +%00000100
        +%00001000
        +%00010000
        +%00100000
        +%01000000
        +%10000000

SAVECONTEXT
        LDX     CURRENTUCB
        LDD     USERLASTERROR
        STD     UCB:LASTERROR,X
        RTS
        PAGE    User context management primitives
::      SET     *
        ORG     $0
        IF      M6800+M6801
ENV:CC  RMB     1
ENV:B   RMB     1
ENV:A   RMB     1
ENV:X   RMB     2
ENV:PC  RMB     2
        ELSEIF  M6809
ENV:CC  RMB     1
ENV:A   RMB     1
ENV:B   RMB     1
ENV:DP  RMB     1
ENV:X   RMB     2
ENV:Y   RMB     2
ENV:U   RMB     2
ENV:PC  RMB     2
        FIN
        ORG     ::

NEWSTACK        ; virgin stack frame for user's stack (his space)
                IF      M6800!M6801
                $FF,0,0,0,#0,#$100
                ELSE
                $80,0,0,0,#0,#0,#0,#$100
                FIN
NEWSTACKLEN     EQU     *-NEWSTACK
        PAGE
GETDXFROMUSERSTACK
        LDX     #USERSPSAVE
        JSR     COPYUSERTODX
        STX     TSTEMP  save for possible use by popdxfromuserstack
        IF      M6800+M6801
        INX
        FIN
        JMP     COPYUSERTODX

POPDXFROMUSERSTACK
        BSR     GETDXFROMUSERSTACK
        LDX     TSTEMP  top of stack saved by getdxfromuserstack
        STD     TSTEMP
        INX
        INX
        TXD
        LDX     #USERSPSAVE     trim stack by 2 bytes
        JSR     COPYDTOUSER
        LDX     TSTEMP
        LDD     TSTEMP
        RTS

INITUSERSTACK
        LDD     TOPMEM  put user's stack starting at top of his memory
        SUBD    #NEWSTACKLEN
        STD     TSTEMP
        LDX     #USERSPSAVE
        JSR     COPYDTOUSER
        IF      M6809
        LDY     TSTEMP
        ELSE
        LDX     TSTEMP
        STX     TEMPX
        FIN
        LDX     #NEWSTACK
        LDD     #NEWSTACKLEN
        JMP     COPYTOUSER
        PAGE
GETXFROMUSERCONTEXT     ; user's processor context is on top of his stack
        LDX     #USERSPSAVE
        JSR     COPYUSERTODX
        IF      M6800+M6801
        LEAX    ENV:X+1,X
        ELSE
        LEAX    ENV:X,X
        FIN
        JMP     COPYUSERTODX
        PAGE
SETPCINUSERCONTEXT
        STX     TSTEMP
        LDX     #USERSPSAVE
        JSR     COPYUSERTODX
        LDD     TSTEMP
        IF      M6800+M6801
        LEAX    ENV:PC+1,X
        ELSE
        LEAX    ENV:PC,X
        FIN
;       IF      M6809
; Assert: E flag in CCR is set
;       STX     TSTEMP            ensure E flag set in CCR
;       JSR     COPYDTOUSER
;       LDD     TSTEMP
;       SUBD    #ENV:PC
;       STD     TSTEMP
;       TFR     D,X
;       JSR     COPYUSERTODX
;       ORAA    #$80
;       LDX     TSTEMP
;       JMP     COPYATOUSER      I know...this isn't pretty, but it's a solution
;       ELSE
        JMP     COPYDTOUSER
;       FIN     M6809
        PAGE
SAVEUSERCONTEXT ; move all of user context, to safe place
;  We actually don't save the context, because there is nothing worthwile saving!
;  SDOS defines the register contents after a SYSCALL to be garbage,
;  except the Carry bit, and if C=1, then the X register contains useful stuff.
;  This code should eventually be substituted inline in UserErrored
        IF      M6800!M6801
        LDAA    #$01           Force interrupt enabled CC with C=1
        ELSE    (M6809)
        LDA     #$81           Force interrupt enabled CC with C=1
        FIN
        STA     CONTEXTBLOCK   Build phony context
        LDX     #USERSPSAVE
        JSR     COPYUSERTODX
        ADDD    #ENV:PC        Adjust top of stack
        LDX     #USERSPSAVE
        JMP     COPYDTOUSER

SETXINSAVEDUSERCONTEXT  ; guess what this does!
        STX     CONTEXTBLOCK+ENV:X
        RTS
        PAGE
RESTOREUSERCONTEXT      ; move user context back to user space
        LDX     #USERSPSAVE
        JSR     COPYUSERTODX
        SUBD    #ENV:PC
        STD     TSTEMP
        LDX     #USERSPSAVE
        JSR     COPYDTOUSER
        LDX     TSTEMP
        IF      M6800+M6801
        INX
        STX     TEMPX
        ELSE
        TFR     X,Y
        FIN
        LDX     #CONTEXTBLOCK   safe place
        LDD     #ENV:PC
        JMP     COPYTOUSER
        PAGE    Queue Management: Run Queue
*       All of the subsequent queue management routines (ADDxxxQ, REMxxxQ)
*       operate on the named queue by adding the UCB named in the D register
*       to the head of that queue and removing the UCB from the tail of the
*       named queue, leaving the name of that UCB in the D register.  There
*       are separate routines to avoid the overhead of one generalized
*       routine.

ADDRUNQ
        LDX     #RUNQ
        JMP     ADDQUEUE

ADDRUNQFRONT
        LDX     #RUNQ
        JMP     ADDQUEUEFRONT

REMRUNQ
        LDX     #RUNQ
        JMP     REMQUEUE

ADDIOQ
        LDX     #IOQ
        JMP     ADDQUEUE

ADDIOQFRONT
        LDX     #IOQ
        JMP     ADDQUEUEFRONT

REMIOQ
        LDX     #IOQ
        JMP     REMQUEUE

ADDINPUTQ
        LDX     #INPUTQ
        JMP     ADDQUEUE

REMINPUTQ
        LDX     #INPUTQ
        JMP     REMQUEUE
        PAGE
ADDOUTPUTQ
        LDX     #OUTPUTQ
        JMP     ADDQUEUE

REMOUTPUTQ
        LDX     #OUTPUTQ
        JMP     REMQUEUE

ADDSPACEQ
        LDX     #SPACEQ
        JMP     ADDQUEUE

REMSPACEQ
        LDX     #SPACEQ
        JMP     REMQUEUE

REMDELAYQ
        LDX     #DELAYQ
        JMP     REMQUEUE
        page
ADDDELAYQ ; entries are in ascending order of length of delay desired

; the current user is inserted in the delay queue where his wakeup time is
; less than or equal to his successor's wakeup time

        tst     delayq+queue:head
        beq     adddelayq.qempty       b/ the queue is empty
        sta     currentucb
        jsr     testfuse               fetch fuse left before 1st job ready
        stx     tempx
        lda     delayq+queue:head      update ucb:delay for 1st job
        sta     queue:ucb
        ldx     queue:ucb
        ldd     tempx                  = remaining fuse for this job
        std     ucb:delay,x            now all ucb:delay contain proper deltas
        clr     tempx                  prior:=nil
        clr     tempx+1
        lda     delayq+queue:head
adddelayq.loop
        sta     queue:ucb
        ldx     currentucb
        ldd     ucb:delay,x
        ldx     queue:ucb
        subd    ucb:delay,x            = remaining delay when this job is ready
        blo     delaygoeshere          b/ currentucb goes in front of this ucb
        ldx     currentucb             update delay delta required
        std     ucb:delay,x
        ldx     queue:ucb
        stx     tempx                  prior:=current
        lda     ucb:nextonq,x          current:=current^.next
        bne     adddelayq.loop         b/ not end of queue
adddelayq.qempty
        LDX     #DELAYQ
        ldd     currentucb
        JSR     ADDQUEUE
adddelayq.setfuse
        lda     delayq+queue:head      assert: somebody's in the q!
        sta     queue:ucb
        ldx     queue:ucb
        ldx     ucb:delay,x            get delay for 1st job in q
        jmp     setfuse                tell /MT primitives about it
        page
delaygoeshere
        negd                           = new delay delta for next guy on q
        std     ucb:delay,x
        ldb     tempx                  = pointer to previous node
        beq     delaygoesathead        b/ goes at head of queue
        ldx     currentucb
        lda     queue:ucb
        sta     ucb:nextonq,x          target^.next:=current
        ldx     tempx
        lda     currentucb
        sta     ucb:nextonq,x          prior^.next:=target
        bra     adddelayq.setfuse      and set up fuse

delaygoesathead
        ldx     currentucb
        lda     delayq+queue:head
        sta     ucb:nextonq,x          target^.next:=head
        lda     currentucb
        sta     delayq+queue:head      head:=target
        bra     adddelayq.setfuse      and set up fuse
        PAGE
; The queue management routines, below, presume that a UCB is on a page
; boundary, and therefore, the lower 8 bits of each address will always
; be zero: a ucb may be referenced with a byte.

ADDQUEUE ; add to end of queue
; (a) -> ucb, (x) -> queue descriptor

        LDB     QUEUE:TAIL,X            see if anyone 't all's in the queue
        BNE     ADDQUEUE.1              B/ yup
ADDQUEUE.MT ; add to empty queue
        STA     QUEUE:HEAD,X            assert: empty tail -> empty queue
        STA     QUEUE:TAIL,X
        RTS

ADDQUEUE.1
        STA     QUEUE:TAIL,X            this is the new tail (old is in (b))
        STB     QUEUE:UCB               point old tail at new one
        LDX     QUEUE:UCB
        STA     UCB:NEXTONQ,X
        RTS

ADDQUEUEFRONT ; add to front of queue
; (a) -> ucb, (x) -> queue descriptor
        LDB     QUEUE:HEAD,X
        BEQ     ADDQUEUE.MT             b/ trivial case
        STA     QUEUE:HEAD,X
        STA     QUEUE:UCB
        LDX     QUEUE:UCB
        STB     UCB:NEXTONQ,X
        RTS
        page
REMQUEUE

; (x) -> queue descriptor
; returns (a) =  0  => empty queue
;         (a) <> 0  => (a) -> ucb

        LDA     QUEUE:HEAD,X            get the head of the queue
        BEQ     REMQUEUE.1              B/ queue is empty
        CMPA    QUEUE:TAIL,X            see if only entry on queue
        BNE     REMQUEUE.2              B/ more than one entry
        CLR     QUEUE:HEAD,X            clear the queue
        CLR     QUEUE:TAIL,X
REMQUEUE.1
        CLRB                            return this ucb
        RTS

REMQUEUE.2
        STA     QUEUE:UCB               make the successor of this ucb
        STX     TEMPX
        LDX     QUEUE:UCB
        LDB     UCB:NEXTONQ,X           the new head of queue
        CLR     UCB:NEXTONQ,X           subject ucb has no successor
        LDX     TEMPX                   install the new queue head
        STB     QUEUE:HEAD,X
        CLRB
        RTS
        PAGE
*       Examine the input queue, looking for ports which have completed.
*       If a ^C^C has been detected, force the user to do an ERROREXIT
*       syscall.

EXAMINEINPUTQ
        LDA     INPUTQ          see if there's anything interesting going on
        STA     TSTEMP  (used to prevent subsequent tail chasing)
        BNE     EXAMINEINPUTQ.5 B/ I thought so!!
        ERRORRTS        ohhh..  Too bad!

EXAMINEINPUTQ.5
        JSR     REMINPUTQ       pull this one off the queue and work with him
        STD     CURRENTUCB
        LDX     CURRENTUCB
        LDA     UCB:QUEUEERR,X  see if this one died in sleep
        ORAA    UCB:QUEUEERR+1,X (this field set by CKLINEFLAGS)
        BEQ     EXAMINEINPUTQ.5a        B/ still alive
        LDD     CURRENTUCB
        OKRTS                           SURPRISE!!

EXAMINEINPUTQ.5a
        LDAA    SCBLK:PARAMS,X  see if this one has completed
        STAA    READYLINE+SCBLK:PARAMS
        LDX     #READYLINE
        JSR     SYSCALL$
        BCC     EXAMINEINPUTQ.6 B/ not ready yet
        CPX     #ERR:IOINPROGRESS       if busy, try again later
        BEQ     EXAMINEINPUTQ.6 B/ still busy
        CPX     #ERR:ACTIVATIONRECEIVED if done, exit
        BNE     EXAMINEINPUTQ.7 B/ got an error, instead!!
        LDD     CURRENTUCB
        OKRTS                   all done

EXAMINEINPUTQ.6
        LDD     CURRENTUCB      tack this one on the end of the queue
        JSR     ADDINPUTQ
        LDA     INPUTQ          get the head of the queue and do him
        CMPA    TSTEMP          what's this...
        BNE     EXAMINEINPUTQ.5 ...oh...we haven't seen you before...OK
        ERRORRTS                ohhh...we've been here before...too bad!
        PAGE
EXAMINEINPUTQ.7
        TXD
        LDX     CURRENTUCB
        STD     UCB:QUEUEERR,X
        LDD     CURRENTUCB
        OKRTS                   user is ready to run--with BIG surprise!

EXAMINEINPUTQ.ERROR
        JSR     GOCATATONIC     something bad happened while waiting for input to complete
        PAGE    Queue Management: Output Wait Queue
*       Examine the output queue to find user whose output is complete.

EXAMINEOUTPUTQ
        LDA     OUTPUTQ         see if anyone waiting for output
        BEQ     EXAMINEOUTPUTQ.ERRORRTS
        STA     TSTEMP          remember place to avoid tail-chasing
EXAMINEOUTPUTQ.1
        JSR     REMOUTPUTQ      go feed some of this user's buffer to vt driver
        STD     CURRENTUCB
        LDX     CURRENTUCB
        TST     SCBLK:DATA,X    see if request completed
        BEQ     EXAMINEOUTPUTQ.2
        LDD     UCB:QUEUEERR,X  see if he died in sleep
        BNED    EXAMINEOUTPUTQ.1a       B/ he died (probably via ^C^C)
        LDX     SCBLK:DATA+1,X  request completed--see if with error
        BNE     EXAMINEINPUTQ.7 b/ with error... too bad!
EXAMINEOUTPUTQ.1a
        LDD     CURRENTUCB      no error--return with completed request
        OKRTS

EXAMINEOUTPUTQ.2
        LDD     CURRENTUCB      put this user at the end of the line
        JSR     ADDOUTPUTQ
        LDA     OUTPUTQ         check for tail-chasing
        CMPA    TSTEMP
        BNE     EXAMINEOUTPUTQ.1        look at another user
EXAMINEOUTPUTQ.ERRORRTS
        ERRORRTS                found nothing of interest
        PAGE    Queue Management: I/O Queue
*       Choose from I/O Queue in Round-Robin fashion

EXAMINEIOQ
        LDA     IOQ
        BEQ     EXAMINEIOQ.EMPTY
        JSR     REMIOQ
        OKRTS

EXAMINEIOQ.EMPTY
        ERRORRTS
        PAGE    Queue Management: Space Wait Queue
*       Allocate space for first user on SPACE Q.  If success, make that
*       user current and return with carry clear;
*       if fail or queue is empty, then return with carry set.

EXAMINESPACEQ
        LDA     SPACEQ
        BEQ     ESQXIT                 B/ no one on SPACE Q
        LDB     NUMPAGES               any pages available yet ?
        BEQ     ESQXIT                 b/ no, nothing we can do here!
        STA     CURRENTUCB             assert: no context is current!!
        LDX     CURRENTUCB
        LDA     UCB:QUEUEERR,X         see if he died in sleep
        ORAA    UCB:QUEUEERR+1,X
        BNE     EXAMINESPACEQ.1        b/ he died...
        LDAA    UCB:USERNUMBER,X       set up for space allocation
        STAA    CURRENTUSER
        LDAA    UCB:PNEEDED,X          get count of pages desired
        JSR     ALLOCATENPAGES
        BCS     ESQXIT                 B/ no pages available, at all (shouldn't happen!)
EXAMINESPACEQ.1
        JSR     REMSPACEQ              remove user from SPACE Q
        OKRTS

ESQXIT
        ERRORRTS
        PAGE    Queue Management: Delay Queue
EXAMINEDELAYQ

; Examine the first user on the delay queue to see if his wakeup time has
; been reached or passed.  If so, remove him from the queue and turn him
; loose.

; assert: queue is in ascending order of time

        ldx     delayq
        beq     delayqisempty
        jsr     testfuse               is fuse for 1st job on queue burned up ?
        bne     delaynotdone           b/ yes
        jsr     remdelayq              pull off head of queue
        ldb     queue:head,x           anybody else on the delay queue ?
        beq     examinedelayq.okrts    b/ no, leave fuse burned out.
        stb     queue:ucb              yes, get new fuse
        ldx     queue:ucb
        ldx     ucb:delay,x
        bne     examinedelayq.1
        sta     sdosmtstatuschanged    another job needs waking
examinedelayq.1
        psha
        jsr     setfuse
        pula
examinedelayq.okrts
        clrb
        okrts

delayqisempty
delaynotdone
        errorrts                       no one ready to go
        page
delay.ctlc.unblock

; come here when the current user is to be removed from the delay queue;
; if the user is not on the delay queue, just return; otherwise, remove him
; from the delay queue and add him to the run queue

        lda     delayq+queue:head
        beq     delay.ctlc.notinq
        sta     queue:ucb
        jsr     testfuse               get remaining fuse
        txd                            and save as 1st job's remaining delay
        ldx     queue:ucb
        std     ucb:delay,x
        lda     queue:ucb              get pointer to 1st user in queue
        clrb                           prior:=nil
delay.ctlc.loop
        ldx     queue:ucb
        cmpa    currentucb
        beq     delay.ctlc.foundit     b/ found currentucb in queue
        tfr     a,b                    prior:=current
        lda     ucb:nextonq,x          current:=current^.next
        sta     queue:ucb
        bne     delay.ctlc.loop
delay.ctlc.notinq
        rts

delay.ctlc.foundit
        pshb
        ldx     currentucb             now remove current user from q
        lda     ucb:nextonq,x
        beq     delay.ctlc.lastonq     b/ current is on queue tail
        sta     queue:ucb              remember next guy on q
        ldd     ucb:delay,x            get delay remaining for current user
        ldx     queue:ucb              add to delay for next user in q
        addd    ucb:delay,x
        std     ucb:delay,x
        lda     queue:ucb              points to next user in q
        pulb
        stb     queue:ucb
        beq     delay.ctlc.firstonq    b/ current is on queue head
        ldx     queue:ucb
        sta     ucb:nextonq,x          prior^.next:=current^.next
        bra     delay.ctlc.setfuse     b/ somebody is still in delay q
        page
delay.ctlc.firstonq ; and somebody else follows current user in q
        sta     delayq+queue:head      head:=current^.next
        bra     delay.ctlc.setfuse     b/ somebody is still in delay q

delay.ctlc.lastonq
        pulb
        stb     queue:ucb
        beq     delay.ctlc.onlyonq     b/ current is only one on queue
        stb     delayq+queue:tail      tail:=prior
        ldx     queue:ucb
        clr     ucb:nextonq,x          prior^.next:=nil
delay.ctlc.setfuse
        lda     delayq+queue:head      assert: queue is not empty
        sta     queue:ucb              set fuse to delay for 1st job in q
        ldx     queue:ucb
        ldx     ucb:delay,x
        jsr     setfuse
        bra     delay.ctlc.addtorunq

delay.ctlc.onlyonq
        ldx     #0                     head:=nil
        stx     delayq                 tail:=nil
delay.ctlc.addtorunq
        ldx     currentucb             clear ucb^.next since we removed him
        clr     ucb:nextonq,x
        ldd     currentucb
        jsr     addrunq
        rts
        PAGE    Buffer Management
* Support routines for ALLOCATE1PAGE and ALLOCATENPAGES

* FINDFREEPAGE (and FFP1) find the beginning of a "hole" in the page map
* COUNTPAGES determines the size of the "hole"

* All registers (including TEMPX) are volatile

FINDFREEPAGE
        TST     NUMPAGES see if any free pages exist
        BEQ     FFP3     B/ none.
        LDAB    MAPSIZE
        LDX     PAGEMAPBASE  points to 1st dynamically allocatable page
FFP1
        IF      M6800!m6801
        LDAA    0,X     look for a zero slot in the map
        BEQ     FFP2    B/ found one!
        INX             next!!   pleez
        ELSE    (M6809)
        LDA     ,x+
        BEQ     FFP2    B/ found one!
        FIN
        DECB
        BNE     FFP1
FFP3    ERRORRTS

FFP2
        IF      M6809
        DEX
        FIN
        STX     TEMPX   assert: map on page boundary
        LDAA    TEMPB   presto!  get the page number
        OKRTS
        PAGE
COUNTPAGES
        LDAA    NPAGES  I'm satisfied if I get this much
        STAA    THISCOUNT
        CLRA            count how many I got
COUNTPAGES.LOOP
        IF      M6800!M6801
        TST     0,X     is this available?
        BNE     COUNTPAGES.EXIT B/ nope
        INX             next page, pleez
        ELSE    (M6809)
        TST     ,X+     is this available ?
        BNE     COUNTPAGES.EXIT B/ nope
        FIN
        INCA            count it
        DEC     THISCOUNT
        BEQ     COUNTPAGES.GOTENUFF     B/ got what I asked for
        DECB            don't overrun map
        BNE     COUNTPAGES.LOOP
COUNTPAGES.EXIT
        ERRORRTS

COUNTPAGES.GOTENUFF
        OKRTS
        PAGE
* Allocate one page and mark it as being used
*
*  returns carry clear: (A), NPAGES contains 1; (B), PAGEBASE contains page number
*                       (X) contains CurrentUCB
*  If no page is available and a BCC/BCS follows the JSR/BSR,
*  then return is made with carry set.
*  Otherwise, the user is blocked until the request can be satisfied.
*
ALLOCATE1PAGE
        LDAA    #1              = number of pages to allocate
ALLOCATENPAGES.1 ; enter here with (A)=1
        STA     NPAGES          assert: (A)=1
        LDB     UCB:PERMANENTPAGEBUSY,X is permanently allocated page busy ?
        BNE     ALLOCATE1PAGE.HUNT b/ yes, allocate the hard way...
        STA     UCB:PERMANENTPAGEBUSY,x mark permanent page as allocated
        LDB     UCB:PERMANENTPAGE,x     get page address
        STB     PAGEBASE        fulfill contract
*       CLC                     assert: C=0 because of ADDA # above
        RTS

ALLOCATE1PAGE.HUNT ; go hunt for a page
        LDB     UCB:ALLOCATEDPAGECNT,X
        BNE     ALLOCATENPAGES.TOOMANYSEGMENTS
        BSR     FINDFREEPAGE
        LBCS    ANP.1   B/ didn't get page
        LDAB    CURRENTUSER     mark it as owned
        ORAB    #$40            don't want to confuse with available page
        STAB    0,X
        STAA    PAGEBASE
        LDX     CURRENTUCB
        STAA    UCB:ALLOCATEDPAGESBASE,X
        INC     UCB:ALLOCATEDPAGECNT,X
        TFR     A,B             meet contract
        LDAA    #1              = number of pages allocated
        DEC     NUMPAGES
        OKRTS

ALLOCATENPAGES.TOOMANYSEGMENTS ; USER WANTS MORE THAN 2 ALLOCATED SEGMENTS
        LDX     #ERR:MEMORYMGMTFAIL
        JSR     GOCATATONIC
        PAGE
* Allocate (A) pages and mark them as being used
*
*  returns carry clear: (B), PAGEBASE contains page number,
*                       (A), NPAGES contains from 1 to original contents of (A)
*                       (X) contains CurrentUCB
*
*               If no page is available and
*                       a BCC/BCS follows the JSR/BSR, then return is made
*                       with carry set.  Otherwise, the user is blocked
*                       until the request can be satisfied.
*
*               Optimized to handle requests for 1 page very quickly,
*                       as this is by far the most common request /MT makes.
*                       Note that /MT can never issue more than 2 requests
*                       for pages to handle a system call, and it is
*                       guaranteed that one of those request is for 1 page.
*
ALLOCATENPAGES
        LDX     CURRENTUCB      ensure pre-conditions met
        CMPA    #1              check for most frequent request
        BEQ     ALLOCATENPAGES.1 b/ go handle most common request
        STAA    NPAGES          remember request size
        BEQ     ANP.8           0 pages is an easy request to satisfy
        LDB     UCB:ALLOCATEDPAGECNT,X
        BNE     ALLOCATENPAGES.TOOMANYSEGMENTS b/ 2 segments of length > 1 !!?
        CLR     LASTCOUNT       prepare (sigh!) for search
        JSR     FINDFREEPAGE    find a hole
        BCS     ANP.1           B/ none to be found
ANP.5   BSR     COUNTPAGES      size the hole
        BCC     ANP.2           B/ the hole is big enough--split with the goods!!
        CMPA    LASTCOUNT       is this one bigger than the last one?
        BLS     ANP.3           B/ no--look for another hole
        STAA    LASTCOUNT       remember this hole
        LDAA    TEMPB
        STAA    LASTBASE
ANP.3   TSTB                    see if the map has been completely examined
        BEQ     ANP.4           B/ it has--take our best match and scoot!
        JSR     FFP1            (B) and (X) are still set up--look for another hole
        BCC     ANP.5           B/ got a hole--go size it

ANP.4   LDX     CURRENTUCB      take best match; mark it as owned
        LDAA    LASTBASE
        STAA    UCB:ALLOCATEDPAGESBASE,X
        STAA    PAGEBASE
        STAA    TEMPB
        LDAA    LASTCOUNT
        STAA    UCB:ALLOCATEDPAGECNT,X
        STAA    NPAGES
        LDX     TEMPX
        LDAB    CURRENTUSER
        ORAB    #$40
ANP.6   STB     ,X+
        DECA
        BNE     ANP.6
        LDB     NUMPAGES        keep track of number of pages available
        SUBB    NPAGES
        BCC     ANP.A
        LDX     #ERR:MEMORYMGMTFAIL
        JSR     GOCATATONIC

ANP.A   STB     NUMPAGES
        LDX     CURRENTUCB      meet exit contract
        LDAA    UCB:ALLOCATEDPAGECNT,X
        LDAB    UCB:ALLOCATEDPAGESBASE,X
ANP.8   OKRTS

ANP.2   LDAA    NPAGES  an exact match is our best match
        STAA    LASTCOUNT
        LDAA    TEMPB
        STAA    LASTBASE
        BRA     ANP.4

ANP.1   TSX             if he checks with BCC/BCS, don't block him
        LDX     0,X
        LDAA    0,X
        IF      M6809
        CMPA    #$10    check for lbcc/lbcs
        BNE     *+4
        LDA     1,X
        FIN     M6809
        ANDA    #$FE
        CMPA    #$24
        BNE     ANP.7   B/ he doesn't check
        LDX     CURRENTUCB      make life convenient for caller
        ERRORRTS

ANP.7   LDAA    NPAGES
        LDX     CURRENTUCB      block him until he can get the pages
        STAA    UCB:PNEEDED,X
        LDD     CURRENTUCB
        JSR     ADDSPACEQ
        JSR     SAVEPLACE       EXAMINESPACEQ calls ALLOCATENPAGES until success!
        LDX     CURRENTUCB      meet exit contract
        LDAA    UCB:ALLOCATEDPAGECNT,X
        LDAB    UCB:ALLOCATEDPAGESBASE,X
        OKRTS
        PAGE
RELEASEALLPAGES

*  Release all pages checked out to current user
*  Returns (X) pointing to CurrentUCB

        LDX     CURRENTUCB      this is convenient for SYSCALLEXIT
        CLR     UCB:PERMANENTPAGEBUSY,X "deallocate" permanent page
        LDB     UCB:ALLOCATEDPAGECNT,X a variable size segment allocated ?
        BEQ     RELEASEALLPAGES.RTS  b/ no, take fast exit!
        CLR     UCB:ALLOCATEDPAGECNT,X yes, make it disappear from UCB
        TFR     B,A             update free page count
        ADDA    NUMPAGES
        STA     NUMPAGES
        LDA     UCB:ALLOCATEDPAGESBASE,X mark pages in map as free
        STA     TEMPX+1
        LDA     PAGEMAPBASE
        STA     TEMPX
        LDX     TEMPX           get pointer to 1st page to free
RELEASEALLPAGES.LOOP
        CLR     ,X+
        DECB
        BNE     RELEASEALLPAGES.LOOP
*** Could check SPACEQ here, and move users on it to RUNQ
*** This is prevent having to inspect SPACEQ in POLL routine, enhancing response
*** This would require a change of viewpoint here, from
*** "this user releasing his pages" to "the system waking up others"
*** That is inconsistent with this implementation, and so we don't do it here
        LDX     CURRENTUCB
RELEASEALLPAGES.RTS
        RTS
        PAGE    OPEN, CREATE, and RENAME
OPEN
CREATE  BSR     DOOPEN  call open subroutine (localizes errors)
        BCS     OPEN.ERR1
        JMP     RETURNSCANNED

OPEN.ERR1
        STX     LASTERROR
        CPX     #ERR:RDBUFTOOSMALL      in this case, we return NOTHING!!
        BEQ     OPEN.ERR2
        JSR     RETURNSCANNED
        JMP     ERRORED

OPEN.ERR2
        LDX     CURRENTUCB
        CLR     UCB:GIVERPLEN,X        return nothing, pleez!
        JMP     ERRORED
        PAGE
DOOPEN
        JSR     FNAMESETUP              (checks for RDLEN >= 2)
        JSR     WASCONSOLEREQUESTED
        BCC     DOOPEN.2                b/ console was requested
DOOPEN.JC ; entry point for JC:CREATE
        JSR     SETCHANNEL
        JSR     SYSCALL$
        BCC     CHECKDEVTYP             get device class (i.e., vt or non-vt)
        CPX     #ERR:CHBUSY
        BNE     DOOPEN.1
        JSR     GOCATATONIC             MT out of sync with SDOS
DOOPEN.1
        STX     TSTEMP
        JSR     RELEASECHANNEL          close out virtual channel--don't care
        BCS     DOOPEN.DONTCARE         about errors
DOOPEN.DONTCARE
        LDX     TSTEMP
        JMP     ERRORINX
        PAGE
DOOPEN.2                                ; open/create to console:
        lda     scblk:params,x
        JSR     TRANSLATECHANNEL
        jsr     ischannelclosed         bomb out if channel is open
        LDX     CURRENTUCB
        LDA     UCB:LFCHAN,X
        TST     UCB:USERCHAN,X          see what channel user wanted
        BEQ     DOOPEN.5                b/ he wanted channel 0
        LDX     UCB:CHANNELMAP,X
        JSR     STAINDEX
        LDX     CURRENTUCB
DOOPEN.3
        LDA     SCBLK:PARAMS,X
        STA     INDEXFORSTA
        LDX     #DEVICEMAP
        LDA     #VT:CONSOLE
        JMP     STAINDEX                mark this as a virtual terminal device

DOOPEN.5
        STA     UCB:CHAN0,X
        BRA     DOOPEN.3

ischannelopen                           ; c/r -> yes; c/s, err:closed -> no
        cmpa    #$ff
        beq     ischannelopen.no        b/ closed
        okrts

ischannelopen.no
        jsr     erret
        #err:closed

ischannelclosed                         ; c/r -> yes; c/s, err:chbusy -> no
        cmpa    #$ff
        bne     ischannelclosed.no      b/ open
        okrts

ischannelclosed.no
errchanisopen
        jsr     erret
        #err:chbusy
        page
RENAME
        BSR     DORENAME
        BCS     OPEN.ERR1
        JMP     RETURNSCANNED

DORENAME
        JSR     FNAMESETUP      validate and fetch file name
        JSR     GETCHANNEL      translate virtual to real channel
        JMP     SYSCALL$
        PAGE
*       ASSERT: Timeshare will be running only with virtual terminal driver;
*       therefore, DEVTYP=CONSOLE or DEVTYP=LPT will mean virtual terminal
*       device

CHECKDEVTYP
        LDX     CURRENTUCB
        LDAA    SCBLK:PARAMS,X  do a devtyp status syscall on this channel
        STA     INDEXFORSTA
        LDX     #GETDEVTYP
        STAA    SCBLK:PARAMS,X
        JSR     SYSCALL$
        LDX     #DEVICEMAP
        LDA     #VT:CONSOLE
        LDB     BUFFER          pick up the type
        CMPB    #DVTYP.CONSOLE
        BEQ     CHECKDEVTYP.1
        LDA     #VT:PRINTER
        CMPB    #DVTYP.PRINTER
        BEQ     CHECKDEVTYP.1
        CLRA                    not a virtual device
        JMP     STAINDEX

CHECKDEVTYP.1
        JSR     STAINDEX        plunk in the device type

*       make all VT devices which are not open to the console, killproof

        LDX     CURRENTUCB
        LDA     SCBLK:PARAMS,X
        CMPA    UCB:LFCHAN,X    is this the real console?
        BEQ     CHECKDEVTYP.2   b/ real console
        LDX     #SETKILLPROOF
        STAA    SCBLK:PARAMS,X
        JSR     SYSCALL$
CHECKDEVTYP.2
        OKRTS
        page
isitvirtual ; return Z reset (non-zero) if VT device selected
; return device type flags in ucb:vtflag

        ldx     currentucb
        lda     scblk:params,x
        sta     indexforlda
        ldx     #devicemap
        jsr     ldaindex
        ldx     currentucb
        sta     ucb:vtflag,x
        rts
        PAGE    CLOSE & DELETE
CLOSE
        JSR     GETCHANNEL      translate virtual to real channel
        JMP     RELEASECHANNEL

CLOSE.DUMP

*       do a DUMPBUFFERS before doing a CLOSE (called by EXITS)

        JSR     GETCHANNEL
        LDAA    SCBLK:PARAMS,X
        LDX     #DUMPBUFFERS
        STAA    SCBLK:PARAMS,X
        JSR     SYSCALL$
        bcs     close.dump.dontcare
close.dump.dontcare
        JMP     RELEASECHANNEL

DELETE
        BSR     DODELETE
        LBCS    OPEN.ERR1
        BRA     RETURNSCANNED

DODELETE
        JSR     FNAMESETUP      validate and copy over the file name
        LDX     CURRENTUCB      perform the syscall
        JMP     SYSCALL$
        PAGE    Support routines for OPEN, CLOSE, and friends
RETURNSCANNED

*       return the file name scanned length to the user space

        LDX     CURRENTUCB
        LDX     UCB:USERRDBUF,X
        LDD     NAMESCANNEDCNT
        JSR     COPYDTOUSER
        OKRTS

RETURNSTARTADDRESS

*       return the load module start address to the user space

        LDX     CURRENTUCB
        LDX     UCB:USERRDBUF,X
        LEAX    2,X
        LDD     STARTADDRESS
        JSR     COPYDTOUSER
        OKRTS
        PAGE
*       Perform common file name processing for OPEN, CREATE, RENAME,
*       and DELETE.  Error exits are taken for
*
*               write buffer too small
*               read buffer too small
*               bad file name

FNAMESETUP
        JSR     CHECKRDLEN      need at least 2 bytes for returning scanned count
        #2
        BSR     FNAMESETUP.1    (this is a firebreak)
        RTS

*       Perform common file name processing for LOAD and CHAIN.  Error
*       exits are taken for
*
*               write buffer too small
*               read buffer too small
*               bad file name

PNAMESETUP
        JSR     CHECKRDLEN
        #4
        BSR     FNAMESETUP.1    (this is a firebreak)
        RTS
        PAGE
FNP.ERR1
        JSR     ERRET
        #ERR:BADFILENAME

FNAMESETUP.1
        CLR     NAMESCANNEDCNT
        CLR     NAMESCANNEDCNT+1
        JSR     CHECKWRLEN
        #0                      this allows SDOS to complain about the name
        TST     SCBLK:WRLEN,X   look for an overly long file name (> 255 bytes)
        LBNE    FNP.ERR1
        JSR     ALLOCATE1PAGE   get buffer, copy over filename, update scb
        LDX     CURRENTUCB
        LDAA    PAGEBASE
        CLRB
        STD     SCBLK:WRBUF,X
        IF      M6809
        TFR     D,Y
        ELSE
        STD     TEMPX
        FIN
        LDD     SCBLK:WRLEN,X
        LDX     UCB:USERWRBUF,X
        JSR     COPYTOSYSTEM
        LDX     CURRENTUCB
        LDD     #NAMESCANNEDCNT
        STD     SCBLK:RDBUF,X
        LDD     #2
        STD     SCBLK:RDLEN,X
        LDX     CURRENTUCB
        OKRTS
        PAGE
WASCONSOLEREQUESTED             ; c/r -> yes; c/s -> no
        LDX     CURRENTUCB
        LDB     SCBLK:WRLEN+1,X for the device name CONSOLE:
        SUBB    #LCONSOLE
        BLO     FNP.1
        LDAB    #LCONSOLE       the length looks about right
        LDX     #CONSOLE        compare for an exact match
        STX     TEMPX
        LDX     CURRENTUCB
        LDX     SCBLK:WRBUF,X
FNP.2   LDAA    0,X
        cmpa    #'@
        bcs     fnp.3
        ANDA    #(\ASCII:SPACE)&$FF
fnp.3   INX
        STX     TEMPX+2
        LDX     TEMPX
        CMPA    0,X
        BNE     FNP.1           B/ match stops here--exit
        INX
        STX     TEMPX
        LDX     TEMPX+2
        DECB
        BNE     FNP.2
        LDX     CURRENTUCB
        OKRTS                   console requested

FNP.1   LDX     CURRENTUCB
        ERRORRTS                console not requested
        page    Channel Resource Management
; There are three segments to the channel mapping data base: the first
; segment is channelstack, which is a stacked list of all available
; real channels; the second is a channelmap for each user (referenced
; by ucb:channelmap), which maps the user's virtual channels to real
; channels-- a real channel of $ff indicates the virtual channel is closed
; (real channel $ff is not on the stack); the third is a devicemap,
; which flags a channel as a virtual printer (1), a virtual console (2),
; or neither (0)

allocaterealchannel
        tst     channelstackc   see if any available (most likely)
        bne     allocaterealchannel.1   b/ channels available
        jmp     erret
        #err:notenoughchannels

allocaterealchannel.1
        dec     channelstackc
        ldx     channelstackp
        lda     ,x+
        stx     channelstackp
        okrts
        page
releaserealchannel                      ; (a) = chan to release; (x) -> ucb
        cmpa    ucb:lfchan,x            see if real console
        beq     releaserealchannel.1    b/ it is--don't close or release it
        sta     closelogchan+scblk:params
        tst     channelstackc           see if there's room on the stack
        beq     releaserealchannel.badshow (need I say more?)
        inc     channelstackc
        ldx     channelstackp
        sta     ,-x                     release the channel
        stx     channelstackp
        ldx     #closelogchan
        jsr     syscall$                now, close it
        ldx     currentucb
releaserealchannel.1
        okrts

releaserealchannel.badshow
        jsr     gocatatonic
        page
translatechannel                        ; (a) = userchannel; (x) -> UCB
        sta     ucb:userchan,x          save user's channel
        sta     indexforlda
        sta     indexforsta
        beq     translatechannel.2      b/ channel 0 was requested
        ldx     ucb:channelmap,x
        cmpa    0,x                     check for valid channel number
        blo     translatechannel.1      b/ channel is valid
        jsr     erret
        #err:chtoobig

translatechannel.1
        clc                             signal "success"
        jmp     ldaindex                and fetch physical channel number

translatechannel.2
        lda     ucb:chan0,x
        okrts

getchannel
        ldx     currentucb
        lda     scblk:params,x
        bsr     translatechannel
        jsr     ischannelopen
        ldx     currentucb
        sta     scblk:params,x          update the syscall block
        okrts
        page
setchannel
        ldx     currentucb
        lda     scblk:params,x
        bsr     translatechannel
        jsr     ischannelclosed
        bsr     allocaterealchannel     go get the real thing
        ldx     currentucb              and put it in the user's channel map
        sta     scblk:params,x
        tst     ucb:userchan,x
        beq     setchannel.2            b/ talking about channel 0
        ldx     ucb:channelmap,x
        jsr     staindex
        ldx     currentucb
        okrts

setchannel.2
        sta     ucb:chan0,x
        okrts

releasechannel
        ldx     currentucb
        lda     #$ff
        tst     ucb:userchan,x          channel 0 gets special treatment
        beq     releasechannel.2
        ldx     ucb:channelmap,x
        jsr     staindex
        ldx     currentucb
releasechannel.1
        lda     scblk:params,x
        jmp     releaserealchannel      give the channel back

releasechannel.2
        lda     #$ff
        sta     ucb:chan0,x             channel 0 is closed
        bra     releasechannel.1
        PAGE    CHAIN/LOAD SYSCALLS
*       CHAIN -- PERFORM "SYSCALL:CHAIN"
*       ALWAYS RETURNS CONTROL TO CALLER AFTER ERROR UNTIL TYPE 1 RECORD VALIDATED
*       ONCE TYPE 1 RECORD SEEN, ERROREXIT IS FORCED ON AN ERROR.
*       CHAIN SWITCHES STACK TO TOP OF USER SPACE ONCE TYPE 1 RECORD SEEN.
*
*       CHAIN Transition/action table:
*       Unencrypted --> Unencrypted:    Do nothing
*       Unencrypted --> Encrypted:      Zero User Space, Save decryption key, mark 'running encrypted'
*       Encrypted --> Encrypted:        Do nothing
*       Encrypted --> Encrypted':       Zero the user space, save decryption key
*       Encrypted --> Unencrypted:      Zero the user space, save key, mark 'runencrypted'

*       LOAD Transition/action table:
*       Unencrypted --> Unencrypted:    Do nothing
*       Unencrypted --> Encrypted:      Signal error
*       Encrypted --> Encrypted:        Do nothing
*       Encrypted --> Encrypted':       Signal error
*       Encrypted --> Unencrypted:      Signal error
*
*       These routines use OldKeyEncrypted and NewKeyEncrypted to decide transitions
*       Definition: If OldKeyEncrypted=0, then we were running Unencrypted
*               If NewKeyEncrypted=0, then we are transiting to Unencrypted
        PAGE
CHAIN   JSR     EXITS   GO CLOSE ALL THE CHANNELS
        BSR     LOADINIT        OPEN THE FILE AND VERIFY IT IS AN OBJECT FILE
        LDX     STARTADDRESS    CHECK THE START ADDRESS FOR ILLEGAL VALUE
        BEQ     ERRZEROSTARTADDRESS     B/ NO START ADDRESS!
        BSR     COMPAREDECRYPTIONKEYS   ARE OLD AND NEW ENCRYPTION KEYS IDENTICAL ?
        BCC     CHAINOK B/ DECRYPTION KEYS MATCH, DO NOTHING
        JSR     ZAPUSERSPACE    MAKE TRASH OUT OF INFORMATION IN USER SPACE
        if      m6800!m6801
        ldd     currentucb      save this "key" as last "key" used
        addd    #ucb:oldKeyEncrypted
        std     topointer
        else    (m6809)
        ldy     currentucb
        leay    ucb:OldKeyEncrypted,y
        fin
        LDX     #NEWKEYENCRYPTED        = FROM ADDRESS
        ldd     #8      = # bytes to save
        jsr     blockmove       Note: it is NOT secure to call code+sdos:blockmove here!
CHAINOK ; ITS OK TO DO THE CHAIN, HOP TO IT!
        JSR     LOADREST        GO LOAD THE REST OF THE FILE
        BCC     CHAIN1  B/ NO LOADER ERROR
        JMP     EXIT1   I GIVE UP

CHAIN1  ;LDAA   KILLEDF SEE IF USER GOT KILLED WHILE LOADING!
        ;JSR    KILLEDTEST      ...?
        JSR     INITUSERSTACK   GIVE USER A GOOD STACK POINTER
        LDX     STARTADDRESS    ALL IS DONE...
        JSR     SETPCINUSERCONTEXT
        OKRTS

ERRZEROSTARTADDRESS     ; START ADDRESS IS ZERO ON A CHAIN
        LDX     #ERR:ZEROSTARTADDRESS   GET ERROR CODE
        JMP     LOADER2 GO CLOSE THE FILE, TRASH THE KEY, AND EXIT!
        PAGE
*       LOAD -- PERFORM "SYSCALL:LOAD"
*
LOAD    BSR     LOADINIT        LOAD THE FILE INTO MEMORY
        BSR     COMPAREDECRYPTIONKEYS   ARE OLD AND NEW DECRYPTION KEYS IDENTICAL ?
        LBCS    LOADER2         B/ KEYS DON'T MATCH, CLOSE FILES AND SIGNAL ERROR!
        JSR     LOADREST        LOAD OBJECT RECORDS FROM FILE
        LDD     STARTADDRESS    COPY STARTADDRESS TO SYSCALL RESULT
        LDX     CURRENTUCB
        LDX     SCBLK:RDBUF,X
        STD     2,X
        OKRTS
        PAGE
*
*       COMPAREDECRYPTIONKEYS -- COMPARE OLD AND NEW DECRYPTION KEYS
*       SIGNAL ERROR IF NO MATCH
*       (DO SO IN A SUBTLE WAY, SO IT IS NOT EASY TO FIND WHO GENERATES THE ERROR CODE)
*
COMPAREDECRYPTIONKEYS
        IF      M6800!M6801
        LDD     CURRENTUCB              = COMPARE "TO" ADDRESS
        ADDD    #UCB:OLDKEYENCRYPTED
        STD     TOPOINTER
        ELSE    (M6809)
        LDY     CURRENTUCB
        LEAY    UCB:OLDKEYENCRYPTED,Y
        FIN
        LDX     #NEWKEYENCRYPTED        = COMPARE "FROM" ADDRESS
        LDB     #8      = # BYTES TO COMPARE (KEY SIZE)
        JSR     BLOCKCOMPARE
        BEQ     COMPAREDECRYPTIONMATCH  B/ ALL IS OK
        LDD     #ERR:DECRYPTIONKEYSDONTMATCH-1234       GENERATE ERROR CODE...
        ADDD    #1234   IN SUBTLE WAY
        TDX
        ERRORRTS                AND TAKE ERROR EXIT

COMPAREDECRYPTIONMATCH  ; OLD AND NEW KEYS MATCH!
        OKRTS
        PAGE
*
*        LOADINIT -- OPEN LOAD FILE, COMPUTE DECRYPTION KEY,
*        AND VERIFY OBJECT FORMAT CONTENT
LOADINIT
        JSR     PNAMESETUP      validate and copy file name
        LDX     CURRENTUCB
        LDD     SCBLK:WRBUF,X
        STD     LOADOPEN+SCBLK:WRBUF
        LDD     SCBLK:WRLEN,X
        STD     LOADOPEN+SCBLK:WRLEN
        LDX     #LOADOPEN
        JSR     SYSCALL$
        BCS     LOADINITCANTOPEN        B/ HAD A PROBLEM!
        BSR     LOADINITCOPYSCANNED
        LDA     #255            get as big a load record buffer as possible
        JSR     ALLOCATENPAGES
        LDD     PAGEBASE
        STD     LOADADDRESS
        JSR     SETUPFRANKBAKER set up syscall linkage within userspace
        BSR     LOADINITPROCESSSTARTRECORD
        LBCS    LOADER2         error, undo everything committed so far
        RTS
        PAGE
LOADINITPROCESSSTARTRECORD ; process start record
        CLR     OKTODECRYPTFLAG FLAG "DON'T DECRYPT!"
        LDX     #DECRYPTBUFFER  SET UP SO GET BYTE GETS 1ST BYTE OF FILE
        STX     DECRYPTBUFPTR
        LDX     #FILLDECRYPTBUFFER      READ 1ST 8 BYTES OF FILE
        JSR     SYSCALL$
        JSR     GETBYTE         GET ME A BYTE
        CMPA    #LOAD:ENCRYPTED IS THIS AN ENCRYPTED FILE?
        LBEQ    LOADENCRYPTED   B/ YES, GO COMPUTE DECRYPTION KEY AND PROCESS 1ST LOAD RECORD
        LDX     #NEWKEYENCRYPTED        SET NEWKEYENCRYPTED = 0 --> UNENCRYPTED FILE
        LDB     #8              = # BYTES TO ZERO
ZERONEWKEYLOOP
        CLR     ,X+
        DECB
        BNE     ZERONEWKEYLOOP
LOADSTART       ; VERIFY THAT THIS IS A PROPERLY CONSTRUCTED START RECORD
        CMPA    #LOAD:TYPE1     DOES IT APPEAR TO BE SDOS BINARY FORMAT ?
        BEQ     LOADTYPE1       B/ YES
CANTLOAD        ; THIS IS NOT AN OBJECT FILE
        BSR     LOADCLOSE       CLOSE THE FILE
        JSR     ERRET
        FDB     ERR:NOTALOADFILE

LOADTYPE1       ; FETCH START ADDRESS AND VERIFY COMPLEMENT IN TYPE1 RECORD
        JSR     GETWORD GET THE EXECUTION ADDRESS
        STD     STARTADDRESS
        JSR     GETWORD
        ADDD    STARTADDRESS
        CMPD    #-1
        BNE     CANTLOAD        B/ NOT TYPE 1 RECORD!
LOADINITOKRTS
        JSR     RETURNSTARTADDRESS      return the start address before loading
        OKRTS

LOADINITCANTOPEN        ; ERROR WHEN OPENING LOAD FILE
        STX     TSTEMP
        BSR     LOADINITCOPYSCANNED
        LDX     TSTEMP
        CPX     #ERR:FILENOTFOUND       IS THIS THE CAUSE?
        BNE     LOADINITCANT1   B/ NO
        LDX     #ERR:NOSUCHPROGRAM      YES, CHANGE ERROR CODES
LOADINITCANT1
        JMP     ERRORINX        TRIGGER THE ERROR AGAIN

LOADINITCOPYSCANNED
        LDX     CURRENTUCB
        CLR     UCB:GIVERPLEN,X remember we did it here, so we don't do it again
        LDX     UCB:USERSCB,X   set reply length for CHAIN/LOAD
        LEAX    SCBLK:RPLEN,X
        LDD     #2+2            2 for filename length, 2 for start address
        JSR     COPYDTOUSER
        JMP     RETURNSCANNED
        PAGE
LOADREST        ; LOAD OBJECT RECORDS FROM FILE
        JSR     LOADCONTENTS    LOAD THE CONTENTS OF THIS FILE
        BCS     LOADER2 B/ ERRORED IN LOADING FILE CONTENTS
LOADCLOSE       ; CLOSE THE LOAD FILE AND QUIT
        if      m6800!m6801
        LDD     CURRENTUCB      DECIDE IF WE SHOULD RUN ENCRYPTED OR NOT
        ADDD    #UCB:OLDKEYENCRYPTED
        TDX
        else    (m6809)
        LDX     CURRENTUCB
        LEAX    UCB:OLDKEYENCRYPTED,X
        fin
        JSR     SETKEY  (TRASH THE DECRYPTION KEY, THIS PATH ALWAYS TAKEN!)
;       LDAA    0,X     IF OLDKEYENCRYPTED<>0, THEN RUN ENCRYPTED!
;       ORAA    1,X
;       ORAA    2,X
;       ORAA    3,X
;       ORAA    4,X
;       ORAA    5,X
;       ORAA    6,X
;       ORAA    7,X
;       JSR     GETRUNNINGENCRYPTED     GET POINTER TO RUNNINGENCRYPTED FLAG
;       STAA    0,X     TELL ROM WE ARE/ARE NOT RUNNING ENCRYPTED
        JSR     RELEASEALLPAGES         DON'T NEED BUFFERS ANY LONGER
*                                       Note: this is needed in case loader
*                                       errors while trying to CHAIN!
        LDX     #LOADCLOSE1     NOW CLOSE THE LOAD FILE
        JMP     SYSCALL$

LOADCLOSE1      EQU     *
        FCB     SYSCALL:CLOSE
        FCB     CLOSE:SCLEN
        FCB     LOADCHANNEL

ErrSerialNoWrong
        Jsr     Erret
        Fdb     Err:SerialNoWrong

LOADER2 ; ERRORED WHILE TRYING TO LOAD
        STX     STARTADDRESS    SAVE THE ERROR CODE
        BSR     LOADCLOSE       CLOSE UP THE LOAD FILE
        BCS     LOADER2.1       B/ IGNORE ERRORS
LOADER2.1
        LDX     STARTADDRESS    GET ERROR CODE BACK
        BRA     LOADINITCANT1   GO STICK USER WITH ERROR
        PAGE    SDOS BINARY FORMAT LOADER
;GETRUNNINGENCRYPTED ; GET ADDRESS OF RUNNING ENCRYPTED FLAG TO (X)
;       LDX     $FFFE   GET POINTER TO JMP AROUND SERIAL NUMBER
;       LDX     1,X     GET POINTER TO RESTART CODE
;       LDX     LDAENCRYPTED-RESTART+1,X        = ADDRESS OF RUNNINGENCRYPTED FLAG
;       RTS

LOADENCRYPTED ; LOAD AN ENCRYPTED FILE, PROCESS TYPE 5 RECORD
        LDX     #GETSERIALNUMBER GRAB CPU SERIAL NUMBER
        JSR     SYSCALL$
;       BSR     GETRUNNINGENCRYPTED     GET ADDRESS OF RUNNING ENCRYPTED
;       CLRA            SELECT BANK 0
;       INC     0,X     BUMP RUNNINGENCRYPTED; = 2 --> WAS ALREADY RUNNING ENCRYPTED
;       LDX     $FFFE   CALL SELECTBANK TO VERIFY THAT IT WORKS
;       LDX     1,X
;       JSR     [ERASEBANK-RESTART+1,X]
        LDB     DECRYPTBUFFER+1 GET KEY COUNT FROM TYPE 5 RECORD
        STB     NKEYS   = # OF KEYS ENCODED
        LDX     #SDOSSECRETKEY
        JSR     SETKEY  TO START DECRYPT CASCADE THAT GENERATES KEY
        LDX     #DECRYPTBUFFER  START CASCADE OF DECRYPTING 05 RECORD
        JSR     DECRYPT THIS RANDOMIZES AS MUCH AS ENCRYPT
        JSR     SETKEY  SET KEY TO CONTENTS OF BUFFER
        CLR     OKTODECRYPTFLAG FLAG 'NO SERIAL NUMBER MATCHES'
LOADCASCADELOOP ; PROCESS SERIAL NUMBERS BY CASCADING THEM
        LDX     #FILLDECRYPTBUFFER READ IN THE NEXT SERIAL NUMBER
        JSR     SYSCALL$
        IF      M6800!M6801
        LDX     #DECRYPTBUFFER  = COMPARE "TO" ADDRESS
        STX     TOPOINTER
        ELSE    (M6809)
        LDY     #DECRYPTBUFFER
        FIN
        ldx     #RomSerialNumber Get pointer to serial number in ROM
        LDB     #8      = # BYTES TO COMPARE
        JSR     BLOCKCOMPARE    COMPARE DECRYPTBUFFER AGAINST ROM SERIAL NUMBER
        TPA             HAS 4'S BIT SET IF MATCHED
        ANDA    #4      = 0 IF NO MATCH, <>0 IF MATCH
*       SET OKTODECRYPTFLAG IF THERE IS A MATCH
*       DON'T USE CONDITIONAL BRANCH AS THEY ARE EASY TO FIND
*
        EORA    OKTODECRYPTFLAG NOW SET FLAG IF OK TO DECRYPT
        STA     OKTODECRYPTFLAG
*** IF DECRYPT KEY WERE FUNCTION OF ROM, THEN WE WOULD NOT HAVE TO CHECK SERIAL
*** NUMBER IN ROM AT ALL; SIMPLY TRY TO LOAD IT. ILLEGAL LOAD RECORD REPORTS AS
*** WRONG SERIAL NUMBER!
        LDX     #DECRYPTBUFFER  START CASCADE OF DECRYPTING 05 RECORD
        JSR     DECRYPT THIS RANDOMIZES AS MUCH AS ENCRYPT
        JSR     SETKEY  SET KEY TO CONTENTS OF BUFFER
        DEC     NKEYS   PROCESSED A KEY...
        BNE     LOADCASCADELOOP B/ MORE KEYS TO PROCESS
        TST     OKTODECRYPTFLAG DID WE FIND A MATCHING SERIAL NUMBER?
        LBEQ    ERRSERIALNOWRONG
*
*       AT THIS POINT, THE DECRYPTION KEY FOR THE OBJECT RECORDS IS COMPLETE
*       NOW WE START THE ACTUAL LOADING PROCESS
*       WE STILL CHECK FOR OBJECT FILE FORMAT IN CASE THE DECRYPTION KEY IS BAD
        PAGE
*       NOW GENERATE AN ENCRYPTED VERSION OF THE DECRYPTION KEY...
*       SO THAT CHAIN/LOAD CAN COMPARE TO OLD VERSION OF "DECRYPTION" KEY
*
        jsr     decrypt "Encrypt" the key using itself
        IF      M6800!M6801
        LDX     #NEWKEYENCRYPTED        = "TO" ADDRESS
        STX     TOPOINTER
        ELSE    (M6809)
        LDY     #NEWKEYENCRYPTED
        FIN
        LDX     #DECRYPTBUFFER  = FROM ADDRESS
        LDD     #8      = SIZE OF KEY
        JSR     BLOCKMOVE       SAVE NEWKEY, ENCRYPTED FOR LATER COMPARISION
*       LDX     #DECRYPTBUFFEREND       SET UP TO GET PRESUMED TYPE1 RECORD CODE
        STX     DECRYPTBUFPTR
        JSR     GETBYTE GET ME A BYTE
        jmp     loadstart       go process type1 load record

        FCB     $CE     TO THROW OFF WOULD-BE DISASSEMBLERS
SDOSSECRETKEY FCB $4C,$B0,$B7,$4E,$9B,$65,$72,$C9
        PAGE
LOADSETPOS      ; SYSCALL TO POSITION LOAD FILE PAST SKIP RECORD
        FCB     SYSCALL:CONTROL USED BY LOADER TO EXECUTE "SKIP N BYTES"
        FCB     CONTROL:SCLEN+4
        FCB     LOADCHANNEL
        FCB     CC:POSITION
        FDB     LOADFILEPOS     POINTER TO POSITION SELECT BUFFER
        FDB     4       SIZE OF POSITION SELECT BUFFER

LOADTYPE0       ; IGNORE "LOADCOUNT" BYTES (ASSERT: CANNOT OCCUR IN ENCRYPTED FILES!!!)
        JSR     GETWORD
LOADTYPE0L      ; USE UP BYTES IN DECRYPT BUFFER
        STD     LOADCOUNT       SAVE # BYTES TO SKIP
        LDX     DECRYPTBUFFER   USE UP BYTES IN DECRYPTBUFFER, FIRST
        CPX     #DECRYPTBUFFEREND       DECRYPT BUFFER EXHAUSTED?
        BEQ     LOADTYPE0.2     B/ YES
        JSR     GETBYTE NO, USE UP A BYTE
        LDD     LOADCOUNT       DECREMENT SKIP LOADCOUNT
        SUBD    #1
        BNED    LOADTYPE0L      B/ MORE BYTES TO SKIP
        BRA     LOADNEXT        EXHAUSTED SKIP LOADCOUNT!

LOADTYPE0.2 ; SKIP OVER BIG CHUNK OF BYTES IN FILE
        LDX     #LOADGETPOS     GET FILE POSITION
        JSR     SYSCALL$
        LDD     BUFFER  ADD LOADCOUNT BYTES TO CURRENT POSITION
        ADDD    LOADFILEPOS+2
        STD     LOADFILEPOS+2
        BCC     LOADTYPE0.1
        LDX     LOADFILEPOS     PROPOGATE CARRY TO UPPER 16 BITS
        INX
        STX     LOADFILEPOS
LOADTYPE0.1     EQU     *
        LDX     #LOADSETPOS     AND POSITION THERE
        JSR     SYSCALL$
        BRA     LOADNEXT
        page
*       LOAD BYTES AND THEN LOOK FOR NEXT RECORD
*
LOADTYPE2
        BSR     LOAD2AND3
*
*       GET NEXT RECORD, TYPE 0, 2, & 3 ALLOWED HERE
*
LOADCONTENTS    ; LOAD CONTENTS OF OBJECT FILE
LOADNEXT        JSR     GETBYTE
        CMPA    #LOAD:TYPE2     DATA RECORD ?
        BEQ     LOADTYPE2       B/ YES
        CMPA    #LOAD:TYPE3     LAST DATA RECORD ?
        BEQ     LOADTYPE3       B/ YES
        CMPA    #LOAD:TYPE0     SKIP RECORD ?
        BEQ     LOADTYPE0       B/ YES
ERRBADLOADRECORD        EQU     *
        JSR     ERRET
        FDB     ERR:BADLOADRECORD

ERRNOTENOUGHROOM        EQU     *
        JSR     ERRET
        FDB     ERR:NOTENOUGHROOM
        PAGE
*       LOAD BYTES AND THEN QUIT
*
LOADTYPE3 ; LAST LOAD RECORD, LOAD THE BYTES AND QUIT
*
*
*       LOAD BYTES FROM DISK FILE INTO USER SPACE
*
LOAD2AND3 ; LOAD CONTENTS OF TYPE 2 OR TYPE 3 RECORD
        JSR     GETWORD GO GET THE LOAD ADDRESS
        STD     USERLOADADDRESS
        JSR     GETWORD
        STD     LOADCOUNT
        ADDD    USERLOADADDRESS = ADDRESS OF LAST BYTE LOADED, +1
*
*       LOADBOUNDSCHECK -- MAKE SURE (A,B) <= DRIVER BASE
*       WE SHOULD ALSO CHECK TO MAKE SURE WE ARE LOADING ON TOP OF THE STACK, TOO!
*
        SEC             ACTUALLY TEST FOR (A,B)-1 < DRIVERBASE
        SBCB    TOPMEM+1                ...?
        SBCA    TOPMEM                  ...?
        BCC     ERRNOTENOUGHROOM        B/ HE'S DEAD!
LOAD2AND3.1 ; CHECK FOR DONE LOADING BYTES FROM THIS RECORD
        LDX     LOADCOUNT       ARE WE DONE?
        LBEQ    LOAD2AND3RTS    B/ YES
LOAD2AND3LOOP ; LOAD SOME BYTES FROM THIS RECORD
        LDX     DECRYPTBUFPTR   TRY TO OPTIMIZE THE LOAD PROCESS
        CPX     #DECRYPTBUFFEREND IS THERE STILL STUFF IN THE DECRYPT BUFFER?
        BNE     LOAD2AND3BYTE   B/ STUFF STILL IN THE BUFFER
        LDD     NPAGES          TAKE MIN(BUFFERSPACE,RECORDSIZE)
        CMPD    LOADCOUNT
        BCS     LOAD2AND3.3     B/ RECORD DOES NOT FIT IN BUFFER
        LDD     LOADCOUNT       AT LEAST 8 BYTES TO LOAD?
LOAD2AND3.3
        ANDB    #(\7)&$FF       (D) = MULTIPLE OF 8 BYTES TO LOAD
        STD     OPTIMIZEDLOADCOUNT
        BEQD    LOAD2AND3BYTE   B/ NOT ENOUGH BYTES TO LOAD
        PAGE
*
*       LOAD A MULTIPLE OF 8 BYTES INTO MEMORY QUICKLY
*
        LDD     LOADCOUNT       COMPUTE REMAINING LOADCOUNT AFTER OPTIMIZED LOAD
        SUBD    OPTIMIZEDLOADCOUNT
        STD     LOADCOUNT
        LDX     #LOADMULTIPLEOF8
        JSR     SYSCALL$        EOF WILL OCCUR IF LOAD FILE IS NOT MULTIPLE OF 8 BYTES IN SIZE
        LDX     LOADADDRESS     WHERE TO START DECRYPTING
        LDD     LOADADDRESS     COMPUTE WHERE TO END DECRYPTING
        ADDD    OPTIMIZEDLOADCOUNT
        STD     TSTEMP          = 1ST PLACE NOT YET LOADED
        TST     OKTODECRYPTFLAG ARE WE DECRYPTING?
        BEQ     LOAD2AND3.2     B/ NO, GO LOAD MORE BYTES
LOAD2AND3MASSDECRYPT ; DECRYPT JUST LOADED BLOCK OF BYTES
        JSR     DECRYPT GO DECRYPT A BLOCK OF 8 BYTES
        LEAX    8,X     FIND NEXT BLOCK OF 8 BYTES
        CPX     TSTEMP          ALL LOADED BYTES DECRYPTED YET?
        BNE     LOAD2AND3MASSDECRYPT B/ NO, GO DECRYPT SOME MORE
LOAD2AND3.2
        LDD     USERLOADADDRESS
        IF      M6809
        TFR     D,Y
        ELSE
        STD     TEMPX
        FIN
        ADDD    OPTIMIZEDLOADCOUNT
        STD     USERLOADADDRESS
        LDX     LOADADDRESS
        LDD     OPTIMIZEDLOADCOUNT
        JSR     COPYTOUSER
        JMP     LOAD2AND3.1
        PAGE
*       LOAD A BYTE THE HARD WAY
*
LOAD2AND3BYTE ; LOAD ONE BYTE THE UNOPTIMIZED WAY
        BSR     GETBYTE
        LDX     USERLOADADDRESS
        JSR     COPYATOUSER
        LDX     USERLOADADDRESS
        INX
        STX     USERLOADADDRESS
        LDX     LOADCOUNT
        DEX
        STX     LOADCOUNT
        LBNE    LOAD2AND3LOOP
LOAD2AND3RTS    OKRTS   YOU GUESS...
        PAGE
GETBYTE ; GET NEXT DECRYPTED BYTE FROM THE FILE INTO (A)
        LDX     DECRYPTBUFPTR   IS THE BUFFER EMPTY?
        CPX     #DECRYPTBUFFEREND
        BNE     GETBYTE1        B/ NOPE
        TST     OKTODECRYPTFLAG BUFFER IS EMPTY, ARE WE DECRYPTING?
        BNE     GETBYTED        B/ YES, GO FETCH ANOTHER BUFFERFUL TO DECRYPT
        LDX     #GET1BYTE       NO, FETCH NEXT LOAD RECORD HEADER BYTE
        JSR     SYSCALL$
        LDA     BUFFER  GET THE BYTE
        OKRTS

GETBYTED        ; GET NEXT 8 BYTES FROM FILE AND DECRYPT
        LDX     #FILLDECRYPTBUFFER
        JSR     SYSCALL$
        LDX     #DECRYPTBUFFER  START BUFFER POINTER AT BEGIN BUFFER
        JSR     DECRYPT DECRYPT THE 8 BYTES JUST READ
GETBYTE1 ; FETCH DECRYPTED BYTE FROM BUFFER
        LDA     ,X+     GET THE CHAR
        STX     DECRYPTBUFPTR
        OKRTS           I'M DONE
*
GETWORD ; GET 2 BYTES FROM THE DISK BUFFER INTO (D)
        BSR     GETBYTE
        PSHA
        BSR     GETBYTE
        TAB
        PULA
        RTS
        page
SETKEY ; SET "KEY" TO 8 BYTES POINTED TO BY (X)
        LDD     4,X     COPY KEY BYTES TO INLINE CODE
        STB     KEY5    DO SO IN AS APPARENTLY DISORGANIZED WAY AS POSSIBLE
        STA     KEY4
        LDD     0,X
        STA     KEY0
        STB     KEY1
        LDD     6,X
        STB     KEY7
        STA     KEY6
        LDD     2,X
        STA     KEY2
        STB     KEY3
        RTS
        PAGE
ZAPUSERSPACE    ; OLD DECRYPTION KEY <> NEW, ERASE USER SPACE!
        LDD     LOADADDRESS
        ADDA    NPAGES
        TDX
        LDD     #0
ZAPUSERSPACEL ; ZAP ANOTHER USER SPACE BYTE
        STD     ,--X            ASSERT: THIS ZEROS AN EVEN NUMBER OF BYTES!
        CPX     LOADADDRESS     STOP ZEROING AT BEGINNING OF BUFFER
        BNE     ZAPUSERSPACEL

; repeatedly copy buffer to user space until user space is zeroed

        LDD     TOPMEM
        DECA                    SKIP PAGE ZERO
        STD     LOADCOUNT
        LDD     #$100
        STD     USERLOADADDRESS
ZAPUSERSPACEL.1
        LDD     NPAGES
        CMPD    LOADCOUNT
        BLO     ZAPUSERSPACEL.2 B/ BUFFER SIZE < LOADCOUNT
        LDD     LOADCOUNT
ZAPUSERSPACEL.2
        IF      M6809
        LDY     USERLOADADDRESS
        ELSE
        LDX     USERLOADADDRESS
        STX     TEMPX
        FIN
        LDX     LOADADDRESS
        JSR     COPYTOUSER
        LDD     LOADCOUNT
        SUBD    NPAGES
        BLO     SETUPFRANKBAKERJ
        BEQD    SETUPFRANKBAKERJ
        STD     LOADCOUNT
        LDD     USERLOADADDRESS
        ADDD    NPAGES
        STD     USERLOADADDRESS
        BRA     ZAPUSERSPACEL.1

SETUPFRANKBAKERJ
        JMP     SETUPFRANKBAKER
        PAGE    EXIT CODE
*       Close all channels which user has open, except for channel 0

EXITS
        LDX     CURRENTUCB      make CHAIN syscall block into a CLOSE scb
        LDX     UCB:CHANNELMAP,X        start with this user's highest virt chan
        LDAA    0,X             fetch number of possible user channels
        DECA                    leave out channel 0
EXITS.LOOP
        LDX     CURRENTUCB
        STAA    SCBLK:PARAMS,X
        PSHA                    save this channel number
        JSR     CLOSE.DUMP
        BCS     EXITS.DOESNTMATTER
EXITS.DOESNTMATTER
        PULA
        DECA
        BNE     EXITS.LOOP
EXITS.DONE
        RTS
        PAGE    Block Move and Compare
blockmove ; /MT doesn't move big blocks, so this awful routine is ok
        std     tempx+4
blockmoveloop
        lda     ,x+
        if      m6800!m6801
        stx     tempx+2
        ldx     tempx
        sta     ,x+
        stx     tempx
        ldx     tempx+2
        else
        sta     ,y+
        fin     m6800!m6801
        decb
        bne     blockmoveloop
        tst     tempx+4
        beq     blockmoveloop.1
        dec     tempx+4
        bra     blockmoveloop

blockmoveloop.1
        rts
        page
blockcompare ; /MT doesn't compare big blocks, so this awful routine is ok
        lda     ,x+
        if      m6800!m6801
        stx     tempx+2
        ldx     tempx
        cmpa    0,x
        bne     blockcomparefail
        inx
        stx     tempx
        ldx     tempx+2
        else
        cmpa    ,y+
        bne     blockcomparefail
        fin     m6800!m6801
        decb
        bne     blockcompare
        rts                        Z flag cleared in CCR => compare =

blockcomparefail
        if      m6800!m6801
        inx
        stx     tempx
        ldx     tempx+2
        fin     m6800!m6801
        lda     #-1                clears Z flag in CCR => compare <>
        rts
        PAGE
SETUPFRANKBAKER ; set up syscall linkage within user space
        LDAA    SYSCALL$        SET UP SYSCALL JUMP IN PAGE ZERO...
        LDX     #SYSCALL$       ...to jump to I/O package base
        JSR     COPYATOUSER
        LDD     TOPMEM  (so user knows where base of I/O pack is!)
        LDX     #SYSCALL$+1
        JSR     COPYDTOUSER
        LDAA    USERSPACESYSCALL        tell user how to get to system space
        LDX     TOPMEM
        JSR     COPYATOUSER
        LDD     USERSPACESYSCALL+1
        LDX     TOPMEM
        INX
        JMP     COPYDTOUSER
        PAGE    READA
; Should we time slice between bites for SYSCALL:READ/WRITE to non-VT devices ???

READA
        JSR     GETCHANNEL      do channel translation
        JSR     ISITVIRTUAL
        BEQ     READA.1         b/ not VT device
        CLR     UCB:USERCPUBOUND,X doing I/O to VT device --> not CPU bound
        TST     SCBLK:PARAMS+1,X non-line mode read ?
        LBEQ    ERRILLSYSCALL   foo on non-linemode reada to vt device!!
READA.1
        JSR     CHECKRDLEN
        #0
        JSR     READA.1.1       get ready to do a read
        LDX     CURRENTUCB      Like SETUPREADBUF
        JSR     ALLOCATE1PAGE    but only allocate 1 page as reply buffer
*                                 since READA's of >256 bytes are unlikely;
*                                  this speeds up most READAs
        STAA    SCBLK:RDLEN,X
        CLR     SCBLK:RDLEN+1,X
        STAB    SCBLK:RDBUF,X
        CLR     SCBLK:RDBUF+1,X
READA.LOOP.0
        TST     UCB:VTFLAG,X    vt reada's and other reada's are different
        BNE     READA.VTLOOP    B/ go handle the vt device
        PAGE
READA.LOOP
        JSR     READLOOPTEST
        LBCS    READB.9         B/ nothing left
        JSR     SYSCALL$
        LBCS    READA.8         oops!
        JSR     COPYBITETOUSER
        JSR     READALOG        log this bite
        JSR     CHECKACTIVATIONFORREADA
        LBCS    READB.9         B/ this bite contained activation--exit
        BRA     READA.LOOP

READA.VTLOOP
        JSR     READLOOPTEST
        LBCS    READB.9         B/ nothing left
        JSR     SYSCALL$
        BCS     READA.VTLOOP.ERR        B/ something's wrong
        JSR     COPYBITETOUSER
        JSR     READALOG        log this bite
        JMP     READB.9         since activation, done

READA.VTLOOP.ERR
        CPX     #ERR:ACTIVATIONNOTINBUFFER
        LBNE    READA.8         B/ wasn't what I expected
        JSR     COPYBITETOUSER
        JSR     READALOG
        BRA     READA.VTLOOP    since no activation, keep trying

READA.ERROR
        JSR     GOCATATONIC     internal error while doing reada
        PAGE
READALOG        ; perform logging for a reada
        JSR     DOWELOG
        BEQ     READARTS        B/ nope
        LDD     SCBLK:PARAMS,X  save channel and line mode flag
        PSHD
        LDAA    UCB:VTFLAG,X    save device type flags
        PSHA
        LDD     SCBLK:RDBUF,X   save this stuff, too
        STD     SCBLK:WRBUF,X
        PSHD
        LDD     SCBLK:RPLEN,X
        STD     SCBLK:WRLEN,X
        PSHD
        LDD     SCBLK:RDLEN,X
        PSHD
        LDAA    UCB:LOGCHANNEL,X
        STAA    SCBLK:PARAMS,X
        LDAA    #SYSCALL:WRITEA set up to do a write
        STAA    SCBLK:OPCODE,X
        LDAA    #WRITEA:SCLEN
        STAA    SCBLK:WLEN,X
        JSR     WRITEA.DIRTYWORK
        BCS     READALOG.ERR            oops
READALOG.COMPLETE
        LDX     CURRENTUCB              put the scblk back together
        PULD
        STD     SCBLK:RDLEN,X
        PULD
        STD     SCBLK:RPLEN,X
        PULD
        STD     SCBLK:RDBUF,X
        PULA
        STAA    UCB:VTFLAG,X
        PULD
        STD     SCBLK:PARAMS,X
        LDAA    #SYSCALL:READA         why is this done ?
        STAA    SCBLK:OPCODE,X         (ok, because efficiency unneeded here)
        LDAA    #READA:SCLEN
        STAA    SCBLK:WLEN,X
READARTS
        OKRTS
        PAGE
READALOG.ERR
        STX     LASTERROR
        LDX     CURRENTUCB              put the scblk back together
        PULD
        STD     SCBLK:RDLEN,X
        PULD
        STD     SCBLK:RPLEN,X
        PULD
        STD     SCBLK:RDBUF,X
        PULA
        STAA    UCB:VTFLAG,X
        PULD
        STD     SCBLK:PARAMS,X
        LDAA    #SYSCALL:READA
        STAA    SCBLK:OPCODE,X
        LDAA    #READA:SCLEN
        STAA    SCBLK:WLEN,X
        JMP     ERRORED
        PAGE
READA.8 ; come here for reada errors

; an error occurring during a reada propagates the error if it is not
; err:eofhit; otherwise, save the error code, readalog, if channel 0 is
; open to the console, leave it open: the user can close and re-open it;
; otherwise, close channel 0, close the log if logging to the console,
; and then open channel 0 to the console

        STX     LASTERROR
        JSR     COPYBITETOUSER  give user as much as I got from SDOS
        JSR     READB.9         calculate final rplen
        LDX     LASTERROR
        CPX     #ERR:EOFHIT     we're not interested if not EOF
        LBNE    ERRORED
        JSR     READALOG        log what we've got
        lda     UCB:USERCHAN,X  toss him out if he's not using channel 0
        bne     reada.goteof
        jsr     isitconsole
        beq     reada.goteof    b/ skip all this if already open to console:
        jsr     getuserlfchannel
        lbeq    jobcontrol.jobdone     b/ eof on chan 0 and no console!
        JSR     CLOSECONSOLE    switch back to the console for further input
        LDX     CURRENTUCB        and turn off logging if it's to the console
        LDAA    UCB:LOGCHANNEL,X
        CMPA    #$FF
        BEQ     READA.8.1       B/ not even logging
        CMPA    UCB:LFCHAN,X
        BNE     READA.8.1       B/ logging, but not to console
        JSR     CLOSELOG        bye, bye, logging!
READA.8.1
        JSR     OPENCONSOLE
        LDX     CURRENTUCB
        lda     ucb:chan0,x     patch up the scb
        sta     scblk:params,x
        JSR     ISITVIRTUAL
        JSR     READA.1.1       may have changed from file to vt, so make sure
        JMP     READA.LOOP.0      the coast is clear before leaping
        PAGE
READA.1.1
        TST     UCB:VTFLAG,X
        BNE     READA.2.1       B/ special handling for VT devices
READA.1.2
        OKRTS

READA.2.1
        LDAA    SCBLK:PARAMS,X  if input is ready, don't wait for it!!
        STAA    READYLINE+SCBLK:PARAMS
        LDX     #READYLINE      go ready a line and wait for it
        JSR     SYSCALL$
        BCC     READA.3         B/ the line is not ready
        CPX     #ERR:ACTIVATIONRECEIVED
        BEQ     READA.1.2       B/ the line is ready to go
        CPX     #ERR:IOINPROGRESS
        BEQ     READA.3         B/ the line is not ready
        JSR     GOCATATONIC     BAD NEWS!!!

READA.3
        LDD     CURRENTUCB
        JSR     ADDINPUTQ
        JSR     SAVEPLACE
        OKRTS

reada.goteof
        ldx     #err:eofhit
        jmp     errorinx
        PAGE
READLOOPTEST    ; see if the user has anything left to copy--carry set if none
        LDD     UCB:USERRDLEN,X see how much more must be read
        BEQD    READLOOPTEST.9  B/ nothing more needed
        SUBD    SCBLK:RDLEN,X   see if full- or partial-bite needed
        BCC     READLOOPTEST.1
        LDD     UCB:USERRDLEN,X do a partial-bite to finish off operation
        STD     SCBLK:RDLEN,X
READLOOPTEST.1
        OKRTS

READLOOPTEST.9
        ERRORRTS
        PAGE
CHECKACTIVATIONFORREADA ; used only for non-VT class devices
        LDD     UCB:USERRDLEN,X if user got everything he asked for, he's
        SUBD    UCB:USERRPLEN,X   obviously done.  if he didn't, then check
        BEQD    READA.DONE          the last character read for activation
        LDD     SCBLK:RDBUF,X
        ADDD    SCBLK:RPLEN,X
        TDX
        DEX
        LDAB    0,X             look at last character read
        CMPB    #ASCII:CR       (SDOS ensures that parity bit is reset)
        BNE     READA.NOTDONE
READA.DONE
        LDX     CURRENTUCB
        ERRORRTS

READA.NOTDONE
        LDX     CURRENTUCB
        OKRTS
        PAGE    READB
*       Perform a read binary operation in bite-size chunks.  The size of the
*       bite is determined by how many pages /MT can allocate.

READB
        JSR     GETCHANNEL      do channel translation
        JSR     CHECKRDLEN      all I really want are the side-effects
        #0
        BSR     SETUPREADBUF
READB.LOOP
        JSR     READLOOPTEST
        BCS     READB.9         B/ nothing left
        JSR     SYSCALL$        fetch, boy!!
        BCS     READB.8         ouch!!
        BSR     COPYBITETOUSER
        BRA     READB.LOOP

READB.8 ; got some kind of error: terminate operation
        STX     LASTERROR
        BSR     COPYBITETOUSER  copy data to user
        BSR     READB.9
        JMP     ERRORED

READB.9
        LDD     UCB:USERRPLEN,X
        STD     SCBLK:RPLEN,X   return the complete rplen
        OKRTS
        PAGE
SETUPREADBUF
        LDX     CURRENTUCB
        LDD     SCBLK:RDLEN,X
        ADDD    #255    round up to next page
        JSR     ALLOCATENPAGES  page count left in A--neat, huh?!
        STAA    SCBLK:RDLEN,X   adjust system call block
        CLR     SCBLK:RDLEN+1,X
        STAB    SCBLK:RDBUF,X
        CLR     SCBLK:RDBUF+1,X
        RTS
        page
COPYBITETOUSER
        LDX     CURRENTUCB
        IF      M6809
        LDY     UCB:USERRDBUF,X
        ELSE
        LDD     UCB:USERRDBUF,X
        STD     TEMPX
        FIN
        LDD     SCBLK:RPLEN,X
        BEQD    COPYBITETOUSER.9        nothing to copy--so don't bother
        LDX     SCBLK:RDBUF,X
        JSR     COPYTOUSER
        LDX     CURRENTUCB      adjust pointers, counters
        LDD     UCB:USERRDBUF,X
        ADDD    SCBLK:RPLEN,X
        STD     UCB:USERRDBUF,X
        LDD     UCB:USERRDLEN,X
        SUBD    SCBLK:RPLEN,X
        STD     UCB:USERRDLEN,X
        LDD     UCB:USERRPLEN,X
        ADDD    SCBLK:RPLEN,X
        STD     UCB:USERRPLEN,X
COPYBITETOUSER.9
        RTS
        PAGE
COPYBITEFROMUSER ; copy "bite" (pun intended) from user space to system space
; "bite" size is determined by how much buffer we were able to grab
; returns Z bit Set ("Zero") if this is the last bite we must process
; returns Z bit Reset ("Not Zero") if user syscall block still has lots to move

        LDX     CURRENTUCB
        LDAA    UCB:BUFFER,X    copy data from userspace to systemspace
        CLRB
        STD     SCBLK:WRBUF,X
        IF      M6809
        TFR     D,Y
        ELSE
        STD     TEMPX
        FIN
        LDD     UCB:USERWRLEN,X
        CMPA    UCB:BUFFERSIZE,X   do we copy a full bite, or just a taste?
        BHS     COPYBITEFROMUSER.2      B/ copy over a full bite
        STD     SCBLK:WRLEN,X   copy over last bite
        LDX     UCB:USERWRBUF,X
        JSR     COPYTOSYSTEM
        CLRA                    signal "last bite"
        RTS                     --> no need to adjust pointers
        page
COPYBITEFROMUSER.2
        LDAA    UCB:BUFFERSIZE,X fetch size of buffer to move
        CLRB
        STD     SCBLK:WRLEN,X
        LDX     UCB:USERWRBUF,X
        JSR     COPYTOSYSTEM
        LDX     CURRENTUCB      adjust count and pointer
        LDD     UCB:USERWRBUF,X
        ADDD    SCBLK:WRLEN,X
        STD     UCB:USERWRBUF,X
        LDD     UCB:USERWRLEN,X
        SUBD    SCBLK:WRLEN,X
        STD     UCB:USERWRLEN,X
        IF      M6800
        BNE     *+3             set "Z" bit to indicate remaining amount
        TSTB
        FIN
        RTS
        PAGE    WRITEA & WRITEB
;
;       WRITEA -- To perform SYSCALL:WRITEA for user
;       Note that a fast path for WRITEAs with small WRBUFs has been provided
;
WRITEA  JSR     GETCHANNEL      do channel translation
        LDD     SCBLK:WRBUF,X   set up buffer space for COPYBITEFROMUSER
        STD     UCB:USERWRBUF,X
        LDD     SCBLK:WRLEN,X
        BEQD    WRITEAFROMSYSTEMSPACE  b/ none to write, do it quick!
        STD     UCB:USERWRLEN,X
        ADDD    #255
        JSR     ALLOCATENPAGES
        STAB    UCB:BUFFER,X            remember this!
        STAA    UCB:BUFFERSIZE,X        this too!!
WRITEA.LOOP
        JSR     COPYBITEFROMUSER
        BEQ     WRITEAFROMSYSTEMSPACE   b/ last bite, take fast path
        BSR     WRITEAFROMSYSTEMSPACE
        BRA     WRITEA.LOOP     b/ this is not last bite
        PAGE
WRITEAFROMSYSTEMSPACE
        BSR     DOWELOG
        BEQ     WRITEAFROMSYSTEMSPACE.6 B/ no, we don't
        JSR     ISITCONSOLE
        BNE     WRITEAFROMSYSTEMSPACE.2 B/ no, it isn't
        LDX     CURRENTUCB              well, we are and it is, so do it twice
        LDD     SCBLK:WRBUF,X
        PSHD
        LDD     SCBLK:WRLEN,X
        PSHD
        JSR     WRITEA.DIRTYWORK         first to channel 0
        BCS     WRITEAFROMSYSTEMSPACE.3 oops!
        LDX     CURRENTUCB
        PULD
        STD     SCBLK:WRLEN,X
        PULD
        STD     SCBLK:WRBUF,X
        PAGE
WRITEAFROMSYSTEMSPACE.2
        LDAA    SCBLK:PARAMS,X          then to log
        PSHA
        LDD     #SYSCALL:WRITEA##8!WRITEA:SCLEN convert back to WRITEA call
        STD     SCBLK:OPCODE,X
        LDAA    UCB:LOGCHANNEL,X
        STAA    SCBLK:PARAMS,X
        JSR     WRITEA.DIRTYWORK
        BCS     WRITEAFROMSYSTEMSPACE.4
WRITEAFROMSYSTEMSPACE.5
        LDX     CURRENTUCB
        PULA
        STAA    SCBLK:PARAMS,X          patch scblk back together
        OKRTS

WRITEAFROMSYSTEMSPACE.4
        STX     TSTEMP
        JSR     CLOSELOG                had trouble during logging
        BCS     WFSS.4.DONTCARE         damn the log, full speed ahead!
WFSS.4.DONTCARE
        ldx     currentucb              if channel 0 is not to the console
        jsr     isitconsole             then close and re-open console, too
        bcc     wfss.5                  b/ console
        jsr     closeconsole            kaBLOOIE!
        jsr     openconsole
wfss.5
        LDX     CURRENTUCB
        PULA
        STAA    SCBLK:PARAMS,X          patch scblk back together
        ldx     tstemp
        JMP     ERRORINX

WRITEAFROMSYSTEMSPACE.6 ; fast path for WRITEAs with small buffers
        lda     scblk:params,x          writing to user CONSOLE: ?
        cmpa    ucb:lfchan,x
        beq     writea.dirtywork        b/ yes, go do it!
        cmpa    ucb:chan0,x             no, writing to channel zero ?
        bne     writea.dirtywork        b/ no, just go do it!
        okrts                           skip output if chan 0, but not console

WRITEAFROMSYSTEMSPACE.3
        LEAS    4,S
        JMP     ERRORINX
        PAGE
DOWELOG ; returns Z set (Zero) if NOT logging
; returns Z reset (Not Zero) if logging; log channel in (a)
        LDX     CURRENTUCB
        lda     ucb:logchannel,x
        cmpa    #$ff            see if log is open
        beq     dowelog.rts     b/ no (hi frequency path)
        lda     scblk:params,x  is it channel zero ?
        cmpa    ucb:chan0,x
        beq     dowelog.yes
        clra                    set Z
dowelog.rts
        rts

dowelog.yes
        ldab    #1              reset Z --> logging
        rts

isitconsole ; returns Z set (Zero) if true
        ldx     currentucb
        lda     scblk:params,x
        cmpa    ucb:lfchan,x
        rts
        PAGE
WRITEA.DIRTYWORK
        LDX     CURRENTUCB
        JSR     ISITVIRTUAL             accomodate vt, if vt
        LBEQ    SYSCALL$                B/ not vt, just do it!
        CLR     UCB:USERCPUBOUND,X      be nice to guys who do terminal I/O
        LDD     #SYSCALL:CONTROL##8!SCBLK:DATA turn "writea" to "cc:writeanowait"
        STD     SCBLK:OPCODE,X
        LDAA    #CC:WRITEANOWAIT
        STAA    SCBLK:PARAMS+1,X
        LDD     CURRENTUCB
        ADDD    #SCBLK:DATA             put the done flag and error code in the scb
        STD     SCBLK:RDBUF,X
        LDD     #3
        STD     SCBLK:RDLEN,X
        JSR     SYSCALL$
        LDX     CURRENTUCB
        LDA     SCBLK:DATA,X            see if VT driver took all the data
        BEQ     WRITEA.DIRTYWORK.5      b/ no, go put user to sleep
        LDX     SCBLK:DATA+1,X          yes, get error code
        BEQ     WRITEA.DIRTYWORK.3      b/ no error, get out!
WRITEA.DIRTYWORK.2
        STX     LASTERROR
        JMP     ERRORED

WRITEA.DIRTYWORK.5 ; stick user into output wait queue
        LDD     CURRENTUCB
        JSR     ADDOUTPUTQ
        JSR     SAVEPLACE
WRITEA.DIRTYWORK.3 ; assert: C=0
        RTS
        page
;       WRITEB -- does SYSCALL:WRITEB for users
;       Note fast path for WRITEBs with small WRBUFs
;
WRITEB  JSR     GETCHANNEL      do channel translation
        LDA     SCBLK:PARAMS,X  writing to channel zero ?
        CMPA    UCB:CHAN0,X     ...?
        BNE     WRITEB.1        b/ nope
        CMPA    UCB:LFCHAN,X    to user console: ?
        BNE     WRITEB.OKRTS    b/ write to channel 0, but not to console: !
WRITEB.1
        LDD     SCBLK:WRBUF,X
        STD     UCB:USERWRBUF,X
        LDD     SCBLK:WRLEN,X
        BEQD    WRITEB.DIRTYWORK b/ writeb 0 bytes, do call now!
        STD     UCB:USERWRLEN,X
        LDD     SCBLK:WRLEN,X
        ADDD    #255
        JSR     ALLOCATENPAGES
        STAB    UCB:BUFFER,X            remember this!
        STAA    UCB:BUFFERSIZE,X        this too!!
WRITEB.LOOP
        JSR     COPYBITEFROMUSER
        BEQ     WRITEB.DIRTYWORK       b/ last bite, take fast path!
        BSR     WRITEB.DIRTYWORK
        BRA     WRITEB.LOOP            b/ this is not last bite

WRITEB.OKRTS
        OKRTS                   das ist alles
        page
WRITEB.DIRTYWORK ; DOES NASTY PART OF I/O FOR WRITE BINARY
        LDX     CURRENTUCB
        JSR     ISITVIRTUAL             accomodate vt, if vt
        LBEQ    SYSCALL$                B/ not vt, just do it
        CLR     UCB:USERCPUBOUND,X      be nice to guys who do terminal I/O
        LDD     #SYSCALL:CONTROL##8+SCBLK:DATA turn "writeb" into "cc:writebnowait"
        STD     SCBLK:OPCODE,X
        LDAA    #CC:WRITEBNOWAIT
        STAA    SCBLK:PARAMS+1,X
        LDD     CURRENTUCB
        ADDD    #SCBLK:DATA             put the done flag and error code in the scb
        STD     SCBLK:RDBUF,X
        LDD     #3
        STD     SCBLK:RDLEN,X
        JSR     SYSCALL$
        LDX     CURRENTUCB              no error during I/O
        LDA     SCBLK:DATA,X            see if VT driver took all the data
        BEQ     WRITEB.DIRTYWORK.5      b/ no, go put user to sleep
        LDX     SCBLK:DATA+1,X          yes, get error code
        BEQ     WRITEB.DIRTYWORK.3      b/ no error, get out!
WRITEB.DIRTYWORK.5 ; stick user into output wait queue
        LDD     CURRENTUCB
        JSR     ADDOUTPUTQ
        JSR     SAVEPLACE
WRITEB.DIRTYWORK.3 ; assert: Carry bit is Reset, here...
        RTS
        PAGE    CREATELOG & CLOSELOG
CREATELOG
        LDX     CURRENTUCB
        LDA     UCB:LOGCHANNEL,X       is it open, already?
        JSR     ISCHANNELCLOSED        bomb out if not closed
        BSR     DOCREATELOG
        BCS     CREATELOG.ERR2
        JMP     RETURNSCANNED
        OKRTS

CREATELOG.ERR2

; got an error and log wasn't created, so get rid of the channel

        STX     TSTEMP
        LDX     CURRENTUCB
        LDA     UCB:LOGCHANNEL,X
        LDB     #$FF
        STB     UCB:LOGCHANNEL,X
        JSR     RELEASEREALCHANNEL
        BCS     CREATELOG.DONTCARE
CREATELOG.DONTCARE
        LDX     TSTEMP
        JMP     OPEN.ERR1
        PAGE
docreatelog
        jsr     fnamesetup             go get the device/file name
        jsr     wasconsolerequested
        bcc     docreatelog.2          b/ yes-- this is going to be easy
docreatelog.1 ; entry point for JC:CREATE
        jsr     allocaterealchannel    sigh...
        ldx     currentucb
        sta     ucb:logchannel,x
        sta     scblk:params,x
        ldd     #syscall:create##8!create:sclen
        std     scblk:opcode,x
        jsr     syscall$               go do the create
        jmp     checkdevtyp            now that it's open, record its type

docreatelog.2
        lda     ucb:lfchan,x           this is the real console
        sta     ucb:logchannel,x
        okrts

CLOSELOG
        LDX     CURRENTUCB
        LDA     UCB:LOGCHANNEL,X
        LDB     #$FF
        STB     UCB:LOGCHANNEL,X
        jsr     ischannelopen
        JMP     RELEASEREALCHANNEL
        PAGE    CONTROL & STATUS
CONTROL
        JSR     GETCHANNEL      translate virtual channel to real
        JSR     ISITVIRTUAL     VT cc:killenable and cc:killdisable not allowed
        BEQ     CONTROL.3       b/ not VT
        LDX     CURRENTUCB
        LDAA    SCBLK:PARAMS+1,X
        CMPA    #CC:KILLPROOF
        BEQ     CONTROL.ERR3
        CMPA    #CC:KILLENABLE
        BEQ     CONTROL.ERR3
CONTROL.3
        JSR     DOWELOG
        BEQ     CONTROL.2       b/ no logging
        STAA    SCBLK:PARAMS,X  control log channel
CONTROL.2
        LDAA    SCBLK:WLEN,X    see if syscall block contains write buffer
        ANDA    #%01111111
        CMPA    #SCBLK:WRLEN+2
        BCS     CONTROL.1       B/ no write buffer
        LDD     SCBLK:WRLEN,X   see if buffer too large
        CMPD    #256
        BHI     CONTROL.ERR1    B/ too big--too bad!!
        LDD     SCBLK:WRBUF,X   remember user's write buffer
        STD     UCB:USERWRBUF,X
        JSR     ALLOCATE1PAGE   get page and move user's write buffer over
        LDX     CURRENTUCB
        LDAA    PAGEBASE
        CLRB
        STD     SCBLK:WRBUF,X
        IF      M6809
        TFR     D,Y
        ELSE
        STD     TEMPX
        FIN
        LDD     SCBLK:WRLEN,X
        LDX     UCB:USERWRBUF,X
        JSR     COPYTOSYSTEM
CONTROL.1
        LDX     CURRENTUCB      do syscall
        JSR     SYSCALL$
        BCS     CONTROL.ERR2
        OKRTS

CONTROL.ERR1
        JSR     ERRET
        #ERR:WRBUFTOOBIG

CONTROL.ERR3
        JSR     ERRET
        #ERR:NOTUNDERTIMESHARE
        PAGE
CONTROL.ERR2
        CPX     #ERR:FILEISOPEN maybe the errmsgs file is causing this
        LBNE    ERRORINX        (and then, again, maybe it isn't)
        STX     TSTEMP
        LDX     CURRENTUCB
        LDAA    SCBLK:PARAMS+1,X
        CMPA    #CC:DISMOUNTDISK
        LBNE    ERRORED         but, then, if it isn't dismount, I don't care
        LDX     #CLOSEERRMSGS   get this out of the way and retry the dismount
        JSR     SYSCALL$
        BCC     CONTROL.1       try the cc:dismount, again
        LDX     TSTEMP          must have been err:closed...ah, well...
        jmp     errorinx
        PAGE
; caveat: if the caller's RDLEN > 256 then it is reduced to 256, giving
; SDOS the opportunity to reject the buffer as too small (which is probably
; not the case)

STATUS
        JSR     GETCHANNEL      translate virtual channel to real
        JSR     DOWELOG
        BEQ     STATUS.2        B/ the answer is "we're not"
        STAA    SCBLK:PARAMS,X  get status of log channel
STATUS.2
        LDAA    SCBLK:WLEN,X    see if syscall block contains read buffer
        ANDA    #%01111111
        CMPA    #SCBLK:RDLEN+2
        LBCS    SYSCALL$        B/ no read buffer, no reply expected
        LDD     SCBLK:RDLEN,X   see if read buffer too large
        CMPD    #256
        BLS     STATUS.3        B/ buffer is one page or less
        LDD     #256
        STD     SCBLK:RDLEN,X   reduce the buffer to one page
STATUS.3
        LDD     SCBLK:RDBUF,X
        STD     UCB:USERRDBUF,X save user's read buffer
        JSR     ALLOCATE1PAGE   go get room for reply
        LDX     CURRENTUCB
        LDAA    PAGEBASE
        CLRB
        STD     SCBLK:RDBUF,X
        JSR     SYSCALL$        do syscall
        BCS     STATUS.ERR2     B/ syscall errored
        BRA     RDBUFTOUSER     copy read buffer to user space

STATUS.ERR2
        STX     LASTERROR       got an error, copy reply back
        BSR     RDBUFTOUSER
        JMP     ERRORED
        PAGE
RDBUFTOUSER     ; copy the reply buffer back to the user space
        LDX     CURRENTUCB
        IF      M6809
        LDY     UCB:USERRDBUF,X
        ELSE
        LDD     UCB:USERRDBUF,X
        STD     TEMPX
        FIN
        LDD     SCBLK:RPLEN,X
        BEQD    RDBUFTOUSER.XIT get out of here if rplen=0
        LDX     SCBLK:RDBUF,X
        JSR     COPYTOUSER
RDBUFTOUSER.XIT
        OKRTS
        PAGE    ERROREXIT & EXIT
*       EXIT syscall stuffs a CHAIN syscall block and a call referencing it
*       into the user space and then forces the user's PC to that syscall.
*       EXIT sets the LASTERROR to 0.  ERROREXIT does the same as EXIT, but
*       sets LASTERROR to the error number supplied as a parameter to the
*       syscall.

EXIT    LDX     #0      set LASTERROR to 0
        STX     USERLASTERROR
        BRA     EXIT2

ERROREXIT
        LDX     CURRENTUCB
        LDX     SCBLK:PARAMS,X  get user supplied error code
EXIT1   STX     USERLASTERROR
        JSR     DERRCR          put error out on user's console
EXIT2   JSR     RELEASEALLPAGES make sure no loose ends
        LDD     CURRENTUCB      set up stack pointer, just to be safe
        ADDD    #UCB:STACK
        IF      M6800!M6801
        TDX
        TXS                    set up correctly for 6800 or 6801
        ELSE
        TFR     D,S
        FIN
        LDD     #FIREBREAK      in case of disaster
        PSHD
        BSR     EXIT.CHECKSUM   make sure memory hasn't flaked out
        JSR     KILLENABLE      killenable, in case user disabled
        BCS     *+2             B/ I don't care!
        IF      M6809
        LDY     #USERSPACEEXIT
        ELSE
        LDX     #USERSPACEEXIT
        STX     TEMPX
        FIN
        LDX     #USERSPACEEXITSTUFF
        LDD     #USERSPACEEXITSTUFFLEN
EXIT4   JSR     COPYTOUSER
        JSR     INITUSERSTACK
        JMP     SYSCALLEXIT.1
        page
EXIT.CHECKSUM
        LDD     #MTCHKSUMSIZE
        STAA    TEMPA
        LDX     #MTCHKSUMBASE
        CLRA
CKSUMLOOP
        ASLA
        ADCA    0,X
        INX
        DECB
        BNE     CKSUMLOOP
        DEC     TEMPA
        BPL     CKSUMLOOP
        TSTA
        BNE     EXIT.CHKSUM
        OKRTS

EXIT.CHKSUM
        JSR     ERRET
        #ERR:SELFTESTCKSUM
        PAGE
USERSPACEEXITSTUFF
USERSPACEEXIT   EQU     $100
        LDX     #USERSPACECHAIN
        JSR     SYSCALL$
        BCC     *       should never get here!!
        STX     USERSPACEERROREXIT+SCBLK:PARAMS
        LDX     #USERSPACEERROREXIT
        JMP     SYSCALL$

USERSPACECHAIN  EQU     *-USERSPACEEXITSTUFF+USERSPACEEXIT
        FCB     SYSCALL:CHAIN,CHAIN:SCLEN,IGNORED,IGNORED
        FDB     DEFAULTPROG,DEFAULTPROGL
        FDB     CHANGED,USERSPACEREPBUF,4

USERSPACEERROREXIT      EQU     *-USERSPACEEXITSTUFF+USERSPACEEXIT
        FCB     SYSCALL:ERROREXIT,ERROREXIT:SCLEN,CHANGED,CHANGED

USERSPACEREPBUF EQU     *-USERSPACEEXITSTUFF+USERSPACEEXIT
        RMB     4

DEFAULTPROG     EQU     *-USERSPACEEXITSTUFF+USERSPACEEXIT
DEFAULTPROG:
        FCC     'DEFAULTPROGRAM'
DEFAULTPROGL    EQU     *-DEFAULTPROG:

USERSPACEEXITSTUFFLEN   EQU     *-USERSPACEEXITSTUFF
        PAGE    SET ERROR & GET ERROR
*       set USERLASTERROR and split!

SETERROR
        LDX     CURRENTUCB
        LDX     SCBLK:PARAMS,X
        STX     USERLASTERROR
        OKRTS   ta daaa!!


*       Get USERLASTERROR and split

GETERROR
        JSR     CHECKRDLEN
        #2
        LDX     CURRENTUCB
        LDX     SCBLK:RDBUF,X
        LDD     USERLASTERROR
        JSR     COPYDTOUSER
        OKRTS
        PAGE    KILLPROOF & KILLENABLE
KILLPROOF
        LDX     CURRENTUCB
        LDA     UCB:LFCHAN,X
        LDX     #SETKILLPROOF
        STAA    SCBLK:PARAMS,X
        JMP     SYSCALL$

KILLENABLE
        LDX     CURRENTUCB
        LDA     UCB:LFCHAN,X
        LDX     #CLEARKILLPROOF
        STAA    SCBLK:PARAMS,X
        JMP     SYSCALL$
        PAGE    ERROR DISPLAY
*       DERR -- DISPLAY "USERLASTERROR" ON THE CONSOLE...
*       AS EITHER AN ERROR STRING FROM THE ERRORMSGS.SYS FILE
*       OR AS "ERROR ddddd" IF WE CAN'T GET TO ERRORMSGS.SYS SOMEHOW
*       IF WE CANNOT PRINT THE ERROR MESSAGE, CROAK AND DIE!
*
DERRCR  ; tack a CR on the end of the error message
        INC     DERRCRFLAG
DERR
        LDX     USERLASTERROR   DO IT NOW, IN CASE OF ERROR WHILE
        STX     ERRORNUMBER     PROCESSING THIS ERROR
        JSR     OPENCONSOLE     MAKE SURE WE CAN OUTPUT THE ERROR MESSAGE
        LDA     UCB:CHAN0,X     IS CONSOLE: REALLY OPEN ?
        JSR     ISCHANNELOPEN
        BCS     DERR.CANT       B/ no, job is in trouble !
        JSR     SETUPBUFFER     set up buffer housekeeping
        LDX     ERRORNUMBER     omit error 0
        BNE     DE.3
        CLR     DERRCRFLAG
        OKRTS

DERR.CANT ; can't display error message
        ldx     currentucb
        lda     #js:dying       so kill the job as desperation measure
        sta     ucb:jobstate,x
        okrts
        PAGE
*
*       POSITION TO THE ERROR MESSAGE POINTER
*       = 3 * ERROR NUMBER
*
DE.3
        LDX     #DISPPOS1
        CLR     1,X     (0,X IS ASSEMBLED AS A ZERO!)
        LDAA    ERRORNUMBER
        LDAB    ERRORNUMBER+1
        ASLB            *2
        ROLA
        ROL     1,X
        ADDB    ERRORNUMBER+1   *3
        ADCA    ERRORNUMBER
        BCC     DERR0
        INC     1,X
DERR0
        STAB    3,X
        STAA    2,X
        LDX     #DISPPOS        NOW POSITION ERRORMSGS.SYS FILE...
        JSR     SYSCALL$        TO THE ERROR MESSAGE STRING POINTER
        BCC     DERR.2
        CPX     #ERR:CLOSED     open the file if it's closed
        BNE     DERR4   otherwise, skip the English message
        LDX     #OPENERRMSGS
        JSR     SYSCALL$
        BCS     DERR4   B/ OOPS, SOME PROBLEM OCCURRED
        BRA     DE.3            go try the position again
        PAGE
DERR.2  
        LDX     #DISPREADB3     READ IN THE STRING ADDRESS
        JSR     SYSCALL$
        BCS     DERR4
        LDX     DISPPOS1+2      IS THE ERROR MSG IN THE FILE?
        BNE     DERR1A  B/ YUP
        LDAA    DISPPOS1+1      ...?
        BEQ     DERR4   B/ NO, PRINT THE ERROR CODE THE HARD WAY
DERR1A  
        LDX     #DISPPOS        POSITION TO THE STRING
        JSR     SYSCALL$
        BCS     DERR4   B/ ERROR
*
*       COPY THE STRING TO CHANNEL 0
*
DERR1
        LDAA    #255    upper limit on length of message
        STAA    TSTEMP
        LDX     #DISPGETCHAR
        JSR     SYSCALL$
        BCS     DERR4
        LDAA    BUFFER
        CMPA    #ASCII:CR
        LBEQ    DE.8.3  B/ I'M DONE!
        DEC     TSTEMP
        LBEQ    DE.8.3
        JSR     STUFFINBUFFER
        BRA     DERR1
        PAGE
*       AN ERROR WAS DETECTED WHILE TRYING TO PRINT AN ERROR STRING
*       IGNORE THE ERROR, AND ATTEMPT TO PRINT "ERROR <ERRORNUMBER>" INSTEAD
*       (IN DECIMAL FORMAT)
*
DERR4
        LDAA    #DISPERRORMSGL  stuff canned message into write buffer
        STAA    TSTEMP
        LDX     #DISPERRORMSG
        JSR     COPYTOBUFFER
        LDAB    #16     (16 BITS TO CONVERT)
        LDX     #DECBUF CONVERT 16 BITS BINARY TO 3 DIGITS BCD
        CLR     0,X
        CLR     1,X
        CLR     2,X
DERR5
        ASL     ERRORNUMBER-DECBUF+1,X
        ROL     ERRORNUMBER-DECBUF,X
        LDAA    2,X
        ADCA    2,X
        DAA
        STAA    2,X
        LDAA    1,X
        ADCA    1,X
        DAA
        STAA    1,X
        LDAA    0,X
        ADCA    0,X
        DAA
        STAA    0,X
        DECB
        BNE     DERR5
        LDAB    #3      (3 BYTES OF BCD)
DERR6
        LDAA    2,X
        ANDA    #$F
        PSHA
        LDAA    2,X
        LSRA
        LSRA
        LSRA
        LSRA
        ANDA    #$F
        PSHA
        DEX
        DECB
        BNE     DERR6
        LDX     #STRINGBUFFER
        LDAA    #'0
        STAA    0,X
        LDAB    #6      (6 BYTES ON THE STACK)
DERR7
        PULA
        DECB
        BEQ     DERR9   B/ NO MORE (THEY WERE ALL ZERO)
        TSTA
        BEQ     DERR7   B/ ZERO SUPPRESS
DERR9   INCB
        BRA     DE.8.1
        PAGE
DERR8   PULA
DE.8.1  ADDA    #'0
        STAA    0,X
        INX
        DECB
        BNE     DERR8
        DEX
        STX     TEMPX   COMPUTE LENGTH OF THE STRING (ALWAYS < 256)
        LDAB    TEMPX+1
        SUBB    #(STRINGBUFFER&$FF)-1
        STAB    TSTEMP
        LDX     #STRINGBUFFER
        JSR     COPYTOBUFFER
DE.8.3  TST     DERRCRFLAG      see if CR wanted on end of error message
        BEQ     DE.8.2
        CLR     DERRCRFLAG
        LDAA    #ASCII:CR
        BSR     STUFFINBUFFER
DE.8.2  JSR     WRITEAFROMSYSTEMSPACE   go for it!!
        BCS     DE.8.2.0        b/ owtch!
        OKRTS

DE.8.2.0
        JSR     GETUSERLFCHANNEL       does user have an LFCHAN ?
        LBEQ    DERR.CANT       b/ no, --> no way to display error from here
        JSR     CLOSECONSOLE    get rid of the console: might be the problem
        JSR     CLOSELOG        same goes for the log
        BCS     DE.8.2.1
DE.8.2.1
        JSR     OPENCONSOLE     get the real thing back!
DE.8.2.3
        JSR     WRITEAFROMSYSTEMSPACE  try again
        BCS     DE.8.2.2        b/ I give up!
        OKRTS

DE.8.2.2
        CPX     #ERR:PROGRAMKILLED      handle obscurata
        BEQ     DE.8.2.3
        JSR     GOCATATONIC
        PAGE
SETUPBUFFER
        LDX     CURRENTUCB
        LDAA    #SYSCALL:WRITEA         construct a WRITA syscall block
        STAA    SCBLK:OPCODE,X
        LDAA    #WRITEA:SCLEN
        STAA    SCBLK:WLEN,X
        JSR     ALLOCATE1PAGE           error message is 255 bytes max!
        LDX     CURRENTUCB
        LDAA    NPAGES
        STAA    UCB:BUFFERSIZE,X
        LDAA    PAGEBASE
        STAA    UCB:BUFFER,X
        STAA    POINTERINBUFFER
        STAA    SCBLK:WRBUF,X
        CLR     POINTERINBUFFER+1
        CLR     SCBLK:WRBUF+1,X
        CLR     SCBLK:WRLEN,X
        CLR     SCBLK:WRLEN+1,X
        LDA     UCB:CHAN0,X
        STA     SCBLK:PARAMS,X
        OKRTS

STUFFINBUFFER
        LDX     POINTERINBUFFER guess what this routine does??
        STAA    0,X
        INC     POINTERINBUFFER+1
        LDX     CURRENTUCB
        INC     SCBLK:WRLEN+1,X byte count will never exceed 255!
        RTS
        PAGE
COPYTOBUFFER
        LDAA    0,X     copy (X) -> string to buffer
        INX
        STX     TEMPX
        BSR     STUFFINBUFFER
        LDX     TEMPX
        DEC     TSTEMP
        BNE     COPYTOBUFFER
        RTS

DISPERRORMSG    FCC     'Error '
DISPERRORMSGL   EQU     *-DISPERRORMSG

ERRMSGFNE       FCC     'ERRORMSGS.SYS'
ERRMSGFNEL      EQU     *-ERRMSGFNE

DISPPOS ; USED TO POSITION ERRORMSGS.SYS FILE
        FCB     SYSCALL:CONTROL,CONTROL:SCLEN+4,ERRMSGCHANNEL,CC:POSITION
        FDB     DISPPOS1,4      wrbuf, wrlen
        PAGE
openconsole

; make sure that channel 0 is open; otherwise, open it to the console

        ldx     currentucb
        lda     ucb:chan0,x
        cmpa    #$ff                   is channel 0 closed?
        bne     openconsole.2          b/ no-- its already open
        lda     ucb:lfchan,x           open channel 0 to the real thing
        sta     ucb:chan0,x
openconsole.2
        rts
        page
closeconsole

; make sure that channel 0 is closed: release whatever was attached to
; channel 0

        ldx     currentucb
        ldb     #$ff
        lda     ucb:chan0,x
        stb     ucb:chan0,x
        jsr     releaserealchannel
        bcs     closeconsole.dontcare
closeconsole.dontcare

; close the lineflags channel and re-open it, since closeconsole may have
; been called to clear an EOF flag

        jsr     getuserlfchannel
        beq     closeconsole.okrts     b/ no lf channel, we're all done
        sta     scblk:params+closelogchan
        sta     scblk:params+openlfchan
        ldd     ucb:consolestr,x
        std     openlfchan+scblk:wrbuf
        ldb     ucb:consolelen,x
        clra
        std     openlfchan+scblk:wrlen
        ldx     #closelogchan
        jsr     syscall$
        bcs     closeconsole.dontcareeither
closeconsole.dontcareeither
        ldx     #openlfchan
        jsr     syscall$
        bcs     closeconsole.drasticmeasures
closeconsole.okrts
        okrts

closeconsole.drasticmeasures
        jsr     gocatatonic
        PAGE
*       CHECKRDLEN -- CHECK SCBLK:RDLEN...
*       TO MAKE SURE ITS VALUE >= 2 BYTES AT RETURN ADDRESS
*       ALSO CHECKS THAT SYSCALL BLOCK IS LONG ENOUGH TO INCLUDE SCBLK:RDLEN
*       (X) = CURRENTUCB ON EXIT
*       SKIPS AROUND 2 BYTE INLINE VALUE IF OK; ELSE ERROREXIT
*
CHECKRDLEN      
        LDX     CURRENTUCB      CHECK THAT READ DATA BUFFER IS INCLUDED...
        LDAA    SCBLK:WLEN,X    IN THE SYSCALL BLOCK
        ANDA    #$7F    BYEBYE WAIT BIT
        CMPA    #SCBLK:RDLEN+2  IS SYSCALL BLOCK LONG ENOUGH ?
        BCS     ERRSYSTOOSHORTJ B/ NOPE, STICK THE USER WITH AN ERROR
        LDD     [0,S]           IS RDLEN >= MINLENGTH ?
;                               I.E., IS 0 > MINLENGTH-RDLEN-1 ?
        SEC                     (-1 PART)
        LDX     CURRENTUCB      SUBTRACT RDLEN
        SBCB    SCBLK:RDLEN+1,X
        SBCA    SCBLK:RDLEN,X
        BCC     ERRRDBUFTOOSMALL        B/ NO, NOT ENOUGH READ BUFFER
        ADCB    SCBLK:RDLEN+1,X SET REPLY LENGTH = DESIRED # BYTES
        ADCA    SCBLK:RDLEN,X   (A,B):=DESIRED # BYTES
        STAA    SCBLK:RPLEN,X   RPLEN:=(A,B)
        STAB    SCBLK:RPLEN+1,X
        LDD     SCBLK:RDBUF,X   remember the user's buffer
        STD     UCB:USERRDBUF,X
        LDD     SCBLK:RDLEN,X   and its length
        STD     UCB:USERRDLEN,X
        CLR     UCB:USERRPLEN,X
        CLR     UCB:USERRPLEN+1,X
CHECKRDLEN1     
        TSX             ALL IS OK, TAKE SKIP EXIT
        LDAA    1,X     BUMP RETURN PAST INLINE ARGUMENT
        ADDA    #2      =2 BYTES IN SIZE
        STAA    1,X
        BCC     CHECKRDLEN2
        INC     0,X
CHECKRDLEN2     
        LDX     CURRENTUCB
        OKRTS

ERRSYSTOOSHORTJ 
        JMP     ERRSYSCALLTOOSHORT

ERRRDBUFTOOSMALL        
        JSR     ERRET
        FDB     ERR:RDBUFTOOSMALL
        PAGE
*       CHECKWRLEN -- CHECK SCBLK:WRLEN...
*       TO MAKE SURE ITS VALUE >= 2 BYTES AT RETURN ADDRESS
*       ERROR EXIT IF NOT
*       RETURNS WITH (X) CONTAINING CURRENTUCB OTHERWISE
*       SKIPS AROUND 2 BYTE INLINE VALUE

CHECKWRLEN      
        LDX     CURRENTUCB      CHECK THAT WRBUF INFO IS INCLUDED...
        LDAA    SCBLK:WLEN,X    IN THE SYSCALL
        ANDA    #$7F    BYEBYE WAIT BIT
        CMPA    #SCBLK:WRLEN+2  SYSCALL BLOCK LONG ENOUGH ?
        BCS     ERRSYSTOOSHORTJ B/ NO, GO STICK IT TO THE USER
        LDD     [0,S]           IS WRLEN >= MINLENGTH ?
;                               I.E., IS 0 > MINLENGTH - WRLEN -1 ?
        SEC                     (-1 PART)
        LDX     CURRENTUCB      NOW SUBTRACT WRLEN
        SBCB    SCBLK:WRLEN+1,X
        SBCA    SCBLK:WRLEN,X
        BCC     ERRWRBUFTOOSMALL        B/ go bitch about it!!
        LDD     SCBLK:WRBUF,X   remember user's buffer
        STD     UCB:USERWRBUF,X
        LDD     SCBLK:WRLEN,X   and its length
        STD     UCB:USERWRLEN,X
        BRA     CHECKRDLEN1     go for common exit
ERRWRBUFTOOSMALL        
        JSR     ERRET
        FDB     ERR:WRBUFTOOSMALL
        PAGE    ATTNCHECK
*       An error return is made only if channel 0 is attached to virtual
*       console device and an attention is outstanding.

ATTNCHECK
        BSR     ISCONSOLE       see if it's even possible to get an attn
        BCS     ATTNCHECK.9     B/ I thought not!
        LDX     #ATTENTIONCK
        JMP     SYSCALL$        go ask if attention outstanding

ATTNCHECK.9
        OKRTS
        PAGE    ISCONSOLE
isconsole

; see if channel 0 is open to the user's console (the real console)

        ldx     currentucb
        lda     ucb:chan0,x
        jsr     ischannelopen
        cmpa    ucb:lfchan,x           is it open to the console
        bne     isconsole.2            b/ no-- something else
        sta     attentionck+scblk:params (for use of attentionck syscall)
        okrts

isconsole.2
        jsr     erret
        #err:notopentoconsole
        page    Interlock
interlock

; implement INTERLOCK syscall for SDOS/MT

        ldx     currentucb
        ldd     scblk:params,x
        cmpb    #ic:create
        lbeq    ilk.create
        cmpb    #ic:destroy
        lbeq    ilk.destroy
        cmpb    #ic:lock
        lbeq    ilk.lock
        cmpb    #ic:release
        lbeq    ilk.release
        cmpb    #ic:test
        lbeq    ilk.lockifavail
        cmpb    #ic:reset
        lbeq    ilk.reset
        jsr     erret
        #err:illegalinterlockfunction
        page
ilk.matchcap

; match the capability in targetcap with the capability named in (x)
; return with cc set to = or <>

        ldab    #16
        stx     tempx
        ldx     #targetcap
ilk.matchcap.1
        ldaa    0,x
        inx
        stx     tempx+2
        ldx     tempx
        cmpa    0,x
        bne     ilk.matchcap.2
        inx
        stx     tempx
        ldx     tempx+2
        decb
        bne     ilk.matchcap.1
ilk.matchcap.2
        rts
        page
ilk.addcap

; find a free slot in the capability table and move the capability in
; targetcap to that capability slot; return the slot in (a)

; err:implementationlimitreached may be returned if no more slots

        jsr     ilk.findcapslot
        jsr     ilk.resolveslot resolve slot in (a) to indices
        ldx     capmapx         allocate the slot
        ldd     #$0100          one reference, no queue
        std     capmap:refcount,x
        ldx     captablex
        ldab    #16
        stx     tempx
        ldx     #targetcap
ilk.addcap.1
        ldaa    0,x
        inx
        stx     tempx+2
        ldx     tempx
        staa    0,x
        inx
        stx     tempx
        ldx     tempx+2
        decb
        bne     ilk.addcap.1
        rts
        page
ilk.resolveslot

; resolve (a)=slot number to correct capmapx, captablex

        sta     capslot         this will be used later, too
        asla
        sta     capmapx+1       map index is 2x slot number
        asla
        asla
        asla
        sta     captablex+1     slot index is 16x slot number
        lda     #captable/512   allow for carry
        rola
        sta     captablex
        rts
        page
ilk.findcapslot

; find a free slot in the capability table
; return (a) -> slot number; return err:implementationlimitreached
; if no more slots 

        ldx     #capmap+31*2
        lda     #31
ilk.findcapslot.2
        tst     0,x
        beq     ilk.findcapslot.1
        dex
        dex
        deca
        bpl     ilk.findcapslot.2
        jsr     erret
        #err:implementationlimitreached

ilk.findcapslot.1
        okrts
        page
ilk.findcap

; find a match to the target capability, returning the matching slot number
; in (a), or err:notlocked when no match is made

        ldaa    #31
ilk.findcap.1
        psha
        jsr     ilk.resolveslot
        ldx     captablex
        jsr     ilk.matchcap
        beq     ilk.findcap.2
        pula
        deca
        bpl     ilk.findcap.1
        jsr     erret
        #err:notlocked

ilk.findcap.2
        pula
        ldx     capmapx                 the capabilities match, but is it
        tst     capmap:refcount,x       locked?
        bne     ilk.findcap.3           B/ apparently so
        deca                            oh well...go look again
        bra     ilk.findcap.1

ilk.findcap.3
        okrts
        page
ilk.block

; block the caller if he is not the first one locking the object

        ldx     capmapx                 count a lock
        inc     capmap:refcount,x
        lda     capmap:refcount,x
        cmpa    #1                      if he is the only reference,
        bne     ilk.block.1             he doesn't get blocked
        okrts

ilk.block.1
        clrb                            he's going on the queue for
        lda     capmap:queue,x          this object--see if there's one
        beq     ilk.block.2             B/ no queue--yet
        std     tempx                   point at ucb
        ldx     tempx
ilk.block.4
        tst     ucb:nextonq,x           see if this one's the last one
        beq     ilk.block.3             B/ sure is
        ldx     ucb:nextonq,x           look at the next ucb
        bra     ilk.block.4

ilk.block.2
        lda     currentucb              this one's now the head of the queue
        sta     capmap:queue,x
        bra     ilk.block.5             go block and return

ilk.block.3
        lda     currentucb              add this one to the end of the queue
        sta     ucb:nextonq,x
ilk.block.5
        jsr     saveplace               go away until unblocked
        okrts                           I must have been unblocked
        page
ilk.ctlc.unblock

; called when ^C^C hits a user; currentucb points at the ucb in question;
; if the user is in any of the interlock queues, he is removed, without
; altering the reference counts (subsequent use of ic:reset required), and
; added to the run queue; otherwise, nothing is done

        ldx     #capmap         look at all of the queues
ilk.cltc.unblock.1
        stx     capmapx
        bsr     ilk.ctlc.checkqueue
        bcc     ilk.ctlc.unblock.done
        ldx     capmapx
        inx
        inx
        cpx     #capmap+32*2    see if done
        bne     ilk.cltc.unblock.1
ilk.ctlc.unblock.done
        rts
        page
ilk.ctlc.checkqueue
        lda     capmap:queue,x
        beq     ilk.ctlc.checkerr
        clrb                            no prior in queue
        clr     tempx+1
ilk.ctlc.checkloop
        sta     tempx                   point at current
        ldx     tempx
        cmpa    currentucb              is he me?
        beq     ilk.ctlc.checkunq       b/ yup
        tab                             current becomes prior
        lda     ucb:nextonq,x           get the new current
        bne     ilk.ctlc.checkloop      b/ new current is valid--check him out
ilk.ctlc.checkerr
        errorrts                        not in this queue

ilk.ctlc.checkunq
        lda     ucb:nextonq,x           de-reference next ucb
        clr     ucb:nextonq,x
        tstb                            was prior the capmap?
        bne     ilk.ctlc.checkunq.1     b/ nope
        ldx     capmapx                 update the capmap entry
        sta     capmap:queue,x
        bra     ilk.ctlc.checkunq.2     found him!!  he's off the queue


ilk.ctlc.checkunq.1
        stb     tempx                   re-point the prior ucb
        ldx     tempx
        sta     ucb:nextonq,x
ilk.ctlc.checkunq.2
        lda     currentucb
        jsr     addrunq
        okrts
        page
ilk.unblock

; reduce the reference count of the named capability by 1; it it was
; zero, to start with, or doesn't exist, err:notlocked is returned;
; if it was one, to start with, then a simple return is made; otherwise,
; the first user enqueued upon the object is dequeued and put in the
; run queue

        stx     tstemp          save the unblock error code
        jsr     ilk.findcap     look up the capability
        ldx     capmapx         reduce the count
        dec     capmap:refcount,x
        bmi     ilk.unblock.1   B/ whoops--was zero
        bne     ilk.unblock.2   B/ must unblock a user
        okrts                   no users blocked

ilk.unblock.1
        inc     capmap:refcount,x       put the count back to zero
        jsr     erret           scream bloody murder
        #err:notlocked

ilk.unblock.2
        clrb                    pull a user off the head of the queue
        lda     capmap:queue,x
        bne     ilk.unblock.3   B/ queue exists
        okrts                   that's strange--no queue--oh, well...

ilk.unblock.3
        std     tempx
        ldx     tempx
        ldb     ucb:nextonq,x   unchain from the head of the queue
        clr     ucb:nextonq,x
        pshd
        ldd     tstemp          tell user what went wrong
        std     ucb:queueerr,x
        puld
        ldx     capmapx
        stb     capmap:queue,x
        clrb                    add user to run queue
        jsr     addrunq         (note: (d) contains UCB address)
        okrts                   all done
        page
ilk.validate

; Check that the capability is correctly formed.

; copy capability from userspace to targetcap

; this is where err:nosuchobject would be generated

        jsr     checkwrlen
        #16
        if      m6809
        ldy     #targetcap
        else
        ldd     #targetcap
        std     tempx
        fin
        ldx     currentucb
        ldx     scblk:wrbuf,x
        ldd     #16
        jsr     copytosystem
        okrts

        page
ilk.genrandom

; roll a 16-byte 'random' number, which will be used as the capability,
; for the time being

; call 'decrypt 8 bytes' twice, using the clock as the mudtext

        ldx     #ilkcap         use a YUKK decryption key
        jsr     setkey
        ldx     #ilkcap         decrypt 8 bytes at a time
        jsr     decrypt
        ldx     #ilkcap+8
        jmp     decrypt
        page
ilk.returncap

; return the capability to the user space

        ldx     currentucb
        if      m6809
        ldy     ucb:userrdbuf,x
        else
        ldd     ucb:userrdbuf,x
        std     tempx
        fin
        ldd     #16
        ldx     #ilkcap
        jsr     copytouser
        okrts
        page
ilk.create

; Create a capability to the object.  For the time being, a 16-byte random
; number is returned.

; If the object is invalid, err:nosuchobject will be returned.
; [full implementation, only]

        jsr     checkwrlen
        #16
        jsr     checkrdlen
        #16
        jsr     ilk.genrandom
        jsr     ilk.returncap
        okrts
        page
ilk.destroy

; Destroy the usefulness of capabilities to the object. Release all
; interlocks on the object; users enqueued for use of the object will be
; unblocked with err:objectdestroyed.

; If the capability is invalid, err:nosuchobject will be returned.
; [full implementation, only]

        jsr     ilk.validate
ilk.destroy.1
        ldx     #err:objectdestroyed
        jsr     ilk.unblock
        bcc     ilk.destroy.1
        cpx     #err:notlocked
        lbne    errorinx
        okrts
        page
ilk.lock

; Lock the object for the exclusive use of the caller.  If the object is
; not immediately available for the exclusive use of the caller, the caller
; is blocked until the object is available for his exclusive use.  
; err:implementationlimitreached will be returned if more than 32 objects
; are referenced.

; If the capability is invalid, err:nosuchobject will be returned.
; [full implementation, only]

        jsr     ilk.validate
        jsr     ilk.findcap
        bcs     ilk.lock.1
        jsr     ilk.block
        okrts

ilk.lock.1
        cpx     #err:notlocked
        lbne    errorinx
        jsr     ilk.addcap
        okrts
        page
ilk.release

; Release the object from the caller's exclusive use.  If the object has
; not been previously locked, err:notlocked is returned.

; If the capability is invalid, err:nosuchobject will be returned.
; [full implementation, only]

        jsr     ilk.validate
        ldx     #0
        jsr     ilk.unblock
        okrts
        page
ilk.lockifavail

; Lock the object for the exclusive use of the caller.  If the object is
; not immediately available for the exclusive use of the caller, no further
; action is taken and err:alreadylocked is returned.

; If the capability is invalid, err:nosuchobject will be returned.
; [full implementation, only]

        jsr     ilk.validate
        jsr     ilk.findcap
        bcs     ilk.lock.1
        jsr     erret
        #err:alreadylocked
        page
ilk.reset

; Unconditionally release all interlocks on the object; users enqueued for
; use of the object will be unblocked with err:lockreset.  If the object
; is not locked at all, err:notlocked will be returned.


; If the capability is invalid, err:nosuchobject will be returned.
; [full implementation, only]

        jsr     ilk.validate
        ldx     #err:lockreset
        jsr     ilk.unblock
ilk.reset.1
        ldx     #err:lockreset
        jsr     ilk.unblock
        bcc     ilk.reset.1
        cpx     #err:notlocked
        lbne    errorinx
        okrts
        PAGE    DELAY
DELAY
        LDX     CURRENTUCB
        LDD     SCBLK:PARAMS,X
        BEQD    DELAY.1
        STD     UCB:DELAY,X            set desired delay
        LDD     CURRENTUCB             put this one on ice
        JSR     ADDDELAYQ
        JSR     SAVEPLACE
DELAY.1
        OKRTS
         page  Get Serial Number for User
USERGETSERIALNUMBER ; Execute SYSCALL:GETSERIALNUMBER on behalf of user
         jsr   checkrdlen              ensure reply buffer is proper size
         fdb   8
; note: the following code should be part of a general
; routine that handles syscalls whose write and reply buffers are at most
; one page in size. Save for a rainy day.
; ?? shouldn't CONTROL and STATUS routines handle
; read and write buffer possibilities ??
         jsr   allocate1page           set up to execute the system call
         stb   scblk:rdbuf,x           remember where to place reply
         clr   scblk:rdbuf+1,x
         sta   scblk:rdlen,x
         clr   scblk:rdlen+1,x
         jsr   syscall$
         jmp   rdbuftouser             return results to user program
         page  SYSCALL:JOBCONTROL handling
*        SYSCALL:JOBCONTROL handler
*
*        Handles Job Control Syscalls, including subcodes:
*
*              JC:CREATE     Create a new job
*                                      WRBUF contains DO file name
*                                      SCBLK:EXTENSION contains LOG file
*                                      RDBUF returns job capability
*
*              JC:TESTDONE   Test for job completion
*                                      WRBUF contains job capability
*                                      Signals ERR:NOSUCHJOB if complete
*
*              JC:DESTROY    Abort a job
*                                      WRBUF contains job capability
*
jobcontrol ; come here to handle SYSCALL:JOBCONTROL
         ldx   currentucb
         lda   scblk:params,x
         bne   errillegaljobcontrol    b/ params must be zero
         ldb   scblk:params+1,x
         cmpb  #jc:create
         lbeq  jc.create
         cmpb  #jc:testdone
         lbeq  jc.testdone
         cmpb  #jc:destroy
         lbeq  jc.destroy
errillegaljobcontrol
         jsr   erret
         #err:illegaljobcontrol
         page
jc.create ; come here to handle SYSCALL:JOBCONTROL with JC:CREATE
         jsr   checkrdlen              ensure that space for reply is present
         #16                           (also ensures that WRBUF is present)
jc.findfreejob ; loop to find a free job
         ldx   ucbchain                where to start
         stx   ucbpointer
jc.findfreejobloop
         ldx   ucbpointer              check job state
         lda   ucb:jobstate,x
         cmpa  #js:free                is job available for snatching ?
         beq   jc.foundfreejob         b/ yes, snatch it!
         lda   ucb:lfnext,x            find next ucb
         sta   ucbpointer
         bne   jc.findfreejobloop      b/ more jobs to inspect
         jsr   erret
         #err:nomorejobs

jc.foundfreejob ; job selected by ucbpointer is available for use
         ldd   currentucb              make new job be the current job awhile
         stx   currentucb
         std   ucbpointer              remember name of ucb initiating this
         addd  #scblk:data             form address of LOG file name
         std   scblk:wrbuf,x
         ldx   ucbpointer              get length of LOG file name
         ldb   scblk:wlen,x
         andb  #$7f                    mask off wait bit
         subb  #scblk:data             and remove scblk overhead
         clra                          form 16 bit length
         ldx   currentucb
         std   scblk:wrlen,x
         ldd   #namescannedcnt         set up reply buffer to make SDOS happy
         std   scblk:rdbuf,x
         ldd   #2
         std   scblk:rdlen,x
         jsr   wasconsolerequested     asking for CONSOLE: ?
         bcc   jc.createerrchanopen    b/ unreasonable thing to ask, here...
         jsr   docreatelog.1           set up the log file
         bcs   jc.createjoberr         b/ can't, abort this call!
         ldx   ucbpointer              set up SYSCALL:OPEN...
         ldd   scblk:wrlen,x
         ldx   scblk:wrbuf,x
         stx   tempx
         ldx   currentucb
         std   scblk:wrlen,x
         ldd   tempx
         std   scblk:wrbuf,x
         ldd   #syscall:open+open:sclen
         std   scblk:opcode,x
         clr   scblk:params,x          to open channel zero
         jsr   fnamesetup.1            go get the file name
         bcs   jc.createjoberr         b/ can't, abort this call!
         jsr   wasconsolerequested     can't DO user's console...
         bcc   jc.createerrchanopen    b/ DO CONSOLE: for another job !!???
         jsr   doopen.jc               open file to channel zero
         bcs   jc.createjoberr         b/ can't, abort this call!
         ldx   currentucb              successfully opened necessary channels
         lda   #js:busy                mark this job as busy
         sta   ucb:jobstate,x
         jsr   jc.setnewjobcapability  invent "new" capability for created job
         ldd   currentucb              put job into runnable state
         jsr   addrunq                 he will eventually wake up...
         ldd   ucbpointer              ucb of creating job
         std   currentucb              put world back like it belongs
         jsr   ilk.returncap           and give it back to the user
         okrts

jc.createerrchanopen ; CONSOLE: is already open, can't re-use
         ldx   ucbpointer              switch back to original user
         stx   currentucb
         jmp   errchanisopen

jc.createjoberr ; can't open "do" or "log" file for some reason
         pshx
         jsr   closelog                make sure log is closed
         bcs   *+2                     ignore any error
         pulx
         ldd   ucbpointer              ucb of creator...
         std   currentucb              restore to original state
         jmp   errorinx                and go yell about the problem

jc.setnewjobcapability ; chooses new capability key for job
         jsr   ilk.genrandom           invent a "new" capability
         if    m6800!m6801
         ldd   currentucb              form pointer to job capability name
         addd  #ucb:jobcapability
         std   tempx
         else  (m6809)
         ldx   currentucb
         leay  ucb:jobcapability,x
         fin
         ldd   #16
         ldx   #ilkcap
         jmp   blockmove               save capability in ucb
         page
jc.testdone ; come here to handle SYSCALL:JOBCONTROL with JC:TESTDONE
*        jsr   jc.findjob              find job specified by WRBUF capability
*        okrts                         if we found it, that's enough...

jc.findjob ; subroutine to find job specified by WRBUF capability
         jsr   ilk.validate            fetch the capability for job
         ldx   ucbchain                where to start
         stx   ucbpointer
jc.findjobloop
         ldx   ucbpointer              check job state
         lda   ucb:jobstate,x
         cmpa  #js:busy                does job "exist" ?
         bne   jc.findjobnext          b/ no, ignore this job
         if    m6800!m6801
         ldd   ucbpointer              form pointer to job capability name
         addd  #ucb:jobcapability
         tdx
         else  (m6809)
         ldx   ucbpointer
         leax  ucb:jobcapability,x
         fin
         jsr   ilk.matchcap            compare given capability to actual
         beq   jc.foundjob             b/ found matching job
jc.findjobnext
         ldx   ucbpointer              find next ucb
         lda   ucb:lfnext,x
         sta   ucbpointer
         bne   jc.findjobloop          b/ more jobs to inspect
         jsr   erret
         #err:nosuchobject

jc.foundjob
         okrts                         if we found it, that's enough...
         page
jc.destroy ; come here to handle SYSCALL:JOBCONTROL with JC:DESTROY
         jsr   jc.findjob              find job specified by WRBUF capability
         ldx   ucbpointer              make us into the other job, temporarily
         ldd   currentucb
         stx   currentucb
         std   ucbpointer
         jsr   getuserlfchannel        any terminal attached?
         bne   jc.destroycant          b/ yes, user hasn't power to destroy it
         lda   #js:dying               mark job as "needs destruction"
         sta   ucb:jobstate,x          yes, mark job as "needs destruction"
;                                      (makes scheduler destroy it...
;                                       next time job tries to wake up)
         jsr   ilk.ctlc.unblock        rip job out of interlock queues
         jsr   delay.ctlc.unblock      rip job out of delay queues
         ldx   ucbpointer              make us back into the job we were
         stx   currentucb
         okrts

jc.destroycant
         ldx   ucbpointer              make us back into the job we were
         stx   currentucb
errcapabilityfailure
         jsr   erret
         #err:capabilityfailure        capability bits for operation not set
         page
jobcontrol.fatalerror ; job can't proceed due to fatal error in DERR
         jsr   releaseallpages         give everything back to /MT
         bra   jobcontrol.finalservices

jobcontrol.jobdone ; job has reached EOF on channel 0
         ldx   #err:jobcompleted       get appropriate final status
         bra   jobcontrol.killjobforX

jobcontrol.mercykilling ; come here to do mercy killing of errant job
         ldx   #err:jobkilled          do final output to log file
jobcontrol.killjobforX ; (X) contains reason why job died
         stx   userlasterror           save cause of death
         jsr   releaseallpages         let go of allocated pages
         lda   #js:busy                prevent redundant mercy killing
         sta   ucb:jobstate,x
         jsr   jc.setnewjobcapability  prevent 2nd "jc.destroy" to this job
         jsr   derrcr                  write autopsy results to log
jobcontrol.finalservices
         jsr   exits                   close all the I/O channels
         jsr   closeconsole            get rid of any do file
*        jsr   openconsole             can't do this on a destroyable job
         jsr   closelog
         ldx   currentucb              now job is finally free
         lda   #js:free
         sta   ucb:jobstate,x
         jsr   releaseallpages         make clean slate
         jsr   saveplace               leave job in never-never (inspect) queue
         jmp   exit                    we awaken! must be new job to do
         PAGE
PATCH    RPT   50                      assume only a little patch space needed
         swi

firebomb.mtinit
        ldx     #initializetimeshare
firebomb.loop
        clr     ,x+
        cpx     #endofinitializetimeshare+1
        bne     firebomb.loop
        jmp     pollforuser

MTCHKSUMSIZE    EQU     *-MTCHKSUMBASE

ENDOFTIMESHARE ; end of SD/MT procedure section
        PAGE    UCBs
        org     (*//256)*256
firstucb

ucb     set     *
        rpt     ucb:size
        fcb     0

        org     ucb+ucb:consolestr     name of console
        fdb     *+2
consbeg set     *
        fcc     /console:/
consend set     *
        org     ucb+ucb:consolelen     length of console name
        fcb     consend-consbeg

        org     ucb+ucb:size
        page
ucb     set     *
        rpt     ucb:size
        fcb     0

        org     ucb+ucb:consolestr     name of console
        fdb     *+2
consbeg set     *
        fcc     /port1:/
consend set     *
        org     ucb+ucb:consolelen     length of console name
        fcb     consend-consbeg

        org     ucb+ucb:size
        page
ucb     set     *
        rpt     ucb:size
        fcb     0

        org     ucb+ucb:consolestr     name of console
        fdb     *+2
consbeg set     *
        fcc     /port2:/
consend set     *
        org     ucb+ucb:consolelen     length of console name
        fcb     consend-consbeg

        org     ucb+ucb:size
        page
ucb     set     *
        rpt     ucb:size
        fcb     0

        org     ucb+ucb:consolestr     name of console
        fdb     *+2
consbeg set     *
        fcc     /port3:/
consend set     *
        org     ucb+ucb:consolelen     length of console name
        fcb     consend-consbeg

        org     ucb+ucb:size
        page
ucb     set     *
        rpt     ucb:size
        fcb     0

        org     ucb+ucb:consolestr     name of console
        fdb     *+2
consbeg set     *
        fcc     /port4:/
consend set     *
        org     ucb+ucb:consolelen     length of console name
        fcb     consend-consbeg

        org     ucb+ucb:size
        page
ucb     set     *
        rpt     ucb:size
        fcb     0

        org     ucb+ucb:consolestr     name of console
        fdb     *+2
consbeg set     *
        fcc     /port5:/
consend set     *
        org     ucb+ucb:consolelen     length of console name
        fcb     consend-consbeg

        org     ucb+ucb:size
        page
ucb     set     *
        rpt     ucb:size
        fcb     0

        org     ucb+ucb:consolestr     name of console
        fdb     *+2
consbeg set     *
        fcc     /port6:/
consend set     *
        org     ucb+ucb:consolelen     length of console name
        fcb     consend-consbeg

        org     ucb+ucb:size
        PAGE    SDOS/MT Initialization Code
*       * Alert virtual terminal driver
*
*       * Set up UCBs
*
*       ---find and set TOPMEM for each user (1 per address space)
*
*       ---set up a console for each user
*
*       ---set each user's stack to look as if an exit syscall had been issued
*
*       ---fill sundry other UCB: slots with appropriate values

INITIALIZETIMESHARE
        SWI                     for debugging purposes
        BSR     DOSTUFF
        BCS     INITERR         B/ couldn't get going for some reason
        LDX     #SYSKILLENABLE  let the sun shine in!
        JSR     SYSCALL$
        BCS     INITERR         B/ oh well...something's not right

        LDX     #HELLODERE      announce myself (save this for very last)
        JSR     SYSCALL$
        LBCC    FIREBOMB.MTINIT GO for it!!!
*** shouln't this FIREBOMB first, and then announce ?

INITERR
        STX     INIT.ERROREXIT+SCBLK:PARAMS
        LDX     #SYSKILLENABLE
        JSR     SYSCALL$
        BCS     *+2             ignore any error, I give up anyway!
        LDX     #INIT.ERROREXIT
        JMP     SYSCALL$

NOTENOUGHROOM
        JSR     ERRET
        #ERR:MTNOROOM           not enough address space to run SDOS/MT
        PAGE
DOSTUFF
        LDX     #SYSKILLPROOF   make me bulletproof!
        JSR     SYSCALL$
        LDX     #SETTIMESHARE   MT's running now!
        JSR     SYSCALL$
        CLRA                    no initial quantum
        LDX     #TIMESLICEABORTED where to go on 1st RETURNTOUSER calls
        JSR     SETQUANTUM

; should validate use of correct SELECTBANK at this point
; (and GOCATATONIC if wrong)
;

; read the clock and use it as a seed for generating random interlock
; capabilities

        LDX     #OPENCLOCK
        JSR     SYSCALL$
        LDX     #READCLOCK
        JSR     SYSCALL$
        LDX     #CLOSECLOCK
        JSR     SYSCALL$

; close channel 0 and close the log (in case SDOS/MT was started with
; a DO file); channel 0 will be allocated to the first user as his invisible
; console channel, which will be used to watch out for ^C^C status

        ldx     #closezero
        jsr     syscall$
        ldx     #closelog$
        jsr     syscall$
        bcs     dostuff.2
dostuff.2

; see if the LOGIN program exists, and note the fact (of absence or presence)

        LDX     #FINDLOGIN
        JSR     SYSCALL$
        BCS     DOSTUFF.1
        INC     LOGINEXISTS     note that LOGIN exists
        LDX     #CLOSELOGIN
        JSR     SYSCALL$
        PAGE
DOSTUFF.1

*       set up memory map

        LDAA    $FC             find my top of memory
        SUBA    #ENDOFTIMESHARE//256
        CMPA    #7*UCB:SIZE/256 need space for 7 UCB'S + 7 STACKS + 7 PAGES to run SDOS/MT
        LBLO    NOTENOUGHROOM   b/ too bad--not enough room to sneeze in
        STAA    MAPSIZE
        LDX     PAGEMAPBASE     now, mark all available pages
INIT.1  ;                         as available
        CLR     ,X+
        DECA
        BNE     INIT.1

*       set up the UCB's

        CLR     NUMUSERS        remember number of users we have
        CLR     UCBCHAIN        reset chain of UCBs
        CLR     UCBCHAIN+1
INIT.2  BSR     SETUPUCB        set up as many user's as possible
        BCS     INIT.2.1        b/ can't set up more ucbs
        LDD     CURRENTUCB
        ADDD    #UCB:SIZE
        STD     CURRENTUCB
        BRA     INIT.2

INIT.2.1
        CPX     #0              normal completion ?
        LBNE    ERRORINX        b/ no, croak and die...
        TST     NUMUSERS        how many users did we set up ?
        BEQ     INIT.NOUSERS    b/ none, go roll over and die...
        LDA     FIRSTUCB+UCB:JOBSTATE verify 1st job can talk to world
        CMPA    #JS:BUSY
        BNE     INIT.FIRSTJOBMUSTHAVECONSOLE
        LDA     MAPSIZE
        STA     NUMPAGES
        CMPA    NUMUSERS        enough pages to run /MT ?
        BLS     INIT.NOTENOUGHPAGES
        LDA     UCBCHAIN        visit all users, and allocate UCB:PERMANENTPAGE
INIT.3 ; allocate UCB:PERMANENTPAGE to this user
        STA     CURRENTUCB
        LDX     CURRENTUCB
        LDA     UCB:USERNUMBER,X
        STA     CURRENTUSER
        JSR     ALLOCATE1PAGE.HUNT     go hunt for a page
        CLR     UCB:ALLOCATEDPAGECNT,X forget page as variable-size-segment
        STB     UCB:PERMANENTPAGE,X    remember it as this, instead
        INC     PAGEMAPBASE+1          prevent from ever searching this page again
        DEC     MAPSIZE
        LDA     UCB:LFNEXT,X           find next user
        BNE     INIT.3
        TST     NUMPAGES               any pages left at all ?
        BEQ     INIT.NOTENOUGHPAGES    b/ no, give up...
        OKRTS                          SDOS/MT initialization successful!!!

INIT.NOUSERS
INIT.FIRSTJOBMUSTHAVECONSOLE
INIT.NOTENOUGHPAGES
        JSR     ERRET
        #ERR:MTBADCONFIG
        PAGE
; Set up a UCB for CURRENTUCB.  If the userspace doesn't have enough
; space to run defaultprogram, then truncate the chain of users and exit.
; If there isn't a console for this user, then mark this user as a free job,
; and don't put it in any queue; otherwise mark as a busy job, set him
; up to do an EXIT, and stuff him in the run queue.
; Otherwise, put the finishing touches on the ucb, and exit.

DEFAULTPROGRAMSIZE      EQU     20000   rough guess at size needed for this one

TRUNCATECHAIN
        DEC     NUMUSERS
        LDX     #0                     signal "normal completion"
        ERRORRTS

SETUPUCB
        INC     NUMUSERS
        LDA     NUMUSERS
        JSR     USERSELECT      select this user so I determine how large...
        BCS     TRUNCATECHAIN     (user # too high for this configuration)
        JSR     USERCURRENTSIZE     his address space is
        CMPD    #DEFAULTPROGRAMSIZE
        BLO     TRUNCATECHAIN   b/ this space isn't large enough...
        SUBD    #3                    (allow for JMP USERSPACESYSCALL)

        LDX     PAGEMAPBASE     this user is real, allocate UCB space forever!
        DEC     0,X             mark pages as busy
        DEC     1,X

        rpt     UCB:SIZE//256
        INC     PAGEMAPBASE+1

        rpt     UCB:SIZE//256
        DEC     MAPSIZE

        LDX     CURRENTUCB
        STD     UCB:TOPMEM,X
        STD     TOPMEM                 used by INITUSERSTACK

        LDA     NUMUSERS               remember user number
        STA     UCB:USERNUMBER,X

        LDB     UCBCHAIN               point current to prior
        STB     UCB:LFNEXT,X
        LDA     CURRENTUCB
        STA     UCBCHAIN

; make the UCB "habitable"

        LDAA    CPUQUANTUMTICKS
        STAA    UCB:REMAININGQUANTUM,X
        STAA    UCB:USERCPUBOUND,X
        page
        jsr     ilk.genrandom          generate capability for this job
        if      m6800!m6801
        ldd     currentucb             form pointer to ucb:capability
        addd    #ucb:jobcapability
        std     tempx
        else    (m6809)
        ldx     currentucb
        leay    ucb:jobcapability,x
        fin
        ldd     #16                    number of bytes to move
        ldx     #ilkcap                source of capability
        jsr     blockmove              save capability in ucb

        ldx     currentucb             reset this job's I/O channels
        lda     currentucb             form pointer to channel map table
        ldb     #ucb:channelmapt
        std     ucb:channelmap,x       and save in ucb
        lda     #$ff                   "Channel is closed"
        sta     ucb:logchannel,x       mark log channel as closed
        ldx     ucb:channelmap,x
        ldb     #32                    number of user virtual channels
        stb     ,x+                    store number of channels
        decb                           account for 1st map table slot
setupucb.ctl
        sta     ,x+
        decb
        bne     setupucb.ctl

        page
; get a console for the user

        LDX     CURRENTUCB
        LDD     UCB:CONSOLESTR,X       get name
        STD     CONSOLEOPEN+SCBLK:WRBUF
        CLRA
        LDB     UCB:CONSOLELEN,X       get length
        STD     CONSOLEOPEN+SCBLK:WRLEN
        JSR     ALLOCATEREALCHANNEL
        STA     CONSOLEOPEN+SCBLK:PARAMS
        LDX     #CONSOLEOPEN
        JSR     SYSCALL$               open it
        BCS     SETUPUCB.NOCONSOLE     b/ can't open console: for this guy
        LDX     CURRENTUCB
        LDA     #JS:BUSY               mark job as not available
        STA     UCB:JOBSTATE,X
        LDA     CONSOLEOPEN+SCBLK:PARAMS can open, set up LF channel info
        STA     UCB:LFCHAN,X           get the channel
        STA     UCB:CHAN0,X            give user an open console
        STA     INDEXFORSTA
        LDA     #VT:CONSOLE            set the device type
        LDX     #DEVICEMAP
        JSR     STAINDEX
        LDD     CURRENTUCB
        JSR     ADDRUNQ
        BRA     SETUPUCB.STACK
        PAGE
SETUPUCB.NOCONSOLE ; this job has no console
        CPX     #ERR:NOSUCHDEVICE      is this a good reason ?
        LBNE    ERRORINX               b/ no... RIBBIT! die...
        LDX     CURRENTUCB
        LDA     #JS:FREE               mark job as available
        STA     UCB:JOBSTATE,X
        LDA     #$FF                   get "not open" code
        STA     UCB:LFCHAN,X           remember, this job has no LF channel
        STA     UCB:CHAN0,X            and currently has no channel 0
        LDA     CONSOLEOPEN+SCBLK:PARAMS
        JSR     RELEASEREALCHANNEL     give channel back to free pile
        BCS     *+2                    ignore "channel is closed" error
;                                      very carefully, leave job out of queues
        page
SETUPUCB.STACK ; set up system space stack pointer for this user
        LDD     CURRENTUCB             set up system space stack pointer
        ADDD    #UCB:STACK
        STD     TEMPX

; prime the user's stack with simulated EXIT syscall, matching return
; address, and a firebreak address, in case something goes haywire

        STS     SETUPUCB.SPSAVE
        LDX     TEMPX
        TXS
        LDD     #FIREBREAK      set up firebreak
        PSHD
        LDD     #EXIT           assume this as first user activity
        LDX     CURRENTUCB
        TST     UCB:JOBSTATE,X           is this a free job ?
        BEQ     SETFIRSTUSERACTIVITY     b/ yes, doesn't need to LOGIN
        TST     LOGINEXISTS
        BEQ     SETFIRSTUSERACTIVITY
; LOGOFF exists.  Set it up to recieve control as 1st program to run.
        JSR     KILLPROOF       logoff gets killproofed at system boot
        BCS     *+2             B/ I don't care!
        IF      M6809
        LDY     #USERSPACELOGIN
        ELSE
        LDX     #USERSPACELOGIN
        STX     TEMPX
        FIN
        LDX     #USERSPACELOGINSTUFF
        LDD     #USERSPACELOGINSTUFFLEN
        JSR     COPYTOUSER
        JSR     INITUSERSTACK
        LDD     #SYSCALLEXIT.1   set to pass control back to user
SETFIRSTUSERACTIVITY
        PSHD
        LDX     CURRENTUCB
        STS     UCB:STACKP,X
        LDS     SETUPUCB.SPSAVE
        JSR     SETUPFRANKBAKER give user a way out
        OKRTS
        page
SETUPUCB.SPSAVE FDB     0        ; SETUPUCB saves its Stack pointer here

USERSPACELOGINSTUFF
USERSPACELOGIN  EQU     $100
        LDX     #USERSPACELOGINCHAIN
        JSR     SYSCALL$
        BCC     *       should never get here!!
        STX     USERSPACELOGINERROREXIT+SCBLK:PARAMS
        LDX     #USERSPACELOGINERROREXIT
        JMP     SYSCALL$

USERSPACELOGINCHAIN     EQU     *-USERSPACELOGINSTUFF+USERSPACELOGIN
        FCB     SYSCALL:CHAIN,CHAIN:SCLEN,IGNORED,IGNORED
        FDB     LOGIN,LOGINL
        FDB     CHANGED,USERSPACELOGINREPBUF,4

USERSPACELOGINERROREXIT EQU     *-USERSPACELOGINSTUFF+USERSPACELOGIN
        FCB     SYSCALL:ERROREXIT,ERROREXIT:SCLEN,CHANGED,CHANGED

USERSPACELOGINREPBUF    EQU     *-USERSPACELOGINSTUFF+USERSPACELOGIN
        RMB     4

LOGIN   EQU     *-USERSPACELOGINSTUFF+USERSPACELOGIN
LOGIN:
        FCC     'LOGOFF'
LOGINL  EQU     *-LOGIN:

USERSPACELOGINSTUFFLEN  EQU     *-USERSPACELOGINSTUFF
        page
HELLODERE       ; used for announcing presence
        FCB     SYSCALL:WRITEA,WRITEA:SCLEN,0,IGNORED
        FDB     MTMSG,COPYRIGHTEND-MTMSG

SYSKILLENABLE   ; enable ^C^C, etc.
        FCB     SYSCALL:KILLENABLE,KILLENABLE:SCLEN

SYSKILLPROOF    ; disable ^C^C, etc.
        FCB     SYSCALL:KILLPROOF,KILLPROOF:SCLEN

SETTIMESHARE    ; say that timeshare is now running
        FCB     SYSCALL:CONTROL,CONTROL:SCLEN+10,0,CC:SETTIMESHARE
        FDB     0,0
        FDB     0,USERSPACESYSCALL,SIZETSPRIMS

INIT.ERROREXIT          ; exit with complaint
        FCB     SYSCALL:ERROREXIT,ERROREXIT:SCLEN,CHANGED,CHANGED
        PAGE
FINDLOGIN
        FCB     SYSCALL:OPEN,OPEN:SCLEN,LOADCHANNEL,IGNORED
        FDB     LOGIN:,LOGINL
        FDB     CHANGED,NAMESCANNEDCNT,2

CLOSELOGIN
        FCB     SYSCALL:CLOSE,CLOSE:SCLEN,LOADCHANNEL,IGNORED

OPENCLOCK       ; these three syscall blocks are used for initializing the interlock seed
        FCB     SYSCALL:OPEN,OPEN:SCLEN,CLOCKCHANNEL,IGNORED
        FDB     CLOCKNAME,LENCLOCKNAME
        FDB     CHANGED,NAMESCANNEDCNT,2

READCLOCK
        FCB     SYSCALL:READB,READB:SCLEN,CLOCKCHANNEL,IGNORED
        FDB     IGNORED,IGNORED
        FDB     CHANGED,ILKCAP,6

CLOSECLOCK
        FCB     SYSCALL:CLOSE,CLOSE:SCLEN,CLOCKCHANNEL

CLOCKNAME
        FCC     "CLOCK:"
LENCLOCKNAME    EQU     *-CLOCKNAME

CLOSEZERO
        FCB     SYSCALL:CLOSE,CLOSE:SCLEN,0,IGNORED

CLOSELOG$
        FCB     SYSCALL:CLOSELOG,CLOSELOG:SCLEN,IGNORED,IGNORED
        PAGE
CONSOLEOPEN
        FCB     SYSCALL:OPEN,OPEN:SCLEN,CHANGED,IGNORED
        FDB     CHANGED,CHANGED
        FDB     CHANGED,NAMESCANNEDCNT,2
        page
calcchksum

; calculate the checksum and then do a SWI; this routine is presumably called
; only by the debugger, and leaves the correct value for MTCHKSUM in that
; location

        jsr     exit.checksum
        bcc     calcchksum.swi  B/ Eureka!!
        inc     mtchksum        one of these values should do it
        bra     calcchksum

calcchksum.swi
        swi

endofinitializetimeshare

        END     INITIALIZETIMESHARE
