mirror of https://github.com/wwarthen/RomWBW.git
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
460 lines
9.1 KiB
460 lines
9.1 KiB
SUBTTL Global Equates,Temps,Defs
|
|
TITLE FCHAIN - Fortran CALL FCHAIN Statement
|
|
|
|
ENTRY FCHAIN
|
|
EXTRN $CLSFL,$INIT,$IOERR
|
|
|
|
CPM SET 0 ; True for CP/M
|
|
CPM42 SET 1 ; True for CP/M's at X'4200'
|
|
ISIS SET 0 ; True for ISIS-II
|
|
MOD1 SET 0 ; True for TRS-80 Mod-1
|
|
MOD2 SET 0 ; True for TRS-80 Mod-2
|
|
TEK SET 0 ; True for Tektronics
|
|
|
|
CR SET 13
|
|
LF SET 10
|
|
|
|
NAMLEN SET 11 ; Default Filename Length **3.36
|
|
|
|
IF MOD1
|
|
NAMLEN SET 23
|
|
ENDIF
|
|
IF MOD2
|
|
NAMLEN SET 30
|
|
ENDIF
|
|
|
|
|
|
IF CPM42
|
|
CPM SET 1
|
|
ENDIF
|
|
IF CPM
|
|
CPMWRM SET 0 ; CP/M Base ( & Warm Boot Addr)
|
|
ENDIF
|
|
IF CPM42
|
|
CPMWRM SET 4200H
|
|
ENDIF
|
|
; ----
|
|
IF CPM
|
|
C.EMSG SET 9
|
|
C.OPEN SET 15
|
|
C.READ SET 20
|
|
C.BUFF SET 26
|
|
CPMENT SET CPMWRM+5 ; CP/M Entry (BDOS Funct call addr)
|
|
TFCB SET CPMWRM+5CH
|
|
TBUFF SET CPMWRM+80H
|
|
TPA SET CPMWRM+100H
|
|
|
|
;**3.36 DFTEXT: DB 'COM'
|
|
|
|
ENDIF
|
|
; ================
|
|
IF ISIS
|
|
CISIS SET 40H ;ISIS Entry Point
|
|
I.LOAD SET 6 ;Load Pgrm Function
|
|
ENDIF
|
|
; ================
|
|
IF MOD1
|
|
M.ABRT SET 4430H ;Error return to system
|
|
M.GET SET 13H ;Input a byte from an I/O device
|
|
M.OPEN SET 4424H ;Open an existing file
|
|
M.EXIT SET 402DH ;Normal return to system
|
|
ENDIF
|
|
; ================
|
|
IF TEK
|
|
SRB SET 3
|
|
T.CHAN SET SRB+1 ; Channel No.
|
|
T.LEN SET SRB+5 ; Filename Len
|
|
T.BPTR SET SRB+6 ; Address of Buffer
|
|
T.FNAM SET SRB+8 ; Filename Buffer
|
|
ENDIF
|
|
; ================
|
|
IF2
|
|
.PRINTX/Fortran CHAIN/
|
|
IF CPM
|
|
.PRINTX/ For CPM/
|
|
ENDIF
|
|
IF CPM42
|
|
.PRINTX/ ..at 4200H/
|
|
ENDIF
|
|
IF ISIS
|
|
.PRINTX/ For ISIS-II/
|
|
ENDIF
|
|
IF MOD1
|
|
.PRINTX/ For TRS80 Mod-1/
|
|
ENDIF
|
|
IF MOD2
|
|
.PRINTX/ For TRS80 Mod-2/
|
|
ENDIF
|
|
IF TEK
|
|
.PRINTX/ For Tektronics/
|
|
ENDIF
|
|
ENDIF
|
|
|
|
PAGE
|
|
SUBTTL FCHAIN - Process a CALL FCHAIN statement
|
|
|
|
; FCHAIN processes a CALL FCHAIN statement by the following steps:
|
|
;
|
|
; 1. Parse filename to see if valid
|
|
;
|
|
; 2. Open file in default OS File Control Block
|
|
;
|
|
; 3. Move a short program loader to top of memory
|
|
; and load new program
|
|
;
|
|
; SYNTAX: CALL FCHAIN ('<OS dependent filename> ')
|
|
|
|
; ENTRY [HL] = FWA SDESC for Filename
|
|
; EXIT Start executing new program
|
|
; USES ALL
|
|
|
|
FCHAIN:
|
|
IF CPM
|
|
LDAX D ;Get Drive no.
|
|
STA TFCB ;Put in TFCB
|
|
ENDIF
|
|
SHLD .NFWA ; Save FWA of Name
|
|
LXI H,CHN01
|
|
PUSH H
|
|
LHLD $CLSFL
|
|
PCHL ; Close all Files
|
|
CHN01:
|
|
LXI B,CHN02 ; Addr to RET to..
|
|
JMP $INIT ; Reset SP to top of ram
|
|
CHN02:
|
|
IF CPM
|
|
CALL .SNAM ; Go scan filename
|
|
LXI D,TBUFF ;Set DMA buffer
|
|
MVI C,C.BUFF
|
|
CALL CPMENT
|
|
LXI D,TFCB ;Open file
|
|
MVI C,C.OPEN
|
|
CALL CPMENT
|
|
INR A
|
|
JZ $IOERR ; **IO** Error - File not found
|
|
LXI H,0
|
|
DAD SP
|
|
DCR H
|
|
MVI L,0 ;Get 1 page below user stack
|
|
LXI D,LOADER ;Move program loader to high memory
|
|
MVI B,ENDIPL-IPL
|
|
CALL $$MOV
|
|
MOV L,B ;[HL] = addr of loader
|
|
PUSH H ;For 'RET' to loader
|
|
LXI D,LOCTAB ;[DE] = addr of ADDRESS MODIFY TABLE
|
|
CHN03: LDAX D ;Get low byte address
|
|
ORA A ;Are we done?
|
|
JZ CHN04 ; Yes
|
|
MOV L,A ;[HL] = address to modify
|
|
MOV M,H ;Modify it with [H]
|
|
INX D
|
|
JMP CHN03 ;Keep looping
|
|
CHN04: LXI H,TPA ;[HL] = TPA address
|
|
RET ;'RET' to loader
|
|
ENDIF
|
|
; ================
|
|
IF ISIS
|
|
LHLD .NFWA
|
|
XCHG ;[DE] = Strt of Name
|
|
LXI H,I.FNAM
|
|
MVI B,15
|
|
CALL $$MOV ;Move Filename to FCB
|
|
MVI C,I.LOAD ;Load Function
|
|
LXI D,I.FCB
|
|
CALL CISIS ;Load next Pgm & Go
|
|
JMP $IOERR ; (Just in case)
|
|
ENDIF
|
|
; ================
|
|
IF MOD1
|
|
LXI H,0 ;Get stack address
|
|
DAD SP
|
|
MVI L,0 ;Get below user stack
|
|
DCR H
|
|
DCR H ;Blocking buffer address
|
|
DCR H ;Loader start address
|
|
PUSH H ;Save loader start address
|
|
MVI B,32 ;Blank fill 32 byte DCB
|
|
SPLOOP: DCX H
|
|
MVI M,' '
|
|
DCR B
|
|
JNZ SPLOOP
|
|
POP B ;Loader start address
|
|
PUSH H ;Save DCB addr
|
|
LHLD .NFWA
|
|
XCHG ;[DE] = Strt of Filename
|
|
POP H
|
|
PUSH H ;[HL] = DCB addr
|
|
PUSH B ;Save loader start address
|
|
CALL .SNAM ;Scan Filename into DCB
|
|
MVI B,0 ;LRL = 256
|
|
POP H ;Loader start address
|
|
POP D ;DCB (Filespec) address
|
|
PUSH D ;Save DCB address
|
|
PUSH H ;Save loader start address
|
|
INR H ;Blocking buffer address
|
|
CALL M.OPEN ;Open an existing file
|
|
JNZ $IOERR ;**IO** Err - Fnf.
|
|
|
|
DCR H ;Top loader start address
|
|
LXI D,LOADER ;Loader start address
|
|
MVI B,ENDIPL-IPL ;Size of loader program
|
|
CALL $$MOV ;Move to top of memory
|
|
|
|
POP H ;Loader start address
|
|
POP D ;DCB address
|
|
PCHL ;Run loader
|
|
ENDIF
|
|
; ================
|
|
IF MOD2
|
|
LHLD .NFWA ;[HL] points to name
|
|
PUSH H ;Save SOS
|
|
LXI B,NAMLEN ;[B]=0, [C]=Max Name Len
|
|
CHN03:
|
|
MOV A,M
|
|
CPI ' '+1
|
|
JC CHN04 ;Brif EOS
|
|
INX H
|
|
INR B ;String Len+1
|
|
DCR C ;Max len-1
|
|
JNZ CHN03
|
|
JMP $IOERR ;**IO** Error, Name too long
|
|
CHN04:
|
|
MVI M,CR ;Proper TRSDOS Terminator
|
|
POP H ;Get SOS
|
|
MVI A,37 ;Exeq TRSDOS cmnd, no ret
|
|
RST 1 ;Do it, [HL]=string, [B]=string len
|
|
JMP $IOERR ; (Who trusts Trash-DOS)
|
|
ENDIF
|
|
; ================
|
|
IF TEK
|
|
LHLD .NFWA
|
|
XCHG ; [DE]=Filename STR
|
|
LXI H,T.FNAM ; [HL]=Filename Buffer
|
|
LXI B,NAMLEN ; [B]=0, [C]=Max Name Len
|
|
CHN03:
|
|
LDAX D
|
|
CPI ' '+1
|
|
JC CHN04 ; Brif End-of-Name
|
|
MOV M,A
|
|
INX D
|
|
INX H
|
|
INR B ; Len+1
|
|
DCR C ; Max-1
|
|
JZ $IOERR ; **IO** Error if name too long..
|
|
JMP CHN03
|
|
CHN04:
|
|
MVI M,CR ; Store Terminator
|
|
MOV A,B
|
|
INR A ; Include CR in Len Cnt
|
|
STA T.LEN ; Store Filename Len in SRB
|
|
MVI A,18H ; Load Overlay & Execute
|
|
STA SRB
|
|
MVI A,4
|
|
STA T.CHAN ; Store Chan 4 (Doc is unclear)
|
|
LXI D,T.FNAM
|
|
LXI H,T.BPTR
|
|
MOV M,D
|
|
INX H ; Store Fname Pntr in SRB
|
|
MOV M,E
|
|
MVI A,0FFH
|
|
OUT 0F7H ; Load Overlay & Execute
|
|
JMP $IOERR ; Should never happen
|
|
ENDIF
|
|
; ================
|
|
|
|
PAGE
|
|
SUBTTL Scan for valid Filename
|
|
|
|
.SNAM:
|
|
IF CPM
|
|
LHLD .NFWA ; FWA of Filename
|
|
XCHG ; [DE] = name FWA
|
|
LXI H,TFCB+1 ; [HL] = FILE CTRL BLOCK
|
|
MVI B,NAMLEN
|
|
.COMMENT & **3.36
|
|
.SNAM1:
|
|
LDAX D ; GET NAME CHAR
|
|
INX D
|
|
STA .NFWA ; Set '.' if user supplied Ext.
|
|
CPI '.'
|
|
JZ .SNAM3 ; Brif saw Ext
|
|
CPI ' '+1
|
|
JC .SNAM3 ; Brif End-of-Name
|
|
MOV M,A ; PUT IN FCB
|
|
INX H
|
|
DCR B ; UNTIL STRING EXHAUSTED
|
|
JNZ .SNAM1
|
|
.SNAM2:
|
|
LDAX D
|
|
INX D
|
|
STA .NFWA
|
|
CPI '.' ; Looking for Ext..
|
|
JZ .SNAM4
|
|
CPI ' '+1 ; or end of name
|
|
JNC .SNAM2
|
|
JMP .SNAM4 ; Go copy user or default ext
|
|
.SNAM3:
|
|
MVI M,' '
|
|
INX H
|
|
DCR B
|
|
JNZ .SNAM3
|
|
.SNAM4:
|
|
MVI B,3 ; Scan Extention
|
|
LDA .NFWA
|
|
CPI '.'
|
|
JZ .SNAM5 ; Brif user supplied ext
|
|
LXI D,DFTEXT ; ..Else use default
|
|
**3.36 &
|
|
.SNAM5:
|
|
LDAX D
|
|
INX D
|
|
MOV M,A
|
|
INX H
|
|
DCR B
|
|
JNZ .SNAM5
|
|
; ----------------
|
|
MOV M,B ; Clear File EX
|
|
MOV A,B
|
|
STA TFCB+32 ; NR = 0
|
|
RET
|
|
ENDIF
|
|
; ================
|
|
IF MOD1
|
|
MVI B,NAMLEN
|
|
.SNAM0:
|
|
LDAX D
|
|
CPI ' '+1
|
|
JC .SNAM1 ;Brif EOS
|
|
MOV M,A
|
|
INX D
|
|
INX H
|
|
DCR B
|
|
JNZ .SNAM0
|
|
JMP $IOERR ;**IO** Error if name too long
|
|
.SNAM1:
|
|
MVI M,CR ;Terminate with CR
|
|
RET
|
|
ENDIF
|
|
|
|
PAGE
|
|
SUBTTL Relocated loader for CP/M & MOD1
|
|
|
|
IF CPM
|
|
LOCTAB:
|
|
DB (X0+2) AND 0FFH
|
|
DB (X1+1) AND 0FFH
|
|
DB (X2+2) AND 0FFH
|
|
DB (X3+2) AND 0FFH
|
|
DB 0
|
|
|
|
; ================
|
|
LOADER:
|
|
.PHASE 0
|
|
IPL: LXI D,TPA ;Program start address
|
|
PUSH D ;Save as return address
|
|
IPL1: XCHG ;[DE] = Next load address
|
|
PUSH D ;Save load address
|
|
MVI C,C.BUFF ;Set DMA address
|
|
CALL CPMENT
|
|
LXI D,TFCB ;Read record
|
|
MVI C,C.READ
|
|
CALL CPMENT
|
|
POP D ;Restore base address of record
|
|
ORA A
|
|
X0: JNZ IPLDON ;EOF
|
|
LXI H,128 ;[HL] = Record size
|
|
DAD D ;[HL] = Start of next record
|
|
X1: MVI A,IPL/256 ;Get hi byte of IPL address
|
|
CMP H ;Are we there?
|
|
X2: JNZ IPL1 ;No - continue loading program
|
|
X3: LXI D,OVFMSG ;Print '* OUT OF MEMORY*'
|
|
MVI C,C.EMSG
|
|
CALL CPMENT
|
|
JMP CPMWRM ;Reset and die
|
|
IPLDON:
|
|
XRA A
|
|
STA TBUFF ; 0 = No cmnd line passed
|
|
MVI A,' '
|
|
STA TFCB+1 ; Clear TFCB for Utilities
|
|
LXI B,CPMWRM ; Push Warm Boot addr for
|
|
PUSH B ; Utilities that just return...
|
|
JMP TPA ;CLOSE FILE AND START PROG
|
|
OVFMSG:
|
|
DB CR,LF,'* Out of Memory *',CR,LF,'$'
|
|
ENDIPL:
|
|
.DEPHASE
|
|
ENDIF
|
|
; ================
|
|
IF MOD1
|
|
LOADER:
|
|
IPL: CALL M.GET ;Read character
|
|
JNZ M.ABRT ;In case of error
|
|
CPI 2 ;Is it EOF ?
|
|
.Z80
|
|
JR Z,(IPL1) ;Get start address
|
|
.8080
|
|
CPI 1 ;Is it data ?
|
|
JNZ M.ABRT ;Not data then error
|
|
CALL M.GET ;Length + 2
|
|
DCR A
|
|
DCR A
|
|
MOV B,A ;Length
|
|
CALL M.GET ;Load address
|
|
JNZ M.ABRT ;In case of error
|
|
MOV L,A
|
|
CALL M.GET
|
|
JNZ M.ABRT ;In case of error
|
|
MOV H,A
|
|
|
|
IPL0: CALL M.GET ;Get data
|
|
MOV M,A ;Put data in load address
|
|
INX H ;Increment load address
|
|
DCR B ;# of bytes left to load
|
|
.Z80
|
|
JR NZ,(IPL0)
|
|
JR Z,(IPL)
|
|
.8080
|
|
|
|
IPL1: CALL M.GET ;Get second 2 (EOF)
|
|
CPI 2
|
|
JNZ M.ABRT ;In case of error
|
|
CALL M.GET ;Get start address
|
|
JNZ M.ABRT ;In case of error
|
|
MOV L,A
|
|
CALL M.GET
|
|
JNZ M.ABRT ;In case of error
|
|
MOV H,A
|
|
PCHL ;Run program
|
|
ENDIPL:
|
|
|
|
ENDIF
|
|
; ================
|
|
IF CPM OR ISIS OR MOD1
|
|
$$MOV:
|
|
LDAX D
|
|
MOV M,A
|
|
INX D
|
|
INX H
|
|
DCR B
|
|
JNZ $$MOV
|
|
RET
|
|
ENDIF
|
|
|
|
DSEG
|
|
|
|
.NFWA: DS 2 ; Temp for FWA of Filename
|
|
|
|
IF ISIS
|
|
I.FCB: DW I.FNAM ;Pntr to Filename
|
|
DW 0 ;Bias field
|
|
DW 1 ;RETSW, Xfer control to new pgm
|
|
DW I.NTRY ;Pntr to Entry addr store
|
|
DW I.STAT ;Status
|
|
; --
|
|
I.FNAM: DS 15 ;Filename
|
|
I.NTRY: DS 2 ;Entry Point Address
|
|
I.STAT: DS 2 ;Ret Status
|
|
ENDIF
|
|
|
|
END
|
|
|