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