        TITLE   SDOS/MT Copyright (C) 1980 Software Dynamics
        PAGE    Things To Do
        with    wi=105,de=51
outaspace       equ     1       fudge the DEFs file to yield more symbol table space
mtsubversion    equ     'c      (other versions are lurking in the field)

; 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 ?]

; add to primitives vector the address of where GOCATATONIC should stuff
;    it's information [4/5/82]

; to assemble, refer to SDxxMT12.DO, on the Components pack
        PAGE    Templates & Equates
        INCLUDE MTSDOS11DEFS.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

                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
CLOCKCHANNEL    RMB     1       channel to use for reading the clock
AVAILABLECHANNELS EQU   *       channels available for general usage
                page
                ORG     $0

UCB:SCB         RMB     128     user's syscall block
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: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
UCB:LFNEXT      RMB     1       next user in system
UCB:WAKEUP      RMB     3       wakeup time 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:CHANNELMAPT RMB     32      room for 31 virtual channels
UCB:QUEUEERR    RMB     2       holding tank for errors while queued
UCB:VTFLAG      RMB     1       <>0 if current channel is vt device
UCB:STARTIO     RMB     1       <>0 => do WANW syscall in examineoutputq
UCB:LINEFLAGS   RMB     1       lineflags hint for user
UCB:CONSOLELEN  RMB     1       length of console name, which follows
UCB:CONSOLESTR  RMB     0       variable length string
                ORG     UCB:SCB+512
UCB:STACK       RMB     0       base of system stack for this user
UCB:SIZE        EQU     *-UCB:SCB
        PAGE
                ORG     1200

ERR:BADREADBUF                  RMB     1       syscall block not within userspace
ERR:BADWRITEBUF                 RMB     1       syscall block not within userspace
ERR:RDBUFTOOBIG                 RMB     1       read buffer > 255 bytes
ERR:WRBUFTOOBIG                 RMB     1       write buffer > 255 bytes
ERR:NOTENOUGHCHANNELS           RMB     1       available channels exhausted--try again
ERR:NOTUNDERTIMESHARE           RMB     1       function not available under timeshare
ERR:MTNOROOM                    RMB     1       not enough room to run SDOS/MT
ERR:MTBADCONFIG                 RMB     1       incorrect configuration for SDOS/MT
err:alreadylocked               rmb     1
err:nosuchobject                rmb     1
err:notlocked                   rmb     1
err:objectdestroyed             rmb     1
err:lockreset                   rmb     1
err:implementationlimitreached  rmb     1
err:illegalinterlockfunction    rmb     1
err:memorymgmtfail              rmb     1

CC:WRITEANOWAIT EQU     $30     write ascii to VT device with no wait
CC:SETTIMESHARE EQU     $31     say that MT is running and get prims

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
CONTEXTBLOCK    RMB     16      holds user context while unwinding stack
NEXTQUANTUM     FCB     5       quantum to use for next time slice
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
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
targetcap       rmb     16      capability which is target of search
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     1       0 -> LOGIN program exists
                page

DECRYPTBUFPTR FDB DECRYPTBUFFER POINTER TO SCAN DECRYPTBUFFER

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

NKEYS   FCB     CHANGED TYPE 5 RECORD: KEY COUNT

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

OLDKEYENCRYPTED ; ENCRYPTED VERSION OF LAST DECRYPTION KEY USED
        FCB     0,0,0,0,0,0,0,0 SPACE TO HOLD KEY (8 BYTES)

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
currenttime     fdb     $ffff,$ffff,$ffff current clock reading
lastday         rmb     1                 day from previous clock reading

readtime ; read the clock for the current time
        fcb     syscall:readb,readb:sclen,clockchannel,ignored
        fdb     ignored,ignored
        fdb     changed,currenttime,6
console fcc     'CONSOLE:'
lconsole equ    *-console
                PAGE
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
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
*       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    RMB     3       copy from selected user space to system space
COPYTOUSER      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)
                RMB     3*3     3 unneeded primitive routines
SIZETSPRIMS     EQU     *-USERSPACESYSCALL
                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
        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
*
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
        page
; the following are used for indexing into tables; the carry bit is set for
; "free"; (x) -> table; indexfor<xxx> must be valid

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

staindex
        if      m6809
indexforsta equ *+3
        sta     >0,x
        else
indexforsta equ *+1
        sta     0,x
        fin
        okrts
        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
        jsr     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
        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
        jsr     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    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        OPEN FILE
        CREATE:SCLEN,#CREATE    CREATE A NEW FILE
        CLOSE:SCLEN,#CLOSE      CLOSE A FILE
        RENAME:SCLEN,#RENAME    RENAME A FILE
        DELETE:SCLEN,#DELETE    DELETE A FILE
        LOAD:SCLEN,#LOAD        LOAD A FILE INTO MEMORY
        CHAIN:SCLEN,#CHAIN      CHAIN TO A FILE
        CREATELOG:SCLEN,#CREATELOG      CREATE A FILE FOR OUTPUT ON LOG CHANNEL
        CLOSELOG:SCLEN,#CLOSELOG        CLOSE LOG OUTPUT FILE
        DISKDEFAULT:SCLEN,#ERRNOTTS     SET DISK DEFAULT DEVICE *** error ***
        READA:SCLEN,#READA      READ ASCII BYTES FROM A FILE
        READB:SCLEN,#READB      READ BINARY BYTES FROM A FILE
        WRITEA:SCLEN,#WRITEA    WRITE ASCII BYTES TO A FILE
        WRITEB:SCLEN,#WRITEB    WRITE BINARY BYTES TO A FILE
        CONTROL:SCLEN,#CONTROL  PERFORM A CONTROL OPERATION ON AN I/O CHANNEL
        STATUS:SCLEN,#STATUS    READ STATUS FROM AN I/O CHANNEL
        WAITDONE:SCLEN,#SCOK    WAIT FOR I/O CHANNEL OPERATION DONE *** no-op ***
        EXIT:SCLEN,#EXIT        GIVE CONTROL BACK TO THE OPERATING SYSTEM
        ERROREXIT:SCLEN,#ERROREXIT      EXIT TO SYSTEM WITH ERROR CODE
        SETERROR:SCLEN,#SETERROR        REPORT AN ERROR TO THE SYSTEM
        GETERROR:SCLEN,#GETERROR        RETURN THE LAST ERROR CODE
        DISPERROR:SCLEN,#DERR   DISPLAY USER'S LAST ERROR
        KILLPROOF:SCLEN,#KILLPROOF      MAKE USER PROGRAM KILL-PROOF 
        KILLENABLE:SCLEN,#KILLENABLE    MAKE USER PROGRAM KILLABLE 
        DEBUG:SCLEN,#ERRNOTTS   CALL SYSTEM DEBUGGER *** error ***
        ATTNCHECK:SCLEN,#ATTNCHECK      OPERATOR ATTENTION CHECK
        ISCONSOLE:SCLEN,#ISCONSOLE      IS CHANNEL ZERO OPEN TO CONSOLE PREDICATE
        INTERLOCK:SCLEN,#INTERLOCK      PERFORM INTERLOCK FUNCTIONS
        DELAY:SCLEN,#DELAY      DELAY USER AT 60 Hz RESOLUTION
OPCODEMAX       EQU     (*-OPCODES)/3-1
        PAGE    Scheduler
POLLFORUSER
        JSR     CHECKLINEFLAGS  see if anyone twitched
        JSR     EXAMINEOUTPUTQ  look for output complete
        BCC     PFU.1
        JSR     EXAMINESPACEQ   look for space available
        BCC     PFU.1
        JSR     EXAMINEDELAYQ   see if anyone's time is up
        BCC     PFU.1
        JSR     EXAMINEINPUTQ   look for input complete
        BCC     PFU.1
        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
        STD     CURRENTUCB      we're going to work with this user for...
PFU.1
        JSR     FETCHCONTEXT    ...a while
        LDAA    CURRENTUSER
        JSR     USERSELECT
        LDX     CURRENTUCB
        LDS     UCB:STACKP,X            fetch this user's system environment
        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
SYSCALLENTRY
        JSR     GETSYSCALLBLOCK go get the syscall block from the user space
        JSR     CLEARCARRYINUSERCONTEXT clear carry in user's context
        BSR     VALIDATESYSCALLBLOCK    guess!
        BCS     SYSCALL.4
        INX
        LDX     (OPCODES&$FF),X         GET THE BRANCH ADDRESS
        JSR     0,X                     GO DO SYSCALL FUNCTION
        BCC     SYSCALLEXIT             do a no-error exit
SYSCALL.4
        JMP     USERERRORED     else bitch about situation

FIREBREAK       ; last-ditch firebreak
        BCS     FIREBREAK.1     need this to stop the stack un-winder
FIREBREAK.1
        JSR     GOCATATONIC     I should never be here--roll up eyes and go mum
        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
SCOK
        OKRTS

SYSCALLEXIT
        JSR     RETURNRPLEN     return the reply length field to the user
        JSR     RETURNLINEFLAGS give him most current lineflags hint
        JSR     RELEASEALLPAGES get rid of all user pages
        JSR     RETURNTOUSER    return to user with fruits of labor
        JMP     SYSCALLENTRY    he did another syscall...go for it!

RETURNRPLEN     ; return rplen field if syscall block allows it
        LDX     CURRENTUCB      return reply length to user, if requested
        LDAA    SCBLK:WLEN,X
        ANDA    #%01111111
        CMPA    #SCBLK:RPLEN+2
        BCS     RETURNRPLEN.9   B/ not requested
        LDD     UCB:USERSCB,X
        ADDD    #SCBLK:RPLEN
        STD     TEMPX
        LDD     SCBLK:RPLEN,X
        LDX     TEMPX
        JSR     COPYDTOUSER
RETURNRPLEN.9
        RTS
        PAGE
GETSYSCALLBLOCK ; get the syscall block from the user space
        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
        CLRA
        ANDB    #%01111111
        LDX     CURRENTUCB
        IF      M6809
        TFR     X,Y
        ELSE
        STX     TEMPX
        FIN
        LDX     UCB:USERSCB,X
        JMP     COPYTOSYSTEM
        PAGE
VALIDATESYSCALLBLOCK    ; validate the syscall block (with firebreak, pleez)
        LDX     CURRENTUCB
        LDAB    SCBLK:OPCODE,X  GET THE OPCODE
        CMPB    #OPCODEMAX      IS THE OPCODE LEGAL?
        LBHI    ERRILLSYSCALL   B/ NO
        ASLB            MULTIPLY OPCODE VALUE BY 3
        ADDB    SCBLK:OPCODE,X  N*2+N = N*3
        IF      OPCODEMAX*3>>255
        ?ERROR  OPCODE INDEXING WON'T WORK
        FIN
        STAB    SYSCALLX+1      LOCATE OPCODE TABLE SLOT CORRESPONDING TO OPCODE
        LDAA    SCBLK:WLEN,X    COPY SYSCALL BLOCK LENGTH TO (A)
        ANDA    #%01111111      MASK OFF WAIT FLAG
        CMPA    #SCBLK:WRLEN+2  validate write buffer, if given
        BCS     SYSCALL2        B/ not given
        LDD     SCBLK:WRLEN,X   don't care how squirrelly the WRBUF is if 0 WRLEN
        BEQD    SYSCALL2.1      B/ 0 WRLEN
        LDD     SCBLK:WRBUF,X
        CMPD    TOPMEM
        LBHI    ERRBADWRITEBUF
        ADDD    SCBLK:WRLEN,X
        CMPD    TOPMEM
        LBHI    ERRBADWRITEBUF
SYSCALL2.1
        LDAA    SCBLK:WLEN,X    clear reply length, if given
        ANDA    #%01111111
        CMPA    #SCBLK:RDLEN+2
        BCS     SYSCALL2        B/ not given
        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    SYSCALL2        B/ 0 RDLEN
        LDD     SCBLK:RDBUF,X
        CMPD    TOPMEM
        LBHI    ERRBADREADBUF
        ADDD    SCBLK:RDLEN,X
        CMPD    TOPMEM
        LBHI    ERRBADREADBUF
SYSCALL2
        LDAA    SCBLK:WLEN,X
        ANDA    #%01111111
        LDX     SYSCALLX        GRAB POINTER TO OPCODE TABLE SLOT
        CMPA    OPCODES&$FF,X   IS SIZE OF SYSCALL BLOCK >= NECESSARY MINIMUM ?
        LBCS    ERRSYSCALLTOOSHORT      B/ NO, YOU DIE!
        OKRTS
        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
        LDD     CURRENTUCB      move current user to tail of RUN Q
        JSR     ADDRUNQ
        BSR     SAVEPLACE       this user resumes here for next quantum
        BCS     TSE.1           B/ oops
        BSR     CHECKLINEFLAGS  get lineflags if channel 0 is VT console
        BCC     RUNTHISUSER     user didn't ^C^C
TSE.1
        BSR     SETUPTHISUSER
        LEAS    2,S             get rid of return from RETURNTOUSER
        JMP     USERDIED        R.I.P.

        PAGE
CHECKLINEFLAGS
        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     CURRENTUCB
        PSHA
        LDA     #FIRSTUCB/256
CHECKLINEFLAGS.DOIT.2
        STA     CURRENTUCB
        LDX     CURRENTUCB
        LDA     UCB:LFCHAN,X
        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
        PULA
        STA     CURRENTUCB
        RTS                             all done

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!)

        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
        PAGE
*       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.

SAVEPLACE
        JSR     SAVECONTEXT
        STS     UCB:STACKP,X    remember this context
        JMP     POLLFORUSER

RUNTHISUSER
        BSR     SETUPTHISUSER
        JMP     RETURNTOUSER    give user a chance to muck things up (he will)

SETUPTHISUSER   ; get this user ready to run (one way or another)
        LDAA    NEXTQUANTUM     give this incarnation a fresh quantum
        LDX     #TIMESLICEEXPIRED       where to go on quantum-end
        JMP     SETQUANTUM

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   TSX             GET RETURN ADDRESS TO (X)
        LDX     0,X
        INS             AND POP IT FROM THE STACK
        INS
        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
        INS
        INS
ERRORED ; NOW FAKE "RTS" UNTIL BCC/BCS ENCOUNTERED
        TSX             GRAB RETURN ADDRESS
        LDX     0,X     ...
        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
GOCATATONIC

; come here to roll over and die

; RETURN ADDRESS IN LOC 0
; VERSION & SUBVERSION IN LOC 2
; ERROR CODE IN LOC 4

        STX     4
        NOP
        SEI
        TSX
        LDX     0,X
        STX     0               save return address for autopsy
        LDAA    #MTVERSION      save version and subversion for same reason
        IFUND   MTSUBVERSION
        CLRB
        ELSE
        LDAB    #MTSUBVERSION
        FIN
        STD     2
        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
        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
        JSR     EXIT1                   he looses!!
        JMP     SYSCALLEXIT             exit syscall doesn't error

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     SETCARRYINSAVEDUSERCONTEXT
        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.

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
        RTS

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
        ADDD    #ENV:X+1
        ELSE
        ADDD    #ENV:X
        FIN
        TDX
        JMP     COPYUSERTODX

CLEARCARRYINUSERCONTEXT
        LDX     #USERSPSAVE
        JSR     COPYUSERTODX
        IF      M6800+M6801
        INX
        FIN
        CLC     assert: CCR is first byte of processor context
        TPA
        JMP     COPYATOUSER

SETPCINUSERCONTEXT
        STX     TSTEMP
        LDX     #USERSPSAVE
        JSR     COPYUSERTODX
        IF      M6800+M6801
        ADDD    #ENV:PC+1
        ELSE
        ADDD    #ENV:PC
        FIN
        TDX
        LDD     TSTEMP
        IF      M6809
        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, except PC, and move to safe place
        LDX     #USERSPSAVE
        JSR     COPYUSERTODX
        STX     TSTEMP
        IF      M6800+M6801
        INX
        LDD     #CONTEXTBLOCK   safe place
        STD     TEMPX
        ELSE
        LDY     #CONTEXTBLOCK
        FIN
        LDD     #ENV:PC count to move
        JSR     COPYTOSYSTEM
        LDD     TSTEMP  adjust top of stack
        ADDD    #ENV:PC
        LDX     #USERSPSAVE
        JMP     COPYDTOUSER

SETXINSAVEDUSERCONTEXT  ; guess what this does!
        STX     CONTEXTBLOCK+ENV:X
        RTS
        PAGE
RESTOREUSERCONTEXT      ; move user context back
        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

SETCARRYINSAVEDUSERCONTEXT
        SEC
        TPA
        STAA    CONTEXTBLOCK+ENV:CC
        RTS
        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

REMRUNQ
        LDX     #RUNQ
        JMP     REMQUEUE

ADDINPUTQ
        LDX     #INPUTQ
        JMP     ADDQUEUE

REMINPUTQ
        LDX     #INPUTQ
        JMP     REMQUEUE

ADDOUTPUTQ
        LDX     #OUTPUTQ
        JMP     ADDQUEUE

REMOUTPUTQ
        LDX     #OUTPUTQ
        JMP     REMQUEUE
        PAGE
ADDSPACEQ
        LDX     #SPACEQ
        JMP     ADDQUEUE

REMSPACEQ
        LDX     #SPACEQ
        JMP     REMQUEUE

REMDELAYQ
        LDX     #DELAYQ
        JMP     REMQUEUE
        page
ADDDELAYQ                              ; entries must be in ascend order

; 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
        ldx     currentucb
        ldd     ucb:wakeup,x
        std     currenttime            put target^.wakeup here
        lda     ucb:wakeup+2,x
        sta     currenttime+2
        clrb                           prior:=nil
        lda     delayq+queue:head
adddelayq.loop
        sta     queue:ucb
        ldx     queue:ucb
        pshb
        jsr     comparetime            target^.wakeup : current^.wakeup
        bls     delaygoeshere          b/ bingo!
        ins
        ldx     queue:ucb
        ldb     queue:ucb              prior:=current
        lda     ucb:nextonq,x          current:=current^.next
        bne     adddelayq.loop         b/ not end of queue
adddelayq.qempty
        LDX     #DELAYQ
        lda     currentucb
        JMP     ADDQUEUE
        page
delaygoeshere
        pulb
        tstb
        beq     delaygoesathead        b/ goes at head of queue
        ldx     currentucb
        lda     queue:ucb
        sta     ucb:nextonq,x          target^.next:=current
        stb     queue:ucb
        ldx     queue:ucb
        lda     currentucb
        sta     ucb:nextonq,x          prior^.next:=target
        rts

delaygoesathead
        ldx     currentucb
        lda     delayq+queue:head
        sta     ucb:nextonq,x          target^.next:=head
        lda     currentucb
        sta     delayq+queue:head      head:=target
        rts
        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

; (a) -> ucb, (x) -> queue descriptor

        LDB     QUEUE:TAIL,X            see if anyone 't all's in the queue
        BNE     ADDQUEUE.1              B/ yup
        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
        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
        BEQ     EXAMINEINPUTQ.5a        B/ still alive
        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!!
        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
        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, feeding more output where necessary,
*       and re-queueing those UCBs which have done their time.

EXAMINEOUTPUTQ
        LDA     OUTPUTQ         see if anyone waiting for output
        STA     TSTEMP          remember place to avoid tail-chasing
        BNE     EXAMINEOUTPUTQ.1        B/ got someone--go look at him
        ERRORRTS        signal empty queue

EXAMINEOUTPUTQ.1
        JSR     REMOUTPUTQ      go feed some of this user's buffer to vt driver
        STD     CURRENTUCB
        LDX     CURRENTUCB
        LDA     UCB:QUEUEERR,X  see if he died in sleep
        ORAA    UCB:QUEUEERR+1,X
        BEQ     EXAMINEOUTPUTQ.1a       B/ still alive
        OKRTS                           SURPRISE!!

EXAMINEOUTPUTQ.1a
        TST     UCB:STARTIO,X   see if syscall must be issued
        BEQ     EXAMINEOUTPUTQ.3
        JSR     SYSCALL$
        BCS     EXAMINEOUTPUTQ.ERROR
        LDX     CURRENTUCB
        CLR     UCB:STARTIO,X
EXAMINEOUTPUTQ.3
        TST     SCBLK:DATA,X    see if request completed
        BEQ     EXAMINEOUTPUTQ.2
        LDX     SCBLK:DATA+1,X  request completed--see if with error
        BNE     EXAMINEOUTPUTQ.ERROR
        LDX     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
        ERRORRTS                found nothing of interest

EXAMINEOUTPUTQ.ERROR
        CPX     #ERR:IOINPROGRESS       whatever you say, Ron...
        BEQ     EXAMINEOUTPUTQ.2        treat this one as nothing taken
        JMP     EXAMINEINPUTQ.7 go thrash user
        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
        STA     CURRENTUCB      assert: no context is current!!
        LDA     UCB:QUEUEERR,X  see if he died in sleep
        ORAA    UCB:QUEUEERR+1,X
        BEQ     EXAMINESPACEQ.1 B/ still alive
        OKRTS                   SURPRISE!!

EXAMINESPACEQ.1
        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
        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
        bsr     timepleez              get current time
        lda     delayq                 and see if head of queue is ready to go
        clrb
        std     currentucb
        ldx     currentucb
        jsr     comparetime            currenttime : ucb:wakeup
        bls     delayqisempty          b/ head of queue is not ready to go
        jsr     remdelayq              pull off head of queue
        okrts

delayqisempty
        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

        clrb                           prior:=nil
        lda     delayq+queue:head
delay.ctlc.loop
        sta     queue:ucb
        beq     delay.ctlc.alldone     b/ queue is empty
        ldx     queue:ucb
        cmpa    currentucb
        beq     delay.ctlc.foundit     b/ found currentucb in queue
        tab                            prior:=current
        lda     ucb:nextonq,x          current:=current^.next
        bra     delay.ctlc.loop

delay.ctlc.foundit
        lda     ucb:nextonq,x
        beq     delay.ctlc.lastonq     b/ current is on queue tail
        clr     ucb:nextonq,x          current^.next:=nil
        tstb
        beq     delay.ctlc.firstonq    b/ current is on queue head
        stb     queue:ucb
        ldx     queue:ucb
        sta     ucb:nextonq,x          prior^.next:=current^.next
        bra     delay.ctlc.addtorunq
        page
delay.ctlc.firstonq
        sta     delayq+queue:head      head:=current^.next
        bra     delay.ctlc.addtorunq

delay.ctlc.lastonq
        tstb
        beq     delay.ctlc.onlyonq     b/ current is only one on queue
        stb     queue:ucb
        stb     delayq+queue:tail      tail:=prior
        ldx     queue:ucb
        clr     ucb:nextonq,x          prior^.next:=nil
        bra     delay.ctlc.addtorunq

delay.ctlc.onlyonq
        ldx     #0                     head:=nil
        stx     delayq                 tail:=nil
delay.ctlc.addtorunq
        lda     currentucb
        jsr     addrunq
delay.ctlc.alldone
        rts
        page
timepleez

; Read the clock: device to get the current time.

        lda     currenttime+3          save the day from the last reading
        sta     lastday                so I can check for midnight crossover
        ldx     #readtime
        jsr     syscall$
        bcc     timeok
        jsr     gocatatonic            somethin's not right at all

timeok  lda     currenttime+3          currentday : lastday
        cmpa    lastday
        bne     pastmidnight           b/ crossed over midnight
        okrts                          just a plain-vanilla clock reading

pastmidnight
        clr     tempx+1                adjust all entries on the delay queue
        lda     delayq                 ...starting with the head
adjusttheq
        sta     tempx
        ldx     tempx
        jsr     adjusttime
        lda     ucb:nextonq,x
        bne     adjusttheq             b/ more to go
        rts                            all on delay queue have been offset 24'
        page
addtime

; Add the current time to the UCB:WAKEUP field in the current ucb.

        bsr     timepleez              first we have to have the time...
        ldx     currentucb
        lda     ucb:wakeup+2,x
        adda    currenttime+2
        sta     ucb:wakeup+2,x
        lda     ucb:wakeup+1,x
        adca    currenttime+1
        sta     ucb:wakeup+1,x
        lda     ucb:wakeup,x
        adca    currenttime
        sta     ucb:wakeup,x
        rts

comparetime

; Compare the current time with the UCB:WAKEUP field in the current ucb.
; return condition code: < = >; (x) -> ucb

        lda     currenttime
        cmpa    ucb:wakeup,x
        bne     comparetime.exit
        lda     currenttime+1
        cmpa    ucb:wakeup+1,x
        bne     comparetime.exit
        lda     currenttime+2
        cmpa    ucb:wakeup+2,x
comparetime.exit
        rts
        page
adjusttime

; Subtract 24 hour's worth of ticks from the UCB:WAKEUP field in the current
; ucb; return with carry set if underflow, else carry clear.

        lda     ucb:wakeup+2,x
        suba    twentyfourhours+2
        sta     ucb:wakeup+2,x
        lda     ucb:wakeup+1,x
        sbca    twentyfourhours+1
        sta     ucb:wakeup+1,x
        lda     ucb:wakeup,x
        sbca    twentyfourhours
        sta     ucb:wakeup,x
        bmi     adjusttime.waypast
        rts

adjusttime.waypast
        clr     ucb:wakeup,x           this should have been gotten--make it 0
        clr     ucb:wakeup+1,x
        clr     ucb:wakeup+2,x
        rts

twentyfourhours
        fcb     $4f,$1a,0              (5,184,000 ticks in 24 hours)
        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
FFP1    LDAA    0,X     look for a zero slot in the map
        BEQ     FFP2    B/ found one!
        INX             next!!   pleez
        DECB
        BNE     FFP1
FFP3    ERRORRTS

FFP2    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
        TST     0,X     is this available?
        BNE     COUNTPAGES.EXIT B/ nope
        INCA            count it
        DEC     THISCOUNT
        BEQ     COUNTPAGES.GOTENUFF     B/ got what I asked for
        INX             next page, pleez
        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: PAGEBASE contains page number, NPAGES contains 1
*
*               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
        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
        DEC     NUMPAGES
        OKRTS
        PAGE
* Release all pages checked out to current user

RELEASEALLPAGES
        LDAB    MAPSIZE
        LDX     PAGEMAPBASE

RAP1    LDAA    0,X     is this a victim?
        ANDA    #$8F    ignore flags
        CMPA    CURRENTUSER
        BNE     RAP2    B/ nope!
        CLR     0,X     yup!  free the slot
        INC     NUMPAGES
RAP2    INX
        DECB
        BNE     RAP1
        LDA     MAPSIZE perform sanity check
        CMPA    NUMPAGES
        BCS     RAP3
        OKRTS

RAP3    LDX     #ERR:MEMORYMGMTFAIL
        JSR     GOCATATONIC
        PAGE
* Allocate (A) pages and mark them as being used
*
*  returns carry clear: PAGEBASE contains page number,
*                       NPAGES contains from 1 to (A),
*                       as the number of pages allocated
*
*               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.

ALLOCATENPAGES
        CMPA    #255    check for variable request
        BNE     ANP.9   B/ not variable
        LDA     NUMPAGES
        SUBA    NUMUSERS
        BHI     ANP.9
        LDA     #1      things are pretty tight right now
ANP.9   STAA    NPAGES  remember request size
        BEQ     ANP.8   0 pages is an easy request to satisfy
        CMPA    #1      check for special case
        BEQ     ALLOCATE1PAGE
        CLR     LASTCOUNT       prepare (sigh!) for search
        BSR     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 very roomy--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   LDAA    LASTBASE        take our best match and mark it as owned
        STAA    PAGEBASE
        STAA    TEMPB
        LDAA    LASTCOUNT
        STAA    NPAGES
        LDX     TEMPX
        LDAB    CURRENTUSER
        ORAB    #$40
ANP.6   STAB    0,X
        INX
        DECA
        BNE     ANP.6
        LDB     NUMPAGES
        SUBB    NPAGES
        BCC     ANP.A
        LDX     #ERR:MEMORYMGMTFAIL
        JSR     GOCATATONIC

ANP.A   STB     NUMPAGES
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
        ERRORRTS

ANP.7   LDAA    NPAGES
        LDX     CURRENTUCB      block him until he can get the pages
        STAA    UCB:PNEEDED,X
        LDD     CURRENTUCB
        JSR     ADDSPACEQ
        JMP     SAVEPLACE
        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     SCBLK:WLEN,X            return nothing, pleez!
        JMP     ERRORED
        PAGE
DOOPEN
        JSR     FNAMESETUP
        JSR     WASCONSOLEREQUESTED
        BCC     DOOPEN.2                b/ console was requested
        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
        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
isitvirtualina

; return device type flags in (a): vt:console or vt:printer

        ldx     currentucb
        lda     scblk:params,x
        sta     indexforlda
        ldx     #devicemap
        jsr     ldaindex
        ldx     currentucb
        rts

isitvirtual                            ; c/r -> yes; c/s -> no

; return device type flags in ucb:vtflag

        bsr     isitvirtualina
        sta     ucb:vtflag,x
        beq     isitvirtual.1          b/ not virtual
        okrts

isitvirtual.1
        errorrts
        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
        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
        BMI     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
        ldx     #err:chtoobig           this shouldn't happen AT ALL!
        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
        lbmi    ldaindex                b/ channel is valid
        jsr     erret
        #err:chtoobig

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
        LBCS    LOADER2                 B/ COULD GET AN ERROR HERE
        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
        ldx     #OldKeyEncrypted        save this "key" as last "key" used
        stx     topointer
        else    (m6809)
        ldy     #OldKeyEncrypted
        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      ...?
        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
        LBCS    LOADER2         B/ COULD GET AN ERROR HERE
        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
        LDX     #OLDKEYENCRYPTED        = COMPARE "TO" ADDRESS
        STX     TOPOINTER
        ELSE    (M6809)
        LDY     #OLDKEYENCRYPTED
        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
        LDA     #255            get load record buffer
        JSR     ALLOCATENPAGES
        LDD     PAGEBASE
        STD     LOADADDRESS
        JSR     SETUPFRANKBAKER set up syscall linkage within userspace
        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
        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$
        BCS     LOADER2         B/ PROBABLY EOF, TOO BAD!
        PAGE
        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
        JSR     RETURNRPLEN
        LDX     CURRENTUCB
        CLR     SCBLK:WLEN,X
        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
        LDX     #OLDKEYENCRYPTED        DECIDE IF WE SHOULD RUN ENCRYPTED OR NOT
        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
        LDX     #LOADCLOSE1     NOW CLOSE THE LOAD FILE
        JMP     SYSCALL$

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

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
;       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     $fffe   Get pointer to serial number in ROM
        LEAX    3,X     = ADDRESS OF ROM SERIAL NUMBER
        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?
        BEQ     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

ErrSerialNoWrong
        Jsr     Erret
        Fdb     Err:SerialNoWrong

        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!
        IF      M6800!M6801
        LDD     LOADADDRESS
        ADDA    NPAGES
        TDX
ZAPUSERSPACEL ; ZAP ANOTHER USER SPACE BYTE
        CLR     ,-X
        CPX     LOADADDRESS     STOP ZEROING AT BEGINNING OF BUFFER
        BNE     ZAPUSERSPACEL
        ELSE    (M6809)
        LDX     LOADADDRESS     USE BLOCKMOVE LIKE 360 MVC INSTRUCTION TO ZERO MEMORY
        CLR     0,X             ZERO FIRST TWO BYTES OF BUFFER
        CLR     1,X
        LDD     NPAGES          COMPUTE SIZE OF BUFFER TO ZERO
        SUBD    #2
        LEAY    2,X             WHERE TO MOVE STUFF TO...
        JSR     BLOCKMOVE       NOT SECURE TO CALL CODE+SDOS:BLOCKMOVE
        FIN

; 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
        BCS     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
        BEQD    SETUPFRANKBAKERJ
        SUBD    NPAGES
        BCS     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
        DECA
        BLE     EXITS.DONE      B/ he has no channels!!
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
        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
        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

READA
        JSR     GETCHANNEL      do channel translation
        JSR     ISITVIRTUAL
        TST     UCB:VTFLAG,X    B/ non-vt doesn't pre-check
        BEQ     READA.1
        TST     SCBLK:PARAMS+1,X
        BNE     READA.1
        JMP     ERRILLSYSCALL   foo on non-linemode reada to vt device!!

READA.1
        JSR     CHECKRDLEN
        #0
        JSR     READA.1.1       get ready to do a read
        JSR     SETUPREADBUF
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
        BCS     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
        JSR     WRITE.DIRTYWORK.3       condition scblk for writea
        JSR     WRITE.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
        STAA    SCBLK:OPCODE,X
        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
        TST     UCB:USERCHAN,X  toss him out if he's not using channel 0
        bne     reada.goteof
        jsr     isitconsole
        bcc     reada.goteof    b/ skip all this if already open to 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
        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
        ANDB    #$7F            make it look like true ascii
        CMPB    #ASCII:CR
        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 TS can allocate.

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

READB.8 ; got some kind of error: terminate operation
        STX     LASTERROR
        JSR     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?!
        LDX     CURRENTUCB      spiff up the syscall block
        LDAA    PAGEBASE
        STAA    SCBLK:RDBUF,X
        CLR     SCBLK:RDBUF+1,X
        LDAA    NPAGES
        STAA    SCBLK:RDLEN,X
        CLR     SCBLK:RDLEN+1,X
        RTS

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    WRITEA & WRITEB
WRITEA  JSR     GETCHANNEL      do channel translation
        JSR     WRITE.SETUPSCB
        LDD     SCBLK:WRLEN,X   check initial count for zero
        CMPD    #0
        BNE     WRITEA.LOOP
        JMP     SYSCALL$        SDOS needs this info

WRITEA.LOOP
        JSR     COPYBITEFROMUSER
        BCS     WRITEA.9        no more left
        JSR     WRITEAFROMSYSTEMSPACE
        BRA     WRITEA.LOOP

WRITEA.9
        OKRTS                   das ist alles


WRITEB  JSR     GETCHANNEL      do channel translation
        JSR     ISCHAN0TOCONSOLE
        BCS     WRITEB.9        b/ its to channel 0, but not to console
        JSR     WRITE.SETUPSCB
        LDD     SCBLK:WRLEN,X   check initial count for zero
        CMPD    #0
        BNE     WRITEB.LOOP
        JMP     SYSCALL$        SDOS needs this info

WRITEB.LOOP
        JSR     COPYBITEFROMUSER
        BCS     WRITEB.9        B/ no more left
        JSR     WRITE.DIRTYWORK
        BRA     WRITEB.LOOP

WRITEB.9
        OKRTS                   das ist alles
        PAGE
WRITEAFROMSYSTEMSPACE
        BSR     DOWELOG
        BCS     WRITEAFROMSYSTEMSPACE.6 B/ no, we don't
        JSR     ISITCONSOLE
        BCS     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     WRITE.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
        LDAA    UCB:LOGCHANNEL,X
        STAA    SCBLK:PARAMS,X
        JSR     WRITE.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
        jsr     ischan0toconsole
        bcs     wfss.6                  b/ chan 0, but not to console--skip it
        JMP     WRITE.DIRTYWORK

wfss.6  okrts                           skip output if chan 0, but not console

WRITEAFROMSYSTEMSPACE.3
        LEAS    4,S
        JMP     ERRORINX
        PAGE
DOWELOG         ; c/s -> no; c/r, return log channel in (a) -> yes
        LDX     CURRENTUCB
        jsr     isitchan0
        bcs     dowelog.9       b/ not channel 0
        lda     ucb:logchannel,x
        cmpa    #$ff            see if log is open
        beq     dowelog.9       b/ log not open
        OKRTS

DOWELOG.9
        ERRORRTS

isitconsole     ; c/r -> yes; c/s -> no
        ldx     currentucb
        lda     scblk:params,x
        cmpa    ucb:lfchan,x
        bne     isitconsole.9          b/ not console
        okrts

isitconsole.9
        errorrts

isitchan0       ; c/r -> yes; c/s -> no
        ldx     currentucb
        lda     scblk:params,x
        cmpa    ucb:chan0,x
        bne     isitchan0.9            b/ not channel 0
        okrts

isitchan0.9
        errorrts

ischan0toconsole ; c/r -> yes; c/s -> no
        ldx     currentucb
        lda     scblk:params,x
        cmpa    ucb:chan0,x
        bne     ischan0toconsole.1     b/ not channel 0
        cmpa    ucb:lfchan,x
        bne     ischan0toconsole.9     b/ channel 0 is not console
ischan0toconsole.1
        okrts

ischan0toconsole.9
        errorrts
        PAGE
WRITE.SETUPSCB
        JSR     CHECKWRLEN
        #0
        LDD     SCBLK:WRLEN,X
        ADDD    #255
        JSR     ALLOCATENPAGES
        LDX     CURRENTUCB
        LDAA    PAGEBASE
        STAA    UCB:BUFFER,X            remember this!
        LDAA    NPAGES
        STAA    UCB:BUFFERSIZE,X        this too!!
        OKRTS

WRITEA.FIXUPSCB ; changes a writea to a writea nw
        LDAA    #SYSCALL:CONTROL        turn prince into toad
        STAA    SCBLK:OPCODE,X
        LDAA    #SCBLK:DATA
        STAA    SCBLK:WLEN,X
        LDAA    #CC:WRITEANOWAIT
        STAA    SCBLK:PARAMS+1,X
        STAA    UCB:STARTIO,X           <>0 => need to issue the syscall
        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
        OKRTS
        PAGE
COPYBITEFROMUSER
        LDX     CURRENTUCB
        LDAA    UCB:BUFFER,X    copy data from userspace to systemspace
        STAA    SCBLK:WRBUF,X
        CLR     SCBLK:WRBUF+1,X
        LDAA    UCB:BUFFERSIZE,X
        STAA    SCBLK:WRLEN,X   until exhausted
        CLR     SCBLK:WRLEN+1,X
        LDD     UCB:USERWRLEN,X
        BEQD    COPYBITEFROMUSER.9      which it truly is (exhausted, that is)
        SUBD    SCBLK:WRLEN,X   do we copy a full bite, or just a taste?
        BCC     COPYBITEFROMUSER.2      B/ copy over a full bite
        LDD     UCB:USERWRLEN,X copy over remaining taste
        STD     SCBLK:WRLEN,X
COPYBITEFROMUSER.2
        IF      M6809
        LDY     SCBLK:WRBUF,X
        ELSE
        LDD     SCBLK:WRBUF,X   do the copying
        STD     TEMPX
        FIN
        LDD     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
        OKRTS

COPYBITEFROMUSER.9
        ERRORRTS
        PAGE
WRITE.DIRTYWORK
        LDX     CURRENTUCB
        JSR     ISITVIRTUAL             accomodate vt, if vt
        BCS     WRITE.DIRTYWORK.1       B/ not vt
        LDX     CURRENTUCB
        LDAA    SCBLK:OPCODE,X          but is it a writea?
        CMPA    #SYSCALL:WRITEA
        BNE     WRITE.DIRTYWORK.1       B/ nope
        JSR     WRITEA.FIXUPSCB
        LDD     CURRENTUCB
        JSR     ADDOUTPUTQ
        JSR     SAVEPLACE
        BCS     WRITE.DIRTYWORK.2       oops
WRITE.DIRTYWORK.3
        LDX     CURRENTUCB
        LDAA    #SYSCALL:WRITEA         paste scb back together
        STAA    SCBLK:OPCODE,X
        LDAA    #WRITEA:SCLEN
        STAA    SCBLK:WLEN,X
        OKRTS
        PAGE
WRITE.DIRTYWORK.2
        STX     LASTERROR
        BSR     WRITE.DIRTYWORK.3
        JMP     ERRORED

WRITE.DIRTYWORK.1
        LDX     CURRENTUCB
        JMP     SYSCALL$
        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
        jsr     allocaterealchannel    sigh...
        ldx     currentucb
        sta     ucb:logchannel,x
        sta     scblk:params,x
        lda     #syscall:create
        sta     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
        BCS     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
        BCS     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
        SUBD    #257
        BPL     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
        BCS     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
        BCS     STATUS.1        B/ no read buffer
        LDD     SCBLK:RDLEN,X   see if read buffer too large
        SUBD    #257
        BMI     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.1
        JMP     SYSCALL$        process syscall, no reply expected

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.  LOGOFFEXIT is used only once, to start up LOGOFF, instead
*       of DEFAULTPROGRAM.

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

; Checksum MT at each user exit.  This is done to guard against flaky memory,
; rather than flaky users (which is encryption's job).

EXIT2   BSR     EXIT.CHECKSUM
        JSR     KILLENABLE      killenable, in case user disabled
        BCS     EXIT2.1         B/ I don't care!
EXIT2.1 LDX     CURRENTUCB
        CLR     SCBLK:WLEN,X    there WILL be no reply
        IF      M6809
        LDY     #USERSPACEEXIT
        ELSE
        LDX     #USERSPACEEXIT
        STX     TEMPX
        FIN
        LDX     #USERSPACEEXITSTUFF
        LDD     #USERSPACEEXITSTUFFLEN
EXIT4   JSR     COPYTOUSER
        JSR     INITUSERSTACK
        OKRTS
        page
LOGOFFEXIT
        LDX     #0              set LASTERROR to 0
        STX     USERLASTERROR

; Checksum MT at each user exit.  This is done to guard against flaky memory,
; rather than flaky users (which is encryption's job).

        BSR     EXIT.CHECKSUM
        LDX     CURRENTUCB
        CLR     SCBLK:WLEN,X    there WILL be no reply
        JSR     KILLPROOF       logoff gets killproofed
        BCS     EXIT3.2         B/ I don't care!
EXIT3.2
        IF      M6809
        LDY     #USERSPACELOGIN
        ELSE
        LDX     #USERSPACELOGIN
        STX     TEMPX
        FIN
        LDX     #USERSPACELOGINSTUFF
        LDD     #USERSPACELOGINSTUFFLEN
        JSR     COPYTOUSER
        JSR     INITUSERSTACK
        OKRTS
        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)//16)*16

*       round up to multiple of 16 to optimize block transfer
        PAGE
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)//16)*16

*       round up to multiple of 16 to optimize block transfer
        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
        JSR     SETUPBUFFER     set up buffer housekeeping
        LDX     ERRORNUMBER     omit error 0
        BNE     DE.3
        CLR     DERRCRFLAG
        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     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
        JSR     WRITE.DIRTYWORK.3       turn scblk into a writea
        LDD     #255            this is how big the message might be
        STD     SCBLK:WRLEN,X
        JSR     WRITE.SETUPSCB  (X) -> UCB, on return
        LDAA    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

        ldx     currentucb
        lda     ucb:lfchan,x
        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
        rts

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
*       SETS SCBLK:RPLEN TO 2 BYTE INLINE VALUE IF RDLEN IS OK
*       (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
        TSX             IS RDLEN >= MINLENGTH ?
        LDX     0,X     I.E., IS 0 >= MINLENGTH-RDLEN ?
        LDAA    0,X     I.E., IS 0 > MINLENGTH-RDLEN-1 ?
        LDAB    1,X
        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
        TSX             IS WRLEN >= MINLENGTH ?
        LDX     0,X     I.E., IS 0 >= MINLENGTH - WRLEN ?
        LDAA    0,X     I.E., IS 0 > MINLENGTH - WRLEN -1 ?
        LDAB    1,X
        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:lockifavail
        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:WAKEUP+1,X
        CLR     UCB:WAKEUP,X
        JSR     ADDTIME                add current time to UCB:WAKEUP
        LDD     CURRENTUCB             put this one on ice
        JSR     ADDDELAYQ
        JSR     SAVEPLACE
DELAY.1
        OKRTS
        PAGE
PATCH   RPT 100
        FCB     0

firebomb.mtinit
        ldx     #initializetimeshare
firebomb.loop
        clr     0,x
        inx
        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     256
        fcb     0
        rpt     256
        fcb     $5a

        org     ucb+ucb:channelmap
        fdb     ucb+ucb:channelmapt
        org     ucb+ucb:channelmapt
        fcb     32                     32 channels for this user
        rpt     31                     channels 1..31
        fcb     $ff                    channel is closed

        org     ucb+ucb:logchannel
        fcb     $ff                    channel is closed
        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:lasterror
        fdb     0
        org     ucb+ucb:queueerr
        fdb     0

        org     ucb+ucb:stackp
        fdb     ucb+ucb:stack

        org     ucb+ucb:size
        page
ucb     set     *
        rpt     256
        fcb     0
        rpt     256
        fcb     $5a

        org     ucb+ucb:channelmap
        fdb     ucb+ucb:channelmapt
        org     ucb+ucb:channelmapt
        fcb     32                     32 channels for this user
        rpt     31                     channels 1..31
        fcb     $ff                    channel is closed

        org     ucb+ucb:logchannel
        fcb     $ff                    channel is closed
        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:lasterror
        fdb     0
        org     ucb+ucb:queueerr
        fdb     0

        org     ucb+ucb:stackp
        fdb     ucb+ucb:stack

        org     ucb+ucb:size
        page
ucb     set     *
        rpt     256
        fcb     0
        rpt     256
        fcb     $5a

        org     ucb+ucb:channelmap
        fdb     ucb+ucb:channelmapt
        org     ucb+ucb:channelmapt
        fcb     32                     32 channels for this user
        rpt     31                     channels 1..31
        fcb     $ff                    channel is closed

        org     ucb+ucb:logchannel
        fcb     $ff                    channel is closed
        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:lasterror
        fdb     0

        org     ucb+ucb:queueerr
        fdb     0

        org     ucb+ucb:stackp
        fdb     ucb+ucb:stack

        org     ucb+ucb:size
        page
ucb     set     *
        rpt     256
        fcb     0
        rpt     256
        fcb     $5a

        org     ucb+ucb:channelmap
        fdb     ucb+ucb:channelmapt
        org     ucb+ucb:channelmapt
        fcb     32                     32 channels for this user
        rpt     31                     channels 1..31
        fcb     $ff                    channel is closed

        org     ucb+ucb:logchannel
        fcb     $ff                    channel is closed
        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:lasterror
        fdb     0
        org     ucb+ucb:queueerr
        fdb     0

        org     ucb+ucb:stackp
        fdb     ucb+ucb:stack

        org     ucb+ucb:size
        page
ucb     set     *
        rpt     256
        fcb     0
        rpt     256
        fcb     $5a

        org     ucb+ucb:channelmap
        fdb     ucb+ucb:channelmapt
        org     ucb+ucb:channelmapt
        fcb     32                     32 channels for this user
        rpt     31                     channels 1..31
        fcb     $ff                    channel is closed

        org     ucb+ucb:logchannel
        fcb     $ff                    channel is closed
        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:lasterror
        fdb     0
        org     ucb+ucb:queueerr
        fdb     0

        org     ucb+ucb:stackp
        fdb     ucb+ucb:stack

        org     ucb+ucb:size
        page
ucb     set     *
        rpt     256
        fcb     0
        rpt     256
        fcb     $5a

        org     ucb+ucb:channelmap
        fdb     ucb+ucb:channelmapt
        org     ucb+ucb:channelmapt
        fcb     32                     32 channels for this user
        rpt     31                     channels 1..31
        fcb     $ff                    channel is closed

        org     ucb+ucb:logchannel
        fcb     $ff                    channel is closed
        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:lasterror
        fdb     0
        org     ucb+ucb:queueerr
        fdb     0

        org     ucb+ucb:stackp
        fdb     ucb+ucb:stack

        org     ucb+ucb:size
        page
ucb     set     *
        rpt     256
        fcb     0
        rpt     256
        fcb     $5a

        org     ucb+ucb:channelmap
        fdb     ucb+ucb:channelmapt
        org     ucb+ucb:channelmapt
        fcb     32                     32 channels for this user
        rpt     31                     channels 1..31
        fcb     $ff                    channel is closed

        org     ucb+ucb:logchannel
        fcb     $ff                    channel is closed
        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:lasterror
        fdb     0
        org     ucb+ucb:queueerr
        fdb     0

        org     ucb+ucb:stackp
        fdb     ucb+ucb:stack

        org     ucb+ucb:size
        PAGE    Once-Only
*       * 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

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!!!

INITERR
        STX     INIT.ERROREXIT+SCBLK:PARAMS
        LDX     #SYSKILLENABLE
        JSR     SYSCALL$
        BCS     FORGETYOUSAWTHIS
FORGETYOUSAWTHIS
        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$

; 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$

; 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
        CLR     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    #21             need space for 7 UCB'S + 7 STACKS + 7 PAGES to run SDOS/MT
        LBLT    NOTENOUGHROOM   b/ too bad--not enough room to sneeze in
        STAA    MAPSIZE
        LDX     PAGEMAPBASE     now, mark all available pages
INIT.1  ;                         as available
        CLR     0,X
        INX
        DECA
        BNE     INIT.1

*       set up the UCB's

        LDX     #0
        STX     TSTEMP
INIT.2  BSR     SETUPUCB        set up as many user's as possible
        BCS     INIT.2.1
        LDX     CURRENTUCB
        STX     TSTEMP
        LDD     CURRENTUCB
        ADDD    #UCB:SIZE
        STD     CURRENTUCB
        BRA     INIT.2

INIT.2.1
        LDA     MAPSIZE
        STA     NUMPAGES
        CLRA                    no initial quantum
        LDX     #TIMESLICEEXPIRED       where to go when quantum up
        JSR     SETQUANTUM
        OKRTS                   we made it!!
        PAGE
; Set up a UCB for CURRENTUSER.  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 exit with err:mtbadconfig.
; Otherwise, put the finishing touches on the ucb, and exit.

DEFAULTPROGRAMSIZE      EQU     20000   rough guess at size needed for this one

SETUPUCB
        LDX     CURRENTUCB
        INC     NUMUSERS
        LDA     NUMUSERS
        JSR     USERSELECT      select this user so I can fiddle with 
        BCS     TRUNCATECHAIN     (user # too high for this configuration)
        JSR     USERCURRENTSIZE     his address space--I want to see how
        SUBD    #3                    (allow for JMP USERSPACESYSCALL)
        STD     TOPMEM                  large he is
        SUBD    #DEFAULTPROGRAMSIZE
        BPL     SETUPUCB.0
TRUNCATECHAIN
        DEC     NUMUSERS
        ERRORRTS
        PAGE
SETUPUCB.0

; get a console for the user

        LDX     TSTEMP
        BEQ     SETUPUCB.1
        LDA     CURRENTUCB             point prior to current
        STA     UCB:NEXTONQ,X
        STA     UCB:LFNEXT,X
SETUPUCB.1
        LDX     CURRENTUCB
        INC     PAGEMAPBASE+1
        INC     PAGEMAPBASE+1
        DEC     MAPSIZE
        DEC     MAPSIZE
        LDA     CURRENTUCB
        STA     RUNQ+QUEUE:TAIL
        LDA     NUMUSERS
        STA     UCB:USERNUMBER,X
        LDD     UCB:CONSOLESTR,X       get name
        STD     CONSOLEOPEN+SCBLK:WRBUF
        CLRA
        LDB     UCB:CONSOLELEN,X       get length
        STD     CONSOLEOPEN+SCBLK:WRLEN
        JSR     ALLOCATEREALCHANNEL
        LDX     CURRENTUCB
        STA     UCB:LFCHAN,X           get the channel
        STA     UCB:CHAN0,X            give user an open console
        STA     INDEXFORSTA
        STA     CONSOLEOPEN+SCBLK:PARAMS
        LDX     #CONSOLEOPEN
        JSR     SYSCALL$               open it
        LDA     #VT:CONSOLE            set the device type
        LDX     #DEVICEMAP
        JSR     STAINDEX
        PAGE
; make the UCB "habitable"

        LDX     CURRENTUCB
        LDD     TOPMEM          fill the UCB with goodies
        STD     UCB:TOPMEM,X

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

        STS     TEMPX
        LDX     UCB:STACKP,X
        TXS
        LDD     #FIREBREAK      set up firebreak
        PSHD
        LDD     #SYSCALLEXIT
        PSHD
        TST     LOGINEXISTS
        BNE     NOLOGOFF
        LDD     #LOGOFFEXIT
        BRA     SETFIRSTSYSCALL

NOLOGOFF
        LDD     #EXIT
SETFIRSTSYSCALL
        PSHD
        LDX     CURRENTUCB
        STS     UCB:STACKP,X
        LDS     TEMPX
        JMP     SETUPFRANKBAKER give user a way out
        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

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
