IMD 1.15: 15/05/2007 13:25:41 fog hak 004         -FOG/HAK004DUMP24X COMROM ASM ROM DOC JRNL BASh PASSWORDBAS RESIZE DOC RESIZE2 BAS"RESIZE3 BAS"POW ASM<POWCMDS POW" !"POWTEXT POW#DOWHILESLIB$NCOMPARELIB %SELECTS LIB&SEQIO LIBR'()*+,DISK DOC-!9" 1& 2 :):og,ʺw!M CP/M DUMP UTILITY VERS 1.33B $, yCOPYRIGHT 1978 BY S. J. SINGER $X È *$ >2 1& 2 !" !s# © >!\!s# !~:+~AX2 x~# !@$x?G ## 7!@4<VALIDATEU!@OTGROUPq!@giG q!@|MAP!@ÕDIR !@íTRACK!@T ~!#:0 ?))) O }` 2 !  @ SECTOR+!@&(S :}` 2 2 " @NO-t:}` 2 ! nG~2 pÔ* @ÈEDITnÛ EDIT - $ !  s# ª  >! WRITE! STOPڔ!0 Ô ERROR - TRACK $ : !ow> SECTOR $4 !: ow  >2  ʔ:}` 2 2  ͡: <2 ŒÔ&: oT))): _><ڵF 2 ~2 2 : _`o" !"  GROUP ALLOC O))))  }#.z |-}z "   UGƐ'@'_: >: >  * ~>  ! s# ƒ  > }ҧ.Ù : ʷ}* w  : <2 ;!" &Î*.*"Ô : O*.!"| : ATION MAP DRIVE - $ % $!  * G $:  ~t b 0$`  : <2 Á y 1$w  xœ yœ zœ ø U #R   2 $  * w GROUPS REMAINING ON DISK OUT OF 243 O*." ڤ : _*.'"$A DRIVE $) R -$O e TRACK $] !: oÝ ڀ |w{0__wí SECTOR $ !: ow  ͞! : 4: A_>2 >2 ÔE6# >$  ÔÔ: : _2 <2 : O*.!"5 : O*."G *."R *.'"] q INPUT ERROR$c  ÔÙ INCORRECT SECTOR NUMBER$  Ô INCORRECT TRACK NUMBER$  Ô INCORRECT GROUP NUMBER (GREATER THAN 242)$   w#    .)w# 7y4# / w# 6!\W e!`cCOMl!" : _\ \”͞Â: Á!" * : >: >ÿ $ ~>  #y      * ~Ô) NO FILE BY THAT NAME ON DRIVE $  ÔL DISK DEAD ERROR$:   o ERROR IN FILE NAME$Z  ÔÎ ADDRESS ERROR$}  Îù ERROR - HEX INPUT ONLY $  ;  : _* $ $R (GREATER   >._#y +     ^* " * " æ>2 2 : _: O*."wڤ : O*.!"| *.'" ^: 2 |<2 |: COMMAND, RE-EXECUTE ;DDT.COM WHEN THROWN BACK INTO CP/M, AND DUMP OR LIST ;OR EVEN MOVE DATA TO 100 HEX! EXIT DDT AND USE SAVE ;COMMAND TO SAVE 16 PROMS.COM FOR DISSASEMBLY BY ;ANY DISSASEMBLER (LIKE ZESOURCE.COM) AND MAYBE YOU WILL ;FIND EVEN MORE FASCINATING THINGS OUT ABOUT YOUR ;OSBORNE!! ; ; ;PROGRAM BEGINS HERE ; ORG 4000H ;PUT ABOVE SYSTEM PROM AREA DI ;DISABLE INTERRUPTS OR IT WON'T WORK XRA A ;TURN ON PROMS OUT 00H STA 0EF08H ;LET SYSTEM KNOW WE ARE IN PROM LXI B,1000H ;MAKE COUNTER FOR 4K BYTES TO MOVE LXI H,0000H ;AND MOVE DATA STARTING FROM ADDRESS 0 LXI D,8000H ;AND PUT IT IN HIGH RAM AT 8000H MOVE MOV A,M ;GET A BYTE OF PROM STAX D ;SAVE IT IN RAM INX H ;BUMP PROM POINTER INX D ;BUMP RAM POINTER DCX B ;DE-BUMP BYTE COUNT TO MOVE MOV A,B ;CHECK IF;------------------------------------------------ ;GET PROM PROGRAM AS SEEN IN LIFELINES MAGAZINE ;DECEMBER 1981....ENTERED BY BYRON MCKAY ; ;LANGUAGE: CP/M ASM ;TYPE : UTILITY ;PURPOSE: USED TO DISCOVER INTERNAL DETAILS OF THE ;SYSTEM ROMS FOR THE  ALL DATA MOVED ORA C JNZ MOVE ;LOOP UNTILL ALL 4K PROM MOVED TO RAM MVI A,1 ;TURN OFF PROMS OUT 1 STA 0EF08H ;LET SYSTEM KNOW WE ARE IN RAM EI ;ENABLE INTERRUPTS JMP 0000H ;WARM BOOT CP/M END    THIN ABOU WHAԠ ɠ DIĠ HER I YO DON'Ԡ PROGRA͠ BUԠ AR LOOKINǠ FOҠ GOO WA T SUBMI THINGӠ TϠ TH LIBRARY!! JUS FIN GOO ARTICL AN COP٠ TH LISTING, DEBUG IT AND SUBMIT IT!! BYRON MCKAY  DECEMBER 20, 1981 !! JUS FIN GOO ARTICL AN COP٠ TH LISTING, DEBUG IT AND SUBMIT IT!! BYRON MCKAY  DOCUMENTATION FOR ROM.ASM THIӠ LIBRAR٠ ENTR I NOTHIN MOR THA SHOR PROGRA͠ COPIE FRO LIFELINEӠ MAGAZINŠ DECEMBE ISSUE THŠ PROGRA͠ I VER SIMPLISTIà IΠ IT APPROACȠ TϠ GETTINǠ TH PROMӠ OΠ THŠ OSBORN TURNE O AN READIN THEM TH REA DAT CA B SAVEĠ (PROMS.COM ANĠ THEΠ RUΠ THRՠ DIS- ASSEMBLE O TH USER CHOOSING TH SOURC COD I CALLE "ROM.ASM PR AN HE FILE AR INCLUDE WITȠ THŠ PACKAGE ALS VERSIOΠ 1. MONITO MACHIN (M OWN!! WA REA AN TH ROM SAVEĠ I THŠ FIL "PROMS.COM TH FIL LENGT I 1 BLOCK (APP 4K HAV FU DIS-ASSEMBLINǠ IT! PLEAS SUBMI AN FINDING YO MIGH HAV T TH LIBRARY HOP YO ENJO IT!! P.S YO MIGH  REM INITIALIZE R2=35 R1=0 C9=40: R9=35 E1=1: E2=30: X3=40: I1=31: I2=35: A1=C9+1:A2=C9+1:B1=C9+1 LIN$="--------------------------------------------------------" B2=C9+1: X1=C9+1: X2=C9+1 DIM D(C9,R9), T$(C9) REM CLEAR COLUMN NAMES TO BLANKS F NEXT ID CLOSE 1 PRINT: PRINT 95 INPUT "WANT TO SEE COMMAND LIST? (Y OR N)";YN$ IF YN$="N" THEN 543 IF YN$<>"Y" THEN 95 PRINT: PRINT PRINT "E = ENTER. (ECCRR) ENTERS A VALUE IN COLUMN AND ROW SPECIFIED" PRINT "A = ACCUMULATE. (ACCRR) ADDS VALUES EOR I=0 TO C9 T$(I)=" " NEXT I REM INSERT COLUMN NAMES HERE****************************** T$(1)="FOOD" T$(2)="FUEL & OIL" T$(3)="XPDBL SUP" T$(4)="LIQUOR" T$(5)="BEER" T$(6)="SOFT DRKS" T$(7)="BAR SUPL." T$(8)="ICE" T$(9)="DECOR." T$(10)="ENG. NTERED AND ENTERS SUM." PRINT "C = CLEAR.***** CAUTION ****** CLEARS AN ENTIRE COLUMN" PRINT " IF (CCC) OR A SINGLE ENTRY IF (CCCRR)" PRINT "L = LIST. DISPLAYS AN ELEMENT IF (LCCRR) OR AN ENTIRE" PRINT " COLUMN IF (LCC)" PRINT "R = ROW. DISPLAYSMNT." T$(11)="HULL MNT." T$(12)="LIN & FRN" T$(13)="ADM SLRY" T$(14)="OP SLRY" T$(15)="SUP SLRY" T$(16)="RENT & UTL" T$(17)="TRANSP." T$(18)="ENTRTNMNT" T$(19)="COMMISNS" T$(20)="TAXES" T$(21)="TRAVEL" T$(22)="MISCLN" T$(23)="ELECTRONIC" T$(3 ALL NON ZERO ITEMS IN THE ROW SPECIFIED." PRINT " IF ROW NUMBER IS ENTERED (RRR)" PRINT " IF NO ROW NUMBER, DISPLAYS ALL ROW TOTALS." PRINT "T = TRIAL BALANCE. PRINTS TRIAL BALANCE REPORT." PRINT "I = INCOME STATEMENT. PRINTS INCOME REPORT." PR1)="GRP SALES" T$(32)="VCHR SALES" T$(33)="DIR SALES" T$(34)="CATERING" T$(35)="OTHER REV." F$="EACLRTINPBSQ" INPUT "FILE NAME"; JRN$ REM REM 90 INPUT "READ OLD DATA FROM DISK? (Y OR N)";YN$ IF YN$="N" THEN 95 IF YN$<>"Y" THEN 90 PRINT "LOAD PRINT "N = NAME OF COLUMN. INPUTS NAME OF COLUMN" PRINT "P = PARAMETERS. ALLOWS INPUT OF CHANGE IN PARAMETERS" PRINT " SPECIFYING USE OF COLUMNS FOR SPECIAL FUNCTIONS" PRINT " AN INPUT OF ZERO FOR A PARAMETER MEANS NO CHANGE" PRINT "B = LIST ALL COOPER DISK IN DRIVE A." INPUT "TYPE 'GO' WHEN READY";GO$ PRINT: PRINT "READING FILE" FILE JRN$ READ #1; A1,A2,B1,B2,E1,E2,I1,I2,X1,X2,X3,R1,R2,R9,C9 FOR COL=1 TO C9 READ #1; T$(COL) NEXT COL FOR ID=1 TO C9 FOR JD=1 TO R9 READ #1;D(ID,JD) NEXT JD LUMN NAMES" PRINT "S = STOP. WRITES ALL DATA ON DISK AND RETURNS PROGRAM" PRINT " CONTROL TO CP/M." PRINT "NOTATION (CCRR) MEANS COLUMN AND ROW NUMBERS OF ITEMS" PRINT "WHICH MUST ALWAYS BE TWO DIGITS. IE ONE IS 01, TWO 02 ETC." PRINT "AN ENTRY OF   ZERO RETURNS TO COMMAND MODE." 543 PRINT: INPUT "COMMAND (E,A,C,L,R,T,I,N,P,B OR S)";S$: PRINT PRINT K=LEN(S$) FOR J=1 TO LEN(F$) IF LEFT$(S$,1)=MID$(F$,J,1) THEN 5470 NEXT J GOSUB 9910 GO TO 95 5470 ON J GOSUB 5730,5530,5930,6130,6530,7230,7430,5F COL=0 THEN 5415 IF COLA2 THEN 5414 B1=COL 5415 INPUT "BANK ACCT DEPOSITS COLUMN";COL IF COL=0 THEN 5416 IF COLA2 THEN 5415 B2=COL 5416 INPUT "LOWEST EXPENSE COLUMN";COL IF COL=0 THEN 5417 IF COL<0 OR COL>C9+1 THEN 5416 E1=400\ ,5405,5430,5490,9999 GO TO 543 5400 INPUT "COLUMN NUMBER"; COL INPUT "COLUMN NAME"; CNAME$ T$(COL)=CNAME$ GO TO 543 5405 PRINT "CURRENT PARAMETERS" PRINT: PRINT PRINT C9;"COLUMNS, ";R9;"ROWS": PRINT PRINT "ASSETS/LIABILITIES COL. ";A1;"TOCOL 5417 INPUT "HIGHEST EXPENSE COLUMN";COL IF COL=0 THEN 5418 IF COL C9+1 THEN 5417 E2=COL 5418 INPUT "LOWEST INCOME COLUMN";COL IF COL=0 THEN 5419 IF COL<0 OR COL>C9+1 THEN 5418 I1= COL 5419 INPUT "HIGHEST INCOME COLUMN";COL IF COL= ";A2 PRINT "BANK ACCT WITHDRAWALS COL. ";B1;"DEPOSITS COL. ";B2 PRINT "EXPENSES COL. ";E1;"TO ";E2 PRINT "INCOME COL. ";I1;"TO ";I2 PRINT "TRANSFER ID COL. ";X1;" TRANSFER AMOUNT COL. ";X2 PRINT "TRANSACTION ID COL. ";X3 PRINT "ASSETS BEGINNING BA0 THEN 5420 IF COL<0 OR COL>C9+1 THEN 5419 I2=COL 5420 INPUT "TRANSFER ID COLUMN";COL IF COL=0 THEN 5421 IF COL<0 OR COL>C9+1 THEN 5420 X1=COL 5421 INPUT "TRANSFER AMOUNT COLUMN";COL IF COL=0 THEN 5422 IF COL<0 OR COL>C9+1 THEN 5421 X2=COL 5422 L. ROW ";R1 PRINT "BUDGET AMOUNT ROW ";R2 PRINT 5410 INPUT "HOW MANY COLUMNS MAX.";COL IF COL=0 THEN 5411 IF COL<0 OR COL>99 THEN 5410 C9=COL 5411 INPUT "HOW MANY ROWS MAX.";ROW IF ROW=0 THEN 5412 IF ROW<0 OR ROW>99 THEN 5411 R9=ROW 5412 INPUT "INPUT "TRANSACTION ID COLUMN";COL IF COL=0 THEN 5423 IF COL<0 OR COL>C9+1 THEN 5422 X3=COL 5423 INPUT "ASSET ACCT BEGINNING BALANCE ROW";ROW IF ROW=0 THEN 5424 IF ROW<0 OR ROW>R9+1 THEN 5423 R1=ROW 5424 INPUT "BUDGET AMOUNT ROW";ROW IF ROW=0 THEN LOWEST ASSET/LIABILITY COLUMN";COL IF COL=0 THEN 5413 IF COL<0 OR COL>C9+1 THEN 5412 A1=COL 5413 INPUT "HIGHEST ASSET/LIABILITY COLUMN";COL IF COL=0 THEN 5414 IF COLC9+1 THEN 5413 A2 = COL 5414 INPUT "BANK ACCT WITHDRAWALS COLUMN";COL I5425 IF ROW<0 OR ROW>R9+1 THEN 5424 R2=ROW 5425 GO TO 543 5430 FOR COL=1 TO C9 PRINT COL, T$(COL) NEXT COL GO TO 543 5490 PRINT "WRITING FILE" FILE JRN$ PRINT #1;A1,A2,B1,B2,E1,E2,I1,I2,X1,X2,X3,R1,R2,R9,C9 FOR COL=1 TO C9 PRINT #1; T$(COL) NE  XT COL FOR ID=1 TO C9 FOR JD=1 TO R9 PRINT #1;D(ID,JD) NEXT JD NEXT ID CLOSE 1 PRINT "FINISHED" STOP REM REM ********ACCUMULATE IN SPECIFIED COLUMN/ROW ELEMENT******** REM 5530 GOSUB 9730 IF C<0 THEN 5690 IF C=X1 OR C=X3 THEN 9950 GOSUB 9830T YN$ IF YN$<>"Y" THEN 6090 D(C,R)=0 GOTO 6090 6010 PRINT "CLEAR ALL OF COL. ";C;" (Y OR N)"; INPUT YN$ IF YN$<>"Y" THEN 6090 FOR R=0 TO R9 IF R=R1 OR R=R2 THEN 6040 D(C,R)=0 6040 NEXT R 6090 RETURN REM REM COLUMN LIST ROUTINES REM  IF R<0 THEN 5690 IF R NE R1 OR A2>C9 OR A1>A2 THEN 5610 IF CA2 THEN 9970 5610 PRINT "COL.";C;"ROW";R;"ACCUMULATE"; INPUT T IF T=0 THEN 5640 D(C,R)=D(C,R)+T GOTO 5610 5640 T=D(C,R): T=INT(ABS(T)*100+.5)/100 IF D(C,R)<0 THEN T=-(T)  6130 GOSUB 9730 IF C<0 THEN 6490 IF K=3 THEN 6230 GOSUB 9830 IF R<0 THEN 6490 REM REM LIST SPECIFIED COLUMN/ROW ELEMENT REM V=D(C,R): L=15: M=2 IF C=X1 OR C=X3 THEN M=0 6180 GOSUB 9030 PRINT GOTO 6490 REM REM LIST ALL NOND(C,R)=T 5690 RETURN REM REM ENTER IN CONSECUTIVE ROWS OF SPECIFIED COLUMN REM 5730 GOSUB 9730 IF C<0 THEN 5890 GOSUB 9830 IF R<0 THEN 5890 IF R<>R1 OR A2>C9 OR A1>A2 THEN 5760 IF CA2 THEN 9970 5760 PRINT T$(C) 5770 PRINT "COL ZERO ELEMENTS IN COLUMN REM 6230 PRINT "COL.#--ROW #--XFR ID--TXN ID----$ AMOUNT ";T$(C) T=0 FOR R=0 TO R9 IF D(C,R)=0 OR R=R1 THEN 6390 V=C: L=5: M=0 GOSUB 9030 V=R: L=7 GOSUB 9030 IF X1>C9 THEN 6310 V=D(X1,R) IF V>0 THEN L=9: .";C;"ROW";R;"ENTRY"; INPUT T IF T=0 THEN 5890 IF C NE X1 AND C NE X3 THEN 5830 D(C,R)=INT(ABS(T)) GOTO 5840 5830 D(C,R)=INT(ABS(T)*100+.5)/100 5840 IF T<0 THEN D(C,R)=-(D(C,R)) 5850 R=R+1 IF R>R9 THEN 5890 IF R NE R1 OR A2>C9 OR A1>A2 THEN GOSUB 9030 6310 IF X3>C9 THEN 6350 V=D(X3,R) IF V>0 THEN L=7: PRINT TAB(22);: GOSUB 9030 6350 IF C=X1 OR C=X3 THEN PRINT: GOTO 6390 6360 PRINT TAB(30); V=D(C,R): L=11: M=2 GOSUB 9030 PRINT T=T+D(C,R) 6390 NEXT R IF C=X1 OR C=X3 THEN 64905770 IF CA2 THEN 5850 GOTO 5770 5890 RETURN REM REM SET SPECIFIED ELEMENT OR COLUMN TO ZERO REM 5930 GOSUB 9730 IF C<0 THEN 6090 IF K=3 THEN 6010 GOSUB 9830 IF R<0 THEN 6090 PRINT "CLEAR COL. ";C;" ROW ";R;" (Y OR N)"; INPU PRINT TAB(16);"COLUMN TOTAL";TAB(30); V=T: L=11: M=2 GOSUB 9030 PRINT 6490 RETURN REM REM ROW LIST ROUTINES REM 6530 IF K=1 THEN 6840 IF K NE 3 THEN 9920 H$=S$: S$=LEFT$(H$,1)+" "+RIGHT$(H$,2) K=LEN(S$) GOSUB 9830 IF R<0 T  HEN 7190 REM REM LIST ALL NON ZERO ELEMENTS IN ROW REM REM EXCEPTING XFR ID AND TXN ID REM PRINT "COL.#--ROW #----$ AMOUNT----COL. NAME" T=0 FOR C=0 TO C9 IF D(C,R)=0 OR C=X1 OR C=X3 THEN 6750 V=C: L=5: M=0 GOSUB 9030 V=R:  OR B1>C9 OR B2>C9 OR R=R2 THEN 7130 IF D(B1,R)=0 AND D(B2,R)=0 THEN 7130 T4=T4-D(B1,R)+D(B2,R) V=T4: L=13 GOSUB 9030 7130 PRINT 7140 NEXT R PRINT TAB(7);"TOTAL ALL ROWS"; V=T5: L=16: M=2 GOSUB 9030 PRINT 7190 RETURN REM REM DISPLAY TRIAL=7 GOSUB 9030 V=D(C,R): L=13: M=2 GOSUB 9030 PRINT TAB(29);T$(C) IF C>=I1 OR C=B1 THEN T=T+D(C,R) ELSE T=T-D(C,R) 6750 NEXT C PRINT LEFT$(LIN$,28) PRINT "ROW BALANCE"; V=T: L=12: M=2 GOSUB 9030 PRINT GOTO 7190 REM REM REM LIST L BALANCE REM 7230 PRINT "COL.#---NAME---------ACCT BAL."; PRINT "------BUDGET---COL. TOTALS" C1=0: C2=C9 GOSUB 8640 PRINT LIN$ PRINT "*****GRAND TOTALS"; P1=T1: P2=T2: P3=T3 GOSUB 8910 RETURN REM REM REM DISPLAY INCOME STATEMENT REM TOTALS OF ALL ROWS WITH NON ZERO ELEMENTS REM REM ALSO LISTS CHECKING ACCOUNT RUNNING BALANCE REM REM 6840 PRINT "ROW #--XFR ID--TXN ID--ROW TOTALS---CH ACC BAL" IF R1>R9 OR B1>C9 OR B2>C9 THEN 6910 V=R1: L=5: M=0 GOSUB 9030 7430 PRINT"COL.#---NAME-----------AMOUNT-"; PRINT "------BUDGET-----VARIANCE-" IF I2>C9 OR I1>I2 THEN T1=0: T2=0: T3=0: GOTO 7470 7460 C1=I1: C2=I2: GOSUB 8640 PRINT LIN$ 7470 PRINT "*****TOTAL INCOME"; P1=T1: P2=T2: P3=T3 GOSUB 8910 PRINT G1= T4=D(B2,R1) V=T4: L=42: M=2 GOSUB 9030 PRINT 6910 T5=0 FOR R=0 TO R9 IF R=R1 THEN 7140 N=0: T=0 FOR C=0 TO C9 IF D(C,R)=0 OR C=X1 OR C=X3 THEN 7010 IF C>=I1 AND C<=I2 OR C=B1 THEN T=T+D(C,R) ELSE T=T-D(C,R) N=N+1 7010 NEXT C T1: G2=T2: G3=T3 IF E2>C9 OR E1>E2 THEN T1=0: T2=0: T3=0: GOTO 7530 7520 C1=E1: C2=E2: GOSUB 8640 PRINT LIN$ 7530 PRINT "***TOTAL EXPENSES"; P1=T1: P2=T2: P3=T3: GOSUB 8910 PRINT G1=G1-T1: G2=G2-T2: G3=G3-T3 PRINT "**SURPLUS/DEFICIT"; P1=G1 IF N=0 THEN 7140 V=R: L=5: M=0 GOSUB 9030 IF X1>C9 THEN 7050 V=D(X1,R) IF V>0 THEN L=9: GOSUB 9030 7050 IF X3>C9 THEN 7070 V=D(X3,R) IF V>0 THEN L=7: PRINT TAB(15);: GOSUB 9030 7070 PRINT TAB(23); V=T: L=1: M=2 GOSUB 9030 T5=T5+T IF R1>R9: P2=G2: P3=G3: GOSUB 8910 PRINT IF X2>C9 THEN 7710 C1=X2: C2=X2: GOSUB 8640 G1=G1+T1: G2=G2+T2: G3=G3+T3 7710 PRINT"****NET CASH FLOW"; P1=G1: P2=G2: P3=G3: GOSUB 8910 PRINT IF A2>C9 OR A1>A2 THEN 8090 T6=0 IF R1>R9 THEN 7910 FOR C=A1   TO A2 T6=T6+D(C,R) NEXT C 7910 T7=0 FOR C=A1 TO A2 N=0: T=0 FOR R=0 TO R9 IF D(C,R)=0 THEN 7960 IF R=R2 OR R=R1 THEN 7960 N=N+1 T=T+D(C,R) 7960 NEXT R IF N>0 THEN T7=T7+T 7990 NEXT C T8=T7+T6 PRINT "NET CASH BALANCE (ENDING)"; V=T8: L=13$=STR$(V1) IF V1<1000 OR M=0 THEN 9150 IF V1<1E06 THEN 9140 V$=STR$(V) GOTO 9350 9140 V1$=LEFT$(V9$,LEN(V9$)-4) V1$=V1$+","+MID$(V9$,LEN(V9$)-3,3) GOTO 9210 9150 IF M=0 THEN V1$=LEFT$(V9$,LEN(V9$)): GOTO 9210 V1$=LEFT$(V9$,LEN(V9$)-1) 9210 IF M=0: M=2 GOSUB 9030: PRINT PRINT "NET CASH BALACE (BEGIN.)"; V=T6: GOSUB 9030 PRINT " NET CASH FLOW"; V=T7: GOSUB 9030: PRINT 8090 RETURN REM REM OUTPUT ROUTINES FOR TRIAL BALANCE OR INCOME STMT. REM 8640 T1=0: T2=0: T3=0 FOR C=C1 TO C THEN V2$="": GOTO 9310 9230 V9$=STR$(V2) IF LEN(V9$)<>3 THEN 9250 9240 V2$="."+V9$ GOTO 9310 9250 IF LEN(V9$)=2 THEN V2$=".0"+V9$ IF LEN(V9$)<>1 AND LEN(V9$)<>2 THEN PRINT "BAD .XX":STOP 9310 V9$=" " IF V<=-.005 THEN V9$="-" 9320 V$=V9$+V1$+V2$ 2 IF C=X1 OR C=X3 THEN 8810 N=0: T=0 FOR R=0 TO R9 IF D(C,R)=0 OR R=R1 THEN 8710 N=N+1 IF R<>R2 THEN T=T+D(C,R) 8710 NEXT R IF N=0 THEN 8810 P1=T: T1=T1+P1 IF R2>R9 THEN 8780 P2=D(C,R2) T2=T2+P2: P3=P1-P2: T3=T3+P3 8780 V=C: L=5: M=0: 9350 L9=LEN(V$) IF M=2 THEN L9=L9-1 9360 IF L>L9 THEN PRINT " ";: L9=L9+1: GOTO 9360 9380 PRINT MID$(V$,1,LEN(V$)-1); RETURN REM REM REM CHECK FOR VALID COLUMN # REM 9730 IF K<3 THEN C=-1: GOTO 9920 9740 S2$=MID$(S$,2,1) IF S2$<"0" OR S2$>"9" GOSUB 9030 PRINT TAB(7); T$(C); GOSUB 8910 8810 NEXT C RETURN 8910 PRINT TAB(19); V=P1: L=11: M=2: GOSUB 9030 IF R2>R9 THEN 8990 V=P2: L=13: GOSUB 9030 V=P3: L=13: GOSUB 9030 8990 PRINT RETURN REM REM FORMATTED PRINT ROUTINE THEN C=-1: GOTO 9930 9750 S3$=MID$(S$,3,1) IF S3$<"0" OR S3$>"9" THEN C=-1: GOTO 9930 9760 C=VAL(MID$(S$,2,2)) IF C<=C9 THEN 9990 C=-(1) GOTO 9940 REM REM CHECK FOR VALID ROW REM 9830 IF K<>5 THEN R=-1: GOTO 9920 9840 S4$=MID$(S$,4,1) IF S REM REM 9030 IF M<>0 AND M<>2 THEN M=0 9040 L=INT(ABS(L)) IF L<2 OR L>72 THEN L=14 9050 V1=INT(ABS(V)) IF M=0 THEN V2=0: GOTO 9080 9060 V2=INT((ABS(V)-V1)*100+.5) IF V2>100 THEN V2=0: V1=V1+1 9080 IF V1=0 AND M>0 THEN V1$="": GOTO 9210 9110 V94$<"0" OR S4$>"9" THEN R=-1: GOTO 9930 9850 S5$=MID$(S$,5,1) IF S5$<"0" OR S5$>"9" THEN R=-1: GOTO 9930 9860 R=VAL(MID$(S$,4,2)) IF R<=R9 THEN 9990 R=-1 GOTO 9960 9910 PRINT "INVALID COMMAND FUNCTION": GOTO 9990 9920 PRINT "WRONG # OF CHARACTERS   TYPED": GOTO 9990 9930 PRINT "NON-NUMERIC ROW OR COLUMN #": GOTO 9990 9940 PRINT "COLUMN NUMBER OUT OF RANGE": GOTO 9990 9950 PRINT "ILLEGAL COLUMN FOR THIS FUNCTION": GOTO 9990 9960 PRINT "ROW NUMBER OUT OF RANGE": GOTO 9990 9970 PRINT "ILLEGAL ROW FOR THIS FUNCTION": GOTO 9990 9990 RETURN 9999 END 4D34}4D3#44E344F344F3#44G344G3#44A344A3#44B344C444C4#44D444D4#44E45410 REM THIS PROGRAM CHANGES A 'BASIC' COMMAND WORD TO A USER-DEF COMAND WORD 20 REM FROM INTERFACE AGE FEB 1980 PAGE 20 30 Z9$=CHR$(12):REM Z9$ CLEARS SCREEN 40 PRINTZ9$ 50 REM 60 REM * CONVERT HEX TO DECIMAL FOR LOOP * 70 REM 80 DIM A(4) 90 G1=0  100 PRINT 110 INPUT "WHAT IS BEGINNING HEX ADDRESS OF 'BASIC' ";N$ 120 IF LEN(N$)=4 THEN 160 130 PRINT 140 PRINT "MUST BE A 4-DIGIT NUMBER, RE-ENTER" 150 GOTO 100 160 J=1 170 L=LEN(N$) 180 FOR I=1 TO 4 190 A(I)=ASC(MID$(N$,J,1))-48 200 IF A(I)>9 THEN A(I)=A(I)-7 210 J=J+1 220 NEXT I 230 AA=4096*A(1)+256*A(2)+16*A(3)+A(4) 240 IF G1=1 THEN 310 250 A1=AA:REM A1=BEGINNING DECIMAL ADDRESS OF 'BASIC' 260 PRINT 270 PRINT 280 INPUT "WHAT IS ENDING ADDRESS OF 'BASIC' ";N$ 290 G1=1 300 GOTO 160 310 A2=AA:REM A2=ENDING DECIMAL ADDRESS OF 'BASIC' 320 REM 330 REM * INPUT OLD AND NEW WORD FOR SEARCH * 340 REM 350 PRINT 360 PRINT 370 INPUT "WHAT IS WORD TO LOCATED ";W$ 380 PRINT 390 PRINT 400 PRINT "WHAT IS NEW";LEN(W$);"-LETTER WORD   "; 410 INPUT T$ 420 IF LEN(T$)=LEN(W$) THEN 520 430 PRINT 440 PRINT 450 PRINT 460 PRINT 470 PRINT"MUST BE";LEN(W$);"-LETTERS LONG" 480 GOTO 380 490 REM 500 REM * NOW LOOK FOR MATCH IN BASIC * 510 REM 520 PRINTZ9$ 530 PRINT 540 PRINT"TH (RESIZE3 modified by myself for use by Ham Radio Clubs.) Use RESIZE2 for files keyed on the name, RESIZE3 for files keyed on Amateur Radio Call-sign. RESIZE re-sizes the file. For example, if you have 128 records and find yourself with a nIS MAY TAKE A WHILE, SO BE PATIENT" 550 FOR J=A1 TO A2 560 B=PEEK(J) 570 FOR K=1 TO LEN(W$) 580 IF CHR$(B)<>MID$(W$,K,1) THEN 660 590 B=PEEK(J+K) 600 NEXT K 610 PRINT 620 PRINT 630 PRINT 640 PRINT "MATCH IS FOUND AT ADDRESS";J;"DECIMAL" 650 Geed for more, you may use RESIZE to convert the file to a different size. It is a good idea to use increments of 128 since CP/M sets up directories 128 sectors at a time. You will be prompted for the filenames and new file length. OTO 730 660 NEXT J 670 PRINTZ9$ 680 PRINT"NO MATCH WAS FOUND" 690 END 700 REM 710 REM CHANGE OLD TO NEW WORD * 720 REM 730 FOR I=1 TO LEN(W$) 740 B=ASC(MID$(T$,I,1)) 750 POKE J,B 760 J=J+1 770 NEXT I 780 END NGE OLD TO NEW WORD * 720 REM  The program will take a certain amount of time to run since it has to perform a great many disk accesses. If you are converting from a "name key" format to a "call-sign key" format using RESIZE3, changing the READ #1 statement after line 11 will enable you to re-key on call-signs. Just reverse the NAME$(N) and CALL$(N) fields. The file will be re-written indexed by call-sign. James K. Mills WB9KFP CACHE Member  RESIZE.DOC Documentation for RESIZE2.BAS & RESIZE3.BAS 01/02/80 RESIZE is a file reconfiguration program for Ward Christensen's Maillist programs written in BASIC-E   HICH \ TRANSFERS A RECORD AT A TIME FROM THE \ OLD FILE TO THE NEW FILE. BUF.LEN = 100 :REM BUFFER 100 RECORDS IN 12K OF MEMORY REC.LEN = 128 DIM SORT$(BUF.LEN), NAME$(BUF.LEN), ORG$(BUF.LEN), \ STREET$(BUF.LEN), CITY$(BUF.LEN), ZIP$(BUF.LEN),\ PHONE$(BUF.LEN), CLASS$(BUF.LEN), PAID$(BUF.LEN),\ TYPE$(BUF.LEN) PRINT CHR$ (26); CHR$ (0) : REM CLEAR ADM-3A SCREEN PRINT "RESIZE2 PROGRAM VERSION "; VERSION PRINT "FILE NAME MAY BE ENTERED WITH A: OR B:" PRINT PRINT "YOU CANNREM RESIZE2.BAS VERSION = 1.01 REM 01/02/80 REM RESIZE PROGRAM FOR THE MAILLIST FILES. REM THIS PROGRAM WAS WRITTEN BY: JAMES K. MILLS REM P.O. BOX 94864 REM SCHAUMBURG, IL 60194 REM THE PROGRAM READS THE FLAGGED (1) RECORDS FROM \OT USE THE SAME NAME FOR OLD AND NEW FILES" PRINT 5 INPUT "CAPITAL LETTERS ONLY! OLD FILE NAME";OLD.NAME$ INPUT "CAPITAL LETTERS ONLY! NEW FILE NAME";NEW.NAME$ PRINT IF OLD.NAME$=NEW.NAME$ THEN PRINT "USE 2 DIFFERENT FILES":\ GOTO 5 INPUT "N THE FILE INTO AN ARRAY IN MEMORY, \ RE-CALCULATES THE KEY AND WRITES THE RECORD IN \ THE CORRECT PLACEMENT IN THE FILE. REM THERE ARE DISADVANTAGES TO THIS TECHNIQUE. \ FIRST OF ALL, MAKE A BACKUP DISC BEFORE THE \ RECONFIGURATION. IF YOU HAEW FILE NUMBER OF RECORDS";NEW.LEN DIM R1(NEW.LEN), R2(NEW.LEN), R3(NEW.LEN), R4(NEW.LEN), \ R5(NEW.LEN), R6(NEW.LEN), R7(NEW.LEN), R8(NEW.LEN) FILE OLD.NAME$(REC.LEN) :REM #1 = OLD FILE FILE NEW.NAME$(REC.LEN) :REM #2 = NEW FILE REM READ OLD VE A POWER FAILURE OR \ A SYSTEM FAILURE OF ANY KIND, YOUR FILES WILL \ NOT BE LOST IF YOU HAVE A BACKUP. ALSO, IF YOU \ HAVE LITTLE MEMORY, YOU WILL NOT BE ABLE TO RUN THIS \ PROGRAM SUCCESSFULLY: USE THE RE-SIZE PROGRAM \ BY WARD CHRISTENSEN WRECORDS LIVE.RECS.READ = 0 : LIVE.RECS.WRITTEN = 0 I=1 : N=0 : DONE = 0 10 PRINT "READING RECORDS FROM ";OLD.NAME$ 11 IF END #1 THEN 15 READ #1,I;FLAG IF FLAG = 0 THEN I=I+1:GOTO 11 READ #1,I;FLAG,SORT$(N),NAME$(N),ORG$(N),STREET$(N), \ CITY  $(N),ZIP$(N),PHONE$(N),CLASS$(N),PAID$(N), \ TYPE$(N) LIVE.RECS.READ=LIVE.RECS.READ+1 IF LIVE.RECS.READ/10=INT(LIVE.RECS.READ/10) THEN \ PRINT LIVE.RECS.READ;" RECORDS READ" IF N=BUF.LEN THEN 20 I=I+1:N=N+1:GOTO 11 15 DONE = 1 20 REM WRITE R0 1111 IF R2(KEY-256)<>0 THEN KEY=KEY+1:GOTO 1100 GOTO 1120 1112 IF R3(KEY-512)<>0 THEN KEY=KEY+1:GOTO 1100 GOTO 1120 1113 IF R4(KEY-768)<>0 THEN KEY=KEY+1:GOTO 1100 GOTO 1120 1114 IF R5(KEY-1024)<>0 THEN KEY=KEY+1:GOTO 1100 GOTO 1120 1115 IF ECORDS TO NEW FILE PRINT "WRITING RECORDS TO ";NEW.NAME$ FOR A=0 TO N GOSUB 1000 PRINT #2,KEY;1,SORT$(A),NAME$(A),ORG$(A), \ STREET$(A),CITY$(A),ZIP$(A),PHONE$(A), \ CLASS$(A),PAID$(A),TYPE$(A) LIVE.RECS.WRITTEN=LIVE.RECS.WRITTEN+1 IR6(KEY-1280)<>0 THEN KEY=KEY+1:GOTO 1100 GOTO 1120 1116 IF R7(KEY-1536)<>0 THEN KEY=KEY+1:GOTO 1100 GOTO 1120 1117 IF R8(KEY-1792)<>0 THEN KEY=KEY+1:GOTO 1100 1120 READ #2,KEY;FLAG IF FLAG = 0 THEN RETURN IF KEY > 1792 THEN R8(KEY-1792)=-1:GOTO F LIVE.RECS.WRITTEN/10=INT(LIVE.RECS.WRITTEN/10)\ THEN PRINT LIVE.RECS.WRITTEN; "RECORDS WRITTEN" NEXT A IF DONE = 0 THEN N=0:GOTO 10 PRINT PRINT LIVE.RECS.READ; "TOTAL RECORDS READ" PRINT LIVE.RECS.WRITTEN-1; "TOTAL RECORDS WRITTEN" GOTO 991150 IF KEY > 1536 THEN R7(KEY-1536)=-1:GOTO 1150 IF KEY > 1280 THEN R6(KEY-1280)=-1:GOTO 1150 IF KEY > 1024 THEN R5(KEY-1024)=-1:GOTO 1150 IF KEY > 768 THEN R4(KEY- 768)=-1:GOTO 1150 IF KEY > 512 THEN R3(KEY- 512)=-1:GOTO 1150 IF KEY > 256 99 1000 KEY = 0 FOR B=1 TO LEN(NAME$(A)) STEP 2 KEY = 2*KEY + (15 AND ASC(MID$(NAME$(A),B,1)) NEXT B KEY = KEY - NEW.LEN * INT(KEY/NEW.LEN) KEY = INT(KEY+.1) IF KEY <= 0 THEN KEY = 1 REM FIND OPEN SLOT IN FILE 1100 K1=INT(KEY/256)+1 THEN R2(KEY- 256)=-1:GOTO 1150 R1(KEY)=-1 1150 KEY = KEY + 1 IF KEY > NEW.LEN THEN KEY = 1 GOTO 1100 9999 CLOSE 2 CLOSE 1 END  IF K1=1 THEN 1110 IF K1=2 THEN 1111 IF K1=3 THEN 1112 IF K1=4 THEN 1113 IF K1=5 THEN 1114 IF K1=6 THEN 1115 IF K1=7 THEN 1116 IF K1=8 THEN 1117 PRINT:PRINT "ABANDON HOPE" :PRINT:STOP 1110 IF R1(KEY)<>0 THEN KEY=KEY+1:GOTO 1100 GOTO 112  REM RESIZE3.BAS VERSION = 1.01 REM 01/02/80 REM RESIZE PROGRAM FOR THE MAILLIST FILES. REM MODIFIED FOR USE WITH AMATEUR RADIO MAILIST. REM THIS PROGRAM WAS WRITTEN BY: JAMES K. MILLS REM P.O. BOX 94864 REM SCHAUMBURG, IL 60194 REM THE PROGRAM READS THE FLAGGED (1) RECORDS FROM \ THE FILE INTO AN ARRAY IN MEMORY, \ RE-CALCULATES THE KEY AND WRITES THE RECORD IN \ THE CORRECT PLACEMENT IN THE FILE. REM THERE ARE DISADVANTAGES TO THIS TECHNIQUE. \ FIRST OF ALL, MAKE A BACKUP DISC BEFORE THE \ RECONFIGURATION. IF YOU HAVE A POWER FAILURE OR \ A SYSTEM FAILURE OF ANY KIND, YOUR FILES WILL \ NOT BE LOST IF YOU HAVE A BACKUP. ALSO, IF YOU \ HAVE LITTLE MEMORY, YOU WILL NOT BE ABLE TO RUN THIS \ PROGRAM SUCCESSFULLY: USE THE RE-SIZE PROGRAM \ BY WARD CHRISTENSEN WHICH \ TRANSFERS A RECORD AT A TIME FROM THE \ OLD FILE TO THE NEW FILE. BUF.LEN = 100 :REM BUFFER 100 RECORDS IN 12K OF MEMORY REC.LEN = 128 DIM SORT$(BUF.LEN), NAME$(BUF.LEN), CALL$(BUF.  LEN), \ STREET$(BUF.LEN), CITY$(BUF.LEN), ZIP$(BUF.LEN),\ PHONE$(BUF.LEN), CLASS$(BUF.LEN), PAID$(BUF.LEN),\ TYPE$(BUF.LEN) PRINT CHR$ (26); CHR$ (0) : REM CLEAR ADM-3A SCREEN PRINT "RESIZE3 PROGRAM VERSION "; VERSION:PRINT PRINT "*** AMATEU.RECS.READ;" RECORDS READ" IF N=BUF.LEN THEN 20 I=I+1:N=N+1:GOTO 11 15 DONE = 1 20 REM WRITE RECORDS TO NEW FILE PRINT "WRITING RECORDS TO ";NEW.NAME$ FOR A=0 TO N GOSUB 1000 PRINT #2,KEY;1,SORT$(A),CALL$(A),NAME$(A), \ STREET$(A),CITY$(R RADIO VERSION ***":PRINT PRINT "FILE NAME MAY BE ENTERED WITH A: OR B:" PRINT PRINT "YOU CANNOT USE THE SAME NAME FOR OLD AND NEW FILES" PRINT 5 INPUT "CAPITAL LETTERS ONLY! OLD FILE NAME";OLD.NAME$ INPUT "CAPITAL LETTERS ONLY! NEW FILE NAME";A),ZIP$(A),PHONE$(A), \ CLASS$(A),PAID$(A),TYPE$(A) LIVE.RECS.WRITTEN=LIVE.RECS.WRITTEN+1 IF LIVE.RECS.WRITTEN/10=INT(LIVE.RECS.WRITTEN/10)\ THEN PRINT LIVE.RECS.WRITTEN; "RECORDS WRITTEN" NEXT A IF DONE = 0 THEN N=0:GOTO 10 PRINT PRINNEW.NAME$ PRINT IF OLD.NAME$=NEW.NAME$ THEN PRINT "USE 2 DIFFERENT FILES":\ GOTO 5 INPUT "NEW FILE NUMBER OF RECORDS";NEW.LEN DIM R1(NEW.LEN), R2(NEW.LEN), R3(NEW.LEN), R4(NEW.LEN), \ R5(NEW.LEN), R6(NEW.LEN), R7(NEW.LEN), R8(NEW.LEN) FILE T LIVE.RECS.READ; "TOTAL RECORDS READ" PRINT LIVE.RECS.WRITTEN-1; "TOTAL RECORDS WRITTEN" GOTO 9999 1000 KEY = 0 : K = LEN (CALL$(A)) FOR B = K TO 1 STEP -1 KEY=16*KEY+(63 AND ASC(MID$(CALL$(A),B,1))) NEXT B KEY = KEY - NEW.LEN * INT(KEY/NEOLD.NAME$(REC.LEN) :REM #1 = OLD FILE FILE NEW.NAME$(REC.LEN) :REM #2 = NEW FILE REM READ OLD RECORDS LIVE.RECS.READ = 0 : LIVE.RECS.WRITTEN = 0 I=1 : N=0 : DONE = 0 10 PRINT "READING RECORDS FROM ";OLD.NAME$ 11 IF END #1 THEN 15 READ #1,I;FLAW.LEN) KEY=INT(KEY+.1) IF KEY <= 0 THEN KEY = 1 REM FIND OPEN SLOT IN FILE 1100 K1=INT(KEY/256)+1 IF K1=1 THEN 1110 IF K1=2 THEN 1111 IF K1=3 THEN 1112 IF K1=4 THEN 1113 IF K1=5 THEN 1114 IF K1=6 THEN 1115 IF K1=7 THEN 1116 IF KG IF FLAG = 0 THEN I=I+1:GOTO 11 READ #1,I;FLAG,SORT$(N),CALL$(N),NAME$(N),STREET$(N), \ CITY$(N),ZIP$(N),PHONE$(N),CLASS$(N),PAID$(N), \ TYPE$(N) LIVE.RECS.READ=LIVE.RECS.READ+1 IF LIVE.RECS.READ/10=INT(LIVE.RECS.READ/10) THEN \ PRINT LIVE1=8 THEN 1117 PRINT:PRINT "ABANDON HOPE" :PRINT:STOP 1110 IF R1(KEY)<>0 THEN KEY=KEY+1:GOTO 1100 GOTO 1120 1111 IF R2(KEY-256)<>0 THEN KEY=KEY+1:GOTO 1100 GOTO 1120 1112 IF R3(KEY-512)<>0 THEN KEY=KEY+1:GOTO 1100 GOTO 1120 1113 IF R4(KEY-768)<>  0 THEN KEY=KEY+1:GOTO 1100 GOTO 1120 1114 IF R5(KEY-1024)<>0 THEN KEY=KEY+1:GOTO 1100 GOTO 1120 1115 IF R6(KEY-1280)<>0 THEN KEY=KEY+1:GOTO 1100 GOTO 1120 1116 IF R7(KEY-1536)<>0 THEN KEY=KEY+1:GOTO 1100 GOTO 1120 1117 IF R8(KEY-1792)<>0 THEN KEY=KEY+1:GOTO 1100 1120 READ #2,KEY;FLAG IF FLAG = 0 THEN RETURN IF KEY > 1792 THEN R8(KEY-1792)=-1:GOTO 1150 IF KEY > 1536 THEN R7(KEY-1536)=-1:GOTO 1150 IF KEY > 1280 THEN R6(KEY-1280)=-1:GOTO 1150 IF KEY > 1024 THEN R5(KEY-1024)=-1:GOTO 1150  IF KEY > 768 THEN R4(KEY- 768)=-1:GOTO 1150 IF KEY > 512 THEN R3(KEY- 512)=-1:GOTO 1150 IF KEY > 256 THEN R2(KEY- 256)=-1:GOTO 1150 R1(KEY)=-1 1150 KEY = KEY + 1 IF KEY > NEW.LEN THEN KEY = 1 GOTO 1100 9999 CLOSE 2 CLOSE 1 END   ; ;POW FROM DR. DOBBS JOURNAL NO. 29, PAGE 20 ; ;....POW.... ;30 JULY 79....MODS FOR CP/M ;BY BOTTER REEVES...LOY NAVA CO. LTD. ;1229/27 NEW ROAD, BANGKOK 5, THAILAND ;233-4193 ;DEC 16-30, 1977 : ;MODIIED FOR FDOS JUN 3,1978 ;SELECTRIC MODS  JZ TBLP JNC GOTB CPI 0 JNZ TBLP ;NO MORE TABS IN TABLE JMP CLOS ;GOT GOOD TAB, UPDATE POINTERS GOTB LXI H,RMAR CMP M JNC CLOS PUTB STA LPOS LXI H,OBUF CALL ADAH SHLD LADR RET ;CONVERT ASCII NUMBER TO BINARY ;ADDRESS IN HL ONJUNE 15,1978 ;TOTAL JUSTIFICATION FIXED JULY 20, 1978 ; ; ;BY HERMAN WATSON ;P.O. BOX 341401 ;CORAL GABLES, FLA 33134 ; ; ; ;THE FOLLOWING IS THE JAZZED UP VERSION FOR FDOS ;WITH INSTRUCTION PRINTOUT AT THE BEGINNING ; ORG 100H ;START LOC FOR ENTRY, SAVED IN APNT ON EXIT ;RETURN WITH VALUE IN HL ADEC PUSH H POP B LXI H,0 ADE1 LDAX B CALL NMCK ;CHECK FOR DECIMAL NUMBER JC ADE2 INX B MOV D,H MOV E,L DAD H DAD H DAD D DAD H SUI 48 MOV E,A MVI D,0 DAD D JMP ADE COM FILE START LXI SP,STACK LXI H,STMSG CALL TXTYP JMP MAIN STMSG DB '...PROCESSOR OF WORDS FOR 8080',0DH,0AH DB 'THE COMMANDS ARE AS FOLLOWS',0DH,0AH DB ' "P" = PRINT',0DH,0AH DB ' "L" = LOAD',0DH,0AH DB ' "Q" = QUIT',0DH,0AH DB 1 ADE2 PUSH B XTHL SHLD APNT POP H RET ;CHECK FOR DECIMAL NUMBER IN ASCII NMCK CPI '0' RC CPI '9'+1 CMC RET ;INITIALIZE OBUF FOR NEW FORMATTED LINE NEWL LXI H,OBUF ;FILL WITH SPACES LDA MAXL MOV C,A MVI A,' ' NEWA' CTRL C WILL ABORT',0DH,0AH DB 'ENTER COMMAND $' ;UTILITY ROUTINES ;ADD A TO HL ADAH ADD L MOV L,A RNC INR H RET ;TEST DE .EQ. HL ;RETURN ZERO IF SO TDHE MOV A,D CMP H RNZ MOV A,E CMP L RET ;GENERATE PSEUDORANDO MOV M,A INX H DCR C JNZ NEWA LXI H,OBUF ;COMPUTE LEFT MARGIN ADDR LDA LMAR CALL ADAH SHLD LADR LDA LMAR ;SET POSITION COUNTER STA LPOS LXI H,OBUF ;COMPUTE RIGHT MARGIN ADDR LDA RMAR CALL ADAH SHLD LEND MVI M,CR ;EOL AT RIGHT M NUMBER 0-15 RAND LXI H,RNDV RND1 MOV A,M RLC INR A RLC RLC XRA M MOV M,A ANI 0FH RET ;CONVERT TABS TO CORRECT POSITION TBST LDA LPOS MOV C,A LXI D,TTAB ;SEARCH TTAB FOR NEXT GREATEST LOCATION TBLP LDAX D INX D CMP C RET ;FORMATTED OUTPUT ;CALL WITH LETTER IN A ;HANDLES LEFT OR TOTAL JUSTIFICATION FMAT CPI 9 ;TEST TAB JZ TBST CPI CR ;TEST CARG RETRN JNZ LFTS MVI A,' ' ;REPLACE CR WITH SPACE LFTS CPI LF ;IGNORE LINE FEEDS RZ CPI ' ' JNZ RFMT   ;IF HERE, EITHER LEFT OR TOTAL JUST. SO ALLOW ;NO SPACES AT THE LEFT OF THE LINE LXI H,LMAR LDA LPOS CMP M RZ ;AT START, SO STAY THERE MVI A,' ' ;OK TO KEEP SPACE RFMT LHLD LADR ;NOW PLACE LETTER IN OBUF MOV M,A INX H SHLD LADR LXI H,R ;MOVE LINE TO RIGHT, AND PAD ;IF LMAR REACHED, PUSH LINE LEFT AND ;PAD AGAIN UNTIL DONE ;(HL) .GE. (DE), SO DE IS RIGHT OF HL, AND WHEN ;DE .EQ. HL, THE PADDING IS DONE ;BEGIN AT LAST CHAR AND SHOVE RIGHT ;START PADDING AT THE SFLP SPACE ;(SFLP IMAR ;CHECK IF OBU FULL LDA LPOS INR A STA LPOS CMP M RC ;OBUF FULL. ASSUME LEFT JUST. ;BACK UP TO SPACE AND SAVE OVERFLOW ;DE=TEMP ADDRESS ;C=CHAR COUNT ;HL=OBUF ADDRESS MVI B,30 ;MAX AMOUNT TEML CAN HOLD MVI C,0 ;TEML CHAR COUNT S RANDOM) AND CONTINUE ;PADDING EACH OCCURRANCE OF A GROUP ;OF SPACES UNTIL THE TWO POINTERS ARE EQUAL ;TO EACH OTHER TOTL CALL RAND ;INIT SFLP STA SFLP LHLD LEND XCHG LHLD LADR LDA LPOS MOV C,A MVI B,0 ;MAKE SURE SP IS FOUND ;DE .EQ LXI D,TEML LHLD LADR MVI M,CR ;EOL IN CASE NOT POSSIBLE ;LOOP BACK TO FIRST SPACE (WITHIN 30 LETTERS ;AND WITHOUT HITTING LEFT MARGIN) LJBU DCX H MOV A,M CPI ' ' JZ LJFN LJRT STAX D INX D INR C DCR B JZ OUTL JMP LJBU LJFN DCX H . HL MEANS PAD DONE CALL TDHE JZ OUTL ;RIGHT AND PAD RITE MOV A,M ;PICK UP FROM LEFT STAX D ;STORE AT RIGHT CPI ' ' ;TEST PICKED UP CHAR JNZ WORD MVI B,1 ;NOTE THAT SP WAS FOUND LDA SFLP ;TST IF WE CAN INSERT YET ORA A ;TEST FOR Z MOV A,M INX H CPI ' ' JZ LJRT MOV A,C STA TCNT ;SAVE CHAR COUNT LDA LPOS ;BACK UP LPOS SUB C STA LPOS MOV C,A ;DON'T GO PAST NEW PARA TAB LDA BRTB ;FOR UNMODIFIED INDENTION SUB C ;TO THAT TAB POSITION JNC OUTL ;TERMS NOT MET SHLERO JZ PADD ;CAN'T INSERT YET DCR A STA SFLP JMP WORD ;NOT YET PADD LDA LCHR ;CHECK IF GROUP OF SPACES CPI ' ' ;DON'T ALLOW THIS COND. JZ WRD1 MVI A,' ' ;PADDING DONE HERE DCX D STAX D CALL TDHE JZ OUTL WORD MOV A,M STA LCHR WRD1D LADR MVI M,CR ;NEW EOL ;TEST HERE IF LEFT JUST. OR TOTAL JUST. ;0=NO JUST. ;1=LEFT ONLY ;2=TOTAL JUST. ;BY THE WAY, AT THIS POINT LEFT JUST. ;IS COMPLETE ALREADY LDA JFLG CPI 1 JZ OUTL CPI 2 JNZ OUTL ;TOTAL JUST. AT THIS POINT  DCX D ;REST OF RIGHT AND PAD LOOP DCX H DCR C LDA BRTB ;ALLOWS INDENTION CMP C JZ LEFT ;HIT INDENTATION LDA LMAR ;OR LEFT MARGIN CMP C JNZ RITE ;CAN STILL PROCEED ;PUSH LEFT AND TRY AGAIN LEFT INX D INX H INR C LDAX D MOV M,A   CPI CR JNZ LEFT XRA A ;TEST IF ONE SP FOUND ORA B JZ OUTL ;NOPE, NOT ONE SP FOUND JMP RITE ;OUTPUT A COMPLETE FORMATTED LINE FROM OBUF OUTL LXI H,OBUF ;OUT TO CR OUTM MOV A,M INX H CPI CR JZ EOL CALL OUTC JMP OUTM EOL CALL NEULL SO FORCE CR AND CONTINUE LHLD LADR MVI M,CR JMP OUTL ;OUTPUT OBUF IF ANYTHING IN IT CLOS LXI H,LMAR LDA LPOS CMP M RZ RC LHLD LADR MVI M,CR JMP OUTL ;OUTPUT BOTTOM OF PAGE, THE DIVIDER, AND ;THE TOP OF THE NEXT PAGE WL ;CLEAN OBUF LDA SPAS ;PROCESS SPACING MOV C,A EOLP CALL CRLF LDA PPOS ;UPDATE TEXT PAGE POSITION INR A STA PPOS LXI H,PLEN CMP M JNC EOXP DCR C JNZ EOLP JMP RSTR EOXP CALL NEXP ;NEED A NEW PAGE! ;RESTORE OVERFLOW FROM TEML ;I NEXP LDA BLEN ;GET BOTTOM LENGTH ORA A JZ DVDR ;NO BOTTOM PLEASE MOV C,A NPBL LDA BOTN ;CHECK IF AT LINE FOR MSG OUT CMP C CZ BMSG ;YES, OUTPUT IT CALL CRLF DCR C JNZ NPBL ;DETERMINE IF LAST PAGE IN FILE LDA EOT ORA A RZ ;ZERO NTO OBUF STARTING AT LMAR RSTR LXI D,TCNT LDAX D ORA A RZ LXI H,TEML-1 MOV C,A DCR C CALL ADAH MOV A,M CPI ' ' ;PREVENT FIRST BEING SPACE MOV A,C STAX D JZ RSTR ;FIRST NOT SPACE INR C LDA LMAR ADD C STA LPOS XCHG LSAYS EOF ENCOUNTERED ;START A NEW PAGE NOW ;OUTPUT WARNING TO CONSOLE AND WAIT FOR "GO" DVDR LXI H,PAGMS CALL TXTYP CALL ECHO1 CALL CI LXI H,PAGN INR M NEWP LDA TLEN ;GET TOP LENGTH ORA A JZ NPXT ;NO TOP PLEASE MOV C,A NPTL LDA THLD LADR RSTL LDAX D MOV M,A DCX D INX H DCR C JNZ RSTL SHLD LADR XRA A STA TCNT RET ;UNFORMATTED OUTPUT ROUTINE ;EQUIVALENT TO FMAT, BUT NO JUSTIFICATION ;IF TEXT EXCEEDS RMAR, THEN A CR IS FORCED AND A ;NEW LINE IS STARTED UOPN ;EQUAL LINE FOR MSG OUTPUT? CMP C CZ TMSG ;YES, PRINT IT CALL CRLF DCR C JNZ NPTL NPXT XRA A STA PPOS RET BMSG LDA PAGN ;NO MSG ON FIRST PAGE CPI 2 RC MOV A,C STA TSTG ;SAVE PRESENT LINE COUNT LHLD BOTA ;GET BOTM MSG ADDRESS FMT CPI 9 ;TEST TAB JZ TBST CPI LF ;IGNORE LINE FEEDS RZ CPI CR ;TEST CARG RETURN LHLD LADR MOV M,A ;INSERT AS EOL JZ OUTL INX H SHLD LADR LXI H,RMAR ;TEST IF FULL LDA LPOS INR A STA LPOS DCR A CMP M RC ;HERE, OBUF IS F LDA BOTT ;AND TAB POSITION ;DIRECTLY OUTPUT MESSAGE LINE TO PRINTER ;DOES NOT USE OR DESTROY OBUF AND ITS CONTENTS TNTR MOV C,A LDA CASE PUSH PSW BMAL MVI A,' ' ;SPACE OVER TO TAB CALL OUTC DCR C JNZ BMAL BMSL MOV A,M ;OUTPUT THE MESSAG  E INX H CALL CAPR ;DO CASE PROCESSING JC BMSL ;IGNORE LAST CHAR CPI ':' ;SUBSTITUTE THE PAGE NUMBER CZ BIND ;AT OCCURANCE OF COLON CPI CR JZ BMXT CALL OUTC JMP BMSL BMXT STA PPOS POP PSW STA CASE LDA TSTG ;RESTORE LINE COUNT MOV CESS A LETTER ORA A MOV A,B SHLD APNT JZ NOFM CALL FMAT ;EITHER LEFT OR TOTAL JUST. JMP PRIN NOFM CALL UFMT ;NO JUSTIFICATION JMP PRIN EOF CALL CLOS ;CLOSE PENDING LINE XRA A STA EOT CALL NPAG MVI A,0FFH STA EOT JMP MAIN ;CASC,A RET ;OUTPUT TOP OF PAGE MESSAGE (SEE BMSG) TMSG LDA PAGN CPI 2 RC MOV A,C STA TSTG LHLD TOPA LDA TOPT JMP TNTR ;BINARY TO DECIMAL CONVERT CONTNTS OF A REG ;DIRECT OUTPUT TO PRINTER,COMPLETE WITH ZERO ;SUPPRESSION BIND MVE PROCESSING SUBROUTINE ;RETURN WITH CARRY SET IF CHAR IS TO BE ;IGNORED. (IE WAS A SHIFT COMMAND) ;CHECK IF SHIFT OR UNSHIFT COMMAND CAPR CPI 5EH ;CONTROL N JZ UCAS CPI 5CH ;CONTROL L JZ LCAS ;CHECK AND PROCESS UPPER AND LOWER CASE MOI E,0 LDA PAGN MVI C,100 CALL BIDA MVI C,10 CALL BIDA ADI '0' RET BIDA MVI B,'0'-1 INR B SUB C JNC BIDA+2 ADD C MOV D,A MOV A,B CPI '0' JNZ BINZ MOV A,E ORA A MOV A,D RZ BINZ INR E MOV A,B CALL OUTC MOV A,D RV B,A LDA CASE CPI 3 JZ CASX ;ZERO SAYS SHIFT LOCKED UP ;LAND HERE, EITHER SINGLE SHIFT OR LOWER CASE ;TEST FOR SINGLE SHIFT CPI 1 ;1=SINGLE SHIFT MVI A,0 ;Z FLAG STILL PRESERVED STA CASE ;CLEAR IT ANYWAY JZ CASX ;ZERO SAYS SINGLE SHIFTET ;COMMAND DECODER AND PRINT LOOP ;THIS IS THE MAIN TEXT AND WORD PROCESSING LOOP ;HERE, WE GET THE NEXT CHAR FROM TEXT AND SEE ;IF A COMMAND, OR PROCESSED TEXT PRIN LHLD APNT ;SOURCE TEXT POINTER PRLP MOV A,M INX H CPI 3 JC EOF CPI ':'  ;LAND HERE, LOWER CASE COND ;TEST IF IT IS ALPHA MOV A,B CPI 'A' JC CASX ;NOT ALPHA CPI 'Z'+1 JNC CASX ;NOT ALPHA ;LAND HERE, CONVERT TO LOWER CASE MVI A,20H ORA B MOV B,A ;EXIT WITH CARRY BIT CLEAR CASX ORA A MOV A,B RE;COLON=BEGINNING OF COMMAND JZ CMND CALL CAPR ;DO CASE PROCESSING JC PRLP ;LETTER WAS TO BE IGNORED MOV B,A ;TEST IF DIRECT OUTPUT OF NEXT CHAR CPI 5BH ;CONTROL K? JNZ PROC ;NO MOV B,M ;OUTPUT WITHOUT QUESTION INX H PROC LDA JFLG ;PROT ;PROCESS UNSHIFT OR LOWER CASE MODE LCAS XRA A JMP NOLCK ;PROCESS SHIFT (EITHER SINGLE OR SHIFT LOCK) UCAS LDA CASE CPI 1 JZ LOCK MVI A,1 ;SINGLE SHIFT JMP NOLCK LOCK MVI A,3 NOLCK STA CASE STC ;SET CARRY, IGNORE LETTER RET    ;COLON WAS ENCOUNTERED IN TEXT ;THIS TESTS NEXT TWO CHARACTERS ;AGAINST ALL COMMANDS TO FIND COMMAND ;AND CALL IT CMND MOV B,M INX H MOV C,M INX H SHLD CEPT ;POINTS TO DELIMITER LXI H,CTAB ;LOOP TO FIND MATCH CLOP MOV A,M INX H DISC OR TAPE JMP FDIN PROMPT DB '...$' MAIF CPI 'P' JNZ MAIQ ;PROCESS TEXT AND EMBEDDED COMMANDS LXI H,TEXT SHLD APNT CALL CLOS CALL NEWL JMP PRIN MAIQ CPI 'Q' JNZ MAIN ;IF NOT L,P,OR Q LOOP ;RETURN TO MONITOR JMP RE ORA A JZ CRTN CMP B JZ ONEM ;HERE FIRST LETTER FAIL INX H INX H INX H JMP CLOP ;HERE FIRST LETTER MATCH ONEM MOV A,M INX H CMP C JZ TWOM ;HERE SECOND LETTER FAIL INX H INX H JMP CLOP ;COMMAND MATCH TWOM MOV E,M ;LOAD ADSTRT ;ECHOS ON CONSOLE AND OUTS CRLF ECHO CALL CO ECHO1 PUSH B MVI C,CR CALL CO MVI C,LF CALL CO POP B RET ;OUTPUT CARG RTRN AND LINE FEED TO PRINTER ;RETURNS WITH CR IN A CRLF MVI A,CR CALL OUTW MVI A,LF CALL OUTW MVI A,CDR INX H MOV D,M LHLD CEPT SHLD APNT ;POINTING AT DELIMITER LXI H,PRIN ;SET UP RETURN PUSH H XCHG PCHL ;GO TO COMMAND ROUTINE ;FAILED TO MATCH A COMMAND, SO PRINT TEXT CRTN LHLD APNT MOV B,M INX H JMP PROC ;TAPE INPUT ROUTR RET ;THE COMMAND TABLE IN SYS-8 FORMAT ;IE TEXT LETTERS HAVE REVERSED ORDER CTAB DW 'DM' DW DMAR DW 'DT' DW DTAB DW 'PL' DW DPAG DW 'JT' DW TOTJ DW 'JE' DW ENDJ DW 'JL' DW LEFJ DW 'CT' DW CENT DW 'LF' DW LNFD DW 'INE FDIN CALL INIR LXI H,TEXT TPLP CALL GBYT MOV M,A INX H JNC TPLP ;NO EOF FOR FDOS ;FOR TAPE, I WOULD CHECK FOR VALUE LESS THAN 3 ;IE BINARY 1=EOF FOR TAPE ;AND CARRY SET = EOF FROM FDOS DCX H MVI M,1 JMP MAIN ;THIS IS THE IDB' DW DBRK DW 'BP' DW BRKP DW 'NP' DW NPAG DW 'CM' DW MIDC DW 'PN' DW SETP DW 'SP' DW SPAZ DW 'PT' DW PGTP DW 'PB' DW PGBT DW 'TM' DW TMES DW 'BM' DW BMES DW 'PG' DW FPAG DW 'CC' DW CEND DW 'OF' DW OPOF NTERACTIVE PORTION OTHER THAN DIALOG ;ADDED FOR FDOS. ALLOWS 'L' OR 'P' OR 'Q' ONLY ;LOAD OR PRINT OR QUIT MAIN CALL ECHO1 LXI H,PROMPT CALL TXTYP CALL CI ;GET CHAR FROM CONSOLE MOV C,A CALL ECHO1 MOV A,C CPI 'L' JNZ MAIF ;LOAD FROMDW 'ON' DW OPON DB 0 ;TERMINATE A COMMAND ;CR,COMMA,SPACE, OR NOTHING ARE OK CTRM LHLD APNT MOV A,M INX H SHLD APNT CPI CR RZ CPI ' ' RZ CPI ',' RZ DCX H SHLD APNT RET ;FIND DELIMITER WITHIN A COMMAND ;SPACE AND COMMA   ARE ACCEPTED CDEL LHLD APNT MOV A,M INX H CPI ',' RZ CPI ' ' RZ DCX H RET ;CLOSE OR END CENTER TAB COMMAND CEND CALL OUTL JMP CTRM ;IMMEDIATELY FORCE A PAGE START FPAG CALL DVDR JMP CTRM ;DEFINE MARGINS. LEFT, RIGHT UTE LADR FOR MESSAGE CALL ADAH XCHG LHLD CEPT ;START OF MESSAGE ADDRESS CEMV MOV A,M ;MOVE IT TO OBUF INX H CALL CAPR ;DO CASE PROCESSING AGAIN JC CEMV ;LETTER TO BE IGNORED CPI CR RZ STAX D INX D JMP CEMV ;DEFINE PAGE LENGTH D DMAR CALL GARG STA LMAR STA BRTB ;SET THAT TOO CALL GARG STA RMAR CALL CLOS CALL NEWL JMP CTRM ;DEFINE TABS. TAB1,TAB2,TAB3, ETC. TO 14 DTAB LXI H,TTAB SHLD TBAD DTBL CALL CDEL JNZ DTBX CALL ADEC MOV A,L LHLD TBAD MOV M,PAG CALL GARG STA PLEN JMP CTRM ;LINE FEED COMMAND (IGNORE ZERO LF'S) LNFD CALL GARG STA CETM CALL LFDO JMP CTRM ;DO LINE FEEDS AND KEEP TRACK OF POSITION ON PAGE. ;IF NEW PAGE, REST OF LF COMMAND IS FORGOTTEN LFDO CALL CLOS LDA CEA INX H SHLD TBAD JMP DTBL DTBX LHLD TBAD MVI M,0 JMP CTRM ;SET TOTAL JUSTIFICATION MODE TOTJ MVI A,2 STA JFLG JMP CTRM ;SET LEFT JUSTIFICATION MODE LEFJ MVI A,1 STA JFLG JMP CTRM ;CLOSE PRESENT LINE AND SET TO NO JUST. MOTM ORA A RZ MOV C,A LFLP CALL CRLF LDA PPOS INR A STA PPOS LXI H,PLEN CMP M JNC NEXP DCR C RZ JMP LFLP ;DEFINE A PARAGRAPH BREAK. LF'S, TAB DBRK CALL GARG STA BRLF CALL GARG STA BRTB JMP CTRM ;BREAK FOR A NEW PARADE ENDJ XRA A STA JFLG CALL CLOS JMP CTRM ;CENTER TAB, TAB, MESSAGE TO BE CENTERED CENT CALL GARG ;GET TAB CENA STA CETM CALL CDEL JNZ CTRM SHLD CEPT CALL CLOS CENP MVI C,0 LHLD CEPT ;COUNT CHARS IN MESSAGE CECC MOV A,M IGRAPH BRKP CALL CLOS ;CLEAR LINE LDA PPOS ;GET PAGE POSITION ORA A JZ BRKT ;NO LF AT TOP OF PAGE LDA BRLF STA CETM CALL LFDO BRKT LDA BRTB CALL PUTB JMP CTRM ;FORCE BOTTOM PRESENT PAGE AND START NEW ONE NPAG LDA PAGN ORA A JZ NX H CALL CAPR ;DO CASE PROCESSING JC CECC ;LETTER IS TO BE IGNORED INR C CPI CR JNZ CECC ;COMPUTE POSN OF FIRST LETTER OF MESSAGE MOV A,C ORA A RAR MOV C,A LDA CETM SUB C SHLD APNT ;POINTS PAST MESSAGE MOVL LXI H,OBUF ;COMPDVDR CALL CLOS CALL NEWL LDA PLEN STA CETM CALL LFDO JMP CTRM ;CENTER MIDDLE (BETWEEN MARGINS), MESSAGE MIDC LDA RMAR LXI H,LMAR SUB M RAR ;DIVIDE BY TWO ADD M CALL CENA STAX D JMP OUTL ;PAGE NUMBER SETP CALL GARG S  TA PAGN JMP CTRM ;SET SPACING SPAZ CALL GARG STA SPAS JMP CTRM ;DEFINE TOP OF PAGE LENGTH AND ITS LINE OF OCCUPANCE PGTP CALL GARG STA TLEN CALL GARG STA TOPN JMP CTRM ;DEFINE BOTTOM SAME AS ABOVE PGBT CALL GARG STA BLEN BDOS POP B! POP D! POP H RET ;TYPE A LINE OF TEXT ON CONSOLE TXTYP PUSH H! PUSH D! PUSH B XCHG MVI C,9 CALL BDOS POP B POP D POP H RET ;INPUT A LINE OF TEXT FROM CONSOLE TXTIN PUSH H! PUSH D! PUSH B LXI D,CONBUF+65 MVI C,6 CALL GARG STA BOTN JMP CTRM ;SET TOP MESSAGE ADDRESS AND THE MESSAGE TAB TMES CALL GARG STA TOPT CALL CDEL JNZ CTRM SHLD TOPA TMLP MOV A,M INX H CPI CR JNZ TMLP SHLD APNT RET ;SET BOTTOM MSG ADDRESS AND MESSAGE TAB BME5 ;CLEAR BUFFER TO SPACES MVI A,' ' TXTN1 STAX D DCX D DCR C JNZ TXTN1 MVI C,10 CALL BDOS POP B! POP D! POP H RET ;OPEN FILE OPENF LXI D,INFCB MVI C,15 ;CPM FUNCTION FOR OPEN CALL BDOS CPI 255 ;FAILED TO OPEN IF = 255 CMC RS CALL GARG STA BOTT CALL CDEL JNZ CTRM SHLD BOTA JMP TMLP ;TURN OFF PRINTER OUTPUT OPOF XRA A ;ZERO TURNS OFF OUTPUT STA OPST ;MARK AT OUTPUT SYATUS JMP CTRM ;TURN ON PRINTER OPON MVI A,0FFH ;NON-ZERO MEANS ON STA OPST ;MARK ATNZ LXI H,NOFMS ;FILE NOT FOUND MSG CALL TXTYP STC RET NOFMS DB 'FILE NOT FOUND$' ;GET A CHARACTER FROM DISK FILE GBYT PUSH H CALL DISKIN ;LIB ROUTINE TO GET BYTE POP H ; FROM DISK FILE RET ;INITIALIZE TO READ DISK FILE INIR C STATUS JMP CTRM ;GET THE NEXT ARGUMENT GARG CALL CDEL JNZ GARE CALL ADEC MOV A,H ORA A MOV A,L RZ GARE POP H JMP CTRM ; ;I/O ROUTINES ;CONSOLE INPUT OF CHARACTER (ECHOS TOO) CO PUSH H! PUSH D! PUSH B MOV E,C MVI C,2 ALL ECHO1 ;CRLF TO CONSOLE LXI H,GREET CALL TXTYP CALL TXTIN CALL ECHO1 ;CRLF TO CONSOLE LXI H,CONBUF+2 ;+2 FOR COUNTS LXI D,INFCB ; A LA CP/M FORMAT CALL MTFCB ;LIB ROUTINE TO MAKE FCB JC INIR ;ERROR, TRY AGAIN CALL OPENF ;FCB OK, OPENCALL BDOS POP B! POP D! POP H RET ;SEND A CHARACTER TO THE PRINTER PO PUSH H! PUSH D! PUSH B MOV E,C MVI C,5 ;LIST OUT FUNCTION CALL BDOS POP B! POP D! POP H RET ;GET CHAR FROM CONSOLE CI PUSH H! PUSH D! PUSH B MVI C,1 CALL  IT JC INIR ;ERROR, TRY AGAIN LXI H,INBUF+128 ;INIT. FOR DISKIN SHLD INPTR RET GREET DB 'ENTER FILE NAME ',0DH,0AH,'$' ;PRINTER OUTPUT OUTC CPI CR JZ CRLF OUTW PUSH B ANI 7FH MOV C,A LDA OPST ;TEST IF OUTPUT ON ORA A CNZ PO   ;ON IF NON-ZERO CALL CSTS ORA A CNZ ABTST ;KEY PRESSED ON CONSOLE MOV A,C POP B RET ;TEST FOR ABORT (CNTRL C) ABTST CALL CI CPI 3 RNZ ;NOPE JMP RESTRT ;RETURN TO CP/M ;CONSOLE STATUS CHECK...RETURNS A NON-ZERO ; IF KEY PRESS CODE MOV A,M ; TEST IF DISK CODE GOOD INX H ; INX H ; SBI '@' ; RC ; MAKE ERROR RETURN IF BAD CPI 'Z'+1 ; CMC ; RC ; STAX D ; STORE DISK CODE AT FCB + 0 MTFCB1: INX D ; MVI C,8 ; PROCESS FILE NAME FIELD CALL GETNAM ; MOED AT CONSOLE CSTS PUSH H! PUSH D! PUSH B MVI C,11 CALL BDOS POP B! POP D! POP H RET ;++++++++++++++++++++++++++++++++++++++++++++++ ; ; MAKE CP/M FILE CONTROL BLOCK ; ; MAKEFCB.LIB - VERSION 0.2 - 28 OCT 77 ; ; JEFFREY W. SHOOK ; P.V A,M ; TEST FOR FILE TYPE SEPARATOR INX H ; CPI '.' ; JNZ MTFCB2 ; MVI C,3 ; PROCESS FILE TYPE FIELD CALL GETNAM ; MOV A,M ; INX H ; MTFCB2: CALL TERMT ; TEST FOR CORECT TERMINATOR RET ; PROCESS NAME FIELD GETNAM: MOV A,M ; O. BOX 185 ; ROCKY POINT, NEW YORK 11778 ; (516) 744 7133 ; ;++++++++++++++++++++++++++++++++++++++++++++++ ; CREATE A CP/M FILE CONTROL BLOCK FROM ; A COMMAND STRING AT THE ADDRESS IN HL ; AND PLACE IT AT THE ADDRESS IN DE. RETURN ; WITH THEGET CHAR FROM CMD STR INX H ; CPI '?' ; ALLOW AMBIG REFERENCE CHAR JZ GETNA1 ; CPI '*' ; FILL REST WITH ? JZ GETNA2 ; CALL VALCHR ; TEST FOR ALLOWED CHAR IN NAME JC GETNA3 ; GETNA1: STAX D ; STORE CHAR IN TFCB INX D ; DCR C ; C CARRY SET IF AN ERROR OCCURS. ; DEFINITIONS FCBSIZ: EQU 33 FNMLEN: EQU 11 ; FILE NAME LENGTH MTFCB: PUSH H ; SAVE CMD STRING PTR PUSH D ; SAVE FCB ADDRESS LXI B,FCBSIZ; CLEAR ENTIRE FCB AREA MVI A,0 ; CALL FILLB ; POP D ; FILLHECK NAME SIZE JNZ GETNAM ; RET ; GETNA2: MVI A,'?' ; FILL REST OF FIELD WITH ? MVI B,0 ; JMP FILLB ; GETNA3: INX D ; MOVE FCB PTR TO END OF FIELD DCR C ; JNZ GETNA3 ; DCX H ; RET ; ; TEST FOR VALID CHAR IN NAME FIELD ; RET FILE NAME WITH SPACES PUSH D ; INX D ; LXI B,FNMLEN; MVI A,' ' ; CALL FILLB ; POP D ; RESTORE POINTERS POP H ; CALL SKIPS ; SKIP LEADING SPACES INX H ; CHECK FOR DISK CODE MOV A,M ; DCX H ; CPI ':' ; JNZ MTFCB1 ; JUMP ON NOURN WITH CARRY SET IF INVALID. VALCHR: CPI '*' CMC RZ CPI ',' CMC RZ CPI '.' CMC RZ CPI ' ' RC CPI '^'+1 CMC RC CPI ':' CMC RNC CPI '@' RET ; TEST FOR VALID FILENAME TERMINATOR CHAR ; RETURN WITH CAR  RY SET IF INVALID. TERMT: CPI ' ' RZ CPI ',' RZ CPI CR RZ CPI ';' RZ STC RET ; SKIP SPACES IN CMD STRING SKIPS: MVI A,' ' SKIPS1: CMP M RNZ INX H JMP SKIPS1 ; FILL BLOCK WITH VALUE ; ENTER WITH: ; A = V ; READ CHARACTER FROM FILE DISKIN: LHLD INPTR ; TEST BUFFER POINTER LXI D,-(INBUF+128) DAD D MOV A,H ORA L CZ RDREC ; IF EMPTY, READ NEXT RECORD RC ; RETURN ON BAD READ LHLD INPTR ; GET CHAR FROM BUFFER MOV A,M INX H ; MOVE BUFFER POALUE FOR FILL ; DE = START OF BLOCK ; BC = LENGTH OF BLOCK CLRB: MVI A,0 FILLB: INR B DCR B JNZ FILLB1 INR C DCR C RZ FILLB1: STAX D INX D DCX B JMP FILLB ;++++++++++++++++++++++++++++++++++++++++++++++ ; ; SEQUENTIAL INTER SHLD INPTR RET ; REFILL DISK INPUT BUFFER RDREC: LXI D,INBUF ; SET DMA ADDRESS MVI C,SDMA CALL BDOS LXI D,INFCB ; READ A RECORD MVI C,READ CALL BDOS RAR ; SET CARRY ON BAD READ LXI H,INBUF ; SET POINTER TO BUFFER START SHDISK CHARACTER INPUT ; ; DISKIN.LIB - VERSION 1.0 - 18 SEP 77 ; ; J.W. SHOOK, P.O. BOX 185, ROCKY POINT, NY 11778 ; ;++++++++++++++++++++++++++++++++++++++++++++++ ; BEFORE READING A FILE SEQUENTIALLY ; THE FOLLOWING INITIAL CONDITIONS ; MULD INPTR RET ;MESSAGE FOR TELLING OPERATOR ABOUT NEW PAGE PAGMS DB 'PRESS ANY KEY WHEN READY FOR NEW PAGE$' ;DEFINE VARIABLES RESTRT EQU 0 ;CPM REBOOT BDOS EQU 5 ;CP/M ENTRY FOR I/O READ EQU 20 ;CP/M READ NEXT RECORD FUNCTION SDMA EQU 26 ;ST BE ESTABLISHED. ; 1) A CP/M FILE CONTROL BLOCK ; CONTAINING THE FILE NAME MUST ; START AT LOCATION INFCB. ; 2) A 128 BYTE BUFFER AREA MUST ; START AT LOCATION INBUF. ; 3) THE FILE MUST BE SUCCESSFULLY ; OPENED. ; 4) THE NEXT RECORDCP/M SET DMA ADDRESS FUNCTION CR EQU 13 LF EQU 10 EOT DB 0FFH ;LAST PAGE PRINTED IF ZERO OPST DB 0FFH ;OUTPUT ON OR OFF STATUS TSTG DB 0 ;TEMP STORAGE FOR BMSG CASE DB 3 ;UPPER CASE LOCK INITIALLY SFLP DB 0 ;FLOP FOR EVERY RND SPACE RNDV DB 5AH ;SE POINTER IN ; THE FILE CONTROL BLOCK MUST BE ; SET TO ZERO. ; 5) THE WORD AT LOCATION INPTR ; MUST BE SET TO INBUF+128 TO ; MARK THE BUFFER AS EMPTY. ; 6) TO READ A FILE AGAIN, JUST SET ; NEXT RECORD TO ZERO, AND ; RESET INPTR. ED FOR RANDOM NUMBER LCHR DB 0 ;LAST CHAR FOR TOTAL JUST. CETM DS 1 ;CENTR TAB OR CHAR COUNT CEPT DS 2 ;CENTR TEXT POINTER LMAR DB 10 ;LEFT MARGIN RMAR DB 70 ;RIGHT MARGIN TTAB DB 15 ;TAB TABLE DB 22 DB 30 DB 45 DB 0 DS 10 ;UP TO 15 TABS T  BAD DS 2 ;TAB TABLE POINTER SPAS DB 1 ;SPACING PLEN DB 45 ;PAGE LENGTH BRLF DB 1 ;NEW PARAGRAPH LF'S BRTB DB 15 ;NEW PARAGRAPH TAB TLEN DB 10 ;TOP LENGTH PAGN DB 0 ;PAGE NUMBER TOPN DB 0 ;MSG LINE NUMBER BOTN DB 0 ;MESSAGE LINE NUMBE TOPA DS 2 ;MSG ADDR BOTA DS 2 ;MSG ADDR TOPT DB 10 ;TOP TAB BOTT DB 10 ;BOTTOM TAB BLEN DB 10 ;BOTTOM LENGTH LPOS DB 1 ;LINE POSITION PPOS DB 1 ;PAGE POSITION JFLG DB 0 ;NO JUST. INITIALLY LADR DS 2 ;LPOS ADDR LEND DS 2 ;RIGHT MARGIN ADDRESS APNT DS 2 ;INPUT :PN,0 :DM,15,65 :DB,1,15 :PT,5,0 :PB,5,0 :PL,55 :JT :PG :CM,^^"POW" SPECIAL CHARACTERS FOR CONTROL\ :BP ^CONTROL ^K PRECEDING A CHARACTER CAUSES THAT CHARACTER TO BE PRINTED AS IT APPEARS WITH NO DECODING. ^THIS IS USED FOR EXAMPLE TO PRINT A POINTER MAXL DB 135 ;MAXIMUM LINE LENGTH TCNT DB 0 ;OVERFLOW CHAR COUNT TEML DS 30 ;OVERFLOW BUFFER OBUF DS 136 ;OUTPUT BUFFER INBUF DS 128 ;DISK FILE INPUT BUFFER INFCB DS 33 ;FILE CONTROL BLOCK CONBUF DB 64 ;CONSOLE INPUT BUFFER DB 0 DS 64 INCOLON WHICH IS NORMALLY USED TO INDICATE A COMMAND FOLLOWING AND THUS IS NOT PRINTED. ^SO, ^^CNTRL K\ : WOULD CAUSE THE PRINTING OF THE COLON. :BP ^ (^^ASCII 5E)\ IS USED TO INDICATE UPPER CASE SHIFT. ^IF ONLY ONE IS USED THEN ONLY THE CHARACTER IMMEPTR DS 2 ;POINTER FOR DISKIN0V DS 32 STACK TEXT END ;TEXT BUFFER STARTS HERE MOV C,A LDA CASE PUSH PSW BMAL MVI A,' ' ;SPACE OVER TO TAB CALL OUTC DCR C JNZ BMAL BMSL MOV A,M ;OUTPUT THE MESSAGDIATELY AFTER IT IS UPPER CASE. ^IF TWO ARE USED, THEN ALL ALPHABETIC CHARACTERS ARE UPPER CASE UNTIL THE DOWNSHIFT CHARACTER \ (^^ASCII 5C)\ IS ENCOUNTERED ARE UPPER CASE. ^THERE IS NO EFFECT ON NON-ALPHABETIC CHARACTERS. :BP :CM,^^"POW" COMMANDS AND DEFAULT VALUES\ :BP :CM,^^:DM,10,70\ :BP,^DEFINE MARGINS, LEFT MARGIN, RIGHT MARGIN :BP :CM,:^^DT,15,22,30,45\ :BP,^DEFINE TABS UP TO A MAXIMUM OF 14 TABS. ^TABS MUST BE IN ASCENDING ORDER AND NO ERROR CHECKING IS DONE ON THEM. :BP :CM,^^:PL,4  5\ :BP,^DEFINE PAGE LENGTH (^THE TEXT PORTION) TO BE 45 LINES LONG. :BP :CM,^^:JT\ :BP,^BEGIN TOTAL JUSTIFICATION MODE WITH AUTOMATIC SPACE FILLING. :BP :CM,^^:JE\ :BP,^CLOSE PRESENT LINE AND END ALL JUSTIFICATION. :BP :CM,^^:JL\ :BP,^BEGIN LEFT ED'S (DEFAULT = 1) AND AN INDENTION TO THE POSITION SPECIFIED. (^DEFAULT = LEFT MARGIN.) ^THE INDENTION CAN BE SET AT ANY POSITION EITHER TO RIGHT OR LEFT OF THE LEFT MARGIN. :BP :CM,^^:NP\ :BP,^NEW ^PAGE. ^FORCES THE CLOSE OF THE PRESENT PAGE,FEEDS ONLY JUSTIFICATION MODE. :BP :CM,^^:CT,POSITION,TEXT\ :BP,^CENTER THE TEXT ABOUT THE POSITION (COUNTING FROM THE LEFT OF THE PAGE, NOT THE MARGIN) THAT IS SPECIFIED. ^NOTE: ^THE LINE IS NOT PRINTED UNTIL THE :^^CC\ COMMAND IS ENCOUNTERED. :BP :CM, :^ IT OUT OF THE PRINTER, AND THEN BEGINS A NEW PAGE. :BP :CM,^^:CM,TEXT\ :BP,^AUTOMATICALLY CENTERS THE TEXT BETWEEN THE LEFT MARGIN AND RIGHT MARGIN. ^THIS COMMAND DOES ^^NOT\ NEED TO BE CLOSED WITH A :^^CC\ COMMAND. :BP :CM,^^:PN,0\ :BP,^SETA THE ^CC\ :BP,^CLOSE CENTERING COMMAND. ^THIS COMMAND ^^MUST\ BE ISSUED AFTER THE LAST :^^CT\ COMMAND. ^THIS CLOSES THE OUTPUT LINE. :BP :CM,^^:LF,"N"\ :BP,^LINE ^FEED THE PAGE UP "N" TIMES. ^THIS IS ACTUALLY A ^^CR-LF\ SEQUENCE TO THE PRINTER "N" TIMESPAGE NUMBER TO THE SPECIFIED VALUE. (MAXIMUM IS 256) :BP :CM,^^:SP,1\ :BP,^SET THE SPACING. 1 = SINGLE SPACE, 2 = DOUBLE SPACE, ETC. ^DEFAULT IS 1 OR SINGLE SPACING. :BP :CM,^^:PT,LF,N\ :BP,^DEFINE THE TOP OF THE PAGE TO BE ^^LF\ (^DEFAULT = 10) LIN. :BP :CM,^^:BP\ :BP,^BREAK FOR A NEW PARAGRAPH. ^SINCE CARRIAGE RETURNS ARE CONVERTED TO SPACES DURING EITHER TOTAL OR LEFT JUSTIFICATION, IT IS NECESSARY TO BE ABLE TO SPECIFY THE BEGINNING OF A NEW PARAGRAPH WHILE IN THESE MODES. ^THIS IS DONE WIES LONG, WITH THE TITLE ON LINE ^N. ^IF ^N IS ZERO, THEN NO TITLE IS PRINTED.^^ LF\ CAN ALSO BE ZERO FOR A COMPLETELY FILLED PAGE. :BP :CM,^^:PB,LF,N\ :BP,^DEFINE THE PAGE BOTTOM. ^SEE :^^PT\ ABOVE. :BP :CM,^^:TM,POS,TEXT\ :BP,^DEFINE THE TOP OF PTH THIS COMMAND. ^THE PROGRAM CLOSES THE PRESENT LINE, THEN DOES THE SPECIFIED NUMBER OF LINE FEEDS, AND THEN INDENTS TO THE SPECIFIED POSITION.(^SEE COMMAND :^^DB\ BELOW.) :BP :CM,^^:DB,1,15\ :BP,^DEFINE THE PARAGRAPH BREAK TO BE A NUMBER OF LINE FEAGE MESSAGE (IE THE TITLE). ^IT WILL BE PRINTED AT ^^POS\ AND ^^TEXT\ WILL BE THE MESSAGE. FOR PAGE NUMBERING, A COLON WILL BE REPLACED BY THE CURRENT PAGE NUMBER WHEN FOUND IN THE ^^TEXT\. :BP ^EXAMPLE :" :^^TM,45,PAGE\- :-" WOULD CAUSE THE TOP MESSAG  E TO BE PRINTED 45 SPACES FROM THE LEFT OF THE PAGE AS "^^PAGE-4-"\ WHEN PAGE 4 IS PRINTED. :BP :CM,^^:BM,POS,TEXT\ :BP,^DEFINES THE BOTTOM OF PAGE MESSAGE.^SEE :^^TM\ ABOVE. :BP :CM,^^:PG\ :BP,^IMMEDIATELY FORCES THE BEGINNING OF A NEW PAGE (IT WILL NOT FINISH THE PRESENT PAGE). ^THIS COMMAND SHOULD BE ALWAYS GIVEN AT THE BEGINNING OF A NEW TEXT FILE. :BP :CM,^^:OF\ :BP,^TURNS OFF THE PRINTER. ^THE PROGRAM CONTINUES TO PROCESS TEXT AS IF IT WERE ON, BUT THERE IS NO OUTPUT. :BP,:CM,^^:ON\ :BP,^THIS COMMAND WILL TURN ON THE PRINTER AGAIN AFTER IT WAS TURNED OFF BY THE :^^OF\ COMMAND. ^THIS ALLOWS A SECTION OF THE TEXT INPUT TO BE SKIPPED OVER WITHOUT PRINTING. :JE   :DM,10,75 :DB,2,15 :PT,10,5:PB,10,0 :TM,48,^^POW...-:- :JT :PG :CM,^^....POW....\ :LF,3 :BP,^^POW\ IS A PROGRAM THAT IS A "^PROCESSOR ^OF ^WORDS" FOR THE 8080 COMPUTER. ^^POW\ MOST CLOSELY RESEMBLES A PROGRAM CALLED ^^PRINTER\ WRITTEN BY ^CLYDEERS ARE EITHER A COMMA, OR A SPACE, AND A TERMINATOR CAN BE EITHER A COMMA, A SPACE, OR NOTHING. ^THIS ALLOWS MAXIMUM FREEDOM FROM RIGID COMMAND SYNTAX. ^A SAMPLE OF THE COMMAND FORMAT IS SHOWN BY THE DEFINITION OF MARGINS::LF,1 :CM,:^^DM\,10,70 :BP ^ROBY. ^^POW\ HAS THE ABILITY TO SET MARGINS, TABS, SPACING, JUSTIFICATION, AND INDENTATION AND IN ADDITION PROVIDES AUTOMATIC CENTERING, AND AUTOMATIC PAGING WITH TITLES AND NUMBERING. :BP,^THIS PROGRAM WORKS ON AN EXISTING FILE THAT HAS BEEN PREPAR,^IN ADDITION TO THE LIST OF COMMANDS, ^^POW\ ALSO HAS THE ABILITY TO ALLOW THE USE OF AN UPPER AND LOWER CASE PRINTER WITH AN UPPER CASE ONLY INPUT FILE. :JE ED WITH SOME TYPE OF EDITOR AND SAVED ON A MASS STORAGE DEVICE. ^I AM CURRENTLY USING A MODIFIED VERSION OF ^F. ^J. ^GREEB'S EDITOR THAT WAS PUBLISHED IN ^^DDJ \ ^JUNE-^JULY 1976, ALONG WITH ^PERIPHERAL ^VISION'S FLOPPY DISC OPERATING SYSTEM. ^^POW\ HAS BEEN USED WITH CASSETTE TAPE, AND BY SUBSTITUTING THE CASSETTE ^^I/O\ ROUTINES FOR THE ^^FDOS I/O\ ROUTINES, IT CAN EASILY BE CONVERTED BACK. :BP,^COMMANDS ARE FREELY INSERTED INTO THE SOURCE TEXT WHEN IT IS PREPARED. ^^POW\ WILL REACT TO THOSE COM; MACRO LIBRARY FOR "DOWHILE" CONSTRUCT ; GENDTST MACRO TST,X,Y,NUM ;; GENERATE A "DOWHILE" TEST TST X,Y,,ENDD&NUM ENDM ; GENDLAB MACRO LAB,NUM ;; PRODUCE THE LABEL LAB & NUM ;; FOR DOWHILE ENTRY OR EXIT LAB&NUM: ENDM ; GENDJMP MACRO NUM ;MANDS WHEN IT ENCOUNTERS THEM WHILE PRINTING OUT THE FILE. ^COMMANDS ALL CONSIST OF THE SAME FORMAT WHICH IS A COLON IMMEDIATELY FOLLOWED BY A TWO LETTER COMMAND NAME, THEN A DELIMITER WITH OPTIONAL DATA FOR THE COMMAND, AND/OR A TERMINATOR. ^DELIMIT; GENERATE JUMP TO DOWHILE TEST JMP DTEST&NUM ENDM ; DOWHILE MACRO XV,REL,YV ;; INITIALIZE COUNTER DOCNT SET 0 ;NUMBER OF DOWHILES ;; DOWHILE MACRO X,R,Y ;; GENERATE THE DOWHILE ENTRY GENDLAB DTEST,%DOCNT ;; GENERATE THE CONDITIONAL TEST GE  NDTST R,X,Y,%DOCNT SYMPSH DOCNT ;;NEXT ENDDO TO GENERATE (STACKED) DOCNT SET DOCNT+1 ENDM DOWHILE XV,REL,YV ENDM ; ENDDO MACRO ;; GENERATE THE JUMP TO THE TEST SYMPOP DOLEV GENDJMP %DOLEV ;; GENERATE THE END OF A DOWHILE GENDLAB ENDD,%DOLEV ENDM DDO MACRO ;; GENERATE THE JUMP TO THE TEST SYMPOP DOLEV GENDJMP %DOLEV ;; GENERATE THE END OF A DOWHILE GENDLAB ENDD,%DO; MACRO LIBRARY FOR 8-BIT COMPARISON OPERATION ; TEST? MACRO X,Y ;; UTILTITY MACRO TO GENERATE CONDITION CODES IF NOT NUL X ;;THEN LOAD X LDA X ;;X ASSUMED TO BE IN MEMORY ENDIF IRPC ?Y,Y ;;Y MAY BE CONSTANT OPERAND TDIG? SET '&?Y'-'0' ;;FIRST CHAR DIGIT? EXITM ;;STOP IRPC AFTER FIRST CHAR ENDM IF TDIG? <= 9 ;;Y NUMERIC? SUI Y ;;YES, SO SUB IMMEDIATE ELSE LXI H,Y ;;Y NOT NUMERIC SUB M ;;SO SUB FROM MEMORY ENDM ; LSS MACRO X,Y,TL,FL ;; X LSS THAN Y TEST, ;; IF TL IS PRESENT, ASSUME TRUE TEST ;; IF TL IS ABSENT, THEN INVERT TEST IF NUL TL GEQ X,Y,FL ELSE TEST? X,Y ;;SET CONDITION CODES JC TL ENDM ; LEQ MACRO X,Y,TL,FL ;; X LESS THAN OR EQUAL TO Y TEST IF NUL TL GTR X,Y,FL ELSE LSS X,Y,TL JZ TL ENDM ; EQL MACRO X,Y,TL,FL ;; X EQUAL TO Y TEST IF NUL TL NEQ X,Y,FL ELSE TEST? X,Y JZ TL ENDM ; NEQ MACRO X,Y,TL,FL ;; X NOT EQUAL TO Y TEST IF NUL TL EQL X,Y,FL ELSE TEST? X,Y JNZ TL ENDM ; GEQ MACRO X,Y,TL,FL ;; X GREATER THAN!   OR EQUAL TO Y TEST IF NUL TL LSS X,Y,FL ELSE TEST? X,Y JNC TL ENDM ; GTR MACRO X,Y,TL,FL ;; X GREATER THAN Y TEST IF NUL TL LEQ X,Y,FL ELSE LOCAL GFL ;;FALSE LABEL TEST? X,Y JC GFL DCR A JNC TL GFL: ENDM  ;; GENERATE LABEL FOR THIS CASE CASE&NUM&@&ELT: ENDM ; GENELT MACRO NUM,ELT ;; GENERATE ONE ELEMENT OF CASE LIST DW CASE&NUM&@&ELT ENDM ; GENSLAB MACRO NUM,ELTS ;; GENERATE CASE LIST SELV&NUM: ECNT SET 0 ;;COUNT ELEMENTS REPT ELTS ;;GENERATE DW'S GENELT NUM,%ECNT ECNT SET ECNT+1 ENDM ;;END OF DW'S ;; GENERATE END OF CASE LIST LABEL ENDS&NUM: ENDM ; SELNEXT MACRO ;; GENERATE THE NEXT CASE GENCASE %CCNT,%ECNT ;; INCREMENT THE CASE ELEMENT COUNT ECNT SET ECNT+1 ENDM ; SELECT MACRO VAR ;; GENERATE CASE SELECTION CODE SCNT SET 0 ;;COUNT "SELECTS" SELECT MACRO V ;;REDEFINITION OF SELECT SYMPSH %CCNT ;;SAVE PREVIOUS SELECT NUMBER SYMPSH %ECNT ;;AND ITS CASE COUNT CCNT SET SCNT ;;CREATE NEXT SELECT NUMBER SCNT SET SCNT+1 ;;UPDATE SELECT COUNT ;; SELECT ON V OR ACCUMULATOR CONTENTS IF NOT NUL V LDA V ;;LOAD SELECT VARIABLE ENDIF GENSLXI %CCNT ;;GENERATE THE LXI H,SELV# MOV E,A ;;CREATE DOUBLE PRECISION MVI D,0 ;;V IN D,E PAIR DAD D ;;SINGLE PREC INDEX DA; MACRO LIBRARY FOR "SELECT" CONSTRUCT ; ; LABEL GENERATORS GENSLXI MACRO NUM ;; LOAD HL WITH ADDRESS OF CASE LIST LXI H,SELV&NUM ENDM ; GENCASE MACRO NUM,ELT ;; GENERATE JMP TO END OF CASES IF ELT GT 0 JMP ENDS&NUM ;;PAST ADDR LIST ENDIF D D ;;DOUBLE PREC INDEX MOV E,M ;;LOW ORDER BRANCH ADDR INX H ;;TO HIGH ORDER BYTE MOV D,M ;;HIGH ORDER BRANCH INDEX XCHG ;;READY BRANCH ADDRESS IN HL PCHL ;;GONE TO THE PROPER CASE ECNT SET 0 ;;ELEMENT COUNTER RESET SELNEXT ;;SELECT CASE 0"   ENDM ;; INVOKE REDEFINED SELECT THE FIRST TIME SELECT VAR ENDM ; ENDSEL MACRO ;; END OF SELECT, GENERATE CASE LIST GENCASE %CCNT,%ECNT ;;LAST CASE GENSLAB %CCNT,%ECNT ;;CASE LIST ;; GET BACK PREVIOUS SELECT PARAMETERS (IF ANY) SYMPOP ECNT "FILE" MACRO INFILE EQU 1 ;INPUT FILE OUTFILE EQU 2 ;OUTPUTFILE SETFILE EQU 3 ;SETUP NAME ONLY ; ; THE FOLLOWING MACROS DEFINE SIMPLE SEQUENTIAL ; FILE OPERATIONS: ; FILLNAM MACRO FC,C ;; FILL THE FILE NAME/TYPE GIVEN BY FC FOR C CHARACTERS @CNT SYMPOP CCNT ENDM GENCASE %CCNT,%ECNT ;;LAST CASE GENSLAB %CCNT,%ECNT ;;CASE LIST ;; GET BACK PREVIOUS SELECT PARAMETERS (IF ANY) SYMPOP ECNT SET C ;;MAX LENGTH IRPC ?FC,FC ;;FILL EACH CHARACTER ;; MAY BE END OF COUNT OR NUL NAME IF @CNT=0 OR NUL ?FC EXITM ENDIF DB '&?FC' ;;FILL ONE MORE @CNT SET @CNT-1 ;;DECREMENT MAX LENGTH ENDM ;;OF IRPC ?FC ;; ;; PAD REMAINDER REPT @CNT ;; SEQUENTIAL FILE I/O LIBRARY ; FILERR SET 0000H ;REBOOT AFTER ERROR @BDOS EQU 0005H ;BDOS ENTRY POINT @TFCB EQU 005CH ;DEFAULT FILE CONTROL BLOCK @TBUF EQU 0080H ;DEFAULT BUFFER ADDRESS ; ; BDOS FUNCTIONS @MSG EQU 9 ;SEND MESSAGE @OPN EQU 15 ;FIL;@CNT IS REMAINDER DB ' ' ;;PAD ONE MORE BLANK ENDM ;;OF REPT ENDM ; FILLDEF MACRO FCB,?FL,?LN ;; FILL THE FILE NAME FROM THE DEFAULT FCB ;; FOR LENGTH ?LN (9 OR 12) LOCAL PSUB JMP PSUB ;;JUMP PAST THE SUBROUTINE @DEF: ;;THIS SUBROUTINE FILE OPEN @CLS EQU 16 ;FILE CLOSE @DIR EQU 17 ;DIRECTORY SEARCH @DEL EQU 19 ;FILE DELETE @FRD EQU 20 ;FILE READ OPERATION @FWR EQU 21 ;FILE WRITE OPERATION @MAK EQU 22 ;FILE MAKE @REN EQU 23 ;FILE RENAME @DMA EQU 26 ;SET DMA ADDRESS ; @SECT EQU 128 LS FROM THE TFCB (+16) MOV A,M ;;GET NEXT CHARACTER TO A STAX D ;;STORE TO FCB AREA INX H INX D DCR C ;;COUNT LENGTH DOWN TO 0 JNZ @DEF RET ;; END OF FILL SUBROUTINE PSUB: FILLDEF MACRO ?FCB,?F,?L LXI H,@TFCB+?F ;;EITHER @TFCB OR @TFCB+1;SECTOR SIZE EOF EQU 1AH ;END OF FILE CR EQU 0DH ;CARRIAGE RETURN LF EQU 0AH ;LINE FEED TAB EQU 09H ;HORIZONTAL TAB ; @KEY EQU 1 ;KEYBOARD @CON EQU 2 ;CONSOLE DISPLAY @RDR EQU 3 ;READER @PUN EQU 4 ;PUNCH @LST EQU 5 ;LIST DEVICE ; ; KEYWORDS FOR6 LXI D,?FCB MVI C,?L ;;LENGTH = 9,12 CALL @DEF ENDM FILLDEF FCB,?FL,?LN ENDM ; FILLNXT MACRO ;; INITIALIZE BUFFER AND DEVICE NUMBERS @NXTB SET 0 ;;NEXT BUFFER LOCATION @NXTD SET @LST+1 ;;NEXT DEVICE NUMBER FILLNXT MACRO ENDM ENDM ;#   FILLFCB MACRO FID,DN,FN,FT,BS,BA ;; FILL THE FILE CONTROL BLOCK WITH DISK NAME ;; FID IS AN INTERNAL NAME FOR THE FILE, ;; DN IS THE DRIVE NAME (A,B..), OR BLANK ;; FN IS THE FILE NAME, OR BLANK ;; FT IS THE FILE TYPE ;; BS IS THE BUFFER SIZE ;; E FIELD, AND DISK MAP DS 20 ;;X,X,RC,DM0...DM15,CR FIELDS ;; IF FID&TYP<=2 ;;IN/OUTFILE ;; GENERATE CONSTANTS FOR INFILE/OUTFILE FILLNXT ;;@NXTB=0 ON FIRST CALL IF BS+0<@SECT ;; BS NOT SUPPLIED, OR TOO SMALL @BS SET @SECT ;;DEFAULT TO ONE SECTBA IS THE BUFFER ADDRESS LOCAL PFCB ;; ;; SET UP THE FILE CONTROL BLOCK FOR THE FILE ;; LOOK FOR FILE NAME = 1 OR 2 @C SET 1 ;;ASSUME TRUE TO BEGIN WITH IRPC ?C,FN ;;LOOK THROUGH CHARACTERS OF NAME IF NOT ('&?C' = '1' OR '&?C' = '2') @C SET 0 ;;OR ELSE ;; COMPUTE EVEN BUFFER ADDRESS @BS SET (BS/@SECT)*@SECT ENDIF ;; ;; NOW DEFINE BUFFER BASE ADDRESS IF NUL BA ;; USE NEXT ADDRESS AFTER @NXTB FID&BUF SET BUFFERS+@NXTB ;; COUNT PAST THIS BUFFER @NXTB SET @NXTB+@BS ELSE FID&BUF SET BCLEAR IF NOT 1 OR 2 ENDM ;; @C IS TRUE IF FN = 1 OR 2 AT THIS POINT IF @C ;;THEN FN = 1 OR 2 ;; FILL FROM DEFAULT AREA IF NUL FT ;;TYPE SPECIFIED? @C SET 12 ;;BOTH NAME AND TYPE ELSE @C SET 9 ;;NAME ONLY ENDIF FILLDEF FCB&FID,(FN-1)*16,@C ;A ENDIF ;; FID&BUF IS BUFFER ADDRESS FID&ADR: DW FID&BUF ;; FID&SIZ EQU @BS ;;LITERAL SIZE FID&LEN: DW @BS ;;BUFFER SIZE FID&PTR: DS 2 ;;SET IN INFILE/OUTFILE ;; SET DEVICE NUMBER @&FID SET @NXTD ;;NEXT DEVICE @NXTD SET @NXTD+1 ENDIF ;;O;TO SELECT THE FCB JMP PFCB ;;PAST FCB DEFINITION DS @C ;;SPACE FOR DRIVE/FILENAME/TYPE FILLNAM FT,12-@C ;;SERIES OF DB'S ELSE JMP PFCB ;;PAST INITIALIZED FCB IF NUL DN DB 0 ;;USE DEFAULT DRIVE IF NAME IS ZERO ELSE DB '&DN'-'A'+1 ;;USE SPF FID&TYP<=2 TEST PFCB: ENDM ; FILE MACRO MD,FID,DN,FN,FT,BS,BA ;; CREATE FILE USING MODE MD: ;; INFILE = 1 INPUT FILE ;; OUTFILE = 2 OUTPUT FILE ;; SETFILE = 3 SETUP FCB ;; (SEE FILLFCB FOR REMAINING PARAMETERS) LOCAL PSUB,MSG,PMSG LOCAL PNECIFIED DRIVE ENDIF FILLNAM FN,8 ;;FILL FILE NAME ;; NOW GENERATE THE FILE TYPE WITH PADDED BLANKS FILLNAM FT,3 ;;AND THREE CHARACTER TYPE ENDIF FCB&FID EQU $-12 ;;BEGINNING OF THE FCB DB 0 ;;EXTENT FIELD 00 FOR SETFILE ;; NOW DEFINE THE 3 BYTD,EOD,EOB,PNC ;; CONSTRUCT THE FILE CONTROL BLOCK ;; FID&TYP EQU MD ;;SET MODE FOR LATER REF'S FILLFCB FID,DN,FN,FT,BS,BA IF MD=3 ;;SETUP FCB ONLY, SO EXIT EXITM ENDIF ;; FILE CONTROL BLOCK AND RELATED PARAMETERS ;; ARE CREATED INLINE, NOW CRE$  ATE IO FUNCTION JMP PSUB ;;PAST INLINE SUBROUTINE IF MD=1 ;;INPUT FILE GET&FID: ELSE PUT&FID: PUSH PSW ;;SAVE OUTPUT CHARACTER ENDIF LHLD FID&LEN ;;LOAD CURRENT BUFFER LENGTH XCHG ;;DE IS LENGTH LHLD FID&PTR ;;LOAD NEXT TO GET/PUT TO HL ;;PROCESS ANOTHER SECTOR ;; EOD: ;; END OF FILE/DISK ENCOUNTERED IF MD=1 ;;INPUT FILE LHLD FID&PTR ;;LENGTH OF BUFFER SHLD FID&LEN ;;RESET LENGTH ELSE ;; FATAL ERROR, END OF DISK LOCAL EMSG MVI C,@MSG ;;WRITE THE ERROR LXI D,EMSG CALL @ MOV A,L ;;COMPUTE CUR-LEN SUB E MOV A,H SBB D ;;CARRY IF NEXT255 ;; CHECK HIGH ORDER BYTE ALSO MOV A,H ANI (@SECT-1) SHR 8 JNZ PEOF ;;PUT EOF IF NOT 00 ENDIF ;; ARRIVE HERE IF END OF BUFFER, SET LENGTH ;; AND WRITE ONE MORE BYTE TO CLEAR BUFFS SHLD ?F&LOS ;;TO CLEAR EXISTING FILE MVI C,@MAK ;;CREATE A NEW FILE ENDIF ;; NOW OPEN (IF INPUT), OR MAKE (IF OUTPUT) LXI D,FCB&FID CALL @BDOS ;;OPEN/MAKE OK? INR A ;;255 BECOMES 00 JNZ PMSG MVI C,@MSG ;;PRINT MESSAGE FUNCTION LXI D,MSG ;;ERROR MESEN ;;SET TO SHORTER LENGTH PEOF: MVI A,EOF ;;WRITE ANOTHER EOF PUSH PSW ;;SAVE ZERO FLAG CALL PUT&?F POP PSW ;;RECALL ZERO FLAG JNZ EOB? ;;NON ZERO IF MORE ;; BUFFERS HAVE BEEN WRITTEN, CLOSE FILE MVI C,@CLS LXI D,FCB&?F ;;READY FOR CALL CASAGE CALL @BDOS ;;PRINTED AT CONSOLE JMP FILERR ;;TO RESTART MSG: DB CR,LF IF MD=1 ;;INPUT MESSAGE DB 'NO &FID FILE' ELSE DB 'NO DIR SPACE: &FID' ENDIF DB '$' PMSG: ENDM ; PUT MACRO DEV ;; WRITE CHARACTER FROM ACCUM TO DEVICE IF @&LL @BDOS INR A ;;255 IF ERR BECOMES 00 JNZ PMSG ;; FILE CANNOT BE CLOSED MVI C,@MSG LXI D,MSG CALL @BDOS JMP PMSG ;;ERROR MESSAGE PRINTED MSG: DB CR,LF DB 'CANNOT CLOSE &?F' DB '$' PMSG: ENDIF ENDM ;;OF THE IRP ENDM ; ERASE MACRODEV <= @LST ;; SIMPLE OUTPUT PUSH PSW ;;SAVE CHARACTER MVI C,@&DEV ;;WRITE CHAR FUNCTION MOV E,A ;;READY FOR OUTPUT CALL @BDOS ;;WRITE CHARACTER POP PSW ;;RESTORE FOR TESTING ELSE CALL PUT&DEV ENDM ; FINIS MACRO FID ;; CLOSE THE FILE(S) FID ;; DELETE THE FILE(S) GIVEN BY FID IRP ?F, MVI C,@DEL LXI D,FCB&?F CALL @BDOS ENDM ;;OF THE IRP ENDM ; DIRECT MACRO FID ;; PERFORM DIRECTORY SEARCH FOR FILE ;; SETS ZERO FLAG IF NOT PRESENT LXI D,FCB&FID MVI C,@DIR CALL @BD GIVEN BY FID IRP ?F, ;; SKIP ALL BUT OUTPUT FILES IF ?F&TYP=2 LOCAL EOB?,PEOF,MSG,PMSG ;; WRITE ALL PARTIALLY FILLED BUFFERS EOB?: ;;ARE WE AT THE END OF A BUFFER? LHLD ?F&PTR ;;NEXT TO FILL MOV A,L ;;ON BUFFER BOUNDARY? ANI (@SECT-1) OS INR A ;00 IF NOT PRESENT ENDM ; RENAME MACRO NEW,OLD ;; RENAME FILE GIVEN BY "OLD" TO "NEW" LOCAL PSUB,REN0 ;; INCLUDE THE RENAME SUBROUTINE ONCE JMP PSUB @RENS: ;;RENAME SUBROUTINE, HL IS ADDRESS OF ;;OLD FCB, DE IS ADDRESS OF NEW FCB &  PUSH H ;;SAVE FOR RENAME LXI B,16 ;;B=00,C=16 DAD B ;;HL = OLD FCB+16 REN0: LDAX D ;;NEW FCB NAME MOV M,A ;;TO OLD FCB+16 INX D ;;NEXT NEW CHAR INX H ;;NEXT FCB CHAR DCR C ;;COUNT DOWN FROM 16 JNZ REN0 ;; OLD NAME IN FIRST HALF, NEW IN SECOND HALF POP D ;;RECALL BASE OF OLD NAME MVI C,@REN ;;RENAME FUNCTION CALL @BDOS RET ;;RENAME COMPLETE PSUB: RENAME MACRO N,O ;;REDEFINE RENAME LXI H,FCB&O ;;OLD FCB ADDRESS LXI D,FCB&N ;;NEW FCB ADDRESS CALL @RENS ;;RENAME SUBROUTINE ENDM RENAME NEW,OLD ENDM ; GET MACRO DEV ;; READ CHARACTER FROM DEVICE IF @&DEV <= @LST ;; SIMPLE INPUT MVI C,@&DEV CALL @BDOS ELSE CALL GET&DEV ENDM ; '   DISK.DOC -FOG/HAK.004 First Osborne Group (FOG) Hackers Disk This disk contains DUMP24X and ROM previously found on -FOG.016, JRNL, PASSWORD, and RESIZE from -FOG.018, and POW and macro library .LIB files from -FOG.020. Additional .LIB files are continued on -FOG/HAK.005. Jim Woolley FOG Disk Librarian October, 1982