`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$JN^Ou DC.MAIN.TEXT^o"u DATACOMM.CODE^o"MICROMODEM.TEXTMODEMSUBS.TEXToMODEMSUBS.CODEoMM2NK DC.XFER.TEXT^o$ DC.ASM.TEXT^o$' DC.ASM.CODE^o'/ DC.DIR.TEXT^o٠/5 DC.GLO.TEXT^ob59 DC.DATA.TEXT^ob9C DC.IO.TEXTE^o٠CG PATCH.CODEE^oGO PATCH.TEXTE^o&꽌ɪɖ'*&%&,E'зЮ꽌ɪФ`+*xH&x'8*7Ixix&&  ') + &п x) ++`FG8`0($ p,&") (jJJ>L+ "?I>  N `  ` x V Nx .x- z `V0^*^*>` aI꽌ɪVɭ&Y&&Y& 꽌ɪ\8`& (* THIS IS THE PROTOCOL FILE TRANSFER #PROCEDURE. IT TRANSMITS OR RECEIVES #ANY TYPE FILE WITH ERROR CHECKING #AND RE-TRANSMISSION OF BAD BLOCKS. #THE PROTOCOL IS EXACTALY THE SAME #AS IMPLEMENTED IN THE "CLINK" PROGRAM #WRITTEN BY L.E. HUGHES FORELSE T:=1000; "CRC.WORD:=1; "REPEAT #X:=RECVBYTE(T); " COUNT:=COUNT-1; "UNTIL (X=SOH) OR (TIMEOUT) OR (COUNT=0); "FIRSTIME:=FALSE; "IF (X<>SOH) OR TIMEOUT THEN .BEGIN 0MTYPE:='NO SOH'; 0GOTO 1; " END; "CRC.WORD:=0; "Y:=RECVBYTE(50)D;   (*----------------------------------*)   FUNCTION GETMSG:MSGTYPE;   LABEL 1;  VAR T,I,COUNT:INTEGER; $Q: MSGTYPE; $X,Y:BYTE; $  BEGIN "I:=0; LEN.WORD:=0; Q:=UNKNOWN; "COUNT:=5; TIMEOUT:=FALSE; CKSEQ:=FALSE; "IF FIRSTIME THEN T:=12000 "POKE(DATA,DB); "DOCRC(DB);  END;   (*------------------------------*)   PROCEDURE SENDCRC;  VAR XCRC:BYTEWORD;   BEGIN "XCRC.WORD:=CRC.WORD; "SENDBYTE(XCRC.BYTES[1]); (* HIGH CRC BYTE *) "SENDBYTE(XCRC.BYTES[0]); (* LOW CRC BYTE *)  ENND;  DOCRC(X); "RECVBYTE:=X;  END;   (*-------------------------------*)   PROCEDURE SENDBYTE(DB:BYTE);  BEGIN "WHILE NOT GETSTATUS(TXE) DO " BEGIN )IF GETSTATUS(CD) THEN HANGUP; )IF READKEY=ESC THEN EXIT(TRANSFER); 'END;  BEGIN  T:=T+1; "WHILE (NOT GETSTATUS(RRF)) *AND (T>0) DO ,BEGIN .SHORTWAIT(1); .T:=T-1; , IF GETSTATUS(CD) THEN HANGUP; , IF READKEY=ESC THEN EXIT(TRANSFER); ,END;  IF T>0 THEN X:=PEEK(DATA) $ELSE &BEGIN (TIMEOUT:=TRUE; (X:=255; &EDURE MSGKIND(KIND:BYTE);   BEGIN "CASE KIND OF "NUL: MTYPE:='MESSAGE'; "ACK: MTYPE:='ACK'; "NAK: MTYPE:='NAK'; "EOT: MTYPE:='EOT'; !END;  END;   (*---------------------------------*)    FUNCTION RECVBYTE(T:INTEGER):BYTE;  VAR X:BYTE; (*---WAITS ABOUT 10 MS * TIME ----------*)   PROCEDURE SHORTWAIT(TIME:INTEGER);   VAR X:INTEGER;  BEGIN "WHILE TIME>0 DO $BEGIN &FOR X:=0 TO 9 DO &BEGIN &END; $TIME:=TIME-1;  END;  END;   (*-------------------------------*)  PROCETE); ! !BEGIN #CRC.WORD:=CALCRC(CRC.WORD,DB); !END; ! H  (*---HANG UP AND GO BACK TO COMMAND MODE --*)   PROCEDURE HANGUP;   BEGIN "WRITELN('*****LOST CARRIER'); "SETCR2(OH,FALSE); "CLOSE(F); "EXIT(TRANSFER);  END;  PE,GS:STRING; (CH:CHAR; (LEN,CRC:BYTEWORD; (CKSEQ,FIRSTIME,Z,TIMEOUT:BOOLEAN; (SEQNUM:BYTE; (RECVBUFR:PACKED ARRAY[0..2048] OF BYTE; K (XMITBUFR:PACKED ARRAY[0..511] OF BYTE; K H H ! !(*--------------------------------*) !PROCEDURE DOCRC(DB:BYRT,XTEXT,CRCERR, -NOSOH,NOSTX,NOETX,UNKNOWN); % %BYTEWORD=PACKED RECORD CASE 0INTEGER OF .0:(BYTES:PACKED ARRAY[0..1] OF BYTE); .1:(WORD:INTEGER); -END; - % %  VAR SAVEFSW,X,BLK,RETRY:INTEGER; (RESPONSE:MSGTYPE; (COMIN,COMOUT,F:FILE; (MTY FUNCTION CALCRC(CRC:INTEGER;DATA:BYTE):INTEGER;  EXTERNAL;    PROCEDURE TRANSFER(DIR:CHAR;FILENAME:STRING);   CONST NUL=0; (SOH=1; (STX=2; (ETX=3; (EOT=4; (ACK=6; (NAK=21; (  TYPE BYTE=0..255; %MSGTYPE=(XACK,XNAK,XEOT,XTIMEOUT, -XABOE:   SOH NUL LENGTH-H LENGTH-L SEQUENCE STX DATA...DATA ETX CRC-H CRC-L    * THE SEQUENCE NUMBER IS THE BLOCK "NUMBER MOD 2. IT IS ALWAYS ZERO OR ONE. "  *) # #  (*------------------------------------*)  ENCE NUMBERS #FROM "CLINK" WILL NOT HARM THIS #PROGRAM. # )===MESSAGE FORMATS===   CONTROL MESSAGES:   ACKNOWLEDGE = SOH ACK CRC-H CRC-L  NEG ACKNOWLEDGE = SOH NAK CRC-H CRC-L  END OF TRANSMISSION= SOH EOT CRC-H CRC-L   DATA MESSAG #8080 SYSTEMS USING THE MICROMODEM 100 #MODEM BOARD EXCEPT FOR THE ADDITION #OF A MOD 2 SEQUENCE COUNTER TO HELP #PREVENT THE RECEPTION OF DUPLICATE #MESSAGE BLOCKS. THE SEQUENCE COUNTER #HAS NO EFFECT ON THE "CLINK" PROGRAM #AND THE LACK OF SEQU; (* GET MESSAGE TYPE *) "IF TIMEOUT THEN GOTO 1; " "IF Y=NUL THEN (* IT IS A TEXT MESSAGE *) $BEGIN (* GET MESSAGE LENGTH *) 'LEN.BYTES[1]:=RECVBYTE(50); 'LEN.BYTES[0]:=RECVBYTE(50); 'IF TIMEOUT THEN GOTO 1; 'COUNT:=LEN.WORD; " X:=RECVBYTE(50); (* GET STX OR SEQ NUM *) 'IF X<>STX THEN (* GET SEQUENCE NUMBER 0..1 *) /BEGIN / SEQNUM:=X; 1CKSEQ:=TRUE; (* SET FOR SEQUENCE NUMBER CHECKING *) /END; 'WHILE (X<>STX) AND (NOT TIMEOUT) DO (* LOOK FOR STX *) /X:=RECVBYTE(50);----------------------------------*) ! "FUNCTION RECVFILE(FILENAME:STRING):BOOLEAN; "LABEL 1; "VAR F:FILE; &NAKCOUNT,BLOCKS,BLK,I:INTEGER; &Q:MSGTYPE; &RSLT:STRING; &CRLMSG,M:BYTE; & !BEGIN "RSLT:='FILE RECEIVED'; "REWRITE(F,FILENAME); "IF IOR); " "1: CLOSE(F); ! COUNT:=3; 'REPEAT )SENDMSG(EOT); )COUNT:=COUNT-1; 'UNTIL (COUNT=0) OR (GETMSG=XEOT); &IF COUNT=0 THEN RSLT:='EOT LOST'; &WRITELN(RSLT); &IF RSLT='FILE SENT' THEN )SENDFILE:=TRUE )ELSE SENDFILE:=FALSE; !END; ! !(*-&IF Q=XACK THEN OK:=TRUE; & &IF Q=XNAK THEN *BEGIN ,COUNT:=COUNT-1; ,OK:=FALSE; ,IF COUNT=0 THEN .BEGIN 0RSLT:='ABORTED, TOO MANY RETRYS'; 0GOTO 1; .END; ,WRITELN('RETRANSMITTING BLOCK ',BLK); )END; $ $UNTIL OK; " BLK:=BLK+1; "UNTIL EOF(FI:=I-1; , Q:=GETMSG; ,UNTIL (Q IN [XACK,XNAK,XEOT]) OR (I=0); ,IF NOT (Q IN [XACK,XNAK,XEOT]) THEN .BEGIN 0RSLT:='BAD RESPONSE'; 0GOTO 1; .END; *END; " &IF Q=XEOT THEN (BEGIN *RSLT:='TRANSMISSION ABORTED'; *GOTO 1; (END; & TELN('SENDING ',FILENAME,', BLOCK ',BLK); $COUNT:=3; $REPEAT &SENDMSG(NUL); (* SEND MESSAGE *) &Q:=GETMSG; (* GET REPLY *) $ &IF NOT (Q IN [XACK,XNAK,XEOT]) THEN *BEGIN ,I:=3; (* TRY AGAIN FOR GOOD RESPONSE *) ,REPEAT .SENDMSG(NAK); .  BEGIN (RSLT:='NO FILE'; (GOTO 1; &END;  BLK:=0; "REPEAT $SEQNUM:=BLK MOD 2; $TIMEOUT:=FALSE; $I:=BLOCKREAD(F,XMITBUFR,1,BLK);  IF (I<>1) OR (IORESULT<>0) THEN -BEGIN /RSLT:='DISK READ ERROR'; /SENDMSG(EOT); /GOTO 1; -END; $WRI (*-------------------------------*)    FUNCTION SENDFILE(FILENAME:STRING):BOOLEAN;  LABEL 1;  VAR F:FILE; %COUNT,BLK,I:INTEGER; %Q:MSGTYPE; %RSLT:STRING; %OK:BOOLEAN; %  BEGIN "RSLT:='FILE SENT'; "RESET(F,FILENAME); "IF IORESULT<>0 THEN ; (* SEQUENCE NUMBER 0..1 *) 'SENDBYTE(STX); (* SEND STX *) 'FOR I:=0 TO 511 DO (SENDBYTE(XMITBUFR[I]); (* TEXT OF MESSAGE *) 'SENDBYTE(ETX); (* SEND ETX *) %END; %SENDCRC; (* SEND CRC BYTES *) !END; ! MTYPE); "SENDBYTE(SOH); (* SEND SOH *) "CRC.WORD:=0; (* CLEAR CRC *) "SENDBYTE(KIND); (* MESSAGE TYPE *) % "IF KIND=NUL THEN %BEGIN 'SENDBYTE(2); (* HIGH COUNT BYTE *) 'SENDBYTE(0); (* LOW COUNT *) 'SENDBYTE(SEQNUM)NG BEFORE %WE TRANSMIT A MESSAGE *) % "IF GETSTATUS(RRF) THEN X:=RECVBYTE(1); "TIMEOUT:=FALSE; "WHILE NOT TIMEOUT DO X:=RECVBYTE(50); "TIMEOUT:=FALSE; " "(* BEGIN SENDING NOW *) " "MSGKIND(KIND); "IF KIND<>NUL THEN WRITELN('* SENDING ',$IF Q<>XTEXT THEN WRITELN(MTYPE,' RECEIVED'); !END; ! !(*---------------------------------*) % *  PROCEDURE SENDMSG(KIND:BYTE);   VAR I:INTEGER; $X:BYTE; $  BEGIN "FIRSTIME:=FALSE; " "(* THIS MAKES SURE THE OTHER GUY %IS NOT SENDING ANYTHIOT: Q:=XEOT; $NUL: Q:=XTEXT; $ACK: Q:=XACK; $NAK: Q:=XNAK; $ #END; " "MSGKIND(Y); # !1: IF TIMEOUT THEN 'BEGIN )MTYPE:='TIMEOUT'; )Q:=XTIMEOUT; ! END; ' $GETMSG:=Q; EN )BEGIN +MTYPE:='NO ETX'; +Q:=NOETX; +GOTO 1; )END; $END; " "X:=RECVBYTE(20); (* GET CRC BYTES *) "X:=RECVBYTE(20); " "IF TIMEOUT THEN GOTO 1; "IF CRC.WORD<>0 THEN $BEGIN &Q:=CRCERR; &MTYPE:='CRC ERROR'; &GOTO 1; $END; $ "CASE Y OF $E 'IF TIMEOUT THEN GOTO 1; & &(* GET THE MESSAGE *) " 'WHILE (COUNT>0) AND (NOT TIMEOUT) DO )BEGIN +RECVBUFR[I]:=RECVBYTE(50); +IF TIMEOUT THEN GOTO 1; +COUNT:=COUNT-1; I:=I+1; )END; $ X:=RECVBYTE(50); (* GET ETX *) 'IF (X<>ETX) OR TIMEOUT THESULT<>0 THEN 'BEGIN )RSLT:='ERROR IN OPENING FILE'; )GOTO 1; 'END; "BLK:=0; M:=0; NAKCOUNT:=0; "REPEAT $Q:=GETMSG; $WHILE Q=XTEXT DO &BEGIN (IF (NOT CKSEQ) OR (SEQNUM=M) THEN (BEGIN *BLOCKS:=LEN.WORD DIV 512; ( *I:=BLOCKWRITE(F,RECVBUFR,BLOCKS,BLK); *IF IORESULT<>0 THEN -BEGIN /RSLT:='DISK WRITE ERROR'; /SENDMSG(EOT); /GOTO 1; -END; *I:=BLOCKS+BLK; *REPEAT ,WRITELN('RECEIVED BLOCK ',BLK); ,BLK:=BLK+1; *UNTIL BLK=I; ( M:=(M+1) MOD 2; (END; (CRLMSG:THE MODEM. SORRY...  ;  ;THE CRC UPDATE ROUTINE MUST BE  ;WRITTEN IN ASSEMBLY LANGUAGE FOR  ;SPEED ALONE.  ;  ;COPYRIGHT 1980, D.C.HAYES ASSOCIATES, INC.  ;  ;WRITTEN BY DALE A. HEATHERINGTON  ;  ;  ;  RETURN .EQU 0  CRCL .EQU 2  CDATA TO THE 6850 ACIA DATA  ;REGISTER. IF THE POKE WAS DONE  ;IN PASCAL USING THE TRIX RECORD  ;THE ACTUAL WRITE OPERATION WOULD  ;BE INDEXED. THIS RESULTS IN A  ;FALSE READ BEFORE WRITE WHICH  ;DISCARDS THE MOST RECENTLY RECEIVED  ;CHARACTER IN ; "DC.ASM.TEXT" FILE  ;  ;ASSEMBLY LANGUAGE "POKE" AND CRC  ;CALCULATION ROUTINES.  ;  ; VER 1.0 JAN-16-80  ;   ;  ;WE MUST IMPLEMENT THE POKE THIS WAY  ;TO INSURE THAT WE ONLY USE THE  ;6502 ABSOLUTE ADDRESSING MODE TO  ;WRITE N^񠑡ORE FSW *) " "END; (* TRANSFER *) " +WRITELN('WAITING TO RECEIVE BLOCK ZERO...'); +Z:=RECVFILE(FILENAME); $ IF Z THEN WRITELN(FILENAME,' RECEIVED'); )END; ) $IF DIR='S' THEN )BEGIN +WRITELN('TRANSMITTING FILE...'); +Z:=SENDFILE(FILENAME); )END; ) " POKE(CR1,FSW); (* RESTE; "END; "  (*------------------------------------*) " " "BEGIN (* TRANSFER *) " $WRITELN('PROTOCOL FILE TRANSFER ,VER 1.0'); $ $FIRSTIME:=TRUE; $POKE(CR1,21); (* 8 DATA, NO PARITY, 1 STOP *) $IF DIR='R' THEN )BEGIN CONTROL MSG.*) $ NAKCOUNT:=NAKCOUNT+1; 'END; $ $UNTIL (Q=XEOT) OR (NAKCOUNT=4); $SENDMSG(EOT);  1: CLOSE(F,LOCK); $IF NAKCOUNT>3 THEN RSLT:='MESSAGE LOST'; $WRITELN(RSLT); " IF RSLT='FILE RECEIVED' THEN 'RECVFILE:=TRUE 'ELSE RECVFILE:=FALS=ACK; NAKCOUNT:=0; (SENDMSG(CRLMSG); (* SEND ACK *) (Q:=GETMSG; &END; # $IF NOT (Q IN [XEOT,XNAK]) THEN 'BEGIN )CRLMSG:=NAK; )SENDMSG(CRLMSG); ' NAKCOUNT:=NAKCOUNT+1; 'END; $ $IF Q=XNAK THEN 'BEGIN )SENDMSG(CRLMSG); (* RE-TRANSMIT LAST RCH .EQU 3  DBYTE .EQU 4  ;  ; (.PROC POKE,2  ;  ; PROCEDURE POKE(ADDR,DATA:INTEGER);  ; (PLA ;GET RETURN ADDR (STA RETURN (PLA (STA RETURN+1 (PLA ;GET DATA BYTE (TAX ;PUT IT IN X (PLA ;DISCARD MSB (PLA (STA ADRL ;LOW ADDRESS BYTE (PLA (STA ADRH ;HIGH ADDRESS BYTE  .BYTE 8E ;STX OP-CODE  ADRL: .BYTE 0 ;ADDRESS TO POKE  ADRH: .BYTE 0 (LDA RETURN+1;RECOVER RETURN ADDRN^ʟ٠POKE POKE CALCRC CALCRC  hhhhhhHH`(hhhhhhhhhh)E&& II&LHHHH`RZ'II.0 [d.4] POKE SS (PHA (LDA RETURN (PHA (RTS ;TAKE IT HOME TO MOM  ;  ;  ;  ; (.END  T DOWN FROM 8 (BEQ UCRC3 ;WERE DONE IF ZERO (CLC ;ELSE SHIFT DATA LEFT (ROL DBYTE (JMP UCRC1  UCRC3: LDA CRCH ;GET FINISHED CRC (PHA ;PUSH ON STACK (LDA CRCL (PHA (LDA RETURN+1;GET RETURN ADDRE(ROL CRCL ;SHIFT 16 BIT CRC LEFT 1 BIT (ROL CRCH (BCC UCRC2 ;BRANCH IF MSB WAS 0 (LDA CRCH ;XOR WITH 8005 HEX CRC POLYNOMIAL (EOR #80 (STA CRCH (LDA CRCL (EOR #5 (STA CRCL  UCRC2: DEX ;COUN(PLA ;GET HIGH CRC BYTE (STA CRCH ;STORE AGAIN  ; (LDX #8 ;SET COUNTER TO 8  UCRC1: LDA DBYTE ;GET CRC TO A (AND #80 ;KEEP MSB (EOR CRCH ;XOR MSB INTO CRC (STA CRCH (CLC RN (PLA (STA RETURN+1  ; (PLA ;DISCARD 4 BYTES (PLA (PLA (PLA  ; (PLA ;GET DATA BYTE (STA DBYTE ;STORE IT (PLA ;DISCARD HIGH BYTE  ; (PLA ;GET LOW CRC BYTE (STA CRCL ;STORE IT ESS (PHA ;STACK IT (LDA RETURN (PHA (RTS ;BACK TO PASCAL  ;  ;  ;  ;  ;  .FUNC CALCRC,2  ;  ;  ; FUNCTION CALCRC(CRC:INTEGER;DATA:BYTE):INTEGER;  ;  ; (PLA ;GET RETURN ADDRESS (STA RETU/ƃצʅ/ƃʅ) ƃʅ/  ƃ-ƃƅ0ʅ/ ƅ0ƃ𗂨,Ȱ  [R/bƃʅ/  ƃƃƅ0ʅ/ƅ0𗂨, f蘸Xؘ֘DITORM.EDITOR.EDITOR*CLOSE(F); *EXIT(CALL); (END &ELSE (BEGIN *WRITELN(S); *Y:=BUFPNTR-1; *DELETE(S,1,Y); " INPUTBUF:=S; *EXECUTE(INPUTBUF); (END;  CLOSE(F);  BUFPNTR:=X; INPUTBUF:=Q;  END; " ',NAME,'...'); "WHILE (NOT EOF(F)) AND (NOT FOUND) AND (IORESULT=0) DO $BEGIN &READLN(F,S); &BUFPNTR:=1; &NEXTSTRING(S); &IF NAME=TEMPBUF THEN FOUND:=TRUE;  END; ' "IF NOT FOUND THEN (BEGIN *WRITELN(NAME,' NOT FOUND'); *LINEEND:=TRUE; C.DATA.TEXT NOT FOUND'); *EXIT(CALL); (END; "FOUND:=FALSE; X:=BUFPNTR; Q:=INPUTBUF; "IF NAME='?' THEN %BEGIN 'WHILE (NOT EOF(F)) AND (IORESULT=0) DO )BEGIN *READLN(F,S); ) WRITELN(S); )END; &CLOSE(F); &EXIT(CALL); %END; "WRITELN('LOOKING FOR END; #END;  END;  '  (*-CALL BY NAME PROCEDURE-----------*)   PROCEDURE CALL(NAME:STRING);  VAR F:TEXT; $Y,X:INTEGER; $Q,S:STRING;  FOUND:BOOLEAN;   BEGIN  RESET(F,'MM2:DC.DATA.TEXT'); "IF IORESULT<>0 THEN (BEGIN *WRITELN('MM2:D WRITELN('SIZE FILE NAME'); $FOR I:=1 TO 77 DO $BEGIN $WITH DIRX[I] DO $ BEGIN 'IF (LENGTH(DTID)>0) )AND (COUNT>0) THEN 'BEGIN & X:=DLASTBLK-DFIRSTBLK; (CH:=CHR(9); (WRITE(X:3,' '); ' WRITELN(DTID); ' COUNT:=COUNT-1; 'END; &END; AR; 'PR:FILE OF CHAR; 'DIRX:DIRECTORY; 'GS:STRING; 'COUNT:INTEGER;   BEGIN $ !IF UNITNUM IN [4,5,9..12] THEN #BEGIN $UNITREAD(UNITNUM,DIRX[0],2048,2); $WITH DIRX[0] DO $BEGIN %WRITELN(DVID ); $ COUNT:=DLOADTIME; $END;  I:=1; OT:DATEREC); (XDISK,CODE,TEXT,INFO,DATA, (GRAF,FOTO: *(DTID:TID; *DLASTBYTE:1..512; *DACCESS:DATEREC) (END; (  DIRP=^DIRECTORY;  DIRECTORY=ARRAY[DIRRANGE] OF DIRENTRY;    VAR I,P,X,Y,Z:INTEGER; 'CH:CHAR; 'BUFR:PACKED ARRAY[0..BUFSIZE] OF CHLEKIND=(UNTYPED,XDISK,CODE,TEXT, *INFO,DATA,GRAF,FOTO,SECUREDIR); *  DIRENTRY=RECORD (DFIRSTBLK:INTEGER; (DLASTBLK:INTEGER; (CASE DFKIND:FILEKIND OF )SECUREDIR,UNTYPED: )(DVID:VID; *DEOVBLK:INTEGER; *DLOADTIME:INTEGER; *DDUMMY:INTEGER; *DLASTBO (* THIS PROCEDURE LIST THE DIRECTORY *)   PROCEDURE LDIR(UNITNUM:INTEGER);   CONST BUFSIZE=2560;   TYPE   DATEREC=PACKED RECORD (MONTH:0..12; (DAY:0..31; (YEAR:0..100 &END; &  DIRRANGE=0..77;   VID=STRING[7];  TID=STRING[15];  FI ڍʅ- .ƃʅ. ƃ/ƃ  ƃ RDITORM.EDITԮA-޽r tS6 6 X6 6 ҟlܘޘl☂6 6 ҟlß6 n6 V 6 V 蛂lʛTAPPLE1:SYSTEM.EDITOR N, Vols on-line: ȡ & x \6F& EDITOR INITIALIOUT COPYFILEENVIRONMPUTSCBBS FULL DPS 7E1 DIAL 394-4220  LES.FREED FULL DPS 7E1 DIAL 939-1520  SOURCE FULL DPS 8N1 DIAL 577-8911  CBBS.CHICAGO FULL DPS 7E1 DIAL 1-312-528-7141  CYBER FULL DPS 7E1 DIAL 894-2106  CHAIN.DEMO PREFIX 9* PRINTER ON CALL CHAIN.DEMO2  CHAIN.DEMO2 N^bb" RIG); $ $CBPNTR:0..CBSIZE; $ $CBFILE:FILE; $ $   INPUTBUF:STRING;  PREFIX,TEMPBUF,LASTNUM,FONENUM:STRING[25];   (* CAPTURE BUFFER, ALSO USED FOR PRINTER BUFFER *)   CAPBUFR: PACKED ARRAY [0..CBSIZE] OF CHAR;   "(* END OF GLOBALS *) "TRANSLATE:PACKED ARRAY[0..127] OF 0..255; " "OUTPTR,INPTR: INTEGER; (* PRINT BUFFER POINTERS *) "PRINT: BOOLEAN; "PRNSTAT,PRNDATA:INTEGER; (* PRINTER STATUS AND DATA *) " $ #CR1,CR2,DATA,STATUS:INTEGER; $ $ $DUPLEX:(HALF,FULL); $MODES :(ANSW,OCHAR; $ $PRIMPAGE,FOLDFLAG,INDFLAG,CBFLAG, $AUTOLF,RETSYS,LINEEND, $XCONSOLE,SENDINGFILE:BOOLEAN; & $TRIX:RECORD CASE BOOLEAN OF )FALSE: (ADDRESS:INTEGER); )TRUE: (POINTER:^TRIXARRAY); )END; ( ( "MCR2,MSTATUS:BITORBYTE; ( :(BYTEHALF:0..255); &FALSE:(BITHALF:PACKED ARRAY[0..7] OF BOOLEAN); %END;   VAR LINESP,CHRSP,I,FSW:INTEGER; $RDYLOC,HPOS,X,Y,LEN: INTEGER; $BRKLEN,SPCNT,NULLS,BUFPNTR: INTEGER; $ $NUL,BRK,DLE,DEL,FF,CR,LF,ESC,RUBOUT, $PAGECHG,BS,BELL,CHK,CHM,CH: +CD=2; *RES=3; +FE=4; )OVRN=5; +PE=6; )  (*CONTROL REGISTER #2 BITS *) ) *BRS=0; *TXE=1; )MODE=2; )SETT=3; +ST=4; +OH=7; )  TYPE BYTE=0..255;  !TRIXARRAY=PACKED ARRAY[0..1] OF 0..255; ! !BITORBYTE=PACKED RECORD CASE BOOLEAN OF &TRUE   (* GLOBALS ARE HERE! THIS IS "DC.GLO.TEXT" FILE *)   CONST BLKSIZE=512; 'CBSIZE=19000; *KBD=-16384; (KBREL=-16368; )SLOT=2; (* MICROMODEM II SLOT *) &PRNSLOT=1; (* PRINTER SLOT *) )   (* STATUS REGISTER BITS *) *RRF=0; *TRE=1;YNTAEDITCORELINESPACE 1000 CHARSPACE 50 CALL CBBS   IF NOT PRINT THEN OUTPTR:=INPTR;  IF (PEEK(PRNSTAT)<128) AND (INPTR<>OUTPTR) THEN #BEGIN %POKE(PRNDATA,ORD(CAPBUFR[OUTPTR])); %OUTPTR:=OUTPTR+1; # IF OUTPTR>CBSIZE THEN OUTPTR:=0; #END;  END;   (*-----------------------------------*) "PROCEDU%ELSE # BEGIN (ADDRESS:=KBD; (IF POINTER^[0] >127 THEN KBRDY:=TRUE *ELSE KBRDY:=FALSE; " END; "END;   (* THIS CODE SENDS A BYTE FROM THE #PRINT BUFFER TO THE TRENDCOM PRINTER #EACH TIME THE KEYBOARD STATUS IS #CHECKED. *) # ;   (*-----------------------------------*)   FUNCTION KBRDY:BOOLEAN; |  BEGIN !WITH TRIX DO "BEGIN #IF XCONSOLE THEN &BEGIN (ADDRESS:=-16256+14+16*3; (* COM CARD *) # IF (POINTER^[0] MOD 2)<>0 THEN KBRDY:=TRUE 1ELSE KBRDY:=FALSE; &END E(KBREL,0); (X:=PEEK(KBD); (* OR PEEK KEYBOARD *) ! END; !IF X>127 THEN X:=X-128; !CH:=CHR(TRANSLATE[X]);  IF CH=PAGECHG THEN FLIPPAGE;  IF CH=CR THEN &BEGIN (IF PRIMPAGE=FALSE THEN FLIPPAGE; (UNITCLEAR(1);  END;  READKEY:=CH;  END!IF PRIMPAGE THEN POKE(-16300,0) #ELSE POKE(-16299,0);  END;   (*---READ A CHARACTER FROM KEYBOARD-*)   FUNCTION READKEY:CHAR;  VAR X:INTEGER;  BEGIN !IF XCONSOLE THEN &X:=PEEK(-16256+15+16*3) (* PEEK COM CARD DATA PORT *) $ELSE &BEGIN (POKITH TRIX DO "BEGIN #ADDRESS:=STATUS; #MSTATUS.BYTEHALF:=POINTER^[0]; "END; !GETSTATUS:=MSTATUS.BITHALF[BIT];  END;   (*--CHANGE DISPLAY PAGES------------*)  PROCEDURE FLIPPAGE;  BEGIN !IF PRIMPAGE THEN PRIMPAGE:=FALSE #ELSE PRIMPAGE:=TRUE; 2(BIT:INTEGER;STATE:BOOLEAN); ! !BEGIN "MCR2.BITHALF[BIT]:=STATE; "WITH TRIX DO #BEGIN $ADDRESS:=CR2; $POINTER^[0]:=MCR2.BYTEHALF; #END; !END; !  (*----------------------------------*)   FUNCTION GETSTATUS(BIT:INTEGER):BOOLEAN;   BEGIN !W; !EXTERNAL; ! !(*-----------------------------------*) ! !FUNCTION PEEK(ADDR:INTEGER):INTEGER; !BEGIN "WITH TRIX DO #BEGIN #ADDRESS := ADDR; #PEEK := POINTER^[0]; #END; !END; &  (*-----------------------------------*) & $ !PROCEDURE SETCR! !(* THIS IS THE "DC.IO.TEXT" FILE *) ! !(* I/O ROUTINES FOR THE MICROMODEM II *) ! !(*-----------------------------------*) ! !(* THIS ROUTINE IS IN 6502 ASSEMBLY $CODE IN THE FILE "DC.ASM.TEXT". *) ! !PROCEDURE POKE(ADDR,DATA:INTEGER)YNTAEDITCORE1:SYSTEM.EDITOR N, Vols on-line: ȡ & x \6F& EDITOR INITIALIOUT COPYFILEENVIRONMPUTS ڍʅ- .ƃʅ. ƃ/ƃ  ƃ RDITORM.EDITԮA-޽r tS6 6 X6 6 ҟlܘޘl☂6 6 ҟlß6 n6 V 6 V 蛂lʛTAPPLE/ƃצʅ/ƃʅ) ƃʅ/  ƃ-ƃƅ0ʅ/ ƅ0ƃ 𗂨,Ȱ  [R/٠ƃʅ/  ƃƃƅ0ʅ/ƅ0𗂨, f蘸Xؘ֘DITORM.EDITOR.EDITORRE WAIT(TIME:INTEGER); " "BEGIN #WHILE TIME>0 DO %BEGIN 'FOR X:=0 TO 78 DO 'BEGIN 'END; " TIME:=TIME-1; %END; "END; "  (*-----------------------------------*)   FUNCTION RING:BOOLEAN;   BEGIN !IF PEEK(CR2)<128 THEN RING:=TRUE #ELSE RING:=FALSE  END;   (*-----------------------------------*) $ " !  PROCEDURE SENDBREAK(LEN:INTEGER);  BEGIN !POKE(CR1,FSW+96);(*SET BITS 5&6*) !WAIT(LEN DIV 50); !POKE(CR1,FSW);  END;  (*-----------------------------------*) !PROCEDURE DIALDIGN^OMPATIBLE WITH THIS PATCHER PROGRAMI)NSTALL OR R)EMOVE PATCH?:: IR  "."ˡ$צFILE WRITE ERRORPATCH /PLEASE RE-BOOT SYSTEMrv|JPLE" NOT FOUND-.;.;ȡP-....-..-˩- ˄mצ%THIS VERSION OF "SYSTEM.APPLE" IS NOT$COMPATIBLE WITH THIS PATCHER PROGRAMI)NSTALL OR R)EMOVE PATCH?:: IR  "."ˡ$צFILE WRITE ERRORPATCH /PLEASE RE-BLE."š1FILE "SYSTEM.APPLE" NOT FOUND-.;.;ȡP-....-..-˩- ˄mצ%THIS VERSION OF "SYSTEM.APPLE" IS NOT$CALREADY PATCHED..ȡw..../צ INSTALLED..1ץ ǁצ#4:SYSTEM.APP-á,צSYSTEM.APPLE NOT PATCHED..ȡ........../צREMOVED - á0צSYSTEM.APPLE "2 PATCH %UNTIL X=0; %WAIT(11); $END; !END; ! IT(DIG:CHAR); !VAR X:INTEGER; !BEGIN ! "IF DIG='*' THEN WAIT(40) "ELSE "IF DIG IN ['0'..'9'] THEN $BEGIN %IF DIG='0' THEN X:=10 ELSE X:=ORD(DIG)-ORD('0'); %REPEAT 'SETCR2(OH,FALSE); 'WAIT(1); 'SETCR2(OH,TRUE); 'WAIT(1); 'X:=X-1; /ƃצʅ/ƃʅ) ƃʅ/  ƃ-ƃƅ0ʅ/ ƅ0ƃf$𗂨,Ȱ  [R/"ƃʅ/  ƃƃƅ0ʅ/ƅ0𗂨, f蘸Xؘ֘DITORM.EDITOR.EDITOR"IF IORESULT<>0 THEN %BEGIN 'WRITELN('FILE WRITE ERROR'); 'EXIT(PATCH); %END; "CLOSE(F);  WRITELN('PATCH ',S);  WRITELN('PLEASE RE-BOOT SYSTEM');  END.  " " IS NOT'); 'WRITELN('COMPATIBLE WITH THIS PATCHER PROGRAM'); 'EXIT(PATCH); %END; " "WRITE('I)NSTALL OR R)EMOVE PATCH?'); "READ(CH); "WRITELN; " "CASE CH OF "'R': REMOVE; "'I': INSTALL; "END; " "I:=BLOCKWRITE(F,BUFR,2,3); $END; "J:=0; "FOR I:=0 TO 2 DO " BEGIN (* CHECKSUM THE LOCATIONS TO BE PATCHED *) " J:=J+BUFR[CWRITE+I] + BUFR[WSER+I] )+BUFR[WPRN+I] + BUFR[WCOM+I]; #END; # "IF (J<>NORMAL) AND (J<>PATCHED) THEN %BEGIN 'WRITELN('THIS VERSION OF "SYSTEM.APPLE; " "END; " " " "BEGIN (* PATCH *)  "JSRINST[0]:=JSR; "JSRINST[1]:=ADRL; "JSRINST[2]:=ADRH; " "RESET(F,'#4:SYSTEM.APPLE'); "I:=BLOCKREAD(F,BUFR,2,3); "IF IORESULT>0 THEN $BEGIN &WRITELN('FILE "SYSTEM.APPLE" NOT FOUND'); &EXIT(PATCH); #BEGIN (* NOP THE CONSOLE STATUS CHECK CALLS IN THESE ROUTINES *) # %BUFR[CWRITE+I]:=NOP; (* CONSOLE WRITE *) %BUFR[WSER+I]:=NOP; (* SERIAL CARD *) " BUFR[WPRN+I]:=NOP; (* PRINTER *) %BUFR[WCOM+I]:=NOP; (* COM CARD *) # # S:='INSTALLED'; #ENDSRINST[I]; %END; %S:='REMOVED'; ' !END; "  PROCEDURE INSTALL; "BEGIN " "IF J=PATCHED THEN %BEGIN 'WRITELN('SYSTEM.APPLE ALREADY PATCHED'); 'EXIT(PATCH); %END; " "FOR I:=0 TO 2 DO PROCEDURE REMOVE; !BEGIN " $IF J=NORMAL THEN &BEGIN (WRITELN('SYSTEM.APPLE NOT PATCHED'); (EXIT(PATCH); &END; % # % #FOR I:=0 TO 2 DO %BEGIN 'BUFR[CWRITE+I]:=JSRINST[I]; 'BUFR[WSER+I]:=JSRINST[I]; 'BUFR[WPRN+I]:=JSRINST[I]; 'BUFR[WCOM+I]:=JWPRN=529; 'WCOM=543; ( 'NORMAL=1500; (* UNPATCHED CHECKSUM*) 'PATCHED=2808; (* PATCHED CHECKSUM *)   VAR BUFR: PACKED ARRAY[0..1023] OF 0..255; ! JSRINST:PACKED ARRAY[0..2] OF 0..255; $F:FILE; $I,J:INTEGER; $S:STRING[20]; $CH:CHAR; $ " !PROGRAM PATCH;  (*$I-*)   CONST NOP=234; (* 6502 NOP *)  JSR=32; (* 6502 JSR *) 'ADRH=214; (* HIGH ADDRESS BYTE OF CONSOLE STAT. CHECK ROUTINE *) 'ADRL=129; (* LOW ADDRESS BYTE OF STATUS CHECK *) ' ( 'CWRITE=464; 'WSER=503; ' ڍʅ- .ƃʅ. ƃ/ƃ  ƃ RDITORM.EDITԮA-޽r tS6 6 X6 6 ҟlܘޘl☂6 6 ҟlß6 n6 V 6 V 蛂lʛTAPPLE1:SYSTEM.EDITOR N, Vols on-line: ȡ & x \6F& EDITOR INITIALIOUT COPYFILEENVIRONMPUTS!IF (CBPNTR MOD BLKSIZE) <> 0 #THEN BLOCKS:=BLOCKS+1; ! !NEXTSTRING(INPUTBUF); !R:=2;(*TEXT FILES START WITH BLOCK 2*) ! !REWRITE(CBFILE,TEMPBUF); !IF IORESULT=0 THEN !BEGIN # !IF TEMPBUF[LENGTH(TEMPBUF)]<>':' THEN "BEGIN #Y:=BLOCKWRITE(CBFI END;   (*---SAVE CAPTURE BUFFER ON DISK-----*)    PROCEDURE CBSAVE;   VAR BLOCKS,X,Y,R:INTEGER;  DUMMY:PACKED ARRAY[0..511] OF CHAR;    BEGIN !FILLCHAR(DUMMY,512,CHR(0)); !BLOCKS:=CBPNTR DIV BLKSIZE; E QUIT;   VAR CH:CHAR;  BEGIN "RETSYS:=TRUE; "IF MCR2.BITHALF[OH] THEN #BEGIN $REPEAT %WRITELN; %WRITE('WANT TO HANG UP FIRST? (Y/N)'); %READLN(CH); $UNTIL (CH='Y') OR (CH='N'); $IF CH='Y' THEN SETCR2(OH,FALSE); #END; '  EXIT(DATACOMM) ' RVAL:=CHR(X);  END;   (*------------------------------*)  FUNCTION ONOFF:BOOLEAN;  BEGIN !NEXTSTRING(INPUTBUF); !IF TEMPBUF='ON' THEN ONOFF:=TRUE; !IF TEMPBUF='OFF' THEN ONOFF:=FALSE;  END;   (*---EXIT FROM THIS PROGRAM--------*)   PROCEDUR$IF BUFPNTR>LENGTH(BUFR) THEN &LINEEND:=TRUE; & $ $TEMPBUF:=COPY(BUFR,B,(E-B)); "END  END;   (*---CONVERT NUMBER STRING TO CHAR--*)  FUNCTION CHARVAL:CHAR;  VAR X:INTEGER;  BEGIN !NEXTSTRING(INPUTBUF); !X:=CVI(TEMPBUF); !X:=X MOD 256; !CHAE (BLENGTH(BUFR)); % $BUFPNTR:=E;   PROCEDURE NEXTSTRING; 9  TYPE SKIPEM=SET OF CHAR;  9  VAR B,E,I:INTEGER; $DELM:SKIPEM; $DONE:BOOLEAN;  BEGIN !DELM:=['=',' ',','];  TEMPBUF:=' '; !IF BUFPNTR <= LENGTH(BUFR) THEN  "BEGIN " I:=1; B:=BUFPNTR; LINEEND:=FALSE; $ $WHILINTEGER;  BEGIN !MPY:=1; RV:=0; !FOR X:=LENGTH(ASCII) DOWNTO 1 DO "BEGIN #IF ASCII[X] IN ['0'..'9'] THEN $BEGIN %RV:=RV+(MPY*(ORD(ASCII[X])-ORD('0')));  MPY:=MPY*10; $END; "END;  CVI:=RV;  END;   (*----GET NEXT STRING FROM INPUT BUF.-*)%IF AUTOLF THEN SENDCHAR(LF); % X:=NULLS; &WHILE X>0 DO 'BEGIN )SENDCHAR(NUL); % X:=X-1; 'END; %WAIT(LINESP DIV 50); #END;  END;  END; !  (*----CONVERT STRING TO INTEGER-------*) "  FUNCTION CVI(ASCII:STRING):INTEGER;   VAR MPY,X,RV:ATUS(TRE) DO ! BEGIN #IF GETSTATUS(RRF) # AND (NOT SENDINGFILE) THEN &WRITECHR(CHR(PEEK(DATA))); "END;  POKE(DATA,ORD(CH)); !IF DUPLEX=HALF THEN WRITECHR(CH); !IF SENDINGFILE THEN "BEGIN #WAIT(CHRSP DIV 50); #IF (CH=CR) THEN $BEGIN DEM II I/O ROUTINES *) $  (*$IDC.XFER.TEXT*) (* PROTOCOL FILE TRANSFER *)   (*$IDC.DIR.TEXT*) (* DIRECTORY LISTER AND AUTODIAL *)    (*----SEND CHARACTER TO MODEM ---*)   PROCEDURE SENDCHAR(CH:CHAR);  VAR X:INTEGER;  BEGIN !WHILE NOT GETSTXT*) (* GLOBALS FOR DATACOM *)    PROCEDURE WRITECHR(CHM:CHAR);  FORWARD;   PROCEDURE NEXTSTRING(VAR BUFR:STRING);  FORWARD;   PROCEDURE COMMAND;  FORWARD;   PROCEDURE EXECUTE(INPUTLINE:STRING);  FORWARD;   (*$IDC.IO.TEXT*) (* MICROMO   PROGRAM DATACOMM;  (*$C COPYRIGHT 1981, HAYES MICROCOMPUTER PRODUCTS,INC.*)  (* RELEASE 1.1 FEB-20-81 *)  (* WRITTEN BY DALE A. HEATHERINGTON *)   (*$I-*)  (*$S+*)  (*$G+*)  (*$R-*) (* RANGE CHECKING OFF FOR SPEED *)   (*$IDC.GLO.TEYNTAEDITCORELE,DUMMY[0],1,0); #Y:=BLOCKWRITE(CBFILE,DUMMY[0],1,1); "END; !X:=BLOCKWRITE(CBFILE,CAPBUFR[1],BLOCKS,R); !IF X MOD 2<>0 THEN !Y:=BLOCKWRITE(CBFILE,DUMMY[0],1); ! !IF IORESULT=0 THEN CLOSE(CBFILE,LOCK); ! !IF (IORESULT=0) AND (X=BLOCKS) THEN #WRITELN('CAPTURE BUFFER -------> "',TEMPBUF,'"') "ELSE WRITELN('DISK WRITE ERROR #',IORESULT); !END; !  END;   (*--SEND A DISK FILE TO MODEM-------*)    PROCEDURE SEND;    VAR F:FILE; $X,N,R,I:INTEGER; "TXBUF:PACKED ARRAY [0..511] OF CHAR; "IF TEMPBUF='7E2' THEN FSW:= 1; "IF TEMPBUF='7O2' THEN FSW:= 5; "IF TEMPBUF='7E1' THEN FSW:= 9; "IF TEMPBUF='7O1' THEN FSW:=13; "IF TEMPBUF='8N2' THEN FSW:=17; "IF TEMPBUF='8N1' THEN FSW:=21; "IF TEMPBUF='8E1' THEN FSW:=25; "IF TEMPBUF='8O1' THEN F:=CVI(TEMPBUF);  END;   (*-----------------------------------*)   PROCEDURE DPS; (*SETS DATA BITS,PARITY, 5AND STOP BITS*)    VAR CH:CHAR; %I:INTEGER; % %  BEGIN  "NEXTSTRING(INPUTBUF); "I:=FSW; "FSW:=0; --------------------------------*)  PROCEDURE BYE;  "BEGIN $SETCR2(TXE,FALSE); $SETCR2(OH,FALSE); $WRITELN('* HUNG UP *'); "END; " "  (*-GIVES INT. VALUE OF NEXT STRING---*)   FUNCTION INTVAL:INTEGER;  BEGIN "NEXTSTRING(INPUTBUF); "INTVALR),' BYTES LEFT'); "WRITELN('LAST NUM.= ',LASTNUM);  WRITELN('PREFIX = ',PREFIX);  END; "  (*----------------------------------*)   PROCEDURE SETMODE;   BEGIN  !IF TEMPBUF='FULL' THEN #DUPLEX:=FULL %ELSE DUPLEX:=HALF; %  END;  (*---"WRITELN('LN SPACE = ',LINESP); "WRITELN('FOLD = ',FOLD); "WRITELN('PAGE CHG.= ',ORD(PAGECHG)); "WRITELN('ESCAPE = ',ORD(ESC)); "WRITELN('BREAK CHR= ',ORD(BRK)); "WRITELN('BREAK LEN= ',BRKLEN,' MS'); "WRITELN('CAPTURE = ',CB,',',(CBSIZE-CBPNTRITELN('MODE = ',M); "WRITELN('SPEED = ',S); "WRITELN('DATA BITS= ',DB); "WRITELN('PARITY = ',P); "WRITELN('STOP BITS= ',SB); "WRITELN('AUTO LF = ',ALF); "WRITELN('NULLS = ',NULLS); "WRITELN('CH SPACE = ',CHRSP); ELSE D:='FULL'; % "IF MCR2.BITHALF[BRS] THEN S:='300' %ELSE S:='110'; % "IF CBFLAG THEN CB:='ON' %ELSE CB:='OFF'; " "IF FOLDFLAG THEN FOLD:='ON' %ELSE FOLD:='OFF'; % "IF AUTOLF THEN ALF:='ON' %ELSE ALF:='OFF'; % "WRITELN('DUPLEX = ',D); "WE'; "END; " "CASE FSW OF "1,5,17: SB:='2'; "9,13,21,25,29:SB:='1'; "END; " "CASE FSW OF "1,5,9,13: DB:='7'; "17,21,25,27: DB:='8'; "END; " "IF MCR2.BITHALF[MODE] THEN M:='ORIG' %ELSE M:='ANSW'; % "IF DUPLEX=HALF THEN D:='HALF' %!TRANSLATE[X]:=CVI(TEMPBUF);  END;  (*----------------------------------*)  PROCEDURE TYPESTAT;    VAR ALF,FOLD,M,S,DB,P,SB,D,C,CB:STRING[10];   BEGIN " "CASE FSW OF "1,9,25: P:='EVEN'; "5,13,29: P:='ODD'; "17,21: P:='NON'ERROR #',IORESULT);  SENDINGFILE:=FALSE;  CBFLAG:=OLDCBFLAG;  END;    (*--SETUP KEYBOARD TRANSLATE--------*)   PROCEDURE XLATE;  BEGIN !NEXTSTRING(INPUTBUF); !X:=CVI(TEMPBUF); !REPEAT "NEXTSTRING(INPUTBUF); !UNTIL TEMPBUF<>'TO'; G:=OLDCBFLAG; +SENDINGFILE:=FALSE; +EXIT(SEND); +END; (IF (CH<>CHR(0)) AND (DUPLEX<>HALF) THEN WRITECHR(CH); 'UNTIL (I=512)  UNTIL (N=0) OR (IORESULT<>0); $CLOSE(F); $END; "IF IORESULT=0 THEN WRITELN(BELL,TEMPBUF,' SENT.')  ELSE WRITELN(2; +WHILE XCHR(31)) THEN .SENDCHAR(CH); * (LAST:=CH; (I:=I+1; ( IF KBRDY THEN KEY:=READKEY; (IF (KEY=ESC) OR (GETSTATUS(CD)) THEN +BEGIN +CLOSE(F); +CBFLA!RESET(F,TEMPBUF); (*OPEN FILE*) !IF IORESULT=0 THEN #BEGIN  REPEAT &N:=BLOCKREAD(F,TXBUF[0],1,R); &IF IORESULT=0 THEN &I:=0; R:=R+1; &IF N>0 THEN 'REPEAT (CH:=TXBUF[I]; (IF LAST=CHR(16) )THEN (*EXPAND INDENT CODE*) + +BEGIN +X:=3 KEY,DLE,LAST,CH:CHAR;  OLDCBFLAG:BOOLEAN;    BEGIN !OLDCBFLAG:=CBFLAG; !CBFLAG:=FALSE; !LAST:=' '; DLE:=CHR(12); KEY:=' ';  R:=2; (*TEXT FILES START AT RECORD 2*)  SENDINGFILE:=TRUE; !NEXTSTRING(INPUTBUF); (*GET FILE NAME*) ! SW:=29; "  IF FSW=0 THEN &BEGIN (FSW:=I; (WRITELN('BAD DPS VALUE'); (WRITELN('GOOD VALUES ARE:'); (WRITELN('7E2,7O2,7E1,7O1,8N2,8N1,8E1,8O1'); &END; $POKE(CR1,FSW); $  END;   (*-----------------------------------*)   ( (  FUNCTION DIAL(FONENUM:STRING):BOOLEAN;   VAR I,L: INTEGER;  DIG: CHAR;   #BEGIN (FONENUM:=CONCAT(PREFIX,FONENUM); (L:=LENGTH(FONENUM); (I:=1; (WRITELN; (WRITE('MICROMODEM II DIALING: '); (SETCR2(OH,TRUE); (*GO OFF HOOK*) (WAIT(40); (*WAIT 2 PROCEDURE SPEED;   BEGIN "NEXTSTRING(INPUTBUF); "IF TEMPBUF='300' THEN SETCR2(BRS,TRUE); "IF TEMPBUF='110' THEN SETCR2(BRS,FALSE); "IF (TEMPBUF<>'110') AND (TEMPBUF<>'300') $THEN WRITELN $('INVALID SPEED "',TEMPBUF,'"');  END;   (*----------E THEN (BEGIN *PRINT:=FALSE; *WRITELN('PRINTER NOT READY'); *EXIT(PRINTERCRL); (END; &PRNSTAT:=PRNSTAT+I; &INPTR:=0; OUTPTR:=0; &WRITELN('PRINTER ENABLED'); &CBFLAG:=FALSE; &CBPNTR:=1; $END; "END;   (*------------------------------------*) $BEGIN &I:=192; DONE:=FALSE; &PRNSTAT:=-16384+256*PRNSLOT; &PRNDATA:=-16256+16*PRNSLOT; &REPEAT (X:=PEEK(PRNSTAT+I); (Y:=PEEK(PRNSTAT+I-64); (IF (X<128) AND (Y>127) THEN DONE:=TRUE; (IF NOT DONE THEN I:=I+1; &UNTIL DONE OR (I=192+63); &IF NOT DONUFFER WILL BE DESTROYED.'); 'WRITELN('TYPE C TO CONTINUE OR ANY'); 'WRITELN('OTHER KEY TO ABORT'); 'READ(CH); 'IF CH<>'C' THEN EXIT(PRINTERCRL); %END; "PRINT:=P; "IF PRINT THEN (* FIND BYTE IN PRINTER CARD ROM 3TO USE FOR STATUS CHECKING *) "  (*------------------------------------*)   PROCEDURE PRINTERCRL;  VAR DONE,P:BOOLEAN;  CH:CHAR;  X,Y,I:INTEGER;  BEGIN "P:=ONOFF; "IF (CBPNTR>1) AND P THEN %BEGIN 'WRITELN('**WARNING.. THE ',CBPNTR,' BYTES'); 'WRITELN('IN THE CAPTURE BCAPTURING NOT ALLOWED WHEN PRINTING'); (EXIT(CAPTURE); &END; "IF TEMPBUF='ON' THEN CBFLAG:=TRUE; "IF TEMPBUF='OFF' THEN CBFLAG:=FALSE; "IF TEMPBUF='CLEAR' THEN #BEGIN $FILLCHAR(CAPBUFR[0],CBSIZE,CHR(0)); $CBPNTR:=1; #END; (  END;  ); & $CBFLAG:=SAVEFLAG; & $END #ELSE WRITELN('CAPTURE BUFFER EMPTY');  END;  (  (*---------------------------------*)   PROCEDURE CAPTURE;   BEGIN " "NEXTSTRING(INPUTBUF); "  IF PRINT AND (TEMPBUF<>'OFF') THEN &BEGIN (WRITELN(BELL,'R;  CH:CHAR; $SAVEFLAG:BOOLEAN;   BEGIN  CH:=CHR(0); !IF CBPNTR>1 THEN #BEGIN " PNTR:=1; $SAVEFLAG:=CBFLAG; $CBFLAG:=FALSE; &REPEAT (WRITECHR(CAPBUFR[PNTR]); & IF KBRDY THEN CH:=READKEY; (PNTR:=PNTR+1; &UNTIL (CH=ESC) OR (PNTR=CBPNTR"IF CHM>CHR(31) THEN HPOS:=HPOS+1; "IF CHM=CHR(8) THEN &BEGIN (IF HPOS=0 THEN HPOS:=41; (HPOS:=HPOS-1; &END; "IF CHM<>LF THEN WRITE(CHM);  END; (*WRITECHR*)   (*------------------------------------*)   PROCEDURE DUMPBUFR;   VAR PNTR:INTEGE(SPCNT+32); ,CBPNTR:=CBPNTR+1; ,INDFLAG:=FALSE; *END; 'END; (*INDENT*) " "IF (NOT INDFLAG) AND (CBFLAG) THEN PUTCHAR(CHM); "IF CHM=CR THEN HPOS:=0; "IF (FOLDFLAG) AND (HPOS=40) THEN &BEGIN (HPOS:=0; (WRITE(CR); &END; BEGIN (CAPBUFR[INPTR]:=CHM; (INPTR:=INPTR+1; (IF INPTR>CBSIZE THEN INPTR:=0; &END; " "IF CBFLAG AND INDFLAG THEN 'BEGIN (*INDENT*) (IF CH=CHR(32) THEN SPCNT:=SPCNT+1 )ELSE *BEGIN ,CAPBUFR[CBPNTR]:=DLE; ,CBPNTR:=CBPNTR+1; ,CAPBUFR[CBPNTR]:=CHRSE; (WRITELN; (WRITELN(BELL,'CAPTURE BUFFER FULL'); (WRITELN('TYPE '); (READLN(CH); &END %ELSE IF OK THEN CBPNTR:=CBPNTR+1; #IF CH=CR THEN %BEGIN 'INDFLAG:=TRUE; 'SPCNT:=0 %END #END; (*PUTCHAR*) " #  BEGIN (*WRITECHR*) "IF PRINT THEN & (*-----------------------------------*)   PROCEDURE WRITECHR;  !PROCEDURE PUTCHAR(CH:CHAR); !VAR OK:BOOLEAN; ! "BEGIN (*PUTCHAR*) $ OK:= (CH=CR) OR (CH>CHR(31)); $IF OK THEN CAPBUFR[CBPNTR]:=CH; $IF CBPNTR=CBSIZE-2 THEN &BEGIN (CBFLAG:=FAL SECONDS*) (WHILE L>0 DO )BEGIN )DIG:=FONENUM[I]; )WRITE(DIG); )DIALDIGIT(DIG); )I:=I+1; L:=L-1; ( IF READKEY=ESC THEN ,BEGIN -SETCR2(OH,FALSE); -DIAL:=FALSE; -EXIT(DIAL); ,END; (END;  WRITELN; #DIAL:=TRUE; #END;  -------------------------*)   PROCEDURE TERMINAL;   VAR TIME: INTEGER;  BEGIN ! IF GETSTATUS(CD) THEN !BEGIN "SETCR2(OH,FALSE); "SETCR2(MODE,TRUE);(*ORIG. MODE*) %NEXTSTRING(INPUTBUF); %IF TEMPBUF='LAST' THEN 'FONENUM:=LASTNUM (ELSE )BEGIN *LASTNUM:=TEMPBUF; *FONENUM:=TEMPBUF; ( END; ( %IF NOT DIAL(FONENUM) THEN EXIT(TERMINAL); %IF KBRDY THEN CH:=READKEY; %WRITELN('WAITING FOR CARRIER'); %TIME:=30; %WHILE NOT KBRDY AND GETSTATUS(CD) 0AND (TIME>0) DO % BEGIN 'X:=PEEK(DATA); (*WAK$IF TEMPBUF='LINESPACE' THEN SEL:=21; $IF TEMPBUF='AUTOLF' THEN SEL:=22; # IF TEMPBUF='DIR' THEN SEL:=23; # IF TEMPBUF='PREFIX' THEN SEL:=24; # IF TEMPBUF=' ' THEN SEL:=25; # IF TEMPBUF='XMIT' THEN SEL:=26; $IF TEMPBUF='RECV' THEN SEL:=2LS' THEN SEL:=14; # IF TEMPBUF='FOLD' THEN SEL:=15; # IF TEMPBUF='PAGE' THEN SEL:=16; # IF TEMPBUF='ESCAPE' THEN SEL:=17; # IF TEMPBUF='BREAK' THEN SEL:=18; # IF TEMPBUF='BREAKLEN' THEN SEL:=19; # IF TEMPBUF='CHARSPACE' THEN SEL:=20; T' THEN SEL:=7; # IF TEMPBUF='STAT' THEN SEL:=8; # IF TEMPBUF='SPEED' THEN SEL:=9; # IF TEMPBUF='CAPTURE'THEN SEL:=10; # IF TEMPBUF='TYPE' THEN SEL:=11; # IF TEMPBUF='SAVE' THEN SEL:=12; # IF TEMPBUF='SEND' THEN SEL:=13; # IF TEMPBUF='NULBUF='DIAL' THEN SEL:=1; $IF TEMPBUF='ANSWER' THEN SEL:=2; $IF TEMPBUF='DPS' THEN SEL:=3; $IF TEMPBUF='FULL' THEN SEL:=4; $IF TEMPBUF='HALF' THEN SEL:=4; $IF TEMPBUF='BYE' THEN SEL:=5; " IF TEMPBUF='XLATE' THEN SEL:=6; # IF TEMPBUF='EXI"IF READKEY=ESC THEN EXIT(ANSWER); !UNTIL NOT GETSTATUS(CD); !TERMINAL; !END;   (*-----------------------------------*)   PROCEDURE EXECUTE;  VAR SEL:INTEGER;   BEGIN " "BUFPNTR:=1; "REPEAT " $NEXTSTRING(INPUTLINE); " SEL:=0; $IF TEMP(MODE,FALSE); "SETCR2(TXE,TRUE); "WRITELN('WAITING FOR CARRIER...'); "TIMEOUT:=0; "REPEAT #WAIT(20);(*WAIT 1 SECOND*) #TIMEOUT:=TIMEOUT+1; " X:=PEEK(DATA);(*WAKE UP SLEEPING ACIA*) "UNTIL (TIMEOUT=30) OR (NOT GETSTATUS(CD)) *OR (READKEY=ESC); AIT(1); 'TIMEOUT:=TIMEOUT+1; 'IF TIMEOUT=200 THEN )BEGIN *COUNTER:=0; *TIMEOUT:=0; )END; &END; $WHILE RING DO BEGIN END; $COUNTER:=COUNTER+1; $TIMEOUT:=0; #UNTIL COUNTER=RINGS; "END; "WRITELN('ANSWERING CALL',BELL); "SETCR2(OH,TRUE); "SETCR2EGIN !NEXTSTRING(INPUTBUF); !RINGS:=CVI(TEMPBUF);  COUNTER:=0; !REPEAT "SETCR2(OH,FALSE); "WRITELN('WAITING FOR ',RINGS,' RING(S)'); "COUNTER:=0; "IF RINGS>0 THEN "BEGIN #REPEAT %WHILE NOT RING DO &BEGIN 'IF READKEY=ESC THEN EXIT(ANSWER); 'W!UNTIL (GETSTATUS(CD)) OR (NOT MCR2.BITHALF[OH]); !IF MSTATUS.BITHALF[CD] THEN #BEGIN %WRITELN(BELL,'LOST CARRIER'); %BYE #END "   END;  (*-----------------------------------*)   PROCEDURE ANSWER;  VAR X,RINGS,COUNTER,TIMEOUT:INTEGER;   BLSE IF (CHK<>PAGECHG) AND (CHK<>ESC) /THEN SENDCHAR(CHK); &END; # #TRIX.ADDRESS:=STATUS; #IF ODD(TRIX.POINTER^[0]) THEN &BEGIN (CHM:=CHR(PEEK(DATA)); (IF (CHM<>DEL) AND (CHM<>NUL) THEN WRITECHR(CHM); &END; ! TRIX.ADDRESS:=STATUS; #IF ODD(TRIX.POINTER^[0]) THEN &BEGIN (CHM:=CHR(PEEK(DATA)); (IF (CHM<>DEL) AND (CHM<>NUL) THEN WRITECHR(CHM); &END; ! &IF KBRDY THEN &BEGIN 'CHK:=READKEY; 'IF CHK=ESC THEN COMMAND; 'IF CHK=BRK THEN SENDBREAK(BRKLEN) )ER(PEEK(DATA)); (IF (CHM<>DEL) AND (CHM<>NUL) THEN WRITECHR(CHM); &END; & &IF KBRDY THEN &BEGIN 'CHK:=READKEY; 'IF CHK=ESC THEN COMMAND; 'IF CHK=BRK THEN SENDBREAK(BRKLEN) )ELSE IF (CHK<>PAGECHG) AND (CHK<>ESC) /THEN SENDCHAR(CHK); &END; # #!HPOS:=0; !IF KBRDY THEN CH:=READKEY; !IF GETSTATUS(RRF) THEN CH:=CHR(PEEK(DATA)); !CHK:=CHR(0); !CHM:=CHR(0); !WRITELN; !WRITELN(BELL,'CONNECTION ESTABLISHED'); ! !REPEAT #TRIX.ADDRESS:=STATUS; #IF ODD(TRIX.POINTER^[0]) THEN &BEGIN (CHM:=CHE UP ACIA*) 'WAIT(20);(* WAIT 1 SECOND*) 'TIME:=TIME-1; (*WAIT FOR CARRIER*) &END; % %IF GETSTATUS(CD) THEN +BEGIN ,WRITELN(BELL,'NO CARRIER'); ,SETCR2(OH,FALSE); ,EXIT(TERMINAL); +END; % ' !END; ! !SETCR2(OH,TRUE); !SETCR2(TXE,TRUE); 7; # IF TEMPBUF='PRINTER'THEN SEL:=28; # IF TEMPBUF='RDYLOC' THEN SEL:=29; # IF TEMPBUF='CALL' THEN SEL:=30; # #CASE SEL OF &0: WRITELN('INVALID COMMAND"',TEMPBUF,'"'); &1: TERMINAL; &2: ANSWER; &3: DPS; &4: SETMODE; &5: BYE; # 6: XLATE; # 7: QUIT; # 8: TYPESTAT; # 9: SPEED; # 10: CAPTURE; # 11: DUMPBUFR; # 12: CBSAVE; # 13: SEND; # 14: NULLS:=INTVAL; # 15: FOL á N*****LOST CARRIER18š ȡ  *ع<ҦMESSAGEתP]ҦACKתPOҦNAKתPAҦEOTתP3,C =@((šmkloǀɩkl˄nllll8Jšlx š Nȡ   * rǀɡs`2 s*á( :سs*0á 0 ګ((D*ػr((*p()() '''' Ǭ?ǫ?(  ǀ??@šǀ+ھá á ' &^  ǀ?(('( DATACOMM AYES MICROCOMPUTER PRODUCTS, INC.'); ! !REPEAT !COMMAND; !UNTIL RETSYS $  END. " CHR(27); "RUBOUT:=CHR(127); ! DEL:=RUBOUT; ! NUL:=CHR(0); !FILLCHAR(CAPBUFR[0],CBSIZE,CHR(0)); !PAGE(OUTPUT); !WRITELN(' ***** DATACOMM VER 1.1 ****'); !WRITELN(' MICROMODEM II TERMINAL PROGRAM'); !WRITELN('COPYRIGHT 1981 HSP :=0; #SPCNT:=0; !INDFLAG:=FALSE; !LASTNUM:='NONE'; "BRKLEN:=150;(*150 MS BREAK TIME*) "CBPNTR:=1; "RETSYS:=FALSE; !PAGECHG:=CHR(1); $BELL:=CHR(7); &BS:=CHR(8); &LF:=CHR(10); &FF:=CHR(12); &CR:=CHR(13); %DLE:=CHR(16); %BRK:=CHR(23); %ESC:=!FOR X:=0 TO 127 DO TRANSLATE[X]:=X; !MCR2.BYTEHALF:=SETT+MODE; !SETCR2(SETT,TRUE); !POKE(CR1,3); (*RESET ACIA CHIP*) !INPUTBUF:='FULL DPS 7E1 NULLS 0 CAPTURE OFF FOLD ON'; !EXECUTE(INPUTBUF); # "PRINT :=FALSE; " "AUTOLF:=TRUE; "LINESP:=0; "CHR:=CR1; !DATA:=CR2+2; ! !IF PEEK(-15616)=44 THEN %BEGIN 'WRITE('IS THERE AN 80 COLUMN BOARD IN SLOT 3?'); 'REPEAT )READ(CH); )IF CH='N' THEN XCONSOLE:=TRUE; 'UNTIL (CH='Y') OR (CH='N'); %WRITELN; %END !ELSE #XCONSOLE:=FALSE;  GE THEN FLIPPAGE; #UNITCLEAR(1); #WRITELN; #WRITE('COMMAND: '); #READLN(INPUTBUF); #EXECUTE(INPUTBUF);  END;   (*---------------------------------*)   BEGIN !PREFIX:=' '; (* PHONE NUMBER PREFIX*) !CR2:=-16251+16*SLOT; !CR1:=CR2+1; !STATUS WRITELN(RDYLOC); $ 30: BEGIN 2NEXTSTRING(INPUTBUF); 2CALL(TEMPBUF); 0END; $END; # "UNTIL LINEEND "  END;   (*---------------------------------*)   PROCEDURE COMMAND;  VAR I:INTEGER;  BEGIN #SENDINGFILE:=FALSE; #IF NOT PRIMPA# 24: BEGIN 1NEXTSTRING(INPUTBUF); 1PREFIX:=TEMPBUF; 0END; # 26: BEGIN 2NEXTSTRING(INPUTBUF); 2TRANSFER('S',TEMPBUF); 0END; %27: BEGIN 2NEXTSTRING(INPUTBUF); 2TRANSFER('R',TEMPBUF); 0END; %28: PRINTERCRL; %29: DFLAG:=ONOFF; # 16: PAGECHG:=CHARVAL; # 17: ESC:=CHARVAL; # 18: BRK:=CHARVAL; # 19: BRKLEN:=INTVAL; # 20: CHRSP:=INTVAL; %21: LINESP:=INTVAL; %22: AUTOLF:=ONOFF; # 23: LDIR(INTVAL);  "$&(*Mz ń   áš q ۮMZ   áqخ*2 .öÍ˶צNO SOHP2á222ˡ ߸˶ 2Ŷ22˶ҦNO ETXתP  ́0ʁ0 ʁ1$&ʁ-˩t˄ʁ-)á+Þ"ˍ"á+ SENT. ERROR #" ʁ1$a%vbn&! צTO+!4'"+צDISK WRITE ERROR #" %Ɓ-$́1$ ́. ́/ ́0*"á-*+"á)**+š-)́-ʁ.á ,,ʁ-ɡ ,,ʁ-ʁ-ōʁ- ʁ-́.)) ? (Y/N)YNÍYáRf$ vvˡw"á⥀:ˡwwwˡw"áw"Ä=CAPTURE BUFFER -------> "n!۾ھáōګ š!ەLiz ! "צONOFFׯ,#"*LWANT TO HANG UP FIRSTƁP+&V  qqtá+2 ةá # š  2 ^ f ڪP/-.0.0ġ0.-/.0-/ /..->Z Z!  +ƁZ+צ LOOKING FOR ...+ ʁ"Ä%+ƁZP+ ƁŹʁ2צ NOT FOUND!+-ƁŹYƁZʁYƁZP+ʁX 6ݤ ̊WʊWʊUń=ʊWʊW   ʊWʊŮUƅ I qتP+ƁW+MM2:DC.DATA.TEXT"ˡ.צMM2:DC.DATA.TEXT NOT FOUND́́XƁP?9+ "Ä +ƁZP̀ʀ" RECEIVEDSá-TRANSMITTING FILE...̀s1Yƀ ƅ Ɔ50Ɔ6 Ɔ6 ̊VʊVʊV̊USIZE FILE NAMEM̊VʊVȡ^ƆXšZ MESSAGE LOSTתPZZ FILE RECEIVEDׯ-UB@تP1Ɓ]YƁƀƁPROTOCOL FILE TRANSFER ,VER 1.0́sRá`צ WAITING TO RECEIVE BLOCK ZERO...FILEPV̀XYYáʀÍW-WVU"ˡZDISK WRITE ERRORתPWVURECEIVED BLOCK V VVVUáʀ̀̀XʀYỲʀXXYá ʀXXYXÍ-RETRANSMITTING BLOCK V ʀVV- -WWWWÍWáYצEOT LOSTPYYצ FILE SENT-\g]K.ڪP-ƁYZ FILE RECEIVEDתP-"ˡZצERROR IN OPENING RRORתPSENDING צ, BLOCK V WXX;UUUXXUÍXYצ BAD RESPONSEPXáYTRANSMISSION ABORTEDתPXá̀Xá_WẀWá!YצABORTED, TOO MANY RETRYSPBצخˡ%צ * SENDING خá.ȡپ ڪP-ƁYY FILE SENTתP-"ˡYצNO FILEPVV-VUU˞"ˍYDISK READ Elˡצ CRC ERRORPM޹B=83,#  "$&(*6ޮҦTIMEOUTתPˡ$צ RECEIVEDG:   2&EVENת ZצODD NצNONE A:-( =8 4$&(<,.0]468X2 H1 A: & 5$&(6,.0>468F7 D8 =6 %- .$&(6,.0>4B* +ORIGת +צANSW tá HALFת צFULL * %צ300 %צ110 $ צON OFFת & 1ONת 1צOFF # 7צON 7OFFת צ DUPLEX =  צ MODE = +צ+HALFׯ+צBYE+צXLATE+צEXIT+STATׯ+צSPEED +צCAPTURE +צTYPE +SAVEׯ +צSEND +NULLSׯ+FOLDׯ+צPAGE+ESCAPEׯ+צBáצANSWERING CALLWAITING FOR CARRIER... q Í á4 3?<4تP +צDIAL+ANSWERׯ+צDPS+צFULLq˩˄ *)'צ LOST CARRIER*s N3!צ WAITING FOR  צ RING(S)š@$ á4 á  qCONNECTION ESTABLISHEDp((q˩˄ , áá˩˄ p((q˩˄ , áá˩˄ p(("Dz2 LASTׯ ȥժեȥ-3  WAITING FOR CARRIER  ńq   +צ NO CARRIER3 oۂ@ǀńٓ?Íٓ(mצPRINTER NOT READY1oۂoklPRINTER ENABLED$vF 1צ300110ׯצ110300׷1INVALID SPEED "؄**WARNING.. THE v צ BYTESצ(IN THE CAPTURE BUFFER WILL BE DESTROYED.צTYPE C TO CONTINUE OR ANYOTHER KEY TO ABORTCˡ1ثmm@oǀ?noۂ$ؾ  ٩ةvÍګ$$צCAPTURE BUFFER EMPTYO j/mצOFF@#CAPTURING NOT ALLOWED WHEN PRINTING0צON$OFFׯ$CLEARׯ 8J v0#v ١vvةá%.mkؿkkk8Jšk$%, á vvvv vv%%$.ةá &(Ä š á á)  ةˡvš2$000i0P-.MICROMODEM II DIALING: ( -š6.///..-- á -DH -ةō١vؿv8Já^$CAPTURE BUFFER FULLצ TYPE צ7O2צ7E1 צ7O1 צ8N2צ8N1צ8E1צ8O1áo٫צ BAD DPS VALUEGOOD VALUES ARE:7E2,7O2,7E1,7O1,8N2,8N1,8E1,8O1s ,ڪP8Jv צ BYTES LEFT LAST NUM.= צ PREFIX = xx(FULLׯtt) * HUNG UP *,*!+צ7E2ACE =   FOLD = 1 PAGE CHG.=   ESCAPE =   BREAK CHR=   BREAK LEN=  צ MS CAPTURE = , SPEED = %צ DATA BITS= צ PARITY = צ STOP BITS= צ AUTO LF = 7צ NULLS =   CH SPACE =  צ LN SPREAK+צBREAKLEN+ CHARSPACEׯ+ LINESPACEׯ+AUTOLFׯ+צDIR+צPREFIX+ +צXMIT+RECVׯ+צPRINTER+צRDYLOC+CALLׯ++צINVALID COMMAND""34,)*'$(20/%&+ #&"""+++##+鹿SsRf1b RF>  PROCEDURE SENDBREAK(TIME:INTEGER);  PROCEDURE SETRATE(NEWRATE:BAUDRATE);  FUNCTION MODEMINPUT: BOOLEAN;  FUNCTION MODEMREADY: BOOLEAN;  PROCEDURE CHARFORMAT(CHARLEN:L7OR8; STOPBITS:S1OR2; PARITY:PARITYKIND);   (* FUNDAMENTAL ROUTINES *)  PROCEDUROCEDURE PICKUP;  PROCEDURE HANGUP;  FUNCTION RINGING: BOOLEAN;  PROCEDURE DIAL(NUMBER:STRING);   (* MODEM CONTROL *)  PROCEDURE SETMODE(NEWMODE:MODETYPE);  PROCEDURE TXON;  PROCEDURE TXOFF;  FUNCTION CARRIER: BOOLEAN;   (* ACIA CONTROL *) D 4RDRF: BOOLEAN; 4TDRE: BOOLEAN; 4NOTDCD: BOOLEAN; 4NOTCTS: BOOLEAN; 4FE: BOOLEAN; 4OVRN: BOOLEAN; 4PE: BOOLEAN; 4IRQ: BOOLEAN; 4UNUSEDBITS: 0..127; 4NOTRI: BOOLEAN; 4END;   VAR MODEMCONTROL: UMODEMCONTROL;   (* PHONE LINE CONTROL *)  PRTROL=PACKED RECORD 1ACIACLK: 0..3; 1WORDSEL: 0..7; 1XMITCTL: 0..3; 1RIE: BOOLEAN; 1BRS: BAUDRATE; 1TXE: BOOLEAN; 1MODE: MODETYPE; 1NOTRESET: BOOLEAN; 1SELFTEST: BOOLEAN; 1UNUSEDBITS: 0..3; 1OFFHOOK: BOOLEAN; 1END;  %UMODEMSTATUS=PACKED RECOR(*$S+*)  UNIT MICROMODEM;   INTERFACE   CONST SECONDS=100;   TYPE MODEMSLOT=1..3; %BAUDRATE=(RATE110,RATE300); %PARITYKIND=(EVENPARITY,ODDPARITY,NOPARITY);  MODETYPE=(ANSWER,ORIGINATE);  L7OR8=7..8; %S1OR2=1..2;   UMODEMCONN^C 1.1 ****צ' MICROMODEM II TERMINAL PROGRAM1COPYRIGHT 1981 HAYES MICROCOMPUTER PRODUCTS, INC."wRy.L@  \ z &Jv.Pft(\!"$.$f$$F%v%%l%(&H&j&&'I&LHHHH`R @ HZvJ~r>!"$$$H%%%6&HV&&&&''',(P(t(F 4Eתǖv"   8J  ' ***** DATACOMM VER 1.1 ****צ' MICROMODEM II TERMINAL PROGRAM1COPYRIGHT 1981 HAYES MICROCOMPUTER PRODUCTS, INC."wRy.LhhhhhhHH`(hhhhhhhhhh)E&& INá YNÍ ȡ + *sצ(FULL DPS 7E1 NULLS 0 CAPTURE OFF FOLD ONPm#%զNONEתǖv"   8J  ' ***** DATACOMM VER4vk`^P!PT ' &צ COMMAND: PDwץ {?rrssprq=,áQ&IS THERE AN 80 COLUMN BOARD IN SLOT 3?E USEMODEM(SLOT:MODEMSLOT);  PROCEDURE DCHCONTROL(CTL:UMODEMCONTROL);  PROCEDURE DCHSTATUS(VAR STATUS:UMODEMSTATUS);  PROCEDURE DELAY10MS(TIME:INTEGER);   (* STRING INPUT ROUTINE *)  PROCEDURE READMODEM(VAR MODEMIN,MODEMOUT:INTERACTIVE; VAR S:STRING; "VAR CH:CHAR);    IMPLEMENTATION   CONST IOPAGE=192; (* =$C0 *)   TYPE CHARPTR=^ CHAR;  VAR FINDMODEM: MODEMSLOT; $FOUND,MISSING: BOOLEAN; $FOOL: RECORD +CASE BOOLEAN OF -TRUE: (ADDR: PACKED RECORD =128 THEN CH:=CHR(ORD(CH)-128); &IF (CH=CHR(BS)) OR (CH=CHR(DEL)) THEN BEGIN (IF CURPOS<=1 THEN WRITE(MODEMOUT,CHR(BEL)) ADY:=STATUS.TDRE; "END;   PROCEDURE READMODEM;  CONST CR=13; BS=8; DEL=127; CAN=24; BEL=7;  VAR CURPOS,I: INTEGER;  PROCEDURE RUBOUT; !BEGIN #WRITE(MODEMOUT,CHR(BS),' ',CHR(BS)); #END;  BEGIN  S:=''; "CURPOS:=1; "REPEAT ILLEGAL *); "DCHCONTROL(MODEMCONTROL); "END;   FUNCTION MODEMINPUT;  VAR STATUS: UMODEMSTATUS;  BEGIN "DCHSTATUS(STATUS); "MODEMINPUT:=STATUS.RDRF; "END;   FUNCTION MODEMREADY;  VAR STATUS: UMODEMSTATUS;  BEGIN "DCHSTATUS(STATUS); "MODEMREORDSEL:=2*(1-STOPBITS DIV 2)+ORD(PARITY) #ELSE (* NOPARITY IS ILLEGAL *) "ELSE (* CHARLEN=8 *) #IF PARITY=NOPARITY THEN $MODEMCONTROL.WORDSEL:=4+(1-STOPBITS DIV 2) #ELSE IF STOPBITS=1 THEN $MODEMCONTROL.WORDSEL:=6+ORD(PARITY) #ELSE (* STOPBITS=2 IS "MODEMCONTROL.XMITCTL:=0; "DCHCONTROL(MODEMCONTROL); "END;   PROCEDURE SETRATE;  BEGIN "MODEMCONTROL.BRS:=NEWRATE; "DCHCONTROL(MODEMCONTROL); "END;   PROCEDURE CHARFORMAT;  BEGIN "IF CHARLEN=7 THEN #IF PARITY<>NOPARITY THEN $MODEMCONTROL.WUS(STATUS); "IF STATUS.NOTDCD THEN BEGIN $CH:=ACIADATA^; $DCHSTATUS(STATUS); $END; "CARRIER:=NOT STATUS.NOTDCD; "END;   PROCEDURE SENDBREAK;  BEGIN "MODEMCONTROL.XMITCTL:=3; "DCHCONTROL(MODEMCONTROL); "DELAY10MS(TIME); DURE TXON;  BEGIN "MODEMCONTROL.TXE:=TRUE; "DCHCONTROL(MODEMCONTROL); "END;   PROCEDURE TXOFF;  BEGIN "MODEMCONTROL.TXE:=FALSE; "DCHCONTROL(MODEMCONTROL); "END;   FUNCTION CARRIER;  VAR STATUS: UMODEMSTATUS;  CH: CHAR;  BEGIN "DCHSTAT &DCHCONTROL(MODEMCONTROL); &DELAY10MS(50); &MODEMCONTROL.OFFHOOK:=TRUE; &DCHCONTROL(MODEMCONTROL); &DELAY10MS(2*SECONDS); &END; $END; "END;   PROCEDURE SETMODE;  BEGIN "MODEMCONTROL.MODE:=NEWMODE; "DCHCONTROL(MODEMCONTROL); "END;   PROCE"FOR STRPTR:=1 TO LENGTH(NUMBER) DO BEGIN $DIGIT:=POS(COPY(NUMBER,STRPTR,1),'1234567890*#'); $IF DIGIT<>0 THEN DIALDIGIT(DIGIT) $ELSE IF NUMBER[STRPTR]='.' THEN DELAY10MS(1*SECONDS) $ELSE IF NUMBER[STRPTR]='/' THEN BEGIN &MODEMCONTROL.OFFHOOK:=FALSE; !VAR I: INTEGER; !BEGIN #FOR I:=1 TO COUNT DO BEGIN %MODEMCONTROL.OFFHOOK:=FALSE; %DCHCONTROL(MODEMCONTROL); %DELAY10MS(5); %MODEMCONTROL.OFFHOOK:=TRUE; %DCHCONTROL(MODEMCONTROL); %DELAY10MS(3); %END; #DELAY10MS(70); #END;  BEGIN L.OFFHOOK:=FALSE; "DCHCONTROL(MODEMCONTROL); "END;   FUNCTION RINGING;  VAR STATUS: UMODEMSTATUS;  BEGIN "DCHSTATUS(STATUS); "RINGING:=NOT STATUS.NOTRI; "END;   PROCEDURE DIAL;  VAR STRPTR,DIGIT: INTEGER; !PROCEDURE DIALDIGIT(COUNT:INTEGER);  BEGIN "FOR I:=TIME DOWNTO 0 DO #FOR J:=1 TO CNT10MS DO; "END;   PROCEDURE PICKUP;  BEGIN "DELAY10MS(1*SECONDS); "MODEMCONTROL.OFFHOOK:=TRUE; "DCHCONTROL(MODEMCONTROL); "DELAY10MS(2*SECONDS); "END;   PROCEDURE HANGUP;  BEGIN "MODEMCONTRO FUNCTION ISDCHAYES(SLOT:MODEMSLOT): BOOLEAN; "EXTERNAL;   PROCEDURE DCHCONTROL;  BEGIN "DCHCTL(MODEMCS,CTL); "END;   PROCEDURE DCHSTATUS;  BEGIN "DCHSTS(MODEMCS,STATUS); "END;   PROCEDURE DELAY10MS;  CONST CNT10MS=15;  VAR I,J: INTEGER;); -FALSE: (P: ^ CHAR); -END; $MODEMCS: CHARPTR;  ACIADATA: CHARPTR;   PROCEDURE DCHCTL(MODEMADDR:CHARPTR; CTL:UMODEMCONTROL);  EXTERNAL;   PROCEDURE DCHSTS(MODEMADDR:CHARPTR; VAR STATUS:UMODEMSTATUS);  EXTERNAL;  (ELSE BEGIN *RUBOUT; *CURPOS:=CURPOS-1; *END; (CH:=CHR(BS); (END &ELSE IF CH=CHR(CAN) THEN BEGIN (IF CURPOS<=1 THEN WRITE(MODEMOUT,CHR(BEL)) (ELSE BEGIN *FOR I:=CURPOS DOWNTO 1 DO RUBOUT; *CURPOS:=1; *END; (CH:=CHR(BS); (END &ELSE IF CH=CHR(CR) THEN WRITELN(MODEMOUT) &ELSE IF CH>=' ' THEN WRITE(MODEMOUT,CH); &END $ELSE CH:=CHR(DEL);  IF CH>=' ' THEN BEGIN &INSERT(' ',S,CURPOS); &S[CURPOS]:=CH; &CURPOS:=CURPOS+1; &END;  UNTIL (CH<' ') AND (CH<>CHR(BS)) OR (CH=CHR(DEL));  EN DCHCTL B82 !CMP #49 !BNE NOTDCH !LDA 0CB83 !CMP #43 !BNE NOTDCH !LDA #1 !BNE EXITDCH   NOTDCH LDA #0  EXITDCH PHA !PUSH RETURN !RTS   .END  ISDCHAYES,1 !POP RETURN !PLA !PLA !PLA !PLA !POP STATPTR !LDA #0 !PHA !CLC !LDA STATPTR !ADC #0C0 !STA STATPTR+1 !LDA #0 !STA STATPTR !LDA 0CFFF !LDA @STATPTR,Y !LDA 0CB80 !CMP #0D !BNE NOTDCH !LDA 0CB81 !CMP #4D !BNE NOTDCH !LDA 0CSTA @MODEMCS,Y !LDA @STATPTR,Y !DEY !STA @MODEMCS,Y !PUSH RETURN  RTS   .PROC DCHSTS,2 !POP RETURN !POP STATPTR !POP MODEMCS !LDY #1 !LDA @MODEMCS,Y !DEY !STA @STATPTR,Y !LDA @MODEMCS,Y !INY !STA @STATPTR,Y !PUSH RETURN !RTS   .FUNCRETURN .EQU 0  STATPTR .EQU 2  MODEMCS .EQU 4   .MACRO POP !PLA !STA %1 !PLA !STA %1+1 !.ENDM   .MACRO PUSH !LDA %1+1 !PHA !LDA %1 !PHA !.ENDM   .PROC DCHCTL,2 !POP RETURN !POP STATPTR !POP MODEMCS !LDY #0 !LDA @STATPTR,Y !INY !N^C; "DCHCONTROL(MODEMCONTROL); "MODEMCONTROL.ACIACLK:=1; "MODEMCONTROL.NOTRESET:=TRUE; "DCHCONTROL(MODEMCONTROL); "END.  N('NO MICROMODEM II'); $EXIT(PROGRAM); $END; "WITH MODEMCONTROL DO BEGIN $ACIACLK:=3; $WORDSEL:=4; $XMITCTL:=0; $RIE:=FALSE; $BRS:=RATE300; $TXE:=FALSE; $MODE:=ANSWER; $NOTRESET:=FALSE; $SELFTEST:=FALSE; $UNUSEDBITS:=0; $OFFHOOK:=FALSE; $END"MISSING:=FALSE; "WHILE NOT FOUND AND NOT MISSING DO BEGIN $FOUND:=ISDCHAYES(FINDMODEM); $MISSING:=NOT FOUND AND (FINDMODEM=1); $IF NOT MISSING AND NOT FOUND THEN FINDMODEM:=FINDMODEM-1; $END; "IF FOUND THEN USEMODEM(FINDMODEM) "ELSE BEGIN $WRITELD;   PROCEDURE USEMODEM;  VAR TEMP: INTEGER;  BEGIN "TEMP:=SLOT*16+128; "FOOL.ADDR.HI:=IOPAGE; "FOOL.ADDR.LO:=TEMP+5; "MODEMCS:=FOOL.P; "FOOL.ADDR.LO:=TEMP+7; "ACIADATA:=FOOL.P; "END;   BEGIN "FINDMODEM:=3; "FOUND:=FALSE; 'II.0 [d.4]hhhhhhȑHH`.hhhhhhȑHH`.hhhhhhhhHiϱ MI CHHH`V^DCHCTL DCHCTL DCHSTS DCHSTS ISDCHAYE ISDCHAYE