home *** CD-ROM | disk | FTP | other *** search
- title 'XREF v3.06 - Assembler cross reference utility 83/10/18, 01:28'
-
- vers equ 3
- revs equ 6
-
- *************************************************************************
- * *
- * Macro Assembler Cross Reference Program *
- * *
- * Program: XREF36.ASM *
- * By: Lucien Pan Toronto, Ontario, Canada (416) 690-8068 [h] *
- * *
- * Copyright (c) 1983 by Lucien Pan. All rights reserved. This *
- * public domain program is distributed for non-commercial use only. *
- * The author assumes no responsibility or liability for it's use. *
- * *
- *************************************************************************
-
- *************************************************************************
- * *
- * REVISION LOG: *
- * ------------ *
- * *
- * 83/10/17 Added disk file output (forced to fn.LST), tab *
- * v3.06 expansion/compression routines to conserve space, *
- * improved report by automatically executing a second pass *
- * through the file, this time listing only the lines *
- * containing errors, tracing the progression on the CON: *
- * in the form of pass/line number or actual file being *
- * parsed and finally the ability to list only the error *
- * lines in a file or get a summary report which contains *
- * the symbol table (if any), the cross-reference listing *
- * and the error lines (if any). All these and a few other *
- * options are selectable at run-time. *
- * - LLP. *
- * *
- * 83/09/14 This one was long due. Adapted program to accept TDL's *
- * v3.05 macro assembler .PRN listing file. This utility is now *
- * slightly more refined. Because MACROII (TM Computer *
- * Design Labs.) does not use form-feeds, it must be *
- * patched to enable XREF to bypass the header; following *
- * is a simple procedure to do so: *
- * *
- * A>DDT (or ZSID) *
- * -F100 5000 0 *
- * -IMACROII.COM *
- * -R *
- * NEXT PC *
- * 3900 0100 *
- * -S509 *
- * 0509 0D 8D *
- * 050A 0A 01 *
- * 050B 43 . *
- * -^C *
- * *
- * A>SAVE 47 (anyname you whish).COM *
- * *
- * We simply set the 8th bit on the header initial CR and *
- * replaced the following LF by a dummy character (don't *
- * use @NUL or @CR). Either version may be assembled from *
- * the same source file simply by setting the TDL symbol *
- * equate to true or false. *
- * - LLP. *
- * *
- * 83/06/20 Improved listing appearance by flagging error lines *
- * v3.04 with '***'. Also added statistics report at end of *
- * XREF. *
- * - LLP. *
- * *
- * 83/06/14 Fixed a bug occuring when no symbols were defined in a *
- * v3.03 program. No longer needs title info or page preset. *
- * Symbol size increased to 7 characters. *
- * - LLP. *
- * *
- * 83/06/03 Improved error handling routines, adapted program to *
- * v3.02 accept files generated by "ASM" (of Digital Research), *
- * cleaned up line printing routine. *
- * - LLP. *
- * *
- * 83/05/30 Fixed a bug clobbering line numbering and printing when *
- * v3.01 an macro expansion was encountered. (ex: mac filename *
- * $pc+smld) *
- * - LLP. *
- * *
- *=======================================================================*
- * *
- * ABSTRACT: *
- * -------- *
- * *
- * This program will generate a "bannered", cross-referenced *
- * listing of an .PRN file created by either DIGITAL RESEARCH's MAC *
- * or COMPUTER DESIGN LAB's (TDL) MACROII macro-assembler. This *
- * feature is an assembly time option however. *
- * *
- * Please report any bugs and/or comments either through the *
- * TORONTO RCP/M SYSTEM ONE at (416) 231-0442 by leaving a message *
- * if not too impractical or feel free to contact me directly by *
- * voice. *
- * - LLP. *
- * *
- *=======================================================================*
- * *
- * HISTORY: v3.00 *
- * ------- *
- * *
- * Based on XREF.ASM, originally written by Jeff Kravitz and *
- * modified by P.P.H. Lee, Ward Christensen and others, and on *
- * BANNER.ASM, modified by Ron Booley, I integrated both programs *
- * into one module and adapted it to accept .PRN files from MAC. *
- * *
- * Following is a short description of some of the new features *
- * added: *
- * *
- * - For the sake of "pretty-printing", a banner of the file name *
- * information is generated at the beginning of the listing (in *
- * an 7X7 matrix per character expanded) for easy program *
- * identification when multiple listings are bound together. I *
- * suggest that the first page be folded in half as this *
- * procedure allows easy indexing through each of the programs. *
- * *
- * - The line identification number is now appearing after the *
- * object expansion making the final listing more readable *
- * especially when a label is printed right after the expansion *
- * without space in between as it is the case when more than 5 *
- * characters are being defined in an labeled DB statement. *
- * *
- * - In case the file type is not specified, the default .PRN is *
- * assumed. *
- * *
- * - The symbol length is now increased from 5 to 6 characters *
- * which I believe is enough for significant but "to the point" *
- * names. *
- * *
- * - Lucien L. Pan, 83/05/22 *
- * *
- *************************************************************************
-
- false equ 0 ;define boolean
- true equ not false ;__equates
- debug equ false ;debug version (save a tree)
- cpm22 equ true ;for standard CP/M 2.2 BDOS
- h19 equ true ;Heath/Zenith H-19 type terminal
- z8911 equ false ;use internal line printer device driver
- ;__because Magnolia's CP/M bios doesn't
- ;__support parallel i/o. Set to false to
- ;__use standard CP/M LST logical device
- eject equ false ;no initial page form feed
- tdl equ true ;Set to true or false
- mac equ not tdl ;don't touch (set by above)
-
- ;/******************************/
- ;
- ; operating system equates
- ;
- ;/******************************/
-
- ; page zero addresses
-
- base equ 0 ;standard zero base CP/M
- wboot equ base ;warm boot entry point
- bdos equ wboot+5 ;bdos entry point
- fbase equ wboot+6 ;highest user memory+1
- fcb equ wboot+5ch ;default file control block
- fcb2 equ wboot+6ch ;second fcb
- dma equ wboot+80h ;default dma address
- tpa equ wboot+100h ;transient program area
-
- ; bdos functions parameters
-
- conif equ 1 ;console input
- conof equ 2 ;console output
- listf equ 5 ;list output
- dciof equ 6 ;direct console i/o
- psbf equ 9 ;print string buffer
- constf equ 11 ;console status
- cpmver equ 12 ;return version no.
- openf equ 15 ;open file
- findf equ 17 ;search file in directory
- closef equ 16 ;close file
- deletf equ 19 ;delete file
- readf equ 20 ;read file
- writef equ 21 ;write sequential file
- makef equ 22 ;create file
- sdmaf equ 26 ;set dma address
-
- ; misc system equates
-
- fcbl equ 36 ;length of fcb
- eof equ 1ah ;CP/M's end of file delimiter
-
- ;/******************************/
- ;
- ; ascii characters equates
- ;
- ;/******************************/
-
- @nul equ '@'-40h ;^@ (ascii null)
- @bel equ 'G'-40h ;^G (ascii bell)
- @tab equ 'I'-40h ;^I (ascii tab)
- @lf equ 'J'-40h ;^J (ascii line feed)
- @ff equ 'L'-40h ;^L (ascii form feed)
- @cr equ 'M'-40h ;^M (ascii carriage return)
- @esc equ '['-40h ;^[ (ascii escape)
-
- ;/******************************/
- ;
- ; operational equates
- ;
- ;/******************************/
-
- rsiz equ 6 ;size of reserved word table entry
- symsiz equ 7 ;max size of symbol
- ssiz equ symsiz+3 ;# of xref addresses by line
- refsz equ 2+(ssiz*2) ;# of bytes in ref. block
- tbsze equ 20h ;# of sectors to read to fill buffer
-
- if mac
- pglen equ 58 ;# of lines to be printed per page
- endif ;mac
-
- if tdl
- pglen equ 60
- endif
-
- digits equ 5 ;# of digits for line number id.
-
- ;/******************************/
- ;
- ; program start
- ;
- ;/******************************/
-
- org tpa
-
- jmp xref ;bypass header
- db 'Copyright (C) 1983 by Lucien Pan'
- hello: call cdisp ;identify oneself
- db 'XREF v'
- db (vers mod 10)+'0','.'
- db revs/10+'0',(revs mod 10)+'0'
-
- if z8911
- db 'p'
- endif
-
- db ' for '
-
- if mac
- db 'MAC, ASM'
- endif
-
- if tdl
- db 'TDL'
- endif
-
- db ' mnemonics.'
-
- if h19
- db @esc,'x5' ;disable cursor
- endif ;h19
-
- db @cr,@lf,@nul
- ret
-
- xref: lxi h,0
- dad sp ;get ccp stack in hl
- lxi sp,stack ;set local stack pointer
- push h ;save ccp stack ^ on local stack
-
- if z8911
- call in8255 ;initialize parallel port
- endif ;z8911
-
- call hello ;say hello
- call setup ;initialize program
- xref0: call cdisp
-
- if h19
- db @esc,'l',@nul ;HEL - erase entire line
- else
- db ' ',@nul
- endif ;h19
-
- call getbt ;get first byte of source file
- cpi eof
- jz empty ;in case of eof
- push psw
- call ckerr ;error only option selected?
- jz xref01 ;if not
- sub a ;else, select pass two
- sta pass
- lxi h,done3 ;where to go when done
- shld way
- xref01: pop psw
-
- if mac
- cpi ' '
- jz xref2 ;if case 'page 0' from "MAC"
- cpi @ff ;bypass first form feed (from "MAC")
- jz xref2 ;process form feed case if so
- cpi @cr ;bypass CR,LF,CR,LF sequence (from "ASM")
- mvi b,3
- jz xref1 ;if first char was indeed a @cr
- call ckalp ;none of the above, char MUST at least be
- jnc xref2 ;__alphabetic (error code) to qualify as .PRN
- jmp former ;in case an object file was requested
- xref1: call getbt ;skip over "ASM" prologue
- dcr b
- jnz xref1
- cpi @lf ;just to make sure
- jnz former ;sorry!
- endif ;mac
-
- xref2: sta char ;save character for later use
- call ckpass ;are we in pass 1 or 2?
- jz xref21 ;if pass two
- call cksumo ;is summary option active?
- jz xref20 ;if not
- sub a ;else, temporarily disable flag
- sta summary
- call banner ;to print expanded file name
- mvi a,true ;re-activate flag
- sta summary
- ora a
- xref20: cz banner ;print expanded fcb information
- xref21: lda char ;get back character
-
- if mac
- cpi @lf ;was it .PRN from "ASM"?
- jz llf0 ;if yes, process @lf case
- cpi @ff ;was it .PRN from "MAC"?
- jnz xref3 ;if not
- call getfc ;test for normal case
- jz llf1 ;parse if so
- jmp lff2 ;must be header case, process
- xref3: call savbt ;save character in line buffer
- cpi ' ' ;was it .PRN from "MAC" w/page set at 0 ?
- jz llf1 ;continue parsing object expansion field
- mvi b,15 ;this is a long shot to help cluts
- jmp llf4 ;recover from an error in the very first line!
- endif ;mac
-
- if tdl
- cpi @CR
- jnz former
- xref4: call skipnl ;skip formatting new lines
- call ckban ;if no banner wanted
- jnz xref41 ;__bypass initial form-feed
- call ckpass
- cnz formf
- xref41: sub a ;clear this option flag
- sta nobanr ;__for next iteration
- call header
- jmp main1
- endif ;tdl
-
- ;/******************************/
- ;
- ; character parsing mainline
- ;
- ;/******************************/
-
- main: call getfc ;get a byte from source file
- main1: call ckpass ;is it pass 1 or 2?
- lda char
- jz main2 ;if pass 2
- call cknum ;test for numeric
- jnc lnum ;yes, found a number, process
- call ckalp ;test for alphabetic
- jnc lalph ;yes, process
- main2: call ckspc ;parse special characters
- jc main ;if not found, ignore and loop for more
- pchl ;when found, process special character
-
- ;/******************************/
- ;
- ; exit from program
- ;
- ;/******************************/
-
- empty: call fcdisp
- db '+++ Unexpected end of file??? +++',@cr,@lf,@nul
- jmp exit
-
- abort: call fcdisp
- db '+++ Aborted +++',@cr,@lf,@nul
- ; jmp exit
-
- exit: lxi d,fcb ;close source file
- call fclose
- exit1:
- if h19
- call fcdisp
- db @esc,'y5',@nul ;re-enable cursor
- endif ;h19
-
- lxi sp,stack-2 ;^ to old (ccp's) stack
- pop h ;restore ccp stack
- sphl
- ret ;return control back to CP/M
-
- ;/******************************/
- ;
- ; final statistics print
- ;
- ;/******************************/
-
- done: lxi sp,stack-2 ;just to be safe
- call formf ;issue formf eject
- call cdisp
- db @cr,'Listing cross-reference ',@cr,@nul
- sta pass ;activate pass two flag
- lhld symbt ;get symbol table bottom
- call endoft ;test for no symbol case
- jnz done0 ;continue if symbol exist
- call lcdisp ;else print warning
- db @bel,'+++ no symbol detected +++',@lf,@cr,@nul
- jmp done2 ;terminate program
- done0: shld sym ;set symbol pointer
- lhld symtp ;get symbol table top
- mvi m,-1 ;end off symbol table
- done1: lhld sym ;get symbol table pointer
- call psym ;print symbol
- lhld sym
- lxi d,symsiz+1 ;offset to ref link
- dad d
- mov e,m
- inx h
- mov d,m ;get ref block addr
- xchg ;into hl
- shld ref
- call prefs ;print references
- lhld sym ;get symbol table pointer
- lxi d,ssiz ;size of sym table entry
- dad d
- shld sym
- call endoft ;test for end of table
- jnz done1 ;loop if not
- done2: lhld errorc ;any errors detected?
- mov a,h
- ora l
- jz done4 ;if not, proceed with stats.
-
- ; errors were logged, scan file a second time
- ; printing only error lines.
-
- lxi h,done3 ;where to branch when eof hit
- shld way
- call formf ;prettyprint
- lxi d,fcb ;close and reopen file
- call fclose
- lxi d,ifcb
- lxi h,fcb
- mvi b,fcbl
- call move
- lxi d,fcb
- call fopen
- jc abort ;in case murphy's around
- call initp
- jmp xref0 ;re-enter main loop
- done3: call crlf2
- call lptab
- lhld errorc
- mov a,h
- ora l
- jnz done31
- call ldisp
- db ' ',@nul
- call lcdisp
- db 'No',@nul
- done31: cnz done7
- call lcdisp
- db ' error(s) detected ',@lf,@cr,@nul
- done4: call crlft
- call lptab
- lhld lcnt
- mov a,h
- ora l
- jz exit
-
- if mac
- dcx h
- endif
-
- call done7
- call lcdisp
- db ' line(s) processed ',@lf,@cr,@nul
- call formf
- done5: call ckdsk
- jz done6
- mvi a,eof ;save end of file marker
- call putfc
- lxi d,dfcb ;close destination file
- call fclose
- inr a ;everything okay?
- jnz done6 ;if yes
- call fcdisp
- db @bel,' Is disk write protected? ',@nul
- jmp abort
- done6: call cdisp
- db 'Cross-reference completed',@cr,@lf,@nul
- jmp exit ;return to ccp
-
- done7: call decout
- jmp prdec
-
- ;/******************************/
- ;
- ; symbol print routine
- ;
- ;/******************************/
-
- psym: mvi b,symsiz ;symbol size
-
- if tdl ;print a space after 6 chars
- mvi c,6 ;__to enhance truncated symbols
- endif ;tdl
-
- psym0: mov e,m ;get byte
- call pbyt ;print byte
- inx h
-
- if tdl
- dcr c
- cz psym1
- endif ;tdl
-
- dcr b
- jnz psym0
- psym1: mvi e,' '
-
- if mac ;because enhanced printing
- call pbyt ;__is only available on TDL
- endif ;mac
-
- jmp pbyt ;return through pbyt
-
- ;/******************************/
- ;
- ; reference print routine
- ;
- ;/******************************/
-
- prefs: lhld ref ;get ref block addr
- inx h
- inx h ;bump to first ref number
- shld temp ;save ref num addr
- mvi a,(refsz-2)/2 ;number of ref slots
- sta symct ;save in symct
- pref: mvi e,' '
- call pbyt
- lhld temp ;get ref slot addr
- mov e,m
- inx h
- mov d,m ;get ref
- lxi h,0 ;zero?
- call cphl
- jz crlft ;yes, done
- xchg ;get num in hl
- call decot ;convert
- lxi h,dec ;point to dec string
- mvi m,' ' ;blank leading zero
- mvi b,digits ;set loop count
- pref2: mov e,m ;get byte
- call pbyt ;print byte
- inx h
- dcr b
- jnz pref2 ;print reference number
- lhld temp ;get ref slot addr
- inx h
- inx h ;bump to next slot
- shld temp
- lda symct ;get count
- dcr a ;decrement
- sta symct
- jnz pref
- lhld ref ;get ref block address
- mov e,m
- inx h
- mov d,m ;get link to next block
- lxi h,0
- call cphl ;any more blocks?
- jz crlft ;no, exit
- xchg ;yes, set next block pointer in ref
- shld ref
- call crlft ;print cr,lf
- mvi b,symsiz+2
- pref3: mvi e,' '
- call pbyt ;print spaces
- dcr b
- jnz pref3
- jmp prefs
-
- ;/******************************/
- ;
- ; character parsing routines
- ;
- ;/******************************/
-
- lalph: call ckpass ;don't xref on 2nd pass
- jz main
- call linit
- call gtsym ;collect identifier
- lalph0: call getfc ;get a byte from source file
-
- if mac
- cpi '$' ;'$' case?
- jz lalph0 ;if so, ignore
- endif ;mac
-
- lalph1: call ckspsy ;check for special symbol char
- jz lalph5
- call cknum ;test for number
- jnc lalph5 ;yes, continue
- call ckalp ;test for alphabetic
- jnc lalph5 ;yes, continue
- call cres ;test for reserved word
- jc lalph3 ;no, continue
- lalph2: lda char ;get character that ended id
- jmp main1 ;continue scan
- lalph3: call find ;see if defined
- jc lalph4 ;no, continue
- call addrf ;yes, add reference
- jmp lalph2 ;done
- lalph4: call ensym ;enter symbol definition
- call addrf ;add reference
- jmp lalph2 ;continue
- lalph5: call gtsym ;collect identifier
- jmp lalph0 ;continue
-
- lnum: call getfc ;get byte
- call cknum ;test for numeric
- jnc lnum ;yes, continue
- call ckalp ;test for alphabetic
- jnc lnum ;yes, continue
- jmp main1 ;continue with main scan
-
- lapos: call getfc ;get a byte
- cpi '''' ;see if string quote
- jnz lapos ;no, keep looping
- call getfc ;get next byte
- cpi '''' ;test for doubles
- jz lapos ;yes, start scan again
- jmp main1 ;no, continue in main scan
-
- if tdl
- lquot: call getfc ;get a byte
- cpi '"' ;see if string quote
- jnz lquot ;no, keep looping
- call getfc ;get next byte
- cpi '"' ;test for doubles
- jz lquot ;yes, start scan again
- jmp main1 ;no, continue in main scan
-
- ldot: call linit
- mov b,a ;save character
- call getfc
- cpi '.' ;dot dot?
- jz ldot1 ;if true, bypass local symbol
- push psw ;save character
- mov a,b ;restore initial character
- call gtsym ;add to symbol
- pop psw ;restore second char
- jmp lalph1 ;continue parsing symbol
-
- ; local symbol case, bypass parsing
-
- ldot1: call getfc
- call ckspsy
- jz ldot1
- call cknum
- jnc ldot1
- call ckalp
- jc main1
- jmp ldot1
- endif ;tdl
-
- llf: lhld lcnt ;increment line count
- inx h
- shld lcnt
- sub a ;reset error line flag
- sta errl
- llf0: call getfc ;get next file char
- jz llf1 ;br if space (case normal line)
-
- if mac
- cpi @ff ;test for @ff case (.PRN from "MAC")
- jz lff ;if true, process
- cpi @cr ;test for @cr case (.PRN from "ASM")
- jz bypass ;bypass formatting CRLF's
- call getfc ;else, find out if symbol case
- mvi b,3 ;set to skip to macro cue column
- jz llf00 ;when 2nd column is blank, its an error line
- call getfc ;if 3rd column is blank, its an error line
- jz llf00 ;no need to test for symbol table case
- dcr b ;else, it could be symbol table case
- call skip ;this column is always blank
- jz prsym ;__when symbol table case
- llf00: cz skip ;position to macro cue - 1 column
- push h ;now we know for sure this is an error line
- lhld errorc ;increment error count
- inx h
- shld errorc
- mvi a,true ;flag error line
- sta errl
- pop h
- call getfc ;resync to macro cue
- jz llf3 ;if not macro expansion line, count up
- jmp llf21 ;else, don't increment (blank) line count
- endif ;mac
-
- if tdl
- cpi @cr ;is it new line case?
- jnz llf01 ;if not
- call dcrlct ;if so, decrement line count
- call pinit ;init printer line buffer pointers
- jmp xref4 ;bypass new lines and proceed to header case
- llf01: mvi b,6 ;is it symbol table case?
- call skip ;symbol value always appears at column 8
- mvi b,4 ;test for a hex character string
- call skiph0 ;returns fc/1 if non hex char detected
- jnc prsym ;if it was really a symbol table line
- llf02: dcr b ;else, resync to column 12
- cnz skip ;only if not already there
- lhld errorc ;increment error line count
- inx h
- shld errorc
- mvi a,true ;flag error line
- sta errl
- mvi b,14 ;resync to source line
- jmp llf2 ;and proceed with parsing
- endif ;tdl
-
- llf1:
- if mac
- mvi b,5 ;skip over address expansion
- endif ;mac
-
- if tdl
- mvi b,24
- endif ;tdl
-
- llf2: call skip ;__to point to macro indicator
-
- if tdl
- cpi '@'
- jz llf20
- cpi ' '
- cnz dcrlct ;macro-expansion lines
- llf20: call getfc ;__will be xref'ed but not counted
- ; jmp llf5
- endif ;tdl
-
- if mac
- llf21: cnz dcrlct ;anything other than space
- ;__will be treated as a macro line
- llf3: mvi b,11 ;skip over object code expansion
- llf4: call skip ;(first 16 chars of a line in .PRN file)
- endif ;mac
-
- llf5: cpi '*' ;test for special '*' comment line case
- jnz main1 ;if not true, parse remainder of file
- ; jmp lsemi ;else, consider line as a comment
-
- lsemi: call bypln ;bypass parsing of the line (till @cr)
- jmp main1 ;parse remainder of file
-
- bypass:
- call dcrlct ;decrement line count
- jmp lsemi ;treat rest of line as a comment line
-
- lff: if mac
- sub a ;reset page line count
- sta lines
- call getfc ;get next file char & test for space
- jnz lff2 ;if not normal case, test for symbol or header
- call getfc ;test for weird page case
- mvi b,4 ;prepare to sync to macro cue
- jnz llf2 ;if normal line
- mvi b,14 ;# of chars to skip over object expansion
- lff0: call getfc ;skip over object field
- jz lff1 ;if not object, test for page case
- dcr b ;prepare to enter skip loop
- jnz llf4 ;it is not page case, enter normal parsing loop
- jmp former ;cannot be any other case, file is corrupted
- lff1: dcr b ;-- count
- jnz lff0 ;see if at end of object expansion, loop if not
- call getfc ;test for page case
- cpi @cr
- jnz llf5 ;if really not page, then test for comment
- call getfc ;if page case, next char
- cpi @lf ;__must be line feed
- jnz former ;else we've got problems
- call prline ;just print out (hopefully) blank line
- call crlft ;this is why page case is WEIRD!
- jmp main ;re-enter main parsing loop
- lff2: call skiphx ;test for symbol line case
- jc lff3 ;if not a symbol table line
- call getfc ;now, test for a space
- jz prsym ;if really a symbol table line
- call getfc ;test for a error source line case
- jz llf3 ;if true
- cpi 'M' ;try for a header line case
- jnz bypass ;if none of above, treat as for a macro case
- lff3: call bypln ;just save rest of line in line buffer
- call prline ;and print out w/o numbers
- call crlft ;__with the attendant prettyprinting
- call getbt ;bypass following @lf and discard
- cpi @lf ;just make sure were discarding the right char
- jnz former ;if file format error
- call getfc ;next char in file should be @lf
- cpi @lf ;check that character was indeed a @lf
- jz llf0 ;if true, proceed parsing file as for @lf case
- ; jmp former ;else, we've got a problem
- endif ;mac
-
- former: call fcdisp ;print warning and terminate program
- db @bel,'+++ .PRN file format corrupted +++',@cr,@lf,@nul
- jmp exit ;too bad!;(sorry... can't handle it yet)
-
- prsym: sub a ;deactivate summary option
- sta summary
- call dcrlct ;decrement line count
- prsym1: call bprlin ;bypass parsing of the line & unadorned print
- jmp lcr1 ;update page line count & exit
-
- lcr: call prlinu ;print source and line id
- lcr1: call ckpass ;don't increment page line count
- jz main ;if pass 2
- lda lines ;increment page line count
- inr a
- sta lines
- cpi pglen ;test for forms length
- jnz main ;re-enter main character parsing loop
- call formf ;time to form feed
- call getbt ;bypass saving following @lf
- cpi @lf ;only if char is @lf
- jz llf ;if @lf
- call savbt ;else save
- jmp main1 ;and continue parsing
-
- linit: lxi h,sbuf ;erase temporary symbol buffer
- mvi c,symsiz
- mvi a,' '
- linit1: mov m,a
- inx h
- dcr c
- jnz linit1
- lxi h,sbuf ;reset symbol ^
- shld sympt
- sub a ;reset count
- sta symct
- lda char ;restore previously read char
- ret
-
- dcrlct: lhld lcnt
- dcx h
- shld lcnt
- ret
-
- ckpass: lda pass ;is it pass 1 or 2?
- ora a ;pass 1 = nz, pass 2 = 0
- rnz
- sta summary ;disable summary flag
- ret
-
- ckcon: lda crt ;console trace option active?
- ora a ;true if nz
- ret
-
- ckdsk: lda diskl ;disk output option active?
- ora a ;true if nz
- ret
-
- ckerr: lda error ;error only option active?
- ora a ;true if nz
- ret
-
- ckban: lda nobanr ;no banner option selected?
- ora a ;true if nz
- ret
-
- ckquiet:lda quiet ;quiet operation selected?
- ora a ;true if nz
- ret
-
- cksumo: lda summary ;summary option active?
- ora a ;true if nz
- ret
-
- ckentab:lda entab ;enter tabs option active?
- ora a
- ret
-
- if tdl
- skipnl: call getlf
- jnz former
- call getcr
- rc
- jz skipnl
- rrc
- cpi @nul
- jnz skipn1
- endif ;tdl
-
- skipn0: lhld way
- pchl
-
- if tdl
- skipn1: push psw
- call crlf2
- pop psw
- call savbt
- jmp prsym1
-
- getlf: call getbt
- cpi @lf
- ret
-
- getcr: call getbt
- cpi @cr
- rz
- rlc
- ret
-
- header: sub a
- sta char ;(clear for bypln)
-
- ; print out first 4 lines of header as is
-
- mvi b,4
- heade0: push b
- call bprlin ;print source line w/o formatting
- call getfc ;get char following @CR (for bypln)
- pop b
- dcr b ;adj. count
- jnz heade0 ;loop till done
-
- ; test to see if symbol table page case
-
- mvi b,5
- lxi h,pbuf+1
- mvi a,'+'
- heade1: cmp m
- jnz heade2
- inx h
- dcr b
- jnz heade1
- call bprlin ;print source line w/o formatting
- jmp heade3
-
- ; normal listing page case
-
- heade2: call ckpass ;don't pretty-print
- jz heade21 ;__if pass 2
- call crlf
- call ldisp ;replace blank line with pretty-print
- db ' Location Object-code Line# Source line',@NUL
- heade21:call bypln
-
- ; proper subroutine ending
-
- heade3: call getfc
- call bprlin ;print source line w/o formatting
- jmp getfc ;indirect return
- endif ;tdl
-
- ;/******************************/
- ;
- ; initialization
- ;
- ;/******************************/
-
- setup: sub a ;disable all options
- sta crt
- sta diskl
- sta error
- sta nobanr
- sta quiet
- sta summary
- sta entab
- sta warning
-
- ; parse command line
-
- lxi h,dma ;^ to command line tail
- shld bufadd
- ora m ;anything entered?
- jnz setu0 ;if yes, test file type
-
- ; Give a little bit of help
-
- help: call cdisp ;else print help message
- db @cr,@lf,'Usage:'
- db @cr,@lf,@lf,' [d:]xref [d:]fn.ft [d:][/ooo...]'
- db @cr,@lf,@lf,'where ''[]'' denotes optional entry'
- db @cr,@lf,'and ''o'' stands for a valid option identifier.'
- db @cr,@lf,@lf,'Selectable options are:'
- db @cr,@lf,' c - CON: trace'
- db @cr,@lf,' d - disk file listing'
- db @cr,@lf,' forces fn.LST as output file'
- db @cr,@lf,' with option t in effect'
- db @cr,@lf,' e - list error lines only'
- db @cr,@lf,' n - no banner expansion'
- db @cr,@lf,' q - quiet mode'
- db @cr,@lf,' s - summary report only'
- db @cr,@lf,' t - compress blanks to tabs'
- db @cr,@lf,@lf,'Note: if no file type is specified,'
- db @cr,@lf,' the default .PRN will be assumed.'
- db @cr,@lf,' A null file type is entered as a ''.'' (dot).'
- db @cr,@lf,@nul
- jmp exit1 ;__and return to CP/M
-
- ; file name was entered
-
- setu0: mvi a,'.' ;look to see if file type defined
- call findb
- jnc setu00 ;if yes, take file type as is
- mvi a,'P' ;else, assume .PRN file
- sta fcb+9
- lxi h,'RN'
- shld fcb+10
-
- ; ckeck out options wanted
-
- setu00: lxi h,dma
- mvi a,'/' ;look for option delimiter
- call findb
- jc setu1 ;if none found
- dcr b ;any char following?
- jnz setu02 ;if yes
- setu01: call fcdisp ;undecipherable option was entered
- db @bel,'+++ Option error +++',@nul
- jmp help
- setu02: inx h ;get next char
- mov a,m
- cpi 'D' ;disk listing option?
- jnz setu03
- mvi a,true
- sta diskl
- sta entab
- jmp setu09
- setu03: cpi 'E' ;error only option?
- jnz setu04
- mvi a,true
- sta error
- jmp setu09
- setu04: cpi 'N' ;no banner option?
- jnz setu05
- mvi a,true
- sta nobanr
- jmp setu09
- setu05: cpi 'S' ;summary only option?
- jnz setu06
- mvi a,true
- sta summary
- jmp setu09
- setu06: cpi 'C' ;CON: trace option?
- jnz setu07
- mvi a,true
- sta crt
- sta quiet
- jmp setu09
- setu07: cpi 'Q' ;quiet option?
- jnz setu08
- mvi a,true
- sta quiet
- jmp setu09
- setu08: cpi 'T' ;compress tabs option?
- jnz setu01 ;can't be anything else
- mvi a,true
- sta entab
- ; jmp setu09
- setu09: dcr b ;more chars available?
- jnz setu02 ;if yes
-
- setu1: lxi d,fcb ;point to fcb
- lxi h,ifcb ;save a copy of initial fcb
- mvi b,fcbl ;__for later use by pass 2
- call move
-
- ; create disk file output fcb
-
- call ckdsk ;disk output option active?
- jz setu12 ;if not
- setu11: lda fcb2 ;get drive number
- sta dfcb
- lxi d,fcb+1 ;copy source filename
- lxi h,dfcb+1 ;__to destination filename
- mvi b,8
- call move
- mvi m,'L' ;force ft to 'LST'
- inx h
- mvi m,'S'
- inx h
- mvi m,'T'
- sub a
- sta dfcb+32 ;clear current record
-
- ; open source file
-
- setu12: lxi d,fcb
- call fopen ;open fcb
- jnc setu13 ;psw/c0, open ok
- call fcdisp
- db '+++ File not found +++',@cr,@lf,@nul
- jmp exit ;exit back to ccp
-
- ; if disk output wanted, open destination file
-
- setu13: call ckdsk ;disk output option active?
- jz setu2 ;if not
- lxi d,dfcb ;^ destination fcb
- mvi c,findf ;look for destination filename
- call bdos
- inr a ;does file already exists?
- jz setu14 ;if not, bypass delete
- lxi d,dfcb
- mvi c,deletf ;else, delete the file
- call bdos
- setu14: lxi d,dfcb
- mvi c,makef ;now, create the destination file
- call bdos
- inr a
- jnz setu2 ;opening sucessfull
- call fcdisp
- db 'no directory space ',@nul
- jmp abort
-
- ; init variables for 1st pass
-
- setu2: sub a ;enable pass 1 flag
- cma
- sta pass
- lxi h,done ;where to go when eof hit
- shld way
- call initp ;init disk & printer variables
- lxi h,symt ;set symbol table pointers
- mvi m,-1 ;__and xref variables
- shld sym
- shld symbt
- shld symtp
-
- ; check if BDOS v2.2 present
-
- if cpm22
- mvi c,cpmver
- call bdos
- cpi 22h
- jz setu3 ;if okay
- call cdisp
- db 'Warning! this is not CP/M 2.2',@cr,@lf,@nul
- cma
- sta warning
- jmp setu4
- setu3: lhld fbase ;get BDOS entry vector + 6
- lxi d,30Eh-6 ;offset to last char read flag
- dad d
- shld lastci ;save vector
- endif ;cpm22
-
- ; calculate top of free RAM
-
- setu4: lhld fbase ;get highest available memory + 7
- lxi d,-(800h+7) ;substract CCP + 7 size
- dad d ;to get start of CCP ^ - 1 (last free RAM)
- shld ref ;set reference table pointers
- shld refbt
- shld reftp
- ret
-
- ; common initialization routines
-
- initp: call pinit ;set line buffer ^
- lxi h,0
- shld errorc ;reset error count
-
- if mac
- inx h
- endif ;mac
-
- shld lcnt ;reset line count
- lxi h,tbuf+(tbsze*128) ;reset disk buffer pointers
- shld tbdma
- shld inptr
- lxi h,tbuf ;^ to start of disk buffer
- lxi b,symt-tbuf ;calculate buffer size
- initp1: mvi m,eof ;fill buffer area with eof's
- inx h
- dcx b
- mov a,c
- ora b
- jnz initp1 ;loop till done
- ; sub a
- sta tbflg
- ret
-
- ;/******************************/
- ;
- ; skip n characters
- ; in line buffer
- ;
- ;/******************************/
-
- skip: call getfc ;get a byte
- dcr b ;-- count
- jnz skip ;loop till done
- cpi ' ' ;set psw/z1 if space
- ret
-
- ;/******************************/
- ;
- ; skip to end of line
- ;
- ;/******************************/
-
- bypln: lda char ;get current character
- cpi @cr ;test for end of line delimiter
- rz ;return when one found
- call getfc ;else, get next file char
- jmp bypln ;and test again
-
- ;/******************************/
- ;
- ; test for hex char in
- ; address expansion field
- ;
- ;/******************************/
-
- skiphx: mvi b,3 ;3 following char should be hex
- skiph0: call getfc ;get char
- call ckhex ;test for hex
- rc ;exit with psw/c1 if not hex
- dcr b ;-- count
- jnz skiph0 ;loop till done
- ret
-
- ;/******************************/
- ;
- ; check for reserved word
- ;
- ;/******************************/
-
- cres: lxi h,rtab ;point to reserved word table
- shld temp ;save in temp word
- cres1: lhld temp ;get table pointer
- lxi d,sbuf ;point to symbol
- mvi b,rsiz ;symbol size
- cres2: ldax d ;get symbol byte
- cmp m ;compare against table entry
- rc ;less, not in table
- jnz cres3 ;greater, get next table entry
- inx d ;bump pointers
- inx h
- dcr b ;decrement byte count
- jnz cres2 ;keep testing
- jmp cres4 ;found
- cres3: lhld temp ;get table pointer
- lxi d,rsiz ;size of entry
- dad d ;bump pointer
- shld temp ;store new pointer
- call endoft ;test for end of table
- jnz cres1 ;no, loop
- stc ;set carry (not in table)
- ret
- cres4: ora a ;reset carry
- ret
-
- ;/******************************/
- ;
- ; find symbol in table
- ;
- ;/******************************/
-
- find: lhld symbt ;get begin of sym table
- shld sym ;set temp pointer
- find1: lhld sym ;get temp pointer
- lxi d,sbuf ;point to current symbol
- mvi b,symsiz ;symbol size
- find2: ldax d ;get byte from sbuf
- cmp m ;compare to sym table byte
- rc ;greater, not in table
- jnz find3 ;less, get next table entry
- inx d ;bump pointer
- inx h ;bump pointer
- dcr b ;decrement byte count
- jnz find2 ;loop
- ret ;true zero, found
- find3: lhld sym ;get current pointer
- lxi d,ssiz ;symbol table entry size
- dad d ;bump pointer
- xchg ;into de
- lhld symtp ;get top of symbol table
- call cphl ;test for end of table
- jz find4 ;yes, done
- jnc find31 ;psw/c0, everything ok, br if so
- ferr: call fcdisp ;table overflow, error
- db '+++ Symbol table overflow +++',@cr,@lf,@nul
- jmp exit ;return to ccp
- find31: xchg ;current pointer into hl
- shld sym ;set current pointer
- jmp find1 ;loop
- find4: stc ;set carry for not found
- lhld symtp ;get current top
- shld sym ;set current pointer
- ret
-
- ;/******************************/
- ;
- ; add reference to ref table
- ;
- ;/******************************/
-
- addrf: lhld sym ;get symbol pointer
- lxi d,symsiz+1 ;offset past symbol&flags
- dad d
- mov e,m
- inx h
- mov d,m ;get reference pointer
- lxi h,0
- call cphl ;test for zero ref ptr
- jz bldrf ;yes, build reference entry
- link: xchg ;ref ptr in hl
- mov e,m ;get ref link
- inx h
- mov d,m ;into de
- dcx h ;reposition hl
- push h ;save ref ptr
- lxi h,0
- call cphl ;if link is zero
- pop h
- jnz link ;non zero, get next link
- shld ref ;save ref pointer
- inx h
- inx h ;skip to first ref number
- mvi b,(refsz-2)/2 ;number of ref numbers/entry
- link3: mov e,m ;get ref number
- inx h
- mov d,m
- dcx h ;reposition
- push h ;save ref num addr
- lxi h,0
- call cphl ;see if ref num is zero
- pop h
- jz enref ;yes, enter reference
- inx h
- inx h ;skip to next ref num
- dcr b ;decrement count
- jnz link3 ;try again at next slot
- call adblk ;add new ref block
- lhld ref ;get ref pointer
- inx h
- inx h ;skip to first ref slot
- enref: push h ;save ref slot addr
- lhld lcnt ;get line number
- xchg ;into de
- pop h ;get ref slot addr
- mov m,e
- inx h
- mov m,d ;store line ref
- ret ;done
-
- ;/******************************/
- ;
- ; build ref table block
- ;
- ;/******************************/
-
- bldrf: lhld sym ;get symbol pointer
- lxi d,symsiz+1 ;offset to ref pointer
- dad d
- shld ref ;set temp ref pointer to here
- call adblk ;add block
- lhld ref ;get real ref pointer
- inx h
- inx h ;position to first ref slot
- jmp enref ;add reference
- adblk: lhld refbt ;get ref bottom
- lxi d,refsz ;subtract ref size
- mov a,l
- sub e
- mov l,a
- mov a,h
- sbb d
- mov h,a
- shld temp ;save new ref bottom
- xchg ;into de also
- lhld symtp ;get symbol top
- call cphl ;check for bump
- jz ferr ;yes, no room
- jnc ferr ;no room
- lhld temp ;get ref bottom
- xchg ;into de
- lhld ref ;get ref pointer
- mov m,e ;set link
- inx h
- mov m,d ;to new ref block
- lhld temp ;get new ref block addr
- shld ref ;store in ref
- mvi b,refsz ;size of ref block
- sub a
- adb2: mov m,a ;zero the ref block
- inx h
- dcr b
- jnz adb2
- lhld temp ;get new ref bottom
- shld refbt ;set refbt
- ret
-
- ;/******************************/
- ;
- ; enter symbol in sym table
- ;
- ;/******************************/
-
- ensym: lhld sym ;get symbol pointer
- xchg ;into de
- lhld symtp ;get symbol table top
- call cphl ;check for end of table
- jz nwsym ;yes, add symbol at end
- lxi d,ssiz ;symbol table entry size
- dad d ;calculate new end of table
- xchg ;into de
- lhld refbt ;reference table bottom
- call cphl ;test for table overflow
- jz ferr ;full, error
- jc ferr ;yes, error
- lhld symtp ;get table top
- lxi d,ssiz-1 ;bump to end of entry
- dad d
- shld to ;store in to address
- lxi d,ssiz
- mov a,l
- sub e
- mov l,a
- mov a,h
- sbb d
- mov h,a ;subtract size of one entry
- shld from ;store as from address
- lhld sym ;get current pointer
- shld limit ;store as limit address
- call mvup ;move table up in memory
- nwsym: lhld sym ;get current pointer
- lxi d,sbuf ;point to symbol
- mvi b,symsiz ;size of symbol
- call move ;copy symbol to table
- sub a
- mov m,a
- inx h
- mov m,a
- inx h
- mov m,a ;set pointers to 0000
- lhld symtp ;get symbol table top
- lxi d,ssiz ;get symbol entry size
- dad d ;bump
- shld symtp ;store ew top
- ret
-
- ;/******************************/
- ;
- ; move symbol table up
- ;
- ;/******************************/
-
- mvup: lhld to ;get to pointer
- mov b,h
- mov c,l ;into bc
- lhld from ;get from pointer
- xchg ;into de
- lhld limit ;get limit address
- mvup2: ldax d ;get from byte
- stax b ;store at to address
- call cphl ;compare from to limit
- rz ;exit if done
- dcx b ;decrement to
- dcx d ;decrment from
- jmp mvup2 ;loop
-
- ;/******************************/
- ;
- ; general purpose move routine
- ;
- ;/******************************/
-
- move: ldax d ;get byte
- mov m,a ;store byte
- inx d
- inx h ;bump pointers
- dcr b ;decrement count
- jnz move ;loop
- ret
-
- ;/******************************/
- ;
- ; general purpose find routine
- ;
- ; entry:
- ; hl ^ count,string
- ; a byte searched
- ; exit:
- ; hl ^ found byte
- ; fc if not found
- ; uses:
- ; hl,b,a,psw
- ;
- ;/******************************/
-
- findb: mov b,m
- findb0: inx h
- cmp m
- rz
- dcr b
- jnz findb0
- stc
- ret
-
- ;/******************************/
- ;
- ; binary to decimal conversion
- ;
- ;/******************************/
-
- decotj: call decot ;convert value in hl to decimal
- lxi h,dec ;set to blank out leading zeroes
- mvi a,'0'
- decot1: cmp m ;by converting all zero characters to spaces
- rnz ;exit when first non-zero char hit
- mvi m,' ' ;else proceed with filter loop
- inx h
- jmp decot1
-
- decot: lxi d,dec ;there are more elegant ways to do this
- xchg ;__but this one is simple enough
- lxi b,10000 ;__and creates a string as result
- call dig ;__which then can be justified.
- lxi b,1000
- call dig
- lxi b,100
- call dig
- lxi b,10
- call dig
- lxi b,1
- call dig
- ret
-
- dig: mvi m,'0'
- di0: mov a,e
- sub c
- mov e,a
- mov a,d
- sbb b
- mov d,a
- jm di2
- inr m
- jmp di0
- di2: mov a,e
- add c
- mov e,a
- mov a,d
- adc b
- mov d,a
- inx h
- ret
-
- ;/******************************/
- ;
- ; check for special
- ; symbol character
- ;
- ;/******************************/
-
- ckspsy:
- if mac
- cpi '@'
- rz
- cpi '?'
- ret
- endif ;mac
-
- if tdl
- cpi '$'
- rz
- cpi '%'
- rz
- cpi '.'
- ret
- endif ;tdl
-
- ;/******************************/
- ;
- ; test for alphabetic char.
- ;
- ;/******************************/
-
- ckalp: cpi 'A' ;test for ascii characters
- rc ;between 'A' and 'Z'
- cpi 'Z'+1 ;returns psw/c0 if within range
- cmc
- rnc
- cpi 'a' ;also test lowercase alpha characters
- rc
- cpi 'z'+1
- cmc
- ret
-
- ;/******************************/
- ;
- ; test for numeric char
- ;
- ;/******************************/
-
- cknum: cpi '0' ;test for ascii characters
- rc ;between '0' and '9'
- cpi '9'+1 ;returns psw/c0 if within range
- cmc
- ret
-
- ;/******************************/
- ;
- ; test for hexadecimal char
- ;
- ;/******************************/
-
- ckhex: cpi '0' ;smaller than '0' ?
- rc ;if yes
- cpi 'F'+1 ;greater than 'F' ?
- cmc
- rc ;if yes
- cpi '9'+1 ;if smaller than ':' then ok
- cmc
- rnc ;if true
- cpi 'A' ;if not smaller than 'A' then ok
- ret
-
- ;/******************************/
- ;
- ; test for printable char
- ;
- ;/******************************/
-
- ckpra: cpi ' ' ;test for ascii characters
- rc ;between ' ' and 'z'
- cpi 'z'+1 ;returns psw/c0 if within range
- cmc
- ret
-
- ;/******************************/
- ;
- ; test end of table
- ;
- ;/******************************/
-
- endoft: mov a,m
- cpi -1
- ret
-
- ;/******************************/
- ;
- ; map char to upper case
- ;
- ;/******************************/
-
- mupc: cpi 'a' ;is it smaller than 'a'?
- cmc ;just to be neat
- rnc ;if true, can't map
- cpi 'z'+1 ;is it greater than 'z'?
- rnc ;if true, can't map
- sui 20h ;'a' <= char <= 'z' so convert
- ret
-
- ;/******************************/
- ;
- ; check for special characters
- ;
- ;/******************************/
-
- ckspc: lxi h,ctab ;point to special characters table
- ; jmp look
-
- look: lxi d,3 ;table entry size
- mov b,a ;argument byte in b
- look2: call endoft ;test for end of table
- jz lookn ;yes, not found
- cmp b ;compare
- jz looky ;found
- dad d ;bump pointer
- jmp look2 ;loop
- lookn: stc ;carry = not found
- ret
-
- looky: inx h ;skip to table byte
- mov e,m
- inx h
- mov d,m ;table entry in de
- xchg ;into hl
- ret
-
- ;/******************************/
- ;
- ; save byte in line buffer
- ;
- ;/******************************/
-
- savbt: sta char ;save char in char
- lhld lpnt ;get line pointer
- mov m,a ;save byte
- inx h ;bump pointer
- shld lpnt ;save pointer
- ret
-
- ;/******************************/
- ;
- ; print source line with number
- ;
- ;/******************************/
-
- prlinu: call curpas ;check which pass is active
-
- ; print object expansion of .PRN file
-
- pl0:
- if mac
- mvi b,16
- endif
-
- if tdl
- mvi b,24 ;set loop count
- endif
-
- pl1: call getlc ;get a line buffer character
- jc pl4 ;when psw/c1, @cr (end of line) was reached
- call ckpra ;test for printable character
- cc lpdvd ;could be a formatting char, print out anyway
- jc pl1 ;__but skip count
- call lpdvd ;else, print out character to line printer
- dcr b ;-- count
- jnz pl1 ;loop till done
-
- ; print out line number
-
- push h ;save line buffer ^
-
- if mac
- lda errl ;test for error line
- ora a ;none if false (0)
- jz pl11 ;if no error
- mvi e,' ' ;prettyprint
- call lpdvd ;__to enhance error line number
- call lpdvd
- mvi e,'*'
- mvi b,3
- pl10: call lpdvd
- dcr b
- jnz pl10
- pl11: call lptab ;print out a tab (to align on a tab stop)
- endif ;mac
-
- lhld lastp ;get previous line count
- xchg ;compare last line # to current one
- lhld lcnt ;get current line count
- call cphl ;do the compare
- shld lastp ;update last line printed variable
- jnz pl2 ;if line is different
- lxi h,0 ;blank out same line #
- pl2: call prdec ;print out decimal string
-
- if mac
- call lptab ;print out a tab (to align on a tab stop)
- endif ;mac
-
- if tdl
- mvi e,' '
- mvi b,2
- pl21: call lpdvd
- dcr b
- jnz pl21
- endif ;tdl
-
- pop h ;restore line buffer ^
-
- ; print out remainder of source line
-
- pl3: call getlc ;get a char. from line buffer
- jc pl4 ;when psw/c1, end of line so br out
- call lpdvd ;print out character
- jmp pl3 ;loop for more
-
- ; and exit back
-
- pl4: call lpdvd ;print out @cr (to flush line printer)
- call pinit ;reset line buffer^
- ret
-
- ;/******************************/
- ;
- ; print out line buffer
- ;
- ;/******************************/
-
- bprlin: call bypln ;bypass parsing of the line
- prline: call curpas ;check which pass is active
- jmp pl3 ;print out entire line
-
- ;/******************************/
- ;
- ; line printer driver
- ; with tab compression/expansion
- ;
- ;/******************************/
-
- lptab: mvi e,@tab ;print out tab
- ; jmp lpdvd
-
- lpdvd: push psw
- push h
- call cksumo ;summary option wanted?
- jnz lpdvd3 ;if yes, don't print out char
- lxi h,col ;^ column counter
- mov a,e ;get char to output
- sta char ;save for later
- cpi ' ' ;is it a blank?
- jz lpdvd8 ;if yes
- cpi @tab ;is it a tab
- jz lpdvd4 ;if yes
- call ckentab ;enter tabs?
- mov a,e ;get character to output
- jz lpdvd2 ;if no compression wanted
- mvi e,' ' ;next char to print is a blank
- lpdvd0: mov a,m ;get column count
- inx h ;^ newcol
- sub m ;is col < newcol ?
- dcx h ;^ column
- jp lpdvd1 ;if not, print out actual char
- call pbyt ;output blank
- inr m ;adj. column count
- jmp lpdvd0 ;loop for more
- lpdvd1: lda char ;get original char to print out
- mov e,a ;set up registers
- call lpdvd9 ;smart print
- mov a,m ;get column count
- inx h ;^ newcol counter
- mov m,a ;save in newcount
- jmp lpdvd3 ;exit routine
- lpdvd2: call lpdvd9 ;smart print
- lpdvd3: pop h ;exit gracefully
- pop psw
- ret
-
- lpdvd4: call ckentab ;enter tab option wanted?
- jnz lpdvd6 ;if yes
- mvi e,' ' ;else expand @tabs to blanks
- lpdvd5: call pbyt ;print out blank until tab stop
- inr m ;adjust column count
- mov a,m ;are we on a tab stop?
- ani 7 ;(modulo 8)
- jz lpdvd3 ;exit if so
- jmp lpdvd5 ;else, loop for more
- lpdvd6: inx h ;calculate next tab stop
- mov a,m
- adi 8
- ani -8
- mov m,a
- lpdvd7: dcx h ;^ column counter
- mov m,a ;adjust column count to new position
- call pbyt ;print out @tab
- jmp lpdvd3 ;exit routine
- lpdvd8: call ckentab ;enter tabs option wanted?
- mov a,e ;restore char to print
- jz lpdvd2 ;if not, just print out & adj. column count
- inx h ;^ newcol counter
- inr m ;add one
- mov a,m ;are we on a tab stop?
- ani 7 ;(modulo 8)
- jnz lpdvd3 ;if not on a tab stop, exit
- mov a,m ;get newcol count
- mvi e,@tab ;else, print out @tab
- jmp lpdvd7 ;adj. column counter
- lpdvd9: call ckpra ;is character printable?
- call pbyt ;print-out anyway (for them "smart" printers)
- rc ;so, wasn't printable, don't count
- inr m ;bump column count
- ret
-
- ;/******************************/
- ;
- ; print decimal string
- ; equivalent of HL
- ;
- ;/******************************/
-
- prdec: call decotj ;convert string to decimal
- lxi h,dec ;^ converted string
- prde0: call getlc ;get a char. from decimal string
- rc ;when psw/c1, end of string so br out
- call lpdvd ;print out the char
- jmp prde0 ;loop for more
-
- ;/******************************/
- ;
- ; get next char in line buffer
- ;
- ;/******************************/
-
- getlc: mov e,m ;get byte from buffer (^ by hl)
- mov a,e ;__into a and e
- inx h ;++ ^
- cpi @cr ;test for eol
- stc
- rz ;__and return with psw/c1 if true
- cmc ;__else reset psw/c0 if not
- ret ;__and with read char in a and e
-
- ;/******************************/
- ;
- ; display current pass
- ; and line on console
- ;
- ;/******************************/
-
- curpas: lhld lcnt ;get current line#
- call decotj ;convert to decimal
- call cdisp
- db @cr,'Pass ',@nul
- call ckpass ;is it pass 1?
- jnz curpas1 ;if yes
- call cdisp ;else, its pass 2
- db '2 - ',@nul ;so only print error lines
- lda errl ;is it an error line?
- ora a ;yes if not zero
- jnz curpas2 ;print error line
- call curpas2 ;display line number
- pop h ;don't print normal line
- ret ;(return one level back)
- curpas1:call cdisp
- db '1 - ',@nul
- curpas2:call cdisp
- db 'line # ',@nul
- push d
- lxi d,dec ;display current line#
- call psb ;__to console
- pop d
- ; jmp pinit ;return through pinit
-
- ;/******************************/
- ;
- ; init line buffer pointers
- ;
- ;/******************************/
-
- pinit: lxi h,pbuf ;reset ^ to start of line buffer
- shld lpnt
- sub a ;reset column counters
- sta col
- sta newcol
- ret
-
- ;/******************************/
- ;
- ; collect symbol in sym buf
- ;
- ;/******************************/
-
- gtsym: call mupc ;map symbol to upper case
- mov b,a ;save char
- lda symct ;get symbol count
- cpi symsiz ;max?
- rnc ;yes, done
- inr a
- sta symct
- lhld sympt
- mov m,b
- inx h ;bump symbol pointer
- shld sympt
- ret
-
- ;/******************************/
- ;
- ; printer interfaces
- ;
- ;/******************************/
-
- pbyt: push psw ;there goes the neighborhood...
- push b
- push d
- push h
- call ckcon ;console trace option wanted?
- mov a,e ;get character to display
- cnz fo
- call ckdsk ;disk output option wanted?
- jz pbyt1 ;list to LST: if not
- mov a,e ;get character to save
- call putfc ;else, list to disk
- jmp pbyt2 ;bypass printing
- pbyt1:
- if z8911
-
- ; heath h-89 with z-8911 extended i/o card device driver
-
- in 0d2h ;status port of 8255
- ani 80h ;ready?
- jz pbyt1 ;loop if not
- mov a,e ;get byte to output
- out 0d0h ;data port of 8255
- xra a ;turn strobe on (active low for tally 1602a)
- out 0d2h ;do it
- inr a ;turn strobe off
- out 0d2h ;do it again
-
- if debug
- mvi c,conof
- call bdos
- endif ;debug
-
- else ;if not z8911
-
- if debug
- mvi c,conof
- else ;if not debug
- mvi c,listf ;then use CP/M to perform
- endif ;debug
-
- call bdos ;printer (list) out function
-
- endif ;z8911
-
- pbyt2: call break ;check for console input
- pop h ;restore environment
- pop d
- pop b
- pop psw
- ret
-
- ;/*****************************/
- ;
- ; check for console input
- ;
- ;/*****************************/
-
- break: mvi c,constf ;any pending char?
- call bdos
- ora a
- rz ;if not
-
- ; Kluge to fix a minor bug in the direct console i/o of CP/M 2.2 BDOS.
- ; Console status of DCIO function will not reliably detect the next
- ; typed in character due to the occurence of a 'pseudo-parrallel'
- ; routine (in BDOS) which also checks console status, and saves the
- ; input character if one available. This problem seems to appear more
- ; frequently when the console i/o routines are interrupt driven and
- ; shows up when a key is struck during disk i/o. This 'lost' character
- ; reappears at the CCP prompt when the transient terminates.
-
- if cpm22
- lda warning
- ora a
- jnz break0 ;in case its not v2.2
- lhld lastci ;get ^ to lastci variable (in BDOS)
- mov a,m ;get last char input
- mvi m,0 ;toggle flag
- ora a ;any char present?
- cz dcin ;if not, get it
- jmp break1
- endif ;cpm22
-
- break0: mvi c,conif ;problem with this approach is
- call bdos ;__that it echoes all displayable chars
-
- break1: cpi 'C'-40h ;abort?
- rnz ;if not return with char in a
- lda quiet ;temporarily disable quiet option
- push psw
- call fcdisp ;ask confirmation if abort
-
- if h19
- db @esc,'y5' ;re-enable cursor
- endif ;h19
-
- db @cr,@bel,'Abort? (Y/N or ^C to reboot) ',@nul
- mvi c,conif ;get input and echo
- call bdos
- call mupc ;map to upper case
- cpi 'C'-40h ;reboot?
- jnz break2 ;if not
- call cdisp ;echo '^C' on console
- db '^C',@nul
- jmp wboot ;exit back to CP/M
- break2: cpi 'Y' ;abort? (w/o reboot)
- push psw
- call cdisp ;crlf to screen
- db @cr,@lf,@nul
- pop psw
- jz abort ;if yes, terminate program
-
- if h19
- call cdisp
- db @esc,'x5',@nul ;else, disable cursor
- endif ;h19
-
- pop psw ;restore quiet option
- sta quiet ;__to original value
- ret ;and ignore typed in char
-
- ;/******************************/
- ;
- ; unadorned console input
- ;
- ;/******************************/
-
- dcin: mvi e,-1 ;set for input
- mvi c,dciof ;direct console i/o
- call bdos ;do it
- ora a ;set psw
- ret
-
- ;/******************************/
- ;
- ; initialize parallel port
- ;
- ;/******************************/
-
- if z8911
- in8255: mvi a,0aah ;set up 8255 device
- out 0d3h
- mvi a,1 ;set strobe off
- out 0d2h
- ret
- endif
-
- ;/*******************************/
- ;
- ; issue formf eject
- ;
- ;/*******************************/
-
- formf: push psw
- sub a ;reset page line count
- sta lines
- call cksumo ;is summary option active?
- jnz formf0 ;if yes, don't print
- push d
- mvi e,@ff
- call pbyt
- pop d
- formf0: pop psw
- ret
-
- ;/******************************/
- ;
- ; issue cr, lf & test formf
- ;
- ;/******************************/
-
- crlf2: call crlft
- crlft: push psw
- call crlf ;print out a cr & lf
- lda lines ;++ line counter
- inr a
- sta lines
- cpi pglen ;check for page eject
- cz formf ;__at every n lines printed
- call pinit
- pop psw
- ret
-
- crlf: push psw
- call cksumo ;is summary option active?
- jnz crlf0 ;if yes, don't print
- push d
- mvi e,@lf ;print out @lf
- call pbyt
- mvi e,@cr ;print out @cr
- call pbyt
- pop d
- crlf0: pop psw
- ret
-
- ;/******************************/
- ;
- ; character parsing table
- ;
- ;/******************************/
-
- ctab: db @lf
- dw llf
- db @ff
- dw lff
- db @cr
- dw lcr
- db ''''
- dw lapos
-
- if tdl
- db '"'
- dw lquot
- endif ;tdl
-
- db ';'
- dw lsemi
-
- ; special symbol characters for Digital Research's MAC macro assembler
-
- if mac
- db '@'
- dw lalph
- db '?'
- dw lalph
- endif ;mac
-
- ; special symbols characters for TDL's macro assembler
-
- if tdl
- db '$'
- dw lalph
- db '%'
- dw lalph
- db '.'
- dw ldot
- endif ;tdl
-
- ; end of table
-
- db eof
- way: dw done
-
- ; this character should never be encountered in a normal .PRN file
-
- db -1
- dw former
-
- ;/******************************/
- ;
- ; reserved word table
- ;
- ;/******************************/
-
- rtab:
- if mac
- db 'A '
- db 'ACI '
- db 'ADC '
- db 'ADD '
- db 'ADI '
- db 'ANA '
- db 'AND '
- db 'ANI '
- db 'ASEG ' ;reserved for RMAC
- db 'B '
- db 'C '
- db 'CALL '
- db 'CC '
- db 'CM '
- db 'CMA '
- db 'CMC '
- db 'CMP '
- db 'CNC '
- db 'CNZ '
- db 'CP '
- db 'CPE '
- db 'CPI '
- db 'CPO '
- db 'CSEG ' ;reserved for RMAC
- db 'CZ '
- db 'D '
- db 'DAA '
- db 'DAD '
- db 'DB '
- db 'DCR '
- db 'DCX '
- db 'DI '
- db 'DS '
- db 'DSEG ' ;reserved for RMAC
- db 'DW '
- db 'E '
- db 'EI '
- db 'ELSE ' ;reserved for MAC
- db 'END '
- db 'ENDIF '
- db 'ENDM ' ;reserved for MAC
- db 'EQ '
- db 'EQU '
- db 'EXITM ' ;reserved for MAC
- db 'EXTRN ' ;reserved for RMAC
- db 'GE '
- db 'GT '
- db 'H '
- db 'HIGH '
- db 'HLT '
- db 'IF '
- db 'IN '
- db 'INPAGE' ;reserved for RMAC
- db 'INR '
- db 'INX '
- db 'IRP ' ;reserved for MAC
- db 'IRPC ' ;reserved for MAC
- db 'JC '
- db 'JM '
- db 'JMP '
- db 'JNC '
- db 'JNZ '
- db 'JP '
- db 'JPE '
- db 'JPO '
- db 'JZ '
- db 'L '
- db 'LDA '
- db 'LDAX '
- db 'LE '
- db 'LHLD '
- db 'LOCAL ' ;reserved for MAC
- db 'LOW '
- db 'LT '
- db 'LXI '
- db 'M '
- db 'MACLIB' ;reserved for MAC
- db 'MACRO ' ;reserved for MAC
- db 'MOD '
- db 'MOV '
- db 'MVI '
- db 'NAME ' ;reserved for RMAC
- db 'NE '
- db 'NOP '
- db 'NOT '
- db 'NUL '
- db 'OR '
- db 'ORA '
- db 'ORG '
- db 'ORI '
- db 'OUT '
- db 'PAGE '
- db 'PCHL '
- db 'POP '
- db 'PSW '
- db 'PUBLIC' ;reserved for RMAC
- db 'PUSH '
- db 'RAL '
- db 'RAR '
- db 'RC '
- db 'REPT ' ;reserved for MAC
- db 'RET '
- db 'RLC '
- db 'RM '
- db 'RNC '
- db 'RNZ '
- db 'RP '
- db 'RPE '
- db 'RPO '
- db 'RRC '
- db 'RST '
- db 'RZ '
- db 'SBB '
- db 'SBI '
- db 'SET '
- db 'SHL '
- db 'SHLD '
- db 'SHR '
- db 'SP '
- db 'SPHL '
- db 'STA '
- db 'STAX '
- db 'STC '
- db 'STKLN ' ;reserved for RMAC
- db 'SUB '
- db 'SUI '
- db 'TITLE ' ;reserved for MAC
- db 'XCHG '
- db 'XOR '
- db 'XRA '
- db 'XRI '
- db 'XTHL '
- endif ;mac
-
- if tdl
- db '. ' ;'.' is a legal global symbol
- ;__that in my opinion can lead to confusion
- db '.ASCII'
- db '.ASCIS'
- db '.ASCIZ'
- db '.BLKB '
- db '.BLKW '
- db '.BYTE '
- db '.DATE ' ;reserved for MACRO_III
- db '.DEFIN'
- db '.END '
- db '.ENTRY'
- db '.ERROR'
- db '.EXIT '
- db '.EXTER'
- db '.GOTO '
- db '.I8080'
- db '.IDENT'
- db '.IF1 '
- db '.IF2 '
- db '.IFB '
- db '.IFDEF'
- db '.IFDIF'
- db '.IFE '
- db '.IFG '
- db '.IFGE '
- db '.IFIDN'
- db '.IFL '
- db '.IFLE '
- db '.IFN '
- db '.IFNB '
- db '.IFNDE'
- db '.INSER'
- db '.INTER'
- db '.LADDR'
- db '.LALL '
- db '.LCTL '
- db '.LIMAG'
- db '.LINK '
- db '.LIST '
- db '.LOC '
- db '.LSYM '
- db '.MASYN'
- db '.OPSYN'
- db '.PABS '
- db '.PAGE '
- db '.PBIN '
- db '.PHEX '
- db '.PREL '
- db '.PRGEN'
- db '.PRNTX'
- db '.PROGI'
- db '.PSYM '
- db '.RAD40'
- db '.RADIX'
- db '.RELOC'
- db '.REMAR'
- db '.RLIST'
- db '.SALL '
- db '.SBTTL'
- db '.SETDA' ;reserved for MACRO_III
- db '.SETLE' ;reserved for MACRO_III
- db '.SETTI' ;reserved for MACRO_III
- db '.SETWI' ;reserved for MACRO_III
- db '.SLIST'
- db '.SYN '
- db '.SYSYN'
- db '.TEMPS'
- db '.TIME ' ;reserved for MACRO_III
- db '.TITLE'
- db '.WORD '
- db '.XADDR'
- db '.XALL '
- db '.XCTL '
- db '.XIMAG'
- db '.XLINK'
- db '.XLIST'
- db '.XPSYM'
- db '.XSYM '
- db '.Z80 '
- db 'A '
- db 'ACI '
- db 'ADC '
- db 'ADD '
- db 'ADI '
- db 'ANA '
- db 'ANI '
- db 'B '
- db 'BIT '
- db 'C '
- db 'CALL '
- db 'CC '
- db 'CCD '
- db 'CCDR '
- db 'CCI '
- db 'CCIR '
- db 'CM '
- db 'CMA '
- db 'CMC '
- db 'CMP '
- db 'CNC '
- db 'CNO '
- db 'CNZ '
- db 'CO '
- db 'CP '
- db 'CPE '
- db 'CPI '
- db 'CPO '
- db 'CZ '
- db 'D '
- db 'DAA '
- db 'DAD '
- db 'DADC '
- db 'DADX '
- db 'DADY '
- db 'DCR '
- db 'DCX '
- db 'DI '
- db 'DJNZ '
- db 'DSBC '
- db 'E '
- db 'EI '
- db 'EXAF '
- db 'EXX '
- db 'H '
- db 'HLT '
- db 'IM0 '
- db 'IM1 '
- db 'IM2 '
- db 'IN '
- db 'IND '
- db 'INDR '
- db 'INI '
- db 'INIR '
- db 'INP '
- db 'INR '
- db 'INX '
- db 'JC '
- db 'JM '
- db 'JMP '
- db 'JMPR '
- db 'JNC '
- db 'JNO '
- db 'JNZ '
- db 'JO '
- db 'JP '
- db 'JPE '
- db 'JPO '
- db 'JRC '
- db 'JRNC '
- db 'JRNZ '
- db 'JRZ '
- db 'JZ '
- db 'L '
- db 'LBCD '
- db 'LDA '
- db 'LDAI '
- db 'LDAR '
- db 'LDAX '
- db 'LDD '
- db 'LDDR '
- db 'LDED '
- db 'LDI '
- db 'LDIR '
- db 'LHLD '
- db 'LIXD '
- db 'LIYD '
- db 'LSPD '
- db 'LXI '
- db 'M '
- db 'MOV '
- db 'MVI '
- db 'NEG '
- db 'NOP '
- db 'ORA '
- db 'ORI '
- db 'OUT '
- db 'OUTD '
- db 'OUTDR '
- db 'OUTI '
- db 'OUTIR '
- db 'OUTP '
- db 'P '
- db 'PCHL '
- db 'PCIX '
- db 'PCIY '
- db 'POP '
- db 'PSW '
- db 'PUSH '
- db 'RAL '
- db 'RALR '
- db 'RAR '
- db 'RARR '
- db 'RC '
- db 'RES '
- db 'RET '
- db 'RETI '
- db 'RETN '
- db 'RLC '
- db 'RLCR '
- db 'RLD '
- db 'RM '
- db 'RNC '
- db 'RNO '
- db 'RNZ '
- db 'RO '
- db 'RP '
- db 'RPE '
- db 'RPO '
- db 'RRC '
- db 'RRCR '
- db 'RRD '
- db 'RST '
- db 'RZ '
- db 'SBB '
- db 'SBCD '
- db 'SBI '
- db 'SDED '
- db 'SET '
- db 'SHLD '
- db 'SIXD '
- db 'SIYD '
- db 'SLAR '
- db 'SP '
- db 'SPHL '
- db 'SPIX '
- db 'SPIY '
- db 'SRAR '
- db 'SRLR '
- db 'SSPD '
- db 'STA '
- db 'STAI '
- db 'STAR '
- db 'STAX '
- db 'STC '
- db 'SUB '
- db 'SUI '
- db 'X '
- db 'XCHG '
- db 'XRA '
- db 'XRI '
- db 'XTHL '
- db 'Y '
- endif ;tdl
-
- db -1 ;end of reserved word table
-
- ;/******************************/
- ;
- ; routine to open a disk file
- ;
- ; in: de=a(fcb)
- ; out: fc/1=error
- ;
- ;/******************************/
-
- fopen: mvi c,openf ;open file function
- call bdos ;issue open
- cpi -1 ;error?
- stc ;set psw/c1 if so
- rz
- cmc ;else clear carry
- ret
-
- ;/******************************/
- ;
- ; routine to close a disk file
- ;
- ; in: de=a(fcb)
- ;
- ;/******************************/
-
- fclose: mvi c,closef
- jmp bdos ;return through BDOS
-
- ;/******************************/
- ;
- ; routine to read a byte
- ;
- ; out: a=byte
- ; fc/1=error
- ;
- ;/******************************/
-
- getfc: call getbt ;get a file character
- call savbt ;save it in line buffer
- jc skipn0 ;in case of hard eof
- cpi eof ;__or soft eof
- jz skipn0
- cpi ' ' ;set psw/z1 if space
- ret
-
- getbt: push b
- push d
- push h
- lhld tbdma ;get end of buffer
- xchg ;to de
- lhld inptr ;current pointer in hl
- call cphl ;test for end of buffer
- jz getb2 ;yes, read
- getb1: mov a,m ;get byte
- inx h ;bump pointer
- shld inptr ;save pointer
- ora a ;reset carry
- jmp ierr1 ;exit
- getb2: lda tbflg ;get flag
- ora a ;test it
- jnz ierr ;br if no more
- lxi h,tbuf-128 ;else set start of buffer
- mvi a,tbsze ;and buffer size in sectors
- getb3: sta tbcnt ;save it
- lxi d,128 ;calculate new starting
- dad d ;address
- shld tbdma ;save it
- xchg ;place it in de
- mvi c,sdmaf ;set dma address
- call bdos
- mvi c,readf ;read code
- lxi d,fcb ;fcb address
- call bdos ;issue read
- ora a ;check for error/e-o-f
- jnz getb4 ;br if so
- lhld tbdma ;else get last dma starting addr
- lda tbcnt ;get sector count
- dcr a ;subtract one
- jnz getb3 ;br if some more
- lxi d,128 ;else set new end of buffer
- dad d
- shld tbdma
- jmp getb5
- getb4: mvi a,-1 ;set flag
- sta tbflg
- getb5: lxi h,tbuf ;reset buffer pointer
- jmp getb1 ;continue
-
- ierr: stc
- ierr1: pop h
- pop d
- pop b
- ret
-
- ;/******************************/
- ;
- ; routine to save a byte
- ;
- ;/******************************/
-
- putfc: cpi eof
- jz putfc1
- call writec
- ret
- putfc1: call writec
- putfc2: lda bufadd
- cpi 128
- rz
- mvi a,eof
- call writec
- jmp putfc2
-
- ;/******************************/
- ;
- ; write a character to disk
- ;
- ;/******************************/
-
- writec: push h
- lhld bufadd
- mov m,a
- inx h
- sub a
- cmp l
- cz newrit
- shld bufadd
- pop h
- ret
-
- newrit: lxi h,dma
- push h
- push d
- push b
- push psw
- xchg
- mvi c,sdmaf ;set dma address
- call bdos
- lxi d,dfcb
- mvi c,writef
- call bdos ;write one record
- ora a ;write okay?
- jz wexit ;if yes
- call fcdisp
- db @bel,'+++ disk full +++ ',@nul
- jmp abort
-
- wexit: pop psw
- pop b
- pop d
- pop h
- ret
-
- ;/******************************/
- ;
- ; c p h l
- ; routine to compare hl vs de
- ;
- ;/******************************/
-
- cphl: mov a,h
- cmp d
- rnz
- mov a,l
- cmp e
- ret
-
- ;/*****************************/
- ;
- ; word to decimal conversion
- ;
- ;/*****************************/
-
- decout: push psw
- push b
- push d
- push h
- lxi b,-10 ;radix for conversion
- lxi d,-1 ;becomes number/radix
- decou1: dad b ;substract 10
- inx d
- jc decou1
- lxi b,10 ;add radix back in once
- dad b
- xchg
- mov a,h ;test for zero
- ora l
- cnz decout ;elegant recursive call
- mov a,e
- adi '0' ;convert from bcd to hex
- call co ;display
- pop h
- pop d
- pop b
- pop psw
- ret
-
- ;/******************************/
- ;
- ; inline message display
- ;
- ;/******************************/
-
- ildisp: xthl ;get ^string from stack
- ildis1: mov a,m ;get a byte
- inx h ;bump ^
- ora a ;test for delimiter
- push psw
- push d
- push h
- lxi h,ildis2 ;set indirect
- push h ;return address on stack
- xchg ;get routine address
- pchl ;indirect call
- ildis2: pop h
- pop d
- pop psw
- jnz ildis1 ;loop till done
- xthl ;restore proper return address
- ret
-
- ;/******************************/
- ;
- ; print message on both
- ; console and line printer
- ;
- ;/******************************/
-
- lcdisp: lxi d,lcdisp1
- jmp ildisp
- lcdisp1:mov e,a
- call lpdvd
- jmp co ;indirect return through co
-
- ;/******************************/
- ;
- ; print message to line printer
- ;
- ;/******************************/
-
- ldisp: lxi d,ldis1
- jmp ildisp
- ldis1: mov e,a
- jmp lpdvd ;indirect return through lpdvd
-
- ;/******************************/
- ;
- ; force display of
- ; message on console
- ;
- ;/******************************/
-
- fcdisp: sub a ;deactivate quiet option
- sta quiet
- ; jmp cdisp ;return through cdisp
-
- ;/******************************/
- ;
- ; conditional display of
- ; message on console
- ;
- ;/******************************/
-
- cdisp: lxi d,co ;indirect return through co
- jmp ildisp
-
- ;/******************************/
- ;
- ; output character to console
- ;
- ;/******************************/
-
- co: push psw
- call ckquiet
- jz co0
- pop psw
- ret
- co0: pop psw
- ; jmp fo
-
- fo: push psw
- push b
- push d
- push h
- mov e,a
- mvi c,conof
- call bdos
- pop h
- pop d
- pop b
- pop psw
- ret
-
- ;/******************************/
- ;
- ; print string buffer to console
- ;
- ;/******************************/
-
- psb: push psw
- push b
- push d
- push h
- mvi c,psbf
- call ckquiet
- cz bdos
- pop h
- pop d
- pop b
- pop psw
- ret
-
- ;/******************************/
- ;
- ; banner print routine
- ;
- ;/******************************/
-
- banner:
- if eject
- call formf ;start on fresh page
- endif ;eject
-
- call ckban ;banner wanted or not?
- rnz ;just return if not
- call bannes
- jmp formf ;return through formf
-
- bannes: if mac
- mvi b,8 ;__8 lines down
- endif ;mac
-
- if tdl
- mvi b,9
- endif ;tdl
-
- bannel: call crlf
- dcr b
- jnz bannel
- call mvfcb ;get converted fcb
- banne0: mvi d,40h ;init d for matrix of 7 vertical
- lxi h,pbuf ;define buffer area
- banne1: shld banc ;save ^char. buffer
- mov a,m ;get char from buffer
- ani 7fh ;strip off r/o bit
- mov m,a ;__for good
- cpi @cr ;end of record?
- jz banne2 ; finish full expansion if so
- call cvpix ; no, link char. to graphics
- cnc banexp ;if legal, expand first scan of pixels
- lhld banc ;restore ^char.
- inx h ;++^
- jmp banne1 ;loop till done
-
- ; print out full characters expansion
-
- banne2: call crlf ;print out line and start a fresh one
- mov a,d
- rar
- ani 7fh
- rz ;exit when done
- mov d,a
- banne3: lxi h,pbuf ;reset to start of buffer
- banne4: shld banc ;save ^char.
- mov a,m ;get char.
- cpi @cr ;record end?
- jz banne2 ;expand all if so
- call cvpix ;link char. to graph.
- cnc banexp ;if legal, print another scan
- lhld banc ;get ^char.
- inx h ;++^
- jmp banne4 ;loop till done
-
- ; convert characters to graphics
-
- cvpix: push h ;save ^
- call cvpi2 ;link ^ ;cy = invalid
- jc cvpi1 ;if error, restore original ^
- xthl ;else save link ^ on stack
- cvpi1: pop h ;restore stack into hl
- ret
-
- cvpi2: mov e,a
- sui ' '
- rc
- lxi h,0
- jz cvpi4
- sui '*'-' '
- rc
- cpi 'Z'+1-'*'
- jnc cvpi5
- adi 1
- mvi b,0
- mov c,a
- mov l,a
- dad h ;1x*2 = 2x
- dad b ;2x+x = 3x
- dad h ;3x*2 = 6x
- dad b ;6x+x = 7x
- cvpi4: lxi b,pixtab
- dad b
- ret
- cvpi5: adi -1
- ret
-
- ; expand and print out graphics
-
- banexp: mvi c,7 ;set #of pixels per char
- banex1: shld banp
- mov a,m
- ana a
- jm banex3
- mov b,e
- ana d
- jnz banex2
- mvi b,' '
- banex2: push b
- push d
- mov e,b
- call pbyt
- pop d
- pop b
- lhld banp
- inx h
- dcr c
- jnz banex1
- banex3: mvi b,' '
- push b
- push d
- mov e,b
- call pbyt
- call pbyt
- call pbyt
- pop d
- pop b
- ret
-
- ;/******************************/
- ;
- ; xfer justified fcb
- ;
- ;/******************************/
-
- mvfcb: lxi h,pbuf ;^ destination
- push h ;save ^
- lxi d,fcb+1 ;^ source
- mvi b,8 ;max file name length
- call move ;perform transfer
- pop h ;restore ^ destination
- mvi a,' ' ;prepare to justify (filter spaces)
- mvi b,8 ;safeguard
- mvfc0: cmp m ;test for first space
- jz mvfc1 ;exit loop when hit
- inx h ;bump ^
- dcr b ;in case 8 chars used in fn.
- jnz mvfc0 ;loop for more
- mvfc1: mvi m,'.' ;insert a dot
- inx h ;bump ^
- mvi b,3 ;max extent length
- call move ;xfer again
- mvi m,@cr ;save delimiter
- ret
-
- ;/******************************/
- ;
- ; graphics pixels table
- ;
- ;/******************************/
-
- pixtab: db 00h,00h,00h,00h,00h,00h,00h ;null
- db 08h,22h,08h,1ch,08h,22h,08h ; *
- db 08h,08h,08h,3eh,08h,08h,08h ; +
- db 03h,80h,80h,80h,80h,80h,80h ; ,
- db 08h,08h,08h,08h,08h,80h,80h ; -
- db 01h,80h,80h,80h,80h,80h,80h ; .
- db 01h,02h,04h,08h,10h,20h,40h ; /
- db 3eh,43h,45h,49h,51h,61h,3eh ; 0
- db 01h,11h,31h,7fh,01h,01h,01h ; 1
- db 20h,41h,43h,45h,49h,51h,21h ; 2
- db 22h,41h,49h,49h,49h,49h,36h ; 3
- db 04h,0ch,14h,24h,44h,0fh,04h ; 4
- db 7ah,49h,49h,49h,49h,49h,46h ; 5
- db 3eh,49h,49h,49h,49h,49h,26h ; 6
- db 41h,42h,44h,48h,50h,60h,40h ; 7
- db 36h,49h,49h,49h,49h,49h,36h ; 8
- db 32h,49h,49h,49h,49h,49h,3eh ; 9
- db 12h,80h,80h,80h,80h,80h,80h ; :
- db 13h,80h,80h,80h,80h,80h,80h ; ;
- db 08h,14h,22h,41h,41h,41h,80h ; <
- db 14h,14h,14h,14h,14h,14h,14h ; =
- db 41h,41h,41h,22h,14h,08h,80h ; >
- db 20h,40h,40h,4dh,48h,50h,20h ; ?
- db 3eh,41h,41h,49h,55h,55h,39h ; @
- db 3fh,48h,48h,48h,48h,48h,3fh ; A
- db 7fh,49h,49h,49h,49h,49h,36h ; B
- db 3eh,41h,41h,41h,41h,41h,22h ; C
- db 7fh,41h,41h,41h,41h,41h,3eh ; D
- db 7fh,49h,49h,49h,49h,49h,41h ; E
- db 7fh,48h,48h,48h,48h,48h,40h ; F
- db 3eh,41h,41h,41h,4dh,49h,2eh ; G
- db 7fh,08h,08h,08h,08h,08h,7fh ; H
- db 41h,41h,41h,7fh,41h,41h,41h ; I
- db 06h,01h,01h,01h,41h,7eh,40h ; J
- db 7fh,08h,08h,08h,14h,22h,41h ; K
- db 7fh,01h,01h,01h,01h,01h,01h ; L
- db 7fh,20h,10h,08h,10h,20h,7fh ; M
- db 7fh,20h,10h,08h,04h,02h,7fh ; N
- db 3eh,41h,41h,41h,41h,41h,3eh ; O
- db 7fh,48h,48h,48h,48h,48h,30h ; P
- db 3eh,41h,41h,45h,45h,42h,3dh ; Q
- db 7fh,48h,48h,4ch,4ah,4ah,31h ; R
- db 32h,49h,49h,49h,49h,49h,26h ; S
- db 40h,40h,40h,7fh,40h,40h,40h ; T
- db 7eh,01h,01h,01h,01h,01h,7eh ; U
- db 70h,0ch,02h,01h,02h,0ch,70h ; V
- db 7fh,02h,04h,08h,04h,02h,7fh ; W
- db 41h,22h,14h,08h,14h,22h,41h ; X
- db 60h,10h,08h,07h,08h,10h,60h ; Y
- db 41h,43h,45h,49h,51h,61h,41h ; Z
-
- ;/******************************/
- ;
- ; miscellaneous data
- ;
- ;/******************************/
-
- symbt: dw 0 ;symbol table bottom address
- symtp: dw 0 ;symbol table top address
- refbt: dw 0 ;reference table bottom address
- reftp: dw 0 ;reference table top address
- sym: dw 0 ;current symbol table address
- ref: dw 0 ;current reference table address
- from: dw 0 ;move pointer
- to: dw 0 ;to pointer
- limit: dw 0 ;limit pointer
- col: db 0 ;current line column position
- newcol: db 0 ;for tabs compression
- char: db 0 ;last read character
- errl: db 0 ;error line flag
- lcnt: dw 0 ;line counter
- errorc: dw 0 ;error counter
- lpnt: dw 0 ;line buffer char ^
- lastp: dw 0 ;previous line number variable
- symct: db 0 ;symbol count
- sympt: dw 0 ;symbol ^
- lines: db 0 ;print line count
- temp: dw 0 ;temporary variable
- tbflg: db 0 ;transient buffer flag (00=more, ff=no more)
- tbcnt: db 0 ;transient buffer sector count
- tbdma: dw 0 ;dma end of buffer address
- inptr: dw 0 ;input pointer
- bufadd: dw 0 ;output pointer
- banc: dw 0 ;banner character pointer
- banp: dw 0 ;banner pixel pointer
- pass: db 0 ;current pass flag
- crt: db 0 ;CON: trace option flag
- diskl: db 0 ;disk output option flag
- error: db 0 ;error only option flag
- nobanr: db 0 ;no banner option flag
- quiet: db 0 ;quiet operation flag
- summary:db 0 ;summary option flag
- entab: db 0 ;compress tabs option flag
- warning:db 0 ;CP/M 2.2 BDOS flag
- lastci: dw 0 ;vector to last char entered (in BDOS 2.2)
- ifcb: rept fcbl ;initial fcb copy
- db 0
- endm
- dfcb: rept fcbl ;destination fcb
- db 0
- endm
- dec: rept digits ;right justified line # string
- db 0
- endm
- db @cr,'$'
- sbuf set $ ;symbol buffer
- pbuf set sbuf+symsiz ;line buffer
- stack set pbuf+132+100h ;local stack area
- tbuf set stack ;transient buffer
-
- ;/*********************************/
- ;
- ; symbol table area
- ;
- ; the symbol table must be the
- ; last location of the program
- ;
- ;/*********************************/
-
- symt set tbuf+(tbsze*128)
-
- end tpa