Oakland CPM Archive/oakcpm.iso/sigm/sigmv016.ark/COMAND.LIB

Text File | 1984-04-29 | 7KB | 329 lines

;;
;; THIS MACRO PROCESSES COMMANDS ENTERED AT THE KEYBOARD.
;; PARAMETERS PASSED ARE:
;; 'PROMPT'    CHARACTER OR STRING ENCLOSED IN SINGLE QUOTES WHICH
;;        IS TO BE PRINTED AT THE BEGINNING OF EACH COMMAND
;;        LINE AS A PROMPT TO THE OPERATOR.
;; 'ERR'    CHARACTER OR STRING ENCLOSED IN SINGLE QUOTES WHICH
;;        IS TO BE PRINTED IN THE EVENT AN INPUT COMMAND DOES
;;        NOT MATCH THOSE FOUND IN THE TABLE.
;; IBUF        ADDRESS OF INPUT LINE BUFFER.
;;        DEFAULT IS 80H.
;; LEN        LENGTH OF INPUT LINE BUFFER.  SHOULD BE COMPUTED AS
;;        THE MAXIMUM LENGTH OF INPUT EXPECTED + 20.
;;        DEFAULT LENGTH IS 80H.
;; <COMS>    LIST OF VALID COMMAND WORDS WHICH ARE TO BE
;;        PLACED IN THE LOOK UP TABLE.  WORDS CAN BE OF ANY
;;        LENGTH.  ANY NUMBER OF WORDS CAN BE PRESENT.  WORDS
;;        MUST EVALUATE TO LABELS USED ELSEWARE IN THE
;;        PROGRAM.  LIST OF WORDS MUST BE ENCLOSED IN <> AND
;;        MUST BE SEPARATED BY COMMAS.  EXAMPLE <COM1,COM2,COM3>
;; ACON        SEE PARAM MACRO.  IF ACON = '0' PARAM WILL NOT BE
;;        EXPANDED.
;;
COMAND    MACRO    PROMPT,ERR,IBUF,LEN,COMS,ACON
    IF    NOT NUL IBUF
@LINPT    SET    IBUF
@BUF    SET    IBUF+2
    ELSE
@LINPT    SET    080H
@BUF    SET    082H
    ENDIF
    IF    NUL LEN
@LONG    SET    80H
    ELSE
@LONG    SET    LEN
    ENDIF
    LOCAL    INT1,INT2,INT3,INT4,INT5
    JMP    @MAIN    ;;BYPASS ERROR MESSAGE
EROR    CRLF
    PRINT    ERR
@MAIN    LXI    SP,STACK    ;;STACK DEFINED ELSEWARE
    LXI    H,@MAIN    ;;SET RETURN ADDRESS
    PUSH    H
INT1    CRLF        ;;DO A CRLF
    PRINT    PROMPT,S    ;;PRINT PROMPT AND SUPRESS CRLF
    LXI    D,@BUF    ;;POINT TO BUFFER
    MVI    A,@LONG    ;;SET BUFFER LENGTH
    STAX    D
    MVI    C,@BIN
    CALL    @BDOS
    LXI    H,@BUF+1    ;;TEST FOR INPUT
    MOV    A,M
    ORA    A
    RZ
    MVI    D,0
    MOV    E,A
    DAD    D
    INX    H
    MOV    M,D    ;;PLACE 0 AT END OF INPUT LINE
    LXI    H,CTABLE    ;;POINT TO TABLE
    JMP    INT3
INT2    MOV    A,M    ;;STEP TO END OF COMMAND
    ORA    A
    INX    H
    JNZ    INT2
    INX    H
    INX    H    ;;STEP PAST ADDRESS
INT3    LXI    D,@BUF+2    ;;POINT TO WORD
    MOV    A,M
    ORA    A    ;;TEST FOR END OF TABLE
    JZ    EROR
INT4    LDAX    D    ;;GET CHARACTER FROM BUFFER
    CPI    '@'    ;;IS IT A LETTER
    JC    INT5
    ANI    0DFH    ;;IF SO MAKE IT CAPITAL
INT5    CMP    M    ;;COMPARE TO TABLE
    JNZ    INT2
    INX    H
    INX    D
    MOV    A,M
    ORA    A
    JNZ    INT4    ;;JUMP IF NOT END OF WORD
    INX    H
    MOV    A,M
    INX    H
    MOV    H,M
    MOV    L,A
    XCHG
    SHLD    @LINPT
    XCHG
    PUSH    H
    CRLF
    POP    H
    PCHL
CTABLE    IRP    C?,<COMS&>
    DB    'C?&',0
    DW    @&C?
    ENDM
    DB    0
    IRPC    B?,ACON
    IF    NOT('B?&'='0')
    PARAM    @LINPT,ACON,EROR
    ENDIF
    EXITM
    ENDM
    ENDM
;;
;;
;;
;; THIS MACRO EXTRACTS THE BINARY VALUE FROM A STRING OF CHARACTERS.
;; THE STRING OF CHARACTERS MUST BE OF THE FORM
;;    XXX:Y    OR   XXX
;; WHERE X IS AN ASCII CHARACTER FROM '0' THRU '9' OR 'A' THRU 'F'
;; DEPENDING ON THE VALUE OF Y OR THE DEFAULT CONVERSION BASE.
;; : IS THE OPTIONAL BASE DELIMITER
;; Y IS THE OPTIONAL CONVERSION BASE
;; THE PARAMETERS PASSED TO THE MACRO ARE:
;; ADR        ADDRESS OF POINTER TO BUFFER CONTAINING ASCII
;;        REPRESENTATION OF NUMBERS TO BE CONVERTED.
;; ACON        ALLOWED CONVERSION BASES AS FOLLOWS
;;        H=HEX        (0-FFFF)
;;        B=BINARY    (0-1111111111111111)
;;        O=OCTAL        (0-177777)
;;        D=DECIMAL    (0-65535)
;;        THE LEADING BASE IS ASSUMED TO BE THE DEFAULT BASE.
;;        EXAMPLE - IF "HOD" IS PASSED TO ACON - HEX, OCTAL
;;        AND DECIMAL WILL BE ALLOWED.  HEX WILL BE THE DEFAULT
;;        BASE.  (THAT IS ANY NUMBERS WHICH ARE NOT FOLLOWED BY
;;        A BASE DELIMITER AND CONVERSION BASE WILL BE ASSUMED
;;        IN THIS CASE TO BE HEX.)
;; ERR        ADDRESS OR LABEL OF ROUTINE TO PASS CONTROL TO
;;        IN THE EVENT OF AN ERROR IN THE CONVERSION ROUTINE.
;;        DEFAULT WILL RETURN TO THE CALLING PROGRAM WITH
;;        CARRY SET.
;; ON RETURN TO THE CALLING PROGRAM THE FOLLOWING FLAGS APPLY:
;; CARRY SET    AN ERROR WAS FOUND IN EITHER THE FORMAT OF THE
;;        CHARACTERS IN THE BUFFER OR THE NUMBER WAS OUT OF
;;        BOUNDS (ABOVE).
;; CARRY CLEAR    NO ERROR FOUND AND THE FOLLOWING APPLY:
;;        ZERO SET    TRY TO READ PAST END OF BUFFER.
;;                ZERO WILL NOT BE SET IF A VALID NUMBER
;;                WAS FOUND.
;;        A=FF        NULL ENTRY FOUND.  EXAMPLE -
;;                2345,64FF,,6778  THE THIRD ENTRY
;;                IS A NULL ENTRY.
;;        HL=VALUE    THIS IS ONLY VALID IF A<>FF AND
;;                THE ZERO IS NOT SET.
;;
;;
PARAM    MACRO    ADR,ACON,ERR
    LOCAL    INT1,INT2,INT3,INT4,INT5,INT6,INT7
    IF    NOT NUL ERR
INT1    RNC        ;;RETURN IF NO ERROR
    JMP    ERR
@PARAM    LXI    H,INT1    ;;SET ERROR TRAP
    PUSH    H
    ELSE
@PARAM
    ENDIF
    LHLD    ADR    ;;GET POINTER TO BUFFER
    MOV    D,H
    MOV    E,L
    MVI    B,0
    CALL    @ADVAN    ;;POINT TO FIRST NON BLANK
    ORA    A    ;;TEST FOR END OF LINE
    RZ
    CPI    ','    ;;TEST FOR NULL ENTRY
    JNZ    INT2
    MVI    A,0FFH    ;;SET NULL ENTRY FLAG
    ORA    A    ;;CLEAR CARRY
    INX    H
    SHLD    ADR    ;;SAVE POINTER
    RET
INT2    CPI    '-'    ;;NEGATIVE NUMBER?
    JNZ    INT3
    MOV    B,A    ;;SAVE NEG FLAG
    CALL    @ADVAN-1    ;;POINT NEXT
INT3    HEXBI        ;;IS THIS A HEX DIGIT
    RC        ;;RET IF NOT
INT4    CALL    @ADVAN    ;;GET THE CHARACTER
    STAX    D
    INX    D
    INX    H
    CALL    @ADVAN    ;;GET THE NEXT CHARACTER
    HEXBI        ;;HEX CHARACTER?
    JNC    INT4
    IF    NUL ACON    ;;SET DEFAULT CONVERSION BASE
    MVI    C,'H'
    ELSE
    IRPC    B?,ACON
    MVI    C,'B?&'
    EXITM
    ENDM
    ENDIF
    CALL    @ADVAN    ;;GET NEXT NON BLANK CHARACTER
    CPI    ':'    ;;BASE DELIMITER?
    JNZ    INT5
    CALL    @ADVAN-1
    MOV    C,A    ;;GET CONVERSION BASE
    CALL    @ADVAN-1
INT5    ORA    A    ;;END OF LINE?
    JZ    INT6
    CPI    ','    ;;END OF NUMBER
    STC        ;;SET ERROR FLAG
    RNZ
    INX    H
INT6    XCHG        ;;SAVE HL
    MOV    M,B    ;;SET END OF NUMBER EITHER 0 OR '-'
    LHLD    ADR    ;;GET POINTER TO START OF NUMBER
    XCHG        ;;PUT IT TO DE
    SHLD    ADR    ;;SAVE LINE POINTER
    MOV    A,C    ;;GET CON
    CPI    '@'    ;;BE SURE IT'S A CAP
    JC    INT7
    ANI    0DFH
INT7    IF    NUL ACON    ;;BUILD JUMP TABLE FOR CONVERSION BASES
    CPI    'H'
    JZ    @HCON    ;;THIS IS DEFAULT
    ELSE
    IRPC    B?,ACON
    CPI    'B?&'
    JZ    @&B?&CON
    ENDM
    ENDIF
    STC        ;;IF NO MATCH IN JUMP TABLE
    RET        ;;ERROR AND RETURN
    INX    H
@ADVAN    MOV    A,M
    CPI    ' '
    RNZ
    JMP    @ADVAN-1
;;BUILD CONVERSION ROUTINES
    IF    NUL ACON
    @CONV    <H>
    ELSE
    @CONV    ACON
    ENDIF
PARAM    MACRO
    CALL    @PARAM
    ENDM
    ENDM
@CONV    MACRO    ACB
    IRPC    B?,ACB&
    LOCAL    INT1,INT2,MAX
MAX    SET    8
@&B?&CON    LXI    H,0    ;;CLEAR    HL TO RECEIVE RESULT
INT1    LDAX    D    ;;GET A CHARACTER
    ORA    A    ;;TEST FOR END OF LINE
    JNZ    INT2
    INR    A    ;;CLEAR THE ZERO FLAG
    RET
INT2    CPI    '-'    ;;IS THIS NUMBER NEGATIVE
    JZ    @NEG
    HEXBI        ;;EXTRACT VALUE FROM CHARACTER
    RC
    IF    'B?&'='D'
MAX    SET    10
    MOV    B,H
    MOV    C,L
    ENDIF
    DAD    H
    RC        ;;ALWAYS RETURN IF OVERFLOW
    IF    NOT('B?&'='B')
    DAD    H
    RC
    IF    'B?&'='H'
MAX    SET    16
    DAD    H
    RC
    ENDIF
    IF    'B?&'='D'
    DAD    B
    RC
    ENDIF
    DAD    H
    RC
    ELSE
MAX    SET    2
    ENDIF
    CPI    MAX
    CMC
    RC        ;;IS THE DIGIT GREATER THAN MAX ALLOWED
    MOV    C,A
    MVI    B,0
    DAD    B
    RC
    INX    D
    JMP    INT1
    ENDM
@NEG    MOV    A,H    ;;GENERATE 2'S COMPLEMENT
    CMA
    MOV    H,A
    MOV    A,L
    CMA
    MOV    L,A
    INX    H
    RET
    ENDM
;;
;;
;; THIS MACRO TESTS A CHARACTER 'C' FOR '0'<=C<='9' OR 'A'<=C<='F'
;; ON RETURN CARRY CLEAR = TRUE AND THE A REGISTER CONTAINS
;; THE BINARY VALUE OF THE HEX DIGIT.
;;
;;
HEXBI    MACRO
    LOCAL    AROUND,INT1
    JMP    AROUND
@HEXBI    CPI    '@'
    JC    INT1
    ANI    0DFH    ;;MAKE IT A CAP
INT1    SUI    30H
    RC
    CPI    0AH
    CMC
    RNC
    SUI    07H
    CPI    0AH
    RC
    CPI    10H
    CMC
    RET
AROUND
HEXBI    MACRO
    CALL    @HEXBI
    ENDM
    HEXBI
    ENDM