Files
RomWBW/Source/Images/d_bp/u15/DPROG.MAC
b1ackmai1er 78f65522b7 Dev (#108)
* added hack to handle tunes

* quiet clean

* added chmod for execution

* suppress warnings

* Multi-boot fixes

* the windows build somehow thinks that these filesystems are cpm3.

* credit and primitive instructions

* Update sd.asm

Cosmetic fix.

* make compile shut up about conditionals

* Add bin2asm for linus and update build to process font files under linix

* fixed quoted double quote bug, added tests

* added tests

* added bin2asm for font file source creation

* Revert linux bin2asm font stuff

* added rule for font source generation

* build fonts

* added directory mapping cache.  if the same directory is being hit
as last run, we don't need to rebuild the map.  will likely break if
you are running more than one at a time, in that the cache will be
ineffective.  also, if the directory contents change, this will also break.

* removed strip.  breaks osx

* added directory tag so . isn't matched all over the place

* added real cache validation

* fixed build

* this file is copied from optdsk.lib or optcmd.lib

* install to ../HBIOS

* prerequisite verbosity

* diff soft failure and casefn speedup

* added lzsa

* added lzsa

* removed strip. breaks on osx

* added clobber

* added code to handle multiple platform rom builds with rom size override

* added align and 0x55 hex syntax

* default to hd64180

* added N8 capability

* added SBC_std.rom to default build

* added support for binary diff

* diff fixes

* clean, identical build.  font source generator emitted .align.  this does not match the windows build

* Upgrade NZCOM to latest

* Misc. Cleanup

* fixed expression parser bug : ~(1|2) returned 0xfe

* added diff build option

* Update Makefile

Makefile enhancement to better handle ncurses library from Bob Dunlop.

* Update sd.asm

Back out hack for uz80as now that Curt fixed it.

* Misc. Cleanup

* UNA Catchup

UNA support was lacking some of the more recent behavior changes.  This corrects most of it.

* Add github action for building RomWBW

* Bump Pre-release Version

* Update build.yml

Added "make clean" which will remove temporary files without removing final binary outputs.

* Update Makefile

Build all ROM variants by default in Linux/Mac build.

* Update Makefile

* Update Makefile

* Update Makefile

* Update Makefile

* Update Makefile

* Update Makefile

* Update Makefile

* Update Makefile

* Update Makefile

* Update for GitHub Build

Case issue in TASM includes showing up in GitHub build.  This should correct that.

* Added an gitignore files to exclude generated files

* Removed Tunes/clean.cmd and Tunes/ReadMe.txt - as make clean removes them

* Build.sh: marked as executable

chmod +x Build.sh

* Fix to HBIOS/build.sh

When adding files to rom disk, if files were missing, it would error out.

It appears the intent is to skip non-existing files.

Updated to log out correctly for missing files - and continue operation.

* Update Microsoft NASCOM BASIC.docx

Nascom manual, text version by Jan S (full name unknown)

* Fix issue with Apps/Tune not making

If dest directory does not exist, fails to make Apps

* Create ReadMe.txt

* Update Makefile

* Update Build.sh

* Make .gitignores for Tools/unix more specific

* cpmtools Update

Updated cpmtools applications (Windows only).  Removed hack in diskdefs that is no longer required.

* HBIOS Proxy Temp Stack Enhancement

Reuse the bounce buffer area as the temporary stack space required briefly in HBX_INVOKE when transitioning banks.  Increases size of temporary stack space to 64 bytes.

* Update ReadMe.txt

* HBIOS - clean up TMPSTK

* Update hbios.asm

Minor cosmetic changes.

* Build Process Updates

Minor udpates to build process to improve consistency between Windows and Mac/Linux builds.

* Update hbios.asm

Add improved interrupt protection to HBIOS PEEK, POKE, and BNKCPY functions.

* hbios - wrap hbx_bnkcpy

* hbios - adjust hbx_peek hbx_poke guards

* Update hbios.asm

Adjusted used of DI/EI for PEEK and POKE to regain a bit of INTSTK space.  Added code so that HB_INVBNK can be used as a flag indicating if HBIOS is active, $FF is inactive, anything else means active.

* Add HBIOS MuTex

* Initial Nascom basic ecb-vdu graphics

set and reset for 80x25b screen with 256 character mod

* Finalize Pre-release 34

Final support for FreeRTOS

* Update nascom.asm

Optimization, cleanup, tabs and white spaces

* IDE & PPIDE Cleanup

* Clean up

Make version include files common.

* Update Makefile

* Update Makefile

* Build Test

* Build Test

* Build Fixes

* Update nascom.asm

Cleanup

* Update nascom.asm

Optimization

* hbios - temp stack tweak

* Update hbios.asm

Comments on HBX_BUF usage.

* Update nascom.asm

Optimization

* Update nascom.asm

Setup ECB-VDU build option, remove debug code

* Update nascom.asm

Set default build. update initialization

* Update nascom.asm

Make CLS clear vdu screen

* Update nascom.asm

Fixup top screen line not showing

* Add SC131 Support

Also cleaned up some ReadMe files.

* HBIOS SCZ180 - remove mutex special files

* HBIOS SCZ180 - adjust mutex comment

* Misc. Cleanup

Includes some minor improvements to contents in some disk images.

* Delete FAT.COM

Changing case of FAT.COM extension to lowercase.

* Create FAT.com

Completing change of case in extension of FAT.com.

* Update Makefile

Remove ROM variants that just have the HBIOS MUTEX enabled.  Users can easily enable this in a custom build.

* Cleanup

Removed hack from Images Makefile.  Fixed use of DEFSERCFG in various places.

* GitHub CI Updates

Adds automation of build and release assets upon release.

* Prerelease 36

General cleanup

* Build Script Cleanups

* Config File Cleanups

* Update RomWBW Architecture

General refresh for v2.9.2

* Update vdu.asm

Removed a hack in VDU driver that has existed for 8 years.  :-)

* Fix CONSOLE Constant

Rename CIODEV_CONSOLE constant to CIO_CONSOLE because it is a unit code, not a device type code.

Retabify TastyBasic.

* Minor Bug Fixes

- Disk assignment edge case
- CP/M 3 accidental fall thru
- Cosmetic updates

* Update util.z80

* Documentation Cleanup

* Documentation Update

* Documentation Update

* Documentation Updates

* Documentation Updates

* Create Common.inc

* Documentation Updates

* Documentation Updates

* doc - a few random fixes

* Documentation Cleanup

* Fix IM 0 Build Error in ACIA

* Documentation Updates

* Documentation Cleanup

* Remove OSLDR

The OSLDR application was badly broken and almost impossible to fix with new expanded OS support.

* Bug Fixes

- Init RAM disk at boot under CP/M 3
- Fix ACR activation in TUNE

* FD Motor Timeout

- Made FDC motor timeout smaller and more consistent across different speed CPUs
- Added "boot" messaging to RTC

* Cleanup

* Cleanup

- Fix SuperZAP to work under NZCOM and ZPM3
- Finalize standard config files

* Minor Changes

- Slight change to ZAP configuration
- Added ZSDOS.ZRL to NZCOM image

* ZDE Upgrade

- Upgraded ZDE 1.6 -> 1.6a

* Config File Tuning

* Pre-release for Testing

* cfg - mutex consistent config language

* Bump to Version 3.0

* Update SD Card How-To

Thanks David!

* update ReadMe.md

Remove some odd `\`.

* Update ReadMe.txt

* Update ReadMe.md

* Update Generated Doc Files

* Improve XModem Startup

- Extended startup timeout for XM.COM so that it doesn't timeout so quickly while host is selecing a file to send.
- Updated SD Card How-To from David Reese.

* XModem Timing Refinements

* TMS Driver Z180 Improvements

- TMS driver udpated to insert Z180 I/O waitstates internally so other code can run at full speed.
- Updated How-To documents from David.
- Fixed TUNE app to properly restore Z180 I/O waitstates after manipulating them.

* CLRDIR and ZDE updates

- CLRDIR has been updated by Max Scane for CP/M 3 compatibility.
- A minor issue in the preconfigured ZDE VT100 terminal escape sequences was corrected.

* Fix Auto CRT Console Switch on CP/M 3

* Handle lack of RTC better

DSRTC driver now correctly returns an error if there is no RTC present.

* Minor RTC Updates

* Finalize v3.0.1

Cleanup release for v3.0

* New ROMLDR and INTRTC driver

- Refactored romldr.asm
- Added new periodic timer based RTC driver

* CP/M 3 Date Hack

- Hack to allow INTRTC to increment time without destroying the date

* Update romldr.asm

Work around minor Linux build inconsistency

* Update Apps for New Version

* Revert "Update Apps for New Version"

This reverts commit ad80432252.

* Revert "Update romldr.asm"

This reverts commit 4a9825cd57.

* Revert "CP/M 3 Date Hack"

This reverts commit 153b494e61.

* Revert "New ROMLDR and INTRTC driver"

This reverts commit d9bed4563e.

* Start v3.1 Development

* Update FDISK80.COM

Updated FDISK80 to allow reserving up to 256 slices.

* Update sd.asm

For Z180 CSIO, ensure that xmit is finished, before asserting CS for next transaction.

* Add RC2014 UART, Improve SD protocol fix

- RC2014 and related platforms will autodetect a UART at 0xA0 and 0xA8
- Ensure that CS fully brackets all SD I/O

* ROMLDR Improvements

.com files can now be started from CP/M and size of .com files has been reduced so they always fit.

* Update commit.yml

Run commit build in all branches

* Update commit.yml

Run commit build for master and dev branches

* Improved clock driver auto-detect/fallback

* SIO driver now CTC aware

The SIO driver can now use a CTC (if available) to provide much more flexible baud rate programming.

* CTC driver fine tuning

* Update xmdm125.asm

Fixed a small issue in core XM125 code that caused a file write error message to not be displayed when it should be.

* CF Card compatibility improvement

Older CF Cards did not reset IDE registers to defaults values when reset.  Implemented a work around.

* Update ACIA detection

ACIA should no longer be detected if there is also a UART module in the system.

* Handle CTC anomaly

Small update to accommodate CTC behavior that occurs when the CTC trigger is more than half the CTC clock.

* Update acia.asm

Updated ACIA detection to use primary ACIA port instead of phantom port.

* Update acia.asm

Fix bug in ACIA detection.

Thanks Alan!

* MacOS Build Improvement

Build script updated to improve compatibility with MacOS.

Credit to Fredrik Axtelius for this.

* HBIOS Makefile - use env vars for target

Allow build ROM targets to be restricted to just one platform thru use of ENV vars:

ROM_PLATFORM - if defined to a known platform, only this platform is build - defaults to std config
ROM_CONFIG - sets the desired platform config - defaults to std

if the above ENVs are not defined, builds all ROMs

* Added some more gitignores

* Whitespace changes (crlf)

* HBIOS: Force the assembly to fail for vdu drivers if function table count is not correct

* Whitespace: trailing whitespaces

* makefile: updated some make scripts to use  when calling subdir makefiles

* linux build: update to Build.sh fix for some platforms

The initialization of the Rom dat file used the pipe (|) operator to build an initial empty file.

But the pipe operator | may sometimes return a non-zero exit code for some linux platforms, if the
the streams are closed before dd has fully processed the stream.

This issue occured on a travis linux ubuntu image.

Solution was to change to redirection.

* Bump version

* Enhance CTC periodic timer

Add ability to use TIMER mode in CTC driver to generate priodic interrupts.

* HBIOS: Added support for sound drivers

New sound driver support with initial support for the SN76489 chip

New build configuration entry:
* SN76489ENABLE

Ports are currently locked in with:
* SN76489_PORT_LEFT       .EQU    $FC     ; PORTS FOR ACCESSING THE SN76489 CHIP (LEFT)
* SN76489_PORT_RIGHT      .EQU    $F8     ; PORTS FOR ACCESSING THE SN76489 CHIP (LEFT)

* Miscellaneous Cleanup

No functional changes.

Co-authored-by: curt mayer <curt@zen-room.org>
Co-authored-by: Wayne Warthen <wwarthen@gmail.com>
Co-authored-by: ed <linux@maidavale.org>
Co-authored-by: Dean Netherton <dnetherton@dius.com.au>
Co-authored-by: ed <ed@maidavale.org>
Co-authored-by: Phillip Stevens <phillip.stevens@gmail.com>
Co-authored-by: Dean Netherton <dean.netherton@gmail.com>
2020-04-24 06:17:22 +08:00

1125 lines
18 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
;
; PROGRAM: DPROG
; AUTHOR: Richard Conn
; VERSION: 1.0
; DATE: 28 July 84
; PREVIOUS VERSIONS: None
;
vers equ 10
z3env equ 0f400h
;
; DPROG is used to program the user's terminal, printer, or punch
; with data from the file specified in the command line. DPROG will
; automatically search for the file along the path starting at the
; indicated (or implied) DU.
;
;
; Basic Equates
;
opsys equ 0
fcb equ 5ch
tbuff equ 80h
cr equ 0dh
ff equ 0ch
lf equ 0ah
ctrlc equ 'C'-'@'
ctrls equ 'S'-'@'
ctrlz equ 'Z'-'@'
bel equ 7
bs equ 8
tab equ 9
;
; DPROG Constants
;
COMMENT equ ';' ;denotes a comment line
WORD equ '-' ;denotes a word definition
SYM equ '=' ;symbol table dump command
DEV equ '>' ;device assignment
INP equ '<' ;input forms (pause, string, delay)
wordl equ 16 ;length of word
fmt equ '(' ;begin format definition
fmtch equ '%' ;format escape char
endfmt equ ')' ;end format definition
quote equ '"' ;quote string
literal equ '\' ;literal interpretation follows
control equ '^' ;control char follows
;
; SYSLIB Routines
;
ext condin,cin,cout,lout,pout
ext z3init,pfind,z3log
ext moveb,hmovb,logud,pfn1,caps
ext f$open,f$read,f$close
ext eval,pafdc,pa2hc
ext codend
;
; Environment Definition
;
if z3env ne 0
;
; External ZCPR3 Environment Descriptor
;
jmp start
db 'Z3ENV' ;This is a ZCPR3 Utility
db 1 ;External Environment Descriptor
z3eadr:
dw z3env
start:
lhld z3eadr ;pt to ZCPR3 environment
;
else
;
; Internal ZCPR3 Environment Descriptor
;
MACLIB Z3BASE.LIB
MACLIB SYSENV.LIB
z3eadr:
jmp start
SYSENV
start:
lxi h,z3eadr ;pt to ZCPR3 environment
endif
;
; Start of Program -- Initialize ZCPR3 Environment
;
call z3init ;initialize the ZCPR3 Env
;
; Initial Routines
;
call helpck ;check for help
call bufinit ;initialize buffers
;
; Load File
;
call locfile ;locate file
call logud ;enter directory of file
call load ;load file
;
; Perform Program
;
call program ;program the user's terminal
ret
;
; Initialize Buffers
;
bufinit:
call codend ;address of free space
shld format ;format string
xchg
lxi h,deffmt ;set default format (char)
mvi b,40 ;allow 40 chars
call moveb
xchg ;HL pts to format buffer
inr h ;next page
shld locstk ;set location stack
shld tos ;set top of stack
mvi m,0
inx h
mvi m,0 ;zero stack
dcx h
inr h ;next page
shld free ;free area
mvi a,'C' ;assign console as output device
sta outdev
ret
;
; Check for Help
;
helpck:
lxi h,fcb+1 ;pt to fcb name
mov a,m ;get it
cpi '/' ;help if slash
rnz
pop psw ;clear stack
call eprint
db 'DPROG, Version '
db (vers/10)+'0','.',(vers mod 10)+'0'
db cr,lf,' Syntax:'
db cr,lf,' DPROG <-- STD.DPG'
db cr,lf,' DPROG filename <-- filename.DPG'
db cr,lf,' DPROG filename.typ <-- filename.typ'
db 0
ret
;
; Find File
; If found, return BC=DU and NZ
;
locfile:
lxi d,fcb ;pt to FCB
call z3log
lxi d,fcb+1 ;pt to file name
lxi h,defname ;pt to default file name
mvi b,8 ;8 chars
ldax d ;any type?
cpi ' ' ;none if space
cz moveb
lxi d,fcb+9 ;pt to file type
lxi h,deftype ;pt to default file type
mvi b,3 ;3 chars
ldax d ;any type?
cpi ' ' ;none if space
cz moveb
lxi d,fcb ;pt to FCB
mvi a,0ffh ;search current
call pfind ;search for file
rnz ;get file if found
;
; Abort Attempt to Load File
;
abort:
pop psw ;clear stack
call eprint
db cr,lf,' File ',0
lxi d,fcb+1 ;pt to file name
call pfn1
call eprint
db ' NOT Found',0
ret
;
; Load File
;
load:
lxi d,fcb ;pt to fcb
call f$open ;open file for input
jnz abort ;abort attempt
lhld free ;buffer area
load1:
lxi d,fcb ;pt to fcb
call f$read ;read next block
jnz load2 ;done, so mark and close
lxi d,tbuff ;copy into buffer
xchg ;copy into buffer at DE from TBUFF at HL
mvi b,128 ;128 bytes
call moveb
lxi h,80h ;pt to next buffer
dad d
jmp load1
load2:
mvi m,ctrlz ;mark EOF
inr h ;next page
mvi l,0
shld words ;mark beginning of word definition area
shld nxtword ;mark next word
mvi m,0 ;mark no words
jmp f$close ;close input file
;
; Program the User's Terminal
;
program:
lhld free ;pt to first char
prog1:
call capa ;capitalize
cpi ctrlz ;done?
rz
cpi CR ;eol?
jz skipl
cpi WORD ;word definition?
jz defword
cpi SYM ;symbol table or format definition dump?
jz dump
cpi DEV ;assign device?
jz device
cpi INP ;input form?
jz input
push h ;save HL
prog2:
call output ;output line at HL
call locpop ;pop stack if any
jnz prog2 ;continue if any element on stack
pop h ;restore HL
;
; Skip to next line
;
skipl:
mov a,m ;get char
call capa ;capitalize
cpi CR ;new line?
jz skipl1
cpi LF ;new line?
jz skipl1
cpi CTRLZ ;EOF?
rz
inx h ;pt to next
jmp skipl
skipl1:
mov a,m ;get it
inx h ;pt to next
ani 7fh ;mask
cpi CR ;continue?
jz skipl1
cpi LF ;continue?
jz skipl1
dcx h ;pt to non-eol char
jmp prog1 ;continue with next line
;
; Input Form
;
input:
inx h ;pt to next char
call cin ;get any char
ani 7fh ;mask
cpi ctrlc ;abort?
jz opsys
jmp skipl ;continue
;
; Assign Device
;
device:
inx h ;pt to char
call capa ;capitalize
cpi 'C' ;console?
jz setdev
cpi 'L' ;list?
jz setdev
cpi 'P' ;punch?
jz setdev
push psw
call eprint
db cr,lf,bel,' Invalid Device Assignment: ',0
pop psw
call cout ;print char
dcx h ;back up
jmp skipl ;continue
;
; Perform assignment
;
setdev:
sta outdev ;assign
jmp skipl ;continue
;
; Define Word
;
defword:
inx h ;pt to first char of word
call bufword ;store word in buffer
shld nextch ;save ptr to next char
call wscan ;scan for word
jz defnew ;new word defined
xchg ;ptr to high-order in DE
lhld nextch ;get ptr to word definition
xchg ;word defn in DE, word adr high in HL
mov m,d ;store new address
dcx h
mov m,e
xchg ;HL pts to word
jmp skipl ;skip out line
;
; New Word
;
defnew:
lhld nxtword ;pt to next word
xchg
lxi h,wordbf ;pt to buffer
mvi b,wordl ;number of chars max
call hmovb ;copy into buffer and advance HL
lhld nextch ;get address
xchg
mov m,e ;put low
inx h
mov m,d ;put high
inx h ;set ptr to next word
mvi m,0 ;store zero
shld nxtword ;set ptr
xchg ;HL pts to word definition
jmp skipl ;skip to next line
;
; Dump Format String or Word Table
;
dump:
inx h ;pt to option
call capa ;check for format display option
cpi 'F' ;format?
jz dfmt ;dump format if so
cpi 'S' ;symbols?
jz dsym
dcx h ;pt to current
call dumpsym ;dump symbols
call dumpfmt ;dump format
jmp skipl ;continue
;
; Dump Format
;
dfmt:
call dumpfmt ;do dump
jmp skipl ;continue
;
; Dump Words
;
dsym:
call dumpsym ;do dump
jmp skipl ;continue
;
; Dump Words in Symbol Table
;
dumpsym:
push h ;save HL
call eprint
db cr,lf,' >> Word Definitions <<',0
lhld words ;dump word table
sym1:
mov a,m ;get next
ora a
jz symexit
call eprint
db cr,lf,' ',0
call prword ;print word
mov e,m ;get low
inx h
mov d,m ;get high
inx h ;pt to next word
push h ;save ptr
call eprint
db ' >',0
xchg ;HL pts to word
sym2:
mov a,m ;get next char
cpi CR ;done?
jz sym3
cpi TAB ;translate tab to space
jnz sym2out
mvi a,' ' ;space instead of tab
sym2out:
call chout
inx h
jmp sym2
sym3:
call eprint
db '<',0
pop h ;pt to next word
jmp sym1
symexit:
pop h ;pt to char
ret
;
; Output Format String
;
dumpfmt:
push h ;save ptr
call eprint
db cr,lf,' Format: (',0
lhld format ;pt to string
call epstr ;print it
call eprint
db ')',cr,lf,0
pop h ;get ptr
ret
;
; Print Word at HL (advance HL)
;
prword:
mvi b,wordl ;number of chars
prw1:
mov a,m ;get char
call chout
inx h
dcr b
jnz prw1
ret
;
; Routine to Output a Line
;
output:
call sksp ;skip spaces
cpi COMMENT ;done?
rz
cpi CR ;done?
rz
cpi LF ;done?
rz
cpi CTRLZ ;done?
rz
cpi fmt ;format definition?
jz outfmt
cpi quote ;chars?
jz outch
call bufword ;store word in buffer
shld nextch ;save ptr to next char after word
call wscan ;scan for word in table
jz badword ;word not defined
call locpush ;push location onto stack
xchg ;HL pts to continuation location
jmp output ;continue
;
; Output Quoted String
;
outch:
inx h ;pt to next char
outch1:
mov a,m ;get it
ani 7fh ;mask
cpi CR ;done?
jz outcherr
cpi LF ;done?
jz outcherr
cpi CTRLZ ;done?
jz outcherr
cpi quote ;end of quote?
jz outch2
call charout ;output char in whatever form
jmp outch1 ;continue
outcherr:
call eprint
db cr,lf,bel,' Premature End of Quote',cr,lf,0
jmp output
outch2:
inx h ;pt to after quote
jmp output ;continue
;
; Output char in A and set HL to next char on exit
;
charout:
cpi control ;control char follows?
jz charo0
cpi literal ;literal follows?
jz charo1
;
; Normal Char in A
;
charnxt:
inx h ;pt to next char
jmp formatout ;output with format
;
; Output control char
;
charo0:
inx h ;pt to char
call capa ;get char
sui '@' ;convert to control
jc ctrlerr
cpi 20h
jnc ctrlerr
inx h ;pt to next
jmp formatout
ctrlerr:
call eprint
db cr,lf,bel,' Invalid Control Character',cr,lf,0
ret
;
; Output Literal Format
;
charo1:
inx h ;pt to char
call capa ;get char
cpi 'B' ;BS?
jz c1bs
cpi 'D' ;DEL?
jz c1del
cpi 'E' ;ESCAPE?
jz c1esc
cpi 'L' ;CRLF?
jz c1nl
cpi 'N' ;LF?
jz c1lf
cpi 'R' ;CR?
jz c1cr
cpi 'T' ;TAB?
jz c1tab
cpi '0' ;digit?
jc charol ;literal if not
cpi '9'+1 ;range?
jc numout
cpi ' ' ;less than space?
jnc charol
call eprint
db cr,lf,bel,' Invalid Literal Argument',cr,lf,0
ret
;
; Output Char in A literally
;
charol:
mov a,m ;get char
ani 7fh ;don't cap this way
inx h ;pt to next
jmp formatout
;
; Output Number
;
numout:
call eval ;convert to binary in DE
mov a,e ;char binary value
jmp formatout ;output with format
;
; Output BS
;
c1bs:
mvi a,bs
jmp charnxt
;
; Output TAB
;
c1tab:
mvi a,tab
jmp charnxt
;
; Output CR
;
c1cr:
mvi a,cr
jmp charnxt
;
; Output DEL
;
c1del:
mvi a,7fh
jmp charnxt
;
; Output ESCAPE
;
c1esc:
mvi a,1bh
jmp charnxt
;
; Output LF
;
c1lf:
mvi a,lf
jmp charnxt
;
; Output CRLF
;
c1nl:
mvi a,cr
call formatout ;output CR
mvi a,lf
jmp charnxt
;
; Output Char in A According to Format
;
formatout:
push h ;save ptr to next char
push b ;save BC
mov b,a ;char in B
lhld format ;pt to format string
fout1:
mov a,m ;get next char
ani 7fh ;mask
jz foutx ;exit if end of string
cpi fmtch ;expression form?
jz fout2
cpi literal ;literal?
jz flit
;
; Output char in A and advance
;
fch:
call chout ;output char
inx h ;pt to next
jmp fout1
;
; Output Value in B according to format
;
fout2:
inx h ;pt to format type
mov a,m ;get char
inx h ;pt to next
ani 7fh ;mask
call caps
ora a ;none?
jz fout1 ;error condition - % at end of string
cpi 'C' ;char?
jz foch
cpi 'D' ;floating decimal chars
jz fod
cpi '2' ;2 decimal chars
jz fo2
cpi '3' ;3 decimal chars
jz fo3
cpi 'X' ;2 hex chars
jz fox
push psw
call eprint
db cr,lf,bel,' Invalid Format Char: ',0
pop psw
call cout
call crlf
jmp fout1 ;continue
;
; Output value in B as char
;
foch:
mov a,b ;get value
call chout ;output it
jmp fout1 ;continue
;
; Output value in B as floating decimal
;
fod:
mov a,b ;get value
call pafdc ;output
jmp fout1 ;continue
;
; Output value in B as hex
;
fox:
mov a,b ;get value
call pa2hc ;output
jmp fout1 ;continue
;
; Output value in B as 3 decimal chars
;
fo3:
mvi c,100 ;100's
call dec ;output and fall thru to FO2
;
; Output value in B as 2 decimal chars
;
fo2:
mvi c,10 ;10's
call dec
mov a,b ;get value
adi '0' ;convert
call chout
jmp fout1 ;continue
;
; Subtracting Output
; Output value in B as 100's or 10's digit (leading 0 allowed)
;
dec:
push d ;save DE
mov a,b ;get value
mvi d,'0' ;set digit
dec1:
sub c ;subtract
jc dec2
inr d ;increment digit
jmp dec1
dec2:
add c ;add back in
mov b,a
mov a,d ;output digit
call chout
pop d ;restore DE
ret
;
; Exit Format String Output
;
foutx:
pop b ;restore BC
pop h ;restore ptr to next char
ret
;
; Literal Format Output
;
flit:
inx h ;pt to char
call capa ;get char
cpi 'B' ;BS?
jz f1bs
cpi 'D' ;DEL?
jz f1del
cpi 'E' ;ESCAPE?
jz f1esc
cpi 'L' ;CRLF?
jz f1nl
cpi 'N' ;LF?
jz f1lf
cpi 'R' ;CR?
jz f1cr
cpi 'T' ;TAB?
jz f1tab
cpi '0' ;digit?
jc fchck ;literal if not
cpi '9'+1 ;range?
jnc fchck
;
; Output Number
;
call eval ;convert to binary in DE
mov a,e ;char binary value
jmp fch ;output
;
; Check for Valid Literal
;
fchck:
cpi ' ' ;not valid if less than space
jnc fch
call eprint
db cr,lf,bel,' Invalid Literal Argument',cr,lf,0
jmp fout1
;
; Output BS
;
f1bs:
mvi a,bs
jmp fch
;
; Output TAB
;
f1tab:
mvi a,tab
jmp fch
;
; Output CR
;
f1cr:
mvi a,cr
jmp fch
;
; Output DEL
;
f1del:
mvi a,7fh
jmp fch
;
; Output ESCAPE
;
f1esc:
mvi a,1bh
jmp fch
;
; Output LF
;
f1lf:
mvi a,lf
jmp fch
;
; Output CRLF
;
f1nl:
mvi a,cr
call chout ;output CR
mvi a,lf
jmp fch
;
; Define New Output Format
;
outfmt:
inx h ;pt to format char
xchg
lhld format ;pt to format area
xchg
;
; Get next char for format string
;
outf1:
mov a,m ;get next char
ani 7fh ;mask
cpi endfmt ;end of format?
jz outf2
cpi CR ;end of line?
jz outf3
cpi LF ;end of line?
jz outf3
cpi CTRLZ ;end of file?
jz outf3
stax d ;store char
inx h ;pt to next
inx d
cpi literal ;literal denotation?
jnz outf1 ;continue if not
;
; Literal flag, so store next char exactly as-is without interpretation
;
mov a,m ;get next char
ani 7fh ;mask
stax d ;store it literally
inx h ;pt to next
inx d
jmp outf1
;
; Format String Stored - Terminate it
;
outf2:
inx h ;pt to next char
outf3:
xra a ;terminate format string
stax d
jmp output
;
; Invalid Word - So State
;
badword:
call eprint
db cr,lf,bel,' Invalid Word Reference: ',0
lxi h,wordbf ;pt to buffer
call prword ;print word
lhld nextch ;continue
jmp output
;
; Element must be a word - resolve it
;
bufword:
lxi d,wordbf ;buffer to store word in
mvi b,wordl ;length
;
; Build Word into WORDBF
;
bword1:
call capa ;get char
cpi ' '+1 ;end?
jc bword3
stax d ;store char
inx h ;pt to next
inx d
dcr b ;count down
jnz bword1
;
; Word is longer than WORDL - skip trailing chars
;
bword2:
mov a,m ;skip chars to delimiter
ani 7fh ;mask
cpi ' '+1
jc bword4
inx h ;pt to next
jmp bword2
;
; Word is built into WORDBF - space fill it
;
bword3:
mvi a,' ' ;space
stax d ;store char
inx d ;pt to next
dcr b ;count down
jnz bword3
;
; Word is Stored
; HL pts to next char after the Word
;
bword4:
ret
;
; Scan for Word in Table
; Return with Zero Set if Not Resolved
; If Resolved, DE=address of word
;
wscan:
lhld words ;pt to first word in table
wscan1:
mov a,m ;abort if empty table
ora a
rz
lxi d,wordbf ;pt to buffer
mvi b,wordl ;size of buffer
push h ;save HL
wscan2:
ldax d ;get char
cmp m ;compare
jnz wscan3
inx h ;pt to next
inx d
dcr b ;count down
jnz wscan2
mov e,m ;get address in DE
inx h
mov d,m
pop psw ;clear stack
xra a ;return NZ
dcr a
ret
wscan3:
pop h ;get address of current word in table
lxi d,wordl+2 ;advance to next word
dad d
jmp wscan1
;
; Push Address in NEXTCH onto Location Stack
;
locpush:
push h ;save regs
push d
lhld nextch ;get address
xchg ;... in DE
lhld tos ;get top of stack
mov m,e ;store address
inx h
mov m,d
inx h
shld tos ;new top of stack
pop d ;restore regs
pop h
ret
;
; Pop Address from Top of Stack
;
locpop:
lhld locstk ;local stack
xchg
lhld tos ;check to see if nothing on stack
mov a,e ;if lows are same, nothing on stack
cmp l
rz
dcx h ;pt to top element
mov d,m ;get high
dcx h
mov e,m ;get low
shld tos ;new top of stack
xchg ;address in HL
xra a ;return with NZ
dcr a
ret
;
; Skip to Non-Space
;
sksp:
mov a,m ;get char
ani 7fh ;mask
call issp ;test for space
rnz ;not space, so return
inx h ;pt to next
jmp sksp
;
; Test char in A for space char
; Ret with Z if yes
;
issp:
push h ;save HL
push b ;save BC
lxi h,sptab ;pt to table
mov b,a ;char in B
issp1:
mov a,m ;get next char
ora a ;end of table?
jz issp3
cmp b ;match?
jz issp2
inx h ;pt to next
jmp issp1
issp2:
mov a,b ;restore char
pop b ;restore regs
pop h
ret ;Z flag is set
issp3:
xra a ;set NZ
dcr a
jmp issp2
;
; Output New Line
;
crlf:
push psw ;save A
mvi a,cr ;CR
call chout
mvi a,lf ;LF
call chout
pop psw ;get A
ret
;
; Output Char in A with XON/XOFF Flow Control
;
chout:
push psw ;save char
call condin ;conditional input
jz chout1
cpi ctrls ;pause?
jnz chout1
call cin ;wait for following char
chout1:
pop psw ;get char
push b ;save BC
mov c,a ;char in C
lda outdev ;get output device
cpi 'C' ;console?
jz chcon
cpi 'L' ;printer?
jz chlst
cpi 'P' ;punch?
jz chpun
;
; Output to Console
;
chcon:
mov a,c ;get char
call cout
pop b
ret
;
; Output to List
;
chlst:
mov a,c ;get char
call lout
pop b
ret
;
; Output to Punch
;
chpun:
mov a,c ;get char
call pout
pop b
ret
;
; Print String Pted to by HL
;
epstr:
mov a,m ;get char
inx h ;pt to next
ani 7fh ;mask MSB
rz ;done
call chout ;print char
jmp epstr
;
; Print String at Return Address
;
eprint:
xthl ;save HL and pt to string
call epstr ;print string
xthl ;restore HL and new exec adr
ret
;
; Input Char, Mask, and Capitalize
;
capa:
mov a,m ;get char
ani 7fh ;mask
jmp caps ;capitalize
;
; Space Table
;
sptab:
db ' ',tab,bs,ff,',','.',0 ;space chars
;
; Data Area
;
defname:
db 'STD ' ;default file name
deftype:
db 'DPG' ;default file type
deffmt:
db '%C',0 ;default format string
outdev:
ds 1 ;output device (C=console, L=list, P=punch)
outdev1:
ds 1 ;save area for output device
wordbf:
ds wordl ;current word buffer
format:
ds 2 ;address of format string
free:
ds 2 ;address of free area
words:
ds 2 ;address of scratch area
nxtword:
ds 2 ;pointer to next word
nextch:
ds 2 ;pointer to next char
locstk:
ds 2 ;pointer to location stack
tos:
ds 2 ;pointer to top of stack
end