; INIT4TH Version 1.0 as of December 13, 1981

;
; INIT4TH Version 1.0 as of December 13, 1981
;
; By: Kelly Smith, CP/M-Net
;
; The purpose of INIT4TH, came about from the flagrant
; destruction of Fig-Forth screens that were co-resident on
; my CP/M diskettes...I would forget that the screens DO NOT
; appear in the CP/M directory, and as such are prone to
; eminent destruction (due totally to my stupidity) by the
; CP/M "PIP" command. What to do? Well, I also got tired of
; clearing out screens that were full of "e5's" from
; formatting, and decided to kill two birds with one
; stone...
;
; INIT4TH will allow retention of all relevant CP/M
; files (such as FORTH itself) on a CP/M and FORTH diskette,
; initialize all sectors NOT occupied by the resident CP/M
; files, and RESERVE all remaining sectors as available disk
; area for FORTH screens. How is it done? Well, INIT4TH
; creats one "super file" called RESERVED.4TH that is
; nothing but blanks (actually ASCII "space" code) that
; aquires all CP/M groups remaining after the resident CP/M
; files...once your quasi CP/M-FORTH diskette is
; initialized, it's FULL as far as CP/M is concerned for
; further PIPing, and ready for whatever you want to place
; into the available Fig-Forth screen area (my version
; starts with a blank screen number 17, up to 249). It's
; best, if you PIP all the CP/M files to a blank formatted
; diskette first to make them contiguous on the diskette (no
; "holes"), and then run INIT4TH on it to "take-up-the-
; slack".
;
; But WARNING...do not run this on a diskette that
; already has screens that you want to preserve...this is
; ONLY for diskette INITIALIZATION of FORTH screens...copy
; from another diskette as you normally do to place your
; "treasured" screens on it.
;
; A conditional assembly equate "SYS" is used to make
; RESERVED.4TH invisible in the directory (if you want it
; that way).
;
; I hope this is of some use to you, and if you make
; any changes, I would appreciate it, if you modem the
; program to CP/M-Net (805) 527-9321 as INIT4TH.NEW...
;
; P.S. I have learned many new WORDs using FORTH, but
; none are repeatable here...
;
; Best regards: Kelly Smith CP/M-Net
;
;
;
; define TRUE/FALSE assembly parameters
;
true equ -1 ; define TRUE
false equ not true; define FALSE
sys equ true ; define SYS (make RESERVED.4TH a $SYS file)
;
;
; BDOS entry point and function codes
;
base equ 0 ; base address of "standard" CP/M system
bdos equ base+5 ; CP/M BDOS entry address
msgfc equ 9 ; message function
resdsk equ 13 ; reset disk system
offc equ 15 ; open file
cffc equ 16 ; close file
wrfc equ 21 ; write record
mffc equ 22 ; make file
sdma equ 26 ; set dma address
;
; secondary FCB field definitions
;
fn equ 1 ; file name field (rel)
ft equ 9 ; file type field (rel)
ex equ 12 ; file extent field (rel)
frc equ 15 ; file record count (rel)
nr equ 32 ; next record field (rel)
;
; ASCII control characters
;
cr equ 0dh ; carriage return
lf equ 0ah ; line feed
bel equ 07h ; bell signal
;
;
org base+100h
;
lxi h,0 ; save old stack pointer
dad sp
shld oldstk
lxi sp,stack; make a new stack pointer
lxi d,initmsg ; Forth Screen initialization in progress
mvi c,msgfc
call bdos
call reset ; reset disk in case it's R/O
init4th:call open ; attempt to open RESERVED.4TH
inr a ; check CP/M return code
jnz makeok ; RESERVED.4TH already exist?
call make ; make new file
inr a ; check CP/M return code
jnz makeok
lxi d,dirful; oops...disk directory is full
exit: mvi c,msgfc
call bdos
lhld oldstk ; get old CP/M stack pointer
sphl
ret
;
; RESERVED.4TH exists, so set the FCB entry for next append to file
;
makeok:
;
lxi d,active; indicate disk activity with "."
mvi c,msgfc
call bdos
call setdma ; set dma for record to write
call write ; write it out...
push psw ; save possible error code
lda fcb+frc ; get record count
sta fcb+nr ; make next record
pop psw ; get possible error code
ora a ; disk full yet, all available records?
jz makeok ; do more records, if not
call close ; close-up shop, and go home
lxi d,dskful; Forth Screens are now initialized...
jmp exit ; exit to CP/M
;
; reset - reset disk
;
reset:
push h
push d
push b
mvi c,resdsk
call bdos
pop b
pop d
pop h
ret
;
; open - open disk file
;
open:
push h
push d
push b
lxi d,fcb
mvi c,offc
call bdos
pop b
pop d
pop h
ret
;
; setdma - set dma for record
;
setdma:
push h
push d
push b
lxi d,dbuf
mvi c,sdma
call bdos
pop b
pop d
pop h
ret
;
; write - write record
;
write:
push h
push d
push b
lxi d,fcb
mvi c,wrfc
call bdos
pop b
pop d
pop h
ret
;
; close - close disk file
;
close:
push h
push d
push b
lxi d,fcb
mvi c,cffc
call bdos
pop b
pop d
pop h
ret
;
; make - make new disk file
;
make:
push h
push d
push b
lxi d,fcb
mvi c,mffc
call bdos
pop b
pop d
pop h
ret
;

initmsg:db cr,lf,'Forth Screen initialization in progress',cr,lf,'$'
;
active: db '.$'
;
dirful: db cr,lf,'Oops, this diskette is already full!$'
;
dskful: db cr,lf,lf,'Forth Screen initialization completed'

if SYS
db ' as (RESERVED.4TH)$'
endif ; SYS

if not SYS
db ' as RESERVED.4TH$'
endif ; SYS

;
fcb: db 2 ; initialize diskette in B: drive

if SYS
db 'RESERVED4','T'+80H,'H'
endif ; SYS

if not SYS
db 'RESERVED4TH'
endif ; SYS

db 0,0,0,0,0,0,0,0,0,0
;
; data area
;
ds 128 ; 64 level stack
stack equ $ ;local stack
;
oldstk
ds 2 ; storage for old CP/M stack pointer
;
dbuf: db ' ' ; use blanks for initialization data
db ' '
db ' '
db ' '
db ' '
db ' '
db ' '
db ' '
;
end