mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-24 08:54:17 +00:00
539 lines
15 KiB
Plaintext
539 lines
15 KiB
Plaintext
/*SPLH*/ /*$TITLE='PERIPHERAL INTERCHANGE PROGRAM' */
|
|
PIPMOD:
|
|
DO;
|
|
/* P E R I P H E R A L I N T E R C H A N G E P R O G R A M
|
|
|
|
COPYRIGHT (C) 1976, 1977, 1978, 1979, 1980, 1981
|
|
DIGITAL RESEARCH
|
|
BOX 579
|
|
PACIFIC GROVE, CA
|
|
93950
|
|
|
|
REVISED:
|
|
17 JAN 80 BY THOMAS ROLANDER (MP/M 1.1)
|
|
05 OCT 81 BY RAY PEDRIZETTI (MP/M-86 2.0)
|
|
18 DEC 81 BY RAY PEDRIZETTI (CP/M-86 1.1)
|
|
31 JULY 82 BY H.CHAKI (CP/M-68K) */
|
|
|
|
/* COMMAND LINES USED FOR .68K FILE GENERATION */
|
|
/* Command line to generate PIP.68K
|
|
|
|
[[ assume that the all default VOLUME is SYS:0.. on EXORmacs]]
|
|
|
|
(1)S-PL/H Compile and ASM on EXORmacs
|
|
=SPLH PIP,,;A,S,X,NOV,NOF,MAR=1/80
|
|
=ASM PIPSUB,,;A,S,X,NOV,NOF,MAR=1/80
|
|
=ASM UT68K,,;
|
|
[[ caution ]]
|
|
PIP: main routine of PIP utility in S-PL/H
|
|
PIPSUB: sub routine of PIP utility in ASM
|
|
UT68K: standard interface routine in ASM
|
|
A: assemble listing option
|
|
S: symbol listing option
|
|
X: xref listing option
|
|
NOV: non save option
|
|
NOF: non floatable option
|
|
MAR: margin option [[ important ]]
|
|
|
|
(2)LINK on EXORmacs
|
|
=LINK PIP/PIPSUB/UT68K,PIP68K,PIP68K;MIXRL=SPLHLIB.RO
|
|
[[ caution ]]
|
|
R option: generate relocatable object
|
|
|
|
(3)XLINK on EXORmacs
|
|
=XLINK PIP68K.RO,PIP68K.OX,O=PIP68K.OL
|
|
|
|
(4)Convert file on EXORmacs to send to VAX
|
|
=CONV PIP68K.OX,PIP68K.OC
|
|
|
|
(5)Send to VAX from EXORMACS
|
|
=VAX
|
|
VAX command
|
|
S
|
|
Source file
|
|
PIP68K.OC
|
|
|
|
(6)Download to CP/M file from VAX
|
|
|
|
(7)Re-convert file on CP/M
|
|
A>RECONV
|
|
input file :PIP68K.OC
|
|
output file :PIP.68K
|
|
|
|
|
|
end command line */
|
|
|
|
DECLARE
|
|
VERSION LITERALLY '0022H', /* REQUIRED FOR OPERATION */
|
|
MVERSION LITERALLY '1130H'; /* FOR MP/M-86 OPERATION */
|
|
|
|
DECLARE
|
|
MAXB POINTER EXTERNAL, /* ADDR FIELD OF JMP BDOS */
|
|
/*68K*/ MAXBL LONG AT(@MAXB),
|
|
FCB (33) BYTE EXTERNAL, /* DEFAULT FILE CONTROL BLOCK */
|
|
BUFF(128)BYTE EXTERNAL; /* DEFAULT BUFFER */
|
|
|
|
DECLARE
|
|
ENDFILE LITERALLY '1AH'; /* END OF FILE MARK */
|
|
|
|
DECLARE /* MAIN PROGRAM ENTRY LABEL */
|
|
PLM LABEL PUBLIC;
|
|
|
|
DECLARE COPYRIGHT(*) BYTE DATA (
|
|
' (7/31/82) CP/M-68K PIP VERS 1.0 ');
|
|
|
|
|
|
/* LITERAL DECLARATIONS */
|
|
DECLARE
|
|
/*SPLH*/ /* LIT LITERALLY 'LITERALLY', */
|
|
LPP LIT '60', /* LINES PER PAGE */
|
|
TAB LIT '09H', /* HORIZONTAL TAB */
|
|
FF LIT '0CH', /* FORM FEED */
|
|
LA LIT '05FH', /* LEFT ARROW */
|
|
LB LIT '05BH', /* LEFT BRACKET */
|
|
RB LIT '05DH', /* RIGHT BRACKET */
|
|
|
|
FSIZE LIT '33',
|
|
FRSIZE LIT '36', /* SIZE OF RANDOM FCB */
|
|
NSIZE LIT '8',
|
|
FNSIZE LIT '11',
|
|
FEXT LIT '9',
|
|
FEXTL LIT '3',
|
|
|
|
/* SCANNER RETURN TYPE CODE */
|
|
OUTT LIT '0', /* OUTPUT DEVICE */
|
|
PRNT LIT '1', /* PRINTER */
|
|
LSTT LIT '2', /* LIST DEVICE */
|
|
AXOT LIT '3', /* AUXILARY OUTPUT DEVICE */
|
|
FILE LIT '4', /* FILE TYPE */
|
|
CONS LIT '5', /* CONSOLE */
|
|
AXIT LIT '6', /* AUXILARY INPUT DEVICE */
|
|
INPT LIT '7', /* INPUT DEVICE */
|
|
NULT LIT '8', /* NUL CHARACTERS */
|
|
EOFT LIT '9', /* EOF CHARACTER */
|
|
ERR LIT '10', /* ERROR TYPE */
|
|
SPECL LIT '11', /* SPECIAL CHARACTER */
|
|
DISKNAME LIT '12'; /* DISKNAME LETTER */
|
|
|
|
DECLARE
|
|
SEARFCB LITERALLY 'FCB'; /* SEARCH FCB IN MULTI COPY */
|
|
|
|
DECLARE
|
|
TRUE LITERALLY '1',
|
|
FALSE LITERALLY '0',
|
|
FOREVER LITERALLY 'WHILE TRUE',
|
|
CR LITERALLY '13',
|
|
LF LITERALLY '10',
|
|
WHAT LITERALLY '63';
|
|
|
|
DECLARE
|
|
COLUMN BYTE, /* COLUMN COUNT FOR PRINTER TABS */
|
|
LINENO BYTE, /* LINE WITHIN PAGE */
|
|
FEEDBASE BYTE, /* USED TO FEED SEARCH CHARACTERS */
|
|
FEEDLEN BYTE, /* LENGTH OF FEED STRING */
|
|
MATCHLEN BYTE, /* USED IN MATCHING STRINGS */
|
|
QUITLEN BYTE, /* USED TO TERMINATE QUIT COMMAND */
|
|
CDISK BYTE, /* CURRENT DISK */
|
|
SBLEN ADDRESS, /* SOURCE BUFFER LENGTH */
|
|
DBLEN ADDRESS, /* DEST BUFFER LENGTH */
|
|
TBLEN ADDRESS, /* TEMP BUFFER LENGTH */
|
|
SBASE POINTER, /* SOURCE BUFFER BASE */
|
|
/*68K*/ SBASEL LONG AT(@SBASE),
|
|
/*SPLH*/ MEMORY (1024) BYTE EXT,
|
|
/*SPLH*/ DCHAKIP POINTER,
|
|
DCHAKIL LONG AT(@DCHAKIP),
|
|
/* THE VECTORS DBUFF AND SBUFF ARE DECLARED WITH DIMENSION
|
|
1024, BUT ACTUALLY VARY WITH THE FREE MEMORY SIZE */
|
|
DBUFF(1024) BYTE AT (@MEMORY), /* DESTINATION BUFFER */
|
|
SBUFF BASED SBASE (1024) BYTE, /* SOURCE BUFFER */
|
|
|
|
/* SOURCE FCB, PASSWORD AND PASSWORD MODE */
|
|
SOURCE STRUCTURE (
|
|
FCB(FRSIZE) BYTE,
|
|
USER BYTE,
|
|
TYPE BYTE ),
|
|
|
|
/* TEMPORARY DESTINATION FCB, PASSWORD AND PASSWORD MODE */
|
|
DEST STRUCTURE (
|
|
FCB(FRSIZE) BYTE,
|
|
USER BYTE,
|
|
TYPE BYTE ),
|
|
|
|
/* ORIGINAL DESTINATION FCB, PASSWORD AND PASSWORD MODE */
|
|
ODEST STRUCTURE (
|
|
FCB(FRSIZE) BYTE,
|
|
USER BYTE,
|
|
TYPE BYTE ),
|
|
|
|
FILSIZE(3) BYTE, /* FILE SIZE RANDOM RECORD NUMBER */
|
|
|
|
DESTR ADDRESS AT(@DEST.FCB(34)), /* RANDOM RECORD POSITION */
|
|
SOURCER ADDRESS AT(@SOURCE.FCB(34)), /* RANDOM RECORD POSITION */
|
|
DESTR2 BYTE AT(@DEST.FCB(33)), /* RANDOM RECORD POSITION R2 */
|
|
SOURCER2 BYTE AT(@SOURCE.FCB(33)), /* RANDOM RECORD POSITION R2 */
|
|
|
|
EXTSAVE BYTE, /* TEMP EXTENT BYTE FOR BDOS BUG */
|
|
|
|
NSBUF ADDRESS, /* NEXT SOURCE BUFFER */
|
|
NSOURCE ADDRESS, /* NEXT SOURCE CHARACTER */
|
|
NDEST ADDRESS; /* NEXT DESTINATION CHARACTER */
|
|
|
|
DECLARE
|
|
FASTCOPY BYTE, /* TRUE IF COPY DIRECTLY TO DBUF */
|
|
DBLBUF BYTE, /* TRUE IF BOTH SOURCE AND DEST BUFFER USED */
|
|
CONCAT BYTE, /* TRUE IF CONCATINATION COMMAND */
|
|
AMBIG BYTE, /* TRUE IF FILE IS AMBIG TYPE */
|
|
DFILE BYTE, /* TRUE IF DEST IS FILE TYPE */
|
|
SFILE BYTE, /* TRUE IF SOURCE IS FILE TYPE */
|
|
MADE BYTE, /* TRUE IF FILE ALREADY MADE */
|
|
ENDOFSRC BYTE, /* TRUE IF END OF SOURCE FILE */
|
|
NENDCMD BYTE, /* TRUE IF NOT END OF COMMAND TAIL */
|
|
INSPARC BYTE, /* TRUE IF IN MIDDLE OF SPARCE FILE */
|
|
SPARFIL BYTE, /* TRUE IF SPARCE FILE BEING COPIED */
|
|
MULTCOM BYTE, /* FALSE IF PROCESSING ONE LINE */
|
|
PUTNUM BYTE, /* SET WHEN READY FOR NEXT LINE NUM */
|
|
CONCNT BYTE, /* COUNTER FOR CONSOLE READY CHECK */
|
|
CHAR BYTE, /* LAST CHARACTER SCANNED */
|
|
FLEN BYTE; /* FILE NAME LENGTH */
|
|
|
|
DECLARE
|
|
F1 BYTE, /* F1 USER ATTRIBUTE FLAG */
|
|
F2 BYTE, /* F2 USER ATTRIBUTE FLAG */
|
|
F3 BYTE, /* F3 USER ATTRIBUTE FLAG */
|
|
F4 BYTE, /* F4 USER ATTRIBUTE FLAG */
|
|
RO BYTE, /* READ ONLY ATTRIBUTE FLAG */
|
|
SYS BYTE, /* SYSTEM ATTRIBUTE FLAG */
|
|
DCNT BYTE; /* ERROR CODE OR DIRECTORY CODE */
|
|
|
|
DECLARE CBUFF(130) BYTE, /* COMMAND BUFFER */
|
|
MAXLEN BYTE AT (@CBUFF(0)), /* MAX BUFFER LENGTH */
|
|
COMLEN BYTE AT (@CBUFF(1)), /* CURRENT LENGTH */
|
|
COMBUFF(128) BYTE AT (@CBUFF(2)); /* COMMAND BUFFER CONTENTS */
|
|
|
|
DECLARE
|
|
CBP BYTE; /* COMMAND BUFFER POINTER */
|
|
|
|
DECLARE
|
|
CUSER BYTE; /* CURRENT USER NUMBER */
|
|
|
|
DECLARE
|
|
LAST$USER BYTE;
|
|
|
|
DECLARE /* CONTROL TOGGLE VECTOR */
|
|
CONT(26) BYTE, /* ONE FOR EACH ALPHABETIC */
|
|
/* 00 01 02 03 04 05 06 07 08 09 10 11 12 13
|
|
A B C D E F G H I J K L M N
|
|
14 15 16 17 18 19 20 21 22 23 24 25
|
|
O P Q R S T U V W X Y Z */
|
|
ARCHIV BYTE AT(@CONT(0)), /* FILE ARCHIVE */
|
|
DELET BYTE AT(@CONT(3)), /* DELETE CHARACTERS */
|
|
ECHO BYTE AT(@CONT(4)), /* ECHO CONSOLE CHARACTERS */
|
|
FORMF BYTE AT(@CONT(5)), /* FORM FILTER */
|
|
GETU BYTE AT(@CONT(6)), /* GET FILE, USER # */
|
|
HEXT BYTE AT(@CONT(7)), /* HEX FILE TRANSFER */
|
|
IGNOR BYTE AT(@CONT(8)), /* IGNORE :00 RECORD ON FILE */
|
|
KILDS BYTE AT(@CONT(10)), /* KILL FILENAME DISPLAY */
|
|
LOWER BYTE AT(@CONT(11)), /* TRANSLATE TO LOWER CASE */
|
|
NUMB BYTE AT(@CONT(13)), /* NUMBER OUTPUT LINES */
|
|
OBJ BYTE AT(@CONT(14)), /* OBJECT FILE TRANSFER */
|
|
PAGCNT BYTE AT(@CONT(15)), /* PAGE LENGTH */
|
|
QUITS BYTE AT(@CONT(16)), /* QUIT COPY */
|
|
RSYS BYTE AT(@CONT(17)), /* READ SYSTEM FILES */
|
|
STARTS BYTE AT(@CONT(18)), /* START COPY */
|
|
TABS BYTE AT(@CONT(19)), /* TAB SET */
|
|
UPPER BYTE AT(@CONT(20)), /* UPPER CASE TRANSLATE */
|
|
VERIF BYTE AT(@CONT(21)), /* VERIFY EQUAL FILES ONLY */
|
|
WRROF BYTE AT(@CONT(22)), /* WRITE TO R/O FILE */
|
|
ZEROP BYTE AT(@CONT(25)); /* ZERO PARITY ON INPUT */
|
|
|
|
DECLARE ZEROSUP BYTE, /* ZERO SUPPRESSION */
|
|
(C3,C2,C1) BYTE; /* LINE COUNT ON PRINTER */
|
|
|
|
DCL DUMMYP POINTER,
|
|
DUMMYL LONG AT(@DUMMYP);
|
|
DCL DUM1P POINTER,
|
|
DUM1L LONG AT(@DUM1P);
|
|
DCL DUM2P POINTER,
|
|
DUM2L LONG AT(@DUM2P);
|
|
|
|
OUTD: PROCEDURE(B) EXTERNAL;
|
|
DECLARE B BYTE;
|
|
/* SEND B TO OUT: DEVICE */
|
|
END OUTD;
|
|
|
|
INPD: PROCEDURE BYTE EXTERNAL;
|
|
END INPD;
|
|
|
|
MON1: PROCEDURE(F,A) EXTERNAL;
|
|
DECLARE F BYTE,
|
|
A ADDRESS;
|
|
END MON1;
|
|
|
|
MON2: PROCEDURE(F,A) BYTE EXTERNAL;
|
|
DECLARE F BYTE,
|
|
A ADDRESS;
|
|
END MON2;
|
|
|
|
MON3: PROCEDURE(F,A) ADDRESS EXTERNAL;
|
|
DECLARE F BYTE,
|
|
A ADDRESS;
|
|
END MON3;
|
|
/* 68K*/
|
|
MON5: PROC(F,A) EXT;
|
|
DCL F BYTE,A POINTER;
|
|
END;
|
|
MON6: PROC(F,A) BYTE EXT;
|
|
DCL F BYTE,A POINTER;
|
|
END;
|
|
MON7: PROC(F,A) ADDR EXT;
|
|
DCL F BYTE,A POINTER;
|
|
END;
|
|
|
|
BOOT: PROCEDURE;
|
|
/* SYSTEM REBOOT */
|
|
CALL MON1(0,0);
|
|
END BOOT;
|
|
|
|
|
|
RDCHAR: PROCEDURE BYTE;
|
|
/* READ CONSOLE CHARACTER */
|
|
RETURN MON2(1,0);
|
|
END RDCHAR;
|
|
|
|
PRINTCHAR: PROCEDURE(CHAR);
|
|
DECLARE CHAR BYTE;
|
|
CALL MON1(2,CHAR AND 7FH);
|
|
END PRINTCHAR;
|
|
|
|
CRLF: PROCEDURE;
|
|
CALL PRINTCHAR(CR);
|
|
CALL PRINTCHAR(LF);
|
|
END CRLF;
|
|
|
|
PRINTX: PROCEDURE(A);
|
|
DECLARE A POINTER;
|
|
CALL MON5(9,A);
|
|
END PRINTX;
|
|
|
|
PRINT: PROCEDURE(A);
|
|
DECLARE A POINTER;
|
|
/* PRINT THE STRING STARTING AT ADDRESS A UNTIL THE
|
|
NEXT DOLLAR SIGN IS ENCOUNTERED */
|
|
CALL CRLF;
|
|
CALL PRINTX(A);
|
|
END PRINT;
|
|
|
|
RDCOM: PROCEDURE;
|
|
/* READ INTO COMMAND BUFFER */
|
|
MAXLEN = 128;
|
|
CALL MON5(10,@MAXLEN);
|
|
END RDCOM;
|
|
|
|
CONBRK: PROCEDURE BYTE;
|
|
/* CHECK CONSOLE CHARACTER READY */
|
|
RETURN MON2(11,0);
|
|
END CONBRK;
|
|
|
|
CVERSION: PROCEDURE ADDRESS;
|
|
RETURN MON3(12,0); /* VERSION NUMBER */
|
|
END CVERSION;
|
|
|
|
SETDMA: PROCEDURE(A);
|
|
DECLARE A POINTER;
|
|
CALL MON5(26,A);
|
|
END SETDMA;
|
|
|
|
OPEN: PROCEDURE(FCB);
|
|
DECLARE FCB POINTER;
|
|
DCNT = MON6(15,FCB);
|
|
END OPEN;
|
|
|
|
CLOSE: PROCEDURE(FCB);
|
|
DECLARE FCB POINTER;
|
|
DCNT = MON6(16,FCB);
|
|
END CLOSE;
|
|
|
|
CK$USER: PROCEDURE;
|
|
DO FOREVER;
|
|
IF DCNT = 0FFH THEN RETURN;
|
|
IF LAST$USER = BUFF(ROR (DCNT,3) AND 110$0000B)
|
|
THEN RETURN;
|
|
DCNT = MON2(18,0);
|
|
END;
|
|
END CK$USER;
|
|
|
|
SEARCH: PROCEDURE(FCB);
|
|
DECLARE FCB POINTER;
|
|
DCNT = MON6(17,FCB);
|
|
CALL CK$USER;
|
|
END SEARCH;
|
|
|
|
SEARCHN: PROCEDURE;
|
|
DCNT = MON2(18,0);
|
|
CALL CK$USER;
|
|
END SEARCHN;
|
|
|
|
DELETE: PROCEDURE(FCB);
|
|
DECLARE FCB POINTER;
|
|
CALL MON5(19,FCB);
|
|
END DELETE;
|
|
|
|
DISKRD: PROCEDURE(FCB);
|
|
DECLARE FCB POINTER;
|
|
DCNT = MON6(20,FCB);
|
|
END DISKRD;
|
|
|
|
DISKWRITE: PROCEDURE(FCB);
|
|
DECLARE FCB POINTER;
|
|
DCNT = MON6(21,FCB);
|
|
END DISKWRITE;
|
|
|
|
MAKE: PROCEDURE(FCBA);
|
|
DECLARE FCBA POINTER;
|
|
DCNT = MON6(22,FCBA);
|
|
END MAKE;
|
|
|
|
RENAME: PROCEDURE(FCB);
|
|
DECLARE FCB POINTER;
|
|
DCNT = MON6(23,FCB);
|
|
END RENAME;
|
|
|
|
GETDISK: PROCEDURE BYTE;
|
|
RETURN MON2(25,0);
|
|
END GETDISK;
|
|
|
|
SETIND: PROCEDURE(FCB);
|
|
DECLARE FCB POINTER;
|
|
DCNT = MON6(30,FCB);
|
|
END SETIND;
|
|
|
|
GETUSER: PROCEDURE BYTE;
|
|
RETURN MON2(32,0FFH);
|
|
END GETUSER;
|
|
|
|
SETUSER: PROCEDURE(USER);
|
|
DECLARE USER BYTE;
|
|
CALL MON1(32,(LAST$USER:=USER));
|
|
END SETUSER;
|
|
|
|
SETCUSER: PROCEDURE;
|
|
CALL SETUSER(CUSER);
|
|
END SETCUSER;
|
|
|
|
SETDUSER: PROCEDURE;
|
|
CALL SETUSER(ODEST.USER);
|
|
END SETDUSER;
|
|
|
|
SETSUSER: PROCEDURE;
|
|
CALL SETUSER(SOURCE.USER);
|
|
END SETSUSER;
|
|
|
|
RD$RANDOM: PROCEDURE(FCB) BYTE;
|
|
DECLARE FCB POINTER;
|
|
RETURN MON6(33,FCB);
|
|
END RD$RANDOM;
|
|
|
|
WRITE$RANDOM: PROCEDURE(FCB) BYTE;
|
|
DECLARE FCB POINTER;
|
|
RETURN MON6(34,FCB);
|
|
END WRITE$RANDOM;
|
|
|
|
RETFSIZE: PROCEDURE(FCB) BYTE;
|
|
DECLARE FCB POINTER;
|
|
RETURN MON6(35,FCB);
|
|
END RETFSIZE;
|
|
|
|
SET$RANDOM: PROCEDURE(FCB);
|
|
DECLARE FCB POINTER;
|
|
/* SET RANDOM RECORD POSITION */
|
|
CALL MON5(36,FCB);
|
|
END SET$RANDOM;
|
|
|
|
|
|
MOVE: PROCEDURE(S,D,N);
|
|
DECLARE (S,D) POINTER, N BYTE;
|
|
DECLARE A BASED DUM1P BYTE, B BASED DUM2P BYTE;
|
|
/*68K*/ DUM1P=S; DUM2P=D;
|
|
DO WHILE (N:=N-1) <> 255;
|
|
/*68K*/ B = A; DUM1L=DUM1L+1; DUM2L=DUM2L+1;
|
|
END;
|
|
END MOVE;
|
|
|
|
ERROR: PROCEDURE(ERRTYPE,FILEADR);
|
|
DECLARE I BYTE,
|
|
TEMP BYTE,
|
|
ERRTYPE BYTE,
|
|
FILEADR POINTER,
|
|
FCB BASED FILEADR (FSIZE) BYTE;
|
|
|
|
/* ERRTYPE ERROR MESSAGES */
|
|
DECLARE ER00(*) BYTE DATA ('DISK READ$');
|
|
DECLARE ER01(*) BYTE DATA ('DISK WRITE$');
|
|
DECLARE ER02(*) BYTE DATA ('VERIFY$');
|
|
DECLARE ER03(*) BYTE DATA ('INVALID DESTINATION$');
|
|
DECLARE ER04(*) BYTE DATA ('INVALID SOURCE$');
|
|
DECLARE ER05(*) BYTE DATA ('USER ABORTED$');
|
|
DECLARE ER06(*) BYTE DATA ('BAD PARAMETER$');
|
|
DECLARE ER07(*) BYTE DATA ('INVALID USER NUMBER$');
|
|
DECLARE ER08(*) BYTE DATA ('INVALID FORMAT$');
|
|
DECLARE ER09(*) BYTE DATA ('HEX RECORD CHECKSUM$');
|
|
DECLARE ER10(*) BYTE DATA ('FILE NOT FOUND$');
|
|
DECLARE ER11(*) BYTE DATA ('START NOT FOUND$');
|
|
DECLARE ER12(*) BYTE DATA ('QUIT NOT FOUND$');
|
|
DECLARE ER13(*) BYTE DATA ('INVALID HEX DIGIT$');
|
|
DECLARE ER14(*) BYTE DATA ('CLOSE FILE$');
|
|
DECLARE ER15(*) BYTE DATA ('UNEXPECTED END OF HEX FILE$');
|
|
DECLARE ER16(*) BYTE DATA ('INVALID SEPARATOR$');
|
|
DECLARE ER17(*) BYTE DATA ('NO DIRECTORY SPACE$');
|
|
DECLARE ER18(*) BYTE DATA ('INVALID FORMAT WITH SPARSE FILE$');
|
|
|
|
DECLARE ERRMSG(*) POINTER DATA(
|
|
@ER00,@ER01,@ER02,@ER03,@ER04,
|
|
@ER05,@ER06,@ER07,@ER08,@ER09,
|
|
@ER10,@ER11,@ER12,@ER13,@ER14,
|
|
@ER15,@ER16,@ER17,@ER18);
|
|
|
|
CALL SETDUSER;
|
|
IF MADE THEN
|
|
DO; CALL CLOSE(@DEST);
|
|
CALL DELETE(@DEST); /* DELETE DESTINATION SCRATCH FILE */
|
|
END;
|
|
|
|
/* PRINT OUT ERROR MESSAGE */
|
|
CALL PRINT(@('ERROR: $'));
|
|
CALL PRINTX(ERRMSG(ERRTYPE));
|
|
CALL PRINTX(@(' - $'));
|
|
IF FILEADR <> 0 THEN
|
|
DO; CALL PRINTCHAR('A' + FCB(0) - 1);
|
|
CALL PRINTCHAR(':');
|
|
DO I = 1 TO FNSIZE;
|
|
IF (TEMP := FCB(I) AND 07FH) <> ' ' THEN
|
|
DO; IF I = FEXT THEN CALL PRINTCHAR('.');
|
|
CALL PRINTCHAR(TEMP);
|
|
END;
|
|
END;
|
|
END;
|
|
|
|
/* ZERO THE COMLEN IN CASE THIS IS A SINGLE COMMAND */
|
|
COMLEN = 0;
|
|
CALL CRLF;
|
|
GO TO RETRY;
|
|
END ERROR;
|
|
|
|
FORMERR: PROCEDURE;
|
|
CALL ERROR(8,0); /* INVALID FORMAT */
|
|
END FORMERR;
|
|
|
|
MAXSIZE: PROCEDURE BYTE;
|
|
IF (SOURCE.FCB(35) = FILSIZE(2)) AND
|
|
(SOURCE.FCB(34) = FILSIZE(1)) AND
|
|
(SOURCE.FCB(33) = FILSIZE(0)) THEN RETURN TRUE;
|
|
RETURN FALSE;
|
|
END MAXSIZE;
|
|
|
|
SETUPDEST: PROCEDURE;
|
|
CALL SETDUSER; /* DESTINATION USER */
|
|
CALL MOVE(@ODEST,@DEST,(FRSIZE + 1)); /* SAVE ORIGINAL DEST */
|
|
/* MOVE THREE CHARACTER EXTENT INTO DEST FCB */
|
|
CALL MOVE(@('$$$'),@DEST.FCB(FEXT),FEXTL);
|
|
CALL DELETE(@DEST); /* REMOVE OLD $$ |