home *** CD-ROM | disk | FTP | other *** search
Text File | 1993-10-25 | 45.8 KB | 2,224 lines |
- ;.....
- ;
- ; (...Cont. from QL.001)
-
- ;.....
- ;
- ; we're no longer working with a compressed file
- ; normal, unsq & uncr all come here
- ; if we were extracting, go finish up, else
- ; find eof marker: only look in last sector read
- ; if no eof found, put one in at end of last sector
- ;
- FINDEOF:
- LD A,(EXTRACTING) ; Were we extracting?
- OR A
- JP NZ,EXTRDONE ; ***
-
- EX DE,HL ; Last dma now in HL
- LD BC,128
- XOR A ; Clr cy
- SBC HL,BC ; HL=start of last sector read
- LD A,EOF
- CPIR ; Look for eof thru 128 bytes
- JR Z,GOTEOF ; Eof found
- LD (HL),A ; Else put in our own eof marker
- ; Probably leaves some garbage at eof
-
- GOTEOF: LD (EOFADR),HL ; Save highest used adr
- XOR A ; Clr cy
- LD DE,(BUFPTR)
- SBC HL,DE
- LD (FILELEN),HL ; Save actual file len in bytes
-
- ; chk if we really have a text file
- ; assume it's text:
- ; IF the 1st byte is between 20h and 7fh or cr, lf or tab or formfeed
- ; AND 90% of 1st 100 chars are printable (for wordstar hi bits)
- ; if text, set ptrs to 1 char past every 22nd lf in buffer
- ; else, set up for hex/ascii dumping instead of chaos of earlier versions
- ; by setting ptrs to every 256 bytes of buffer
- ;
- ; 1st see if we really have a text file
- ;
- LD HL,(BUFPTR)
- LD A,(HL)
- CALL CHKOKCTRLS ; Cr,lf,tab?
- JR Z,CHKTEXT ; Text so far
- CP ' '
- JR C,ISNONTEXT ; Ctrl char 1st
- CP 7FH+1 ; This screens common init 0c3h
- JR NC,ISNONTEXT
-
- CHKTEXT:
- LD B,100 ; # to scan
- LD C,0 ; Count of non-text chars
-
- WASTEXT:
- LD A,(HL)
- INC HL
- AND 7FH ; Mask to ascii
- CALL CHKOKCTRLS
- JR Z,TEXTCH
- CP ' ' ; Some kind of ctrl char?
- JR NC,TEXTCH
- INC C ; Non-text++
-
- TEXTCH: DJNZ WASTEXT
-
- LD A,C ; Non-text count
- CP 10 ; If < 10/100 are non-text,
- JR C,ISTEXT ; It really is a text file
-
- ;.....
- ;
- ; setup for a non-text file
- ;
- ISNONTEXT:
- XOR A
- LD (AFLAG),A
- CALL TOGLA
-
- LD HL,(FILELEN)
- LD A,L
- OR A
- LD A,H ; # of 256 byte pgs
- JR Z,EVENPG ; Even page boundary
- INC A ; For overage
-
- EVENPG: LD (HIPG),A
-
- ; set pg ptrs to every 256 bytes of buffer
-
- LD B,A
- LD DE,(BUFPTR)
- DEC DE
- LD HL,(@PTRTBL)
-
- SETPP: LD (HL),E
- INC HL
- LD (HL),D
- INC HL
- INC D ; += 256 bytes
- DJNZ SETPP
-
- JP STICKINEOF ; Stick in eof adr for last pg finds
- ; - and print page 1
-
- ;................................
- ; ;
- CHKOKCTRLS: ; Subr to chk for ctrl chars ok in a text file
- CP TAB ; Ret with Z set if tab,cr,lf,ff, or eof
- RET Z ;
- CP CR ;
- RET Z ;
- CP FF ;
- RET Z ;
- CP LF ;
- RET Z ;
- CP 1AH ;
- RET ;
- ;...............................;
- ;.....
- ; Setup for a text file
- ;
- ; distinguish ws doc files by looking for 1st page break: 8ah
- ; if prev ch is 0dh or 8dh, assume it to be ws doc
- ;
- ISTEXT: LD A,0FFH ;
- LD (AFLAG),A ; Mark non-text flag false
- CALL TOGLA ;
- LD (WSDOC),A ;
-
- LD HL,(BUFPTR)
- LD BC,(FILELEN)
- LD A,8AH ; 1st possible ws doc pg break
- CPIR
- JP PO,NOPGBRK ; None found
- DEC HL
-
- STILLLF:
- DEC HL ; Back up to prev cr
- LD A,(HL)
- AND 7FH
- CP LF
- JR Z,STILLLF ; Skip if double sp
-
- CP CR
- JR NZ,NOPGBRK ; 8ah not preceded by 0dh or 8dh
-
- ; it's a real pg break: go thru file and chg all 8ah to temp 0ah
- ; push adrs on stk so we can restore later
-
- LD A,0FFh
- LD (WSDOC),A
-
- LD HL,0
- PUSH HL ; Flag top of stk
-
- LD HL,(BUFPTR)
- LD BC,(FILELEN)
- LD A,8AH
-
- FIND8AHNEXT:
- CPIR ; Look for 8ah to chg
- JP PO,NOPGBRK ; All 8ah chg to 0ah
- DEC HL ; HL now *8ah
- PUSH HL ; Save adr on stk for later
- ; No stk overflow chking done??
- LD (HL),LF ; Chg to real lf
- INC HL
- JR FIND8AHNEXT
-
- ; set pg ptrs to ch following every 22nd lf
-
- NOPGBRK:
- LD DE,(BUFPTR) ;
- LD HL,(@PTRTBL) ;
- LD (HL),E ;
- INC HL ;
- LD (HL),D ;
- INC HL ;
- EX DE,HL ;
-
- LD HL,(BUFPTR) ; Point to front of file
- LD BC,(FILELEN) ; Get actual file len
- LD IX,0 ; Pg ctr
-
- SET1: LD A,(DISPLAY) ; Usually every 22 lines
-
- SET2: PUSH AF ; Save line ctr
- LD A,LF
- CPIR ; Look for LF
- JP PO,SETDONE ; BC = 0 = last lf before eof
- POP AF ; Line ctr
- DEC A ; Is this the 22nd line?
- JR NZ,SET2 ; Not a pg break
-
- ; at pg break, store adr of start of next pg
-
- EX DE,HL ; DE=adr to store, HL=*ptrtbl
- LD (HL),E ; Store lo adr of pg ptr
- INC HL
- LD (HL),D ; Store hi adr
- INC HL
- EX DE,HL ; Rst ptrs
-
- INC IX ; Pg++
-
- ; chk for > 255 pgs NOT implemented
-
- JR SET1
-
- SETDONE:
- POP BC ; B = line ctr fr stk
- LD A,(DISPLAY)
- SUB B ; 22 - last line
- JR NZ,PARTIALPG ;
- LD A,B ; Display - 1
- JR NOPARTIALPG ; This partial is really a full pg
- PARTIALPG:
- INC IX ; For last partial pg
-
- NOPARTIALPG:
- LD (LASTPGLINES),A ; Moved down to here
- PUSH IX ; Pg ctr
- POP HL
- LD A,L ; Max 255 pgs allowed
- LD (HIPG),A ; Save highest pg #
-
- ; stick in eof adr for last pg finds
-
- LD HL,(EOFADR)
- EX DE,HL
-
- STICKINEOF:
- LD (HL),E
- INC HL
- LD (HL),D
-
- LD A,(AFLAG)
- OR A
- JR NZ,PRPG1 ; Skip this text stuff if in non-text
-
- ; if ws doc, restore 8ah removed before, adrs on stk
-
- LD A,(WSDOC)
- OR A
- JR Z,PRPG1 ; Not ws doc
-
- ; do the restore until we pop 0000 flag
-
- LD B,8AH
-
- POP8AHNEXT:
- POP HL ; Adr where 8ah was before
- LD A,H
- OR L ; At top of stk flag?
- JR Z,PRPG1 ; Yes, done
- LD (HL),B ; Replace 8ah
- JR POP8AHNEXT
-
- PRPG1: LD A,1
- LD (PAGE),A ; Force pg 1 & print it
-
- ; print the current page
-
- PRPG: CALL CLEARSCREEN
-
- ; chk for pg # beyond eof
-
- LD A,(HIPG)
- LD B,A
- LD A,(PAGE)
- CP B ; Pg # too big?
- JR C,PGNUMOK ; No
- LD A,B
- LD (PAGE),A ; Else, set highest pg num
-
- ; chk if doing hex/ascii dump
-
- PGNUMOK:
- LD A,(AFLAG)
- OR A ; Non-text mode?
- LD A,(PAGE)
- JR Z,PRTEXT ; No, do text
- CALL HEXASCII ; Else, dump 256 bytes like ddt
- JP GETCMD
-
- PRTEXT: LD L,A
- LD H,0
- DEC HL ; Pg 1 is ptd to by 0'th ptr
- ADD HL,HL ; *2 for word adr
- LD DE,(@PTRTBL) ;
- ADD HL,DE ; *start adr of pg we want
- LD E,(HL) ; Lo pg adr
- INC HL
- LD D,(HL) ; Hi pg adr
- EX DE,HL ; HL = adr of pg we want
- LD a,(NLINES) ;
- LD B,A ; Lines/pg ctr, faster than cp adrs
- DEC B
-
- ; B has # of lines to dump
-
- PUTNEXT:
- LD A,(FOUND)
- OR A ; Are we marking found $?
- JR Z,PUT1NEXT ; No
-
- CALL ATMATCHADR ; Are we at the found $ yet?
- JR NZ,PUT1NEXT ; No
-
- ; start hilite of found $
-
- PUSH BC ; Save line ctr
- CALL ONHILITE ;
- CALL Z,USEALT ; (If that failed, use alternate method)
-
- LD A,(STRLEN)
- LD B,A
-
- ; dump ch of found $ in reverse video
-
- INREVID:
- LD A,(HL)
- INC HL
- CALL PUTC ; In rev vid
- DJNZ INREVID
-
- ; stop hilite of found $
-
- CALL OFFHILITE
- CALL Z,USEALT
- XOR A
- LD (FOUND),A ; Took care of that match
- PUSH HL ; Save buffer ptr
- CALL FINDAGAIN ; Look for next occur of find$
- POP HL ; Buffer ptr
- POP BC ; Line ctr
- JR PUTNEXT
-
- ; dump non-find $ chars
-
- PUT1NEXT:
- LD A,(HL) ; Get char
- INC HL ; *char++
- AND 7FH ; Mask in case ws doc
- CP LF
- JR Z,FOUNDLF
- CP EOF ; Is it eof?
- JR Z,HITEOF
-
- ; all truncation logic removed to putc:
-
- SENDCH: CALL PUTC
- JR PUTNEXT
-
- FOUNDLF:
- DJNZ SENDCH ; Line ctr--
- LD (CURRLINE),HL ; *current line lf
-
- LD A,(LINEBYLINE)
- OR A ; Going line by line?
- JR Z,GETCMD ; No
- LD A,CR ; Else, don't put pg #
- CALL PUTC
- JR GET1
-
- HITEOF: DEC HL ; Back up to prev lf
- LD (CURRLINE),HL
-
- SAYEOF: LD A,(INCOMPLETE)
- OR A
- JR Z,REALEOF
- CALL WARNING ; Too big to fit
- JR GETCMD
-
- REALEOF:
- LD A,(COL)
- OR A
- CALL NZ,CRLF ; extra newline in case last line incomplete
- CALL MSG
- DB '*** End of File ***',0
-
- ;
- ; get a command from user & execute it. Default cmd is forward 1 page.
- ;
- GETCMD: CALL CRLF ; Move down to the "status line"
- CALL ONHALF
- LD A,(LIBRARY) ; Working w/ library?
- OR A ;
- LD HL,MEMBER ; Use member name
- JR NZ,CPRFN ;
-
- NALIB: LD HL,FCB1+1 ; Else use file's name
- CPRFN: CALL PRNFN ;
- CALL PUTPGNUM ; And the page number
- CALL OFFHALF
-
- GET1: XOR A ; 0 out jumpto
- LD (JUMPTO),A
-
- CALL GETCHNUM ; Sets jumpto
-
- ; chk for jumpto
- ;
- LD B,A ; Save cmd
- LD A,(JUMPTO)
- OR A ; Jumpto <> 0?
- JR Z,JPTOIS0
-
- GOTO: LD (PAGE),A ; Else new pg is jumpto
- JP PRPG ; Jumpto that page
-
- JPTOIS0:
- LD A,B
- OR A ; A was 0 on ret?
- JR NZ,GET3 ; No, see if letter cmd
- LD A,(CORE)
- INC A ; Pg 0 if core, pg 1 if other
- JR GOTO ; Else, force tof
-
- ; chk letter cmds ;
-
- GET3: LD A,B ; Get cmd back
- CALL UCASE ;
- LD BC,ENDCMDS-CMDS ; # of cmds
- LD HL,CMDS
- CPIR ; Try to match cmd
- JR NZ,DEFAULT ; No matching cmd found
- LD H,B
- LD L,C ; Inverse cmd number
- ADD HL,HL ; *2 for word adrs
- LD DE,CMDADR
- ADD HL,DE ; *cmd adr we want
- LD E,(HL) ; Lo cmd adr
- INC HL
- LD D,(HL) ; Hi cmd adr
- EX DE,HL ; Cmd adr in HL
- JP (HL) ; Go exec it
-
- ;============================================================;
- ; The routines to handle commands when within a file follow. ;
- ;============================================================;
-
- CMDS: DB ' ' ;
- DB '-' ;
- DB 'A' ;
- DB 'B' ;
- DB CTRLC ;
- DB 'F' ;
- DB 'C' ;
- DB CTRLK ;
- DB 'L' ;
- DB 'Q' ;
- DB 'R' ;
- DB 'T' ;
- DB 'X' ;
- DB CTRLX ;
- DB ESC ;
- DB '/' ;
- DB '?' ;
- DB 'E' ;
- DB 'H' ;
- ENDCMDS:
-
- ; in reverse order
-
- CMDADR: DW HOME ; H
- DW ENDFIL ; E
- DW HELP ; ?
- DW HELP ; /
- DW QUIT ; Esc
- DW QUIT ; ^X
- DW QUIT ; X
- DW TOGGLETRUNC ; T
- DW REPEAT ; R
- DW QUIT ; Q
- DW SINGLELINE ; L
- DW SYSTEM ; ^K
- DW CASETGL ; C
- DW FIND ; F
- DW SYSTEM ; ^C
- DW BACKAPAGE ; B
- DW ALTDISPLAY ; A
- DW BACKAPAGE ; -
- DW SINGLELINE ; <sp>
-
- ;.....
- ;
- ; Major abort, right back to CP/M, skipping intermediate levels
- ;
- SYSTEM: LD A,0FFH
- LD (PUTCABRT),A
- JP QLEXIT ; Fix stack and ret to system
-
- ;.....
- ;
- ; default cmd is page forward, cancel any found marking
- ;
- DEFAULT:
- XOR A
- LD (FOUND),A
- LD HL,PAGE
- INC (HL) ; Page++
- DEF1: JP PRPG
-
- ;.....
- ;
- ; Go to end of file
- ;
- ENDFIL: XOR A
- LD (FOUND),A
- LD A,(HIPG)
- LD (PAGE),A ; Set page to highest page #
- JP PRPG
- ;.....
- ;
- ; "Home", ie go to top of file
- ;
- HOME: XOR A
- LD (FOUND),A
- LD A,1
- LD (PAGE),A ; Set page "1"
- JP PRPG
- ;......
- ;
- ; back 1 pg, cancel any found marking
- ;
- BACKAPAGE:
- XOR A
- LD (FOUND),A
-
- BACKPAGE:
- CALL PGMINUS1
- JR DEF1
-
- ;................................
- ;
- PGMINUS1: ;
- LD A,(PAGE) ;
- DEC A ; Page--
- JR NZ,NOTPG0 ; Chk for page #0
- LD A,(CORE) ; If core dumping, pg 0 is ok
- INC A ; Else, force pg 1
- ;
- NOTPG0: LD (PAGE),A ;
- RET ;
- ;...............................;
-
- ;.....
- ;
- ; Toggle case sensitivity (when using 'find' command)
- ;
- CASETGL:
- CALL MSG
- DB 'Case sensitive search: ',0
- CALL TOGLC ; Toggle the flag and associated 'text'
- SAYN: JR Z,SAYNO
- CALL MSG
- DB 'YES',0
- JR DBELOW
- SAYNO: CALL MSG
- DB 'NO',0
- DBELOW: CALL DELAY4
- JP PRPG
-
- ;.....
- ;
- ; Toggle long line truncation
- ;
- TOGGLETRUNC: ;
- CALL MSG ;
- DB 'Truncation: ',0 ;
- CALL TOGLT ;
- JR SAYN ;
-
- ;.....
- ;
- ; Toggle display between ascii <==> hex
- ;
- ALTDISPLAY:
- LD A,(CORE)
- OR A ; Dumping core?
- JP NZ,HELP ; ?
- ;; JP NZ,PRPG ; If so, dont allow toggle to ascii
- XOR A
- LD (FOUND),A ; Kill display of found $
- LD HL,(BUFPTR)
- LD (RESUMESRCH),HL ; Resume srchs at tof
- CALL MSG ;
- DB 'Display mode: ',0
- CALL TOGLA ;
- JR NZ,SAYHEX ;
- CALL MSG ;
- DB 'ASCII',0 ;
- JR DBELO3 ;
- SAYHEX: CALL MSG ;
- DB 'HEX',0 ;
- DBELO3: CALL DELAY4 ;
- LD A,(AFLAG) ;
- OR A ;
- JP Z,ISTEXT ; [re-] set up for a text file
- JP ISNONTEXT ; Else likewise for a non-text file
-
- ;................................
- ;
- TOGLC: LD HL,CFLAG ; Flag to be flipped
- LD DE,CSTATE ; Where to put text
- LD IX,PTNO ; For zero, point to "NO"
- LD IY,PTYES ; For non-zero, point to "YES"
- LD BC,PTYES-PTNO ; #of chars
- CALL FLIPIT ; Generic toggle subr to do all that
- RET ;
- ;...............................;
-
- ;................................
- ;
- TOGLT: LD HL,TFLAG ; Flag to be flipped
- LD DE,TSTATE ; Where to put text
- LD IX,PTNO ; For zero, point to "NO"
- LD IY,PTYES ; For non-zero, point to "YES"
- LD BC,PTYES-PTNO ; #of chars
- CALL FLIPIT ; Generic toggle subr to do all that
- RET ;
- ;...............................;
-
- ;................................
- ;
- TOGLA: LD HL,AFLAG ; Flag to be flipped
- LD IX,PTASC ; For zero, point to "ASCII"
- LD IY,PTHEX ; For non-zero, point to "HEX"
- LD BC,PTASC-PTHEX ; #of chars
- LD DE,ASTATE ; Where to put abv text
- CALL FLIPIT ; Generic toggle subr to do all that
- RET ;
- ;...............................;
-
- ;................................
- ;
- FLIPIT: LD A,(HL) ;
- CPL ;
- LD (HL),A ;
- OR A ; Nec?
- PUSH AF ; Save stat for poss analysis on rtn, also
- JR Z,NOW0 ; Br if now zero (use ix as pointer)
- PUSH IY ; Else use iy as pointer
- JR FL2 ;
- NOW0: PUSH IX ; Else use ix as pointer
- FL2: POP HL ; In any case, get it into hl
- LDIR ; Xfer appropriate text
- POP AF ; For poss analysis of result of toggle
- RET ;
- ;...............................;
-
- PTNO: DB ' NO'
- PTYES: DB 'YES'
-
- PTHEX: DB ' HEX' ;
- PTASC: DB 'ASCII'
-
- ;.....
- ;
- ; Put up the menu screen and process appropriate commands
- ;
- HELP:
- ;
- HELPLP: CALL CLEARSCREEN
- CALL SIGNON ; Commands and statuses
- CALL SUMMARY ; File summary
- CALL REQCMD ; Request command
-
- GETAGN: CALL GETCHR ; Get command
- CALL UCASE ; Upcase if necessary
- CP 'A' ; Only 'A', 'C', or 'T' will be accepted
- JR NZ,ISNTA ; - (or <ret>, obviously)
- CALL TOGLA ; Perf appropriate toggle action
- JR HELPLP ; And redisplay the new settings
-
- ISNTA: CP 'C' ; As above
- JR NZ,ISNTC ;
- CALL TOGLC ;
- JR HELPLP ;
-
- ISNTC: CP 'T' ; As above
- JR NZ,ISNTT ;
- CALL TOGLT ;
- JR HELPLP ;
-
- ISNTT: CP CR ; Check CR explicitly
- JP Z,PRPG ;
- CALL CHEXIT ; ^C, ^X rtn back to CP/M direct
- JP Z,QUIT ; Other 'exit type' chars go here
- JP PRPG ; Other commands continue?
-
- ;.....
- ;
- ; Forward one line
- ;
- SINGLELINE:
- LD A,(LINEBYLINE)
- INC A ; Turn on or incr linecount
- LD B,A ; Save linebyline flag
- LD A,(AFLAG)
- OR A ; In non-text mode?
- LD A,B ; Get linebyline flag back
- JR NZ,NON1LINE ; We're in non-text
- LD A,(NLINES)
- LD C,A
- DEC C
- LD A,B ; Get linebyline flag back again
- CP C ; 23 lines done 1 at a time?
- JR C,SAMEPAGE ; No
- JR NEWPAGE
-
- NON1LINE:
- CP 17 ; Next non-text pg is 17 line forwards
- JR C,SAMEPAGE
-
- NEWPAGE:
- LD A,(PAGE) ; Else this is a new pg
- INC A
- LD (PAGE),A
- LD A,1 ; Line 1 of that pg
-
- SAMEPAGE:
- LD (LINEBYLINE),A
- CALL CRLF ; Leave pg number intact
- LD B,1 ; 1 line to display
- LD HL,(CURRLINE) ; *curr line
- LD A,(AFLAG)
- OR A
- JP Z,PUTNEXT ; Display a text line
-
- ; else, dump a line in hex/ascii if not at eof
- ;
- LD A,(PAGE) ; Current page
- LD B,A
- LD A,(HIPG) ; Hipg
- XOR B
- JP Z,SAYEOF
- CALL DOHEXASCII
- JP GET1 ; Don't show pg#
-
- ;.....
- ;
- ; Find occurrrence of a string
- ;
- FIND: LD A,0FFH
- LD (FRCMDMODE),A
- CALL FINDASTRING ; B has pg+1 on ret fr find sub
-
- FINDCHK:
- LD A,(STRLEN)
- OR A ; Find $ given
- JP Z,PRPG ; No, redisplay same pg
-
- LD A,(FOUND)
- OR A ; Did we find it?
- JR Z,NOFIND ; No
- LD A,B ; B=pg+1 where found
- LD (PAGE),A
- JP BACKPAGE ; So back up a pg to print it
-
- NOFIND: CALL MSG
- DB CR,LF,' ** Not Found **',0
- LD A,(INCOMPLETE)
- OR A
- CALL NZ,WARNING ; Couldn't search entire file
- JP GETCMD
-
- ;.....
- ;
- ; Repeat find occurrence of a string
- ;
- REPEAT: LD DE,(RESUMESRCH)
- LD A,D
- OR E ; Find in progress?
- JR Z,NOFIND ; No, report it
-
- LD A,0FFH
- LD (FRCMDMODE),A
- CALL FINDAGAIN ; BC has pg+1
- JR FINDCHK
-
- ;................................
- ;
- GETCHR: PUSH BC ;
- PUSH DE ;
- GETCHL: LD C,DIRIO ; Simple character input subroutine
- LD E,0FFH ; Read
- CALL BDOSC1 ;
- OR A ; Anything typed?
- JR Z,GETCHL ;
- POP DE ;
- POP BC ;
- RET ; Ret w/ char in A
- ;...............................;
-
- ;.....
- ;
- ; accumulate numeric jumpto
- ; return if non-numeric or jumpto > hipg
- ;
- GETCHNUM:
- IF ZCPR3
- CALL GETSPEED
- LD DE,DELAY/4
- LD HL,00
-
- DLYLP: ADD HL,DE
- DEC A
- JR NZ,DLYLP
- ELSE
- LD HL,DELAY
- ENDIF
-
- LD (TIMER),HL ; Reinit key delay timer
-
- WAIT: LD C,DIRIO ; Direct cons io
- LD E,0FFH ; Read
- CALL BDOSC1
- OR A ; Anything typed?
-
- IF DELAY
- JR NZ,GOTKEY ; Something typed
- LD A,(JUMPTO) ; Building a jumpto number?
- OR A
- JR Z,WAIT ; No, just waiting for godot
- LD HL,(TIMER)
- DEC HL ; Timer--
- LD (TIMER),HL
- LD A,H
- OR L ; Timer at 0?
- RET Z ; Yes, exec jumpto now
- JR WAIT ; Else loop
- ELSE
- JR Z,WAIT ; Wait for godot
- ENDIF
-
- ; chk for pg number digits to jump to
-
- GOTKEY: CP '0'
- RET C ; Non-numeric
- CP '9'+1
- RET NC
-
- ; it's a digit: echo it
-
- PUSH AF ; Save digit
- CALL PUTC
- POP AF
- SUB '0' ; Remove ascii # bias
- LD B,A ; Save n
-
- ; times 10 + add new digit
-
- LD A,(JUMPTO) ; So far
- ADD A,A ; *2
- LD C,A
- ADD A,A ; *4
- ADD A,A ; *8
- ADD A,C ; *10
- ADD A,B ; Add in new digit
- LD (JUMPTO),A ; So far
-
- ; 0 here jumps to tof
-
- RET Z
-
- ; see if approx enuf digits to deduce jp pg: hipg / 8 < jpto
-
- LD B,A
- LD A,(HIPG)
- SRL A
- SRL A
- SRL A ; Hipg / 8
- CP B ; Cy if < jpto?
- JR NC,GETCHNUM ; Might need 1 more digit
- RET
- ;------------------------------------------------------------------------------
- ;
- FINDAGAIN: ; Repeat last find if there ever was one
- ; Do find 1st if not
- LD DE,(RESUMESRCH) ; Repeat fr here if call fr display
- LD A,(FRCMDMODE) ;
- OR A ; Fr a real repeat cmd?
- JR Z,SET4MATCHSTART ; No, called fr display of matches
- ; So use resumesrch adr
- LD DE,(CURRLINE) ; Default: start repeat at top of next pg
- LD HL,(EOFADR) ;
- XOR A ;
- SBC HL,DE ; Start srch beyond eof?
- JR NC,SET4MATCHSTART ; >no
- LD DE,(BUFPTR) ; Repeat srch fr tof: circular
- ;
- SET4MATCHSTART: ;
- JP STARTSRCHHERE ;
-
- ; print find prompt, get $ to find, srch for it
- ;
- FINDASTRING:
- XOR A
- LD (HEXSRCH),A ; Not hex srch yet
- ld a,cr ;
- call putc ; Output a cr, no lf
- ld b,60 ; ? #of blanks needed to overwrite
- blp: call space ;
- djnz blp ;
- CALL MSG
- DB CR,'Find: ',0
- LD DE,STRMAX
- LD C,RDBUFF ; Read user $
- CALL BDOSC1
- LD A,(STRLEN)
- OR A
- JP Z,FINDFAILS ; Null $ aborts find
-
- ; chk if finding a string of hex bytes
- ; B = user input ctr--
- ; C = hi nbl flag if yes (0ffh), else C = hi nbl
- ; DE = *temp hex $
- ; HL = *user input chars
- ;
- LD B,A ; Ch count
- LD A,(STRING)
- CP HEXSIGNAL ; Hex signal ch?
- JR NZ,FINDTEXT ; No
-
- DEC B ; Count-- for signal char
- JR Z,FINDTEXT ; Find - only
- LD A,1
- CP B ; Find half nbl only?
- JR Z,FINDTEXT
- LD DE,HEXSTRING ; *temp hex out $
- LD HL,STRING+1 ; Pt at 1st valid hex ch
- LD C,0FFH ; Set hi/lo flag = hi nbl
-
- NEXTHEX:
- LD A,(HL) ; Next user char
- INC HL
- CALL MKHEXDIGIT ; Strip ascii
- JR C,FINDTEXT ; Bad hex digit, do normal text srch
- PUSH AF
- LD A,C
- CP 0FFH ; Doing hi nbl?
- JR NZ,LONBL ; No, doing lo nbl
-
- ; hi nbl goes in C
- ;
- POP AF
- SLA A
- SLA A
- SLA A
- SLA A ; After shift to 4 hi bits
- LD C,A ; Save hi nbl in C
-
- ; this also sets hi/lo nbl flag to lo (not hi)
- ;
- JR GOTHI
-
- LONBL: POP AF
- OR C ; Combine hi & lo nbls
- LD (DE),A ; Store into temp hex $
- INC DE ; *temp++
- LD C,0FFH ; Set hi nbl flag again
-
- GOTHI: DJNZ NEXTHEX
-
- ; ascii to hex transl done
- ;
- LD H,D
- LD L,E ; *last hex byte stored
- LD DE,HEXSTRING ; Base adr of hex$
- XOR A
- SBC HL,DE ; # of bytes stored
- LD A,L
- LD (STRLEN),A ; Adj string len
- LD C,A ; # of bytes to copy
- LD B,0
- LD HL,HEXSTRING ; Src
- LD DE,STRING ; Lst
- LDIR ; Copy hex$ to string buffer
- LD A,0FFH
- LD (HEXSRCH),A ; Call for a hex srch, no hi bit masking
-
- FINDTEXT:
- LD DE,(BUFPTR) ; Default srch start at tof
-
- LD A,(CORE)
- OR A ; Find in core dump?
- JR Z,FFILE ; No, in a file
- LD DE,0 ; Default find in core starts at adr 0
-
- FFILE:
- IF FINDFRTOP ; Start find on curr pg
- ELSE ; Avoid assembler specific .NOT. syntax
-
- LD A,(PAGE) ; Curr pg
- LD B,A ; Save curr pg
- LD A,(CORE)
- OR A
- JR NZ,FINCORE ; Pg 0 is 0'th ptr in core
- DEC B ; 0'th ptr is pg 1 if not core
-
- FINCORE: ;
- LD L,B ;
- LD H,0
- ADD HL,HL ; *2 for word adr
- LD DE,(@PTRTBL)
- ADD HL,DE ; Idx into ptrtbl
- LD E,(HL) ; Get pg adr
- INC HL
- LD D,(HL)
- ENDIF ; NOT FINDFRTOP
-
- ; DE set for start of srch
-
- STARTSRCHHERE:
- LD A,(FRCMDMODE) ; Are we in a find/repeat command?
- OR A
- JR NZ,SRCHFILE ; Yes, search rest of file
-
- LD A,(PAGE) ; Fetch ptr of next page
- ADD A,A
- LD C,A
- LD B,0
- LD HL,(@PTRTBL)
- ADD HL,BC
- LD A,(HL)
- INC HL
- LD H,(HL)
- LD L,A
- JR ENDSRCHHERE
-
- SRCHFILE: ; Search rest of file
- LD HL,(EOFADR)
- LD A,(AFLAG)
- OR A ; In nontext display?
- JR NZ,ENDSRCHHERE ; Yes
- DEC HL ; Dont allow srch for eof if in text display
-
- ; HL set for end of srch
-
- ENDSRCHHERE:
- XOR A ; Clr cy
- LD (FRCMDMODE),A ; Set not fr cmd mode
- SBC HL,DE ; Len left to scan
- JR C,FINDFAILS ; Borrow = start srch beyond eof
- JR Z,FINDFAILS ; At eof: nothing to scan
-
- LD B,H ; Len goes in
- LD C,L ; BC for cpir
- EX DE,HL ; HL=start srch adr
- LD IX,MATCHES ; *matches so far
- LD A,(HEXSRCH) ; Hex searching?
- OR A
- LD IY,GETHEX ; Use hex compare & get rtns
- JR NZ,MATCH1ST
- LD A,(CFLAG) ; Case sensitive search?
- OR A ;
- LD IY,GETUC ; Use upcase compare & get rtns
- JR Z,MATCH1ST
- LD IY,GETLC ; Else use lowercase compare & get rtns
-
- ; find the 1st char of $
-
- MATCH1ST:
- LD (IX),0 ; Count of chars matched so far
- LD DE,STRING ; *$
- CALL GSTRCHAR ; Get 1st char to find
- ; Diddle it according to cmp type
-
- MATCHLP:
- CALL DOCMP ; Use proper compare routine - cy set on match
- CPI ; Buffer++, cnt--
- JR C,MTCHD1 ; Matched 1st char
- JP PE,MATCHLP ; Continue looping if cnt >0
-
- FINDFAILS:
- XOR A ; Failure to find
- LD (FOUND),A
- LD (MATCHADR),A
- LD (MATCHADR+1),A
- LD HL,(BUFPTR) ; Repeat finds start at tof
- LD A,(CORE)
- OR A
- JR Z,FILEFAIL ; Failed file srch
- LD HL,00FFH ; Failed core srch
- ; Can't repeat on pg 1 anyway
- FILEFAIL:
- LD (RESUMESRCH),HL
- RET
-
- GSTRCHAR:
- JP (IY) ; Jump to get rtn
-
- DOCMP: PUSH BC ; Need a register
- DEC IY ; Dec ptr by 2
- DEC IY ; To point to CMP vector
- PUSH IY ; Save on stack
- INC IY ; Inc ptr by 2
- INC IY
- RET ; Jump to vector
-
- JR CMPHEX
-
- GETHEX: LD A,(DE)
- RET
-
- JR CMPLC
-
- GETLC: LD A,(DE)
- AND 7FH
- RET
-
- JR CMPUC
-
- GETUC: LD A,(DE)
- AND 7FH
- CALL UCASE
- RET
-
- ; mask high bit before compare
-
- CMPLC: LD B,(HL) ; *buffer
- RES 7,B ; Mask high bit
- CP B ; Compare
- JR Z2C ; Convert Z flag to cy
-
- ; simple compare
-
- CMPHEX: CP (HL) ; Simple compare
- JR Z2C ; Convert Z flag to cy
-
- ; convert both to uppercase before compare
-
- CMPUC: LD B,A ; Save
- LD A,(HL) ; *buffer
- AND 7FH ; Mask high bit
- CALL UCASE ; Make uppercase if lower
- CP B ; Compare (finally!)
- LD A,B
-
- Z2C: POP BC ; Restore
- SCF ; Set carry
- RET Z ; If Z flag set
- OR A ; Clear carry
- RET
-
- ; now try to match rest of $ sequentially
-
- MTCHD1: PUSH HL ; Push start adr of match +1
-
- MATCHSEQ:
- INC (IX) ; Bump successes
- LD A,(STRLEN) ; # to match
- CP (IX) ; Matched whole $?
- JR Z,FOUNDSTRING ; Yes
-
- INC DE ; $++
- CALL GSTRCHAR ; A = *$ (diddled)
- CALL DOCMP ; Compare it
-
- ; chk for eof
- ;
- CPI ; *buf++,cnt--
- JR C,MATCHSEQ ; This ch matched: chk next ch in $
- JP PO,FINDFAILS ; Fail if EOF
-
- ; 2nd ch or later failed to match: back to 1st ch matched + 1
- ;
- POP HL ; Restore *file to 1st ch matched + 1
- LD A,(IX) ; Count of successful matches
-
- BACK2CH1P1:
- INC BC ; Adj len remaining to srch
- DEC A ; Successes--
- JR NZ,BACK2CH1P1
- JP MATCH1ST ; Start srch again for 1st ch
-
- ; find out what pg match is in
- ;
- FOUNDSTRING:
- POP DE ; *1st matching char + 1
- DEC DE ; *1st matching char
- LD (MATCHADR),DE ; Actual match adr of 1st found ch
- LD L,A ; Strlen
- LD H,0
- ADD HL,DE
- LD (RESUMESRCH),HL ; Resume after this match
-
- LD IX,(@PTRTBL) ;
- LD A,(CORE) ; Ff if in core
- LD B,A ; 0 if file
-
- NEXTPG: INC B ; Pg++
- LD L,(IX) ; Lo pg adr
- INC IX
- LD H,(IX) ; Hi pg adr
- INC IX ; To next ptr
- XOR A ; Clr cy
- SBC HL,DE
- JR C,NEXTPG ; Not far enuf
- ; NC = HL > DE is 1 pg too far
- JR Z,NEXTPG ; HL = DE = 1st byte on next pg
-
- ; B has page # + 1 so do backpage
- ;
- LD A,0FFH
- LD (FOUND),A
- RET
-
- ;..............................................................................
- ;
- ; called fr find for hex digit input
- ; strip ascii stuff fr possible hex digit in a
- ; cy set if invalid
- ;
- MKHEXDIGIT: ;
- CP '0' ;
- RET C ; '0'
- CP '9'+1 ; Cy if '0' to '9'
- JR NC,CHKATHRUF ;
- AND 0FH ; Mask to hex nbl
- JR OKHEX ;
- ;
- CHKATHRUF: ;
- SET 5,A ; Tolower
- CP 'a' ;
- RET C ; Invalid
- CP 'f'+1 ; Cy if 'a' to 'f'
- CCF ;
- RET C ; No good
- ADD A,0A9H ; Make hex nbl
- ;
- OKHEX: SCF ;
- CCF ; Set no cy for ok
- RET ;
- ;...............................;
-
- ;==============================================================================
- ; General purpose (low level) subroutines
- ;==============================================================================
-
- ;------------------------------------------------------------------------------
- ; Screen management subroutines
- ;------------------------------------------------------------------------------
-
- ;..............................................................................
- ;
- ; Half Intensity on
- ;
- ONHALF: CALL BYECHK ; Remote user?
- RET NZ ; Yes, forget it and return
-
- PUSH HL ; Save callers HL
- LD A,(DIMSEQ) ; Is there a hardcoded sequence?
- OR A ;
- JR NZ,USEHC1 ; If so, use it no matter what
-
- ;................................
- ;
- IF ZCPR3 ; If ZCPR3, check for TCAP
- CALL GETVID ;
- CALL NZ,STNDOUT ; We have one, use it
- ENDIF ; NOT ZCPR3
- ;...............................;
-
- VDRET1: POP HL ; Restore caller's reg & rtn
- RET ;
-
- USEHC1: CALL ESCMSG ; Output the hardcoded sequence below
- DIMSEQ: DIMON ; Macro containing the sequence
- DB 0 ; Terminating byte
- JR VDRET1 ; Restore regs & rtn
-
- ;..............................................................................
- ;
- ; Half Intensity off
- ;
- OFFHALF:
- CALL BYECHK
- RET NZ
-
- PUSH HL
- LD A,(DMOSEQ)
- OR A
- JR NZ,USEHC2
-
- ;................................
- ;
- IF ZCPR3 ;
- CALL GETVID ;
- CALL NZ,STNDEND ;
- ENDIF ;
- ;...............................;
-
- VDRET2: POP HL
- RET
-
- USEHC2: CALL ESCMSG
- DMOSEQ: DIMOFF
- DB 0
- JR VDRET2
-
- ;..............................................................................
- ;
- ; Reverse video on
- ;
- ONHILITE:
- CALL BYECHK
- INC A ; (complement sense of zero status)
- RET Z ; Return, indicating 'failure'
-
- PUSH HL
- LD A,(REVSEQ)
- OR A
- JR NZ,USEHC3 ; Go use hardcoded sequence if there is one
- ; (else process Z3 if appropriate rtn w/ 0)
- ;................................
- ;
- IF ZCPR3 ;
- CALL GETVID ;
- JR Z,VDRET3 ; Rtn w/ zero cc, indicating failure
- CALL STNDOUT ;
- OR 0FFH ; Rtn w/ non-zero cc, indicating success
- ENDIF ;
- ;...............................;
-
- VDRET3: POP HL
- RET
-
- USEHC3: CALL ESCMSG
- REVSEQ: REVON
- DB 0
- OR 0FFH ; Return, indicating success
- JR VDRET3
-
- ;..............................................................................
- ;
- ; Reverse video off
- ;
- OFFHILITE:
- CALL BYECHK
- INC A
- RET Z
-
- PUSH HL
- LD A,(RVOSEQ)
- OR A
- JR NZ,USEHC4
-
- ;................................
- ;
- IF ZCPR3 ;
- CALL GETVID ;
- JR Z,VDRET4 ;
- CALL STNDEND ;
- OR 0FFH ;
- ENDIF ;
- ;...............................;
-
- VDRET4: POP HL
- RET
-
- USEHC4: CALL ESCMSG
- RVOSEQ: REVOFF
- DB 0
- OR 0FFH
- JR VDRET4
-
- ;..............................................................................
- ;
- ; Clear the screen
- ;
- CLEARSCREEN:
- PUSH HL ; Save callers HL
- PUSH BC ; And bc
- LD A,(DELAYN) ; Is there a delay?
- OR A
- CALL NZ,DELAYIT
- SUB A ; Clear the delay
- LD (DELAYN),A
- CALL BYECHK ; Remote user?
- JR NZ,USELFS ; Yes, use lf's to clear screen
-
- LD A,(CLRSEQ) ; Is there a hardcoded sequence?
- OR A ;
- JR NZ,USEHC ; If so, use it no matter what
-
- ;................................
- ;
- IF ZCPR3 ; If ZCPR, we have a possible alternative
- CALL GETVID ; Check for TCAP
- JR Z,USELFS ; If none, resort to using LF's (pretty poor)
- CALL CLS ; We have one, use it
- JR VDRET ; Clr some flags and return
- ENDIF ; ZCPR3
- ;...............................;
-
- ;.....
- ;
- USELFS: CALL CRLF ;
- ;; LD A,(ROWS) ; Screen height
- LD A,24 ;
- LD B,A ;
-
- LFLOOP: LD A,LF ; ??
- CALL PUTC ;
- DJNZ LFLOOP ;
-
- ;.....
- ;
- VDRET: XOR A ; Clear some flags and return
- LD (COL),A ; Col ctr
- LD (LINEBYLINE),A ; Line by line flag
- POP BC ;
- POP HL ; Restor caller's hl
- RET ;
-
- ;................................
- ;
- USEHC: CALL ESCMSG ; Output hardcoded clearscreen sequence below
- ;
- CLRSEQ: CLRSCR ; Macro containing clearscreen byte sequence
- DB 0 ; End of msg marker
- JR VDRET ; Return is same as above
-
- ;..............................................................................
- ;
- USEALT: PUSH HL ; Nec?
- CALL MSG ; Alternate method to mark 'found' strings
- MRKCHR ; Character (or sequence) to use
- DB 0 ; Guarantee termination
- POP HL ;
- RET ;
-
- ;------------------------------------------------------------------------------
- ;
- ; Memory initialization routines
-
- ;................................
- ;
- INI1MEM:LD HL,INIT1 ; Init all memory from "init1" - "end1init"
- LD DE,INIT1+1 ;
- LD BC,END1INIT-INIT1-1
- LD (HL),0 ;
- LDIR ;
- RET ;
- ;...............................;
-
- ;................................
- ;
- INI2MEM:LD HL,INIT2 ; Init all memory from "init2" - "end2init"
- LD DE,INIT2+1 ;
- LD BC,END2INIT-INIT2-1
- LD (HL),0 ;
- LDIR ;
- ;
- LD HL,(@PTRTBL) ; Also clear the whole 1k 'ptrtbl'
- LD D,H ;
- LD E,L ;
- INC DE ;
- LD BC,1024-1 ;
- LD (HL),0 ;
- LDIR ;
- RET ;
- ;...............................;
-
- ;------------------------------------------------------------------------------
- ;
- ; print a null terminated string at ret adr of this sub
- ; ctrl chars are ok in ql msgs
- ;
- MSG: LD A,0FFH
- LD (FROMQLMSG),A ; Flag this as a ql msg: ctrl chars are ok
- ;
- MSG1: EX (SP),HL ; HL=*string
- LD A,(HL) ; Get char
- INC HL ; *ch++
- EX (SP),HL ; Restore ret adr if done
- OR A ; Ch = 0 msg term?
- JR Z,MSGDONE ;
- CALL PUTC ; Print ch
- JR MSG1 ;
- ;
- MSGDONE: ;
- LD (FROMQLMSG),A ; Mark false
- RET ;
- ;...............................;
-
- ;...............................;
- ; Inline compare string
- ; Compare (HL) with (SP) - ignore hi bits
- ; Success if null reached on either
- ; Only A is destroyed
- ;
- ILCMP: EX DE,HL
- EX (SP),HL ; Caller's DE now on stack
- PUSH DE ; Save caller's HL
-
- ILCLOOP:
- LD A,(HL) ; *s
- OR A ; null?
- JR Z,ILCDON
- LD A,(DE) ; *t++
- INC DE
- OR A ; null?
- JR Z,ILCDON
- XOR (HL) ; zero or 80h will match
- INC HL ; s++
- AND 7Fh ; mask hi bit
- JR Z,ILCLOOP ; Continue if matched
-
- XOR A ; Search for a null
- ILCFAIL:
- CP (HL) ; Found yet?
- JR Z,ILCF1 ; Yes, stop scanning
- INC HL ; s++
- JR ILCFAIL
-
- ILCF1: INC A ; Reset Z flag
-
- ILCDON: INC HL ; bump past null
- POP DE ; Caller's HL restored
- EX (SP),HL ; Retn addr on stack
- EX DE,HL ; Caller's DE restored
- RET ; Z flag set if compare succeeded
-
- ;................................
- ;
- UCASE: CP 'a' ; Upcase the character in A
- RET C ; 'a'-1 and below should be left alone
- CP 'z'+1 ; 'z'+1 and above should be left alone
- RET NC ;
- SUB 20H ; Else upcase it
- RET ;
- ;...............................;
-
- ;................................
- ; Downcase the character in A
- DCASE: CP 'A' ; 'A'-1 and below should be left alone
- RET C ;
- CP 'Z'+1 ; 'Z'+1 and above should be left alone
- RET NC ;
- ADD A,20H ; Else downcase it
- RET ;
- ;...............................;
-
- ;................................
- ;
- WHLCHK: ; Check wheel byte status, ret w. NZ if "on"
- IF ZCPR3 ;
- JP GETWHL ;
- ELSE ;
- ;
- LD A,(WHEEL) ;
- OR A ;
- RET ;
- ENDIF ;
- ;...............................;
-
- ;................................
- ;
- BYECHK: LD A,(BYE5FLAG+1) ; Actual existance of bye is chkd at prog init
- OR A ; That byte will be non-zero if bye was found
- RET Z ; This subr just returns that flag status
- LD A,0FFH ; (if not 0, guarantee 0FF in A [useful])
- RET ;
- ;...............................;
-
- ;................................
- ; Screen delay routines ;
- ;
- DELAY8: LD A,8 ; Note: Delays occur
- LD (DELAYN),A ; when screen is cleared,
- RET ; so multi-file operations
- DELAY4: LD A,4 ; are not slowed down.
- LD (DELAYN),A ;
- RET ;
- ;
- DELAYIT: ;
- DEC A ;
- JR Z,DELY1 ;
- CALL DELY1 ;
- JR DELAYIT ;
- ;
- DELY1: LD BC,0 ;
- LWAIT: NOP ;
- DJNZ LWAIT ;
- DEC C ;
- JR NZ,LWAIT ;
- RET ;
- ;...............................;
-
- ;................................
- ;
- SPACE2: CALL SPACE ; Output 2 spaces
- SPACE: LD A,' ' ; Output 1 space
- JP PUTC ;
- ;...............................;
-
- ;................................
- ;
- CRLF: LD A,CR ; Output a CR/LF sequence
- CALL PUTC ;
- LD A,LF ;
- ;
- ; fall thru to below ;
-
- ;................................
- ;
- ; 'Hi-level' character output routine, providing associated control functions.
- ;
- ; Character to be supplied in A. Regs BC,DE,HL,IX,IY are saved and restored
- ;
- PUTC: PUSH BC ; Save registers
- PUSH DE
- PUSH HL
- PUSH IX
- PUSH IY
-
- PUSH AF ; }
- CALL BYECHK ; } Process and handle on the fly aborts, etc.
- CALL NZ,CKABRT ; } (if running remote only). Only adds a few
- POP AF ; } cycles during local operation.
-
- AND 7FH ; Mask to ascii
-
- CP CR
- JR NZ,NOTCR
-
- ; cr zeroes col ctr
-
- XOR A
- LD (COL),A
- LD A,CR
- JR PUTCH
-
- NOTCR: LD B,A ; Save ch
- LD A,(TFLAG) ;
- OR A ; Truncation on?
- JR Z,NOTTOOLONG ; No, any line len ok
- LD A,(COL) ;
- CP COLUMNS-2 ; At max line len?
- JR C,NOTTOOLONG ; No, line len still ok
- JR NZ,BIOSRET ; Already marked '>': skip this char
-
- ; at truncation pt: mark with '>'
-
- INC A ; To columns-1
- LD (COL),A ; So next ch won't mark trunc again
- LD A,TRUNKCHAR ; Truncation marker
- JR PUTCH
-
- NOTTOOLONG:
- LD A,B ; Get ch back
-
- CP ' '
- JR NC,PRINTABLE ; Count all printables
-
- ; chk ctrl chs we can handle
-
- CP LF ; Masked lf is ok
- JR Z,PUTCH
-
- CP TAB
- JR NZ,NOTTAB
-
- ; adjust col count assuming tabs 0,8,16...
-
- IF EXPANDTABS ; Expand tabs to equiv spaces
- LD A,(COL)
- CPL
- AND 7 ; Mod 8
- INC A
- LD B,A ; Spaces to next tab stop
-
- XTAB: CALL SPACE ; Send spaces to tab stop
- DJNZ XTAB
- JR BIOSRET ; Restore regs & ret
- ELSE ; Term can handle actual tab ch
- LD A,(COL)
- AND 0F8H ; Mask off lo 3 bits
- ADD A,8 ; To next tab stop
- LD (COL),A ; Set new column
- LD A,TAB
- JR PUTCH
- ENDIF ; Expand tabs
-
- NOTTAB: CP BS
- JR NZ,NOTBS
- LD HL,COL
- DEC (HL) ; Col--
- JR PUTCH
-
- ; we must handle other ctrl chars specially, UNLESS they're coming from
- ; a ql message, like clear screen or an escape seq
- ; this should filter all remaining ws doc chars
- ;
- NOTBS: LD B,A ; Save curr ch
- LD A,(FROMQLMSG)
- OR A
- LD A,B ; Get curr ch back
- JR NZ,PUTCH ; Ctrl ch from a ql msg, takes no line space
-
- IF CTRLWORDSTAR
-
- ; Display using the combination ^ <char>
- ;
- PUSH BC ; Save a copy of the char, still in B
- LD A,'^' ; "control"
- CALL CONO ; Output that
- LD HL,COL ; Adjust for the "^" character
- INC (HL) ; Col++
- POP BC ; Get the control char back
- LD A,B ; (char was in B)
- OR 40H ; Make it the corresponding non-cntrl char
- JP NOTCR ; Start this routine all over again
- ENDIF ; CTRLWORDSTAR
-
- IF CTRLDIMVID
-
- ; Display using dim video
- ;
- PUSH BC ; Save the char, still in B
- CALL ONHALF ; Dim intensity
- POP BC ; Get the char back
- LD A,'@' ; Convert to letter
- OR B ;
- CALL CONO ; Print the char
- LD HL,COL ; Adjust for column
- INC (HL)
- CALL OFFHALF ; Back to full intensity
- JR BIOSRET ; And return
- ENDIF ; CTRLDIMVID
-
- IF CTRLDUMMY
-
- ; Display using default marker
- ;
- LD A,CTRLMARKER ; Defined char to use
- ENDIF ; CTRLDUMMY
-
- PRINTABLE:
- OR A ; Filter out NULL's, and don't incr COL
- JR Z,BIOSRET ;
-
- LD HL,COL ;
- INC (HL) ; Col++
-
- PUTCH: CALL CONO ; Output the character
-
- BIOSRET:
- JP BDOSRET ; Same code is there
-
- ;..............................................................................
- ;
- ; put a null terminated escape sequence string at ret adr of this sub
- ; avoid chg col ctr when init/term hiliting
- ; destroys A,HL
- ;
- ESCMSG: EX (SP),HL ; HL=*string
- LD A,(HL) ; Get char
- INC HL ; *ch++
- EX (SP),HL ; Restore ret adr if done
- OR A ; Ch = \0 msg term?
- RET Z ; Done
- LD HL,ESCMSG ; Ret adr is start of this rtn
- PUSH HL ; On stk
- PUSH BC ; Save regs
- PUSH DE ; In this order
- PUSH HL ; Putch: will restore them
- PUSH IX ;
- PUSH IY ;
- JR PUTCH ; Print char w/o chg to col ctr
- ; Returns to escmsg:
-
- ;................................
- ; Low-level single char output.
- CONO: ; Use BIOS or BDOS, as requested;
- IF USEBIOSCONOUT ;
- LD C,A ; Goes in C for BIOS
- LD HL,(BIOSCONOUT) ;
- JP (HL) ; Do it; return directly from there
- ELSE ;
- LD E,A ; Goes in E for BDOS
- LD C,CONOUT ; Console output function
- JP BDOSEV ; Output the char and return from there
- ENDIF ;
- ;...............................;
-
-
- PUTPGNUM:
- CALL MSG ; Start page title in lower left corner
- DB ': Page ',0
-
- ; print current pg number
-
- LD A,(PAGE)
- LD L,A
- LD H,0
- CALL B2DEC ; Convert to printable # & print
-
- CALL MSG
- DB ' of ',0
-
- ; print max pg number
-
- LD A,(HIPG)
- LD L,A
- LD H,0
- CALL B2DEC
-
- ; add marker if read was incomplete
-
- LD A,(INCOMPLETE)
- OR A
- JR Z,NOPLUS
- LD A,'+'
- CALL PUTC
-
- NOPLUS: CALL MSG
- DB ' Cmnd or ''?'' for Menu: ',0
- RET
-
- ;..............................................................................
- ;
- ; print binary # in HL as decimal, lead 0's suppressed
- ;
- IF DOSPLUS ; Under dos+
-
- B2DEC: LD D,H
- LD E,L
- LD C,211 ; New BDOS call to print DE as decimal #
- JP BDOSCALL ; &ret
- ELSE ; The long way under cp/m 2.2
-
- ; convert 16 bit binary # in HL to up to 5 ascii decimal digits & print
- ; suppress leading 0's
- ; rtn fr Alan Miller, 8080/z80 assembly language
- ;
- B2DEC: LD B,0 ; Leading 0 flag
- LD DE,-10000 ; 2's cpl of 10k
- CALL SUBP10
- LD DE,-1000
- CALL SUBP10
- LD DE,-100
- CALL SUBP10
- LD DE,-10
- CALL SUBP10
- LD A,L
- ADD A,'0' ; Ascii bias
- JP PUTC ; &ret
-
- ; subtract power of 10 & count
-
- SUBP10: LD C,'0'-1 ; Ascii count
-
- SUB1: INC C
- ADD HL,DE ; Add neg #
- JR C,SUB1
-
- ; one subt too many, add 1 back
-
- LD A,D ; Cpl DE
- CPL
- LD D,A
- LD A,E
- CPL
- LD E,A
- INC DE ; Add back
- ADD HL,DE
- LD A,C ; Get digit
-
- ; chk for '0'
-
- CP '1' ; '0'?
- JR NC,NONZERO ; No
- LD A,B ; Chk leading 0 flag
- OR A ; Set?
- LD A,C ; Get digit
- RET Z ; Skip leading 0
-
- PRDIGIT:
- JP PUTC ; Print interior 0
-
- NONZERO:
- LD B,0FFH ; Set leading 0 flag
- JR PRDIGIT
- ENDIF ; Not dosplus
- ;..............................................................................
- ;
- ; hex/ascii display code
- ; pg 0 is now really pg 0 if core dumping
- ; display 256 bytes from pg# in a
- ;
- HEXASCII:
- LD B,A ; Save pg to show
- LD A,(CORE)
- OR A
- JR NZ,HEXOFCORE ; Core dump 0'th pg ptr is pg 0
- DEC B ; 0'th pg ptr is page 1
-
- HEXOFCORE:
- LD H,B ;
- LD L,0
- LD DE,(BUFPTR) ; 1st pg of file dump is here
- LD A,(CORE)
- OR A ; Displaying memory?
- JR Z,DUMPHERE ; No, showing file
- LD DE,0 ; 1st pg is beg of mem
-
- DUMPHERE:
- ADD HL,DE ; HL pts to pg start adr
- ld a,(hipg) ; are we on last pg?
- dec a ; (core dumps don't matter)
- cp b
- jr NZ,dump16 ; if not, show 16
- ld a,(filelen) ; get low byte of filelen
- dec a ; 80->7f, 00->ff
- and 80h ; 8th bit set means even # of sectors
- jr nz,dump16 ; if even, show 16 lines
- ld b,8 ; else show only 8
- jr nxtlinehexasc
- dump16: LD B,16 ; Show 16 lines
-
- NXTLINEHEXASC:
- PUSH BC ; Save ctr
- CALL DOHEXASCII
- POP BC ; Restore ctr
- DJNZ NXTLINEHEXASC
- RET
-
- ; display 1 line (16 chs) of hex/ascii
- ; on entry: HL pts into buffer at start of line
- ; on exit: HL pts into buffer after last byte printed
-
- DOHEXASCII:
- LD B,16 ; # of bytes per line
-
- ; put the adr of this line
-
- PUSH HL ; Save ptr adr
- LD A,(CORE)
- OR A ; Displaying core?
- JR NZ,SHOWCOREADR ; Yes, show real adr
- LD DE,(BUFPTR)
- XOR A ; Clr cy
- SBC HL,DE ; Subtract start of buffer from real addr
- INC H ; Add 100h bias for cpm tpa
-
- SHOWCOREADR:
- LD A,H
- PUSH AF
- CALL PUTHINIBBLE
- POP AF
- CALL PUTLONIBBLE
- LD A,L
- PUSH AF
- CALL PUTHINIBBLE
- POP AF
- CALL PUTLONIBBLE
- CALL SPACE2
- POP HL ; Get ptr adr back
-
- ; chk if marking a found string
-
- HEXLOOP:
- LD A,(FOUND)
- OR A
- JR Z,HEXNOMARK ; Not marking
- LD A,(HEXSRCH)
- OR A
- JR Z,HEXNOMARK ; Showing on ascii side only
- CALL ATMATCHADR
- JR NZ,HEXNOMARK
- CALL ONHILITE
- LD A,(HL)
- INC HL
- PUSH AF ; Save byte to display
- CALL PUTHINIBBLE
- POP AF
- CALL PUTLONIBBLE
- CALL OFFHILITE
- PUSH BC
- PUSH HL
- CALL FINDAGAIN ; Find next match
- POP HL
- POP BC
- JR HEXBYTEDONE
-
- HEXNOMARK:
- LD A,(HL)
- INC HL
- PUSH AF ; Save byte to display
- CALL PUTHINIBBLE
- POP AF
- CALL PUTLONIBBLE
-
- HEXBYTEDONE:
- CALL SPACE
- LD A,B ; Byte ctr
- CP 9 ; Half way thru hex display?
- CALL Z,SPACE ; If so, add an extra space
- DJNZ HEXLOOP
-
- ; now do ascii transl of these chs
-
- CALL SPACE
-
- LD DE,-16
- ADD HL,DE ; Back ptr up 16
- LD B,16
-
- ; chk if marking a found ascii string, just like for hex
-
- ASCIILOOP:
- LD A,(FOUND)
- OR A
- JR Z,ASCNOMARK ; Not marking
- LD A,(HEXSRCH)
- OR A
- JR NZ,ASCNOMARK ; Showing on hex side only
- CALL ATMATCHADR
- JR NZ,ASCNOMARK
- CALL ONHILITE
- LD A,(HL)
- INC HL
- CALL PUTCIFASCII
- CALL OFFHILITE
- PUSH BC
- PUSH HL
- CALL FINDAGAIN
- POP HL
- POP BC
- JR ASCBYTEDONE
-
- ASCNOMARK:
- LD A,(HL)
- INC HL
- CALL PUTCIFASCII
-
- ASCBYTEDONE:
- DJNZ ASCIILOOP
-
- LD (CURRLINE),HL ; Save ptr to curr 'line'
- LD A,CR
- CALL PUTC
- LD A,(LINEBYLINE)
- OR A
- RET NZ
- LD A,LF
- JP PUTC ; &ret
-
- PUTHINIBBLE:
- SRL A
- SRL A
- SRL A
- SRL A
-
- PUTLONIBBLE:
- AND 0FH
- ADD A,'0' ; Ascii number bias (0-9)
- CP '9'+1
- JP C,PUTC
-
- IF UCHEX
- ADD A,07H ; If you like caps (A-F)
- ELSE
- ADD A,27H ; Ascii small letter bias (a-f)
- ENDIF
-
- JP PUTC
-
- ; print ch if from 20h to 7eh, else '.'
-
- PUTCIFASCII:
- CP ' '
- JR C,NONASCII
- CP 7EH+1
- JR C,PUTASCII
-
- NONASCII:
- LD A,'.'
-
- PUTASCII:
- JP PUTC ; &ret
-
-
- ; set z if at found $ adr
- ; also set cy if matchadr is later in buffer than HL (matchadr > HL)
-
- ATMATCHADR:
- PUSH HL ; Save *buffer
- LD DE,(MATCHADR)
- XOR A
- SBC HL,DE ; Z = at match adr; cy if matchadr > HL
- POP HL
- RET
-
- ;------------------------------------------------------------------------------
- ; Routine to check for and handle ^S (pause) and ^C, ^K, etc, (abort).
- ; This routine is called continuously (from PUTC) when running remote.
- ; Local users can wait till the next screen ends.
- ;
- CKABRT: PUSH AF ; Save all regs
- PUSH BC
- PUSH DE
- PUSH HL
- PUSH IX
- PUSH IY
-
- LD C,DIRIO ; Normally, just check console status.
- LD E,0FFH ;
- CALL BDOSEV
- OR A
- JR NZ,GOT1 ; (if a character is available)
-
- RETABT: POP IY
- POP IX
- POP HL
- POP DE ; Always return from this subr from here
- POP BC
- POP AF
- RET
-
- ; Analyze the character received
-
- GOT1: CP 'S'-40H ; ^S pauses
- JR Z,WA4CH ; Yes, go to pause loop
-
- GOT1B: AND 1FH ; ^C, ^K, ^X, C, K, X, etc all abort
- CP CTRLC
- JR Z,ABRT
- CP CTRLK
- JR Z,ABRT
- CP CTRLX
- JR NZ,RETABT ; Ignore other keys
-
- ABRT: LD (PUTCABRT),A ; Yes, aborting from PUTC
- JP QLEXIT ; Fix stack and exit direct
-
- WA4CH: LD C,DIRIO ; Loop till we get any character
- LD E,0FFH
- CALL BDOSEV
- OR A
- JR Z,WA4CH
- JR GOT1B ; Continue. Process the char also, but not ^S.
-
- ;..............................................................................
- ;
- ;
- ; Check if a filename typ is in "badtbl" (routine basicly from LTxx)
- ;
- CHKTYP: LD (DESAVE),DE ; Points to the extension to be checked
- LD B,3 ; #of chars in typ
- LD HL,BADTBL-3 ; Index bad file type table
- TSTTY1: INC HL ; Next table address pointer
- DEC B ; Bump loop counter
- JR NZ,TSTTY1 ; Do until at next table entry
- LD A,(HL) ; Get a byte
- OR A ;
- RET Z ; End of table, is 'typable', rtn w/ clr carry
- LD B,3 ; 3 char file type
- LD DE,(DESAVE) ; DE was supplied pointing to typ in question
- TSTTY2: LD A,(DE) ; Get a byte from typ
- AND 7FH ; Strip any file attribute bits
- CP (HL)
- JR Z,TSTTY3 ; Match, continue scan
- LD A,(HL)
- CP '?' ; '?' in table matches all
- JR NZ,TSTTY1 ; No match, next entry
- TSTTY3: INC HL ; Bump table address pointer
- INC DE ; Bump extent pointer
- DJNZ TSTTY2 ;
- SCF ; Match, file not 'typable', rtn w/ carry set
- RET ;
-
- ;..............................................................................
- ;
- ;
- ; Table of non-ascii filetypes (displayed in dim video).
- ; These selections (and the matching routine itself)
- ; were adapted from CB Falconer's LTxx series programs.
- ;
- BADTBL: DEFB 'ABS' ; Intended to disable
- DEFB 'ARC' ; ===================
- DEFB 'ARK'
- DEFB 'BAD'
- DEFB 'CRL'
- DEFB 'C?M' ; COM, CQM, CZM, CPM (v20 executes on PCs)
- DEFB 'E?E' ; EXE, EQE, EZE (MSDOS executable)
- DEFB 'IRL'
- DEFB 'I?T' ; INT, IQT, IZT
- DEFB 'O??' ; OBJ, OQJ, OZJ, OVL, OVR etc
- DEFB 'P?D' ; PCD, PQD, PZD (executable by RUNPCD)
- DEFB 'TX#'
- DEFB 'RBM'
- DEFB 'R?L' ; REL, RQL, RZL
- DEFB 'S?R' ; SLR, SQR, SZR (SLR format rel files)
- DEFB 'SYS'
- DEFB 0,0,0
- DEFB 0,0,0 ; Spares, for user configuration
- DEFB 0,0,0
- DEFB 0 ; Table end marker
-
- ;-----------------------------------------------------------------------------
- ; This is the end of QL proper. The remainder of the code consists of
- ; QFC.LIB (the choose-by-number file interface), UNC.LIB (the uncruncher),
- ; and QL.DTA (the data area), all of which are separate files. The main
- ; file uses INCLUDEs to put these all together. If you wish, you may
- ; eliminate all INCLUDEs and append everything end to end with your editor.
- ; You may also make more files and use more INCLUDEs. The current breakup is
- ; a compromise, and sections have rearranged so related code is somewhat
- ; more 'together' than in previous versions, but the program could probably
- ; use further improvement in this area.
- ;-----------------------------------------------------------------------------
- B 'TX#'
- DEFB 'RBM'
- DEFB 'R?L' ; REL, RQL, RZL
- DEFB 'S?R' ; SLR, SQR, SZR (SLR format rel files)
- DEFB 'SYS'