home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
SIMTEL
/
CPMUG
/
CPMUG052.ARK
/
BATCH.3
< prev
next >
Wrap
Text File
|
1984-04-29
|
9KB
|
341 lines
$This file constitutes the 3rd module of program BATCH.
SHOW ^; $'Start of the installation module
DEF SizeOfModel = AfterModel - Model;
SHOW SizeOfModel;
DEF CPMPerformFunction = #0005;
DEF CPMDefaultFCB = #005C;
DEF CPMDefaultTextBuf = #0080;
DEF SectorSize = #80;
DEF AfterCPMDefaultTextBuf = CPMDefaultTextBuf + SectorSize;
$CP/M system functions
DEF CPMTypeOut = 2;
DEF CPMOpen = 15;
DEF CPMClose = 16;
DEF CPMRead = 20;
MACRO CPMSystemCall;
C <- `P(1);
ASM IF `CHARS =|=`P(2)=|= ~= 0;
DE <- `P(2);
END ASMIF;
CALL CPMPerformFunction;
END MACRO;
MACRO TypeOutMessage;
HL <- ^ + 9;
CALL TypeOutLine;
GO. ^ + `CHARS =|=`P(1)=|= + 2;
BYTE `P(1), TextTerminator;
END MACRO;
MACRO Error,Message<-;
Type Out Message `P(1);
GO. WarmBoot;
END MACRO;
:CRLF BYTE CarriageReturn, LineFeed;
BYTE TextTerminator;
:EndOfFileWasFound BYTE FALSE;
:FileInputCursor WORD AfterCPMDefaultTextBuf;
$Addr. of next char. to input
$from the batch text file,
$initialized to force reading of
$the 1st sector of the file
:RelocationValue WORD NoInitialValue;
:AfterSafeMemory WORD NoInitialValue;
:GO_BATCH_CONST GO. BatchCONST;
:GO_BATCH_CONIN GO. BatchCONIN;
:AFTER_GO_BATCH
:TypeOutString
PROCEDURE;
.HL -> A; ? << A - TextTerminator; IF = EXIT;
HL\/;
A -> E;
CPM System Call CPMTypeOut;
/\HL; HL + 1 -> HL;
REPEAT;
END PROCEDURE;
:TypeOutCRLF
PROCEDURE;
HL <- CRLF; CALL TypeOutString;
END PROCEDURE;
:TypeOutLine
PROCEDURE;
HL\/;
CALL TypeOutCRLF;
/\HL; CALL TypeOutString;
END PROCEDURE;
:OpenBatchTextFile
PROCEDURE;
$Verify the file name
A <- . CPMDefaultFCB + 1; ? << A - " ";
IF = THEN;
Error, Message <- "WHAT FILE?";
END IF;
A <- . CPMDefaultFCB + 9; ? << A - " ";
IF = THEN;
$Use the default file name extension
HL <- "AB"; HL -> . CPMDefaultFCB + 9;
A <- "T"; A -> . CPMDefaultFCB + 11;
END IF;
CPM System Call CPMOpen, CPMDefaultFCB;
A + 1 -> A; $Test the return code
IF 0 THEN;
Error, Message <- "NO FILE";
END IF;
END PROCEDURE;
:CloseBatchTextFile
PROCEDURE;
CPM System Call CPMClose, CPMDefaultFCB;
A + 1 -> A; $Test the return code
IF 0 THEN;
Error, Message <- "ERR CLOSING FILE";
END IF;
END PROCEDURE;
:Read1SectorOfBatchTextFile
PROCEDURE;
CPM System Call CPMRead, CPMDefaultFCB;
A -> . EndOfFileWasFound;
END PROCEDURE;
:Input1CharFromBatchTextFile
PROCEDURE;
HL <- . FileInputCursor;
$Test if past the end of the buffer by comparing addresses
IF;
L -> A; ? << A - >< AfterCPMDefaultTextBuf;
IS = AND;
H -> A; ? << A - <> AfterCPMDefaultTextBuf;
IS = THEN;
CALL Read1SectorOfBatchTextFile;
HL <- CPMDefaultTextBuf;
? << A <- . EndOfFileWasFound;
IF ~0 THEN;
.HL <- Substitute;
END IF;
END IF;
.HL -> A;
HL + 1 -> HL; HL -> . FileInputCursor;
END PROCEDURE;
:RelocateAddressesInTheModel
PROCEDURE;
HL <- Model; DE <- MODEL;
DO;
.DE -> A; A - .HL -> A;
IF ~= THEN;
$Verify that this is the 1st byte of a word that must be
$relocated
A?\/;
? << A - >< (MODEL - Model);
IF ~= THEN;
Error, Message <- "CODE MODELS DO NOT CORRESPOND";
END IF;
HL + 1 -> HL; DE + 1 -> DE;
/\A?;
.DE -> A; A - .HL - CY -> A; ? << A - <> (MODEL - Model);
IF ~= THEN;
HL -> . DiagnosticInfo; HL <-> DE;
HL -> . DiagnosticInfo + 2;
Error, Message <- "1-BYTE RELOC ADDR PROHIBITED";
END IF;
$Perform relocation
DE\/; HL\/;
.HL -> D; HL - 1 -> HL; .HL -> E;
$Original addr. from Model ->
$DE
HL <- . RelocationValue; HL + DE -> HL; HL <-> DE;
$Relocated addr. -> DE
/\HL;
D -> .HL; HL - 1 -> HL; E -> .HL; HL + 1 -> HL;
/\DE;
END IF;
HL + 1 -> HL; DE + 1 -> DE;
$Test if done by comparing addresses
L -> A; ? << A - >< AfterModel; IF ~= REPEAT;
H -> A; ? << A - <> AfterModel; IF ~= REPEAT;
END DO;
END PROCEDURE;
:CopyModelToSafeMemory
PROCEDURE;
HL <- . SafeMemory;
DE <- Model;
DO;
.DE -> A; A -> .HL;
HL + 1 -> HL; DE + 1 -> DE;
$Test if done by comparing addresses
E -> A; ? << A - >< AfterModel; IF ~= REPEAT;
D -> A; ? << A - <> AfterModel; IF ~= REPEAT;
END DO;
END PROCEDURE;
:CopyCharToSafeMemory
PROCEDURE;
A -> D; $Copy the char.
$Verify that there is at least 1 available byte remaining in safe
$memory
IF;
L -> A; A - C >> ?;
IS = AND;
H -> A; A - B >> ?;
IS = THEN;
Error, Message <- "BATCH TEXT TOO LONG";
END IF;
D -> .HL; $Copy the char. into safe
$memory
HL + 1 -> HL;
END PROCEDURE;
:CopyTextToSafeMemory
PROCEDURE;
HL <- . AfterSafeMemory; H -> B; L -> C;
$1st addr. after end of safe
$memory -> BC
HL <- . SafeMemory; DE <- SizeOfModel; HL + DE -> HL;
$Destination addr. of text ->
$HL
DO;
HL\/; BC\/;
CALL Input1CharFromBatchTextFile;
HL <- Escape; A - .HL >> ?;
IF = THEN;
CALL Input1CharFromBatchTextFile;
? << A - "C";
IF = THEN;
$This is the start of a comment to the batch processor
DO;
CALL Input1CharFromBatchTextFile;
HL <- Escape; A - .HL >> ?; IF = EXIT;
? << A - Substitute; IF = EXIT;
A -> E; CPM System Call CPMTypeOut;
REPEAT;
END DO;
ELSE;
$Regenerate and copy the escape char.
A -> H; $Char. following escape
/\BC; HL <-> .SP;
A <- . Escape; CALL CopyCharToSafeMemory;
HL <-> .SP; BC\/;
H -> A; $Char. following escape
END IF;
END IF;
/\BC; /\HL;
? << A - CarriageReturn;
IF = THEN;
CALL CopyCharToSafeMemory;
$Delete any possible following LineFeed
HL\/; BC\/;
CALL Input1CharFromBatchTextFile;
/\BC; /\HL;
? << A - LineFeed; IF = REPEAT;
END IF;
? << A - Substitute;
IF = THEN;
A <- . Escape; CALL CopyCharToSafeMemory;
A <- . TerminationCommandChar;
CALL CopyCharToSafeMemory;
EXIT;
END IF;
CALL CopyCharToSafeMemory;
REPEAT;
END DO;
END PROCEDURE;
:CopyOriginalJMPVectorToModel
PROCEDURE;
HL <- . AdrOf_JMP_WBOOT; HL + 1 -> HL; HL + 1 -> HL;
HL + 1 -> HL; HL -> . AdrOf_JMP_CONST;
DE <- GO_OriginalCONST;
B <- AfterGO_Original - GO_OriginalCONST;
DO;
.HL -> A; A -> . DE;
HL + 1 -> HL; DE + 1 -> DE;
B - 1 -> B; IF ~0 REPEAT;
END DO;
END PROCEDURE;
$Verify that the batch program is not calling itself recursively. The
$detection method is to test whether the original CONST address is the
$same as the address of the batch version of CONST.
:VerifyLackOfRecursion
PROCEDURE;
DE <- BatchCONST; HL <- . RelocationValue; HL + DE -> HL;
HL <-> DE; $Relocated addr. of BatchCONST
$ -> DE
HL <- . GO_OriginalCONST + 1;
IF;
D -> A; A - H >> ?;
IS = AND;
E -> A; A - L >> ?;
IS = THEN;
Error, Message <- "BATCH MUST NOT CALL ITSELF";
END IF;
END PROCEDURE;
:InstateBatchProcessing
PROCEDURE;
HL <- . AdrOf_JMP_CONST; DE <- GO_BATCH_CONST;
B <- AFTER_GO_BATCH - GO_BATCH_CONST;
DO;
.DE -> A; A -> .HL;
HL + 1 -> HL; DE + 1 -> DE;
B - 1 -> B; IF ~0 REPEAT;
END DO;
END PROCEDURE;
:Main $*** Not a procedure ***
CALL OpenBatchTextFile;
CALL YourPatchProc;
HL <- . SizeOfSafeMemory; HL <-> DE; HL <- . SafeMemory;
HL + DE -> HL; HL -> . AfterSafeMemory;
HL <- . SafeMemory; DE <- - Model; HL + DE -> HL;
HL -> . RelocationValue; HL <-> DE;
HL <- . GO_BATCH_CONST + 1; HL + DE -> HL;
HL -> . GO_BATCH_CONST + 1;
HL <- . GO_BATCH_CONIN + 1; HL + DE -> HL;
HL -> . GO_BATCH_CONIN + 1;
CALL RelocateAddressesInTheModel;
CALL CopyOriginalJMPVectorToModel;
CALL VerifyLackOfRecursion;
CALL CopyModelToSafeMemory;
CALL CopyTextToSafeMemory;
CALL CloseBatchTextFile;
CALL InstateBatchProcessing;
GO. WarmBoot;
$You may assemble or patch in the code here, to store the correct values
$into variables SafeMemory and SizeOfSafeMemory.
:YourPatchProc
PROCEDURE;
$This procedure may expand as necessary, to accommodate your code.
$The existing code in this procedure may be discarded. It is
$peculiar to the version of CP/M and the BIOS used by the author
$of this program.
$*************************
$SafeMemory starts after the end of BIOS.
HL <- . CPMPerformFunction + 1; DE <- #10C0; HL + DE -> HL;
HL -> . SafeMemory;
$SafeMemory extends up to the next 1K boundary of address space.
L -> A; ~A -> A; A -> L;
H -> A; ~A -> A; A <- A & #03; A -> H;
HL + 1 -> HL;
HL -> . SizeOfSafeMemory;
END PROCEDURE;
:ZZZ END Start;