[Copyright 1999,2002 Frank Durda IV, All Rights Reserved. Mirroring of any material on this page in any form is expressly prohibited. The official web site for this material is: http://nemesis.lonestar.org Contact this address for use clearances: clearance at nemesis.lonestar.org Comments and queries to this address: web_software_2011 at nemesis.lonestar.org]
MISOSYS EDAS-4.3 04/19/99 01:20:26 FORMS - LS-DOS 6.2 Page 00001
00001 ;LBFORMS/ASM - Set Line Printer Values
00003 ;
00004 ;
002C 00005 PAR_ERR EQU 44 ;Parameter Error Code
0007 00006 FLAGBT EQU 7 ;Flag byte offset
0007 00007 ADDLF EQU 7 ;Add Line Feed = Bit 0
0007 00008 FFHARD EQU 7 ;Form Feed Hard = Bit 1
0007 00009 TABV EQU 7 ;Tab Expansion = Bit 2
0008 00010 CHARS EQU 8 ;Characters per line
0006 00011 INDENT EQU 6 ;Indent after wrap-around
0002 00012 LINES EQU 2 ;Maximum Lines to Print
0009 00013 MARGIN EQU 9 ;Left hand margin value
0000 00014 PAGE EQU 0 ;Maximum Lines per page
0004 00015 XLATEF EQU 4 ;Xlate From
0005 00016 XLATET EQU 5 ;Xlate To
00017 ;
0042 00018 PDEF EQU 66 ;Page Default = 66
0042 00019 LDEF EQU 66 ;Line Default = 66
00020 ;
000E 00021 CURON EQU 0EH ;Cursor on
000F 00022 CUROFF EQU 0FH ;Cursor off
00DD 00023 SKIP EQU 0DDH ;Skip 3 byte instruction
00024 ;
0000 00025 *GET SVCMAC:3 ;SVC Macro equivalents
00026 ;SVCMAC/ASM - LS-DOS Version VI
00027 *LIST OFF
00419 *LIST ON
0000 00421 *GET VALUES:3 ;Misc. equates
00422 ;VALUES/ASM - Version 6
00423 *LIST OFF
00450 *LIST ON
00451 ;
2400 00452 ORG 2400H
00453 ;
00454 START
2400 ED732324 00455 LD (SAVESP+1),SP ;Save SP loc
2404 CD2924 00456 CALL FORMS ;Execute Form Code
2407 210000 00457 EXIT LD HL,0 ;Set no error
240A 1816 00458 JR SAVESP ;Exit
00459 ;
00460 ; I/O Error Handling
00461 ;
240C 3E2C 00462 PRMERR LD A,PAR_ERR ;Parameter Error
240E 6F 00463 IOERR LD L,A ;Xfer error # to HL
240F 2600 00464 LD H,0
2411 F6C0 00465 OR 0C0H ;Abbrev, return
2413 4F 00466 LD C,A ;Xfer to C
2414 00467 @@ERROR ;Display error
2414+3E1A 00468 LD A,26
2416+EF 00469 RST 40
2417 1809 00470 JR SAVESP ;Go to exit routine
00471 ;
00472 ; Internal Error Message Handling
00473 ;
2419 217928 00474 NOPF LD HL,NOPF$ ;No filter present
241C 00475 @@LOGOT ;Log Message
00476 IFEQ 00H,1
00477 LD HL,
00478 ENDIF
241C+3E0C 00479 LD A,12
241E+EF 00480 RST 40
241F 21FFFF 00481 ABORT LD HL,-1 ;Set abort code
2422 310000 00482 SAVESP LD SP,$-$ ;P/u original SP
2425 00483 @@CKBRKC ;Clear any
2425+3E6A 00484 LD A,106
2427+EF 00485 RST 40
2428 C9 00486 RET ;And RETurn to DOS
00487 ;
00488 ; FORMS - Process the Forms Filter Parameters
00489 ;
00490 FORMS
2429 CD0027 00491 CALL DOINIT ;Do initialization
00492 ;
00493 ; Ignore Leading Spaces
00494 ;
242C 2B 00495 DEC HL
242D 23 00496 IGSPCS INC HL ;Bump cmdline ptr
242E 7E 00497 LD A,(HL) ;Skip leading spaces
242F FE20 00498 CP ' '
2431 28FA 00499 JR Z,IGSPCS
00500 ;
00501 ; Any Parameters Entered ?
00502 ;
2433 FE0E 00503 CP CR+1 ;End of line ?
2435 3007 00504 JR NC,GETPRM ;Go if not
00505 ;
00506 ; Display current parameter settings
00507 ;
2437 CD8924 00508 DISPFRM CALL DSFORMS ;Create default string
243A CDF726 00509 CALL DSPLY ;Display defaults
243D C9 00510 RET ; and RETurn
00511 ;
00512 ; Display "Paramter Error" if Illegal input
00513 ;
243E 116227 00514 GETPRM LD DE,PRMTBL$ ;Any Paramters ?
2441 00515 @@PARAM
2441+3E11 00516 LD A,17
2443+EF 00517 RST 40
2444 C20C24 00518 JP NZ,PRMERR ;NZ - "Parameter Error"
00519 ;
00520 ; Create Xlate From Data Area
00521 ;
2447 3ABA27 00522 LD A,(XTRESP) ;P/u xlate TO response
244A 32DF27 00523 LD (XFRESP),A ;Xfer to FROM response
244D 21D627 00524 LD HL,XTPARM+1 ;HL => XLATE To
2450 7E 00525 LD A,(HL) ;P/u value
2451 3600 00526 LD (HL),0 ;Set Xlate To msb = 0
2453 32E227 00527 LD (XFPARM),A ;Xfer to From parm
00528 ;
00529 ; Over-ride all other parms if efault
00530 ;
2456 3AC527 00531 LD A,(DRESP) ;efault Parm entered ?
2459 B7 00532 OR A
245A 2817 00533 JR Z,CHECKQ ;No - check for uery
00534 ;
00535 ; Overwrite $FF data area with default values
00536 ;
245C ED5BD125 00537 LD DE,(DATAREA+2) ;DE => Data area start
2460 010A00 00538 LD BC,10 ;BC = 10 bytes in table
2463 215827 00539 LD HL,DEFTAB ;HL => Default Table
2466 E5 00540 PUSH HL ;Save regs
2467 C5 00541 PUSH BC
2468 EDB0 00542 LDIR ;Xfer to $FF data area
246A C1 00543 POP BC
246B E1 00544 POP HL
246C 11E329 00545 LD DE,DUPDA
246F EDB0 00546 LDIR ;Xfer to duplicate DA
2471 18C4 00547 JR DISPFRM ;Display forms & exit
00548 ;
00549 ; Prompt for any parms not entered & stuff
00550 ;
2473 00551 CHECKQ EQU $
2473 CD1926 00552 CALL INITVAL ;Init parm values = def's
2476 CD8924 00553 CALL DSFORMS ;Create string
2479 3AAA27 00554 LD A,(QRESP) ;uery parm used?
247C B7 00555 OR A
247D CCFC24 00556 CALL Z,CKCOMM ;Check cmdline values if not
2480 C42A25 00557 CALL NZ,PROMPT ;Prompt if "Q"
2483 CDCC25 00558 STUFFIN CALL STFPRMS ;Stuff parms in $FF data
2486 C30724 00559 JP EXIT ;Good exit
00560 ;
00561 ; Display Current FORMS value settings
00562 ;
2489 DDCB0746 00563 DSFORMS BIT 0,(IX+ADDLF) ;Add line feed ?
248D 11E128 00564 LD DE,SADDLF ;DE => addlf dsply msg
2490 C4E826 00565 CALL NZ,XFERON ;Put "ON" in message
00566 ;
00567 ; Display "OFF" if zero, or value if <> zero
00568 ;
2493 DD7E08 00569 LD A,(IX+CHARS) ;CHARS value if it wasn't
2496 B7 00570 OR A ;OFF ?
2497 11BA28 00571 LD DE,SCHARS ;DE => Chars msg
249A C42127 00572 CALL NZ,HEXDEC ;Convert value to dec ASCII
249D 2006 00573 JR NZ,DOFFHRD ;Go if Char parm used
00574 ;
249F 217628 00575 CHAROFF LD HL,OFFSTR ; else xfer "OFF" into
24A2 CDEB26 00576 CALL XFER ; Chars message
00577 ;
00578 ; FFHARD specified ?
00579 ;
24A5 DDCB074E 00580 DOFFHRD BIT 1,(IX+FFHARD) ;FFHARD parm used?
24A9 11EE28 00581 LD DE,SFFHARD ;DE => Ffhard msg
24AC C4E826 00582 CALL NZ,XFERON ;Xfer "ON" if set
00583 ;
00584 ; Xfer INDENT value into string
00585 ;
24AF DD7E06 00586 LD A,(IX+INDENT) ;Default value
24B2 11D428 00587 LD DE,SINDENT ;DE=> Indent msg
24B5 CD2127 00588 CALL HEXDEC ;Convert to decimal ASCII
00589 ;
00590 ; Xfer LINES value into string
00591 ;
24B8 DD7E02 00592 LD A,(IX+LINES) ;P/u LINES value
24BB 11AD28 00593 LD DE,SLINES ;Pt to Lines msg
24BE CD2127 00594 CALL HEXDEC ;Convert to decimal ASCII
00595 ;
00596 ; Xfer MARGIN value into string
00597 ;
24C1 DD7E09 00598 LD A,(IX+MARGIN) ;P/u MARGIN value
24C4 11C728 00599 LD DE,SMARGIN ;DE => Margin msg
24C7 CD2127 00600 CALL HEXDEC ;Convert to decimal ASCII
00601 ;
00602 ; Xfer PAGE value into string
00603 ;
24CA DD7E00 00604 LD A,(IX+PAGE) ;P/u page value
24CD 11A028 00605 LD DE,SPAGE ;DE => Page msg
24D0 CD2127 00606 CALL HEXDEC ;Convert to decimal ASCII
00607 ;
00608 ; Xfer "ON" into string if Tab set
00609 ;
24D3 DDCB0756 00610 BIT 2,(IX+TABV) ;Check Tab bit
24D7 11FB28 00611 LD DE,STAB ;DE => Tab msg
24DA C4E826 00612 CALL NZ,XFERON ;Xfer "ON" if set
00613 ;
00614 ; Is Xlate FROM = Xlate TO ?
00615 ;
24DD DD7E04 00616 LD A,(IX+XLATEF) ;P/u FROM byte
24E0 DD4605 00617 LD B,(IX+XLATET) ;P/u TO byte
24E3 B8 00618 CP B ;Same ?
24E4 2812 00619 JR Z,NOSHOW ;Yes - no show
00620 ;
00621 ; Two distinct values - convert to Hex
00622 ;
24E6 21FF28 00623 LD HL,DOXLATE ;Change CR to LF
24E9 360A 00624 LD (HL),LF ; so msg will dsply
00625 ;
24EB 210B29 00626 LD HL,SXLFROM ;"From" message
24EE CD3C27 00627 CALL HEX8 ;Convert A to Hex @ HL
24F1 78 00628 LD A,B ;P/u TO
24F2 211429 00629 LD HL,SXLTO ;"To" message
24F5 CD3C27 00630 CALL HEX8 ;Convert A to Hex @ HL
00631 ;
00632 ; Point HL to string & RETurn
00633 ;
24F8 219728 00634 NOSHOW LD HL,VALUES ;HL => Default val string
24FB C9 00635 RET ;RETurn
00636 ;
00637 ;
00638 ; CKCOMM - Check command line parameter values
00639 ;
00640 ;
24FC 1E0A 00641 CKCOMM LD E,10 ;10 values to check
24FE FD210E28 00642 LD IY,STRTAB ;IY => Response table
00643 ;
2502 FD6E01 00644 CKCOMML LD L,(IY+1) ;P/u address of response
2505 FD6602 00645 LD H,(IY+2)
00646 ;
00647 ; Set BC = Parameter Response
00648 ;
2508 7E 00649 LD A,(HL) ;Was anything entered ?
2509 B7 00650 OR A
250A 23 00651 INC HL ;Parm addr follows resp
250B 4E 00652 LD C,(HL) ;Set HL = (HL)
250C 23 00653 INC HL
250D 66 00654 LD H,(HL)
250E 69 00655 LD L,C
250F 4E 00656 LD C,(HL) ;P/u response value
2510 23 00657 INC HL ; into BC
2511 46 00658 LD B,(HL)
00659 ;
00660 ; Call routine to Range check parm entry
00661 ;
2512 FD6E05 00662 LD L,(IY+5) ;P/u address of routine
2515 FD6606 00663 LD H,(IY+6) ; to check value validity.
2518 221C25 00664 LD (CALLINS+1),HL ;Stuff addr to CALL instr
251B C40000 00665 CALLINS CALL NZ,$-$ ;BC = response, A = type
251E C20C24 00666 JP NZ,PRMERR ;NZ - "Parameter Error"
00667 ;
00668 ; Position to next table entry
00669 ;
2521 010900 00670 LD BC,9 ;Pos to next STRTAB entry
2524 FD09 00671 ADD IY,BC
2526 1D 00672 DEC E ;Done ?
2527 20D9 00673 JR NZ,CKCOMML
2529 C9 00674 RET ;Yes - RETurn
00675 ;
00676 ;
00677 ; PROMPT - for any vals not entered in parm line
00678 ;
252A 060A 00679 PROMPT LD B,10 ;Eight normal + 2 Xlates
252C FD210E28 00680 LD IY,STRTAB ;Prompt, response table
00681 ;
00682 ; P/u type byte from table & set length = 1
00683 ;
2530 FD7E00 00684 PROMPTL LD A,(IY) ;P/u type byte
2533 3C 00685 INC A ;Merge length = 1
2534 326928 00686 LD (FAKETAB+1),A ;Store new type byte
00687 ;
00688 ; P/u address of response byte
00689 ;
2537 FD5E01 00690 REINPUT LD E,(IY+1) ;P/u address
253A FD5602 00691 LD D,(IY+2) ; in DE
00692 ;
00693 ; Pick up Prompt string address & display it
00694 ;
253D FD6E03 00695 DOPRMPT LD L,(IY+3) ;P/u address in HL
2540 FD6604 00696 LD H,(IY+4)
2543 CD5825 00697 CALL DISPROM ;P/u default & display
00698 ;
00699 ; Input response & stuff into Parm table
00700 ;
2546 CD4327 00701 CALL INPUT ;Input value
2549 C5 00702 PUSH BC ;Save count
254A C4A325 00703 CALL NZ,STUFVAL ;Stuff in valid input
254D C1 00704 POP BC ;Restore count
254E 20E7 00705 JR NZ,REINPUT ;Re-input if bad value
00706 ;
00707 ; Position to next table entry
00708 ;
2550 110900 00709 NEXTPR LD DE,9 ;9 bytes per entry
2553 FD19 00710 ADD IY,DE
2555 10D9 00711 DJNZ PROMPTL ;B prompts
2557 C9 00712 RET ;Done
00713 ;
00714 ;
00715 ; DISPROM - Display Prompt
00716 ;
2558 D5 00717 DISPROM PUSH DE ;Save regs
2559 C5 00718 PUSH BC
255A 0E0F 00719 LD C,CUROFF ;Turn off cursor
255C CDF126 00720 CALL DSP
255F 0620 00721 LD B,32 ;Space padding base
00722 ;
2561 4E 00723 PRLP LD C,(HL) ;P/u character
2562 23 00724 INC HL ;Pos to next
2563 05 00725 DEC B ;Dec count
2564 CDF126 00726 CALL DSP ;Output byte
2567 79 00727 LD A,C ;P/u char
2568 FE7B 00728 CP '{' ;Bracket ?
256A 20F5 00729 JR NZ,PRLP ;No - go til bracket
256C CD8225 00730 CALL STUFDEF ;Display default
256F 78 00731 LD A,B ;P/u base #
2570 81 00732 ADD A,C ; & calculate # of
2571 47 00733 LD B,A ;Spaces to print
2572 0E20 00734 LD C,' '
00735 ;
2574 CDF126 00736 SPLP CALL DSP ;Output spaces
2577 10FB 00737 DJNZ SPLP
00738 ;
2579 219328 00739 LD HL,ENDPROM ;End of prompt
257C CDF726 00740 CALL DSPLY
257F C1 00741 POP BC ;Recover regs
2580 D1 00742 POP DE
2581 C9 00743 RET ; and RETurn
00744 ;
00745 ;
00746 ; STUFDEF - Stuff default value in prompt
00747 ;
2582 FD6E07 00748 STUFDEF LD L,(IY+7) ;P/u default string
2585 FD6608 00749 LD H,(IY+8) ; address
2588 0E05 00750 LD C,5 ;5 chars max
258A 7E 00751 PNLP LD A,(HL)
258B 23 00752 INC HL ;Bump source
258C FE0A 00753 CP LF ;Done ?
258E 280A 00754 JR Z,DUNLP
2590 FE20 00755 CP ' ' ;Leading space ?
2592 28F6 00756 JR Z,PNLP ;Yes - ignore it
2594 CD9C25 00757 CALL DISPA ;Output A
00758 ;
2597 0D 00759 PNLP2 DEC C ;Dec count
2598 20F0 00760 JR NZ,PNLP
00761 ;
259A 3E7D 00762 DUNLP LD A,'}' ;Output end bracket
259C C5 00763 DISPA PUSH BC ;Save count in C
259D 4F 00764 LD C,A ;Xfer char to C
259E CDF126 00765 CALL DSP ;Output byte
25A1 C1 00766 POP BC ;Recover C
25A2 C9 00767 RET ; and RETurn
00768 ;
00769 ;
00770 ; STUFVAL - Stuff values into Parm Table
00771 ;
25A3 D5 00772 STUFVAL PUSH DE ;DE => Response Byte
25A4 21FF27 00773 LD HL,FAKEPRM ;HL => Fake Parm Entry
25A7 116828 00774 LD DE,FAKETAB ;DE => Fake Parm Table
25AA 00775 @@PARAM ;Parse entry
25AA+3E11 00776 LD A,17
25AC+EF 00777 RST 40
25AD E1 00778 POP HL ;HL => Response
25AE C0 00779 RET NZ ;NZ - Re-input
00780 ;
00781 ; Stuff response into Parameter Table
00782 ;
25AF E5 00783 PUSH HL ;Save response dest
25B0 3A6B28 00784 LD A,(FAKERES) ;P/u response
25B3 010000 00785 VALUE LD BC,$-$ ;P/u value
25B6 23 00786 INC HL ;HL => Parm Address
25B7 5E 00787 LD E,(HL) ;P/u parm address
25B8 23 00788 INC HL
25B9 56 00789 LD D,(HL)
25BA EB 00790 EX DE,HL ;HL => Parm lsb
25BB 71 00791 LD (HL),C ;Stuff response in table
00792 ;
00793 ; CALL range checking routine
00794 ;
25BC 21C725 00795 LD HL,RETADR ;Put RET addr on stack
25BF E5 00796 PUSH HL
25C0 FD6E05 00797 LD L,(IY+5) ;P/u addr of range
25C3 FD6606 00798 LD H,(IY+6) ;Checking in HL
25C6 E9 00799 JP (HL) ;Routine sets Z for stat
25C7 E1 00800 RETADR POP HL ;HL => Response byte
25C8 C0 00801 RET NZ ;Don't change if NZ
25C9 3680 00802 LD (HL),80H ; else stuff non-zero
25CB C9 00803 RET ; value for response
00804 ;
00805 ;
00806 ; STFPRMS - Stuff Numeric & Flag Parms into $FF
00807 ;
00808 ;
00809 ; Pt HL => Response byte addr & offset Table
00810 ;
25CC 21E427 00811 STFPRMS LD HL,RESPTAB ;HL => Response Table
25CF DD210000 00812 DATAREA LD IX,$-$ ;P/u Data Area pointer
25D3 0607 00813 LD B,7 ;7 numeric values
00814 ;
00815 ; P/u response byte & offset byte to $FF data
00816 ;
25D5 5E 00817 STUFLP LD E,(HL) ;P/u response address
25D6 23 00818 INC HL
25D7 56 00819 LD D,(HL)
25D8 23 00820 INC HL ;HL => $FF data offset
25D9 4E 00821 LD C,(HL) ;P/u offset in data area
25DA 23 00822 INC HL
00823 ;
25DB 1A 00824 LD A,(DE) ;P/u response
25DC B7 00825 OR A ;Parm entered ?
00826 ;
00827 ; Parm entered - calculate Parm's Location
00828 ;
25DD 13 00829 INC DE ;DE => Parameter Dest
25DE EB 00830 EX DE,HL ;Xfer to HL
25DF 7E 00831 LD A,(HL) ;Set HL = (HL)
25E0 23 00832 INC HL
25E1 66 00833 LD H,(HL)
25E2 6F 00834 LD L,A
00835 ;
00836 ; Stuff parm response into $FF data region
00837 ;
25E3 79 00838 LD A,C ;Xfer offset to A
25E4 4E 00839 LD C,(HL) ;P/u lsb of Parm response
25E5 EB 00840 EX DE,HL ;Recover HL (Table ptr)
25E6 2806 00841 NOPOUT JR Z,NOPARM ;No - don't stuff
25E8 32ED25 00842 LD (IXINST+2),A ;Modify offset in IX inst
25EB DD7100 00843 IXINST LD (IX+$-$),C ;Xfer parm resp to $FF
00844 ;
25EE 10E5 00845 NOPARM DJNZ STUFLP ;Next entry
00846 ;
00847 ; Set Flag bits in $FF data area if parms set
00848 ;
25F0 0603 00849 GETFLAG LD B,3 ;3 flag values
25F2 5E 00850 FLOOP LD E,(HL) ;P/u response address
25F3 23 00851 INC HL
25F4 56 00852 LD D,(HL)
25F5 23 00853 INC HL
25F6 1A 00854 LD A,(DE) ;Entered ?
25F7 B7 00855 OR A
25F8 281C 00856 JR Z,NEXTFLG ;No - get next one
00857 ;
00858 ; Response - If true (SET), False (RES)
00859 ;
25FA 13 00860 INC DE ;Pos to parm address
25FB EB 00861 EX DE,HL ;P/u Parm
25FC 7E 00862 LD A,(HL) ;Set HL = (HL)
25FD 23 00863 INC HL
25FE 66 00864 LD H,(HL)
25FF 6F 00865 LD L,A
2600 EB 00866 EX DE,HL ;Put into DE
2601 0E86 00867 LD C,10000110B ;Default = Reset bit inst
2603 1A 00868 LD A,(DE) ;P/u lsb of parm
2604 B7 00869 OR A ;Set ?
2605 2802 00870 JR Z,SKIPSET ;No - skip SET inst
2607 CBF1 00871 SET 6,C ;Change to Set bit inst
00872 ;
00873 ; Create Post opcode for IX instruction
00874 ;
2609 78 00875 SKIPSET LD A,B ;P/u bit # (0-2)
260A 3D 00876 DEC A
260B 07 00877 RLCA ;Move to bits 3-5
260C 07 00878 RLCA
260D 07 00879 RLCA
260E B1 00880 OR C ;Post op code
260F 321526 00881 LD (IXINST2+3),A ;Change RES b,(IX+nn) ins
2612 DDCB0786 00882 IXINST2 RES $-$,(IX+FLAGBT) ;Set/Reset bit B in $FF
2616 10DA 00883 NEXTFLG DJNZ FLOOP ;Get next flag
2618 C9 00884 RET ;Done - RETurn
00885 ;
00886 ;
00887 ; INITVAL - Initial Parm values
00888 ;
00889 ;
2619 0605 00890 INITVAL LD B,5 ;5 values to stuff
261B 21E427 00891 LD HL,RESPTAB ;HL => Response & offsets
00892 ;
261E 5E 00893 SDLP LD E,(HL) ;P/u response byte addr
261F 23 00894 INC HL
2620 56 00895 LD D,(HL)
2621 23 00896 INC HL
2622 1A 00897 LD A,(DE) ;P/u response byte
00898 ;
00899 ; Get parm table address - DE = (DE)
00900 ;
2623 EB 00901 EX DE,HL
2624 23 00902 INC HL ;Parm address after resp
2625 4E 00903 LD C,(HL) ;P/u lsb
2626 23 00904 INC HL
2627 66 00905 LD H,(HL) ;P/u msb
2628 69 00906 LD L,C ;HL = (HL)
2629 EB 00907 EX DE,HL ;Get back to DE
00908 ;
00909 ; P/u default value from $FF data area
00910 ;
262A D5 00911 PUSH DE ;Save HL & DE
262B E5 00912 PUSH HL
262C 5E 00913 LD E,(HL) ;P/u offset
262D 1600 00914 LD D,0 ;DE = offset to default
262F 2AD125 00915 LD HL,(DATAREA+2) ;HL => Data Area
2632 19 00916 ADD HL,DE
2633 4E 00917 LD C,(HL) ;P/u default value
2634 E1 00918 POP HL ;Restore regs
2635 D1 00919 POP DE
00920 ;
00921 ; If parm wasn't entered - stuff default value
00922 ;
2636 23 00923 INC HL ;Posn to next entry
2637 B7 00924 OR A ;Parm entered ?
2638 2806 00925 JR Z,STFDEF ;No - stuff default
263A 3AAA27 00926 LD A,(QRESP) ;uery parm used?
263D B7 00927 OR A
263E 2802 00928 JR Z,PRMENT ;No - don't stuff
2640 79 00929 STFDEF LD A,C ;Yes - stuff default
2641 12 00930 LD (DE),A
2642 10DA 00931 PRMENT DJNZ SDLP
2644 C9 00932 RET ;Done
00933 ;
00934 ;
00935 ; Range Checking Code of Values
00936 ;
00937 ;
00938 ; Is the Page length valid ?
00939 ;
2645 CDD126 00940 RPAGE CALL MORE0? ;Number between 1 - 255 ?
2648 C0 00941 RET NZ ;No - NZ
2649 3ACF27 00942 LD A,(LPARM) ;P/u LINES value
264C 3D 00943 DEC A
264D B9 00944 CP C ;LINES > PAGE ?
264E F5 00945 PUSH AF ;Save status
264F 3AAA27 00946 LD A,(QRESP) ;uery parm used?
2652 B7 00947 OR A
2653 2003 00948 JR NZ,PQUERY ;Go if so
2655 F1 00949 POP AF ;No
2656 1872 00950 JR VALID2? ;Return NZ if L>P
2658 F1 00951 PQUERY POP AF ;L > P ?
2659 380D 00952 JR C,SETZ ;No - Set Z flag
265B 79 00953 LD A,C ;Yes - Set LINES = PAGE
265C 32E529 00954 LD (DUPDA+LINES),A
265F 328F27 00955 LD (LRESP),A ;Pretend that LINES was
2662 32CF27 00956 LD (LPARM),A ; responded to
2665 CD8924 00957 CALL DSFORMS ;Reset defaults
2668 BF 00958 SETZ CP A ;Set Z flag
2669 C9 00959 RET
00960 ;
00961 ; Is the lines printed per page valid ?
00962 ;
266A CDD126 00963 RLINES CALL MORE0? ;Number between 1 - 255 ?
266D C0 00964 RET NZ ;No - NZ
266E 3D 00965 DEC A
266F 21D327 00966 LD HL,PPARM ;HL => Page length
2672 1855 00967 JR VALID1? ;Set status accordingly
00968 ;
00969 ; Is the Characters printed per line valid ?
00970 ;
2674 CB77 00971 RCHARS BIT 6,A ;Flag response ?
2676 20F0 00972 JR NZ,SETZ ;Yes - Set Z
2678 CDD126 00973 CALL MORE0? ;No - More than zero ?
267B C0 00974 RET NZ ;No - NZ
267C 3AAA27 00975 LD A,(QRESP) ;uery parm used?
267F B7 00976 OR A
2680 C8 00977 RET Z ;Return if not
00978 ;
00979 ; uery - Make sure CHARS > INDENT+MARGIN
00980 ;
2681 21D127 00981 LD HL,MPARM ;HL => Margin value
2684 3ACD27 00982 LD A,(IPARM) ;A = Indent value
2687 86 00983 ADD A,(HL) ;A = Indent + Margin
2688 B9 00984 CP C ;Less than CHARS ?
2689 38DD 00985 JR C,SETZ ;Yes - Set Z
268B AF 00986 XOR A ;Reset INDENT & MARGIN=0
268C 32E929 00987 LD (DUPDA+INDENT),A
268F 32EC29 00988 LD (DUPDA+MARGIN),A
2692 32CD27 00989 LD (IPARM),A
2695 32D127 00990 LD (MPARM),A
2698 3C 00991 INC A ;Pretend that INDENT &
2699 329927 00992 LD (MRESP),A ; MARGIN were responded
269C 328627 00993 CHNGIND LD (IRESP),A ; to
269F CD8924 00994 CALL DSFORMS ;Change defaults
26A2 AF 00995 XOR A ;Set Z & RETurn
26A3 C9 00996 RET
00997 ;
00998 ; Is Margin less than Characters/Line ?
00999 ;
26A4 CDDA26 01000 RMARGIN CALL NUMERIC ;Number between 0 - 255 ?
26A7 C0 01001 RET NZ ;No - NZ
26A8 CDC626 01002 CALL VALID? ;Yes - less than CHARS ?
26AB C0 01003 RET NZ ;No - RETurn NZ
26AC 3ACD27 01004 LD A,(IPARM) ;P/u INDENT
26AF 81 01005 ADD A,C ;Add to MARGIN
26B0 CDC626 01006 CALL VALID? ;M + I < CHARS ?
26B3 C8 01007 RET Z ;Yes - RETurn Z
26B4 AF 01008 XOR A ;No - Set INDENT default
26B5 32CD27 01009 LD (IPARM),A ;Equal to Zero
26B8 32E929 01010 LD (DUPDA+INDENT),A
26BB 3C 01011 INC A ;Pretend I was responded
26BC 18DE 01012 JR CHNGIND ; to
01013 ;
01014 ; Is Margin + Indent less than chars/line ?
01015 ;
26BE CDDA26 01016 RINDENT CALL NUMERIC ;Number between 0 - 255 ?
26C1 C0 01017 RET NZ ;No - NZ
26C2 3AD127 01018 LD A,(MPARM) ;P/u MARGIN val
26C5 81 01019 ADD A,C ;A = MARGIN + INDENT
26C6 21CB27 01020 VALID? LD HL,CPARM ;HL => Characters/Line
26C9 BE 01021 VALID1? CP (HL) ;Response > (HL) ?
26CA 3002 01022 VALID2? JR NC,SETNZ ;Yes - Reset Z flag
26CC BF 01023 CP A ;No - Set Z flag
26CD C9 01024 RET
26CE AF 01025 SETNZ XOR A ;Reset Z flag
26CF 3C 01026 INC A
26D0 C9 01027 RET
01028 ;
01029 ; Is the response a number between 1-255 ?
01030 ;
26D1 CDDA26 01031 MORE0? CALL NUMERIC ;Is the response a number
26D4 C0 01032 RET NZ ;Between 0 - 255 ?
26D5 B7 01033 OR A ;Is the response zero ?
26D6 28F6 01034 JR Z,SETNZ ;Yes - reset Z flag
26D8 BF 01035 CP A ;No - set Z flag
26D9 C9 01036 RET
01037 ;
01038 ; Is the response a 1 byte number ?
01039 ;
26DA E680 01040 NUMERIC AND 80H ;Bit 7 is set if the
26DC EE80 01041 XOR 80H ;Response is numeric.
26DE C0 01042 RET NZ ;NZ <= if Bit is reset
26DF 04 01043 INC B ;Is the response only
26E0 05 01044 DEC B ;1 byte (msb = 0) ?
26E1 79 01045 LD A,C ;Set A = response
26E2 C9 01046 RET ;Yes (Z), no (NZ)
01047 ;
01048 ; Is the response a flag (ON/YES, OFF/NO) ?
01049 ;
26E3 E640 01050 FLAG? AND 40H ;Bit 6 is set if the
26E5 EE40 01051 XOR 40H ;Response is a flag.
26E7 C9 01052 RET ;Yes (Z), no (NZ)
01053 ;
01054 ;
01055 ; XFER - Xfer string @ HL to DE
01056 ; XFERON - Xfer "ON" string to DE
01057 ;
01058 ;
26E8 217328 01059 XFERON LD HL,ONSTR ;HL => "ON"
26EB 010300 01060 XFER LD BC,3 ;3 chars to xfer
26EE EDB0 01061 LDIR
26F0 C9 01062 RET
01063 ;
01064 ;
01065 ; DSP - Display a byte
01066 ;
01067 ;
26F1 D5 01068 DSP PUSH DE ;Save DE
26F2 01069 @@DSP ;Output byte
26F2+3E02 01070 LD A,2
26F4+EF 01071 RST 40
26F5 1804 01072 JR EXDSP
01073 ;
01074 ;
01075 ; DSPLY - Display a string
01076 ;
01077 ;
26F7 D5 01078 DSPLY PUSH DE ;Save DE
26F8 01079 @@DSPLY ;Display it
01080 IFEQ 00H,1
01081 LD HL,
01082 ENDIF
26F8+3E0A 01083 LD A,10
26FA+EF 01084 RST 40
26FB D1 01085 EXDSP POP DE
26FC C8 01086 RET Z ;Return if good
26FD C30E24 01087 JP IOERR ;NZ - I/O Error
01088 ;
01089 ;
01090 ; DOINIT - Sign on message & Get Data area
01091 ;
01092 ;
2700 E5 01093 DOINIT PUSH HL ;Save command ptr
2701 01094 @@FLAGS ;Get system flags
2701+3E65 01095 LD A,101
2703+EF 01096 RST 40
01097 ;
01098 ; Point IX to Filter Data area
01099 ;
2704 116F28 01100 LD DE,$FF ;DE => "$FF"
2707 01101 @@GTMOD ;Find start
2707+3E53 01102 LD A,83
2709+EF 01103 RST 40
270A C21924 01104 JP NZ,NOPF ;Abort if Forms/Flt missing
01105 ;
270D EB 01106 EX DE,HL ;HL => Data Area
270E 010400 01107 LD BC,4 ;Add 4 to ptr
2711 09 01108 ADD HL,BC
2712 22D125 01109 LD (DATAREA+2),HL ;Save $FF data pointer
2715 11E329 01110 LD DE,DUPDA ;DE => Duplicate D area
2718 D5 01111 PUSH DE ;Save ptr
2719 0E0A 01112 LD C,10 ;BC = 10 bytes to xfer
271B EDB0 01113 LDIR
271D DDE1 01114 POP IX ;IX pts to data area
271F E1 01115 POP HL ;Recover cmdline ptr
2720 C9 01116 RET ; and RETurn
01117 ;
01118 ;
01119 ;
01120 ; HEXDEC - Convert Hex Number to Decimal ASCII
01121 ; A => 8-bit Hex Number to Convert
01122 ; DE => Destination of ASCII characters
01123 ;
01124 ;
2721 C5 01125 HEXDEC PUSH BC ;Save regs
2722 E5 01126 PUSH HL
2723 F5 01127 PUSH AF
01128 ;
01129 ; Transfer ASCII chars into temporary buffer
01130 ;
2724 D5 01131 PUSH DE ;Save real destination
2725 11DE29 01132 LD DE,TEMBUF ;DE => Temporary buffer
2728 2600 01133 LD H,0 ;Xfer # to HL
272A 6F 01134 LD L,A
272B 01135 @@HEXDEC ;Convert to ASCII
272B+3E61 01136 LD A,97
272D+EF 01137 RST 40
272E 1B 01138 DEC DE ;Pos to 3-byte field
272F 1B 01139 DEC DE
2730 1B 01140 DEC DE
2731 E1 01141 POP HL ;Recover user buffer
2732 EB 01142 EX DE,HL ;HL to #, DE to user buff
2733 010300 01143 LD BC,3
2736 EDB0 01144 LDIR ;Move the ASCII number
01145 ;
2738 F1 01146 POP AF ;Recover #
2739 E1 01147 POP HL ; and other regs
273A C1 01148 POP BC
273B C9 01149 RET
01150 ;
01151 ;
01152 ; HEX8 - Convert HEX Number in A to HEX @ HL
01153 ;
01154 ;
273C C5 01155 HEX8 PUSH BC ;Save regs
273D 4F 01156 LD C,A ;Xfer char to C
273E 01157 @@HEX8 ;Do it
273E+3E62 01158 LD A,98
2740+EF 01159 RST 40
2741 C1 01160 POP BC
2742 C9 01161 RET ; and RETurn
01162 ;
01163 ;
01164 ;
01165 ; INPUT - Input a string into INBUFF$
01166 ;
01167 ;
2743 E5 01168 INPUT PUSH HL ;Save regs
2744 D5 01169 PUSH DE
2745 C5 01170 PUSH BC
01171 ;
2746 010003 01172 LD BC,3<8 ;3 chars max
2749 210228 01173 LD HL,INBUFF$ ;Key input buffer
274C 01174 @@KEYIN ;Input line
274C+3E09 01175 LD A,9
274E+EF 01176 RST 40
274F DA1F24 01177 JP C,ABORT ;Abort if
01178 ;
2752 04 01179 INC B ;Set Z flag if
2753 05 01180 DEC B ; no input
01181 ;
2754 C1 01182 POP BC ;Restore regs
2755 D1 01183 POP DE
2756 E1 01184 POP HL
2757 C9 01185 RET ; & RETurn with condition
01186 ;
01187 ; Default Value Table
01188 ;
2758 42 01189 DEFTAB DB PDEF,0,LDEF,0,0,0,0,00000100B,0,0
00 42 00 00 00 00 04 00
00
01190 ;
01191 ; Parameter table
01192 ;
2762 80 01193 PRMTBL$ DB 80H ;6.2 @PARAM
01194 ;
01195 ; ADDLF (A) - Flag Input Only
01196 ;
2763 55 01197 DB FLAG!ABB!5
2764 41 01198 DB 'ADDLF'
44 44 4C 46
2769 00 01199 ARESP DB 0
276A D727 01200 DW APARM
01201 ;
01202 ; CHARS (C) - Accept Numeric or Flag input
01203 ;
276C D5 01204 DB FLAG!ABB!NUM!5
276D 43 01205 DB 'CHARS'
48 41 52 53
2772 00 01206 CRESP DB 0
2773 CB27 01207 DW CPARM
01208 ;
01209 ; FFHARD (F) - Accept Flag input only
01210 ;
2775 56 01211 DB FLAG!ABB!6
2776 46 01212 DB 'FFHARD'
46 48 41 52 44
277C 00 01213 FRESP DB 0
277D D927 01214 DW FPARM
01215 ;
01216 ; INDENT (I) - Accept Numeric Input only
01217 ;
277F 96 01218 DB NUM!ABB!6
2780 49 01219 DB 'INDENT'
4E 44 45 4E 54
2786 00 01220 IRESP DB 0
2787 CD27 01221 DW IPARM
01222 ;
01223 ; LINES (L) - Accept Numeric Input only
01224 ;
2789 95 01225 DB NUM!ABB!5
278A 4C 01226 DB 'LINES'
49 4E 45 53
278F 00 01227 LRESP DB 0
2790 CF27 01228 DW LPARM
01229 ;
01230 ; MARGIN (M) - Accept Numeric Input only
01231 ;
2792 96 01232 DB NUM!ABB!6
2793 4D 01233 DB 'MARGIN'
41 52 47 49 4E
2799 00 01234 MRESP DB 0
279A D127 01235 DW MPARM
01236 ;
01237 ; PAGE (P) - Accept Numeric Input only
01238 ;
279C 94 01239 DB NUM!ABB!4
279D 50 01240 DB 'PAGE'
41 47 45
27A1 00 01241 PRESP DB 0
27A2 D327 01242 DW PPARM
01243 ;
01244 ; QUERY (Q) - Accept Flag Input Only
01245 ;
27A4 55 01246 DB FLAG!ABB!5
27A5 51 01247 DB 'QUERY'
55 45 52 59
27AA 00 01248 QRESP DB 0
27AB C927 01249 DW QPARM
01250 ;
01251 ; TAB (T) - Accept Flag input only
01252 ;
27AD 53 01253 DB FLAG!ABB!3
27AE 54 01254 DB 'TAB'
41 42
27B1 00 01255 TRESP DB 0
27B2 DB27 01256 DW TPARM
01257 ;
01258 ; XLATE (X) - Accept Numeric input only
01259 ;
27B4 95 01260 DB NUM!ABB!5
27B5 58 01261 DB 'XLATE'
4C 41 54 45
27BA 00 01262 XTRESP DB 0
27BB D527 01263 DW XTPARM
01264 ;
01265 ; DEFAULT (D) - Accept Flag input only
01266 ;
27BD 57 01267 DB FLAG!ABB!7
27BE 44 01268 DB 'DEFAULT'
45 46 41 55 4C 54
27C5 00 01269 DRESP DB 0
27C6 DD27 01270 DW DPARM
01271 ;
27C8 00 01272 DB 0
01273 ;
27C9 0000 01274 QPARM DW 0
27CB 0000 01275 CPARM DW 0
27CD 0000 01276 IPARM DW 0
27CF 0000 01277 LPARM DW 0
27D1 0000 01278 MPARM DW 0
27D3 0000 01279 PPARM DW 0
27D5 0000 01280 XTPARM DW 0
01281 ;
27D7 0000 01282 APARM DW 0
27D9 0000 01283 FPARM DW 0
27DB 0000 01284 TPARM DW 0
27DD 0000 01285 DPARM DW 0
01286 ;
27DF 00 01287 XFRESP DB 0
27E0 E227 01288 DW XFPARM
27E2 0000 01289 XFPARM DW 0
01290 ;
01291 ;
01292 ; Response Table - Response Addr, $FF Offset
01293 ;
01294 ;
01295 ; 8-bit Numeric Responses
01296 ;
27E4 7227 01297 RESPTAB DW CRESP
27E6 08 01298 DB CHARS
01299 ;
27E7 8627 01300 DW IRESP
27E9 06 01301 DB INDENT
01302 ;
27EA 8F27 01303 DW LRESP
27EC 02 01304 DB LINES
01305 ;
27ED 9927 01306 DW MRESP
27EF 09 01307 DB MARGIN
01308 ;
27F0 A127 01309 DW PRESP
27F2 00 01310 DB PAGE
01311 ;
27F3 BA27 01312 DW XTRESP
27F5 05 01313 DB XLATET
01314 ;
27F6 DF27 01315 DW XFRESP
27F8 04 01316 DB XLATEF
01317 ;
01318 ; Flag Response Table
01319 ;
27F9 B127 01320 DW TRESP
27FB 7C27 01321 DW FRESP
27FD 6927 01322 DW ARESP
01323 ;
01324 ;
27FF 28 01325 FAKEPRM DB '(F='
46 3D
2802 01326 INBUFF$ DS 12
01327 ;
01328 ;
01329 ; STRTAB - 10 entries each with 9 bytes:
01330 ;
01331 ; 1 byte : Type of expected response - flag or numeric
01332 ; 2 bytes: Address of response byte
01333 ; 2 bytes: Address of prompt string
01334 ; 2 bytes: Address of routine to range check response
01335 ; 2 bytes: Address of default value string
01336 ;
01337 ;
01338 ;
280E 01339 STRTAB EQU $
280E 80 01340 DB NUM ;PAGE
280F A127 01341 DW PRESP,PPROMPT,RPAGE,SPAGE
A229 4526 A028
2817 80 01342 DB NUM ;LINES
2818 8F27 01343 DW LRESP,LPROMPT,RLINES,SLINES
7A29 6A26 AD28
2820 80 01344 DB NUM ;CHARS
2821 7227 01345 DW CRESP,CPROMPT,RCHARS,SCHARS
3229 7426 BA28
2829 80 01346 DB NUM ;MARGIN
282A 9927 01347 DW MRESP,MPROMPT,RMARGIN,SMARGIN
9229 A426 C728
2832 80 01348 DB NUM ;INDENT
2833 8627 01349 DW IRESP,IPROMPT,RINDENT,SINDENT
6029 BE26 D428
283B 40 01350 DB FLAG ;ADDLF
283C 6927 01351 DW ARESP,APROMPT,FLAG?,SADDLF
1929 E326 E128
2844 40 01352 DB FLAG ;FFHARD
2845 7C27 01353 DW FRESP,FPROMPT,FLAG?,SFFHARD
4F29 E326 EE28
284D 40 01354 DB FLAG ;TAB
284E B127 01355 DW TRESP,TPROMPT,FLAG?,STAB
B829 E326 FB28
2856 80 01356 DB NUM ;XLATE From
2857 DF27 01357 DW XFRESP,XPROMF,NUMERIC,SXLFROM-2
C729 DA26 0929
285F 80 01358 DB NUM ;XLATE To
2860 BA27 01359 DW XTRESP,XPROMT,NUMERIC,SXLTO-2
D329 DA26 1229
01360 ;
01361 ; Fake Parameter Table for prompts (QUERY)
01362 ;
2868 80 01363 FAKETAB DB 80H ;6.2 @ PARAM
2869 00 01364 DB 0 ;Type byte
286A 46 01365 DB 'F'
286B 00 01366 FAKERES DB 0
286C B425 01367 DW VALUE+1 ;Destination
286E 00 01368 DB 0
01369 ;
01370 ;
286F 24 01371 $FF DB '$FF',ETX
46 46 03
2873 20 01372 ONSTR DB ' ON'
4F 4E
2876 4F 01373 OFFSTR DB 'OFF'
46 46
01374 ;
2879 46 01375 NOPF$ DB 'Forms Filter not Resident',CR
6F 72 6D 73 20 46 69 6C
74 65 72 20 6E 6F 74 20
52 65 73 69 64 65 6E 74
0D
01376 ;
2893 3F 01377 ENDPROM DB '? ',CURON,ETX
20 0E 03
2897 50 01378 VALUES DB 'PAGE = '
41 47 45 20 20 20 3D 20
28A0 20 01379 SPAGE DB ' 66',LF,'LINES = '
36 36 0A 4C 49 4E 45 53
20 20 3D 20
28AD 20 01380 SLINES DB ' 66',LF,'CHARS = '
36 36 0A 43 48 41 52 53
20 20 3D 20
28BA 4F 01381 SCHARS DB 'OFF',LF,'MARGIN = '
46 46 0A 4D 41 52 47 49
4E 20 3D 20
28C7 20 01382 SMARGIN DB ' 0',LF,'INDENT = '
20 30 0A 49 4E 44 45 4E
54 20 3D 20
28D4 20 01383 SINDENT DB ' 0',LF,'ADDLF = '
20 30 0A 41 44 44 4C 46
20 20 3D 20
28E1 4F 01384 SADDLF DB 'OFF',LF,'FFHARD = '
46 46 0A 46 46 48 41 52
44 20 3D 20
28EE 4F 01385 SFFHARD DB 'OFF',LF,'TAB = '
46 46 0A 54 41 42 20 20
20 20 3D 20
28FB 4F 01386 STAB DB 'OFF',LF
46 46 0A
28FF 0D 01387 DOXLATE DB CR,'XLATE = X',AP
58 4C 41 54 45 20 20 3D
20 58 27
290B 30 01388 SXLFROM DB '00',AP,' => X',AP
30 27 20 3D 3E 20 58 27
2914 30 01389 SXLTO DB '00',AP,LF,CR
30 27 0A 0D
01390 ;
01391 ;
2919 41 01392 APROMPT DB 'Add Line Feed after C/R {'
64 64 20 4C 69 6E 65 20
46 65 65 64 20 61 66 74
65 72 20 43 2F 52 20 7B
2932 4D 01393 CPROMPT DB 'Maximum Characters per Line {'
61 78 69 6D 75 6D 20 43
68 61 72 61 63 74 65 72
73 20 70 65 72 20 4C 69
6E 65 20 7B
294F 52 01394 FPROMPT DB 'Real Form Feeds {'
65 61 6C 20 46 6F 72 6D
20 46 65 65 64 73 20 7B
2960 49 01395 IPROMPT DB 'Indent after Wrap-around {'
6E 64 65 6E 74 20 61 66
74 65 72 20 57 72 61 70
2D 61 72 6F 75 6E 64 20
7B
297A 4C 01396 LPROMPT DB 'Lines Printed per Page {'
69 6E 65 73 20 50 72 69
6E 74 65 64 20 70 65 72
20 50 61 67 65 20 7B
2992 4D 01397 MPROMPT DB 'Margin Setting {'
61 72 67 69 6E 20 53 65
74 74 69 6E 67 20 7B
29A2 50 01398 PPROMPT DB 'Physical Page Length {'
68 79 73 69 63 61 6C 20
50 61 67 65 20 4C 65 6E
67 74 68 20 7B
29B8 54 01399 TPROMPT DB 'Tab Expansion {'
61 62 20 45 78 70 61 6E
73 69 6F 6E 20 7B
29C7 58 01400 XPROMF DB 'Xlate From {'
6C 61 74 65 20 46 72 6F
6D 20 7B
29D3 58 01401 XPROMT DB 'Xlate To {'
6C 61 74 65 20 54 6F 20
7B
01402 ;
01403 ;
29DD 20 01404 DB ' '
29DE 01405 TEMBUF DS 5
29E3 01406 DUPDA DS 10
01407 ;
2400 01408 END START
2400 is the transfer address
00000 Total errors
[Copyright 1999,2002 Frank Durda IV, All Rights Reserved. Mirroring of any material on this page in any form is expressly prohibited. The official web site for this material is: http://nemesis.lonestar.org Contact this address for use clearances: clearance at nemesis.lonestar.org Comments and queries to this address: web_software_2011 at nemesis.lonestar.org]