OBJNAM MDO.LIT  ; Replacement for MDO.LIT to fix several bugs & add features
RADIX 10        ; by Irv Bromberg, Medic/OS Consultants, Toronto, CANADA
VMAJOR=2        ; completely new version number
VMINOR=5        ; last modified 15-July-87
VEDIT=207

ASMMSG "%This source file MUST be named MDO.M68 to assemble properly"
ASMMSG "%Requires AMOS/L 1.3 or later for assembly"

if eq,1
Use DOTEST.DO to test the original and new MDO versions.

MDO.LIT is the command which is invoked by the AMOS/L monitor to process
DO files, converting all $symbols they contain to the appropriate
values.  Changing MDO.LIT modifies the way the monitor recognizes
$symbols in .DO files.  To install this new version of MDO.LIT make a
backup copy of the original MDO (COPY MDO.ORG=MDO.LIT) then simply
assemble this source file (some of the features require AMOS/L 1.3 or
later to be recognized by the assembler, and see note below concerning
the J.DEC bit and OCTPCH) and copy the new MDO.LIT into the SYS: account
(DSK0:[1,4]).  Your system will handle .DO files more rapidly by
installing MDO.LIT in SYSTEM memory.

Enhancements added in this new version of MDO.LIT:

Prevent out of memory crashes (and fix bugs related to insufficient
partition freespace in original MDO.LIT) and do graceful "?Out of
memory" EXIT instead.

Prevent malfunction when .DO file translated to .CMD file overlaps high
memory in partition where .CMD file must be moved to (handle by copying
translated file in reverse order last byte first).

Prevent crash when $default line exceeds size of MDO's default line buffer.

Support the following new $symbols:

 $. yields the user's current AMOS/L prompt as SET  [AMOS/L 1.3 & later]
 $B user's base in format OCT DEC or HEX  [OCTPCH required for DEC]
 $C yields either CTRLC or NOCTRLC depending on SET status
 $D yields either DSKERR or NODSKERR depending on SET status
 $E yields either ECHO or NOECHO depending on SET status
 $G yields either GUARD or NOGUARD depending on SET status
 $J user's job name
 $L user's current language definition table name  [AMOS/L 1.3 & later]
 $M user's memory partition size (useful when changing & restoring MEMORY)
 $R user's current RADIX (8 10 or 16)  [OCTPCH required for 10]
 $T user's terminal name
 $U user's name from JOBUSN(JCB)  [AMOS/L 1.3 and later]
 $V yields either VERIFY or NOVERIFY depending on SET status

Plus minor changes to make it run faster or take less code.


Original .DO file processing features are still supported:
$ symbols
 $0-$9 converts to command line or default parameters
 $:    converts to DEVn:
 $P    converts to p,pn
 $$    converts to single $
command line processing
 <parameter with embedded spaces>      assigns to one $n symbol
 $     on command line causes corresponding $n symbol to default

Original MDO bugs which were fixed in this new version:

MDO.LIT version 1.0(106), which was released with AMOS/L 1.3C(157), and
the previous versions of MDO.LIT can seriously malfunction when the user
has little partition freespace available:  When processing $symbols in a
DO file MDO fetches the file to the true freespace in the user's
partition WITHOUT CHECKING THAT THERE IS ENOUGH FREESPACE AVAILABLE.
This could easily crash the system at worst, or could clobber part of a
command file being processed in the user's partition. MDO does not check
for overlap of the translated DO file (with $symbols translated) with
its destination in higher addressed memory as a CMD file for execution.
Thus be very careful when using DO files in small memory partitions using
the original version of MDO.LIT.

MDO uses only a 120-char buffer for the $D default line to be stored.
When more than 120 chars are used in a $D line the results are
unpredictable, with system failure very likely.  This bug was left alone
because it is extremely unlikely that any programmer would overflow this
buffer by providing too long a $D default string.  As always the $D
string must be the first line of the .DO file and no whitespace is
allowed in front of the $D symbol.  Note that the $D symbol which becomes
converted to DSKERR or NODSKERR is not to be confused with the $D default
parmeters string.

endc

SEARCH SYS
ASMMSG "%Must define J.DEC=^H8000 in MAC:SYS.M68 & assemble to SYS.UNV"
SEARCH SYSSYM
SEARCH TRM

JCB=A0
Rad50=A1
Buffer=A2
TCB=A2
CMD=A3
Symbol=A4
WRK=A5  ; DDB and WRK are intentionally the same register
DDB=A5
Atemp=A6

CMDSIZ=D0
Char=D1
Number=D1
TopLimit=D2
Count=D3
Mask=D4
Start=D5
Dtemp=D6

CR=13
LF=10
SPACE=32

=0 ; workspace format:
DDB$:   BLKB    D.DDB   ; DDB for .DO file input
NUM$:   BLKL    10      ; array of $0-$9 string pointers (could point at
                       ; user command line or default string or NULL)
DEV$:   BLKB    8       ; user's DEVn: for $: conversion
PPN$:   BLKB    16      ; user's p,pn for $P conversion
JOB$:   BLKB    8       ; user's job name for $J conversion +NULL
MEM$:   BLKB    10      ; user's memory partition size
BAS$:   BLKB    4       ; user's BASE (OCT DEC or HEX)
TRM$:   BLKB    7       ; user's terminal name for $T conversion +NULL
RDX$:   BLKB    3       ; user's RADIX (8 10 or 16)
DFT$:   BLKB    120     ; string of default $0-$9 values
       WRKSIZ=.
=0

       PHDR    -1,0,PH$REE!PH$REU      ; re-entrant & re-usable

       JOBIDX  JCB

       PUSH    #WRKSIZ
       PUSH
       GETMEM  @SP
       BEQ     MemOK

NoMem:  SMSG    #33,OT$TRM!OT$LDQ       ; ?Insufficient free memory
ErrX:   CRLF                            ; end message with CRLF
       TSTW    JOBCMZ(JCB)             ; command file in progress?
       BNE     10$                     ; yes, allow it to continue
       TSTB    JOBCMD(JCB)             ; command pending?
       BEQ     10$                     ; no, all done
       CLRB    JOBCMD(JCB)             ; yes, cancel pending command
       CLRW    JOBUSR(JCB)             ; log him out (yee gads!)
10$:    EXIT

MemOK:  POP     WRK
       POP

; DEVn:<cr> for $: conversion
       LEA     Rad50,JOBDEV(JCB)
       LEA     Buffer,DEV$(WRK)
       UNPACK
       CLR     Number                  ; pre-clear for word move
       MOVW    JOBDRV(JCB),Number
       DCVT    0,OT$MEM
       MOVB    #':,@Buffer

; setup p,pn for $P conversion
       PUSHW   JOBTYP(JCB)
       ANDW    #^C<J.HEX>,JOBTYP(JCB)
       CLR     Number                  ; pre-clear for byte moves
       MOVB    JOBUSR+1(JCB),Number    ; get proj#
       LEA     Buffer,PPN$(WRK)
       OCVT    0,OT$MEM
       MOVB    #',,(Buffer)+           ; separate proj from prog using ","
       MOVB    JOBUSR(JCB),Number      ; get prog#
       OCVT    0,OT$MEM
       POPW    JOBTYP(JCB)

; setup job name for $J conversion
       LEA     Rad50,JOBNAM(JCB)       ; point at job name
       LEA     Buffer,JOB$(WRK)        ; point at destination
       UNPACK                          ; unpack it
       UNPACK

; setup job partition size for $M conversion
       LEA     Buffer,MEM$(WRK)
       MOV     JOBSIZ(JCB),Number
       DCVT    0,OT$MEM

; setup radix value for $R conversion
       CLR     Number                  ; pre-clear for byte move
       MOVW    JOBTYP(JCB),Dtemp       ; select radix bits from JOBTYP(JCB)
       ANDW    #J.DEC!J.HEX,Dtemp
       CMPW    Dtemp,#J.DEC!J.HEX      ; DECIMAL mode?
       BEQ     DEC
       CMPW    Dtemp,#J.HEX            ; HEX mode?
       BEQ     HEX
       MOVB    #8,Number
       LEA     Symbol,Octal
       BR      CvtRdx
DEC:    MOVB    #10,Number
       LEA     Symbol,Decimal
       BR      CvtRdx
HEX:    MOVB    #16,Number
       LEA     Symbol,Hexadecimal
CvtRdx: LEA     Buffer,RDX$(WRK)        ; convert RADIX to ASCII numbers
       DCVT    0,OT$MEM                ; leave terminating NULL
       LEA     Buffer,BAS$(WRK)        ; convert base to OCT DEC or HEX
10$:    MOVB    (Symbol)+,(Buffer)+     ; continue to terminating NULL
       BNE     10$

; setup terminal name for $T conversion
       MOV     JOBTRM(JCB),Dtemp       ; get user's TCB
       BEQ     OpenFile                ; 0=unattached, no terminal name
       MOV     Dtemp,TCB               ; copy to addr reg
       LEA     Rad50,-4(TCB)           ; point at terminal name
       LEA     Buffer,TRM$(WRK)        ; point at destination
       UNPACK
       UNPACK

OpenFile: ; attempt to open the specified .DO file
       MOV     JOBTRM(JCB),TCB
       MOV     T.ILB(TCB),Buffer       ; set up pointer to input line buffer
       FSPEC   @DDB,DO
       INIT    @DDB
       PUSHW   @DDB
       ORB     #D$ERC!D$BYP,D.FLG(DDB)
       TSTW    D.DEV(DDB)              ; device specified?
       BNE     GetIt                   ; yes, start with that device
       MOVW    #[MEM],D.DEV(DDB)       ; no, try MEM: first
       CLR     D.DVR(DDB)
       OPENI   @DDB
       BEQ     Found
       CLRW    D.DEV(DDB)              ; not in MEM:, clear device word

GetIt:  CLR     D.DVR(DDB)              ; try again to get in the file
       OPENI   @DDB
       BEQ     Found
       CMPB    D.ERR(DDB),#D$EFIU
       BNE     Chk2.2
       ERRMSG  @DDB,OT$LDQ!OT$TRM      ; output error message to terminal
       JMP     ErrX

Chk2.2: CMPW    D.PPN(DDB),#<2_8>+2     ; already [2,2]?
       JEQ     What
       TSTW    D.PPN(DDB)              ; defaulting on PPN?
       BNE     Do2.2                   ; no, try [2,2] next
       MOVW    JOBUSR(JCB),D.PPN(DDB)  ; yes, try [p,0] next
       CLRB    D.PPN(DDB)
       BR      GetIt

Do2.2:  MOVW    #<2_8>+2,D.PPN(DDB)     ; set up to try [2,2] next
       MOVW    #[DSK],D.DEV(DDB)       ; on DSK0:
       CLRW    D.DRV(DDB)
       BR      GetIt

Found:  POPW    @DDB                    ; cancel D.ERC and D.BYP

ChkCMD: ; check the user's command line and set up pointers to any
       ; parameters he specified on the input command line
       MOVW    #10-1,Number            ; pre-clear symbols $0-$9
       LEA     Symbol,NUM$(WRK)
10$:    CLR     (Symbol)+
       DBF     Number,10$
       LEA     Symbol,NUM$(WRK)
       CALL    Set$n
       BR      ChkD$

Set$n:
NxtChr: CMPB    @Buffer,#CR
       BEQ     EndLin
       BYP                             ; skip whitespace
       CMPB    @Buffer,#'$             ; symbol here?
       BEQ     Skip$                   ; no value for this parameter
       TST     @Symbol                 ; in middle of $number parameter?
       BNE     10$                     ; yes, don't modify the start addr
       MOV     Buffer,@Symbol          ; no, save addr of this $number
10$:    ADDW    #4,Symbol               ; advance to next $number ptr
       ADDW    #1,Buffer               ; skip char
       CMPB    -1(Buffer),#'<          ; was it < ?
       BEQ     50$                     ; yes, skip to >
20$:    CMPB    @Buffer,#CR
       BEQ     EndLin
       CMPB    (Buffer)+,#SPACE        ; keep going till space ends param
       BLOS    NxtChr
       BR      20$

50$:    CMPB    @Buffer,#CR             ; <allows embedded spaces>
       BEQ     EndLin
       CMPB    (Buffer)+,#'>
       BEQ     NxtChr
       BR      50$

Skip$:  ADDW    #1,Buffer               ; $ only means skip param
       ADDW    #4,Symbol               ; so leave ptr NULL
       BR      NxtChr                  ; and continue to NxtChr
EndLin: RTN

ChkD$:  ; by this point we have defined the values for
       ; $: $P and those $0-$9 symbols defined on user command line
       ; now check if first line starts with $D for defaults

       USRFRE  CMD
       MOV     CMD,Start               ; save our start point
       MOV     JOBBAS(JCB),Atemp       ; calculate top memory limit
       ADD     JOBSIZ(JCB),Atemp
       SUBW    JOBCMZ(JCB),Atemp       ; addr reg so SUBW affects all bits
       MOV     Atemp,TopLimit          ; then copy to data reg to remember
       CALL    GetByte                 ; get first char from DO file
       CMPB    Char,#'$                ; is it "$"?
       BNE     SavChr                  ; no, no defaults to set up
       CALL    GetByte                 ; is it "$$"?
       CMPB    Char,#'$                ; yes, no defaults to set up
       BEQ     SavChr
       CMPB    Char,#'d                ; it is "d" or "D"?
       BEQ     SetDFT                  ; yes, set up defaults
       CMPB    Char,#'D
       BNE     Cvt$

SetDFT: LEA     Buffer,DFT$(WRK)        ; set up defaults
       MOVW    #120-1,Count            ; set up limit on default line length
10$:    CALL    GetByte                 ; loop until linefeed
       MOVB    Char,(Buffer)+
       CMPB    Char,#LF
       DBEQ    Count,10$               ; stop if limit exhausted
       BEQ     20$                     ; OK, terminating LF reached
       TYPE    <?Default values line too long>
       JMP     ErrX                    ; graceful exit instead of crash
20$:    LEA     Buffer,DFT$(WRK)        ; reset to start of dflt strng
       LEA     Symbol,NUM$(WRK)        ; index $0-$9 ptrs
       CALL    Set$n                   ; set up defaults as $0-$9 values

DoMore: CALL    GetByte
       CMPB    Char,#'$
       BEQ     Cvt$
SavChr: MOVB    Char,(CMD)+
       BCALL   ChkLimit
       BR      DoMore

ChkLimit:CMP    CMD,TopLimit            ; out of memory?
       BLO     10$                     ; no, OK to continue
       CLOSE   @DDB                    ; yes, close the input file
       JMP     NoMem                   ; and exit gracefully (EXIT cleans up
10$:    RTN                             ; stack)

Cvt$:   ; convert $x to appropriate value
       CALL    GetByte                 ; get symbol after "$"
       UCS                             ; fold it to uppercase
       CMPB    Char,#'$                ; "$$" converts to "$"
       BEQ     SavChr                  ; $P converts to p,pn
       CMPB    Char,#'B                ; $B converts to OCT DEC or HEX
       JEQ     BAS
       CMPB    Char,#'C
       JEQ     CTC
       CMPB    Char,#'D
       JEQ     DER
       CMPB    Char,#'E
       JEQ     ECH
       CMPB    Char,#'G
       JEQ     GRD
       CMPB    Char,#'J                ; $J converts to job name
       JEQ     JOB
       CMPB    Char,#'L                ; $L converts to language table name
       JEQ     LNG
       CMPB    Char,#'M                ; $M converts to memory partition size
       JEQ     MEM
       CMPB    Char,#'P
       JEQ     PPN
       CMPB    Char,#'R                ; $R converts to RADIX (8 10 or 16)
       JEQ     RDX
       CMPB    Char,#'T                ; $T converts to terminal name
       JEQ     TRM
       CMPB    Char,#'U                ; $U converts to user name
       JEQ     USR
       CMPB    Char,#'V
       JEQ     VER
       CMPB    Char,#':                ; $: converts to DEVn:
       BEQ     DEV
       CMPB    Char,#'.                ; $. converts to AMOS/L prompt
       JEQ     Dot
       SUBB    #'0,Char                ; check for digit 0-9
       JMI     DoMore                  ; otherwise ignore symbol
       CMPB    Char,#9
       JHI     DoMore
       AND     #255,Char
       LEA     Symbol,NUM$(WRK)        ; index $0-$9 symbol required
       ASL     Char,#2                 ; x4 for lword indexing
       ADD     Char,Symbol
       TST     @Symbol                 ; $n symbol defined?
       JEQ     DoMore                  ; no, ignore it
       MOV     @Symbol,Symbol          ; yes, get ptr to $n symbol
       CMPB    @Symbol,#'<             ; did it have embedded spaces?
       BEQ     Embed                   ; yes, handle embedded spaces

XLT$:   ; translate $symbol at pointed to by Symbol ptr
       CMPB    @Symbol,#SPACE          ; terminate at SPACE or Ctrl code
       JLOS    DoMore
       MOVB    (Symbol)+,(CMD)+
       CALL    ChkLimit
       BR      XLT$

Embed:  ADDW    #1,Symbol               ; skip "<"
10$:    CMPB    @Symbol,#'>             ; reached end of value ">"?
       JEQ     DoMore                  ; yes, continue with DO file
       CMPB    @Symbol,#CR             ; or also terminate at CR
       JEQ     DoMore
       MOVB    (Symbol)+,(CMD)+        ; save it till done with symbol
       CALL    ChkLimit
       BR      10$

BAS:    LEA     Symbol,BAS$(WRK)        ; convert $B to OCT DEC or HEX
       BR      XLT$

CTC:    MOVW    #J.CCA,Mask             ; $C -> CTRLC or NOCTRLC
       LEA     Symbol,NoCtrlc
       JMP     TYP

DER:    MOVW    #J.DER,Mask             ; $D -> DSKERR or NODSKERR
       LEA     Symbol,NoDskErr
       BR      TYP

DEV:    LEA     Symbol,DEV$(WRK)        ; convert $: to DEVn:
       BR      XLT$

ECH:    MOV     JOBTRM(JCB),Atemp       ; $E -> ECHO or NOECHO
       MOVW    T.STS(Atemp),Dtemp
       LEA     Symbol,Echo
       ANDW    #T$LCL,Dtemp
       BEQ     XLT$
       LEA     Symbol,NoEcho
       BR      XLT$

GRD:    MOVW    #J.GRD,Mask             ; $G -> GUARD or NOGUARD
       LEA     Symbol,NoGuard
       BR      TYP

JOB:    LEA     Symbol,JOB$(WRK)        ; convert $J to job name
       BR      XLT$

LNG:    MOV     JOBLNG(JCB),Symbol      ; convert $L to language table name
       ADDW    #LD.NM1,Symbol          ; index first name in table
       BR      XLT$

MEM:    LEA     Symbol,MEM$(WRK)        ; convert $M to memory part'n size
       JMP     XLT$

PPN:    LEA     Symbol,PPN$(WRK)        ; convert $P to p,pn
       JMP     XLT$

RDX:    LEA     Symbol,RDX$(WRK)        ; convert $R to RADIX (8 10 or 16)
       JMP     XLT$

TRM:    LEA     Symbol,TRM$(WRK)        ; convert $T to terminal name
       JMP     XLT$

USR:    LEA     Symbol,JOBUSN(JCB)      ; $U->user name from JOBUSN(JCB)
TillNULL:MOVB   (Symbol)+,(CMD)+        ; copy, terminating on NULL
       BEQ     10$
       CALL    ChkLimit                ; make sure we don't go too far
       BR      TillNULL
10$:    DECW    CMD                     ; undo last post-increment
       JMP     DoMore

Dot:    LEA     Symbol,JOBPRM(JCB)      ; $. -> AMOS/L prompt from JOBPRM(JCB)
       BR      TillNULL

VER:    MOVW    #J.VER,Mask
       LEA     Symbol,NoVerify

TYP:    ANDW    JOBTYP(JCB),Mask
       JEQ     XLT$
       ADDW    #2,Symbol               ; skip "NO"
       JMP     XLT$

EOF:    CLOSE   @DDB
       ; No need to terminate with NULL because size is known and anyways
       ; we'll be moving it in reverse order last byte first.  If we put
       ; a NULL here without checking against TopLimit then could clobber
       ; first byte in next partition or could cause ?Memory parity error
       MOV     CMD,CMDSIZ              ; calculate size of translated
       SUB     Start,CMDSIZ            ; .DO file (now a .CMD file)
       TSTW    JOBCMZ(JCB)             ; cmd file already in progress?
       BNE     Already                 ; yes, don't change cmd file status
       MOVW    #<LF_8>!C.SIL,JOBCMS(JCB); set new line, cmd silence mode
Already:MOV     JOBBAS(JCB),Buffer      ; index place to start moving file
       ADD     JOBSIZ(JCB),Buffer
       SUBW    JOBCMZ(JCB),Buffer      ; point at next CMD byte
       ADDW    CMDSIZ,JOBCMZ(JCB)      ; set new CMD file size
       BR      20$                     ; enter at end of DBF loop
10$:    MOVB    -(CMD),-(Buffer)        ; and move everything over in reverse
20$:    DBF     CMDSIZ,10$              ; order so overlap won't cause error
       EXIT

GetByte:FILINB  @DDB
       TST     D.SIZ(DDB)
       BEQ     EOF                     ; note stack not cleaned up till EXIT
       RTN

What:   ; failed to find or input required .DO file, echo original
       ; user command line bracketed by "?" marks to simulate the way
       ; the monitor does it when .LIT command cannot be found.
       TYPE    <?>
       MOV     JOBTRM(JCB),TCB
       MOV     T.ILB(TCB),Buffer
NxtQry: MOVB    (Buffer)+,Char
       CMPB    Char,#CR
       BEQ     EndQry
       CMPB    Char,#LF
       BEQ     EndQry
       TTY
       BR      NxtQry
EndQry: TYPE    <?>
       JMP     ErrX

Octal:          ASCIZ   "OCT"
Decimal:        ASCIZ   "DEC"
Hexadecimal:    ASCIZ   "HEX"

NoEcho:         ASCII   "NO"
Echo:           ASCIZ   "ECHO"

NoDskErr:       ASCII   "NO"
DskErr:         ASCIZ   "DSKERR"

NoVerify:       ASCII   "NO"
Verify:         ASCIZ   "VERIFY"

NoGuard:        ASCII   "NO"
Guard:          ASCIZ   "GUARD"

NoCtrlc:        ASCII   "NO"
Ctrlc:          ASCIZ   "CTRLC"

               EVEN

               END