Listing of file='FTAPE.SRC;07' on disk='vmedia/comm_pgms_source_code-sector.ccvf'
;FLOPPYTAPE>FTAPE.SRC;7 1981/03/16 15:00 ;SCPU,OCPU2 OPTION 35L ;-DECEMBER 21,1976 8080 CPU ;-INTECOLOR 8080 CPU OPER SYS. VER 4.0 ;-COPYRIGHT (C) 1975,1976 ;-BY INTELLIGENT SYSTEMS CORP. ;-EXTRACTED FROM INTEL'S MOD 80 MONITOR. ;-BY CHARLES A. MUENCH. RXBFA EQU 0 EXINA EQU 1 RSTA EQU 2 STBFA EQU 3 CMNDA EQU 4 BAUDA EQU 5 TXBFA EQU 6 EXOTA EQU 7 MASKA EQU 8 RXBFB EQU 16 EXINB EQU 17 RSTB EQU 18 STBFB EQU 19 CMNDB EQU 20 BAUDB EQU 21 TXBFB EQU 22 EXOTB EQU 23 MASKB EQU 24 BASIC EQU 5000H BASTA EQU BASIC+0006H X2EE EQU BASIC+0262H ORG 09E8EH X235: DS 2 ;BASIC PROG. START POINTER X237: DS 2 ;BASIC PROG. END POINTER ORG 09FF1H RATE2: DS 1 TEMP0: DS 1 TEMP1: DS 1 TEMP2: DS 1 ;-I/O DEVICE INPUT STATUS PORT 5501A BIT VALUES ;-BIT REST MNEMONIC DESCRIPTION ;-0 1 FRAMING ERROR ;-1 1 OVERRUN ERROR ;-2 0 SERIAL BEING RCVD ;-3 1 TTYDA RCVD BUFFER LOADED ;-4 1 TTYBE XMIT BUFFER EMPTY ;-5 1 INTERUPT PENDING ;-6 1 FULL BIT DETECT ;-7 1 START BIT DETECT ;-I/O DEVICE INPUT STATUS PORT 5501B BIT VALUES ;-BIT REST MNEMONIC DESCRIPTION ;-0 1 FRAMING ERROR ;-1 1 OVERRUN ERROR ;-2 0 SERIAL BEING RCVD ;-3 1 CRTDA RCVD BUFFER LOADED ;-4 1 CRTBE XMIT BUFFER EMPTY ;-5 1 INTERUPT PENDING ;-6 1 FULL BIT DETECT ;-7 1 START BIT DETECT ;-TTY I/O CONSTRAINTS TTYDA EQU 8 ;DATA AVAILABLE TTYBE EQU 10H ;TRANSMIT BUFFER EMPTY ;-CRT I/O CONSTRAINTS CRTDA EQU 8 ;DATA AVAILABLE CRTBE EQU 10H ;TRANSMIT BUFFER EMPTY CR EQU 0DH ;ASCII <CR> LF EQU 0AH ;ASCII <LF> ORG 002FH RATEB: DB 0A0H ;4800+1STOP ORG 0130H ;PRINT ANY MESSAGE STRING ENDING WITH 239 DEC. ;ALSO SUPPORTS REPEAT LOOPS OF THE FORM: ; 237,N,D1,D2,...,DM,238 WHERE N IS THE REPEAT COUNT OMESS: MOV A,M ;GET NEXT BYTE INX H ;POINTER CPI 237 ;SPECIAL CODE ? JC LL1 ;A<237: GO SEND BYTE JZ LL2 ;A=237: START REPEAT LOOP CPI 239 ;SPECIAL CODE ? RZ ;A=239: END: RETURN JC LL4 ;A=238: END OF REPEAT LOOP LL1: CALL CO ;SEND BYTE JMP OMESS ;GET NEXT BYTE LL2: MOV D,M ;GET REPEAT COUNT INX H ;BUMP POINTER LL3: PUSH H ;SAVE START POINTER JMP OMESS ;GET NEXT BYTE LL4: DCR D ;FINISHED REPEAT ? JZ LL5 ;YES POP H ;GET SAVED START POINTER JMP LL3 ;ENTER REPEAT LOOP AGAIN LL5: POP PSW ;CLEAN THE STACK JMP OMESS ;GET NEXT BYTE ORG 04A0H ;TEST THE KEYBOARD FOR A INPUT KETST: MVI A,4 OUT MASKA IN STBFA ;GET INTR STATUS ANI 20H ;TEST INTR BIT RZ ;NO KEY HIT IN RSTA ;CLEAR INTERRUPT RET ORG 05D2H ;-COMPARE HL WITH DE ;-IF HL < DE THEN CARRY=0, IF HL = DE THEN ;-CARRY=0, IF HL>DE THEN CARRY=1. CHLDE: MOV A,E ;DE = HL, SET/RES SUB L MOV A,D SBB H RET ;RETURN ORG 0606H ;-DECODE ASCII CHAR IN A-REGISTER INTO HEX DIGIT NIBBLE: SUI '0' RC ADI '0'-'G' RC ADI 6 JP NI0 ADI 7 RC NI0: ADI 10 ORA A RET ;RETURN ORG 0680H ; SHORT WAIT: 0.5 MS. / COUNT : ;STIM EQU 50 ;FOR 'WAIT' STATE IN ROM STIM EQU 63 ;FOR NO 'WAIT' STATE IN ROM WATS: PUSH PSW MVI A,STIM WS1: DCR A JNZ WS1 POP PSW DCR A JNZ WATS RET ; LONG WAIT: 20 MS. / COUNT : ;LTIM EQU 2347 ;FOR 'WAIT' STATE IN ROM LTIM EQU 2906 ;FOR NO 'WAIT' STATE IN ROM WATL: PUSH H WL1: LXI H,LTIM WL2: DCR L JNZ WL2 DCR H JNZ WL2 DCR A JNZ WL1 POP H RET ;+ ; THE FOLLOWING "WAIT" ROUTINE IS NOT EXACT ; NOR IS IT INTENDED TO BE ; ; IT IS INTENDED TO BE MY BEST GUESS ; OF THE FUNCTIONALITY PROVIDED BY THE ORIGINAL ; CODE WRITTEN IN 1976 ;- ORG 0717H WAIT3: CALL WAIT1 CALL WAIT1 WAIT1: XRA A ;CLEAR A WAIT: PUSH PSW ;SAVE COUNT XRA A ;CLEAR A WAITL: INR A JP WAITL ;128 TIMES ? POP PSW DCR A RZ JMP WAIT ;LOOP SOME MORE ;+ ; FLOPPY TAPE READ / WRITE ROUTINES ; ; TWR - WRITE TO FLOPPY TAPE ; TRD - READ FROM FLOPPY TAPE ; TVF - COMPARE MEMORY WITH FLOPPY TAPE ; ; INPUTS: ; HL - POINTER TO MEMORY BUFFER ; DE - DESIRED BYTE COUNT ; A - DRIVE/CHANNEL CODE ; BIT3 - DRIVE : 0 OR 1 ; BITS 2-0 - CHANNEL: 0 THRU 7 ; ; OUTPUTS: ; A WILL CONTAIN A STATUS CODE AND WILL ; HAVE BEEN TESTED (ORA A) : ; A= 0 : NO ERRORS ; A= 2 : KEYBOARD ABORT ; A= 4 : BUFFER TOO LARGE FOR WRITE ; A= 6 : BUFFER TOO SMALL FOR READ ; A=10 : CHECKSUM ERROR ; A=12 : VERIFY FAILURE ; ; IN ANY EVENT, HL WILL POINT 1 BYTE ; PAST THE LAST BYTE MANIPULATED. ;- TBFAD EQU TEMP0 ;BUFFER POINTER TMSK EQU TEMP2 ;VERIFY FLAG ORG 6800H TVF: MVI C,0FFH ;SET MASK FOR VERIFY JMP TRD1 ; TRD: MVI C,0 ;SET MASK FOR READ AND STORE TRD1: ANI 0FH ;SETUP FOR READ MOV B,A ;COPY OPERATION CODE MOV A,C ;GET "VERIFY" MASK STA TMSK ;SAVE IT LDA RATE2 ;GET BAUD RATE ORI 80H ;SET FOR 1 STOP BIT CALL TSUP ;SETUP FOR TRANSFER CALL WAIT1 ;WAIT A WHILE TRD2: MVI B,3 ;SET COUNTER TRD3: CALL RD ;READ A BYTE CPI 0D3H ;TEST FOR A D3 JNZ TRD2 ;NOT D3: RESET AND KEEP LOOKING DCR B ;SEEN 3 D3'S YET? JNZ TRD3 ;NO: KEEP LOOKING ; B NOW = 0 : INITIAL CHECKSUM SHLD TBFAD ;SAVE BUFFER POINTER CALL RD ;READ A BYTE MOV L,A ;SET LOW BYTE COUNT CALL RD ;READ A BYTE MOV H,A ;SET HIGH BYTE COUNT CALL CHLDE ;COMPARE BYTE COUNTS XCHG ;SET DE = TAPE BYTE COUNT LHLD TBFAD ;RESTORE BUFFER POINTER JC BFER ;ERROR: RECORD TOO LONG TRD4: CALL RD ;READ A BYTE PUSH PSW ;SAVE BYTE XRA M ;XOR WITH CURRENT MEMORY PUSH H ;SAVE BUFFER POINTER LXI H,TMSK ;POINT TO "VERIFY" MASK ANA M ;AND WITH MASK POP H ;RESTORE BUFFER POINTER JNZ VFER ;ERROR: VERIFY FAILURE POP PSW ;GET BYTE BACK MOV M,A ;STORE BYTE XRA B ;UPDATE CHECKSUM MOV B,A ;SAVE CHECKSUM INX H ;BUMP POINTER DCX D ;COUNT BYTE MOV A,D ;TEST ... ORA E ;... BYTE COUNT JNZ TRD4 ;NON-ZERO: LOOP CALL RD ;READ CHECKSUM XRA B ;TEST CHECKSUM JNZ CSER ;ERROR: CHECKSUM ERROR TNEX: ;NORMAL EXIT: A=0 MOV B,A ;SET CODE FOR "O.K." JMP TEX0 ;EXIT TWR: ORI 30H ;SETUP FOR WRITE MOV B,A ;COPY OPERATION CODE LDA RATE2 ;GET BAUD RATE ANI 7FH ;SET FOR 2 STOP BITS CALL TSUP ;SETUP FOR TRANSFER MVI B,3 ;SET COUNTER TWR1: CALL WAIT1 ;WAIT A WHILE CALL WR ;WRITE A NULL DCR B ;SENT 3 NULLS YET ? JNZ TWR1 ;NO: SEND ANOTHER ; B NOW = 0 : INITIAL CHECKSUM MVI A,0D3H ;SET D3 CALL WR ;WRITE ... CALL WR ;... 3 ... CALL WR ;... D3'S MOV A,E ;GET LOW BYTE COUNT CALL WR ;WRITE IT MOV A,D ;GET HIGH BYTE COUNT CALL WR ;WRITE IT TWR2: MOV A,M ;GET NEXT BYTE CALL WR ;WRITE IT XRA B ;UPDATE CHECKSUM MOV B,A ;SAVE CHECKSUM INX H ;BUMP POINTER DCX D ;COUNT BYTE MOV A,D ;TEST ... ORA E ;... BYTE COUNT JNZ TWR2 ;NON-ZERO: LOOP MOV A,B ;GET CHECKSUM CALL WR ;WRITE CHECKSUM TWR3: IN EXINB ;READ STATUS BYTE ANA C ;TEST BOL BIT JNZ TWR3 ;WAIT TILL BOL JMP TNEX ;NORMAL EXIT TSUP: OUT BAUDB ;SET RATE & STOP BITS MOV A,B ;COPY OPERATION CODE ANI 33H ;GET R/W & CHANNEL BITS RLC ;ROTATE LEFT MOV C,A ;SAVE IN C MOV A,B ;COPY OPERATION CODE ANI 08H ;GET DRIVE BIT ORA C ;MERGE WITH R/W & CHANNEL RLC ;POSITION ... RLC ;... CONTROL BYTE ... RLC ;... CORRECTLY PUSH PSW ;SAVE CONTROL BYTE ON STACK MVI C,04H ;SET DRIVE 0 HEAD BIT MASK ANI 40H ;TEST DRIVE BIT JZ DROK ;JUMP IF DRIVE 0 MVI C,08H ;SET DRIVE 1 HEAD BIT MASK MOV A,B ;POSITION ... RLC ;... HEAD BIT ... MOV B,A ;CORRECTLY DROK: IN EXINB ;READ STATUS BYTE XRA B ;XOR HEAD POSITION BITS ANA C ;TEST HEAD POSITION JZ HDOK ;ZERO: HEAD POSITION IS CORRECT OUT EXOTB ;ENERGIZE HEAD SOLENOID MVI A,226 ;SET TIME = 250 MS. CALL WAIT ;WAIT A WHILE OUT EXOTB ;DE-ENERGIZE HEAD SOLENOID CALL WAIT1 ;WAIT A WHILE IN EXINB ;READ STATUS BYTE XRA B ;XOR HEAD POSITION BITS ANA C ;TEST HEAD POSITION JZ HDOK ;ZERO: HEAD POSITION IS CORRECT CALL WAIT3 ;WAIT FOR "RECHARGE" JMP DROK ;GO HIT IT AGAIN HDOK: MOV A,C ;GET HEAD BIT MASK RLC ;CHANGE IT INTO ... RLC ;... BOL BIT MASK MOV C,A ;SAVE BOL BIT MASK WBOL: CALL KETST ;TEST FOR KEYBOARD INPUT JNZ ABRT2 ;ABORT IN EXINB ;READ STATUS BYTE ANA C ;TEST BOL BIT JNZ WBOL ;NON-ZERO: WAIT FOR IT POP PSW ;GET CONTROL BYTE OUT EXOTB ;SET CONTROL BYTE RET ;RETURN TO CALLER RD: IN EXINB ;READ STATUS BYTE ANA C ;TEST BOL BIT JZ LDER ;ERROR: LOAD FAILURE CALL KETST ;TEST FOR KEYBOARD INPUT JNZ ABRT1 ;ABORT IN STBFB ;READ STATUS BYTE ANI CRTDA ;GOT A BYTE YET ? JZ RD ;NO: WAIT FOR A BYTE IN RXBFB ;READ THE BYTE RET ;RETURN TO CALLER WR: PUSH PSW ;SAVE BYTE WR1: IN EXINB ;READ STATUS BYTE ANA C ;TEST BOL BIT JZ SZER ;ERROR: BUFFER TOO LARGE CALL KETST ;TEST FOR KEYBOARD INPUT JNZ ABRT2 ;ABORT IN STBFB ;READ STATUS BYTE ANI CRTBE ;READY YET ? JZ WR1 ;NO: WAIT TILL READY POP PSW ;RESTORE BYTE OUT TXBFB ;SEND THE BYTE RET ;RETURN TO CALLER VFER: MVI B,12 ;"VERIFY FAILURE" ERROR CODE JMP TEX2 ; CSER: MVI B,10 ;"CHECKSUM ERROR" ERROR CODE JMP TEX0 ; LDER: MVI B,8 ;"READ FAILURE" ERROR CODE JMP TEX2 ; BFER: MVI B,6 ;"BUFFER TOO SMALL" FOR READ ERROR JMP TEX0 ; SZER: MVI B,4 ;"BUFFER TOO LARGE" FOR WRITE ERROR JMP TEX4 ; ABRT1: MVI B,2 ;"KEYBOARD ABORT" ERROR CODE JMP TEX2 ; ABRT2: MVI B,2 ;"KEYBOARD ABORT" ERROR CODE TEX4: INX SP ;CLEAN UP THE STACK ... INX SP ;... TEX2: INX SP ;... INX SP ;... TEX0: MVI A,02H ;SET "IDLE" CONTROL BYTE OUT EXOTB ;OUTPUT "IDLE" CONTROL BYTE LDA RATE2 ;GET BAUD RATE OUT BAUDB ;RESTORE BAUD RATE & STOP BITS MOV A,B ;COPY ERROR CODE ORA A ;TEST ERROR CODE RET ;RETURN TO CALLER ; BASIC FLOPPY TAPE LOAD/SAVE : SAVE: CALL BSUP ;SETUP CALL TWR ;WRITE TO TAPE JNZ PERMS ;PRINT ERROR MESS & ERROR EXIT PMESS: LXI H,MSTB ;GET TABLE POINTER ADD L ;ADD ERROR CODE MOV L,A ; MOV E,M ;GET LO BYTE OF MESS. POINTER INX H ;BUMP TABLE POINTER MOV D,M ;GET HIGH BYTE OF MESS. POINTER XCHG ;PUT MESS. POINTER IN HL JMP OMESS ;PRINT MESSAGE & RETURN PERMS: CALL PMESS ;PRINT ERROR MESSAGE JMP X2EE ;ERROR EXIT TO BASIC LOAD: MOV C,D ;COPY "VERIFY" MASK LHLD X235 ;GET "START OF BUFFER" POINTER XCHG ;PUT IT IN DE LXI H,-28H ;COMPUTE END ... DAD SP ;... OF BUFFER CALL BSUP ;SETUP CALL TRD1 ;READ FROM TAPE MOV B,A ;SAVE ERROR CODE JZ LNEX ;NO ERRORS: NORMAL EXIT CPI 8 ;CHECKSUM ERROR ? JNZ PERMS ;NO: ERROR EXIT LDA TMSK ;GET "VERIFY" MASK ORA A ;TEST IT MOV A,B ;RESTORE ERROR CODE JNZ PERMS ;"LOAD?": ERROR EXIT LNEX: SHLD X237 ;STORE "END OF BUFFER" POINTER XRA A ;CLEAR A DCX H ;BUMP POINTER BACK MOV M,A ;STORE 3 NULLS ... DCX H ;... TO ALLOW POSSIBLE ... MOV M,A ;... RECOVERY FROM ... DCX H ;... ERROR ... MOV M,A ;... MOV A,B ;RESTORE ERROR CODE CALL PMESS ;PRINT MESSAGE JMP BASTA ;NORMAL RETURN TO BASIC BSUP: CALL NIBBLE ;CONVERT ASCII TO HEX VALUE JC NMER ;INVALID NAME PUSH PSW ;SAVE CONVERTED NAME MOV A,L ;COMPUTE ... SUB E ;... BYTE MOV L,A ;... COUNT MOV A,H ;... SBB D ;... MOV H,A ;... XCHG ;BUFF. PNTR. IN HL, B.C. IN DE POP PSW ;RESTORE CONVERTED NAME RET ;RETURN TO CALLER NMER: LXI H,NMERM ;POINT TO ERROR MESSAGE CALL OMESS ;PRINT ERROR MESSAGE JMP X2EE ;ERROR EXIT TO BASIC MSTB: DW BEEPM DW ABRTM DW PSZM DW PSZM DW LDERM DW CSERM DW VERM BEEPM: DB 7,239 ABRTM: DB 7,'KEYBOARD ABORT',CR,LF,239 PSZM: DB 7,'PROGRAM TOO LARGE',CR,LF,239 LDERM: DB 7,'LOAD FAILURE',CR,LF,239 CSERM: DB 7,'CHECKSUM ERROR',CR,LF,239 VERM: DB 7,'VERIFY FAILURE',CR,LF,239 NMERM: DB 7,'BAD NAME: MUST BE ' DB '0 THRU F HEX DIGIT',CR,LF,239 END ;Ricki A. Vick