home *** CD-ROM | disk | FTP | other *** search
- ;
- ;POW FROM DR. DOBBS JOURNAL NO. 29, PAGE 20
- ;
- ;....POW....
- ;30 JULY 79....MODS FOR CP/M
- ;BY BOTTER REEVES...LOY NAVA CO. LTD.
- ;1229/27 NEW ROAD, BANGKOK 5, THAILAND
- ;233-4193
-
-
- ;DEC 16-30, 1977 :
- ;MODIIED FOR FDOS JUN 3,1978
- ;SELECTRIC MODS JUNE 15,1978
- ;TOTAL JUSTIFICATION FIXED JULY 20, 1978
- ;
- ;
- ;BY HERMAN WATSON
- ;P.O. BOX 341401
- ;CORAL GABLES, FLA 33134
- ;
- ;
- ;
- ;THE FOLLOWING IS THE JAZZED UP VERSION FOR FDOS
- ;WITH INSTRUCTION PRINTOUT AT THE BEGINNING
- ;
- ORG 100H ;START LOC FOR COM FILE
- START LXI SP,STACK
- LXI H,STMSG
- CALL TXTYP
- JMP MAIN
-
-
- STMSG DB '...PROCESSOR OF WORDS FOR 8080',0DH,0AH
- DB 'THE COMMANDS ARE AS FOLLOWS',0DH,0AH
- DB ' "P" = PRINT',0DH,0AH
- DB ' "L" = LOAD',0DH,0AH
- DB ' "Q" = QUIT',0DH,0AH
- DB ' CTRL C WILL ABORT',0DH,0AH
- DB 'ENTER COMMAND $'
-
-
- ;UTILITY ROUTINES
-
- ;ADD A TO HL
-
- ADAH ADD L
- MOV L,A
- RNC
- INR H
- RET
-
- ;TEST DE .EQ. HL
- ;RETURN ZERO IF SO
-
- TDHE MOV A,D
- CMP H
- RNZ
- MOV A,E
- CMP L
- RET
-
-
- ;GENERATE PSEUDORANDOM NUMBER 0-15
-
- RAND LXI H,RNDV
- RND1 MOV A,M
- RLC
- INR A
- RLC
- RLC
- XRA M
- MOV M,A
- ANI 0FH
- RET
-
-
- ;CONVERT TABS TO CORRECT POSITION
-
- TBST LDA LPOS
- MOV C,A
- LXI D,TTAB
- ;SEARCH TTAB FOR NEXT GREATEST LOCATION
- TBLP LDAX D
- INX D
- CMP C
- JZ TBLP
- JNC GOTB
- CPI 0
- JNZ TBLP
- ;NO MORE TABS IN TABLE
- JMP CLOS
- ;GOT GOOD TAB, UPDATE POINTERS
- GOTB LXI H,RMAR
- CMP M
- JNC CLOS
- PUTB STA LPOS
- LXI H,OBUF
- CALL ADAH
- SHLD LADR
- RET
-
-
- ;CONVERT ASCII NUMBER TO BINARY
- ;ADDRESS IN HL ON ENTRY, SAVED IN APNT ON EXIT
- ;RETURN WITH VALUE IN HL
-
- ADEC PUSH H
- POP B
- LXI H,0
- ADE1 LDAX B
- CALL NMCK ;CHECK FOR DECIMAL NUMBER
- JC ADE2
- INX B
- MOV D,H
- MOV E,L
- DAD H
- DAD H
- DAD D
- DAD H
- SUI 48
- MOV E,A
- MVI D,0
- DAD D
- JMP ADE1
- ADE2 PUSH B
- XTHL
- SHLD APNT
- POP H
- RET
-
-
- ;CHECK FOR DECIMAL NUMBER IN ASCII
-
- NMCK CPI '0'
- RC
- CPI '9'+1
- CMC
- RET
-
-
-
- ;INITIALIZE OBUF FOR NEW FORMATTED LINE
-
- NEWL LXI H,OBUF ;FILL WITH SPACES
- LDA MAXL
- MOV C,A
- MVI A,' '
- NEWA MOV M,A
- INX H
- DCR C
- JNZ NEWA
- LXI H,OBUF ;COMPUTE LEFT MARGIN ADDR
- LDA LMAR
- CALL ADAH
- SHLD LADR
- LDA LMAR ;SET POSITION COUNTER
- STA LPOS
- LXI H,OBUF ;COMPUTE RIGHT MARGIN ADDR
- LDA RMAR
- CALL ADAH
- SHLD LEND
- MVI M,CR ;EOL AT RIGHT
- RET
-
-
- ;FORMATTED OUTPUT
- ;CALL WITH LETTER IN A
- ;HANDLES LEFT OR TOTAL JUSTIFICATION
-
- FMAT CPI 9 ;TEST TAB
- JZ TBST
- CPI CR ;TEST CARG RETRN
- JNZ LFTS
- MVI A,' ' ;REPLACE CR WITH SPACE
- LFTS CPI LF ;IGNORE LINE FEEDS
- RZ
- CPI ' '
- JNZ RFMT
-
- ;IF HERE, EITHER LEFT OR TOTAL JUST. SO ALLOW
- ;NO SPACES AT THE LEFT OF THE LINE
- LXI H,LMAR
- LDA LPOS
- CMP M
- RZ ;AT START, SO STAY THERE
- MVI A,' ' ;OK TO KEEP SPACE
- RFMT LHLD LADR ;NOW PLACE LETTER IN OBUF
- MOV M,A
- INX H
- SHLD LADR
- LXI H,RMAR ;CHECK IF OBU FULL
- LDA LPOS
- INR A
- STA LPOS
- CMP M
- RC
-
-
- ;OBUF FULL. ASSUME LEFT JUST.
- ;BACK UP TO SPACE AND SAVE OVERFLOW
- ;DE=TEMP ADDRESS
- ;C=CHAR COUNT
- ;HL=OBUF ADDRESS
-
- MVI B,30 ;MAX AMOUNT TEML CAN HOLD
- MVI C,0 ;TEML CHAR COUNT
- LXI D,TEML
- LHLD LADR
- MVI M,CR ;EOL IN CASE NOT POSSIBLE
- ;LOOP BACK TO FIRST SPACE (WITHIN 30 LETTERS
- ;AND WITHOUT HITTING LEFT MARGIN)
-
- LJBU DCX H
- MOV A,M
- CPI ' '
- JZ LJFN
- LJRT STAX D
- INX D
- INR C
- DCR B
- JZ OUTL
- JMP LJBU
- LJFN DCX H
- MOV A,M
- INX H
- CPI ' '
- JZ LJRT
- MOV A,C
- STA TCNT ;SAVE CHAR COUNT
- LDA LPOS ;BACK UP LPOS
- SUB C
- STA LPOS
- MOV C,A ;DON'T GO PAST NEW PARA TAB
- LDA BRTB ;FOR UNMODIFIED INDENTION
- SUB C ;TO THAT TAB POSITION
- JNC OUTL ;TERMS NOT MET
- SHLD LADR
- MVI M,CR ;NEW EOL
-
-
- ;TEST HERE IF LEFT JUST. OR TOTAL JUST.
- ;0=NO JUST.
- ;1=LEFT ONLY
- ;2=TOTAL JUST.
- ;BY THE WAY, AT THIS POINT LEFT JUST.
- ;IS COMPLETE ALREADY
-
- LDA JFLG
- CPI 1
- JZ OUTL
- CPI 2
- JNZ OUTL
-
- ;TOTAL JUST. AT THIS POINT
- ;MOVE LINE TO RIGHT, AND PAD
- ;IF LMAR REACHED, PUSH LINE LEFT AND
- ;PAD AGAIN UNTIL DONE
- ;(HL) .GE. (DE), SO DE IS RIGHT OF HL, AND WHEN
- ;DE .EQ. HL, THE PADDING IS DONE
-
- ;BEGIN AT LAST CHAR AND SHOVE RIGHT
- ;START PADDING AT THE SFLP SPACE
- ;(SFLP IS RANDOM) AND CONTINUE
- ;PADDING EACH OCCURRANCE OF A GROUP
- ;OF SPACES UNTIL THE TWO POINTERS ARE EQUAL
- ;TO EACH OTHER
-
-
- TOTL CALL RAND ;INIT SFLP
- STA SFLP
- LHLD LEND
- XCHG
- LHLD LADR
- LDA LPOS
- MOV C,A
- MVI B,0 ;MAKE SURE SP IS FOUND
- ;DE .EQ. HL MEANS PAD DONE
-
-
- CALL TDHE
- JZ OUTL
-
- ;RIGHT AND PAD
-
- RITE MOV A,M ;PICK UP FROM LEFT
- STAX D ;STORE AT RIGHT
- CPI ' ' ;TEST PICKED UP CHAR
- JNZ WORD
- MVI B,1 ;NOTE THAT SP WAS FOUND
- LDA SFLP ;TST IF WE CAN INSERT YET
- ORA A ;TEST FOR ZERO
- JZ PADD ;CAN'T INSERT YET
- DCR A
- STA SFLP
- JMP WORD ;NOT YET
- PADD LDA LCHR ;CHECK IF GROUP OF SPACES
- CPI ' ' ;DON'T ALLOW THIS COND.
- JZ WRD1
- MVI A,' ' ;PADDING DONE HERE
- DCX D
- STAX D
- CALL TDHE
- JZ OUTL
- WORD MOV A,M
- STA LCHR
- WRD1 DCX D ;REST OF RIGHT AND PAD LOOP
- DCX H
- DCR C
- LDA BRTB ;ALLOWS INDENTION
- CMP C
- JZ LEFT ;HIT INDENTATION
- LDA LMAR ;OR LEFT MARGIN
- CMP C
- JNZ RITE ;CAN STILL PROCEED
-
- ;PUSH LEFT AND TRY AGAIN
-
- LEFT INX D
- INX H
- INR C
- LDAX D
- MOV M,A
- CPI CR
- JNZ LEFT
- XRA A ;TEST IF ONE SP FOUND
- ORA B
- JZ OUTL ;NOPE, NOT ONE SP FOUND
- JMP RITE
-
- ;OUTPUT A COMPLETE FORMATTED LINE FROM OBUF
-
- OUTL LXI H,OBUF ;OUT TO CR
- OUTM MOV A,M
- INX H
- CPI CR
- JZ EOL
- CALL OUTC
- JMP OUTM
- EOL CALL NEWL ;CLEAN OBUF
- LDA SPAS ;PROCESS SPACING
- MOV C,A
- EOLP CALL CRLF
- LDA PPOS ;UPDATE TEXT PAGE POSITION
- INR A
- STA PPOS
- LXI H,PLEN
- CMP M
- JNC EOXP
- DCR C
- JNZ EOLP
- JMP RSTR
- EOXP CALL NEXP ;NEED A NEW PAGE!
-
- ;RESTORE OVERFLOW FROM TEML
- ;INTO OBUF STARTING AT LMAR
- RSTR LXI D,TCNT
- LDAX D
- ORA A
- RZ
- LXI H,TEML-1
- MOV C,A
- DCR C
- CALL ADAH
- MOV A,M
- CPI ' ' ;PREVENT FIRST BEING SPACE
- MOV A,C
- STAX D
- JZ RSTR
-
- ;FIRST NOT SPACE
-
- INR C
- LDA LMAR
- ADD C
- STA LPOS
- XCHG
- LHLD LADR
- RSTL LDAX D
- MOV M,A
- DCX D
- INX H
- DCR C
- JNZ RSTL
- SHLD LADR
- XRA A
- STA TCNT
- RET
-
-
- ;UNFORMATTED OUTPUT ROUTINE
- ;EQUIVALENT TO FMAT, BUT NO JUSTIFICATION
- ;IF TEXT EXCEEDS RMAR, THEN A CR IS FORCED AND A
- ;NEW LINE IS STARTED
-
- UFMT CPI 9 ;TEST TAB
- JZ TBST
- CPI LF ;IGNORE LINE FEEDS
- RZ
- CPI CR ;TEST CARG RETURN
- LHLD LADR
- MOV M,A ;INSERT AS EOL
- JZ OUTL
- INX H
- SHLD LADR
- LXI H,RMAR ;TEST IF FULL
- LDA LPOS
- INR A
- STA LPOS
- DCR A
- CMP M
- RC
-
-
- ;HERE, OBUF IS FULL SO FORCE CR AND CONTINUE
-
- LHLD LADR
- MVI M,CR
- JMP OUTL
-
-
- ;OUTPUT OBUF IF ANYTHING IN IT
-
- CLOS LXI H,LMAR
- LDA LPOS
- CMP M
- RZ
- RC
- LHLD LADR
- MVI M,CR
- JMP OUTL
-
- ;OUTPUT BOTTOM OF PAGE, THE DIVIDER, AND
- ;THE TOP OF THE NEXT PAGE
-
- NEXP LDA BLEN ;GET BOTTOM LENGTH
- ORA A
- JZ DVDR ;NO BOTTOM PLEASE
- MOV C,A
- NPBL LDA BOTN ;CHECK IF AT LINE FOR MSG OUT
- CMP C
- CZ BMSG ;YES, OUTPUT IT
- CALL CRLF
- DCR C
- JNZ NPBL
-
- ;DETERMINE IF LAST PAGE IN FILE
-
- LDA EOT
- ORA A
- RZ ;ZERO SAYS EOF ENCOUNTERED
-
- ;START A NEW PAGE NOW
-
- ;OUTPUT WARNING TO CONSOLE AND WAIT FOR "GO"
-
- DVDR LXI H,PAGMS
- CALL TXTYP
- CALL ECHO1
- CALL CI
- LXI H,PAGN
- INR M
- NEWP LDA TLEN ;GET TOP LENGTH
- ORA A
- JZ NPXT ;NO TOP PLEASE
- MOV C,A
- NPTL LDA TOPN ;EQUAL LINE FOR MSG OUTPUT?
- CMP C
- CZ TMSG ;YES, PRINT IT
- CALL CRLF
- DCR C
- JNZ NPTL
- NPXT XRA A
- STA PPOS
- RET
- BMSG LDA PAGN ;NO MSG ON FIRST PAGE
- CPI 2
- RC
- MOV A,C
- STA TSTG ;SAVE PRESENT LINE COUNT
- LHLD BOTA ;GET BOTM MSG ADDRESS
- LDA BOTT ;AND TAB POSITION
-
- ;DIRECTLY OUTPUT MESSAGE LINE TO PRINTER
- ;DOES NOT USE OR DESTROY OBUF AND ITS CONTENTS
-
- TNTR MOV C,A
- LDA CASE
- PUSH PSW
- BMAL MVI A,' ' ;SPACE OVER TO TAB
- CALL OUTC
- DCR C
- JNZ BMAL
- BMSL MOV A,M ;OUTPUT THE MESSAGE
- INX H
- CALL CAPR ;DO CASE PROCESSING
- JC BMSL ;IGNORE LAST CHAR
- CPI ':' ;SUBSTITUTE THE PAGE NUMBER
- CZ BIND ;AT OCCURANCE OF COLON
- CPI CR
- JZ BMXT
- CALL OUTC
- JMP BMSL
- BMXT STA PPOS
- POP PSW
- STA CASE
- LDA TSTG ;RESTORE LINE COUNT
- MOV C,A
- RET
-
-
- ;OUTPUT TOP OF PAGE MESSAGE (SEE BMSG)
-
- TMSG LDA PAGN
- CPI 2
- RC
- MOV A,C
- STA TSTG
- LHLD TOPA
- LDA TOPT
- JMP TNTR
-
- ;BINARY TO DECIMAL CONVERT CONTNTS OF A REG
- ;DIRECT OUTPUT TO PRINTER,COMPLETE WITH ZERO
- ;SUPPRESSION
-
- BIND MVI E,0
- LDA PAGN
- MVI C,100
- CALL BIDA
- MVI C,10
- CALL BIDA
- ADI '0'
- RET
- BIDA MVI B,'0'-1
- INR B
- SUB C
- JNC BIDA+2
- ADD C
- MOV D,A
- MOV A,B
- CPI '0'
- JNZ BINZ
- MOV A,E
- ORA A
- MOV A,D
- RZ
- BINZ INR E
- MOV A,B
- CALL OUTC
- MOV A,D
- RET
-
- ;COMMAND DECODER AND PRINT LOOP
- ;THIS IS THE MAIN TEXT AND WORD PROCESSING LOOP
- ;HERE, WE GET THE NEXT CHAR FROM TEXT AND SEE
- ;IF A COMMAND, OR PROCESSED TEXT
-
- PRIN LHLD APNT ;SOURCE TEXT POINTER
- PRLP MOV A,M
- INX H
- CPI 3
- JC EOF
- CPI ':' ;COLON=BEGINNING OF COMMAND
- JZ CMND
- CALL CAPR ;DO CASE PROCESSING
- JC PRLP ;LETTER WAS TO BE IGNORED
- MOV B,A
-
- ;TEST IF DIRECT OUTPUT OF NEXT CHAR
-
- CPI 5BH ;CONTROL K?
- JNZ PROC ;NO
- MOV B,M ;OUTPUT WITHOUT QUESTION
- INX H
- PROC LDA JFLG ;PROCESS A LETTER
- ORA A
- MOV A,B
- SHLD APNT
- JZ NOFM
- CALL FMAT ;EITHER LEFT OR TOTAL JUST.
- JMP PRIN
- NOFM CALL UFMT ;NO JUSTIFICATION
- JMP PRIN
- EOF CALL CLOS ;CLOSE PENDING LINE
- XRA A
- STA EOT
- CALL NPAG
- MVI A,0FFH
- STA EOT
- JMP MAIN
-
- ;CASE PROCESSING SUBROUTINE
- ;RETURN WITH CARRY SET IF CHAR IS TO BE
- ;IGNORED. (IE WAS A SHIFT COMMAND)
-
- ;CHECK IF SHIFT OR UNSHIFT COMMAND
-
- CAPR CPI 5EH ;CONTROL N
- JZ UCAS
- CPI 5CH ;CONTROL L
- JZ LCAS
-
- ;CHECK AND PROCESS UPPER AND LOWER CASE
-
- MOV B,A
- LDA CASE
- CPI 3
- JZ CASX ;ZERO SAYS SHIFT LOCKED UP
-
- ;LAND HERE, EITHER SINGLE SHIFT OR LOWER CASE
- ;TEST FOR SINGLE SHIFT
-
- CPI 1 ;1=SINGLE SHIFT
- MVI A,0 ;Z FLAG STILL PRESERVED
- STA CASE ;CLEAR IT ANYWAY
- JZ CASX ;ZERO SAYS SINGLE SHIFT
-
- ;LAND HERE, LOWER CASE COND
- ;TEST IF IT IS ALPHA
-
- MOV A,B
- CPI 'A'
- JC CASX ;NOT ALPHA
- CPI 'Z'+1
- JNC CASX ;NOT ALPHA
-
- ;LAND HERE, CONVERT TO LOWER CASE
- MVI A,20H
- ORA B
- MOV B,A
-
- ;EXIT WITH CARRY BIT CLEAR
-
- CASX ORA A
- MOV A,B
- RET
- ;PROCESS UNSHIFT OR LOWER CASE MODE
-
- LCAS XRA A
- JMP NOLCK
-
- ;PROCESS SHIFT (EITHER SINGLE OR SHIFT LOCK)
-
- UCAS LDA CASE
- CPI 1
- JZ LOCK
- MVI A,1 ;SINGLE SHIFT
- JMP NOLCK
- LOCK MVI A,3
- NOLCK STA CASE
- STC ;SET CARRY, IGNORE LETTER
- RET
-
-
-
- ;COLON WAS ENCOUNTERED IN TEXT
- ;THIS TESTS NEXT TWO CHARACTERS
- ;AGAINST ALL COMMANDS TO FIND COMMAND
- ;AND CALL IT
-
- CMND MOV B,M
- INX H
- MOV C,M
- INX H
- SHLD CEPT ;POINTS TO DELIMITER
- LXI H,CTAB
-
- ;LOOP TO FIND MATCH
-
- CLOP MOV A,M
- INX H
- ORA A
- JZ CRTN
- CMP B
- JZ ONEM
- ;HERE FIRST LETTER FAIL
- INX H
- INX H
- INX H
- JMP CLOP
- ;HERE FIRST LETTER MATCH
- ONEM MOV A,M
- INX H
- CMP C
- JZ TWOM
- ;HERE SECOND LETTER FAIL
- INX H
- INX H
- JMP CLOP
- ;COMMAND MATCH
-
- TWOM MOV E,M ;LOAD ADDR
- INX H
- MOV D,M
- LHLD CEPT
- SHLD APNT ;POINTING AT DELIMITER
- LXI H,PRIN ;SET UP RETURN
- PUSH H
- XCHG
- PCHL ;GO TO COMMAND ROUTINE
-
-
- ;FAILED TO MATCH A COMMAND, SO PRINT TEXT
-
- CRTN LHLD APNT
- MOV B,M
- INX H
- JMP PROC
-
- ;TAPE INPUT ROUTINE
-
- FDIN CALL INIR
- LXI H,TEXT
- TPLP CALL GBYT
- MOV M,A
- INX H
- JNC TPLP ;NO EOF FOR FDOS
-
- ;FOR TAPE, I WOULD CHECK FOR VALUE LESS THAN 3
- ;IE BINARY 1=EOF FOR TAPE
- ;AND CARRY SET = EOF FROM FDOS
-
- DCX H
- MVI M,1
- JMP MAIN
-
-
- ;THIS IS THE INTERACTIVE PORTION OTHER THAN DIALOG
- ;ADDED FOR FDOS. ALLOWS 'L' OR 'P' OR 'Q' ONLY
- ;LOAD OR PRINT OR QUIT
-
- MAIN CALL ECHO1
- LXI H,PROMPT
- CALL TXTYP
- CALL CI ;GET CHAR FROM CONSOLE
- MOV C,A
- CALL ECHO1
- MOV A,C
- CPI 'L'
- JNZ MAIF
-
- ;LOAD FROM DISC OR TAPE
-
- JMP FDIN
-
- PROMPT DB '...$'
-
- MAIF CPI 'P'
- JNZ MAIQ
-
- ;PROCESS TEXT AND EMBEDDED COMMANDS
-
- LXI H,TEXT
- SHLD APNT
- CALL CLOS
- CALL NEWL
- JMP PRIN
-
- MAIQ CPI 'Q'
- JNZ MAIN ;IF NOT L,P,OR Q LOOP
-
- ;RETURN TO MONITOR
-
- JMP RESTRT
-
- ;ECHOS ON CONSOLE AND OUTS CRLF
-
- ECHO CALL CO
- ECHO1 PUSH B
- MVI C,CR
- CALL CO
- MVI C,LF
- CALL CO
- POP B
- RET
-
- ;OUTPUT CARG RTRN AND LINE FEED TO PRINTER
- ;RETURNS WITH CR IN A
-
- CRLF MVI A,CR
- CALL OUTW
- MVI A,LF
- CALL OUTW
- MVI A,CR
- RET
-
- ;THE COMMAND TABLE IN SYS-8 FORMAT
- ;IE TEXT LETTERS HAVE REVERSED ORDER
-
- CTAB DW 'DM'
- DW DMAR
- DW 'DT'
- DW DTAB
- DW 'PL'
- DW DPAG
- DW 'JT'
- DW TOTJ
- DW 'JE'
- DW ENDJ
- DW 'JL'
- DW LEFJ
- DW 'CT'
- DW CENT
- DW 'LF'
- DW LNFD
- DW 'DB'
- DW DBRK
- DW 'BP'
- DW BRKP
- DW 'NP'
- DW NPAG
- DW 'CM'
- DW MIDC
- DW 'PN'
- DW SETP
- DW 'SP'
- DW SPAZ
- DW 'PT'
- DW PGTP
- DW 'PB'
- DW PGBT
- DW 'TM'
- DW TMES
- DW 'BM'
- DW BMES
- DW 'PG'
- DW FPAG
- DW 'CC'
- DW CEND
- DW 'OF'
- DW OPOF
- DW 'ON'
- DW OPON
- DB 0
-
- ;TERMINATE A COMMAND
- ;CR,COMMA,SPACE, OR NOTHING ARE OK
-
- CTRM LHLD APNT
- MOV A,M
- INX H
- SHLD APNT
- CPI CR
- RZ
- CPI ' '
- RZ
- CPI ','
- RZ
- DCX H
- SHLD APNT
- RET
-
- ;FIND DELIMITER WITHIN A COMMAND
- ;SPACE AND COMMA ARE ACCEPTED
-
- CDEL LHLD APNT
- MOV A,M
- INX H
- CPI ','
- RZ
- CPI ' '
- RZ
- DCX H
- RET
-
- ;CLOSE OR END CENTER TAB COMMAND
-
- CEND CALL OUTL
- JMP CTRM
-
- ;IMMEDIATELY FORCE A PAGE START
-
- FPAG CALL DVDR
- JMP CTRM
-
- ;DEFINE MARGINS. LEFT, RIGHT
-
- DMAR CALL GARG
- STA LMAR
- STA BRTB ;SET THAT TOO
- CALL GARG
- STA RMAR
- CALL CLOS
- CALL NEWL
- JMP CTRM
-
- ;DEFINE TABS. TAB1,TAB2,TAB3, ETC. TO 14
-
- DTAB LXI H,TTAB
- SHLD TBAD
- DTBL CALL CDEL
- JNZ DTBX
- CALL ADEC
- MOV A,L
- LHLD TBAD
- MOV M,A
- INX H
- SHLD TBAD
- JMP DTBL
- DTBX LHLD TBAD
- MVI M,0
- JMP CTRM
-
- ;SET TOTAL JUSTIFICATION MODE
-
- TOTJ MVI A,2
- STA JFLG
- JMP CTRM
-
- ;SET LEFT JUSTIFICATION MODE
-
- LEFJ MVI A,1
- STA JFLG
- JMP CTRM
-
- ;CLOSE PRESENT LINE AND SET TO NO JUST. MODE
-
- ENDJ XRA A
- STA JFLG
- CALL CLOS
- JMP CTRM
-
- ;CENTER TAB, TAB, MESSAGE TO BE CENTERED
-
- CENT CALL GARG ;GET TAB
- CENA STA CETM
- CALL CDEL
- JNZ CTRM
- SHLD CEPT
- CALL CLOS
- CENP MVI C,0
- LHLD CEPT
-
- ;COUNT CHARS IN MESSAGE
-
- CECC MOV A,M
- INX H
- CALL CAPR ;DO CASE PROCESSING
- JC CECC ;LETTER IS TO BE IGNORED
- INR C
- CPI CR
- JNZ CECC
-
- ;COMPUTE POSN OF FIRST LETTER OF MESSAGE
-
- MOV A,C
- ORA A
- RAR
- MOV C,A
- LDA CETM
- SUB C
-
- SHLD APNT ;POINTS PAST MESSAGE
- MOVL LXI H,OBUF ;COMPUTE LADR FOR MESSAGE
- CALL ADAH
- XCHG
- LHLD CEPT ;START OF MESSAGE ADDRESS
- CEMV MOV A,M ;MOVE IT TO OBUF
- INX H
- CALL CAPR ;DO CASE PROCESSING AGAIN
- JC CEMV ;LETTER TO BE IGNORED
- CPI CR
- RZ
- STAX D
- INX D
- JMP CEMV
-
- ;DEFINE PAGE LENGTH
-
- DPAG CALL GARG
- STA PLEN
- JMP CTRM
-
- ;LINE FEED COMMAND (IGNORE ZERO LF'S)
-
- LNFD CALL GARG
- STA CETM
- CALL LFDO
- JMP CTRM
-
- ;DO LINE FEEDS AND KEEP TRACK OF POSITION ON PAGE.
- ;IF NEW PAGE, REST OF LF COMMAND IS FORGOTTEN
-
- LFDO CALL CLOS
- LDA CETM
- ORA A
- RZ
- MOV C,A
- LFLP CALL CRLF
- LDA PPOS
- INR A
- STA PPOS
- LXI H,PLEN
- CMP M
- JNC NEXP
- DCR C
- RZ
- JMP LFLP
-
- ;DEFINE A PARAGRAPH BREAK. LF'S, TAB
-
- DBRK CALL GARG
- STA BRLF
- CALL GARG
- STA BRTB
- JMP CTRM
-
- ;BREAK FOR A NEW PARAGRAPH
-
- BRKP CALL CLOS ;CLEAR LINE
- LDA PPOS ;GET PAGE POSITION
- ORA A
- JZ BRKT ;NO LF AT TOP OF PAGE
- LDA BRLF
- STA CETM
- CALL LFDO
- BRKT LDA BRTB
- CALL PUTB
- JMP CTRM
-
- ;FORCE BOTTOM PRESENT PAGE AND START NEW ONE
-
- NPAG LDA PAGN
- ORA A
- JZ DVDR
- CALL CLOS
- CALL NEWL
- LDA PLEN
- STA CETM
- CALL LFDO
- JMP CTRM
-
- ;CENTER MIDDLE (BETWEEN MARGINS), MESSAGE
-
- MIDC LDA RMAR
- LXI H,LMAR
- SUB M
- RAR ;DIVIDE BY TWO
- ADD M
- CALL CENA
- STAX D
- JMP OUTL
-
- ;PAGE NUMBER
-
- SETP CALL GARG
- STA PAGN
- JMP CTRM
-
- ;SET SPACING
-
- SPAZ CALL GARG
- STA SPAS
- JMP CTRM
-
- ;DEFINE TOP OF PAGE LENGTH AND ITS LINE OF OCCUPANCE
-
- PGTP CALL GARG
- STA TLEN
- CALL GARG
- STA TOPN
- JMP CTRM
-
- ;DEFINE BOTTOM SAME AS ABOVE
-
- PGBT CALL GARG
- STA BLEN
- CALL GARG
- STA BOTN
- JMP CTRM
-
- ;SET TOP MESSAGE ADDRESS AND THE MESSAGE TAB
-
- TMES CALL GARG
- STA TOPT
- CALL CDEL
- JNZ CTRM
- SHLD TOPA
- TMLP MOV A,M
- INX H
- CPI CR
- JNZ TMLP
- SHLD APNT
- RET
-
-
- ;SET BOTTOM MSG ADDRESS AND MESSAGE TAB
-
- BMES CALL GARG
- STA BOTT
- CALL CDEL
- JNZ CTRM
- SHLD BOTA
- JMP TMLP
-
- ;TURN OFF PRINTER OUTPUT
-
- OPOF XRA A ;ZERO TURNS OFF OUTPUT
- STA OPST ;MARK AT OUTPUT SYATUS
- JMP CTRM
-
- ;TURN ON PRINTER
-
- OPON MVI A,0FFH ;NON-ZERO MEANS ON
- STA OPST ;MARK AT STATUS
- JMP CTRM
-
- ;GET THE NEXT ARGUMENT
-
- GARG CALL CDEL
- JNZ GARE
- CALL ADEC
- MOV A,H
- ORA A
- MOV A,L
- RZ
- GARE POP H
- JMP CTRM
-
- ;
- ;I/O ROUTINES
-
- ;CONSOLE INPUT OF CHARACTER (ECHOS TOO)
-
- CO PUSH H! PUSH D! PUSH B
- MOV E,C
- MVI C,2
- CALL BDOS
- POP B! POP D! POP H
- RET
-
- ;SEND A CHARACTER TO THE PRINTER
-
- PO PUSH H! PUSH D! PUSH B
- MOV E,C
- MVI C,5 ;LIST OUT FUNCTION
- CALL BDOS
- POP B! POP D! POP H
- RET
-
- ;GET CHAR FROM CONSOLE
-
- CI PUSH H! PUSH D! PUSH B
-
- MVI C,1
- CALL BDOS
- POP B! POP D! POP H
- RET
-
- ;TYPE A LINE OF TEXT ON CONSOLE
-
- TXTYP PUSH H! PUSH D! PUSH B
- XCHG
- MVI C,9
- CALL BDOS
- POP B
- POP D
- POP H
- RET
-
- ;INPUT A LINE OF TEXT FROM CONSOLE
-
- TXTIN PUSH H! PUSH D! PUSH B
- LXI D,CONBUF+65
- MVI C,65 ;CLEAR BUFFER TO SPACES
- MVI A,' '
- TXTN1 STAX D
- DCX D
- DCR C
- JNZ TXTN1
- MVI C,10
- CALL BDOS
- POP B! POP D! POP H
- RET
-
- ;OPEN FILE
-
- OPENF LXI D,INFCB
- MVI C,15 ;CPM FUNCTION FOR OPEN
- CALL BDOS
- CPI 255 ;FAILED TO OPEN IF = 255
- CMC
- RNZ
- LXI H,NOFMS ;FILE NOT FOUND MSG
- CALL TXTYP
- STC
- RET
-
- NOFMS DB 'FILE NOT FOUND$'
-
- ;GET A CHARACTER FROM DISK FILE
-
- GBYT PUSH H
- CALL DISKIN ;LIB ROUTINE TO GET BYTE
- POP H ; FROM DISK FILE
- RET
-
- ;INITIALIZE TO READ DISK FILE
-
- INIR CALL ECHO1 ;CRLF TO CONSOLE
- LXI H,GREET
- CALL TXTYP
- CALL TXTIN
- CALL ECHO1 ;CRLF TO CONSOLE
- LXI H,CONBUF+2 ;+2 FOR COUNTS
- LXI D,INFCB ; A LA CP/M FORMAT
- CALL MTFCB ;LIB ROUTINE TO MAKE FCB
- JC INIR ;ERROR, TRY AGAIN
- CALL OPENF ;FCB OK, OPEN IT
- JC INIR ;ERROR, TRY AGAIN
- LXI H,INBUF+128 ;INIT. FOR DISKIN
- SHLD INPTR
- RET
-
- GREET DB 'ENTER FILE NAME ',0DH,0AH,'$'
-
-
- ;PRINTER OUTPUT
-
- OUTC CPI CR
- JZ CRLF
- OUTW PUSH B
- ANI 7FH
- MOV C,A
- LDA OPST ;TEST IF OUTPUT ON
- ORA A
- CNZ PO ;ON IF NON-ZERO
- CALL CSTS
- ORA A
- CNZ ABTST ;KEY PRESSED ON CONSOLE
- MOV A,C
- POP B
- RET
-
- ;TEST FOR ABORT (CNTRL C)
-
- ABTST CALL CI
- CPI 3
- RNZ ;NOPE
- JMP RESTRT ;RETURN TO CP/M
-
- ;CONSOLE STATUS CHECK...RETURNS A NON-ZERO
- ; IF KEY PRESSED AT CONSOLE
-
- CSTS PUSH H! PUSH D! PUSH B
- MVI C,11
- CALL BDOS
- POP B! POP D! POP H
- RET
- ;++++++++++++++++++++++++++++++++++++++++++++++
- ;
- ; MAKE CP/M FILE CONTROL BLOCK
- ;
- ; MAKEFCB.LIB - VERSION 0.2 - 28 OCT 77
- ;
- ; JEFFREY W. SHOOK
- ; P.O. BOX 185
- ; ROCKY POINT, NEW YORK 11778
- ; (516) 744 7133
- ;
- ;++++++++++++++++++++++++++++++++++++++++++++++
-
-
- ; CREATE A CP/M FILE CONTROL BLOCK FROM
- ; A COMMAND STRING AT THE ADDRESS IN HL
- ; AND PLACE IT AT THE ADDRESS IN DE. RETURN
- ; WITH THE CARRY SET IF AN ERROR OCCURS.
-
-
- ; DEFINITIONS
-
- FCBSIZ: EQU 33
- FNMLEN: EQU 11 ; FILE NAME LENGTH
-
-
- MTFCB: PUSH H ; SAVE CMD STRING PTR
- PUSH D ; SAVE FCB ADDRESS
-
- LXI B,FCBSIZ; CLEAR ENTIRE FCB AREA
- MVI A,0 ;
- CALL FILLB ;
-
- POP D ; FILL FILE NAME WITH SPACES
- PUSH D ;
- INX D ;
- LXI B,FNMLEN;
- MVI A,' ' ;
- CALL FILLB ;
-
- POP D ; RESTORE POINTERS
- POP H ;
-
- CALL SKIPS ; SKIP LEADING SPACES
-
- INX H ; CHECK FOR DISK CODE
- MOV A,M ;
- DCX H ;
- CPI ':' ;
- JNZ MTFCB1 ; JUMP ON NO CODE
-
- MOV A,M ; TEST IF DISK CODE GOOD
- INX H ;
- INX H ;
- SBI '@' ;
- RC ; MAKE ERROR RETURN IF BAD
- CPI 'Z'+1 ;
- CMC ;
- RC ;
-
- STAX D ; STORE DISK CODE AT FCB + 0
- MTFCB1: INX D ;
-
- MVI C,8 ; PROCESS FILE NAME FIELD
- CALL GETNAM ;
-
- MOV A,M ; TEST FOR FILE TYPE SEPARATOR
- INX H ;
- CPI '.' ;
- JNZ MTFCB2 ;
-
- MVI C,3 ; PROCESS FILE TYPE FIELD
- CALL GETNAM ;
- MOV A,M ;
- INX H ;
-
- MTFCB2: CALL TERMT ; TEST FOR CORECT TERMINATOR
-
- RET
-
-
- ; PROCESS NAME FIELD
-
- GETNAM: MOV A,M ; GET CHAR FROM CMD STR
- INX H ;
-
- CPI '?' ; ALLOW AMBIG REFERENCE CHAR
- JZ GETNA1 ;
-
- CPI '*' ; FILL REST WITH ?
- JZ GETNA2 ;
-
- CALL VALCHR ; TEST FOR ALLOWED CHAR IN NAME
- JC GETNA3 ;
-
- GETNA1: STAX D ; STORE CHAR IN TFCB
- INX D ;
-
- DCR C ; CHECK NAME SIZE
- JNZ GETNAM ;
- RET ;
-
-
- GETNA2: MVI A,'?' ; FILL REST OF FIELD WITH ?
- MVI B,0 ;
- JMP FILLB ;
-
- GETNA3: INX D ; MOVE FCB PTR TO END OF FIELD
- DCR C ;
- JNZ GETNA3 ;
- DCX H ;
- RET ;
-
-
- ; TEST FOR VALID CHAR IN NAME FIELD
- ; RETURN WITH CARRY SET IF INVALID.
-
- VALCHR: CPI '*'
- CMC
- RZ
-
- CPI ','
- CMC
- RZ
-
- CPI '.'
- CMC
- RZ
-
- CPI ' '
- RC
-
- CPI '^'+1
- CMC
- RC
-
- CPI ':'
- CMC
- RNC
-
- CPI '@'
- RET
-
-
- ; TEST FOR VALID FILENAME TERMINATOR CHAR
- ; RETURN WITH CARRY SET IF INVALID.
-
- TERMT: CPI ' '
- RZ
-
- CPI ','
- RZ
-
- CPI CR
- RZ
-
- CPI ';'
- RZ
-
- STC
- RET
-
-
- ; SKIP SPACES IN CMD STRING
-
- SKIPS: MVI A,' '
- SKIPS1: CMP M
- RNZ
- INX H
- JMP SKIPS1
-
-
- ; FILL BLOCK WITH VALUE
-
- ; ENTER WITH:
- ; A = VALUE FOR FILL
- ; DE = START OF BLOCK
- ; BC = LENGTH OF BLOCK
-
- CLRB: MVI A,0
-
- FILLB: INR B
- DCR B
- JNZ FILLB1
- INR C
- DCR C
- RZ
-
- FILLB1: STAX D
-
- INX D
- DCX B
- JMP FILLB
-
-
-
- ;++++++++++++++++++++++++++++++++++++++++++++++
- ;
- ; SEQUENTIAL DISK CHARACTER INPUT
- ;
- ; DISKIN.LIB - VERSION 1.0 - 18 SEP 77
- ;
- ; J.W. SHOOK, P.O. BOX 185, ROCKY POINT, NY 11778
- ;
- ;++++++++++++++++++++++++++++++++++++++++++++++
-
- ; BEFORE READING A FILE SEQUENTIALLY
- ; THE FOLLOWING INITIAL CONDITIONS
- ; MUST BE ESTABLISHED.
-
- ; 1) A CP/M FILE CONTROL BLOCK
- ; CONTAINING THE FILE NAME MUST
- ; START AT LOCATION INFCB.
- ; 2) A 128 BYTE BUFFER AREA MUST
- ; START AT LOCATION INBUF.
- ; 3) THE FILE MUST BE SUCCESSFULLY
- ; OPENED.
- ; 4) THE NEXT RECORD POINTER IN
- ; THE FILE CONTROL BLOCK MUST BE
- ; SET TO ZERO.
- ; 5) THE WORD AT LOCATION INPTR
- ; MUST BE SET TO INBUF+128 TO
- ; MARK THE BUFFER AS EMPTY.
- ; 6) TO READ A FILE AGAIN, JUST SET
- ; NEXT RECORD TO ZERO, AND
- ; RESET INPTR.
-
- ; READ CHARACTER FROM FILE
-
- DISKIN: LHLD INPTR ; TEST BUFFER POINTER
- LXI D,-(INBUF+128)
- DAD D
- MOV A,H
- ORA L
- CZ RDREC ; IF EMPTY, READ NEXT RECORD
- RC ; RETURN ON BAD READ
- LHLD INPTR ; GET CHAR FROM BUFFER
- MOV A,M
- INX H ; MOVE BUFFER POINTER
- SHLD INPTR
- RET
-
-
- ; REFILL DISK INPUT BUFFER
-
- RDREC: LXI D,INBUF ; SET DMA ADDRESS
- MVI C,SDMA
- CALL BDOS
- LXI D,INFCB ; READ A RECORD
- MVI C,READ
- CALL BDOS
- RAR ; SET CARRY ON BAD READ
- LXI H,INBUF ; SET POINTER TO BUFFER START
- SHLD INPTR
- RET
-
- ;MESSAGE FOR TELLING OPERATOR ABOUT NEW PAGE
-
- PAGMS DB 'PRESS ANY KEY WHEN READY FOR NEW PAGE$'
-
- ;DEFINE VARIABLES
-
- RESTRT EQU 0 ;CPM REBOOT
- BDOS EQU 5 ;CP/M ENTRY FOR I/O
- READ EQU 20 ;CP/M READ NEXT RECORD FUNCTION
- SDMA EQU 26 ;CP/M SET DMA ADDRESS FUNCTION
- CR EQU 13
- LF EQU 10
- EOT DB 0FFH ;LAST PAGE PRINTED IF ZERO
- OPST DB 0FFH ;OUTPUT ON OR OFF STATUS
- TSTG DB 0 ;TEMP STORAGE FOR BMSG
- CASE DB 3 ;UPPER CASE LOCK INITIALLY
- SFLP DB 0 ;FLOP FOR EVERY RND SPACE
- RNDV DB 5AH ;SEED FOR RANDOM NUMBER
- LCHR DB 0 ;LAST CHAR FOR TOTAL JUST.
- CETM DS 1 ;CENTR TAB OR CHAR COUNT
- CEPT DS 2 ;CENTR TEXT POINTER
- LMAR DB 10 ;LEFT MARGIN
- RMAR DB 70 ;RIGHT MARGIN
- TTAB DB 15 ;TAB TABLE
- DB 22
- DB 30
- DB 45
- DB 0
- DS 10 ;UP TO 15 TABS
- TBAD DS 2 ;TAB TABLE POINTER
- SPAS DB 1 ;SPACING
- PLEN DB 45 ;PAGE LENGTH
- BRLF DB 1 ;NEW PARAGRAPH LF'S
- BRTB DB 15 ;NEW PARAGRAPH TAB
- TLEN DB 10 ;TOP LENGTH
- PAGN DB 0 ;PAGE NUMBER
- TOPN DB 0 ;MSG LINE NUMBER
- BOTN DB 0 ;MESSAGE LINE NUMBE
- TOPA DS 2 ;MSG ADDR
- BOTA DS 2 ;MSG ADDR
- TOPT DB 10 ;TOP TAB
- BOTT DB 10 ;BOTTOM TAB
- BLEN DB 10 ;BOTTOM LENGTH
- LPOS DB 1 ;LINE POSITION
- PPOS DB 1 ;PAGE POSITION
- JFLG DB 0 ;NO JUST. INITIALLY
- LADR DS 2 ;LPOS ADDR
- LEND DS 2 ;RIGHT MARGIN ADDRESS
- APNT DS 2 ;INPUT POINTER
- MAXL DB 135 ;MAXIMUM LINE LENGTH
- TCNT DB 0 ;OVERFLOW CHAR COUNT
- TEML DS 30 ;OVERFLOW BUFFER
- OBUF DS 136 ;OUTPUT BUFFER
- INBUF DS 128 ;DISK FILE INPUT BUFFER
- INFCB DS 33 ;FILE CONTROL BLOCK
- CONBUF DB 64 ;CONSOLE INPUT BUFFER
- DB 0
- DS 64
- INPTR DS 2 ;POINTER FOR DISKIN0V
- DS 32
- STACK
- TEXT END ;TEXT BUFFER STARTS HERE
-
- MOV C,A
- LDA CASE
- PUSH PSW
- BMAL MVI A,' ' ;SPACE OVER TO TAB
- CALL OUTC
- DCR C
- JNZ BMAL
- BMSL MOV A,M ;OUTPUT THE MESSAG