Trailing-Edge
-
PDP-10 Archives
-
decuslib20-06
-
decus/20-153/dsply.mac
There is 1 other file named dsply.mac in the archive. Click here to see a list.
TITLE DSPLY for RPGLIB V1
SUBTTL Display and/or accept an item
; DSPLY for RPGLIB V1
;
; Copyright (C) 1976, Bob Currier and Cerritos College
; All rights reserved
;
;
; This routine implements the DSPLY verb for the runtime system.
; It will display up to two items and accept one.
;
;
; Call:
; MOVEI 16,parameter.address
; PUSHJ 17,DSPLY
;
; Parameters:
; Word 1: Byte pointer to Factor 1 or zero if none
; Word 2: Byte pointer to Result or zero if none
; Word 3:
; Bit 0: Factor 1 is numeric
; Bit 1: Result is numeric
; Bits 2-3: Unused
; Bits 4-10: Size of factor 1
; Bits 11-17: Size of result
; Bits 18-35: Link to OTFTAB item for display file
; Word 4:
; Bits 0-3: Decimal places of factor 1
; Bits 4-7: Decimal places of result
; Bits 8-35: Unused
;
; Returns:
; Call+1 always
;
;
SEARCH RPGPRM, RPGSWI, MACTEN, UUOSYM
%%LBLP==:%%LBLP
DEBUG==:DEBUG
BIS==:BIS
EXTERN EASTB. ; force EASTBL to be loaded
SALL
TWOSEG
RELOC 400000
ENTRY DSPLY.
IPTR==IPTR ; input pointer
OPTR==OPTR ; output pointer
CNT==CNT ; count
PP==PP ; push/pop
CH==CH ; I/O character
PARM==PARM ; parameter address
SW==0 ; for RPGSWI
T1==TAC2 ; temp
T2==TAC3 ; temp
CNTD==TAC4 ; decimal count
C==TAC5 ; CBLIO communication (MUST be AC11)
DSPLY.: SKIPN IPTR,(PARM) ; pick up pointer to op1
JRST DSPLY1 ; no such animal
LDB CNT,F1SIZ. ; get size
LDB CNTD,F1DEC. ; get decimal count
LDB T1,F1NUM. ; get numeric flag
PUSHJ PP,DISPLY ; go try it
PUSHJ PP,DSPL1. ; output <CRLF> and buffer
DSPLY1: SKIPN IPTR,1(PARM) ; get pointer to result field
POPJ PP, ; exit if none
LDB CNT,F2SIZ. ; get size
LDB CNTD,F2DEC. ; get decimals
LDB T1,F2NUM. ; get numeric flag
PUSHJ PP,DISPLY ; display it
PUSHJ PP,DSPL1.## ; output <CRLF> and buffer
MOVE IPTR,1(PARM) ; get pointer back for accept
LDB CNT,F2SIZ. ; and size
LDB CNTD,F2DEC. ; and decimals
LDB T1,F2NUM. ; and numeric flag
PJRST ACCEPT ; try an accept
;DISPLY Actual disply routine
;
;
;
DISPLY: JUMPN T1,DISNUM ; go do numeric elsewhere
LDB T1,PTIBS. ; get input byte size
DIS.1: JUMPE CNT,DISN.2 ; if none left try decimals
ILDB CH,IPTR ; get a character
XCT CNVTB.-6(T1) ; convert to ASCII
MOVE C,CH ; get into correct AC for CBLIO
PUSHJ PP,OUTCH.## ; call CBLIO routine
SOJG CNT,DIS.1 ; loop until done
POPJ PP, ; then exit
;Display a numeric item
DISNUM: IBP IPTR ; numeric is a bit strange
SUB CNT,CNTD ; get number of non-decimal chars
SWOFF FNEGTV; ; turn off negative flag
LDB T1,PTIBS. ; get byte size
DISN.1: JUMPE CNT,DISN.2 ; exit if no more non-decimal digits
LDB CH,IPTR ; get a character
XCT CNVTB.-6(T1) ; convert to ASCII
CAIN CH," " ; a leading space?
SOJA CNT,DISN.1 ; yes - ignore
CAIN CH,"0" ; a leading zero?
SOJA CNT,DISN.1 ; yes -
DISN.4: CVTSNM 7,CH,CH ; convert char to digit
TLZE CH,(1B0) ; overpunched "-" ?
TSWC FNEGTV; ; yes - complement flag
MOVE C,CH ; get into proper AC
PUSHJ PP,OUTCH. ; output it
SOJLE CNT,DISN.2 ; off to decimal routine when done
ILDB CH,IPTR ; else get another character
XCT CNVTB.-6(T1) ; to ASCII
JRST DISN.4 ; and loop
DISN.2: JUMPE CNTD,RET.1 ; exit if no decimal places
MOVEI C,"." ; else get point
PUSHJ PP,OUTCH. ; and output it
DISN.3: ILDB CH,IPTR ; get character
XCT CNVTB.-6(T1) ; convert
CVTSNM 7,CH,CH ; to digit
TLZE CH,(1B0) ; overpunch?
TSWC FNEGTV; ; yes -
MOVE C,CH ; get into proper AC
PUSHJ PP,OUTCH. ; output
SOJG CNTD,DISN.3 ; loop until done
TSWT FNEGTV; ; negative number?
POPJ PP, ; No
MOVEI C,"-" ; yes - get minus flag
PJRST OUTCH. ; and output
;ACCEPT Accept an arbitrary field
;
;
;
ACCEPT: JUMPN T1,ACCNUM ; is numeric go do it elsewhere
LDB T1,PTIBS. ; get input byte size
PUSHJ PP,GETCH. ; get a character
POPJ PP, ; if just EOL don't modify anything
JRST ACC.1+2 ; else start it
ACC.1: PUSHJ PP,GETCH. ; get a character from the keyboard
JRST ACC.3 ; hit EOL
MOVE CH,C ; get into proper AC
XCT .CNVTB-6(T1) ; convert to whatever
IDPB CH,IPTR ; output
SOJG CNT,ACC.1 ; loop until done or EOL
ACC.2: PUSHJ PP,GETCH. ; get until EOL
POPJ PP, ; EOL - exit
JRST ACC.2 ; loop
ACC.3: MOVEI CH," " ; get a space
XCT .CNVTB-6(T1) ; convert to random
IDPB CH,IPTR ; stash character
SOJG CNT,.-1 ; keep outputting spaces to fill field
POPJ PP, ; and exit when done
;ACCNUM Accept a numeric field
;
;
;
ACCNUM: LDB T1,PTIBS. ; get byte size
SETZ T2, ; zap digit counter
SWOFF FNEGTV; ; not negative to start
MOVE OPTR,LPNT. ; get pointer to temp save buffer
ACCN.1: PUSHJ PP,GETCH. ; get a character
POPJ PP, ; if just a <CR> don't do anything
MOVE CH,C ; get into good AC
CAIN CH," " ; leading space?
JRST ACCN.1 ; yes - ignore
CAIN CH,"0" ; zero?
JRST ACCN.1 ; yes - ignore
ACCN.2: CAIL CH,"0" ; valid digit?
CAILE CH,"9" ; i.e. 0-9?
JRST ACCN.3 ; no - could be decimal point or -
IDPB CH,OPTR ; yes - stash in temp buffer
ADDI T2,1 ; bump count
PUSHJ PP,GETCH. ; get another character
JRST ACCN.8 ; EOL means end of number
MOVE CH,C ; get into good AC
JRST ACCN.2 ; and loop
ACCN.3: CAIE CH,"." ; decimal point?
JRST ACCN.7 ; no - could still be "-"
SUB CNT,CNTD ; get none decimal place count
CAMLE T2,CNT ; did we get more than that?
JRST ACCN.9 ; yes - error
SUB CNT,T2 ; no - get number of digits we didn't get
PUSHJ PP,ZROUT ; output that many zeroes
PUSHJ PP,T2OUT ; now output (T2) chars to data area
SETZ T2, ; reset count
MOVE OPTR,LPNT. ; reinitialize byte pointer to save area
;ACCNUM (cont'd)
;
;
;
ACCN.4: PUSHJ PP,GETCH. ; get a decimal digit
JRST ACCN.6 ; hit EOL
MOVE CH,C ; get into proper AC
CAIL CH,"0" ; is it valid digit?
CAILE CH,"9" ;
JRST ACCN.5 ; no - could be "-"
IDPB CH,OPTR ; stash character
AOJA T2,ACCN.4 ; bump count and loop
ACCN.5: CAIE CH,"-" ; was that a "-" we got fed?
JRST ACCN.9 ; no - error
SWON FNEGTV; ; turn on negative flag
PUSHJ PP,GETCH. ; get another character
JRST ACCN.6 ; make sure we get only EOL after "-"
JRST ACCN.9 ; but we didn't - so is error
ACCN.6: CAMLE T2,CNTD ; did we get too many digits?
JRST ACCN.9 ; looks that way
PUSHJ PP,T2OUT ; no - output buffer to data area
MOVE CNT,CNTD ; get decimal count
SUB CNT,T2 ; get number of digits we need to zap
PUSHJ PP,ZROUT ; and zero them
ACCN6B: TSWT FNEGTV; ; minus field?
POPJ PP, ; no - then we're all done
LDB CH,IPTR ; yes - get back last character
SUB CH,NUMTB.-6(T1) ; convert to real digit
MOVE CH,SGNTB.(CH) ; get character with overpunched "-"
XCT .CNVTB-6(T1) ; convert from ASCII
DPB CH,IPTR ; replace character
POPJ PP, ; end exit
ACCN.7: CAIE CH,"-" ; did we get a minus?
JRST ACCN.9 ; No - error
SWON FNEGTV; ; yes - flag it
PUSHJ PP,GETCH. ; get another character
JRST ACCN.8 ; is EOL - all is OK
JRST ACCN.9 ; is garbage - error
;ACCNUM (cont'd)
;
;
;
ACCN.8: SUB CNT,CNTD ; get non-decimal positions
CAMLE T2,CNT ; all ok size wise?
JRST ACCN.9 ; no - error
SUB CNT,T2 ; yes - get left over size
PUSHJ PP,ZROUT ; output that many zeroes as filler
PUSHJ PP,T2OUT ; transfer real digits
MOVE CNT,CNTD ; get number of decimals
PUSHJ PP,ZROUT ; output that many zeroes
JRST ACCN6B ; and check for minus signs
ACCN.9: PUSHJ PP,%%H.1Y## ; error on display
POP PP,T1 ; pop off return address in case of continue
JRST DSPLY. ; and start all over again
;ZROUT Output (CNT) zeroes through IPTR
;
;
;
ZROUT: JUMPE CNT,RET.1 ; don't do anything if zero
MOVEI CH,"0" ; get a zero
XCT .CNVTB-6(T1) ; convert to whatever
IDPB CH,IPTR ; output
SOJG CNT,.-1 ; loop until all put out
POPJ PP, ; then exit
;T2OUT Output (T2) characters through IPTR
;
;Does not destroy T2
;
;
T2OUT: JUMPE T2,RET.1 ; just exit if zero
MOVE CNT,T2 ; get into ok to destroy AC
MOVE OPTR,LPNT. ; get pointer to save buffer
ILDB CH,OPTR ; get saved character
XCT .CNVTB-6(T1) ; convert to special
IDPB CH,IPTR ; stash into data item
SOJG CNT,.-3 ; loop until done
POPJ PP, ; then exit
;Define pointers and such
;
;
;Define pointers to UUO parameters
;
F1SIZ.: POINT 7,2(PARM),10 ; size of factor 1
F2SIZ.: POINT 7,2(PARM),17 ; size of result
F1DEC.: POINT 4,3(PARM),3 ; decimal places of factor 1
F2DEC.: POINT 4,3(PARM),7 ; decimal places of result
F1NUM.: POINT 1,2(PARM),0 ; factor 1 numeric flag
F2NUM.: POINT 1,2(PARM),1 ; result numeric flag
LPNT.: POINT 7,LPSBUF## ; pointer to save buffer
;Define conversion tables
CNVTB.: LDB CH,PTR67.## ; sixbit to ASCII
JFCL ; ASCII to ASCII
Z ;
LDB CH,PTR97.## ; EBCDIC to ASCII
.CNVTB: LDB CH,PTR76.## ; ASCII to sixbit
JFCL ; ASCII to ASCII
Z ;
LDB CH,PTR79.## ; ASCII to EBCDIC
;Define sign tables
NUMTB.: EXP 20 ; SIXBIT zero
EXP 60 ; ASCII zero
EXP 0 ;
EXP 360 ; EBCDIC zero
SGNTB.: EXP "]" ; -0
EXP "J" ; -1
EXP "K" ; -2
EXP "L" ; -3
EXP "M" ; -4
EXP "N" ; -5
EXP "O" ; -6
EXP "P" ; -7
EXP "Q" ; -8
EXP "R" ; -9
;Define externals
EXTERN PTIBS., GETCH., RET.1
END