/*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 $$$ FILE */ CALL MAKE(@DEST); /* CREATE A NEW ONE */ IF DCNT = 255 THEN CALL ERROR(17,@DEST); /* NO DIRECTORY SPACE */ DEST.FCB(32) = 0; MADE = TRUE; END SETUPDEST; SETUPSOURCE: PROCEDURE; CALL SETSUSER; /* SOURCE USER */ CALL OPEN(@SOURCE); /* OPEN SOURCE */ IF (NOT RSYS) AND ROL(SOURCE.FCB(10),1) THEN /* SKIP SYSTEM FILE */ DCNT = 255; IF DCNT = 255 THEN CALL ERROR(10,@SOURCE); /* FILE NOT FOUND */ F1 = SOURCE.FCB(1) AND 80H; /* SAVE FILE ATRIBUTES */ F2 = SOURCE.FCB(2) AND 80H; F3 = SOURCE.FCB(3) AND 80H; F4 = SOURCE.FCB(4) AND 80H; RO = SOURCE.FCB(9) AND 80H; SYS = SOURCE.FCB(10) AND 80H; DCNT = RETFSIZE(@SOURCE); CALL MOVE(@SOURCE.FCB(33),@FILSIZE,3); SOURCE.FCB(32) = 0; SOURCE.FCB(33),SOURCE.FCB(34),SOURCE.FCB(35) = 0; /* CAUSE IMMEDIATE READ WITH NO PRECEDING WRITE */ NSOURCE = 0FFFFH; END SETUPSOURCE; WRITEDEST: PROCEDURE; /* WRITE OUTPUT BUFFERS UP TO BUT NOT INCLUDING POSITION NDEST - THE LOW ORDER 7 BITS OF NDEST ARE ZERO */ DECLARE J BYTE, DATAOK BYTE, (TDEST,N) ADDRESS; IF NOT MADE THEN CALL SETUPDEST; IF (N := NDEST AND 0FF80H) = 0 THEN RETURN; TDEST = 0; CALL SETDUSER; /* DESTINATION USER */ CALL SETDMA(@DBUFF(TDEST)); IF (SPARFIL := (SPARFIL OR INSPARC)) THEN /* SET UP FCB FROM RANDOM RECORD NO. */ DO; IF WRITE$RANDOM(@DEST) = 255 THEN CALL ERROR(1,@DEST); /* DISK WRITE ERROR */ END; ELSE CALL SETRANDOM(@DEST); /* SET BASE RECORD FOR VERIFY */ DO WHILE TDEST < N; /* SET DMA ADDRESS TO NEXT BUFFER */ CALL SETDMA(@DBUFF(TDEST)); CALL DISKWRITE(@DEST); IF DCNT <> 0 THEN CALL ERROR(1,@DEST); /* DISK WRITE ERROR */ TDEST = TDEST + 128; END; IF VERIF THEN /* VERIFY DATA WRITTEN OK */ DO; TDEST = 0; CALL SETDMA(@BUFF); /* FOR COMPARE */ DO WHILE TDEST < N; DATAOK = (RDRANDOM(@DEST) = 0); DESTR = DESTR + 1; /* NEXT RANDOM READ */ J = 0; /* PERFORM COMPARISON */ DO WHILE DATAOK AND J < 80H; DATAOK = (BUFF(J) = DBUFF(TDEST+J)); J = J + 1; END; TDEST = TDEST + 128; IF NOT DATAOK THEN CALL ERROR(2,@DEST); /* VERIFY ERROR */ END; CALL DISKWRITE(@DEST); /* NOW READY TO CONTINUE THE WRITE OPERATION */ END; CALL MOVE(@DBUFF(TDEST),@DBUFF(0),LOW(NDEST := NDEST - TDEST)); END WRITEDEST; FILLSOURCE: PROCEDURE; /* FILL THE SOURCE BUFFER */ CALL SETSUSER; /* SOURCE USER NUMBER SET */ NSOURCE = NSBUF; DO WHILE NSBUF < SBLEN; /* SET DMA ADDRESS TO NEXT BUFFER POSIITION */ CALL SETDMA(@SBUFF(NSBUF)); EXTSAVE = SOURCE.FCB(12); /* SAVE EXTENT FIELD */ CALL DISKRD(@SOURCE); IF DCNT <> 0 THEN DO; IF DCNT <> 1 THEN CALL ERROR(0,@SOURCE); /* DISK READ ERROR */ /* END - OF - FILE */ /* CHECK BOUNDRY CONDITION FOR BUG IN BDOS AND CORRECT */ IF (SOURCE.FCB(12) <> EXTSAVE) AND (SOURCE.FCB(32) = 80H) THEN SOURCE.FCB(32) = 0; /* ZERO CURRENT RECORD */ CALL SET$RANDOM(@SOURCE); IF (INSPARC := NOT MAXSIZE) AND (CONCAT OR NOT FASTCOPY) THEN CALL ERROR(18,@SOURCE); /* INVALID FORMAT WITH SPARCE FILE */ ENDOFSRC = TRUE; /* SET END OF SOURCE FILE */ SBUFF(NSBUF) = ENDFILE; RETURN; END; ELSE NSBUF = NSBUF + 128; END; END FILLSOURCE; PUTDCHAR: PROCEDURE(B); DECLARE B BYTE; /* WRITE BYTE B TO THE DESTINATION DEVICE GIVEN BY ODEST.TYPE */ IF B >= ' ' THEN DO; COLUMN = COLUMN + 1; IF DELET > 0 THEN /* MAY BE PAST RIGHT SIDE */ DO; IF COLUMN > DELET THEN RETURN; END; END; IF ECHO THEN CALL MON1(2,B); /* ECHO TO CONSOLE */ DO CASE ODEST.TYPE; /* CASE 0 IS OUT */ CALL OUTD(B); /* CASE 1 IS PRN, TABS EXPANDED, LINES LISTED */ CALL MON1(5,B); /* CASE 2 IS LST */ CALL MON1(5,B); /* CASE 3 IS AXO */ CALL MON1(4,B); /* CASE 4 IS DESTINATION FILE */ DO; IF NDEST >= DBLEN THEN CALL WRITEDEST; DBUFF(NDEST) = B; NDEST = NDEST+1; END; /* CASE 5 IS CON */ CALL MON1(2,B); END; /* OF CASE */ END PUTDCHAR; PUTDESTC: PROCEDURE(B); DECLARE (B,I) BYTE; /* WRITE DESTINATION CHARACTER, TAB EXPANSION */ IF B <> TAB THEN CALL PUTDCHAR(B); ELSE IF TABS = 0 THEN CALL PUTDCHAR(B); ELSE /* B IS TAB CHAR, TABS > 0 */ DO; I = COLUMN; DO WHILE I >= TABS; I = I - TABS; END; I = TABS - I; DO WHILE I > 0; I = I - 1; CALL PUTDCHAR(' '); END; END; IF B = CR THEN COLUMN = 0; END PUTDESTC; PRINT1: PROCEDURE(B); DECLARE B BYTE; IF (ZEROSUP := ZEROSUP AND B = 0) THEN CALL PUTDESTC(' '); ELSE CALL PUTDESTC('0'+B); END PRINT1; PRINTDIG: PROCEDURE(D); DECLARE D BYTE; CALL PRINT1(SHR(D,4)); CALL PRINT1(D AND 1111B); END PRINTDIG; NEWLINE: PROCEDURE; DECLARE ONE BYTE; ONE = 1; ZEROSUP = (NUMB = 1); C1 = DEC(C1+ONE); C2 = DEC(C2 PLUS 0); C3 = DEC(C3 PLUS 0); CALL PRINTDIG(C3); CALL PRINTDIG(C2); CALL PRINTDIG(C1); IF NUMB = 1 THEN /* USUALLY PRINTER OUTPUT */ DO; CALL PUTDESTC(':'); CALL PUTDESTC(' '); END; ELSE CALL PUTDESTC(TAB); END NEWLINE; PUTDEST: PROCEDURE(B); DECLARE (I,B) BYTE; /* WRITE DESTINATION CHARACTER, CHECK TABS AND LINES */ IF FORMF THEN /* SKIP FORM FEEDS */ DO; IF B = FF THEN RETURN; END; IF PUTNUM THEN /* END OF LINE OR START OF FILE */ DO; IF B <> FF THEN /* NOT FORM FEED */ DO; IF (I:=PAGCNT) <> 0 THEN /* PAGE EJECT */ DO; IF I=1 THEN I=LPP; IF (LINENO := LINENO + 1) >= I THEN DO; LINENO = 0; /* NEW PAGE */ CALL PUTDESTC(FF); END; END; IF NUMB > 0 THEN CALL NEWLINE; PUTNUM = FALSE; END; END; IF B = FF THEN LINENO = 0; CALL PUTDESTC(B); IF B = LF THEN PUTNUM = TRUE; END PUTDEST; UTRAN: PROCEDURE(B) BYTE; DECLARE B BYTE; /* TRANSLATE ALPHA TO UPPER CASE */ IF B >= 110$0001B AND B <= 111$1010B THEN /* LOWER CASE */ B = B AND 101$1111B; /* TO UPPER CASE */ RETURN B; END UTRAN; LTRAN: PROCEDURE(B) BYTE; DECLARE B BYTE; /* TRANSLATE TO LOWER CASE ALPHA */ IF B >= 'A' AND B <= 'Z' THEN B = B OR 10$0000B; /* TO LOWER */ RETURN B; END LTRAN; GETSOURCEC: PROCEDURE BYTE; /* READ NEXT SOURCE CHARACTER */ DECLARE (B,CONCHK) BYTE; CONCHK = TRUE; /* CONSOLE STATUS CHECK BELOW */ DO CASE SOURCE.TYPE; /* CASE 0 IS OUT */ GO TO NOTSOURCE; /* CASE 1 IS PRN */ GO TO NOTSOURCE; /* CASE 2 IS LST */ NOTSOURCE: CALL ERROR(4,0); /* INVALID SOURCE */ /* CASE 3 IS AXO */ GO TO NOTSOURCE; /* CASE 4 IS SOURCE FILE */ DO; IF NSOURCE >= SBLEN THEN /*68K*/ DO; IF DBLBUF OR (NOT DFILE) THEN NSBUF = 0; ELSE IF NSOURCE <> 0FFFFH THEN DO; CALL WRITEDEST; NSBUF = NDEST; END; CALL FILLSOURCE; END; B = SBUFF(NSOURCE); NSOURCE = NSOURCE + 1; END; /* CASE 5 IS CON */ DO; CONCHK = FALSE; /* DON'T CHECK CONSOLE STATUS */ B = MON2(1,0); END; /* CASE 6 IS AXI */ B = MON2(3,0) AND 7FH; /* CASE 7 IS INP */ B = INPD; END; /* OF CASES */ IF CONCHK THEN /* TEST FOR CONSOLE CHAR READY */ DO; IF OBJ THEN /* SOURCE IS AN OBJECT FILE */ CONCHK = ((CONCNT := CONCNT + 1) = 0); ELSE /* ASCII */ CONCHK = (B = LF); IF CONCHK THEN DO; IF CONBRK THEN DO; IF RDCHAR = ENDFILE THEN RETURN ENDFILE; CALL ERROR(5,0); /* USER ABORTED */ END; END; END; IF ZEROP THEN B = B AND 7FH; IF UPPER THEN RETURN UTRAN(B); IF LOWER THEN RETURN LTRAN(B); RETURN B; END GETSOURCEC; GETSOURCE: PROCEDURE BYTE; /* GET NEXT SOURCE CHARACTER */ DECLARE CHAR BYTE; MATCH: PROCEDURE(B) BYTE; /* MATCH START AND QUIT STRINGS */ DECLARE (B,C) BYTE; IF (C:=COMBUFF(B:=(B+MATCHLEN))) = ENDFILE THEN /* END MATCH */ DO; COMBUFF(B) = CHAR; /* SAVE CURRENT CHARACTER */ RETURN TRUE; END; IF C = CHAR THEN MATCHLEN = MATCHLEN + 1; ELSE MATCHLEN = 0; /* NO MATCH */ RETURN FALSE; END MATCH; IF QUITLEN > 0 THEN DO; IF (QUITLEN := QUITLEN - 1) = 1 THEN RETURN LF; RETURN ENDFILE; /* TERMINATED WITH CR,LF,ENDFILE */ END; DO FOREVER; /* LOOKING FOR START */ IF FEEDLEN > 0 THEN /* GET SEARCH CHARACTERS */ DO; FEEDLEN = FEEDLEN - 1; CHAR = COMBUFF(FEEDBASE); FEEDBASE = FEEDBASE + 1; RETURN CHAR; END; IF (CHAR := GETSOURCEC) = ENDFILE THEN RETURN ENDFILE; IF STARTS > 0 THEN /* LOOKING FOR START STRING */ DO; IF MATCH(STARTS) THEN DO; FEEDBASE = STARTS; STARTS = 0; FEEDLEN = MATCHLEN + 1; MATCHLEN = 0; END; /* OTHERWISE NO MATCH, SKIP CHARACTER */ END; ELSE IF QUITS > 0 THEN /* PASS CHARACTERS TIL MATCH */ DO; IF MATCH(QUITS) THEN DO; QUITS = 0; QUITLEN = 2; /* SUBSEQUENTLY RETURN CR, LF, ENDFILE */ RETURN CR; END; RETURN CHAR; END; ELSE RETURN CHAR; END; /* OF DO FOREVER */ END GETSOURCE; RD$EOF: PROCEDURE BYTE; /* RETURN TRUE IF END OF FILE */ CHAR = GETSOURCE; IF OBJ THEN RETURN (ENDOFSRC AND (NSOURCE > NSBUF)); RETURN (CHAR = ENDFILE); END RD$EOF; HEXRECORD: PROCEDURE; DECLARE (H, HBUF, RL, CS, RT) BYTE, ZEROREC BYTE, /* TRUE IF LAST RECORD HAD LENGTH OF ZERO */ LDA ADDRESS; /* LOAD ADDRESS WHICH FOLLOWS : */ CKHEX: PROCEDURE BYTE; IF H - '0' <= 9 THEN RETURN H-'0'; IF H - 'A' > 5 THEN CALL ERROR(13,@SOURCE); /* INVALID HEX DIGIT */ RETURN H - 'A' + 10; END CKHEX; RDHEX: PROCEDURE BYTE; CALL PUTDEST(H := GETSOURCE); RETURN CKHEX; END RDHEX; RDCS: PROCEDURE BYTE; /* READ BYTE WITH CHECKSUM */ RETURN CS := CS + (SHL(RDHEX,4) OR RDHEX); END RDCS; RDADDR: PROCEDURE ADDRESS; /* READ DOUBLE BYTE WITH CHECKSUM */ RETURN SHL(DOUBLE(RDCS),8) OR RDCS; END RDADDR; /* READ HEX FILE AND CHECK EACH RECORD FOR VALID DIGITS, AND PROPER CHECKSUM */ ZEROREC = FALSE; /* READ NEXT RECORD */ H = GETSOURCE; DO FOREVER; /* SCAN FOR THE ':' */ DO WHILE H <> ':'; IF (H = ENDFILE) THEN DO; IF ZEROREC THEN RETURN; CALL ERROR(15,@SOURCE); /* UNEXPECTED END OF HEX FILE */ END; CALL PUTDEST(H); H = GETSOURCE; END; /* ':' FOUND */ /* CHECK FOR END OF HEX RECORD */ H = GETSOURCE; RL = SHL(CKHEX,4); HBUF = H; H = GETSOURCE; RL = RL OR CKHEX; IF (RL = 0) THEN ZEROREC = TRUE; ELSE ZEROREC = FALSE; IF (ZEROREC AND IGNOR) THEN DO WHILE (H <> ':') AND (H <> ENDFILE); H = GETSOURCE; END; ELSE DO; CALL PUTDEST(':'); CALL PUTDEST(HBUF); CALL PUTDEST(H); CS = RL; LDA = RDADDR; /* LOAD ADDRESS */ /* READ WORDS UNTIL RECORD LENGTH EXHAUSTED */ RT = RDCS; /* RECORD TYPE */ DO WHILE RL <> 0; RL = RL - 1; HBUF = RDCS; /* INCREMENT LA HERE FOR EXACT ADDRESS */ END; /* CHECK SUM */ IF RDCS <> 0 THEN CALL ERROR(9,@SOURCE); /* HEX RECORD CHECKSUM */ H = GETSOURCE; END; END; /* DO FOREVER */ END HEXRECORD; CK$STRINGS: PROCEDURE; IF STARTS > 0 THEN CALL ERROR(11,0); /* START NOT FOUND */ IF QUITS > 0 THEN CALL ERROR(12,0); /* QUIT NOT FOUND */ END CK$STRINGS; CLOSEDEST: PROCEDURE; DO WHILE (LOW(NDEST) AND 7FH) <> 0; CALL PUTDEST(ENDFILE); END; CALL CK$STRINGS; CALL WRITEDEST; CALL SETDUSER; /* DESTINATION USER */ CALL CLOSE(@DEST); IF DCNT = 255 THEN CALL ERROR(14,@DEST); /* CLOSE FILE */ CALL OPEN(@ODEST); IF DCNT <> 255 THEN /* FILE EXISTS */ DO; CALL CLOSE(@ODEST); IF ROL(ODEST.FCB(9),1) THEN /* READ ONLY */ DO; IF NOT WRROF THEN DO; DO WHILE ((DCNT <> 'Y') AND (DCNT <> 'N')); CALL PRINT (@('DESTINATION IS R/O, DELETE (Y/N)?$')); DCNT = UTRAN(RDCHAR); END; IF DCNT <> 'Y' THEN DO; CALL PRINT(@('**NOT DELETED**$')); CALL CRLF; CALL DELETE(@DEST); RETURN; END; CALL CRLF; END; END; /* RESET R/O AND SYS ATTRIBUTES */ ODEST.FCB(9) = ODEST.FCB(9) AND 7FH; ODEST.FCB(10) = ODEST.FCB(10) AND 7FH; CALL SETIND(@ODEST); CALL DELETE(@ODEST); END; CALL MOVE(@ODEST.FCB,@DEST.FCB(16),16); /* READY FOR RENAME */ CALL RENAME(@DEST); /* SET DESTINATION ATTRIBUTES SAME AS SOURCE */ ODEST.FCB(1) = (ODEST.FCB(1) AND 07FH) OR F1; ODEST.FCB(2) = (ODEST.FCB(2) AND 07FH) OR F2; ODEST.FCB(3) = (ODEST.FCB(3) AND 07FH) OR F3; ODEST.FCB(4) = (ODEST.FCB(4) AND 07FH) OR F4; ODEST.FCB(8) = (ODEST.FCB(8) AND 07FH); ODEST.FCB(9) = (ODEST.FCB(9) AND 07FH) OR RO; ODEST.FCB(10) = (ODEST.FCB(10) AND 07FH) OR SYS; ODEST.FCB(11) = (ODEST.FCB(11) AND 07FH); CALL SETIND(@ODEST); IF ARCHIV THEN /* SET ARCHIVE BIT */ DO; CALL SETSUSER; SOURCE.FCB(11) = SOURCE.FCB(11) OR 080H; SOURCE.FCB(12) = 0; CALL SETIND(@SOURCE); END; END CLOSEDEST; SIZE$MEMORY: PROCEDURE; DCL CONT BYTE; /* SET UP SOURCE AND DESTINATION BUFFERS */ /* SPLH */ DCHAKIP=@MEMORY; /* SPLH */ DCHAKIL=DCHAKIL+8192; /* GET 8K BYTE MEMORY ARRAY*/ /* 68K */ IF DCHAKIL>MAXBL THEN /* 68K */ DO; /* 68K */ CALL PRINT(@('**NO MEMORY SPACE**$')); /* 68K */ CALL BOOT; /* 68K */ END; /* 68K */ CONT=0; /* 68K */ DO WHILE (DCHAKIL= 4000H THEN DBLEN,SBLEN = 7F80H; ELSE DBLEN,SBLEN = DBLEN + SBLEN; END; ELSE DO; /* MAY NEED TO WRITE DESTINATION BUFFER */ IF NDEST >= DBLEN THEN CALL WRITEDEST; NSBUF = 0; END; END SIZE$MEMORY; SETUPEOB: PROCEDURE; /* SETS NSBUF TO END OF SOURCE BUFFER */ DECLARE I BYTE; IF NOT OBJ THEN DO; TBLEN = NSBUF - 128; DO I = 0 TO 128; IF (SBUFF(TBLEN + I)) = ENDFILE THEN DO; NSBUF = TBLEN + I; RETURN; END; END; END; END SETUPEOB; SIMPLECOPY: PROCEDURE; DECLARE I BYTE; DECLARE FAST LIT '0', /* FAST FILE TO FILE COPY */ CHRT LIT '1', /* CHARACTER TRANSFER OPTION */ DUBL LIT '2'; /* DOUBLE BUFFER REQUIRED FOR FILE COPY */ DECLARE OPTYPE(26) BYTE DATA ( /* OPTION TYPE FOR EACH OPTION CHARACTER */ FAST, /* FOR A OPTION */ FAST, /* FOR B OPTION */ FAST, /* FOR C OPTION */ DUBL, /* FOR D OPTION */ CHRT, /* FOR E OPTION */ DUBL, /* FOR F OPTION */ FAST, /* FOR G OPTION */ CHRT, /* FOR H OPTION */ DUBL, /* FOR I OPTION */ FAST, /* FOR J OPTION */ FAST, /* FOR K OPTION */ CHRT, /* FOR L OPTION */ FAST, /* FOR M OPTION */ DUBL, /* FOR N OPTION */ FAST, /* FOR O OPTION */ DUBL, /* FOR P OPTION */ DUBL, /* FOR Q OPTION */ FAST, /* FOR R OPTION */ DUBL, /* FOR S OPTION */ DUBL, /* FOR T OPTION */ CHRT, /* FOR U OPTION */ FAST, /* FOR V OPTION */ FAST, /* FOR W OPTION */ FAST, /* FOR X OPTION */ FAST, /* FOR Y OPTION */ CHRT); /* FOR Z OPTION */ CHKRANDOM: PROCEDURE; CALL SETSUSER; CALL SET$RANDOM(@SOURCE); CALL SETDMA(@BUFF); DO FOREVER; IF (DCNT := RD$RANDOM(@SOURCE)) = 0 THEN DO; DESTR = SOURCER; DESTR2 = SOURCER2; ENDOFSRC = FALSE; RETURN; END; IF DCNT = 1 THEN DO; IF (SOURCER := SOURCER + 1) = 0 THEN SOURCER2 = SOURCER2 + 1; END; ELSE IF DCNT = 4 THEN DO; IF (SOURCER := (SOURCER + 128) AND 0FF80H) = 0 THEN SOURCER2 = SOURCER2 + 1; END; ELSE CALL ERROR(0,@SOURCE); END; END CHKRANDOM; FASTCOPY = (SFILE AND DFILE); ENDOFSRC = FALSE; DBLBUF = FALSE; SPARFIL = FALSE; /* LOOK FOR PARAMETERS */ DO I = 0 TO 25; IF CONT(I) <> 0 THEN DO; IF OPTYPE(I) = CHRT THEN FASTCOPY = FALSE; ELSE IF OPTYPE(I) = DUBL THEN DO; DBLBUF = (SFILE AND DFILE); FASTCOPY = FALSE; END; END; END; CALL SIZE$MEMORY; IF SFILE THEN CALL SETUPSOURCE; /* FILES READY FOR COPY */ IF FASTCOPY THEN DO WHILE NOT ENDOFSRC; CALL FILLSOURCE; IF (ENDOFSRC AND NOT INSPARC) THEN DO; CALL SETSUSER; CALL CLOSE(@SOURCE); IF CONCAT THEN DO; CALL SETUPEOB; NDEST = NSBUF; IF NENDCMD THEN RETURN; END; END; NDEST = NSBUF; CALL WRITEDEST; NSBUF = NDEST; IF (ENDOFSRC AND INSPARC) THEN CALL CHKRANDOM; END; ELSE DO; /* PERFORM THE ACTUAL COPY FUNCTION */ IF HEXT OR IGNOR THEN /* HEX FILE */ CALL HEXRECORD; ELSE DO WHILE NOT RD$EOF; CALL PUTDEST(CHAR); END; IF CONCAT AND NENDCMD THEN DO; NSBUF = NDEST; RETURN; END; END; IF DFILE THEN CALL CLOSEDEST; END SIMPLECOPY; MULTCOPY: PROCEDURE; DECLARE (NEXTDIR, NDCNT, NCOPIED) ADDRESS; PRNAME: PROCEDURE; /* PRINT CURRENT FILE NAME */ DECLARE (I,C) BYTE; CALL CRLF; DO I = 1 TO FNSIZE; IF (C := ODEST.FCB(I)) <> ' ' THEN DO; IF I = FEXT THEN CALL PRINTCHAR('.'); CALL PRINTCHAR(C); END; END; END PRNAME; ARCHCK: PROCEDURE BYTE; /* CHECK IF ARCHIVE BIT IS SET IN ANY EXTENT OF SOURCE FILE */ /* BUG */ IF NOT ARCHIV THEN RETURN 1; CALL SETSUSER; SOURCE.FCB(12) = WHAT; CALL SEARCH(@SOURCE); DO WHILE DCNT <> 255; /*68K*/ DUMMYP=@BUFF; DUMMYL=DUMMYL+LINT(SHL(DCNT AND 11B,5)+1); /* 68K CALL MOVE(.BUFF+SHL(DCNT AND 11B,5)+1,.SOURCE.FCB(1),15);*/ /*68K*/ CALL MOVE(DUMMYP, @SOURCE.FCB(1),15); IF NOT ROL(SOURCE.FCB(11),1) THEN DO; /*SOURCE.FCB(12) = 0; */ /* BUG */ RETURN 1; END; CALL SEARCHN; END; RETURN 0; END ARCHCK; /* INITIALIZE COUNTERS */ NEXTDIR, NCOPIED = 0; DO FOREVER; /* FIND A MATCHING ENTRY */ CALL SETSUSER; /* SOURCE USER */ CALL SETDMA(@BUFF); SEARFCB(12) = 0; CALL SEARCH(@SEARFCB); NDCNT = 0; DO WHILE (DCNT <> 255) AND NDCNT < NEXTDIR; NDCNT = NDCNT + 1; CALL SEARCHN; END; /* FILE CONTROL BLOCK IN BUFFER */ IF DCNT = 255 THEN DO; IF NCOPIED = 0 THEN CALL ERROR(10,@SEARFCB); /* FILE NOT FOUND */ IF NOT KILDS THEN CALL CRLF; RETURN; END; NEXTDIR = NDCNT + 1; /* GET THE FILE CONTROL BLOCK NAME TO DEST */ /*68K*/ DUMMYP=@BUFF; DUMMYL=DUMMYL+LINT(SHL(DCNT AND 11B,5)+1); /* 68K CALL MOVE(.BUFF + SHL(DCNT AND 11B,5)+1,.ODEST.FCB(1),15);*/ /*68K*/ CALL MOVE(DUMMYP, @ODEST.FCB(1),15); CALL MOVE(@ODEST.FCB(1),@SOURCE.FCB(1),15); /* FILL BOTH FCB'S */ IF /* NOT ARCHIV OR */ ARCHCK THEN /* BUG */ DO; ODEST.FCB(12) = 0; /* BUG */ SOURCE.FCB(12)=0; IF RSYS OR NOT ROL(ODEST.FCB(10),1) THEN /* OK TO READ */ DO; IF NOT KILDS THEN /* KILL DISPLAY OPTION */ DO; IF NCOPIED = 0 THEN CALL PRINT(@('COPYING -$')); CALL PRNAME; END; NCOPIED = NCOPIED + 1; MADE = FALSE; /* DESTINATION FILE NOT MADE */ CALL SIMPLECOPY; END; END; END; END MULTCOPY; CK$DISK: PROCEDURE; /* ERROR IF SAME USER AND SAME DISK */ IF (ODEST.USER = SOURCE.USER) AND (ODEST.FCB(0) = SOURCE.FCB(0)) THEN CALL FORMERR; END CK$DISK; GNC: PROCEDURE BYTE; IF (CBP := CBP + 1) >= COMLEN THEN RETURN CR; RETURN UTRAN(COMBUFF(CBP)); END GNC; DEBLANK: PROCEDURE; DO WHILE (CHAR := GNC) = ' '; END; END DEBLANK; CK$EOL: PROCEDURE; CALL DEBLANK; IF CHAR <> CR THEN CALL FORMERR; END CK$EOL; SCAN: PROCEDURE(FCBA); DECLARE FCBA POINTER, /* ADDRESS OF FCB TO FILL */ FCBS BASED FCBA STRUCTURE ( /* FCB STRUCTURE */ FCB(FRSIZE) BYTE, USER BYTE, TYPE BYTE ); DECLARE (I,K) BYTE; /* TEMP COUNTERS */ /* SCAN LOOKS FOR THE NEXT DELIMITER, DEVICE NAME, OR FILE NAME. THE VALUE OF CBP MUST BE 255 UPON ENTRY THE FIRST TIME */ DELIMITER: PROCEDURE(C) BYTE; DECLARE (I,C) BYTE; DECLARE DEL(*) BYTE DATA (' =.:;,<>',CR,LA,LB,RB); DO I = 0 TO LAST(DEL); IF C = DEL(I) THEN RETURN TRUE; END; RETURN FALSE; END DELIMITER; PUTCHAR: PROCEDURE; /*68K*/ FLEN=FLEN+1; /*68K*/ FCBS.FCB(FLEN) = CHAR; IF CHAR = WHAT THEN AMBIG = TRUE; /* CONTAINS AMBIGUOUS REF */ END PUTCHAR; FILLQ: PROCEDURE(LEN); /* FILL CURRENT NAME OR TYPE WITH QUESTION MARKS */ DECLARE LEN BYTE; CHAR = WHAT; /* QUESTION MARK */ DO WHILE FLEN < LEN; CALL PUTCHAR; END; END FILLQ; SCANPAR: PROCEDURE; DECLARE (I,J) BYTE; /* SCAN OPTIONAL PARAMETERS */ CHAR = GNC; /* SCAN PAST BRACKET */ DO WHILE NOT(CHAR = CR OR CHAR = RB); IF (I := CHAR - 'A') > 25 THEN /* NOT ALPHA */ DO; IF CHAR = ' ' THEN CHAR = GNC; ELSE CALL ERROR(6,0); /* BAD PARAMETER */ END; ELSE DO; /* SCAN PARAMETER VALUE */ IF CHAR = 'S' OR CHAR = 'Q' THEN DO; /* START OR QUIT COMMAND */ J = CBP + 1; /* START OF STRING */ DO WHILE NOT ((CHAR := GNC) = ENDFILE OR CHAR = CR); END; CHAR=GNC; END; ELSE IF (J := (CHAR := GNC) - '0') > 9 THEN J = 1; ELSE DO WHILE (K := (CHAR := GNC) - '0') <= 9; J = J * 10 + K; END; CONT(I) = J; IF I = 6 THEN /* SET SOURCE USER */ DO; IF J > 15 THEN CALL ERROR(7,0); /* INVALID USER NUMBER */ FCBS.USER = J; END; END; END; CHAR = GNC; END SCANPAR; /* SCAN PROCEDURE ENTRY POINT */ /* INITIALIZE FILE CONTROL BLOCK TO EMPTY */ FCBS.TYPE = ERR; CHAR = ' '; FLEN = 0; DO WHILE FLEN < FRSIZE -1; IF FLEN = FNSIZE THEN CHAR = 0; CALL PUTCHAR; END; FCBS.FCB(0) = CDISK +1; /* INITIALIZE TO CURRENT DISK */ FCBS.USER = CUSER; /* AND CURRENT USER */ /* CLEAR PARAMETERS */ DO I = 0 TO 25; CONT(I) = 0; END; FEEDLEN,MATCHLEN,QUITLEN = 0; /* DEBLANK COMMAND BUFFER */ CALL DEBLANK; /* CHECK PERIPHERALS AND DISK FILES */ /* SCAN NEXT NAME */ DO FOREVER; FLEN = 0; DO WHILE NOT DELIMITER(CHAR); IF FLEN >= NSIZE THEN /* ERROR, FILE NAME TOO LONG */ RETURN; IF CHAR = '*' THEN CALL FILLQ(NSIZE); ELSE CALL PUTCHAR; CHAR = GNC; END; /* CHECK FOR DISK NAME OR DEVICE NAME */ IF CHAR = ':' THEN DO; IF FLEN = 1 THEN /* MAY BE DISK NAME A ... P */ DO; IF (FCBS.FCB(0) := FCBS.FCB(1) - 'A' + 1) > 16 THEN RETURN; /* ERROR, INVALID DISK NAME */ CALL DEBLANK; /* MAY BE DISK NAME ONLY */ IF DELIMITER(CHAR) THEN DO; IF CHAR = LB THEN CALL SCANPAR; CBP = CBP - 1; FCBS.TYPE = DISKNAME; RETURN; END; END; ELSE /* MAY BE A THREE CHARACTER DEVICE NAME */ IF FLEN <> 3 THEN /* ERROR, CANNOT BE DEVICE NAME */ RETURN; ELSE /* LOOK FOR DEVICE NAME */ DO; DECLARE (I,J,K) BYTE, M LITERALLY '9', IO(*) BYTE DATA ('OUTPRNLSTAXO', 0,0,0, /* FAKE AREA FOR FILE TYPE */ 'CONAXIINPNULEOF',0); J = 255; DO K = 0 TO M; I = 0; DO WHILE ((I:=I+1) <= 3) AND IO(J+I) = FCBS.FCB(I); END; IF I = 4 THEN /* COMPLETE MATCH */ DO; FCBS.TYPE = K; /* SCAN PARAMETERS */ IF GNC = LB THEN CALL SCANPAR; CBP = CBP - 1; RETURN; END; J = J + 3; /* OTHERWISE TRY NEXT DEVICE */ END; RETURN; /* ERROR, NO DEVICE NAME MATCH */ END; IF CHAR = LB THEN /* PARAMETERS FOLLOW */ CALL SCANPAR; END; ELSE /* CHAR IS NOT ':', SO FILE NAME IS SET. SCAN REMAINDER */ DO; IF FLEN = 0 THEN /* ERROR, NO PRIMARY NAME */ RETURN; FLEN = NSIZE; IF CHAR = '.' THEN /* SCAN FILE TYPE */ DO WHILE NOT DELIMITER(CHAR := GNC); IF FLEN >= FNSIZE THEN RETURN; /* ERROR, TYPE FIELD TOO LONG */ IF CHAR = '*' THEN CALL FILLQ(FNSIZE); ELSE CALL PUTCHAR; END; IF CHAR = LB THEN CALL SCANPAR; /* RESCAN DELIMITER NEXT TIME AROUND */ CBP = CBP - 1; FCBS.TYPE = FILE; FCBS.FCB(32) = 0; RETURN; END; END; END SCAN; PLM: /* PIP ENTRY POINT */ /* BUFFER AT 80H CONTAINS REMAINDER OF LINE TYPED FOLLOWING THE COMMAND 'PIP' - IF ZERO THEN PROMPT TIL CR */ CALL MOVE(@BUFF,@COMLEN,80H); MULTCOM = (COMLEN = 0); /* GET CURRENT CP/M VERSION */ IF CVERSION < VERSION THEN DO; CALL PRINT(@('REQUIRES CP/M-86$')); CALL BOOT; END; /* IF CVERSION >= MVERSION THEN CALL MON1(45,255);*/ IF MULTCOM THEN DO; CALL PRINT(@('CP/M-68K PIP VERSION 1.0$')); CALL CRLF; END; CUSER = GETUSER; /* GET CURRENT USER */ CDISK = GETDISK; /* GET CURRENT DISK */ RETRY: /* ENTER HERE ON ERROR EXIT FROM THE PROCEDURE 'ERROR' */ /* MAIN PROCESSING LOOP. PROCESS UNTIL CR ONLY */ DO FOREVER; C1, C2, C3 = 0; /* LINE COUNT = 000000 */ CONCNT,COLUMN = 0; /* PRINTER TABS */ NDEST,NSBUF = 0; AMBIG = FALSE; MADE = FALSE; /* DESTINATION FILE NOT MADE */ CONCAT = FALSE; PUTNUM = TRUE; /* ACTS LIKE LF OCCURRED ON ASCII FILE */ DFILE,SFILE = TRUE; NENDCMD = TRUE; LINENO = 254; /* INCREMENTED TO 255 > PAGCNT */ /* READ FROM CONSOLE IF NOT A ONELINER */ IF MULTCOM THEN DO; CALL PRINTCHAR('*'); CALL RDCOM; CALL CRLF; END; CBP = 255; IF COMLEN <= 1 THEN /* SINGLE CHARACTER OR */ DO; CALL SETCUSER; /* RESTORE CURRENT USER */ CALL BOOT; /* NORMAL EXIT FROM PIP HERE */ END; /* LOOK FOR SPECIAL CASES FIRST */ CALL SCAN(@ODEST); IF AMBIG THEN CALL ERROR(3,@ODEST); /* INVALID DESTINATION */ CALL DEBLANK; /* CHECK FOR EQUAL SIGN OR LEFT ARROW */ IF (CHAR <> '=') AND (CHAR <> LA) THEN CALL FORMERR; CALL SCAN(@SOURCE); IF ODEST.TYPE = DISKNAME THEN DO; IF SOURCE.TYPE <> FILE THEN CALL FORMERR; CALL CK$EOL; CALL CK$DISK; ODEST.TYPE = FILE; /* SET FOR CHARACTER TRANSFER */ /* MAY BE MULTI COPY */ IF AMBIG THEN /* FORM IS A:=B:AFN */ DO; CALL MOVE(@SOURCE.FCB(0),@SEARFCB(0),FRSIZE); CALL MULTCOPY; END; ELSE DO; /* FORM IS A:=B:UFN */ CALL MOVE(@SOURCE.FCB(1),@ODEST.FCB(1),FRSIZE - 1); CALL SIMPLECOPY; END; END; ELSE IF (ODEST.TYPE = FILE) AND (SOURCE.TYPE = DISKNAME) THEN DO; CALL CK$EOL; CALL CK$DISK; SOURCE.TYPE = FILE; /* SET FOR CHARACTER TRANSFER */ CALL MOVE(@ODEST.FCB(1),@SOURCE.FCB(1),(FRSIZE - 1)); CALL SIMPLECOPY; END; ELSE IF (ODEST.TYPE > CONS) THEN CALL ERROR(3,0); /* INVALID DESTINATION */ ELSE DO; IF ODEST.TYPE <> FILE THEN DFILE = FALSE; /* SCAN AND COPY UNTIL CR */ DO WHILE NENDCMD; SFILE = TRUE; CALL DEBLANK; IF (CHAR <> ',' AND CHAR <> CR) THEN CALL ERROR(16,0); /* INVALID SEPARATOR */ CONCAT = CONCAT OR (NENDCMD := (CHAR = ',')); IF ODEST.TYPE = PRNT THEN DO; NUMB = 1; IF TABS = 0 THEN TABS = 8; IF PAGCNT = 0 THEN PAGCNT = 1; END; IF (SOURCE.TYPE < FILE) OR (SOURCE.TYPE > EOFT) OR AMBIG THEN CALL ERROR(4,0); /* INVALID SOURCE */ IF SOURCE.TYPE <> FILE THEN /* NOT A SOURCE FILE */ SFILE = FALSE; IF SOURCE.TYPE = NULT THEN /* SEND 40 NULLS TO OUTPUT DEVICE */ DO SFILE = 0 TO 39; CALL PUTDEST(0); END; ELSE IF SOURCE.TYPE = EOFT THEN CALL PUTDEST(ENDFILE); ELSE CALL SIMPLECOPY; CALL CK$STRINGS; /* READ ENDFILE, GO TO NEXT SOURCE */ IF NENDCMD THEN CALL SCAN(@SOURCE); END; END; /* COMLEN SET TO 0 IF NOT PROCESSING MULTIPLE COMMANDS */ COMLEN = MULTCOM; END; /* DO FOREVER */ END;