`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$JN^8gLOG.TEXTg GETIME.TEXT! STRFORT.TEXTaCLOCKUNIT.TEXTaCLKUNT1.1.CODE!CLOCK.DOC.TEXTҢ STARTUP.TEXTRKP MICRO.LINKRPTFULLDUPLEX.CODEbTW SYSGEN.CODERWY STARTUP.CODERYeMODEMTEST.TEXTe MODEM.LIBRARYFILER.IMPL.CODE蠍 LIST.TEXTg ANSWER.TEXTg ANSWER.CODESYMO-CL TIMERSTUFF.TEXT8 MICROMODEM.TEXT$NATIVECODE.TEXTB$0 MICRO.TEXTB06 SYSGEN.TEXTB6: STARTGEN.TEXTB:B FULL.TEXTRBENATIVECODE.CODEREK MICRO.CODE&꽌ɪɖ'*&%&,E'зЮ꽌ɪФ`+*xH&x'8*7Ixix&&  ') + &п x) ++`FG8`0($ p,&") (jJJ>L+ "?I>  N `  ` x V Nx .x- z `V0^*^*>` aI꽌ɪVɭ&Y&&Y& 꽌ɪ\8`&(*S+*)  UNIT TIMERSTUFF;   INTERFACE #PROCEDURE INITTIMERS; #PROCEDURE STARTTIMER(I: INTEGER); #PROCEDURE STOPTIMER(I: INTEGER); #PROCEDURE SHOWTIMERS; #  IMPLEMENTATION   CONST #CLOCKSLOT = 4;  MAXCLOCKS = 20;   TYPE #TIME = PACKED A=3; &C8BITS=21; #DATA=-16249; ! !TYPE $TRIX=RECORD *CASE BOOLEAN OF +FALSE:(ADDRESS:INTEGER); +TRUE:(MEMORY:^CHAR); *END; $BBITS=PACKED ARRAY[0..7] OF BOOLEAN; $ $BTRIX=RECORD +CASE BOOLEAN OF ,FALSE:(ADDRESS:INTEGER); ,TRUE:(BITS:^BBITS); ; $DIALDELAY=1200; $A2SECDELAY=3400; $  SLOTX16=32; $MODEM=-16251; &MOFFHOOK=128; &MINIT=8; &MORIG=4; &MXMTE=2; &M300BAUD=1; #STATUS=-16250; &SPE=64; &SOVRN=32; &SFE=16; &SRESET=8; &SCD=4; &SXRDY=2; &SRRDY=1; #CONTROL=-16250; &CINIT   (*$S+*)  UNIT MICROMODEM;   INTERFACE #FUNCTION MMKEYPRESS:BOOLEAN; #FUNCTION MMDIALER(NUMBER:STRING):BOOLEAN; #FUNCTION MMANSWER(TIMINGENABLED:BOOLEAN):BOOLEAN; #PROCEDURE MMHANGUP; #  IMPLEMENTATION #CONST $DIALPULSE=120; $DIALPAUSE=60N^TH(STR1) - 2); &WRITELN(I:4, STR1:15, STR2:12) #END; #WRITE('PRESS ANY KEY TO CONTINUE:'); #READ(CH); #PAGE(OUTPUT)  END;   BEGIN (* MAIN PROGRAM *) #TPTR := CLOCKPOINTER(CLOCKSLOT);  END.  R1, STR2: STRING; #  BEGIN #PAGE(OUTPUT); #WRITELN; #WRITELN('TIMER # TIME (SEC) # OF RUNS'); #WRITELN('------- ---------- ---------'); #FOR I := 1 TO MAXCLOCKS DO BEGIN &STR(TTIME[I], STR1); &STR(NCALLS[I], STR2); &INSERT('.', STR1, LENGTIMER;   BEGIN #TICK(TIMER[I]);  NCALLS[I] := NCALLS[I] + 1  END;   PROCEDURE STOPTIMER;   VAR #T: MILLIE; #  BEGIN #TICK(T); #TTIME[I] := TTIME[I] + T - TIMER[I]  END;   PROCEDURE SHOWTIMERS;   VAR #I: INTEGER; #CH: CHAR; #ST#M := 10 * M + T[3] MOD 16; #M := 10 * M + T[4] DIV 16; #M := 10 * M + T[4] MOD 16  END;   PROCEDURE INITTIMERS;   VAR #I: INTEGER; #  BEGIN #FOR I := 1 TO MAXCLOCKS DO BEGIN &NCALLS[I] := 0; &TTIME[I] := 0 #END  END;   PROCEDURE STARTEC.SELECT := ADDRESS; #CLOCKPOINTER := ADREC.PTRADR  END;   PROCEDURE TICK(VAR M: MILLIE);   VAR #T: TIME;   BEGIN #T := TPTR^; #M := T[0] MOD 32; #M := 256 * M + T[1]; #M := 256 * M + T[2]; #M := 16 * M + T[3] DIV 16; ILO = 1024;   TYPE #ADRTYPE = (NUMBER, ADDRESS);   VAR #ADREC: RECORD ,CASE SELECT: ADRTYPE OF /NUMBER: (NUMADR: INTEGER); /ADDRESS: (PTRADR: ^TIME) ,END;   BEGIN #ADREC.SELECT := NUMBER; #ADREC.NUMADR := 48 * KILO + 16 * (8 + SLOT); #ADRRRAY [0..4] OF 0..255; #TIMEPTR = ^TIME; #MILLIE = INTEGER[11];   VAR #TPTR: TIMEPTR;  TIMER, TTIME: ARRAY[1..MAXCLOCKS] OF MILLIE;  NCALLS: ARRAY[1..MAXCLOCKS] OF INTEGER[6];   FUNCTION CLOCKPOINTER(SLOT: INTEGER): TIMEPTR;   CONST #K+END; $VAR &DIGIT:INTEGER; &I,J:INTEGER &CD,RI:BOOLEAN &  PROCEDURE WAIT(HOWLONG:INTEGER);   VAR DELAY:INTEGER;  BEGIN "FOR DELAY:=1 TO HOWLONG DO;  END (*WAIT*);   FUNCTION MMGETSTATUS(BITNUMBER:INTEGER):BOOLEAN;  !VAR MMII:BTRIX; !BEGIN #MMII.ADDRESS:=STATUS+SLOTX16; #MMGETSTATUS:=MMII.BITS^[BITNUMBER]; !END (*MMGETSTATUS*); !  FUNCTION MMGETMODEM(BITNUMBER:INTEGER):BOOLEAN;  !VAR MMII:BTRIX; !BEGIN #MMII.ADDRESS:=MODEM+SLOTX16; #MMGETMODEM:=MMII.BITS^[BITNUMBER]; !END 00  PASCALHI .EQU 01  BIOSIN .EQU 0C083  BIOSOUT .EQU 0C08B  CONCHECK .EQU 0D681  VIDOUT .EQU 0D7E7  ;  ; *.PROC POKE,2 ;2 PARAMETER WORDS  ;  ;PROCEDURE(VALUE,ADDRS:INTEGER)  ;  ; EFFECT:  ;  ; VALUE IS STORED AT ADDRS  ;  GTCHAR;  ;  ; THOMAS H. WOTEKI  ; LAST UPDATE MAY 1980  ; FROM BYTE, FEB 1981 PG. 106  ; %.MACRO POP %PLA %STA %1 %PLA %STA %1+1 %.ENDM % %.MACRO PUSH %LDA %1+1 %PHA %LDA %1 %PHA %.ENDM % %;GLOBAL EQUATES  PASCAL .EQU;  ; These routines are stored in the  ; system library:  ;  ; POKE(VALUE,ADDRS:INTEGER;  ; PEEK(ADDRS:INTEGER):INTEGER;  ; CALL(ADDRS:INTEGER);  ; DIALIT(NUMBER:STRING);  ; NEWMODEMVALUE(WORD:INTEGER);  ; SNDCHAR;  ; N^2BDIGITDELAY); (END; $'*':WAIT(A2SECDELAY); #END (*CASE*); $ %'0','1','2','3','4','5','6','7','8','9': (BEGIN (DIGIT:=ORD(NUMBER[I])-ORD('0'); (IF DIGIT=0 THEN DIGIT:=10; (REPEAT *WAIT(DIALPULSE); *MMSETMODEM(CHR(0)); *WAIT(DIALPULSE); * *MMSETMODEM(CHR(MOFFHOOK)); *DIGIT:DIGIT-1; (UNTIL DIGIT=0; (WAIT(HR(C8BITS)); !END (*MMSETUP*);   (*P*)   FUNCTION MMKEYPRESS;  EXTERNAL;   FUNCTION MMDAILER; "BEGIN "MMSETMODEM(CHR(MOFFHOOK)); "WAIT(A2SECDELAY); "FOR I:=1 TO LENGHT(NUMBER) DO $CASE NUMBER[I] OF MEMORY^:=CBYTE; !END(*MMSETCONTROL*); $ !PROCEDURE MMSETMODEM(CBYTE:CHAR); "VAR MMII.TRIX; "BEGIN $MMII.ADDRESS:=MODEM+SLOTX16; $MMII.MEMORY^:=CBYTE; "END (*MMSETMODEM*);   PROCEDURE MMSETUP; !BEGIN #MMSETCONTROL(CHR(CINIT)); #MMSETCONTROL(C (*MMGETMODEM*); !  FUNCTION MMGETDATA:CHAR; !VAR MMII:TRIX; !BEGIN #MMII.ADDRESS:=DATA+SLOTX16; #MMGETDATA:=MMII.MEMORY^; !END (*MMGETDATA*); !  PROCEDURE MMSETCONTROL(CBYTE:CHAR); !VAR MMII:TRIX; !BEGIN #MMII.ADDRESS:=CONTROL+SLOTX16; #MMII.ADDRS .EQU 02  ADDRSHI .EQU 03 (POP PASCAL ( (LDY #00 ;INITIALIZE Y-REG ( (POP ADDRS ;SAVE ADDRESS 8;ARGUMENT ( (PLA ;LSB OF VALUE (STA @ADDRS,Y ;STORE VALUE AT 8;ADDRS (PLA ;DISCARD MSB VALUE ( (PUSH PASCAL (RTS ;BACK TO PASCAL  ;========================================== (.FUNC PEEK,1 ;1 PARAMETER WORD  ;  ;FUNCTION PEEK(ADDRS:INTEGER):INTEGER  ;  ; EFFECT:  ;  ; THE CONTENTS OF ADDRS ARE RETURNED BY PEEK  ;  ;----AIT A WHILE THEN GET (;THE NEXT DIGIT (JSR LONGWAIT (INY (BPL NXTDIGIT (  DONE PUSH PASCAL (RTS (  LONGWAIT LDX #05  AGAIN LDA #0FF )JSR WAIT )DEX )BNE AGAIN )RTS )  WAIT SEC  WAIT2 PHA  WAIT3 SBC #01 (BNE WAIT3 (PLA (SBC SES   PULSE LDA HANGUP ;DIAL THE DIGIT (STA MODEM (LDA #WAIT61 (JSR WAIT (LDA PICKUP (STA MODEM (LDA #WAIT39 (JSR WAIT (DEX (BNE PULSE ( (;WHEN DONE WITH DIGIT (;CHECK TO SEE IF DONE WITH NUMBER ( (CPY LENGTH (BEQ DONE (;IF NOT, W(PLA ;RECOVER DIGIT NUMBER (TAY (LDA @LOCATION,Y ;GET DIGIT AGAIN ( (SEC ;CONVERT DIGIT (SBC #30 ;FROM CHAR FORM (BNE START (LDA #0A ;IN CASE DIGIT IS 0 (  START TAX ;INITIALIZE X TO COUNT PUL #01 ;INITIALIZE TO GET THE FIRST 8;DIGIT NXTDIGIT TYA (PHA ;SAVE DIGIT NUMBER ON STACK (LDA BIOSIN ;SWITCH TO BIOS (LDA @LOCATION,Y ;DISPLAY DIGIT (JSR VIDOUT ;ON CONSOLE (LDA BIOSOUT ;BACK TO PASCAL DA MODEMCOPY ;INITIALIZE LOCATIONS (AND #7F ;HANGUP AND PICKUP FOR (STA HANGUP ;PROPER DIALING (LDA MODEMCOPY (ORA #80 (STA PICKUP (LDY #00 ;REMEMBER HOW MANY DIGITS (LDA @LOCATION,Y ;IN THE TELEPHONE NUM (STA LENGTH ( (LDY MODEMCOPY .EQU 067A  WAIT61 .EQU 99  WAIT39 .EQU 7A  LOCATION .EQU 02  LENGTH .EQU 04  HANGUP .EQU 06  PICKUP .EQU 07  (POP PASCAL ;SAVE THE PASCAL RETURN 8;ADDRESS (POP LOCATION ;POP THE MEMORY ADDRESS 8;OF THE TELEPHONE NUM (L ;THIS ROUTINE ASSUMES THE MICROMODEM IS  ;IN SLOT 2 ON THE MOTHER BOARD.  ;IT SHARES "MODEMCOPY",  ;WHICH CONTAINS A COPY OF THE MODEM  ;CONTROL WORD, WITH THE LOBRARY UNIT.  ;  ;===========================================   MODEM .EQU 0C0A5 =====================  ; (.PROC DIALIT,1  ;  ;A PROCEDURE TO DIAL THE PHONE USING  ;THE D.C. HAYES MICROMODEM II.  ;  ;THIS ROUTINE IS CALLED BY THE PROCEDURE  ;  ; DIAL(NUMBER:STRING)  ;  ;IN THE LIBRARY UNIT MICROMODEM.  ; JUMP .EQU 02  ADDRS .EQU 03  ADDRSHI .EQU 04  DONE .EQU 05  (POP PASCAL ( (LDA #20 (STA JUMP (LDA #60 (STA DONE ( (POP ADDRS ;SAVES ADDRESS OF 8;DESTINATION ROUTINE (JSR JUMP ( (PUSH PASCAL (RTS (  ;======================NG CONTROL TO THE ROUTINE  ;LOCATED AT "ADDRS".  ;  ;WHEN THE RTS IN THE DESTINATION ROUTINE  ;IS ENCOUNTERED, CONTROL IS RETURNED TO  ;LOCATION "DONE", THEN TO THE MAIN BODY  ;OF CALL, THEN TO PASCAL.   ;---------------------------------------  ;SUGGESTED BY KENNETH SKIER IN THE JAN  ;1980 OF BYTE, PAGE 118  ;  ;A JSR INSTRUCTION FOLLOWED BY "ADDRS"  ;ARE LOADED INTO CONSECUTIVE LOCATIONS  ;  ;BEGINNING AT LOCATION "JUMP". CALL THEN  ;EXECUTES A JSR TO THAT LOCATION THEREBY  ;TRANSFERRI TO PASCAL ( ;====================================== (.PROC CALL,1 ;1 PARAMETER WORD  ;  ;PROCEDURE CALL(ADDRS);  ;  ; EFFECT:  ; CALLS THE ROUTINE LOCATED AT ADDRS  ; AND RETURNS TO PASCAL  ;  ;USES A FORM OF INDIRECT ADDRESSING S TO 8;PEEK (LDA #00 ;INITIALIZE (TAY ;Y-REG (PHA ;PUSH MSB OF 8;RETURNED VALUE: 8;ZERO  (LDA @ADDRS,Y ;LOAD A WITH LSB 8;OF RETURN VALUE (PHA ;PUSH ON STACK ( (PUSH PASCAL (RTS ;BACK---------------------------------------  ADDRS .EQU 02  ADDRSHI .EQU 03 (POP PASCAL ( (PLA ;DISCARD 4 BYTES (PLA ;OF STACK BIAS (PLA ;ASSOCIATED WITH (PLA ;FUNCTIONS ( (POP ADDRS ;SAVE ADDRE#01 (BNE WAIT2 (RTS (  ;=================================  ; (.PROC NEWMODEMVALUE,1  ;  ;A PROCEDURE TO CHANGE THE CONTENTS  ;OF LOCATION $C0A5 WHICH IS THE (SLOT 2)  ;LOCATION OF THE MICROMODEM CONTROL  ;WORD. THIS IS A ROUTINE WRITTEN  ;ESPECIALLY FOR USE BY THE LIBRARY  ;UNIT - MICROMODEM.  ;  ;THE ROUTINE LOGICALLY ORS ITS ARGUMENT  ;WITH THE CONTENTS OF MODEMCOPY, $067A,  ;SAVES THE RESULT IN MODEMCOPY AND WRITES  ;IT TO MODEM, $C0A5.  ;-----------------------------------  M carrier:BOOLEAN; $FUNCTION rcvrfull:BOOLEAN; $FUNCTION transempty:BOOLEAN; $FUNCTION aciaerror:BOOLEAN; $FUNCTION aciastatus:INTEGER;  FUNCTION modemstatus:INTEGER; $ $PROCEDURE initacia(word:INTEGER); $PROCEDURE enabletransmit; $PROCEDURE se; { $C202 } *dataout= 1912; { $0778 } *modemcopy= 1658; { $067A } * *resetflag = 8; *selftest = 16; * $TYPE baudrate = (low,high); *mode = (answer,originate); * $VAR md : mode; *br : baudrate; * $FUNCTION ringing:BOOLEAN; $FUNCTION{$ PRINTER:}  {$S+} { Swapping required for UNITS }  UNIT MICROMODEM; INTRINSIC CODE 23 DATA 24;  "INTERFACE " $CONST datain = -16217; { $C0A7 } *acia = -16218; { $C0A6 } *modem = -16219; { $C0A5 } *keybde = -16384; { $C000 } *outa = -15870N^2B(.END ASCAL (PLA ;DISCARD 4 BYTES OF (PLA ;FUNCTION BIAS (PLA (PLA (LDA BIOSIN (JSR CONCHECK ( (LDA #00 ;GET CHAR AND PUSH (PHA ;FUNCTION RESULT (LDA DATAIN (PHA ( (JSR VIDOUT ;OUTPUT TO CONSOLE ( (LDA BIOSOUT (PUSH PASCAL (RTS ( ROUTINE  ;OUTPUTS IT TO THE CONSOLE SCREEN AND  ;RETURNS THE VALUE TO THE CALLING PROGRAM  ;AS A FUNCTION RESULT.  ;  ;THIS ROUTINE IS PART OF THE LIBRARY  ;UNIT MICROMODEM  ;  ;--------------------------------------  DATAIN .EQU 0C0A7  (POP P(RTS (  ;=====================================  ; (.FUNC GTCHAR  ;  ;A ROUTINE TO GET ONE CHARACTER FROM  ;THE MICROMODEM DATA INPUT LOCATION  ;DATAIN. THE ROUTINE ASSUMES THE  ;RECEIVER REGISTER IS FULL.  ;  ;AFTER FETCHING THE CHARACTER THE F18  WPTR .EQU 0BF19  CONBUF .EQU 03B1  BUMP .EQU 0D72C  DATAOUT .EQU 0778  OUTA .EQU 0C202 (LDA BIOSIN (JSR CONCHECK (LDX RPTR (CPX WPTR (BEQ HOME (JSR BUMP (STX RPTR (LDA CONBUF,X (STA DATAOUT (JSR OUTA  HOME LDA BIOSOUT (RTS  ;===================================  ; (.PROC SNDCHAR  ;  ;A PROCEDURE TO OUTPUT ONE CHARACTER  ;THROUGH THE MICROMODEM IN SLOT 2.  ;  ;ROUTINE IS CALLED FROM THE UNIT MICROMODEM  ;  ;------------------------------------  RPTR .EQU 0BODEMCOPY .EQU 067A  MODEM .EQU 0C0A5  (POP PASCAL 7;PULL THE VALUE OF THE NEW 7;BITS TO BE SET AND UPDATE 7;MODEM (PLA (ORA MODEMCOPY (STA MODEMCOPY (STA MODEM ( (PLA ;DISCARD MSB OF 8;NEWBITS (PUSH PASCAL ;BACK TO PASCAL tmode(md:mode; br:baudrate); $PROCEDURE pickup; $PROCEDURE dial(number:STRING); $PROCEDURE waitforcarrier; $PROCEDURE hangup; $PROCEDURE setmodem(word:INTEGER); $PROCEDURE sendchar; $PROCEDURE getchar(VAR ch:CHAR);  !IMPLEMENTATION ! $TYPE word = PACKED ARRAY[0..1] OF 0..255; * *freeunion=RECORD CASE BOOLEAN OF ,TRUE:(addrs:INTEGER); ,FALSE:(value:^word); ,END; , $VAR memory:freeunion; $ !FUNCTION ringing; #{ Determine whether the phone is ringing } #BEGIN $memory.addrs#{Fetch the char stored in the modem input location #datain and send it to the screen. Pass the char as #a function result } # !PROCEDURE getchar; #BEGIN $ch:=gtchar; #END; # !BEGIN "setmodem(resetflag); !END. r it to #the modem output location dataout, and transmit the #character via the modem routine located at outa } # !PROCEDURE sendchar; #BEGIN $sndchar; #END; # !FUNCTION gtchar:CHAR; EXTERNAL; GIN $memory.addrs:=modemcopy; $memory.value^[0]:=0; $newmodemvalue(word); #END; # !PROCEDURE hangup; #{ Hang up the phone, turn off the modem } #BEGIN $setmodem(0); #END; # !PROCEDURE sndchar; EXTERNAL; #{ Get a char from the keyboard, transfeng } #VAR data,wait:INTEGER; #BEGIN $wait:=0; $WHILE NOT carrier AND (WAIT<10000) DO %BEGIN &wait:=wait+1; &memory.addrs:=datain; &data:=memory.value^[0]; %END; #END; # !PROCEDURE setmodem; #{ Write a new value to the modem control word } #BE#{ Dial the indicated number, display the digits as %they are dialed } ! !PROCEDURE dial; #{ Dial the indicated number } #BEGIN $WRITE('Dialing...'); $dialit(number); $WRITELN; #END; # !PROCEDURE waitforcarrier; #{ Wait for carrier after diali up the phone, wait for dial tone } #VAR dummy,wait:INTEGER; #BEGIN $newmodemvalue(128); ${wait for dial tone} $FOR wait:= 0 TO 3000 DO dummy:=0; #END; # !PROCEDURE dialit(number:STRING); EXTERNAL; it to modem. } $ !PROCEDURE enabletransmit; #{ Turn on the modem transmitter } #BEGIN $newmodemvalue(2); #END; # !PROCEDURE setmode; #{ Set the mode and baud rate } #BEGIN $newmodemvalue(4*ORD(md)+ORD(br)); #END; # !PROCEDURE pickup; #{ Pick]:=word; $REPEAT dummy:=0 UNTIL NOT carrier; #END; # !PROCEDURE newmodemvalue(newbits:INTEGER); !EXTERNAL; "{ Logical or the value last written to $location modem (stored in modemcopy) $with the argument, store the result $in modemcopy and write #{ Determine last value written to modem } #BEGIN $memory.addrs:=acia; ! modemstatus:=memory.value^[0] ; #END; ! !PROCEDURE initacia; #{ Initialize ACIA } #VAR dummy:INTEGER; #BEGIN $memory.addrs:=acia; $memory.value^[0]:=3; $memory.value^[0BEGIN $memory.addrs:=acia; ! aciaerror:=memory.value^[0] >3; #END; ! !FUNCTION aciastatus; #{ Determine ACIA status } #BEGIN $memory.addrs:=acia; ! aciastatus:=memory.value^[0] ; #END; ! !FUNCTION modemstatus; GIN $memory.addrs:=acia; ! rcvrfull:=ODD(memory.value^[0]); #END; # !FUNCTION transempty; #{Check if ACIA transmitter register is empty } #BEGIN $memory.addrs:=acia; ! transempty:=ODD(memory.value^[0] DIV 2); #END; ! !FUNCTION aciaerror; #:=MODEM; $ringing:=memory.value^[0]<128; #END; # !FUNCTION carrier; #{ Test for presence of carrier } #BEGIN $memory.addrs:=acia; $carrier:=memory.value^[0] MOD 8<4; #END; # !FUNCTION rcvrfull; #{ Check if ACIA receiver register is full } #BEN^BBN^BBDA ACIA (.BYTE 4A ;LSR A (.BYTE 90,0F7 ;BCC RCOM (.BYTE 0AD,0A7,0C0 ;LDA DATAIN (.BYTE 0A2,00 ;LDX #00 (.BYTE 60 ;RTS ( (.END ;AND #02 (.BYTE 0F0,0F6 ;BEQ WCOM (.BYTE 8C,78,07 ;STY DATAOUT (.BYTE 20,02,0C2 ;JSR OUTA (.BYTE 60 ;RTS (  PRG6 .BYTE 4C,5D,0D8 ;JMP RCOM   PRG7 .BYTE 20,81,0D6 ;JSR CONCHECK (.BYTE 0AD,0A6,0C0 ;L(.BYTE 0A9,15 ;LDA #15 (.BYTE 8D,0A6,0C0 ;STA ACIA (  PRG4 .BYTE 0A8 ;TAY (.BYTE 0A2,00 ;LDX #00 (.BYTE 4C,1F,0D8 ;JMP WCOM ( PRG5 .BYTE 20,81,0D6 ;JSR CONCHECK (.BYTE 0AD,0A6,0C0 ;LDA ACIA (.BYTE 29,02 ,Y (INY (CPY #03 (BCC XRREAD ( (LDY #00  XRCOM LDA PRG7,Y (STA RCOM,Y (INY (CPY #0F (BCC XRCOM ( (LDA BIOSOUT (RTS (  PRG2 .BYTE 4C,0A3,0D7 ;JMP ICOM   PRG3 .BYTE 0A9,03 ;LDA #03 (.BYTE 8D,0A6,0C0 ;STA ACIA OM LDA PRG3,Y (STA ICOM,Y (INY (CPY #0A (BCC XICOM ( (LDY #00  XRWRITE LDA PRG4,Y (STA RWRITE,Y (INY (CPY #06 (BCC XRWRITE ( (LDY #00  XWCOM LDA PRG5,Y (STA WCOM,Y (INY (CPY #11 (BCC XWCOM ( (LDY #00  XRREAD LDA PRG6,Y (STA RREAD0C202  ICOM .EQU 0D7A3  RINIT .EQU 0D79C  RWRITE .EQU 0D809  WCOM .EQU 0D81F  RCOM .EQU 0D85D  RREAD .EQU 0D84E  (LDA BIOSIN (LDA BIOSIN ( (LDY #00  XRINIT LDA PRG2,Y (STA RINIT,Y (INY (CPY #03 (BCC XRINIT ( (LDY #00  XIC;===============================  ;  (.PROC SYSGEN  ;  ;-------------------------------  BIOSIN .EQU 0C083  BIOSOUT .EQU 0C08B  CONCHECK .EQU 0D681  ACIA .EQU 0C0A6  DATAOUT .EQU 0778  DATAIN .EQU 0C0A7  MODEM .EQU 0C0A5  OUTA .EQU PROGRAM startup;   PROCEDURE sysgen; EXTERNAL;   BEGIN !sysgen; !gotoxy(0,5); !writeln ('Welcome to Dr. Wo''s Apple Pascal!'); !writeln ; !writeln ('The system has just been modified to'); !writeln ('enable communications through the'); !writeOT carrier )THEN BEGIN /hangup; /unitclear(1); /exit(terminal); .END )ELSE BEGIN /write('#'); /error:=peek(datain); .END #ELSE IF rcvrfull )THEN getchar(ch) )ELSE sendchar; !UNTIL NOT carrier;  END;   FUNCTION tryagain:BOOLEAN;  VAR answrln('Waiting for carrier...'); !waitforcarrier;  END;   PROCEDURE terminal;  VAR ch:CHAR; $error:INTEGER; $  BEGIN !page(output); !gotoxy(0,5); !writeln('Carrier OK. Begin communications.'); !enabletransmit; !REPEAT "IF aciaerror #THEN IF N!writeln; !write(' --> '); !readln(number); !getaciacntl(word); !page(output); !gotoxy(0,5); !write('Preparing to dial, please wait...'); !initacia(word); !pickup; !setmode(originate,high); !writeln('OK');  dial(number); !writeln; !write ODD 1 29'); #writeln; #write('ACIA control word--> '); #readln(word); "UNTIL word IN [1,5,9,13,17,21,25,29]; !END;   BEGIN { dialup } !setmodem(resetflag); !page(output); !gotoxy(0,5); !writeln('Enter the phone number.'); n(' 7 ODD 2 5'); #writeln(' 7 EVEN 1 9'); #writeln(' 7 ODD 1 13'); #writeln(' 8 NONE 2 17'); #writeln(' 8 NONE 1 21'); #writeln(' 8 EVEN 1 25'); #writeln(' 8 #GOTOXY(0,3); #writeln('Select the ACIA control word:'); #writeln;writeln; #writeln('CHAR PARITY STOP CONTROL'); #writeln('LENGTH BIT BITS WORD '); #writeln('----------------------------'); #writeln(' 7 EVEN 2 1'); #writel(*$LPRINTER:*)  PROGRAM fullduplex;   USES micromodem;   FUNCTION peek(location:INTEGER):INTEGER; EXTERNAL;   PROCEDURE dialup;  VAR number:STRING; $word:INTEGER; $ !PROCEDURE getaciacntrl(VAR word:INTEGER);  BEGIN "REPEAT #PAGE(output); N^RRln ('Micromodem II in slot 2.'); !writeln ; !writeln ('Please set the DATE using the Filer.');  END. :CHAR;  BEGIN !REPEAT "page(output); "gotoxy(0,5); "write('No carrier. Try again? (Y/N)->'); "read(answr); "writeln; "tryagain:=answr IN['Y','y']; !UNTIL answr IN ['Y','N','y','n'];  END;   BEGIN { fullduplex } !REPEAT "dialup; "IF carrier #THEN terminal; !UNTIL NOT tryagain; !hangup;  END. CTION aciastatus:INTEGER;  FUNCTION modemstatus:INTEGER; $ $PROCEDURE initacia(word:INTEGER); $PROCEDURE enabletransmit; $PROCEDURE setmode(md:mode; br:baudrate); $PROCEDURE pickup; $PROCEDURE dial(number:STRING); $PROCEDURE waitforcarrier; $P$TYPE baudrate = (low,high); *mode = (answer,originate); * $VAR md : mode; *br : baudrate; * $FUNCTION ringing:BOOLEAN; $FUNCTION carrier:BOOLEAN; $FUNCTION rcvrfull:BOOLEAN; $FUNCTION transempty:BOOLEAN; $FUNCTION aciaerror:BOOLEAN; $FUN " $CONST datain = -16217; { $C0A7 } *acia = -16218; { $C0A6 } *modem = -16219; { $C0A5 } *keybde = -16384; { $C000 } *outa = -15870; { $C202 } *dataout= 1912; { $0778 } *modemcopy= 1658; { $067A } * *resetflag = 8; *selftest = 16; * """d MICROMODMICROMOD POKE POKE PEEK PEEK CALL CALL DIALIT DIALIT NEWMODEM NEWMODEMSNDCHAR SNDCHAR GTCHAR GTCHAR  hhh zzhHH` ֮ ,׎x ­`*hhhhhh ֩HH ׭HH`,4dFrhhhhhhHH`"hhhhhhhhHHHH`&hh `hh HH`&hhhhz)z H ׭h80  nz n cƥHH` n`8Hh`91)'II.0 [d.4] POKE ROCEDURE hangup; $PROCEDURE setmodem(word:INTEGER); $PROCEDURE sendchar; $PROCEDURE getchar(VAR ch:CHAR);  !IMPLEMENTATION E TION carrier:BOOLEAN; $FUNCTION rcvrfull:BOOLEAN; $FUNCTION transempty:BOOLEAN; $FUNCTION aciaerror:BOOLEAN; $FUN[?ǀ6Z?6Z?Z?Z?Z?Z?Z?   hhhhz)z H ׭h80  nz n cƥHH` n`8Hh`91)hhh zzhHH`  ֮ ,׎  8  ُ؂ ǀǸ ȡ & تPצ Dialing...R0 'ɄY?'2z [?ǀ6Z?6Z?Z?Z?Z?Z?Z?ROCEDURE hangup; $PROCEDURE setmodem(word:INTEGER); $PROCEDURE sendchar; $PROCEDURE getchar(VAR ch:CHAR);  !IMPLEMENTATION E TION carrier:BOOLEAN; $FUNCTION rcvrfull:BOOLEAN; $FUNCTION transempty:BOOLEAN; $FUNCTION aciaerror:BOOLEAN; $FUNCTION aciastatus:INTEGER;  FUNCTION modemstatus:INTEGER; $ $PROCEDURE initacia(word:INTEGER); $PROCEDURE enabletransmit; $PROCEDURE setmode(md:mode; br:baudrate); $PROCEDURE pickup; $PROCEDURE dial(number:STRING); $PROCEDURE waitforcarrier; $P$TYPE baudrate = (low,high); *mode = (answer,originate); * $VAR md : mode; *br : baudrate; * $FUNCTION ringing:BOOLEAN; $FUNCTION carrier:BOOLEAN; $FUNCTION rcvrfull:BOOLEAN; $FUNCTION transempty:BOOLEAN; $FUNCTION aciaerror:BOOLEAN; $FUN " $CONST datain = -16217; { $C0A7 } *acia = -16218; { $C0A6 } *modem = -16219; { $C0A5 } *keybde = -16384; { $C000 } *outa = -15870; { $C202 } *dataout= 1912; { $0778 } *modemcopy= 1658; { $067A } * *resetflag = 8; *selftest = 16; * '"t MICROMODMICROMOD   8  ُ؂ ǀǸ ȡ & تPצ Dialing...R0 'ɄY?'2z BR DIALIT GTCHAR MD MEMORY NEWMODEM SNDCHAR  Z?Z?Z?Z?  8  ُ؂ ǀǸ ȡ & تPצ Dialing...R0 'ɄY?'2z    .N@v&8v>,?Z?Z?Z?Z?  8  ُ؂ ǀǸ ȡ & تPצ Dialing...R0 'ɄY?'2z x ­`*hhhhhh ֩HH ׭HH`,4f*>^P 6H *N<ialing...R0 'ɄY?'2z X FULLDUPL  STARTUP SYSGEN SYSGEN  X[ e k|N]`LשL ֭)x `L] ֭J`|qf[P'II.0 [d.4] SYSGEN  *,6hhhhhhhhHHHH`&f 6  צOK Waiting for carrier...T צ"Carrier OK. Begin communications. * &#Y?L צNo carrier. Try again? (Y/N)->ڳڳ@@~P* צ!Preparing to dial, please wait...*   צOK Waiting for carrier...T צ"Carrier OK. Begin communications. EVEN 1 25 8 ODD 1 29ACIA control word-->  """" צEnter the phone number. -->  7 ODD 2 5 7 EVEN 1 9 7 ODD 1 13 8 NONE 2 17 8 NONE 1 21 8  צSelect the ACIA control word:CHAR PARITY STOP CONTROLLENGTH BIT BITS WORD ---------------------------- 7 EVEN 2 1''צ!Welcome to Dr. Wo's Apple Pascal!$The system has just been modified to!enable communications through theצMicromodem II in slot 2.צ$Please set the DATE!TESTMODE[ORIGINATE,THRHUND]:='ORIGINATE MODE, 300 BAUD';  DOTCOUNT:=0;   END;   PROCEDURE RESETMODEM;  BEGIN !PAGE(OUTPUT); !SKIPLINES(5); !WRITELN('RESETTING MODEM'); !WRITE('PLEASE WAIT... '); !MEMORY.ADDRS:=MODEM; !MEMORY.PNTR^[0]:=OFF;!WRITELN('FROM THE MICROCOUPLER.'); !WRITE(' TO CONTINUE-->');READLN; ' !TESTMODE[ANSWER,ONETEN]:='ANSWER MODE, 110 BAUD'; !TESTMODE[ORIGINATE,ONETEN]:='ORIGINATE MODE, 110 BAUD'; !TESTMODE[ANSWER,THRHUND]:='ANSWER MODE, 300 BAUD'; UNT+1; !IF DOTCOUNT MOD 4=0 "THEN WRITE('.');  END;   FUNCTION CARRIER:BOOLEAN;  BEGIN !MEMORY.ADDRS:=ACIA; !CARRIER:=MEMORY.PNTR^[0]<4;  END;   PROCEDURE INIT;  BEGIN !PAGE(OUTPUT);SKIPLINES(5); & !WRITELN('PLEASE DISCONNECT THE MODEM'); %CHANGE:BOOLEAN;  TESTMODE:ARRAY[ANSWER..ORIGINATE,ONETEN..THRHUND] OF STRING;  MEMORY:TWOFACE;  DOTCOUNT:INTEGER;    PROCEDURE CALL(LOC:INTEGER);  EXTERNAL;   PROCEDURE DOTTEDLINE(VAR DOTCOUNT:INTEGER);  BEGIN !DOTCOUNT:=DOTCO TYPE MODE=(ANSWER,ORIGINATE); %BAUDRATE=(ONETEN,THRHUND);   WORD=PACKED ARRAY[0..1] OF 0..255; % %TWOFACE=RECORD CASE BOOLEAN OF .TRUE:(ADDRS:INTEGER); .FALSE:(PNTR:^WORD); .END; .   VAR MD:MODE; %BR:BAUDRATE;  ERRORS:INTEGER; IOSTUFF;   CONST SLOT= 2; &BASE= -16327; &DATA= -16217; (*HEX $C089*) &ACIA= -16218; &MODEM= -16219;  OUTA= -15870; &CHAR=1912; &OFF= 8;  CLEAR= 3; &NORMAL= 21;  NOCARR= 4;  RCVFULL= 1; &TRNSEMPTY= 2;  BOARD. "  NOTE TO THE USER: YOU MAY OCCASIONAL-  LY FLAG AN ERROR SENDING CTRL-E AND  CNTRL-F CHARACTERS (ASCI 5 AND 6). I  HAVE AND DON'T KNOW WHY. " "BLAISE AWAY! " *DR. WO *  ***************************************)  PROGRAM MODTEST;  USES %WASHINGTON APPLE PI % %LAST UPDATE: APR 18 1980 %  PLEASE NOTE THE INCREASED READABILITY  OF THE MODULAR PASCAL PROGRAM COMPARED  TO THE BASIC PROGRAM APPEARING IN THE  MANUAL. "  THE PROGRAM ASSUMES THE MICROMODEM IS  IN SLOT 2 ON THE APPLE'S  (**************************************   PROGRAM MODEMTEST "  A PROGRAM TO TEST THE D.C.HAYES  MICROMODEM. MODELLED AFTER THE BASIC  PROGRAM WRITTEN BY D.F. HYDE AND  APPEARING IN THE MICROMODEM OWNER'S  MANUAL. " "WRITTEN BY " %TOM WOTEKI '^q using the Filer.G(X[ e k|N]`LשL ֭)x `L] ֭J`|qf[PTEXT#CODE#饀! !MEMORY.ADDRS:=ACIA; !MEMORY.PNTR^[0]:=CLEAR; !REPEAT DOTTEDLINE(DOTCOUNT) UNTIL NOT CARRIER;  SKIPLINES(5);  END;   PROCEDURE SETTEST(MD:MODE;BR:BAUDRATE);  VAR VAL:INTEGER;  BEGIN !WRITELN('SETTING TEST CONDITIONS FOR'); !WRITELN; !WRITELN(' ',TESTMODE[MD,BR]); !WRITELN; !WRITE('PLEASE WAIT... '); !MEMORY.ADDRS:=MODEM; !MEMORY.PNTR^[0]:=154+4*ORD(MD)+ORD(BR); !REPEAT DOTTEDLINE(DOTCOUNT) UNTIL CARRIER;  WRITELN;WRITELN;  END;(* SETTEST *) ! ! !  PROCEDURE TEST;  VAR COUNTEING:BOOLEAN; !FUNCTION CARRIER:BOOLEAN; !FUNCTION ACIASTATUS:INTEGER; !FUNCTION MODEMSTATUS:INTEGER; !FUNCTION TRANSEMPTY:BOOLEAN; !FUNCTION RCVRFULL:BOOLEAN; !FUNCTION REMINREADY:BOOLEAN; !FUNCTION KEYBDREADY:BOOLEAN; !FUNCTION KEYPRESS:BOOLEAN; BLES +ARE DECLARED PUBLICLY +IN "MODEMSTUFF", THE LIBRARY +OF RUN TIME EXTERNALS WHICH +SUPPORTS MICROMODEM '**) ! KEYBDBUFF,REMINBUFF:PACKED ARRAY[MDMIOBRANGE] OF CHAR; ! KEYWPNTR,KEYRPNTR,REMWPNTR,REMRPNTR:MDMIOBRANGE; ! !FUNCTION RING ! !CONST RESETFLAG=8; 'CLEARCHIP=3; ' ! MDMIOBLEN=80; ' !TYPE BAUDRATE=(LOW,HIGH); 'MODE=(ANSWER,ORIGINATE); ! LONGLINE=STRING[255]; ! ! MDMIOBRANGE=0..80; ' !VAR MD:MODE; 'SPEED:BAUDRATE; # ! (** THE FOLLOWING VARIABBG"COPYRIGHT FEB 1981 THOMAS H WOTEKI8 R FILER MICROMODXKEYPRES ); %READLN; $END; !WRITELN('THAT''S ALL FOLKS!'); !  END. % "WRITELN; "WRITELN(NUMOFERRORS,' ERRORS FLAGGED'); !END;(* TEST *) ! ' ' '  BEGIN(*MAIN*)  ' "INIT; " "FOR MD:=ANSWER TO ORIGINATE DO #FOR BR:=ONETEN TO THRHUND DO $BEGIN %RESETMODEM; %SETTEST(MD,BR); %TEST; %WRITELN(' TO CONTINUE'S:=NUMOFERRORS+1; # END; #END; ! ! !BEGIN(*TEST*) " "INITIALIZE; " "REPEAT #IF RCVRREGFULL $THEN GETCHAR(NUMRCVD,NUMOFERRORS,NUMSENT) $ELSE IF TRANSREGEMPTY *THEN SENDCHAR(NUMSENT,COUNTER); "UNTIL COUNTER=128; " ! WRITELN; END; # # # #PROCEDURE GETCHAR(VAR NUMRCVD,NUMOFERRORS:INTEGER;NUMSENT:INTEGER); #BEGIN $MEMORY.ADDRS:=DATA; $NUMRCVD:=MEMORY.PNTR^[0]; $IF NUMSENT<>NUMRCVD $ THEN BEGIN +WRITELN; +WRITELN('ERROR: SENT= ',NUMSENT,' RECVD= ',NUMRCVD); +NUMOFERROR:=(NOT ODD(MEMORY.PNTR^[0]) AND (MEMORY.PNTR^[0]<>0)); #END; # #PROCEDURE SENDCHAR(VAR NUMSENT,COUNTER:INTEGER); #BEGIN $MEMORY.ADDRS:=DATA; $MEMORY.PNTR^[0]:=COUNTER; $CALL(OUTA); $NUMSENT:=COUNTER; $COUNTER:=COUNTER+1; $DOTTEDLINE(DOTCOUNT); #$MEMORY.PNTR^[0]:=NORMAL; $ $WRITELN('BEGIN TEST...'); #END; # #FUNCTION RCVRREGFULL:BOOLEAN; #BEGIN $MEMORY.ADDRS:=ACIA; $RCVRREGFULL:=ODD(MEMORY.PNTR^[0]); #END; # #FUNCTION TRANSREGEMPTY:BOOLEAN; #BEGIN $MEMORY.ADDRS:=ACIA; $TRANSREGEMPTYR,NUMSENT,NUMRCVD,NUMOFERRORS:INTEGER;  #PROCEDURE INITIALIZE; #BEGIN $NUMOFERRORS:=0; $NUMSENT:=0; $NUMRCVD:=0; $COUNTER:=0; $ $MEMORY.ADDRS:=DATA; $MEMORY.PNTR^[0]:=0; $MEMORY.PNTR^[1]:=0; $ $MEMORY.ADDRS:=ACIA; $MEMORY.PNTR^[0]:=CLEAR; !FUNCTION PEEK(LOCATION:INTEGER):INTEGER; !PROCEDURE DIAL(NUMBER:STRING;VAR OK:BOOLEAN); !PROCEDURE TXENABLE; !PROCEDURE SETMODE(MD:MODE;SPEED:BAUDRATE); !PROCEDURE PICKUP(MD:MODE); --!PROCEDURE RESETMODEM(WORD:INTEGER); !PROCEDURE HANGUP; !PROCEDURE WAITFORCARRIER; !PROCEDURE TURNOFFCARR; !PROCEDURE TURNONCARR; !PROCEDURE INITACIA(FSKWORD:INTEGER);  PROCEDURE CLEARKEYBD; !PROCEDURE CLEARREMIN; !PROCEDURE READREMIN(VAR CH:CHARhhhhhh! L ֭HHHH`#>hhHH`"hhHH`"hhhhhh HHHH`0hhhhhh HHHH`0hhhhhhUPDATEMO "XPEEK #XCLEARRE %XCLEARKE &XKEYBDRE (XKEYPRES ,XPOKE $XREMINRE 'XREADREM )XREADKEY +XWRITERE * o T...-VCH ,5:Gfa DUMMY {UDIALDIGI -ESC dRETURN =iWAIT !$9Ykp~BNSV<?DG&:bLt^/WAITING FOR A DIAL TONE... .ö h/٪P&צDIALING TYPE TO EXIT...-V*á/K0,,á ,,-á.-.V  Z?$Z?$ $ F RJf|<0J $~vWAITING FOR A DIAL TONE... .ö h/٪P&צDIALING TYPE TO EXIT...-VצWAITING FOR A CARRIER,צTYPE TO EXIT'Ʉ˄LY?#á .Ljá, mLj[?$z#[?$ START DIALING á ..5 [?$z$OK!צ PLEASE WAIT TO HANG UP THE PHONE á ~&* Z?#Z?#z#" ُ؂",&.ǀ"áצWAITING FOR A DIAL TONE#YOU MAY TYPE TO@ dئת1ˡ#HZ [?#ǀ% & '( )+# $ !, Y?$Y?#Y?$Y?#ǀZ?#Z?#ت̀ʀš,ʀ); !PROCEDURE READKEYBD(VAR CH:CHAR); !PROCEDURE WRITEREMOUT(CH:CHAR);  PROCEDURE PUTREMOUT(X:INTEGER); !PROCEDURE GETREMIN(VAR X:INTEGER);  PROCEDURE PUTCHREMOUT(CH:CHAR); !PROCEDURE GETCHREMIN(VAR CH:CHAR); !PROCEDURE PUTLNREMOUT(LINE:LONGLINE); !PROCEDURE GETLNREMIN(VAR LINE:LONGLINE);  PROCEDURE POKE(VALUE,LOCATION:INTEGER);   IMPLEMENTATION E CEDURE TURNONCARR; !PROCEDURE INITACIA(FSKWORD:INTEGER);  PROCEDURE CLEARKEYBD; !PROCEDURE CLEARREMIN; !PROCEDURE READREMIN(VAR CH:CHAR); !PROCEDURE READKEYBD(VAR CH:CHAR); !PROCEDURE WRITEREMOUT(CH:CHAR);  PROCEDURE PUTREMOUT(X:INTEGER); !PROCEDURE GETREMIN(VAR X:INTEGER);  PROCEDURE PUTCHREMOUT(CH:CHAR); !PROCEDURE GETCHREMIN(VAR CH:CHAR); !PROCEDURE PUTLNREMOUT(LINE:LONGLINE); HHHH` 6hhhh )HH`2hhhhhh H' 80) 8 OHHH`\_`{|}~]^@UQCB9^ZVKJDC|P`) [ `4J )`0hh`hhh hHH`(hhhhhhhhHHHH`&hhh zzhHH` hhhhz)z  5 CONST maxdir=77; {maximum number of entries in directory} &vidleng=7; {number of characters in volume id} &tidleng=15; {number of characters in title id} &fblksize=512; {standard disk block length} &dirblk=2; {directory starts at this diskKEYBDBUF KEYBDBUFREMINBUFUPDATEMO UPDATEMOKEYWPNTRREMWPNTRREMRPNTRKEYRPNTRKEYBDBUFREMINBUFDIALDIGI DIALDIGIKEYWPNTRREMWPNTRREMRPNTRKEYRPNTRKEYBDBUFREMINBUFKEYWPNTRREMWPNTRREMRPNTRKEYRPNTRKEYBDBUFXPOKE XPOKE  REMINBUFKEYWPNTRXPEEK XPEEK  REMWPNTRREMRPNTRKEYRPNTRBUMP MP KEYBDBUFYBDBUFREMINBUFLMINBUFKEYWPNTRREMWPNTRD9PNTRREMRPNTR?MRPNTRKEYRPNTRBUMP <MP POLLMODE POLLMODE KEYWPNTRREMWPNTRREMRPNTRKEYRPNTRBUMP BUMP  KEYBDBUFREMINBUFKEYWPNTR PNTRREMWPNTRPOLLKEYB POLLKEYB REMRPNTRKEYRPNTRYRPNTRREMINBUFKEYWPNTRYWPNTRREMWPNTRPOLLKEYBLLKEYBREMRPNTRKEYRPNTRztBUMP w POLLMODEqMODEKEYBDBUFDBUFREMINBUFMP KEYBDBUFREMINBUFKEYWPNTRXWRITERE XWRITEREREMWPNTRPOLLKEYB@LLKEYBREMRPNTRKEYRPNTRPOLLMODE=LLMODEKEYBDBUFXREADKEY XREADKEYXKEYBDREKEYRPNTRYRPNTRKEYBDBUFREMINBUFMINBUFKEYWPNTRREMWPNTRPOLLKEYBLLKEYBREMRPNTR PNTRXREADREM XREADREMKEYRPNTRBUMP REMWPNTRMWPNTRREMRPNTRMRPNTRKEYRPNTRPOLLMODELLMODEKEYBDBUFREMINBUFKEYWPNTRYWPNTRREMWPNTRPOLLKEYBLLKEYBREMRPNTRXKEYBDRE KEYRPNTRKEYBDBUFREMINBUFKEYWPNTRtYWPNTRREMWPNTRXCLEARKE XCLEARKEREMRPNTRKEYRPNTRqYRPNTRKEYBDBUFREMINBUFXREMINRE XREMINREKEYWPNTRXKEYPRES XKEYPRESREMINBUFKEYWPNTRREMWPNTRREMRPNTRKEYRPNTRKEYBDBUFREMINBUFKEYWPNTRREMWPNTRNMWPNTRXCLEARRE XCLEARREREMRPNTRKMRPNTRz 5HH`8Hh`%NV| F\R block address}  &maxunit=12; &  TYPE daterec=PACKED RECORD 0month:0..12;{0 implies meaningless date} 0day:0..31; 0year:0..100;{100 implies dated volume is temporary} 0END; & &{volume id} &vid=string[vidleng]; & &dirrange=0..maxdir; & &{title id} &tid=string[tidleng]; & --)vPINTEGER vREAL $|CHAR 6BOOLEAN BSTRING ,TEXT INTERAצ Lost unit Lost fileצBad title, illegal file nameצNo room, insufficient spaceNo unit, no such volumeצNo such file on lineid unit numberBColon expected in vol name e@ سعצ Bad blockBad unit numberצBad modeצUndefined hardware errorRNܪPצ צ  á-:ˡšR `عצFile name is too longVolume name is too longצUnit number expectedkצInval0 š éj *áڥצ:P:áڥ #áJ ۪Pצ   á!:áš& ȡ:ة ȡ ةaz ةaAF R צ:ȡ@á:׶P!Rf#š}[  áܩM  * ܪ    Í M  ⓡA éM   ⍡  A #   @árUبNUU l ?٩؞"á' کM ڢM Z ġ  .ange; 5VAR volinfo:direntry);   PROCEDURE getfileinfo(title:string;VAR OK:BOOLEAN;VAR volid:vid; 6VAR unitnum:unitrange;VAR fileinfo:direntry);   IMPLEMENTATION E END; %directory=ARRAY[dirrange] OF direntry; %  unitrange=0..maxunit; %  VAR dirp:^directory; { global directory pointer }   PROCEDURE minifiler;   PROCEDURE fetchdir(unitnum:integer;VAR OK:BOOLEAN;VAR dir:directory);   PROCEDURE getvolinfo(title:string;VAR OK:BOOLEAN;VAR unitnum:unitrity} 3status:BOOLEAN; {for filer wildcards} 3dtid:tid; {title of file} 3dlastbye:1..fblksize; {numbr of bytes in file's last block} 3daccess:daterec); {date last modified} 1END; %directory=ARRAY[dirrange] OF direntry; % irrange; {number of files in directory} 3dloadtime:integer; {time of last access ??} 3dlastboot:daterec); {most recent date setting} 1xdskfile,codefile,textfile,infofile, 1datafile,graffile,fotofile: 2(filler2:0..1024; {12 bits for downward compatibil block} 0CASE dfkind:filekind OF 1securedir,untypedfile: 2{only in dir[0], this is volume info} 2(filler1:0..2048; {13 bits for downward compatibility ??} 3dvid:vid; 3deovblk:integer; {number of blocks in this volume}  dnumfiles:d&filekind=(untypedfile,xdskfile,codefile,textfile,infofile,datafile, 1graffile,fotofile,securedir); & &{directory layout} &direntry=PACKED RECORD 0dfirstblk:integer;{first physical disk address} 0dlastblk:integer; {points at bock following last usedCTLINPUT xOUTPUT fbKEYBOARDFALSE `TRUE vxNIL MAXINT Xv    צ Duplicat file Not closedNot open Bad formatzRing buffer overflowPWrite protect error' cF#qBvNYá*Not a blocked volume'Undefined I-O error\`  "á8۪P ٥á٥ ةM !RPM ڢڢצ$Remove file(s) and update directory?M ġM  Removing M Crunch what volume? Pš=ˡ!  Endangered file(s) on  :M ȡ3 ۏٕܩ۩ȡM ٕݢٕk ٪ M  ȡ$MMš M  ة:צ crunchedlory of? Pˡ! کM M  $M ܕצMoving ݢ,   blocks۩צDestroy : ?BM MةDirectory zeroed3No action. Directory preserved.Zero the directšá#ץáI + áM  šU Prefix is : (٪   :צ Prefix is: : Root is: : *Set prefix to? Pz: Directory listing of? Pš4ˡ Volumes on line: ȡW š< M  צ files.á. M M   files,   unused blocks,   in largestM M šI   šܚ M :M ȡá צ of  ݢ BAD Codeצ Text Infogצ DataL Graf1צ FotozaH/۩M áMar-Apr-May-Jun-Jul-Aug-|Sep-jOct-XNov-FDec-4???-" tdTD   blocks.t צ%List,Vols,Prfx,Zero,Krunch,Rmov,Quit?hM ݢݢ ݢ  -Jan-Feb-ܪP ٥áT٥ IM ۥM ةM !MR   ?Þ(ȍ Crunch buffer is  צM צM ȡM M M M M#צNo action taken%7E# ڪتצ=b9PPbáOM ddȡ4M eeefef9dbdPdbbdP9Ä "lM ddȡSM ee9ef9fefefcM cń THESE FILES ARE LISTED:  TO EVERYONE MAC T. TO TERRY AMATEUR RADIO OPERATORS N^vWRRkzPREFIX O}fPRSLT -29UZa " ejqSTRINGPN.=CRTITLE )BS\$2CLUNITTABL N4p(qKVOLID _x(Tm}'@OOhw BGgjs5 8 M R \ s }HEAP  (IORSLT + ~HMfF\nOFFSET "5JPHYSUNITb{7Bs*CRRkzPREFIX O}fPRSLT -29UZa " ejqSTRINGPN.=CRTITLE )BS\$2CLUNITTABL N4p(qKVOLID `e!&u #6BGgjs5 8 M R \ s }HEAP  (IORSLT + ~HMfF\nOFFSET "5JPHYSUNITb{7Bs*C]/ DIRP 1W_pnxH~'2DOmx~r ; Y p aDIRHEAP  } FILEID  V GINDEX D:? ,(-FILER HmBELL a; BOOTER :|BUFFBLKC  6=CH 5Em}-2,:!+qt:BCLEOS Y~CLEOLN " < p | XdH"(\0TH$dd dצ:ddx"Remove what file(s)? PšCˡ$  "!!!$|xtpl!hKz`" &.2"$&(*,.02468:<>@PbFHJfNZRTVnZ\^r$ >zfjM cc#Gצ Can't find dd dצ:ddx"Remove what file(s)? PšCˡ$  "&RESET(F,'MODEM:LIST.TEXT'); &WHILE NOT EOF(F) DO (BEGIN *READLN(F,S); & WRITELN(S); (END; &CLOSE(F,LOCK); $END; ( "BEGIN #CMMND:=ESC; #PAGEFLIP:=CHR(1); #BREAK:=CHR(19); #RESUME:=CHR(17); #FSKWORD:=21; #HALFDUPLEX:=FALSE; #NEEDSLNFD:=T"PROCEDURE SETUPANSWER(VAR SESSIONFLAG:FLAGVALS); " $PROCEDURE EXAMINEFILES; $VAR &F:TEXT; &S:LONGSTRING; $ $BEGIN &RESET(F,'MODEM:LOG.TEXT'); &WHILE NOT EOF(F) DO (BEGIN *READLN(F,S); & WRITELN(S); (END; &CLOSE(F,LOCK); BEGIN #PAGE(OUTPUT); #WRITELN(' Welcome to'); #WRITELN; #WRITELN(' TERMINAL'); #WRITELN; #WRITELN(' The smart terminal program'); #WRITELN; #WRITELN(' by'); #WRITELN; #WRITELN(' Dr. Wo'); "END; $ LEOL:=CHR(29); #BACKSPACE:=CHR(8); #SPC:=CHR(32); #TILDE:=CHR(126); #DEL:=CHR(127); # #ALFA:=[SPC..TILDE]; # #COLCOUNT:=0; #SPACECOUNT:=0; #PAGEWIDTH:=40; #BUFFCOUNT:=0; # #PAGEONE:=TRUE; #CAPTURE:=FALSE; # "END; # "PROCEDURE SAYHELLO; "EVAR SESSIONFLAG:FLAGVALS); "PROCEDURE INITVARS; "BEGIN #CLEARKEYBD; #CLEARREMIN; " #RETURN:=CHR(13); #LINEFEED:=CHR(10); #NULLCHAR:=CHR(0); #BELL:=CHR(7); #CLEOS:=CHR(11); #ESC:=CHR(27); #CANCEL:=CHR(24); #HOME:=CHR(25); #FORM:=CHR(12); #CER,FILENAME:STRING; " SESSIONFLAG:FLAGVALS; " !SEGMENT PROCEDURE SETUP(VAR MD:MODE;VAR CMMND,PAGEFLIP,BREAK,RESUME:CHAR; EVAR HALFDUPLEX,NEEDSLNFD:BOOLEAN; EVAR SYSNAME,SYSNUMBER:STRING; EVAR SPEED:BAUDRATE;VAR FSKWORD:INTEGER; ,DEL:CHAR; &ESC,CANCEL,CMMND,PAGEFLIP,BREAK,RESUME:CHAR; &CLEOL,HOME,FORM,BACKSPACE:CHAR; &ALFA:SET OF CHAR; &FSKWORD,COLCOUNT,PAGEWIDTH,BUFFCOUNT,SPACECOUNT:INTEGER; &PAGEONE,CAPTURE,HALFDUPLEX,NEEDSLNFD:BOOLEAN; &NAME:STRING[255]; &SYSNAME,SYSNUMB  TEMPORARY POWAR FAILURE *) ! "USES CHAINSTUFF, %(*$UMODEM:MODEM.LIBRARY*)  MICROMODEM,FILER;     TYPE FLAGVALS=(BOOTUP,CONTINUE,NEWSETUP,ENDSESSION); &LONGSTRING=STRING[255]; &  VAR CH,CLEOS,BELL,RETURN,LINEFEED,NULLCHAR,SPC,TILDE (*$S+*)  PROGRAM ANSWERTERMINAL;  (* REQUIRES MODEM:LIST.TEXT PSEUDODIRECTORY AND A LOG FILE CALLED MODEM:  LOG.TEXT, THIS PROGRAM AUTO RESTARTS ON LOSS OF CARRIER AND AT ITS END  A FILE CALLED SYSTEM.STARTUP SHOULD CHAIN TO THIS PROGRAM IN CASE OF N^ƣgRUE; #SPEED:=HIGH; #UNITCLEAR(1); #RESETMODEM(0); #RESETMODEM(RESETFLAG); #INITACIA(FSKWORD); #PAGE(OUTPUT); #GOTOXY(0,5); #WRITELN('WAITING FOR A CALL'); #WRITELN; #WRITE('TYPE TO REVIEW LOG AND MESSEGE NAMES'); #WHILE NOT RINGING DO $IF KEYPRESS THEN %BEGIN &READ(KEYBOARD,CH); &IF CH=ESC THEN BEGIN WRITELN;EXAMINEFILES;END; %END; #SESSIONFLAG:=CONTINUE; #WRITELN; #WRITELN; #WRITELN('ANSWERING THE PHONE'); #PICKUP(MD); #SETMODE(MD,SPEED); #TXENABLE; #WAITFORCARRIER; "END; "-IF RCVRFULL THEN 1BEGIN 3CHREAD(CH); 3IF ((CH='Y') OR (CH='y')) THEN DONE:=TRUE; 3IF ((CH='N') OR (CH='n')) THEN DONE:=TRUE; 1END; +IF ((CH='N') OR (CH='n')) THEN DONE:=FALSE; )END; %UNTIL DONE; # LOGNAME; #END; # # #PROCEDURE KONCATTEXT(N'); )CHREAD(CH); 'UNTIL ((CH IN [RETURN,SPC] ) OR ( NOT CARRIER)); 'IF NOT CARRIER THEN STARTOVER; 'IF (CH=SPC) THEN BANNER 'ELSE )BEGIN +MOREADLN(NAME); +MOWRITELN(NAME); +MOWRITELN('CORRECT?(Y/N)'); +WHILE (CARRIER AND NOT DONE) DO OG.TEXT'); )REPEAT +READLN(L,S); )UNTIL EOF(L); )WRITELN(L,NAME); )CLOSE(L,LOCK); )(*$I+*) 'END; ) ) ) #BEGIN %DONE:=FALSE; %REPEAT 'REPEAT )MOWRITELN(' HIT FOR HELP WITH LOG IN FORMAT'); )MOWRITELN(' HIT TO START LOGGING I; )MOWRITELN('JOHN DOE WOULD TYPE ... JDOE '); )MOWRITELN('THEN HIT TO END THE LOG IN'); ' CH:=CHR(0); 'END; ' ' 'PROCEDURE LOGNAME; 'VAR )L:TEXT; )S:LONGSTRING; ) 'BEGIN )MOWRITELN('PLEASE WAIT..'); )(*$I-*) )RESET(L,'MODEM:L)MOWRITELN('YOU CAN RUN TEACHING PROGRAMS IN MEDICINE.'); )MOWRITELN('...'); )MOWRITELN('YOU MUST HIT WHEN ASKED TO START'); )MOWRITELN('THEN TYPE THE INITIAL OF YOUR FIRST NAME '); )MOWRITELN('FOLLOWED BY YOUR LAST NAME IN FULL.. NO SPACES')FALSE;  IF(NOT CARRIER) THEN STARTOVER; " END; # # # #PROCEDURE LOGIN; #VAR DONE:BOOLEAN; ' 'PROCEDURE BANNER; 'BEGIN )MOWRITELN(' WELCOME TO DR. PUNDIAK''S APPLE II COMPUTER'); )MOWRITELN('YOU CAN PICK UP AND WRITE MESSEGES...'); E;  REPEAT 'MOWRITELN(' ARE YOU IN HALFDUPLEX OR FULLDUPLEX?(H/F)'); 'IF CARRIER THEN CHREAD(CH); %UNTIL ((CH IN ['H','h','F','f'] ) OR (NOT CARRIER)); %IF CARRIER THEN % IF ((CH ='H') OR (CH = 'h')) )THEN HALFDUPLEX:=TRUE )ELSE HALFDUPLEX:=PLEX FROM REMIN*) #BEGIN %REPEAT 'MOWRITELN(' DO YOU NEED LINEFEEDS?(Y/N)'); 'IF CARRIER THEN CHREAD(CH); %UNTIL ((CH IN ['Y','y','N','n'] ) OR (NOT CARRIER)); %IF CARRIER THEN IF ((CH='Y') OR (CH='y')) 'THEN NEEDSLNFD:=TRUE % ELSE NEEDSLNFD:=FALS-END; )END; %UNTIL ((CH=RETURN) OR NOT CARRIER); %IF NOT CARRIER THEN STARTOVER; #END; # # # #PROCEDURE GOODBYE; #BEGIN %MOWRITELN(', THANKS FOR CALLING'); %STARTOVER; #END; # # # # # # #PROCEDURE INTRODUCTION;(*SETS UP LINEFEEDS AND DU%CH:=CHR(0); %REPEAT 'IF RCVRFULL THEN )BEGIN +X:=X+1; +CHREAD(CH); +IF ((CH=BACKSPACE) AND (X>1)) THEN -BEGIN + X:=X-2; /DELETE(LINE,X+1,1); -END +ELSE IF CH<>RETURN THEN -BEGIN /SHORTSTRING[1]:=CH; /LINE:=CONCAT(LINE,SHORTSTRING); NE); (REPEAT *IF NOT CARRIER THEN STARTOVER; (UNTIL TRANSEMPTY; (IF NEEDSLNFD THEN PUTCHREMOUT(LINEFEED); &END; # # #PROCEDURE MOREADLN(VAR LINE:LONGSTRING); #VAR X:INTEGER; 'SHORTSTRING:STRING[1]; #BEGIN %LINE:=''; %SHORTSTRING:='*'; %X:=0; RRIER THEN STARTOVER; %GETCHREMIN(CH); %CLEARREMIN; %IF NOT HALFDUPLEX THEN 'BEGIN )WHILE NOT TRANSEMPTY DO +IF NOT CARRIER THEN STARTOVER; )PUTCHREMOUT(CH); # END; #END;   #PROCEDURE MOWRITELN(LINE:LONGSTRING); &BEGIN (PUTLNREMOUT(LI PROCEDURE STARTOVER;  BEGIN "HANGUP; "SETCHAIN('MODEM:ANSWER'); "EXIT(PROGRAM);  END; !  PROCEDURE GOTERMINAL(MD:MODE;VAR SESSIONFLAG:FLAGVALS);  VAR STOP:BOOLEAN; $ $ #PROCEDURE CHREAD(VAR CH:CHAR); #BEGIN %WHILE NOT RCVRFULL DO 'IF NOT CA ! !BEGIN (* SETUP *) "INITVARS; "REPEAT #CASE SESSIONFLAG OF $BOOTUP:BEGIN ,SAYHELLO; ,MD:=ANSWER; ,SETUPANSWER(SESSIONFLAG); +END; $CONTINUE:IF MD=ANSWER THEN SETUPANSWER(SESSIONFLAG); $END; ! UNTIL SESSIONFLAG=CONTINUE; !END; ! VAR ST:LONGSTRING); #VAR LEN:INTEGER; #BEGIN %LEN:=LENGTH(ST); %IF (LEN > 10) THEN DELETE(ST,11,(LEN-10)); %ST:=CONCAT(ST,'.TEXT'); #END; # #  # #PROCEDURE LISTDIRECTORY; #VAR S:STRING[255]; 'DIR:TEXT; #BEGIN %RESET(DIR,'MODEM:LIST.TEXT'); %REPEAT 'READLN(DIR,S); 'MOWRITELN(S); %UNTIL EOF(DIR); %CLOSE(DIR,LOCK); #END; # # # #FUNCTION SEARCHDIRECTORY(NAME:STRING):BOOLEAN; #VAR S:STRING[255]; # FOUND:BOOLEAN; # DIR:TEXT; #BEGIN %(*$I-*) %RESET(DIR,'MODEM:LIST.TEXT'); %F# EXIT(PROGRAM); 'END; #END; $ # % #PROCEDURE MENU; # #BEGIN %REPEAT 'MOWRITELN(' CHOOSE MODE...'); 'MOWRITELN(' G)ET W)RITE R)UN H)ELP Q)UIT'); 'IF CARRIER THEN )BEGIN +CHREAD(CH); +IF CH IN ['G','W','R','H','C','Q','g','w','r','EPEAT 'MOWRITELN('EXACT NAME OF FILE TO RUN NEXT'); 'MOREADLN(S); 'MOWRITELN(S); 'MOWRITELN('CORRECT?(Y/N) KEY TO ABORT'); 'CHREAD(CH); %UNTIL (CH IN ['Y','y',ESC]); # IF CH=ESC THEN STARTOVER %ELSE 'BEGIN )SETCHAIN(S); MOWRITELN(' '); %MOWRITELN('HIT KEY G TO GET MESSEGES'); %MOWRITELN('KEY W TO WRITE MESSEGES'); %MOWRITELN('KEY R TO RUN TEACHING PROGRAMS'); %MOWRITELN('KEY Q TO QUIT THIS PROGRAM'); #END; # # #PROCEDURE MAKECHAIN; #VAR S:STRING[255]; #BEGIN %RNPUT THEN CHECKS IT WITH THE NEXT TEXT INFO WHICH &WOULD BE THE ANSWER. A RUNNING SCORE AND OTHER BELLS AND WHISTLES &COULD BE IMPLEMENTED *) #BEGIN %MOWRITELN('RUNNING PROGRAMS MODE NOT IMPLEMENTED YET'); #END; # # ) #PROCEDURE HELP; #BEGIN %%UNTIL (FILEEND OR NOT CARRIER); %CLOSE(F,LOCK); #END;(*CREATE*) % ) # #PROCEDURE PREFORM; #(* PLANNING TO INSERT A PROCEDURE THAT READ A TEXT FILE IF A LINE &EQUALS THE WORD COMMAND OR ANY OTHER SENTINAL WORD THEN THE PROGRAM &WAITS FOR REMIN IOR YOUR MESSEGE, ENTER AND HIT '); %MOREADLN(S); %IF SEARCHDIRECTORY(S) THEN REOPENFILE(S) %ELSE OPENNEWFILE(S); %MOWRITELN('ENTER MESSEGE... END BY TYPING THE WORD ''END'' ON A NEW LINE'); %REPEAT 'EDITLINE(FILEEND); NE:LONGSTRING; &BEGIN (DONE:=FALSE; (MOREADLN(LINE); (IF LINE='END' THEN DONE:=TRUE (ELSE WRITELN(F,LINE); (WRITEREMOUT(RETURN); (IF NEEDSLNFD THEN WRITEREMOUT(LINEFEED); &END;(*EDITLINE*) / #BEGIN %FILEEND:=FALSE; %MOWRITELN(' MAKE UP A NAME FFILE(FNAME); -EXIT(REOPENFILE); +END )ELSE +REPEAT + READLN(F,S); +UNTIL EOF(F); )WRITELN(F); )WRITE(F,'**** NEW MESSEGE ****'); )WRITELN(F,'FROM ',NAME); )WRITELN(F); 'END; & & & &PROCEDURE EDITLINE(VAR DONE:BOOLEAN); &VAR X:INTEGER; *LI-MOWRITELN('TROUBLE .. TRY A NEW FILENAME'); ' (*$I+*) -EXIT(CREATE); +END; )(*$I+*) 'END; & & PROCEDURE REOPENFILE(FNAME:LONGSTRING); 'BEGIN '(*$I-*) )KONCATTEXT(FNAME); )RESET(F,FNAME); -(*$I+*) )IF IORESULT <> 0 THEN +BEGIN -OPENNEWR L:TEXT; 'BEGIN )(*$I-*) )RESET(L,'MODEM:LIST.TEXT'); )IF IORESULT = 0 THEN +BEGIN -REPEAT /READLN(L,BUFF) -UNTIL EOF(L); -WRITELN(L,FNAME); -CLOSE(L,LOCK); +END; )KONCATTEXT(FNAME); )REWRITE(F,FNAME); )IF IORESULT <> 0 THEN +BEGIN T +READLN(F,BUFF); ) MOWRITELN(BUFF); )UNTIL EOF(F); )CLOSE(F,LOCK); 'END; # (*$I+*) #END; % ) #PROCEDURE CREATE; #VAR F:TEXT; # FILEEND:BOOLEAN; 'BUFF,S,FNAME:STRING[255]; ' # 'PROCEDURE OPENNEWFILE(FNAME:LONGSTRING); 'VANAME); 'MOWRITELN(' '); 'MOWRITELN(FNAME); 'MOWRITELN('CORRECT?(Y/N)'); 'CHREAD(CH); %UNTIL (CH IN ['Y','y']); %KONCATTEXT(FNAME); %(*$I-*) %RESET(F,FNAME); %IF IORESULT <> 0 THEN MOWRITELN('NO SUCH FILE,(SPELLED CORRECT?)') %ELSE 'BEGIN )REPEA% END; %UNTIL ((EOF(DIR)) OR FOUND); %CLOSE(DIR,LOCK); #END; # # # #PROCEDURE SEARCH; #VAR BUFF,FNAME:STRING[255]; # F:TEXT; #BEGIN %LISTDIRECTORY; %REPEAT 'MOWRITELN('ENTER NAME OF FILE EXACTLY FOLLOWED BY '); # MOREADLN(FOUND:=FALSE; %SEARCHDIRECTORY:=FALSE; %(*$I+*) %IF IORESULT <> 0 THEN 'BEGIN )MOWRITELN('TROUBLE-- LIST FILE NOT FOUND'); )EXIT(SEARCHDIRECTORY); 'END; %REPEAT 'READLN(DIR,S); 'IF S=NAME THEN *BEGIN ,FOUND:=TRUE; ,SEARCHDIRECTORY:=TRUE; h','c','q'] THEN .CASE CH OF 0'G','g':SEARCH; 0'W','w':CREATE; 0'R','r':PREFORM; 0'H','h':HELP; 0'C','c':MAKECHAIN; 0'Q','q':GOODBYE; .END; )END 'ELSE STARTOVER; %UNTIL (NOT CARRIER); #END; % , ' ' )  BEGIN (* GOTERMINAL *) "IF CARRIER THEN INTRODUCTION; "IF CARRIER THEN LOGIN; "IF CARRIER THEN MENU; "IF NOT CARRIER THEN STARTOVER; "IF CH IN ['Q','q'] THEN HANGUP;  END;(*GOTERMINAL*)    BEGIN(*MAIN*) !SESSIONFLAG:=BOOTUP; !REPEAT "SETUP(MD,CMMND,PAGEFLIP,BREAK,RESUME,HALFt  .th D\2"  ^r 2PREFORM HELP MAKECHAIMENU A5`0hh`hhh hHH`(hhhhhhhhHHHH`&hhh zzhHH` hhhhz)z  5z 5HH`8Hh`%N>~D \RHH`2hhhhhh  Hf'   f80) 8 OHHH`\_`{|}~]^@UQCB9^ZVKJDC|P`) [ f`4J  )HH`"hhHH`"hhhhhh HHHH`0hhhhhh HHHH`0hhhhhh  HHHH` 6hhhh  )*á/K0,,á ,,-á.-.V  Z?$Z?$ $ hhhhhh! L ֭HHHH`#>hhWAITING FOR A DIAL TONE... .ö h/٪P&צDIALING TYPE TO EXIT...-VצWAITING FOR A CARRIER,צTYPE TO EXIT'Ʉ˄LY?#á .Ljá, mLj[?$z#[?$ START DIALING á ..5 [?$z$OK!צ PLEASE WAIT TO HANG UP THE PHONE á ~&* Z?#Z?#z#" ُ؂",&.ǀ"áצWAITING FOR A DIAL TONE#YOU MAY TYPE TO@ dئת1ˡ#HZ [?#ǀ% & '( )+# $ !, Y?$Y?#Y?$Y?#ǀZ?#Z?#ت̀ʀš,ʀBGB B\ L 8ANSWERTEMICROMODFILER SETUP DUPLEX,NEEDSLNFD,SYSNAME,SYSNUMBER, )SPEED,FSKWORD,SESSIONFLAG); "IF CARRIER THEN GOTERMINAL(MD,SESSIONFLAG); !UNTIL SESSIONFLAG=ENDSESSION;  SETCHAIN('MODEM:ANSWER');  END.  6^3zr6bGx6bg6fWfwZ6jR`6jr6nH6nhN6rCT6rcf6vQl6vq6DONE 6;5X 6vLINE .:@árUبNUU  l ?٩[؞"á' ک[M ڢ[M Z ġ  . [M  צ files.á. [M [M   files,   unused blocks,   in largestM [M šI   šܚ [M :[M ȡ򩁉á צ of  ݢ BAD Codeצ Text Infogצ DataL Graf1צ FotozaH/۩[M á[Mar-Apr-May-Jun-Jul-Aug-|Sep-jOct-XNov-FDec-4???-" tdTD   blocks.t  צ%List,Vols,Prfx,Zero,Krunch,Rmov,Quit?h[M ݢݢ ݢ  -Jan-Feb-ܪP [٥áT٥ I[M ۥ[M ة[M !MR  [ ?Þ(ȍ Crunch buffer is  צNYá*Not a blocked volume'Undefined I-O error\`  "á8۪P [ ٥á ٥ ة[M !RPצ Duplicat file Not closedNot open Bad formatzRing buffer overflowPWrite protect error' cF#qBvצ Lost unit Lost fileצBad title, illegal file nameצNo room, insufficient spaceNo unit, no such volumeצNo such file on lineid unit numberBColon expected in vol name e@ سعצ Bad blockBad unit numberצBad modeצUndefined hardware errorRNܪPצ צ  á-:ˡšR `عצFile name is too longVolume name is too longצUnit number expectedkצInval0 š éj *áڥצ:P:áڥ #áJ ۪Pצ   á!:áš& ȡ:ة ȡ ةaz ةaAF R צ:ȡ@á:׶P!Rf#š}[  áܩ[M  * ܪ    Í [M  ⓡA é[M   ⍡  A #   z: Directory listing of? Pš4 ˡ Volumes on line: ȡW š<   :צ Prefix is: : Root is: : *Set prefix to? P.EZ j  & WAITING FOR A CALL*TYPE TO REVIEW LOG AND MESSEGE NAMES$ ddjá  byצ Dr. WoƁ-צMODEM:LOG.TEXT *Ɓ.Ɓ.צMODEM:LIST.TEXT *Ɓ.Ɓ a `_b cjim lnk ^~]\o^](Z  Welcome toצ TERMINALצ The smart terminal program" < p | XdH"(\0TH$dd dצ:ddx"Remove what file(s)? PšCˡ$  "!!!$|xtpl!hKz`" &.2"$&(*,.02468:<>@PbFHJfNZRTVnZ\^r$ >zfjM cc#Gצ Can't find dd dצ:ddx"Remove what file(s)? PšC ˡ$  " eeefef9dbdPdbbdP9Ä "l[M ddȡS[M ee9ef9fefefc[M cń[M צ[M ȡ[M [M [M [M M[#צNo action taken%7E# ڪتצ=b9PPbáO[M ddȡ4[M[M ڢڢצ$Remove file(s) and update directory?[M ġ[M  Removing [M [Crunch what volume? Pš= ˡ!  Endangered file(s) on  :[M ȡ3 ۏٕܩ۩ȡ[M ٕݢٕk ٪ [M  ȡ$MMš M  ة[:צ crunchedlory of? P ˡ! ک[M [M  $[M ܕצMoving ݢ,   blocks۩צDestroy : ?B[M Mة[Directory zeroed3No action. Directory preserved.Zero the directš á#ץ áI + á [M   š U Prefix is : (٪צANSWERING THE PHONE   6á á,6v>JN צMODEM:LIST.TEXT *Ɓ.Ɓ MODEM:ANSWER"  > Fت` 0ئת*dLddkń)daˡ"dN^vgWER la< xrXBd  " 2 .OOSE MODE...צ! G)ET W)RITE R)UN H)ELP Q)UITddd~zvrCwj((6"$&(D,.02468:<>@PDFHh^NPRTVXZ\hvbdfh dJ_hgfeZ1 ꥁáצ MODEM:ANSPE> KEY TO ABORT׮ddjdjá  צ CHOOSE MODE...צ! G)ET W)RITE R)UN H)ELP Q)UITddd~zvrCwj((6"$&(NING PROGRAMS MODE NOT IMPLEMENTED YET6 HIT KEY G TO GET MESSEGES׮KEY W TO WRITE MESSEGES׮KEY R TO RUN TEACHING PROGRAMS׮צKEY Q TO QUIT THIS PROGRAMצEXACT NAME OF FILE TO RUN NEXT#CORRECT?(Y/N) ƁƁƁƁ;ENTER MESSEGE... END BY TYPING THE WORD 'END' ON A NEW LINE׮Ɓ.ʁ.!\צ)RUNROUBLE .. TRY A NEW FILENAME׮ƀvZت "ˡ ! **** NEW MESSEGE ****צFROM yENDׯ Ɓ"ˡ&צNO SUCH FILE,(SPELLED CORRECT?)(ƁƀƁƀƁ ƁƁ2ZتƀƁƀMODEM:LIST.TEXT"á3ƀ/ƀƀ ƀƀƀ "ˡ&TTEXT̀"ˡ&TROUBLE-- LIST FILE NOT FOUND׮ƀ-ƀ-̀ƀ ʀƀƀEƁƂ- /ENTER NAME OF FILE EXACTLY FOLLOWED BY ׮ צ CORRECT?(Y/N)dddNédnÍdNédnÍء J  š .TEXT< ƀƁƀצMODEM:LIST.TEXTƀƀƀ ƀƀ5Zf ڪPƀƁƀMODEM:LIST.. 6Zt ( HIT FOR HELP WITH LOG IN FORMAT׮צ! HIT TO START LOGGING INdda^d^á ]צ CORRECT?(Y/N)ؓ) ddYédyÍTO START׮)THEN TYPE THE INITIAL OF YOUR FIRST NAME ׮.FOLLOWED BY YOUR LAST NAME IN FULL.. NO SPACES׮צJOHN DOE WOULD TYPE ... JDOE צ#THEN HIT TO END THE LOG INdv Ɓ-צ PLEASE WAIT..צMODEM:LOG.TEXTƁ@dHédhÍ צ+ WELCOME TO DR. PUNDIAK'S APPLE II COMPUTERצ%YOU CAN PICK UP AND WRITE MESSEGES...צ*YOU CAN RUN TEACHING PROGRAMS IN MEDICINE....׮)YOU MUST HIT WHEN ASKED damצ, THANKS FOR CALLING$צ DO YOU NEED LINEFEEDS?(Y/N)dd@@dYédyÍ* ARE YOU IN HALFDUPLEX OR FULLDUPLEX?(H/F)׮dd@(AND %2 ;MASK FORMAT FLAGS ETC. (STA TEMP ;SAVE IT (ASL A ;MULTIPLY X 10 (ASL A (ADC TEMP (ASL A (STA TEMP ;SAVE DIGIT TENS X 10 (LDA %1-1 ;GET DIGIT X 1 (STA ADDR ;DISCARD STACK BIAS (PLA (PLA (PLA (LDA %1 ;GET DIGIT X 10 (STA ADDR ;WRITE TO CLOCK (STA ADDR ;WRITE TO CLOCK (LDA DATA ;GET RESULT FROM CLOCK version 1.0  ;  ; macro definitions  ;  .MACRO POP (PLA (STA %1 (PLA (STA %1+1 (.ENDM  ;  .MACRO PUSH (LDA %1+1 (PHA (LDA %1 (PHA (.ENDM  ; (.MACRO DOIT (POP RETURN ;SAVE RETURN ADDRESS (PLA address for slot 4  ;  RETURN .EQU 00  TEMP .EQU 02  OLDT .EQU 04  ADDR .EQU 0C0C1  DATA .EQU 0C0C0  KEY .EQU 0C000 ;KEYBOARD ADDRESS  SYSDAY .EQU 0AA18 ; version 1.1  ;SYSDAY .EQU 0A912 ; ;---------------------------------------------  ; Pascal / Fortran routines to use the  ; California Computer Systems model 7424  ; Calendar / Clock Module  ;  ; David N. Jones 1/3/81  ;  ;--------------------------------------------  ; set upO^̡!ANSWER LOG:   ;WRITE TO CLOCK (STA ADDR ;WRITE TO CLOCK (LDA DATA ;GET RESULT FROM CLOCK (AND #0F ;MASK OFF 4 BITS (ADC TEMP ;ADD ONES TO TENS (STA TEMP ;SAVE RESULT (LDA #00 (PHA ;PUSH MSB OF VALUE = 0 (LDA TEMP ;GET RESULT (PHA ;PUSH RESULT TO STACK (PUSH RETURN ;RESTORE RETURN ADDRESS (RTS ;GO BACK TO CALLER  .ENDM   ;----(PUSH RETURN (RTS  ;  ; (.FUNC PRESSKEY  ; FUNCTION PRESSKEY:BOOLEAN  ; version of keypress that works with 80 col. displays  ; (POP RETURN (PLA (PLA (PLA (PLA (LDA #00 (PHA ;PUSH MSB = 0 (LDA #7F ;SLSB MONTH (ADC TEMP ;ADD SHIFTED DATE TO MONTH (STA SYSDAY ;STICK DATE TO MEMORY (TXA (STA SYSDAY+1 (PLA ;DISCARD MSB OF MONTH (LDA OLDT ;RETURN OLD DATE (PHA (LDA OLDT+1 (PHA SL A (ASL A (ASL A (ROL TEMP ;SHIFT CARRY TO FIRST BIT OF YEAR (LDX TEMP ;SAVE RESULT IN X (STA TEMP ;SAVE SHIFTED DATE FOR LATER (PLA ;DISCARD MSB DATE (PLA ;GET ;DISCARD STACK BIAS (PLA (PLA (PLA (PLA ;GET LSB YEAR (STA TEMP ;SAVE IT (PLA ;DISCARD MSB YEAR (PLA ;GET LSB DATE (ASL A ;SHIFT BIT 5 TO CARRY (A ; UPDATES THE PASCAL SYSTEM DATE AND RETURNS  ; AN INTEGER REPRESENTING THE OLD DATE  ; warning-this routine may be version dependent  ; (POP RETURN (LDA SYSDAY ;SAVE OLD DATE (STA OLDT (LDA SYSDAY+1 (STA OLDT+1 (PLA ;MASK OFF 4 BITS (PHA ;PUT RESULT ON STACK (PUSH RETURN  RTS  ;---------------------------------------------  .FUNC UPDATE,3  ; FUNCTION UPDATE(IMON,IDATE,IYEAR) .FUNC IDAY  ; FUNCTION IDAY:INTEGER  ; GETS THE DAY AS AN INTEGER  POP RETURN (PLA (PLA (PLA (PLA (LDA #00 (PHA ;PUT MSB=0 ON STACK (LDA #26 (STA ADDR (STA ADDR (LDA DATA ;GET DAY (AND #0F GETS THE DATE AS AN INTEGER  ; (DOIT #28,#0F  ;---------------------------------------------  .FUNC IYEAR  ; FUNCTION IYEAR:INTEGER  ; GETS THE YEAR AS AN INTEGER  ; (DOIT #2C,#0F  ;---------------------------------------------   ;---------------------------------------------  .FUNC IMON  ; FUNCTION IMON:INTEGER  ; GETS THE MONTH AS AN INTEGER  ; (DOIT #2A,#0F  ;---------------------------------------------  .FUNC IDATE  ; FUNCTION IDATE:INTEGER  ; FUNCTION IMIN:INTEGER  ; GETS THE MINUTES AS AN INTEGER  ; (DOIT #23,#0F  ;---------------------------------------------  .FUNC ISEC  ; FUNCTION ISEC:INTEGER  ; GETS THE SECONDS AS AN INTEGER  ; (DOIT #21,#0F ;GO BACK TO CALLER  ;--------------------------------------------- (.FUNC IHOUR  ; FUNCTION IHOUR:INTEGER  ; GETS THE HOURS AS AN INTEGER  ;  DOIT #25,#03  ;---------------------------------------------  .FUNC IMIN  ;0 (PHA ;PUSH MSB OF VALUE = 0 (LDA DATA ;GET RESULT FROM CLOCK (AND #0F ;MASK OFF 4 BITS (PHA ;PUSH RESULT TO STACK (PUSH RETURN ;RESTORE RETURN ADDRESS (RTS (PLA ;DISCARD STACK BIAS (PLA (PLA (PLA (PLA ;GET LSB OF PARAMETER (STA ADDR ;WRITE TO CLOCK (STA ADDR ;WRITE TO CLOCK (PLA ;DISCARD MSB OF PARAMETER (LDA #0----------------------------------------- (.FUNC GETIME,1  ; GET ONE DIGIT FROM CLOCK-  ;  ; FUNCTION GETIME(CODE:INTEGER):INTEGER  ;---------------------------------------------  ; (POP RETURN ;SAVE RETURN ADDRESS ETUP TO COMPARE TO 127  CMP KEY (BCC TRUE ; >127 GOTO TRUE (LDA #00 ;FALSE -RESULT =0 (JMP FINI  TRUE LDA #01 ;TRUE -RESULT =1  FINI PHA ;PUSH RESULT ON STACK (PUSH RETURN (RTS '.END O^a 1004 FORMAT(' date: ',I2,'-',A3,'-',I2)  1005 FORMAT(/' today is: ',A9) &STOP &END  2) IH-12,IMIN(),ISEC() &IF (IH.LE.12) WRITE(*,1003) IH ,IMIN(),ISEC()  1000 FORMAT(///' Welcome to U.C.S.D. Fortran')  1002 FORMAT(' time: ',I2,':',I2,':',I2,' PM')  1003 FORMAT(' time: ',I2,':',I2,':',I2,' AM') W.EQ.2) DAY='Sunday' &IF (IW.EQ.3) DAY='Monday' &IF (IW.EQ.4) DAY='Tuesday' &IF (IW.EQ.5) DAY='Wednesday' &IF (IW.EQ.6) DAY='Thursday' &IF (IW.EQ.7) DAY='Friday' &WRITE(*,1000) &WRITE(*,1005) DAY &WRITE(*,1004) ID,MON,IY &IF (IH.GT.12) WRITE(*,100IM.EQ.4) MON='Apr' &IF (IM.EQ.5) MON='May' &IF (IM.EQ.6) MON='Jun' &IF (IM.EQ.7) MON='Jul' &IF (IM.EQ.8) MON='Aug' &IF (IM.EQ.9) MON='Sep' &IF (IM.EQ.10)MON='Oct' &IF (IM.EQ.11)MON='Nov' &IF (IM.EQ.12)MON='Dec' &IF (IW.EQ.1) DAY='Saturday' &IF (I $USES CLOCKSTUFF  C234567890 PROGRAM TIME &CHARACTER*3 MON &CHARACTER*9 DAY &IH=IHOUR() &IM=IMON() &ID=IDATE() &IY=IYEAR() &IW=IDAY() &IOLD =UPDATE(IM,ID,IY) &IF (IM.EQ.1) MON='Jan' &IF (IM.EQ.2) MON='Feb' &IF (IM.EQ.3) MON='Mar' &IF (O^a+צJanP+צFebP+צMarP+צAprP+צMayPt+צJunPh+צJulP\+צAugPP+צSepPD+צOctP8+צNovP,+צDecP  zpf\RH>4*TP P }}TP}צ-Q}+ǡ}צ-ǢEAN;  FUNCTION UPDATE(IMON,IDATE,IYEAR:INTEGER):INTEGER; PROCEDURE DATE(VAR DATES:STRING);  PROCEDURE DAYOFWEEK (VAR DOW:STRING); $ $  IMPLEMENTATION L E M.WRK.TEXT*SYSTEM.WRK.CODE[*]APPLE2:SYSTEM.SWAPDISK  FUNCTION GETIME(DIGIT:INTEGER):INTEGER;  FUNCTION IHOUR:INTEGER;  FUNCTION ISEC :INTEGER;  FUNCTION IMIN :INTEGER;  FUNCTION IMON :INTEGER;  FUNCTION IDATE:INTEGER;  FUNCTION IYEAR:INTEGER; FUNCTION IDAY :INTEGER;  FUNCTION PRESSKEY :BOOLBB CLOCKSTU ='Tuesday '; (4 : DOW :='Wednesday'; (5 : DOW :='Thursday '; (6 : DOW :='Friday '; &END; (* OF CASE *) $END; (* DAYOFWEEK *)   BEGIN {Main Program}  (* DUMMY MAIN *)  END. $ &END; (* OF CASE *) &STR(IDATE,DAYS); &STR(IYEAR,YEARS); &DATES := CONCAT(DAYS,'-',MON,'-',YEARS); $END; (* DATE *) ! !PROCEDURE DAYOFWEEK; $BEGIN &CASE IDAY OF (0 : DOW :='Saturday '; (1 : DOW :='Sunday '; (2 : DOW :='Monday '; (3 : DOW :IN &CASE IMON OF (1 : MON :='Jan'; (2 : MON :='Feb'; (3 : MON :='Mar'; (4 : MON :='Apr'; (5 : MON :='May'; (6 : MON :='Jun'; (7 : MON :='Jul'; (8 : MON :='Aug'; (9 : MON :='Sep'; (10: MON :='Oct'; (11: MON :='Nov'; (12: MON :='Dec'; ISEC ; EXTERNAL;  FUNCTION IMIN ; EXTERNAL;  FUNCTION IMON ; EXTERNAL;  FUNCTION IDATE ; EXTERNAL;  FUNCTION IYEAR ; EXTERNAL;  FUNCTION IDAY ; EXTERNAL;  FUNCTION UPDATE; EXTERNAL; $ !PROCEDURE DATE; $VAR DAYS,MON,YEARS : STRING; $ $BEGINTEGER;  FUNCTION IDAY :INTEGER;  FUNCTION UPDATE(IMON,IDATE,IYEAR:INTEGER):INTEGER; PROCEDURE DATE(VAR DATES:STRING);  PROCEDURE DAYOFWEEK (VAR DOW:STRING); $ $  IMPLEMENTATION  FUNCTION GETIME; EXTERNAL;  FUNCTION IHOUR ; EXTERNAL;  FUNCTION (*$S+*)  UNIT CLOCKSTUFF; INTRINSIC CODE 24; "  INTERFACE  FUNCTION GETIME(DIGIT:INTEGER):INTEGER;  FUNCTION IHOUR:INTEGER;  FUNCTION ISEC :INTEGER;  FUNCTION IMIN :INTEGER;  FUNCTION IMON :INTEGER;  FUNCTION IDATE:INTEGER;  FUNCTION IYEAR:}}PZ|   wئ Saturday תP{צ Sunday Pjئ Monday תPYצ Tuesday PHئ WednesdayתP7צ Thursday P&ئ Friday תP~o`QB3$  2:SYSTEM.SWAPDISKGETIME IHOUR IDATE IDAY ISEC IMIN IMON IYEAR PRESSKEY UPDATE  ;  FUNCTION IYEAR:INTEGER; FUNCTION IDAY :INTEGER;  FUNCTION PRESSKEY :BOOLO^l try to help if you can't get them to work. " " ibrary using the 9LIBRARY program on APPLE3:. If you put the clock 9in slot 4 and use version 1.1 there is no reason 9to recompile and assemble the files. 9 9 9 "I have been using these programs for a couple of months now and had no "problems. I'loutines. 9 '4) STRFORT.TEXT - This file is an Apple Fortran version of the 9above program. Note that the string routines 9can't be used in fortran. 9 '5) CLKUNT1.1.CODE - This is a compiled and linked code file ready 9to be loaded into the system l9system library. Included are a couple of routines 9to return string values for the date and day of 9the week. 9 '3) START.TEXT - This file is a Pascal program that can be used 9as a SYSTEM.STARTUP program and demonstrates 9several of the clock r9to the proper address if the clock is in any 9other slot. Comments in the code show the 9usage of the routines. 9 '2) CLOCKUNIT.TEXT - This file contains a file to create a unit of 9the clock routines that can be installed in the E.TEXT - This file is the source code for the assembly 9language routines. It is set up for the clock 9in slot 4 and version 1.1 of Pascal. The proper 9system date address for version 1.0 is commented 9out if you want to use 1.0. ADDR must be changed Apple Pascal I decided to take a stab at it as my first  assembly language project. Here is the result. The clock functions can  be installed into the system library and called via the USES statment.  The following files are involved:   '1) GETIMPascal Unit for the California Computer Systems Calendar/Clock module     David N. Jones  6964 Walling Ln.  Dallas Tx. 75231  348-0604   14-Feb-81   Since the CCS model 7424 clock card does not come with any software to  interface it withO^ҢҢEAN;  FUNCTION UPDATE(IMON,IDATE,IYEAR:INTEGER):INTEGER; PROCEDURE DATE(VAR DATES:STRING);  PROCEDURE DAYOFWEEK (VAR DOW:STRING); $ $  IMPLEMENTATION L E M.WRK.TEXT*SYSTEM.WRK.CODE[*]APPLE2:SYSTEM.SWAPDISKEC:2,' PM') #ELSE WRITE (IHOUR:2,':',IMIN:2,':',ISEC:2,' AM');  UNTIL KEYPRESS;   (* UPDATE SYSTEM DATE *)  IOLD:=UPDATE(IMON,IDATE,IYEAR);  (* WRITELN (' OLD DATE=',IOLD); *)  END. $ rtran'); "WRITELN; "WRITELN; "DAYOFWEEK(DOW); (WRITELN(' today is : ',DOW); "DATE(DATES); (WRITELN(' date : ',DATES); " WRITE (' time : '); "REPEAT "GOTOXY(15,8); "IF (IHOUR>12) " THEN WRITE (IHOUR-12:2,':',IMIN:2,':',ISPROGRAM CLOCK;  USES APPLESTUFF,CLOCKSTUFF;  VAR  #DATES,DOW : STRING; ! IOLD : INTEGER; "   BEGIN {Main Program} "PAGE(OUTPUT); "WRITELN; "WRITELN; "WRITELN; "WRITELN(' Welcome to U. C. S. D. Pascal/Fo