TITLE 'SCRRTN - SCREEN HANDLER SUBROUTINES'
;PROGRAM
; SCRNRTN - SCREEN HANDLER SUBROUTINES
;PROGRAMMER
; ROBERT M. WHITE
;DATE WRITTEN
; DECEMBER 1, 1980
;(C)COPYRIGHT 1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
; THIS SET OF SUBROUTINES GIVE THE USER VARIOUS
; SCREEN PROCESSING SUBROUTINES LIKE CLEAR, ERASE-
; TO-END-OF-LINE, ETC.
;REMARKS
; 1. SEE EACH ROUTINE FOR A DESCRIPTION OF WHAT
; IT DOES.
; 2. THESE ROUTINES WERE MEANT TO BE UTILIZED WITH
; THE PL/I-80 SYSTEM DISTRIBUTED BY DIGITAL
; RESEARCH OF CALIFORNIA.
; 3. ALL ROUTINES ASSUME THAT THE CP/M CONSOLE IS
; A VIDEO DEVICE SUCH AS A SOROC-120 OR TRS-80.
PAGE
;***********************************************************
;* GET A CHARACTER FROM THE CONSOLE W/O WAIT *
;***********************************************************
; PERFORM CONSOLE INPUT, CHAR RETURNED IN STACK,
; 000H IF NO CHAR
CONINP:
PUBLIC CONINP
MVI E,0FFH ;SET FOR INPUT.
MVI C,6 ;GET IT.
CALL BDOS
POP H ;RETURN ADDRESS
PUSH PSW ;CHARACTER TO STACK
INX SP ;DELETE FLAGS
MVI A,1 ;CHARACTER LENGTH IS 1
PCHL ;BACK TO CALLING ROUTINE
;***********************************************************
;* PUT A CHARACTER TO THE CONSOLE. *
;***********************************************************
; DIRECT CONSOLE OUTPUT
; 1->CHAR(1)
CONOUT:
PUBLIC CONOUT
CALL GETP1 ;GET PARAMETER
MVI C,6 ;DIRECT CONSOLE I/O
JMP ?BDOS ;DO IT AND RETURN.
EXTRN ?BDOS
;***********************************************************
;* *
;* GENERAL PURPOSE ROUTINES USED UPON ENTRY *
;* *
;***********************************************************
;
; GET SINGLE BYTE PARAMETER TO REGISTER E
GETP1:
MOV E,M ;LOW (ADDR)
INX H
MOV D,M ;HIGH(ADDR)
XCHG ;HL = .CHAR
MOV E,M ;TO REGISTER DE
INX H
MOV D,M
RET
PAGE
;****************************************************************
;* CHRINP/CHROUT - CHARACTER I/O ROUTINES *
;****************************************************************
;PROGRAM
; CHRINP/CHROUT - CHARACTER I/O ROUTINES
;PROGRAMMER
; ROBERT M. WHITE
;DATE WRITTEN
; AUGUST 4, 1980
;(C)COPYRIGHT 1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
; THESE ROUTINES GET OR PUT A CHARACTER FROM/TO THE
; VIDEO TERMINAL.
;REMARKS
; 1. FOR INTERNAL USE ONLY.
; GET A CHARACTER.
CHRINP:
PUSH B ;SAVE REGISTERS.
PUSH D
PUSH H
CHRINP$LOOP:
MVI E,0FFH ;SET FOR INPUT.
MVI C,6 ;GET IT.
CALL BDOS
ORA A ;CHARACTER AVAILABLE?
JZ CHRINP$LOOP ;...NO.
POP H ;RESTORE REGS.
POP D
POP B
RET ;RETURN TO CALLER.
; PUT A CHARACTER.
CHROUT:
PUSH B ;SAVE REGISTERS.
PUSH D
PUSH H
MOV E,A ;GET THE CHAR.
MVI C,6 ;OUTPUT IT.
CALL BDOS
POP H ;RESTORE REGS.
POP D
POP B
RET ;RETURN TO CALLER.
; PUT A STRING.
STROUT:
PUBLIC STROUT
MOV C,M ;GET ITS LENGTH.
INX H
STROUT$LOOP:
MOV A,M ;OUTPUT A CHAR.
CALL CHROUT
INX H ;BUMP PTR.
DCR C ;DECR COUNT.
JNZ STROUT$LOOP ;LOOP FOR ALL CHARS.
RET ;RETURN TO CALLER.
PAGE
;****************************************************************
;* CLRSCR - CLEAR THE SCREEN *
;****************************************************************
;PROGRAM
; CLRSCR - CLEAR THE SCREEN
;PROGRAMMER
; ROBERT M. WHITE
;DATE WRITTEN
; DECEMBER 1, 1980
;(C)COPYRIGHT 1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
; THIS SUBROUTINE CLEARS THE VIDEO SCREEN HOMING
; THE CURSOR.
;INPUT
; NONE
;REMARKS
; DO INITIALIZATION.
CLRSCR:
PUBLIC CLRSCR
; DO IT.
IF SOROC$120
CALL $+3+6
DB 5,01BH,02AH,000H,000H,000H
POP H
JMP STROUT
ENDIF
IF ADM3A
MVI A,01AH
JMP CHROUT
ENDIF
PAGE
;****************************************************************
;* EOL - ERASE TO END OF LINE *
;****************************************************************
;PROGRAM
; TERMINAL ERASE LINE PROGRAM
;PROGRAMMER
; ROBERT M. WHITE
;DATE WRITTEN
; AUGUST 4, 1980
;(C)COPYRIGHT 1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
; THIS ROUTINE ERASES A LINE ON THE CP/M CONSOLE.
;INPUT
; HL <= PL/1 PARAMETER LIST (2 PARMS)
; PARM1 = X COORDINATE
; PARM2 = Y COORDINATE
;OUTPUT
;REMARKS
; DO INITIALIZATION.
EOL:
PUBLIC EOL
; SET THE CURSOR.
CALL GOTOXY
; ISSUE THE ERASE LINE COMMAND.
IF SOROC$120
CALL $+3+4
DB 3,01BH,054H,000H
POP H
JMP STROUT
ENDIF
IF ADM3A
MVI A,TRMCOL ;GET # OF REMAINING COLS.
SUB C
MOV C,A ;SAVE IT.
EOL$LOOP:
MVI A,' ' ;OUTPUT A BLANK.
CALL CHROUT
DCR C ;LOOP FOR REMAINING COLS.
JNZ EOL$LOOP
RET ;RETURN TO CALLER.
ENDIF
PAGE
;****************************************************************
;* GETB15 - GET A BINARY NUMBER (15 BIT) *
;****************************************************************
;PROGRAM
; GETB15 - GET A BINARY NUMBER (15 BIT)
;PROGRAMMER
; ROBERT M. WHITE
;DATE WRITTEN
; DECEMBER 1, 1980
;(C)COPYRIGHT 1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
; THIS ROUTINE PUTS A CHARACTER STRING
; TO A PARTICULAR (X,Y) COORDINATES.
;INPUT
; HL <= PL/1 PARAMETER LIST
; PARM1 = X COORDINATE
; PARM2 = Y COORDINATE
; PARM3 = BINARY NUMBER (RETURNED)
; PARM4 = LOW RANGE CHECK NUMBER
; PARM5 = HIGH RANGE CHECK NUMBER
; PARM6 = RETURN CODE
;REMARKS
; DO INITIALIZATION.
GETB15:
PUBLIC GETB15
MVI A,6 ;SET # OF PARMS.
CALL MOVPRM ;GET THE PARAMETER PTRS.
CALL SAVPRM ;SAVE THEM
; GET A SIX-BYTE STRING FROM CONSOLE.
GETB15$BGN:
LXI H,CONSIX ;PASS ON STRING LENGTH.
SHLD PRM3PTR
LXI H,WRKSTR+1 ;PASS ON STRING AREA.
SHLD WRKPTR
LXI H,WRKPTR
SHLD PRM4PTR
LHLD PRM6PTR ;PASS ON RETURN CODE.
SHLD PRM5PTR
LXI H,PRMPTRS ;GET THE STRING.
CALL GETSTR
; CONVERT THE STRING TO A NUMBER.
MVI A,6 ;GET LENGTH.
LXI D,WRKSTR+1 ;POINT TO STRING.
CALL AB16 ;DO IT.
JNC GETB15$OK ;...CONVERSION ERROR.
GETB15$ERO:
MVI A,7 ;BEEP OPERATOR.
CALL CHROUT
JMP GETB15$BGN
GETB15$OK:
PUSH H ;SAVE THE NUMBER.
XCHG
LHLD WRK3PTR ;SAVE IT IN CALLER'S AREA.
MOV M,E
INX H
MOV M,D
; * * * RANGE CHECK IT * * *
; PUT LOW VALUE IN BC.
LHLD WRK4PTR ;GET PTR TO IT.
MOV C,M ;PUT IT IN BC.
INX H
MOV B,M
; PUT HIGH VALUE IN DE.
LHLD WRK5PTR ;GET PTR TO IT.
MOV E,M ;PUT IT IN DE.
INX H
MOV D,M
; IF BOTH ZERO, BYPASS CHECK.
MOV A,B ;ARE THEY ZERO?
ORA C
ORA D
ORA E
JZ GETB15$NCK ;...YES, SKIP CHECK.
; CHECK LOW RANGE.
POP H ;GET NUMBER.
PUSH H
MOV A,L ;SUBTRACT BC FROM IT.
SUB C
MOV A,H
SBB B
POP H
JC GETB15$ERO ;**TOO SMALL**
; CHECK HIGH RANGE.
PUSH H
MOV A,E ;SUBTRACT IT FROM DE.
SUB L
MOV A,D
SBB H
POP H
JC GETB15$ERO ;**TOO LARGE**
PUSH H
GETB15$NCK:
; PUT IT BACK TO SCREEN.
LXI H,WRKPTRS ;SET FOR ORIGINAL PARMS.
CALL PUTB15 ;DO IT.
; RETURN TO CALLER W/STRING.
POP H ;RETURN THE NUMBER.
MOV A,L
RET
PAGE
;****************************************************************
;* GETSTR - GET A CHARACTER STRING *
;****************************************************************
;PROGRAM
; GETSTR - GET A CHARACTER STRING
;PROGRAMMER
; ROBERT M. WHITE
;DATE WRITTEN
; DECEMBER 1, 1980
;(C)COPYRIGHT 1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
; THIS ROUTINE PUTS A CHARACTER STRING
; TO A PARTICULAR (X,Y) COORDINATES.
;INPUT
; HL <= PL/1 PARAMETER LIST
; PARM1 = X COORDINATE
; PARM2 = Y COORDINATE
; PARM3 = STRING LENGTH (MAXIMUM)
; PARM4 = PTR -> STRING AREA (RETURNED)
; PARM5 = RETURN CODE
;REMARKS
; DO INITIALIZATION.
GETSTR:
PUBLIC GETSTR
MVI A,5 ;SET FOR 5 PARMS.
CALL MOVPRM ;GET THE PARM PTRS.
; GET THE STRING LENGTH.
LHLD PRM3PTR ;GET ITS PTR.
MOV A,M ;GET STRING LENGTH.
ORA A ;IF ZERO,
RZ ;...SIMPLY RETURN.
CPI 80+1
RNC
; SET THE CURSOR.
GETSTR$BGN:
LXI H,PRMPTRS ;GET X,Y PTR.
CALL GOTOXY ;DO IT.
; FILL AREA WITH FIELD INDICATOR.
LHLD PRM3PTR ;GET SIZE OF AREA.
MOV C,M
GETSTR$INT:
MVI A,'_' ;OUTPUT CHAR.
CALL CHROUT
DCR C ;LOOP FOR ALL CHARS.
JNZ GETSTR$INT
; RESET THE CURSOR.
LXI H,PRMPTRS ;GET X,Y COORD.
CALL GOTOXY ;DO IT.
; INITIALIZE FOR INPUT LOOP.
MVI C,0 ;ZERO INPUT STRING LENGTH.
LXI H,PRM4PTR ;POINT TO STRING.
CALL GETP1
XCHG
; LOOP GETTING NEXT CHARACTER.
GETSTR$LOOP:
CALL CHRINP ;GET THE NEXT CHAR.
; CHECK FOR REMOVE-LAST-CHARACTER.
CPI 8 ;CTRL H(BS)?
JZ $+8 ;...YES, REMOVE LAST CHAR.
CPI 127 ;RUB?
JNZ GETSTR$RBB ;...NO, BYPASS THIS SECTION.
MOV A,C ;IF NO CHAR YET,
ORA A ;...BEEP OPERATOR.
JNZ GETSTR$RBC
GETSTR$ERR:
MVI A,7 ;BEEP OPERATOR.
CALL CHROUT
JMP GETSTR$LOOP ;GET NEXT CHARACTER.
GETSTR$RBC:
DCR C ;RUB THE CHARACTER.
DCX H
MVI A,8 ;REPLACE IT ON SCREEN.
CALL CHROUT
MVI A,'_'
CALL CHROUT
MVI A,8
CALL CHROUT
JMP GETSTR$LOOP ;GET NEXT CHARACTER.
GETSTR$RBB:
; ADD THE CHARACTER TO THE STRING.
PUSH PSW
PUSH H
LHLD PRM3PTR
MOV A,M ;TOO MANY CHARACTERS?
POP H
CMP C ;...NO, ADD IT.
JNZ GETSTR$CHA
POP PSW
JMP GETSTR$ERR ;BEEP OPERATOR.
GETSTR$CHA:
POP PSW
CPI 32 ;VALID CHAR?
JNC GETSTR$CHO ;...YES, ADD IT TO STRING.
JMP GETSTR$ERR ;BEEP OPERATOR.
GETSTR$CHO:
INR C ;BUMP COUNT.
MOV M,A ;SAVE THE CHARACTER.
INX H
CALL CHROUT ;ECHO THE CHARACTER.
JMP GETSTR$LOOP ;GET NEXT CHARACTER.
; ADD TRAILING SPACES TO THE STRING.
GETSTR$RTN:
PUSH H
LHLD PRM5PTR ;SET RETURN CODE.
MOV M,A
LHLD PRM3PTR ;GET LENGTH.
MOV A,M
POP H
SUB C ;GET NUMBER OF SPACES.
JZ GETSTR$ASB ;NONE, BYPASS.
MOV C,A
MVI M,' ' ;ADD A SPACE.
INX H
DCR C ;LOOP FOR ALL.
JNZ $-4
GETSTR$ASB:
; REWRITE THE STRING ON THE VIDEO.
LXI H,PRMPTRS ;POINT TO INPUT PARMS.
CALL PUTSTR ;PUT IT TO CONSOLE.
; RETURN TO CALLER.
RET
PAGE
;****************************************************************
;* GOTOXY - SET CURSOR TO (X,Y) COORDINATES *
;****************************************************************
;PROGRAM
; TERMINAL SET CURSOR PROGRAM
;PROGRAMMER
; ROBERT M. WHITE
;DATE WRITTEN
; AUGUST 4, 1980
;(C)COPYRIGHT 1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
; THIS ROUTINE SET THE CURSOR ON THE CP/M CONSOLE
; TO A PARTICULAR (X,Y) COORDINATES.
;REMARKS
; DO INITIALIZATION.
GOTOXY:
PUBLIC GOTOXY
; GET THE X COORDINATE.
MOV E,M ;GET X PTR.
INX H
MOV D,M
INX H
XCHG
MOV B,M
XCHG
; GET THE Y COORDINATE.
MOV E,M ;GET Y PTR.
INX H
MOV D,M
INX H
XCHG
MOV C,M
XCHG
; ISSUE SET CURSOR SEQUENCE.
IF SOROC$120
MVI A,01BH ;ISSUE <ESC>.
CALL CHROUT
MVI A,'=' ;ISSUE '='.
CALL CHROUT
MOV A,B ;ISSUE X COORDINATE.
ADI 31
CALL CHROUT
MOV A,C ;ISSUE Y COORDINATE.
ADI 31
CALL CHROUT
ENDIF
IF ADM3A
MVI A,01BH ;ISSUE <ESC>.
CALL CHROUT
MVI A,'=' ;ISSUE '='.
CALL CHROUT
MOV A,B ;ISSUE X COORDINATE.
ADI 31
CALL CHROUT
MOV A,C ;ISSUE Y COORDINATE.
ADI 31
CALL CHROUT
ENDIF
; RETURN TO CALLER.
RET ;RETURN TO CALLER.
PAGE
;****************************************************************
;* PUTB15 - PUT A BINARY NUMBER (15 BIT) *
;****************************************************************
;PROGRAM
; PUTB15 - PUT A BINARY NUMBER (15 BIT)
;PROGRAMMER
; ROBERT M. WHITE
;DATE WRITTEN
; DECEMBER 1, 1980
;(C)COPYRIGHT 1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
; THIS ROUTINE PUTS A CHARACTER STRING
; TO A PARTICULAR (X,Y) COORDINATES.
;INPUT
; HL <= PL/1 PARAMETER LIST
; PARM1 = X COORDINATE
; PARM2 = Y COORDINATE
; PARM3 = NUMBER TO BE PUT
;REMARKS
; DO INITIALIZATION.
PUTB15:
PUBLIC PUTB15
MVI A,3 ;SET FOR 3 PARMS.
CALL MOVPRM ;SAVE THE PTRS.
; MOVE IN CURSOR. POSITION IN.
LXI H,PRMPTRS
CALL GOTOXY ;DO IT.
; CONVERT THE NUMBER TO ASCII.
LHLD PRM3PTR ;GET THE INPUT NUMBER.
MOV E,M
INX H
MOV D,M
XCHG
LXI D,WRKSTR+1 ;POINT TO AREA.
CALL BA16 ;CONVERT IT.
; REMOVE LEADING ZEROES.
LXI H,WRKSTR+2
MVI C,4 ;LEAVE AT LEAST ONE.
MOV A,M ;IS IT A ZERO?
CPI '0'
JNZ $+10 ;...NO, SKIP REST.
MVI M,' ' ;...YES, BLANK IT.
INX H ;BUMP PTR.
DCR C ;DECR COUNT.
JNZ $-10 ;LOOP FOR ALL CHARS.
; PUT THE STRING TO THE SCREEN AND RETURN.
LXI H,WRKSTR
MVI M,6
JMP STROUT
PAGE
;****************************************************************
;* PUTMSG - PUT A VARYING CHARACTER STRING *
;****************************************************************
;PROGRAM
; PUTMSG - PUT A CHARACTER STRING TO THE SCREEN
;PROGRAMMER
; ROBERT M. WHITE
;DATE WRITTEN
; AUGUST 4, 1980
;(C)COPYRIGHT 1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
; THIS ROUTINE PUTS A CHARACTER STRING
; TO A PARTICULAR (X,Y) COORDINATES.
;INPUT
; HL <= PL/1 PARAMETER LIST
; PARM1 = X COORDINATE
; PARM2 = Y COORDINATE
; PARM3 = STRING
;REMARKS
; DO INITIALIZATION.
PUTMSG:
PUBLIC PUTMSG
; SET THE CURSOR.
PUSH H ;SAVE POINTER.
CALL GOTOXY ;DO IT.
POP H ;RESTORE POINTER.
; POINT TO THE STRING.
LXI D,4 ;BUMP OVER X,Y STUFF.
DAD D
MOV E,M ;GET POINTER TO STRING.
INX H
MOV D,M
XCHG ;PUT IT IN HL.
MOV A,M ;GET STRING LENGTH.
ORA A ;NULL STRING?
RZ ;...YES, RETURN.
; OUTPUT THE STRING AND RETURN.
JMP STROUT ;PUT IT.
PAGE
;****************************************************************
;* PUTSTR - PUT A VARYING CHARACTER STRING *
;****************************************************************
;PROGRAM
; PUTSTR - PUT A CHARACTER STRING TO THE SCREEN
;PROGRAMMER
; ROBERT M. WHITE
;DATE WRITTEN
; AUGUST 4, 1980
;(C)COPYRIGHT 1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
; THIS ROUTINE PUTS A CHARACTER STRING
; TO A PARTICULAR (X,Y) COORDINATES.
;INPUT
; HL <= PL/1 PARAMETER LIST
; PARM1 = X COORDINATE
; PARM2 = Y COORDINATE
; PARM3 = STRING LENGTH
; PARM4 = PTR -> STRING AREA
;REMARKS
; DO INITIALIZATION.
PUTSTR:
PUBLIC PUTSTR
MVI A,4 ;GET INPUT PARMS.
CALL MOVPRM
; SET THE CURSOR.
LXI H,PRMPTRS ;POINT TO COORDS.
CALL GOTOXY ;DO IT.
; GET ITS LENGTH.
LHLD PRM3PTR
MOV A,M ;GET STRING LENGTH.
ORA A ;NULL STRING?
RZ ;...YES, RETURN.
MOV C,A ;SAVE IT.
; POINT TO THE STRING.
PUSH B ;SAVE LENGTH.
LXI H,PRM4PTR ;GET IT.
CALL GETP1
XCHG
POP B ;RESTORE IT.
; OUTPUT THE STRING AND RETURN.
JMP STROUT$LOOP ;PUT IT.
PAGE
;****************************************************************
;* PUTD92 - PUT A DECIMAL NUMBER (9.2) *
;****************************************************************
;PROGRAM
; PUTD92 - PUT A DECIMAL NUMBER (9.2) TO THE SCREEN.
;PROGRAMMER
; ROBERT M. WHITE
;DATE WRITTEN
; APRIL 23, 1981
;(C)COPYRIGHT 1981,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
; THIS ROUTINE PUTS A DECIMAL NUMBER
; TO A PARTICULAR (X,Y) COORDINATES.
;INPUT
; HL <= PL/1 PARAMETER LIST
; PARM1 = X COORDINATE
; PARM2 = Y COORDINATE
; PARM3 = PTR -> DECIMAL NUMBER
;REMARKS
; DO INITIALIZATION.
PUTD92:
PUBLIC PUTD92
MVI A,3 ;GET INPUT PARMS.
CALL MOVPRM
; SET THE CURSOR.
LXI H,PRMPTRS ;POINT TO COORDS.
CALL GOTOXY ;DO IT.
; MOVE THE NUMBER TO THE WORK AREA.
LHLD PRM3PTR ;POINT TO THE NUMBER.
MOV E,M
INX H
MOV D,M
LXI H,WRKDEC ;POIN
T TO WORK AREA.
MVI C,5
PUTD92$LOOP:
LDAX D
MOV M,A
INX H
INX D
DCR C
JNZ PUTD92$LOOP
; SET THE SIGN.
LXI H,WRKDEC+4 ;POINT TO THE SIGN BYTE.
MOV A,M
ANI 0F0H
MVI A,' ' ;DEFAULT TO POSITIVE.
JZ $+5 ;...POSITIVE.
MVI A,'-'
STA WRKSGN ;SAVE IT.
; COMPLEMENT THE NUMBER IF NEGATIVE.
LXI H,WRKDEC ;POINT TO THE NUMBER.
CPI '-' ;IS IT NEGATIVE?
CZ CMPD92 ;...YES, COMPLEMENT THE NUMBER.
; UNPACK THE NUMBER AND EDIT IT.
LXI D,WRKSTR+14 ;POINT TO OUTPUT AREA.
LXI H,WRKDEC ;POINT TO THE NUMBER.
CALL UPKD92 ;UNPACK THE NUMBER.
XCHG
LXI D,WRKSTR+1 ;POINT TO OUTPUT AREA.
CALL EDTD92
; OUTPUT THE STRING AND RETURN.
LXI H,WRKSTR+1 ;POINT TO THE STRING.
MVI C,13 ;SET ITS LENGTH.
JMP STROUT$LOOP ;PUT IT.
;PROGRAM
; CONVERT ASCII TO BINARY (16 BIT).
;PROGRAMMER
; ROBERT M. WHITE
;DATE WRITTEN
; AUGUST 4, 1980
;(C)COPYRIGHT 1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
; THIS ROUTINE CONVERTS AN ASCII STRING TO A 16
; BIT BINARY NUMBER.
;REMARKS
; DO INITIALIZATION.
AB16:
PUSH B ;SAVE REGS.
PUSH D
MOV C,A ;SAVE STRING LENGTH.
LXI H,0 ;INITIALIZE NUMBER.
ORA A ;ANY INPUT?
JZ AB16E ;...NO, JUST RETURN ZERO.
; HANDLE SIGN IF ANY.
MVI B,0 ;DEFAULT TO PLUS.
LDAX D ;GET THE FIRST BYTE.
CPI '+' ;IS IT PLUS?
JZ AB16S ;...YES, ADJUST FOR IT.
CPI '-' ;IS IT MINUS?
JNZ AB16L ;...NO, SKIP SIGN.
MVI B,0FFH ;...YES.
AB16S:
INX D ;BUMP PTR.
DCR C ;DECR COUNT.
STC ;IF ONLY CHAR, RETURN W/ERROR.
JZ AB16E
; GET THE NEXT CHAR AND CHECK IT.
AB16L:
LDAX D ;GET IT.
CPI ' ' ;RETURN IF WE FOUND A BLANK.
JZ AB16R
SUI '0' ;REMOVE ASCII BIAS.
JC AB16E ;...ERROR.
CPI 9+1
CMC
JC AB16E ;...ERROR.
; MULTIPLY ACCUMULATOR BY 10.
PUSH D ;MULTIPLY HL BY 10.
DAD H ;*2
MOV E,L
MOV D,H
DAD H ;*4
DAD H ;*8
DAD D ;*10
POP D
; ACCUMULATE THE NUMBER.
ADD L
MOV L,A
JNC $+4
INR H
; BUMP PTRS AND LOOP FOR COUNT.
INX D ;BUMP INPUT PTR.
DCR C
JNZ AB16L ;LOOP FOR ALL CHARS.
ORA A ;RESET CY.
; IF NEG, COMPLEMENT NUMBER.
AB16R:
MOV A,B ;GET SIGN INDICATOR.
ORA A ;NEGATIVE?
JZ AB16E ;...NO.
MOV A,L ;COMPLEMENT HL.
CMA
MOV L,A
MOV A,H
CMA
MOV H,A
INX H ;FORCE 2'S COMPLEMENT.
; RETURN TO CALLER.
AB16E:
POP D ;RESTORE REGS.
POP B
RET ;RETURN TO CALLER.
;PROGRAM
; CONVERT BINARY (16 BIT) TO ASCII.
;PROGRAMMER
; ROBERT M. WHITE
;DATE WRITTEN
; AUGUST 4, 1980
;(C)COPYRIGHT 1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
; THIS ROUTINE CONVERTS AN 16 BIT BINARY NUMBER
; TO ASCII.
;REMARKS
; DO INITIALIZATION.
BA16:
PUSH B ;SAVE REGS.
PUSH D
PUSH H
; PUT SPACE FOR SIGN.
MVI A,' '
STAX D
INX D
; GET 10000 DIGIT.
PUSH D ;SUBTRACT OUT NUMBER.
LXI B,-10000
LXI D,-1
DAD B
INX D
JC $-2
LXI B,10000
DAD B
MOV A,E
POP D
ADI '0' ;ADD IN ASCII BIAS.
STAX D ;SAVE CHAR.
INX D ;BUMP PTR.
; GET 1000 DIGIT.
PUSH D ;SUBTRACT OUT NUMBER.
LXI B,-1000
LXI D,-1
DAD B
INX D
JC $-2
LXI B,1000
DAD B
MOV A,E
POP D
ADI '0' ;ADD IN ASCII BIAS.
STAX D ;SAVE CHAR.
INX D ;BUMP PTR.
; GET 100 DIGIT.
PUSH D ;SUBTRACT OUT NUMBER.
LXI B,-100
LXI D,-1
DAD B
INX D
JC $-2
LXI B,100
DAD B
MOV A,E
POP D
ADI '0' ;ADD IN ASCII BIAS.
STAX D ;SAVE CHAR.
INX D ;BUMP PTR.
; GET 10 DIGIT.
PUSH D ;SUBTRACT OUT NUMBER.
LXI B,-10
LXI D,-1
DAD B
INX D
JC $-2
LXI B,10
DAD B
MOV A,E
POP D
ADI '0' ;ADD IN ASCII BIAS.
STAX D ;SAVE CHAR.
INX D ;BUMP PTR.
; GET 1 DIGIT.
MOV A,L
ADI '0' ;ADD IN ASCII BIAS.
STAX D ;SAVE CHAR.
INX D ;BUMP PTR.
; RETURN TO CALLER.
POP H ;RESTORE REGS.
POP D
POP B
RET ;RETURN TO CALLER.
PAGE
;****************************************************************
;* ADDD92 - ADD A DECIMAL NUMBER (9.2) *
;****************************************************************
;PROGRAM
; PUTD92 - ADD A DECIMAL NUMBER (9.2) TO A CONSTANT.
;PROGRAMMER
; ROBERT M. WHITE
;DATE WRITTEN
; APRIL 23, 1981
;(C)COPYRIGHT 1981,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
; THIS ROUTINE ADDS A DECIMAL NUMBER
; WITH A CONSTANT.
;INPUT
; HL <= DECIMAL NUMBER
; A = CONSTANT
;REMARKS
; DO INITIALIZATION.
ADDD92:
PUSH H ;SAVE REGS.
PUSH B
; ADD CONSTANT TO FIRST BYTE.
ADD M ;DO IT.
DAA ;ADJUST FOR DECIMAL VALUE.
MOV M,A ;SAVE VALUE.
JNC ADDD92$END ;...NO CARRY.
; BUMP REST OF DIGITS FOR CARRY.
MVI C,4 ;SET MAX DIGITS.
ADDD92$LOOP:
INX H ;BUMP TO NEXT BYTE.
MOV A,M ;ADD 1 TO IT.
ADI 1
DAA
MOV M,A
JNC ADDD92$END
DCR C ;LOOP FOR REMAINING BYTES.
JNZ ADDD92$LOOP
; RETURN TO CALLER.
ADDD92$END:
POP B ;RESTORE REGS.
POP H
RET
PAGE
;****************************************************************
;* CMPD92 - COMPLEMENT A DECIMAL NUMBER (9.2) *
;****************************************************************
;PROGRAM
; PUTD92 - COMPLEMENT A DECIMAL NUMBER (9.2).
;PROGRAMMER
; ROBERT M. WHITE
;DATE WRITTEN
; APRIL 23, 1981
;(C)COPYRIGHT 1981,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
; THIS ROUTINE COMPLEMENTS A DECIMAL
; NUMBER USING 10'S COMPLEMENT.
;INPUT
; HL <= DECIMAL NUMBER
;REMARKS
; DO INITIALIZATION.
CMPD92:
PUSH H ;SAVE REGS.
PUSH B
; SUBTRACT ALL DIGITS FROM 9.
MVI C,5 ;SET MAX DIGITS.
CMPD92$LOOP:
MVI A,099H ;GET 9'S.
SUB M ;SUBTRACT DIGITS FROM IT.
DAA
MOV M,A
INX H ;BUMP PTR.
DCR C ;LOOP FOR REMAINING BYTES.
JNZ CMPD92$LOOP
; MAKE IT 10'S COMPLEMENT BY ADDING ONE TO IT
; AND RETURN TO CALLER.
POP B ;RESTORE REGS.
POP H
MVI A,1
JMP ADDD92
;PROGRAM
; EDTD92 - EDIT A DECIMAL NUMBER (9.2).
;PROGRAMMER
; ROBERT M. WHITE
;DATE WRITTEN
; APRIL 23, 1981
;(C)COPYRIGHT 1981,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
; THIS ROUTINE EDITS A DECIMAL NUMBER.
;INPUT
; HL <= DECIMAL NUMBER
; DE <= OUTPUT AREA (13 BYTES)
;REMARKS
; EDIT MASK = '-Z,ZZZ,ZZ9.99'
; DO INITIALIZATION.
EDTD92:
PUSH H ;SAVE REGS.
PUSH D
PUSH B
PUSH D ;SAVE OUTPUT PTR.
MVI A,' ' ;BLANK SIGN OUTPUT POSITION.
STAX D
; POINT TO END OF BOTH FIELDS.
PUSH D ;POINT TO END OF NUMBER.
LXI D,10-1
DAD D
POP D
PUSH H ;POINT TO END OF OUTPUT AREA.
LXI H,13-1
DAD D
XCHG
POP H
; GET LOW ORDER DIGITS.
MVI C,2 ;SET DECIMAL NUMBERS.
CALL EDTD92$DIGIT
MVI A,'.' ;SET DECIMAL POINT.
STAX D
DCX D
MOV A,M ;SET FIRST DIGIT.
STAX D
DCX H
DCX D
; GET NEXT TWO DIGITS.
MVI C,2
CALL EDTD92$DIGIT
; SET COMMA SEPERATOR.
MVI A,','
STAX D
DCX D
; GET NEXT THREE DIGITS.
MVI C,3
CALL EDTD92$DIGIT
; SET COMMA SEPERATOR.
MVI A,','
STAX D
DCX D
; GET LAST DIGITS.
MVI C,1
CALL EDTD92$DIGIT
; BLANK FILL FIRST 9 POSITIONS.
POP H ;POINT TO OUTPUT.
MVI C,8 ;SET FOR MAX OF 9 POSITIONS.
EDTD92$FILL:
INX H ;BUMP PTR.
MOV A,M ;GET THE BYTE.
CPI '0' ;IS IT ZERO?
JZ EDTD92$BLNK ;...YES, BLANK FILL.
CPI ',' ;IS IT A COMMA?
JNZ EDTD92$FLEN ;...NO, WE'RE DONE.
EDTD92$BLNK:
MVI M,' ' ;...YES, BLANK OUT THE CHAR.
DCR C ;LOOP FOR MAX CHARS.
JNZ EDTD92$FILL
EDTD92$FLEN:
; SET THE SIGN.
DCX H
LDA WRKSGN ;GET IT.
MOV M,A ;PUT IT IN OUTPUT.
; RETURN TO CALLER.
POP B ;RESTORE REGS.
POP D
POP H
RET
; GET NEXT DIGIT.
EDTD92$DIGIT:
EDTD92$LOOP:
MOV A,M ;GET THE NEXT BYTE.
STAX D ;...NO, ADD IT TO OUTPUT.
DCX H ;DECR PTRS.
DCX D
DCR C ;LOOP FOR REMAINING BYTES.
JNZ EDTD92$LOOP
;PROGRAM
; UPKD92 - UNPACK A DECIMAL NUMBER (9.2).
;PROGRAMMER
; ROBERT M. WHITE
;DATE WRITTEN
; APRIL 23, 1981
;(C)COPYRIGHT 1981,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
; THIS ROUTINE UNPACKS A DECIMAL NUMBER.
;INPUT
; HL <= DECIMAL NUMBER
; DE <= OUTPUT AREA
;REMARKS
; DO INITIALIZATION.
UPKD92:
PUSH H ;SAVE REGS.
PUSH D
PUSH B
; POINT TO LAST BYTE.
INX H
INX H
INX H
INX H
; EXPAND ALL BYTES.
MVI C,5 ;SET MAX DIGITS.
UPKD92$LOOP:
MOV A,M ;GET HIGH ORDER DIGIT.
RAR ;PUT HIGH ORDER DIGIT IN
RAR ;LOW ORDER DIGIT.
RAR
RAR
CALL UPKD92$DIGIT ;PUT THIS DIGIT.
MOV A,M ;GET LOW ORDER DIGIT.
CALL UPKD92$DIGIT ;PUT THIS DIGIT.
DCX H ;BUMP PTR.
DCR C ;LOOP FOR REMAINING BYTES.
JNZ UPKD92$LOOP
; RETURN TO CALLER.
POP B ;RESTORE REGS.
POP D
POP H
RET
; UNPACK A DIGIT.
UPKD92$DIGIT:
ANI 00FH ;LIMIT TO LOW ORDER DIGIT.
ADI '0' ;CONVERT IT TO ASCII.
STAX D ;SAVE IT.
INX D ;BUMP OUTPUT PTR.
RET
PAGE
;****************************************************************
;* MOVPRM - MOVE IN PARAMETER LIST *
;****************************************************************
;PROGRAM
; MOVE IN PL/1 PARAMETER.
;PROGRAMMER
; ROBERT M. WHITE
;DATE WRITTEN
; APRIL 11, 1981
;(C)COPYRIGHT 1981,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
; THIS ROUTINE MOVES IN THE PARAMETER LIST FROM
; PL/1.
;INPUT
; HL <= PL/1 PARAMETER LIST
; A = NUMBER OF PARAMETERS
;REMARKS
; DO INITIALIZATION.
MOVPRM:
PUSH B ;SAVE REGS.
PUSH D
PUSH H
SHLD PRMPTR ;SAVE PL/1 PRM LIST PTR.
ADD A ;CONVERT NUMBER OF PARMS
MOV C,A ;TO BYTES AND SAVE IT.
; MOVE THE PARAMETERS TO WORK AREA.
LXI D,PRMPTRS ;POINT TO PARAMETER LIST.
MOVPRM$LOOP:
MOV A,M ;GET A BYTE.
STAX D ;PUT THE BYTE.
INX D ;BUMP PTR.
INX H
DCR C ;LOOP FOR ALL PARMS.
JNZ MOVPRM$LOOP
; RETURN TO CALLER.
POP H ;RESTORE REGS.
POP D
POP B
RET ;RETURN TO CALLER.
PAGE
;****************************************************************
;* SAVPRM - SAVE THE PARAMETER LIST *
;****************************************************************
;PROGRAM
; SAVE THE PL/1 PARAMETER.
;PROGRAMMER
; ROBERT M. WHITE
;DATE WRITTEN
; APRIL 11, 1981
;(C)COPYRIGHT 1981,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
; THIS ROUTINE SAVES THE PARAMETER LIST FROM
; PL/1.
;INPUT
; NONE
;REMARKS
; DO INITIALIZATION.
SAVPRM:
PUSH B ;SAVE REGS.
PUSH D
PUSH H
; MOVE THE PARAMETERS TO WORK AREA.
MVI C,2*6
LXI D,WRKPTRS ;POINT TO PARAMETER LIST.
LXI H,PRMPTRS
SAVPRM$LOOP:
MOV A,M ;GET A BYTE.
STAX D ;PUT THE BYTE.
INX D ;BUMP PTR.
INX H
DCR C ;LOOP FOR ALL PARMS.
JNZ SAVPRM$LOOP
; RETURN TO CALLER.
POP H ;RESTORE REGS.
POP D
POP B
RET ;RETURN TO CALLER.
PAGE
;****************************************************************
;* DATA AREAS FOR ALL SUBROUTINES *
;****************************************************************
