10 GOTO 60
20 DIM A$(100),B$(100)
30 AA$,AB,AB$,AC,AC$,AD,AF,AF$,AG,AG$,AH,AI,AJ,AO,AP,AQ,AR,BD,D,E,E$,EP$,G,H,J,K,O,P,P$,Q,Q$,R,R$,S,S$,T$,V$,W$,Z$
40 CALL ACCKEY :: CALL CLS :: CALL DECHEX :: CALL DELAY :: CALL END :: CALL EQWS :: CALL FB :: CALL GS :: CALL HDG :: CALL PAUSE :: CALL PN
50 CALL SCREEN :: CALL START :: CALL WTSU
60 !@P-
100 ! GRAPHICOMP COPYRIGHT (C) 1991 by Barry Traver, 835 Green Valley Drive, Philadelphia, PA 19128 (phone: 215/483-1379)
110 CALL FB(2,12) :: DISPLAY AT(1,10):"GRAPHICOMP": :" Version 1.4a": :" for MICROpendium"
120 DISPLAY AT(7,6):"Copyright (C) 1991":" by Barry A. Traver":" All Rights Reserved!": : :"GRAPHICOMP is a limited XB"
130 DISPLAY AT(13,1):"graphics compiler to help beginners to learn assembly language. Limitations: Usesimple graphics statements"
140 DISPLAY AT(17,1):"with only constants (numericand string) as parameters. Use an XB LISTing as your input file." :: CALL PAUSE
170 CALL FB(16,14) :: DISPLAY AT(1,5)ERASE ALL:"Here are the XB commands": :"GRAPHICOMP 1.4a can handle:": : :" CALL CLEAR"
190 DISPLAY AT(8,1):" CALL HCHAR(A,B,C[,D])": :" CALL VCHAR(A,B,C[,D])": :" DISPLAY AT(A,B)):C$[;]": :" DISPLAY AT(A,B)ERASE ALL:C$"
210 DISPLAY AT(17,1):"More commands will be added": :"in GRAPHICOMP 1.4b in next": :"month's MICROpendium." :: CALL PAUSE
220 D,K,AR,BD=0 :: CALL FB(2,4) :: DISPLAY AT(2,1)ERASE ALL:"Here are your choices:"
230 DISPLAY AT(5,1):"1. Many output files, many entry points (one file for each line number, one entry point for"
240 DISPLAY AT(9,4):"each file)": : :"2. One output file, many entry points (again, one entry point for"
250 DISPLAY AT(15,4):"each line number)": : :"3. One output file, one entry point (i.e., one CALL LINK does it all!)"
260 DISPLAY AT(23,1)BEEP:"What is your choice?" :: CALL ACCKEY(23,22,"13",E) :: CALL FB(2,12)
270 DISPLAY AT(7,1):"Input (LISTing) File?": :" DSK" :: IF E=1 THEN DISPLAY AT(15,1):"Output Drive (1-9)? "
280 IF E<>1 THEN DISPLAY AT(13,1):"Output File? ": :" DSK" :: IF E=3 THEN DISPLAY AT(19,1):"Entry Point?":"":" START"
290 ACCEPT AT(9,2)SIZE(-27):P$ :: ON ERROR 300 :: OPEN #2:P$,INPUT :: ON ERROR STOP :: CALL SCREEN(12) :: DISPLAY AT(24,1):"" :: GOTO 320
300 ON ERROR 310 :: CLOSE #2
310 CALL SCREEN(10) :: DISPLAY AT(24,3):"Disk Error - Try Again!" :: RETURN 290
320 IF E=1 THEN 380 ELSE ACCEPT AT(15,2)SIZE(-27):P$ :: ON ERROR 360 :: OPEN #1:P$,OUTPUT :: ON ERROR STOP
330 CALL SCREEN(12) :: DISPLAY AT(24,1):"" :: CALL HDG :: IF E=2 THEN 390
340 ACCEPT AT(21,2)VALIDATE(UALPHA)SIZE(-6):EP$ :: PRINT #1:"* ACCESSED BY":"* CALL LINK(""&EP$&"")":"" :: GOTO 390
360 ON ERROR 370 :: CLOSE #1
370 CALL SCREEN(10) :: DISPLAY AT(24,3):"Disk Error - Try Again!" :: RETURN 320
380 CALL ACCKEY(15,21,"19",AB)
390 CALL FB(2,8) :: PRINT "EXTENDED BASIC CODE:": :
400 IF EOF(2)THEN PRINT "EMPTY FILE!" :: STOP ELSE LINPUT #2:T$ :: IF T$="" THEN 400 ELSE 450
440 IF EOF(2)THEN 670 ELSE LINPUT #2:T$
450 IF LEN(T$)=80 THEN LINPUT #2:P$ :: T$=T$&P$! DV80 BAND-AID
480 PRINT T$ :: D=D+1 :: A$(D)=T$ :: B$(D-1)="L"&SEG$(T$,1,POS(T$," ",1)-1) :: IF POS(T$,"GOTO",1)<>0 THEN 440
490 AD=POS(T$," ",1) :: IF SEG$(T$,AD+1,1)="!" OR SEG$(T$,AD+1,3)="REM" THEN 440
530 IF E=1 THEN 440
550 IF POS(T$,"CALL CLEAR",1)<>0 OR POS(T$,"DISPLAY AT",1)<>0 THEN BD=(BD OR 2) :: GOTO 440
590 IF POS(T$,"CALL HCHAR",1)<>0 OR POS(T$,"CALL VCHAR",1)<>0 THEN BD=(BD OR 2) :: GOTO 440
660 GOTO 15000! ERROR
670 CALL DELAY(100) :: CALL FB(2,16) :: DISPLAY AT(11,11)ERASE ALL:"ENTERING": :TAB(10);"CONVERSION": :TAB(11);"SECTION!" :: CALL DELAY(100)
680 IF E>1 THEN DISPLAY ERASE ALL :: CALL FB(16,5) :: PRINT "ASSEMBLY CODE:":"" :: CALL GS(BD,AR)
690 IF E<>3 THEN 710
700 FOR R=0 TO 1 :: PRINT #R:"* DEFINE ENTRY POINT": :" DEF "&EP$: :EP$;TAB(8);"LWPI WS":" B @"&B$(0):"" :: NEXT R
710 FOR Q=1 TO D :: T$=A$(Q) :: AD=POS(T$," ",1) :: S$=SEG$(T$,1,AD-1) :: Q$=S$&RPT$(" ",6-LEN(S$)) :: CALL FB(2,8)
720 DISPLAY AT(11,1):"EXTENDED BASIC LINE:": :T$ :: CALL DELAY(100) :: IF POS(T$,"GOTO",1)<>0 THEN GOSUB 14000 :: GOTO 915
740 AD=POS(T$," ",1) :: IF SEG$(T$,AD+1,1)="!" THEN GOSUB 14000 :: GOTO 915
750 AD=POS(T$," ",1) :: IF SEG$(T$,AD+1,3)="REM" THEN GOSUB 14000 :: GOTO 915
770 IF POS(T$,"CALL CLEAR",1)<>0 THEN GOSUB 2000 :: GOTO 910
810 IF POS(T$,"DISPLAY AT",1)<>0 THEN GOSUB 6000 :: GOTO 910
820 IF POS(T$,"CALL HCHAR",1)<>0 THEN AF$="H" :: AG$="INC R0" :: GOSUB 7000 :: GOTO 910
890 IF POS(T$,"CALL VCHAR",1)<>0 THEN AF$="V" :: AG$="AI R0,32" :: GOSUB 7000 :: GOTO 910
900 GOTO 15000! ERROR
910 Z$=""
915 IF E<>3 THEN 930 ELSE IF Q=D THEN CALL END(5,Z$) :: GOTO 930
920 FOR R=0 TO 1 :: PRINT #R:"* BRANCH TO NEXT SECTION":"":Z$;TAB(8);"B @"&B$(Q):"" :: NEXT R
930 NEXT Q :: IF E=1 THEN 980 ELSE CALL FB(2,8) :: DISPLAY AT(12,10):"End-Of-File": :TAB(8);"FOR INPUT FILE" :: CALL DELAY(100)
940 DISPLAY ERASE ALL :: CALL FB(16,5) :: PRINT "ASSEMBLY SOURCE CODE:": :
960 FOR R=0 TO 1 :: PRINT #R:"* GENERAL WRAPUP":"" :: NEXT R :: CALL END(3,"") :: IF K THEN CALL WTSU
970 CALL END(24,"")
980 CLOSE #2 :: DISPLAY ERASE ALL :: CALL SCREEN(4) :: DISPLAY AT(11,11):"FINISHED!" :: DISPLAY AT(13,1)BEEP:" Another file (Y/N)?"
990 CALL ACCKEY(13,25,"YN",S) :: IF S THEN 220 ELSE DISPLAY ERASE ALL :: STOP
2000 ! CLEAR
2010 CALL START(E,AB,S$,T$) :: IF E=1 THEN CALL EQWS(10)
2020 CALL PN(E,S$,Z$) :: CALL CLS(E,S$) :: IF E=1 THEN CALL END(27,"")ELSE IF E=2 THEN CALL END(5,"")
2030 RETURN
6000 ! DISPLAY AT
6010 G=0 :: K=1 :: AD=POS(T$,"ERASE ALL",1) :: IF AD<>0 THEN G=1
6020 AF=POS(T$,"DISPLAY AT(",1)+10 :: AG=POS(T$,",",AF+1) :: AH=POS(T$,")",AG+1) :: AI=POS(T$,""",AH+1) :: AJ=POS(T$,""",AI+1)
6030 AP=VAL(SEG$(T$,AF+1,AG-AF-1)) :: H=VAL(SEG$(T$,AG+1,AH-AG-1)) :: AO=32*(AP-1)+(H-1)+2 :: V$=SEG$(T$,AI+1,AJ-AI-1)
6040 IF SEG$(T$,AJ+1,1)<>";" THEN V$=V$&RPT$(" ",28-(H+LEN(V$))+1)
6050 R$=STR$(LEN(V$)) :: W$="'"&V$&"'" :: CALL START(E,AB,S$,T$) :: IF E=1 THEN CALL EQWS(10)ELSE R=1 :: GOTO 6130
6060 FOR R=0 TO 1 :: PRINT #R:"* TEXT FOR MESSAGE": :"T"&Q$&"TEXT "&W$:" EVEN":"" :: NEXT R
6070 CALL PN(E,S$,Z$) :: IF G THEN CALL CLS(E,S$) :: IF AD<>0 THEN Z$=""
6080 FOR R=0 TO 1
6090 PRINT #R:"* DISPLAY MESSAGE": :Z$;TAB(8);"LI R0,"&STR$(AO):" LI R1,"&"T"&S$:" LI R2,"&R$:" BLWP @VMBWS":""
6100 NEXT R :: IF E=1 THEN CALL END(3,"")ELSE IF E=2 THEN CALL END(5,"")
6110 IF E=1 THEN CALL WTSU :: CALL END(8,"") :: CLOSE #1
6120 RETURN
6130 J=ASC(SEG$(V$,R,1)) :: IF J<32 OR J=39 OR J>127 THEN 6140 :: R=R+1 :: IF R>LEN(V$)THEN 6060 ELSE 6130
6140 FOR R=0 TO 1 :: PRINT #R:"* DATA FOR DISPLAY":"":"T"&Q$ :: NEXT R :: AC$=" BYTE " :: FOR P=1 TO LEN(V$) :: O=ASC(SEG$(V$,P,1))
6150 IF O<30 THEN O=O+128
6160 AC$=AC$&STR$(O)&","
6170 IF P/8=INT(P/8)OR P=LEN(V$)THEN AC$=SEG$(AC$,1,LEN(AC$)-1) :: FOR R=0 TO 1 :: PRINT #R:AC$ :: NEXT R :: AC$=" BYTE "
6180 NEXT P :: FOR R=0 TO 1 :: PRINT #R:" EVEN":"" :: NEXT R :: GOTO 6070
7000 ! HCHAR AND VCHAR
7010 AF=POS(T$,"CALL "&AF$&"CHAR"&"(",1)+10 :: AG=POS(T$,",",AF+1) :: AH=POS(T$,",",AG+1) :: AI=POS(T$,",",AH+1)
7020 IF AI<>0 THEN AQ=1 ELSE AI=POS(T$,")",AH+1) :: AQ=0 :: GOTO 7040
7030 AJ=POS(T$,")",AI+1)
7040 AP=VAL(SEG$(T$,AF+1,AG-AF-1)) :: H=VAL(SEG$(T$,AG+1,AH-AG-1)) :: E$=STR$(VAL(SEG$(T$,AH+1,AI-AH-1))+96) :: CALL DECHEX(E$,2)
7050 AA$=STR$(32*(AP-1)+(H-1)) :: IF AQ=1 THEN AB$=SEG$(T$,AI+1,AJ-AI-1)ELSE AB$="1"
7060 CALL START(E,AB,S$,T$) :: IF AF$="H" THEN AC=(32*(AP-1)+(H-1)+VAL(AB$)>768)ELSE AC=(AP+VAL(AB$)>24)
7070 IF E=1 THEN CALL EQWS(10)
7080 CALL PN(E,S$,Z$) :: FOR R=0 TO 1 :: PRINT #R:"* WRITE "&AF$&"CHAR": :Z$;TAB(8);"LI R0,"&AA$:" LI R1,>"&E$&"00"
7090 PRINT #R:" LI R2,"&AB$:AF$&Q$&"BLWP @VSBW":" "&AG$
7100 IF AC THEN PRINT #R:" CI R0,768":" JLT C"&S$:" AI R0,-"&STR$(767-(AF$="H")):"C"&S$;
7110 PRINT #R:TAB(8);"DEC R2":" JGT "&AF$&Q$:"" :: NEXT R :: IF E=1 THEN CALL END(27,"")ELSE IF E=2 THEN CALL END(5,"")
7120 RETURN
14000 ! REM AND ! (AND GOTO)
14010 CALL START(E,AB,S$,T$) :: IF E=1 THEN CALL EQWS(8)
14020 CALL PN(E,S$,Z$) :: T$="* "&T$ :: FOR R=0 TO 1 :: PRINT #R:SEG$(T$,1,80) :: IF LEN(T$)>80 THEN PRINT #R:"* "&SEG$(T$,81,LEN(T$)-80)
14030 IF POS(T$,"GOTO",1)<>0 THEN PRINT #R:"* NOT IMPLEMENTED!"
14040 PRINT #R:"" :: NEXT R :: IF E=1 THEN CALL END(27,"")ELSE IF E=2 THEN CALL END(5,"")
14050 RETURN
15000 ! ERROR
15010 CALL SCREEN(10) :: PRINT: :"E R R O R !": : :"An error in processing has occurred. Please check the"
15020 PRINT "input file at point where the problem occurred." :: CALL DELAY(300) :: STOP
29999 !@P+
30000 SUB DECHEX(A$,A) :: IF SEG$(A$,1,1)="-" AND VAL(A$)>-129 THEN A$=STR$(256-VAL(SEG$(A$,2,LEN(A$)-1)))
30010 B=0 :: C=LEN(A$) :: FOR D=1 TO C :: B=B+(POS("0123456789ABCDEF",SEG$(A$,D,1),1)-1)*10^(C-D) :: NEXT D :: A$=""
30020 E=INT(B/16) :: A$=SEG$("0123456789ABCDEF",B-16*E+1,1)&A$ :: IF E<>0 THEN B=E :: GOTO 30020
30030 IF A<>0 THEN IF LEN(A$)<A THEN A$="0"&A$ :: GOTO 30030
30040 SUBEND
30050 SUB DELAY(A) :: FOR B=1 TO A :: NEXT B :: SUBEND
30300 SUB FB(A,B) :: DISPLAY ERASE ALL :: FOR C=0 TO 14 :: CALL COLOR(C,A,1) :: NEXT C :: CALL SCREEN(B) :: SUBEND
30310 SUB START(A,B,A$,B$) :: CALL FB(16,5) :: PRINT "ASSEMBLY SOURCE CODE:": : :
30320 IF A=1 THEN OPEN #1:"DSK"&STR$(B)&".L"&A$&"/S",OUTPUT :: CALL HDG
30330 FOR C=0 TO 1 :: PRINT #C:"* ASSEMBLY EQUIVALENT OF" :: IF LEN(B$)<79 THEN PRINT #C:"* "&B$ :: GOTO 30350
30340 C$="* "&SEG$(B$,1,78) :: D$="* "&SEG$(B$,79,LEN(B$)-78) :: PRINT #C:C$:D$
30350 IF A=3 THEN 30380
30360 PRINT #C:"* ACCESSED BY":"* "&A$&" CALL LINK("L"&A$&"")":"":"* DEFINE ENTRY POINT": :" DEF L"&A$
30380 PRINT #C:"" :: NEXT C :: SUBEND
30400 SUB PN(A,A$,B$) :: B$="L"&A$&RPT$(" ",5-LEN(A$)) :: IF A=3 THEN SUBEXIT
30410 FOR B=0 TO 1 :: PRINT #B:"* PROGRAM START": :B$&" LWPI WS":"" :: NEXT B :: B$="" :: SUBEND
30430 SUB END(A,B$) :: FOR B=0 TO 1 :: IF(A AND 1)THEN PRINT #B:"* RETURN TO XB":""
30440 IF(A AND 2)THEN PRINT #B:"RETURN LWPI GPLWS":" B @BASIC":""
30450 IF(A AND 4)THEN PRINT #B:B$;TAB(8);"B @RETURN":""
30460 IF(A AND 8)THEN PRINT #B:" END":""
30470 NEXT B :: IF(A AND 16)THEN CLOSE #1
30480 SUBEND
30490 SUB CLS(E,B$) :: IF E=3 THEN L$="L"&B$ ELSE L$=""
30495 FOR A=0 TO 1 :: PRINT #A:"* CLEAR THE SCREEN": :L$;TAB(8);"CLR R0":" LI R1,>8000":" LI R2,768"
30500 PRINT #A:"C"&B$;TAB(8);"BLWP @VSBW":" INC R0":" DEC R2":" JGT C"&B$:""
30510 NEXT A :: SUBEND
30520 SUB EQWS(A) :: FOR B=0 TO 1
30530 PRINT #B:"* XB EQUATES":"":"BASIC EQU >006A":"GPLWS EQU >83E0"
30550 IF(A AND 2)THEN PRINT #B:"VSBW EQU >2020"
30570 PRINT #B:""
30580 NEXT B :: IF(A AND 8)THEN CALL WS
30590 SUBEND
30600 SUB WTSU :: FOR A=0 TO 1
30610 PRINT #A:"* WRITE-TO-SCREEN UTILITY": :"VMBWS DATA VWS,VPN":"VWS BSS 32":"VPN MOV *R13,R0":" MOV @2(R13),R2"
30620 PRINT #A:" MOV @4(R13),R3":"VLP MOVB *R2+,R1":" AI R1,>6000":" BLWP @VSBW":" INC R0":" DEC R3"
30630 PRINT #A:" JNE VLP":" RTWP":"" :: NEXT A :: SUBEND
30650 SUB GS(A,B) :: FOR C=0 TO 1 :: PRINT #C:"* GENERAL SETUP":"" :: NEXT C :: CALL EQWS(A) :: CALL WS :: SUBEND
30710 SUB PAUSE :: DISPLAY AT(24,1):"(Press any key to continue.)"
30720 CALL KEY(0,A,B) :: IF B<1 THEN 30720
30730 DISPLAY ERASE ALL :: SUBEND
30740 SUB WS :: FOR A=0 TO 1 :: PRINT #A:"* DEFINE WORKSPACE": :"WS BSS 32":"" :: NEXT A :: SUBEND
30770 SUB HDG :: PRINT #1:"* THIS ASSEMBLY SOURCE CODE":"* WAS CREATED BY":"* GRAPHICOMP (VERS. 1.4a),":"* AN XB GRAPHICS COMPILER"
30780 PRINT #1:"* BY BARRY A. TRAVER":"* 835 GREEN VALLEY DRIVE":"* PHILADELPHIA, PA 19128":"* (PHONE: 215/483-1379)":"" :: SUBEND
30790 SUB ACCKEY(A,B,A$,C) :: CALL GCHAR(A,B+2,D) :: DISPLAY AT(A,B)BEEP:CHR$(D); :: E=0
30800 CALL KEY(0,F,G) :: E=E+1 :: IF E=5 THEN CALL HCHAR(A,B+2,30)
30810 IF E=10 THEN CALL HCHAR(A,B+2,D) :: E=0
30820 IF G<1 THEN 30800 ELSE IF F>96 THEN F=F-32
30830 IF F=13 THEN F=D
30840 IF A$<>"YN" THEN 30850
30845 IF CHR$(F)<>"Y" AND CHR$(F)<>"N" THEN 30800 ELSE CALL HCHAR(A,B+2,F) :: C=F :: IF C=89 THEN C=1 :: SUBEXIT ELSE C=0 :: SUBEXIT
30850 IF CHR$(F)<SEG$(A$,1,1)OR CHR$(F)>SEG$(A$,2,1)THEN 30800
30860 CALL HCHAR(A,B+2,F) :: IF F>64 THEN F=F-64
30870 IF F>48 THEN F=F-48
30880 C=F :: SUBEND
1
GRAPHICOMP1.jpg 95.73K
0 downloads
