DataMuseum.dk

top - metrics - download

    Length: 8176 (0x1ff0)
    Notes: OS65UFile, OSU65U-BASIC
    Names: »DMSCOP«

└─⟦2f57871a3⟧ Bits:30009355 Ohio Scientific OS-OMS Nucleus, delvist oversat til dansk
    └─⟦this⟧ »DMSCOP« 

BASIC

00001 PRINT"** PROGRAM NOT EXECUTABLE FROM CONSOLE **":RUN"DBMSYS","PASS"
00002 CLOSE:CLEAR:REM 1/79  DISKETTE COPIER  (DMSCOP)
00003 POKE2888,0:FLAG9
00005 FOR I=1 TO 27:PRINT:NEXT: REM CLEAR SCREEN
00010 PRINT"DB 2  DISKETTE KOPIERING"
00011 PRINT"------------------------"
00025 PRINT
00027 PRINT"       *****  ADVARSEL  *****"
00029 PRINT
00031 PRINT"    FORKERT BRUG AF DETTE PROGRAM"
00033 PRINT"    VIL BEVIRKE \DEL[GGELSE AF"
00034 PRINT"    DATABASESYSTEMET !!"
00037 PRINT
00046 PRINT
00050 PRINT"               INSTRUKTIONER:"
00051 PRINT"               --------------"
00053 PRINT
00055 PRINT"1 - PLASER DISKETTEN DER SKAL KOPIERES I DEN \VERSTE STATION"
00056 PRINT
00060 PRINT"2 - PLASER DEN BLANKE DISKETTE I DEN NEDERSTE STATION"
00061 PRINT
00065 PRINT"3 - KONTROLLER DEN BLANKE DISKETTE ER I NEDERSTE STATION"
00067 PRINT
00068 PRINT
00070 INPUT"TAST RETURN";X$
00080 FOR I=1 TO 27:PRINT:NEXT
00090 PRINT"VIGTIGT!!!";CHR$(7)
00092 PRINT
00094 PRINT"UNDERS\G AT:"
00095 PRINT
00096 PRINT"            \VERSTE STATION INDEHOLDER MASTER DISKETTE"
00097 PRINT"            NEDERSTE STATION INDEHOLDER BLANK DISKETTE"
00098 PRINT:PRINT
00099 INPUT"\NSKES DET AT FORTS[TTE (J/N)";X$
00100 X$=LEFT$(X$,1)
00101 IF X$="N" THEN RUN"DBMSYS","PASS"
00102 IF X$="J" GOTO 110
00105 PRINT CHR$(7):GOTO 99
00110 FOR I=1 TO 27:PRINT:NEXT
00115 PRINT"DISKETTESTATIONENS TYPE"
00116 PRINT
00117 PRINT"    (1) ENKELTSIDET"
00118 PRINT"    (2) DOBBELTSIDET"
00119 PRINT
00120 INPUT"INDTAST NUMMERET P] TYPEN";JL
00121 IF JL=1 OR JL=2 GOTO 130
00124 PRINT CHR$(7):GOTO 120
00130 PRINT:PRINT:PRINT" VENT CA. ";JL*2;" MINUTTER"
00135 REM
00250 REM   SAVE INITIAL DEV ASSIGNMENT
00280 TMPU=PEEK(9832): REM  $2668 DISCN
00290 QA$="I": REM  INITIAL CONDITION
00291 JH=1: REM FIRST TIME
00310 REM  
00370 REM
00400 REM  RETURN POINT
00410 IF JH=1 THEN FR$="A":TU$="B":GOTO 430
00415 IF JH=JL THEN FR$="C":TU$="D":JH=JH+1:QA$="I":GOTO 430
00416 IF JL=1 AND JH=2 GOTO 418
00417 IF JH-1=JL THEN QA$="A":GOTO 430
00418 GOTO 5050
00430 IF QA$<>"I" GOTO 520
00460 REM
00520 CB=9889: JV=8778: REM  $26A1 XFR CB, $224A USR JV
00550 FR=18176: TU=18177: TRACK=18178: REM  $4700,1,2 FOR WHICHR/W
00580 ZV=9431: REM  $24D7 INTERF SUBR R/W JMPS
00610 Z1L=82: Z2H=39: REM  $2752  WHICHR
00640 Z3L=242: Z4H=38: REM  $26F2 WHICHW
00670 XV=9467: REM  $24FB BDIS2 JMP
00700 X1L=197: X2H=47: REM  $2FC5 INIZ TK SUBR
00730 X3L=101: X4H=48: REM  $3065 INIZ DISK SUBR
00760 REM  
00880 IF QA$<>"I" GOTO 2170
00910 REM
00940 DE = ASC(TU$)-ASC("A")
00970 IF DE<0 OR DE>7 GOTO 880
01000 DEV TU$: DV$=TU$
01030 IF DE>3 THEN GOTO 174: REM  3300
01060 REM  
01090 REM  FLOPPY INIZ
01120 FA=0
01150 TA=275000
01180 POKE JV,235: POKE JV+1,36: REM  BDIS2
01210 POKE XV,X1L: POKE XV+1,X2H: REM  FOR TRACK SUBR
01240 BT = INT(FA/3584): ET = INT(TA/3584): REM TRACKS
01270 IF BT*3584=FA AND (ET+1)*3584-1=TA GOTO 1330
01330 POKE XV,X1L: POKE XV+1,X2H: REM  FOR TRACK SUBR
01360 IF BT>1 OR ET<76 GOTO 1480
01390 POKE XV,X3L: POKE XV+1,X4H: REM  FOR ALL TKS
01420 ER = USR(Y):IF ER<>0 THEN RW$="INIT":DA=PEEK(18196)*3584:GOTO5410
01450 GOTO 5530
01480 FOR Y=BT TO ET: REM  DO INDIV TKS
01510 ER = USR(Y): IF ER<>0 THEN RW$="INIT": DA=Y*3584: GOTO 5410
01540 POKE XV,205: POKE 18196,Y+1: REM  FINTK: ENTRY $CD; $4714=TRK
01570 NEXT Y
01600 GOTO 5530
01630 REM  3300 INIZ
01660 INPUT"KODEORD ";PW$:IF VAL(PW$)<>3300 GOTO 1660
01690 INPUT"FRA ADRESSE "; FA:IF FA<0 OR FA>=72898560 GOTO 1690
01720 INPUT"TIL ADRESSE ";TA: IF TA<FA OR TA>=72898560 GOTO 1720
01750 BC = INT(FA/(3584*12*5)): EC = INT((TA)/(3584*12*5))
01780 IF BC*3584*12*5=FA AND (EC+1)*3584*12*5-1=TA GOTO 1870
01810 PRINT "INITIALISERING FRA";BC*3584*12*5;"TIL";(EC+1)*3584*12*5-1
01840 INPUT"KOREKT(J/N)";QA$:IF LEFT$(QA$,1)<>"J" GOTO 1690
01870 POKE 61436,INT(EC/256)*128: POKE 61437,EC-INT(EC/256)*256
01900 POKE 61434,INT(BC/256)*128: POKE 61435,BC-INT(BC/256)*256:REM *R1
01930 POKE 13635,251: POKE 14296,250: REM  *R1  DINIZ FIX
01960 POKE XV,206: POKE XV+1,55: REM  3300 INIZ SUBR
01990 POKE JV,235: POKE JV+1,36: REM  BDIS2
02020 PRINT: PRINT "VENT"; (EC-BC+1)/4; "MINUTER"
02050 ER = USR(X)
02080 IF ER=0 GOTO 5530
02110 DA=(INT(PEEK(18339)/128)*256+PEEK(18340))*215040+PEEK(18338)*224
02140 GOTO 5410
02170 REM  
02200 REM  COPY FUNCTIONS
02230 IF QA$="S" THEN ST=0:EN=6:GOTO 2410
02260 IF QA$="A" THEN ST=0:EN=76:GOTO 2410
02290 IF QA$="F" THEN ST=7:EN=76:GOTO 2410
02320 IF QA$="X" GOTO 760
02350 GOTO 760
02380 REM  
02410 REM
02440 DS = ASC(FR$) - ASC("A"): REM  UNIT A=0, B=1, ETC
02470 IF DS<0 OR DS>7 GOTO 2410
02500 IF DS<4 THEN FS=0:GOTO 2800
02530 FA=0
02560 FS = INT(FA/3584)
02590 TA=275000
02620 ES = INT(TA/3584)
02650 IF FS*3584=FA AND (ES+1)*3584-1=TA GOTO 2710
02710 ST = FS: EN = ES
02740 PRINT
02770 REM  
02800 REM
02830 DE = ASC(TU$) - ASC("A")
02860 IF DE<0 OR DE>7 GOTO 2800
02890 REM  *R1
02920 IF DE<4 THEN TS=ST:GOTO 3100: REM *R1
02950 INPUT"TIL ADRESSE ";AO:IF AO<0 OR AO>=72898560 GOTO 2950
02980 TC = INT(AO/(3584*12*5))
03010 IF TC*3584*12*5=AO GOTO 3070
03040 PRINT "KOPIERING TIL "; TC*3584*12*5
03070 TS = TC*12*5: REM  *R1
03100 SO = TS - ST: REM  *R1
03130 REM  
03160 REM   XFR WHICHR/W ROUTINES INTO SCRATCH BUFFER
03190 DEV FR$: DV$=FR$
03220 REM  SETUP USR VECTOR FOR BASIC-DOS R/W INTERF SUBR & GET$
03250 POKE JV,192: POKE JV+1,36: REM  $24C0 R/W INTERF SUBR
03280 POKE ZV+4,232: POKE ZV+5,40: REM  $28E8 GET$
03310 POKE CB+1,242: POKE CB+2,50: POKE CB+3,0: POKE CB+4,0: REM $32F2
03340 POKE CB+5,0: POKE CB+6,1: REM  256 BYTES
03370 POKE CB+7,242: POKE CB+8,38: REM  $26F2 SCRBUF
03400 RW=0:ER=USR(RW):IF ER<>0 GOTO 5380
03430 REM  
03460 REM   SETUP INTERF SUBR TO GO TO WHICHR/W
03490 POKE ZV+1,Z1L: POKE ZV+2,Z2H: POKE ZV+4,Z3L: POKE ZV+5,Z4H
03520 REM  
03550 POKE 16647,234: REM  KEEP HEAD DOWN, FGET $4107=NOP
03580 POKE 16946,234: REM  KEEP HEAD DOWN, FPUT $4232=NOP
03610 REM  
03640 REM   LOOP FOR EACH SECTOR TO BE COPIED
03670 FOR Y=ST TO EN
03700 REM
03730 REM  READ "FROM UNIT"
03760 DEV FR$: DV$=FR$
03790 REM  
03820 YY=0: IF Y>0 THEN YY=255: REM  *R1
03850 POKE FR,DS: POKE TU,DE: POKE TRACK,YY: REM  *R1 FOR TK0 R/W
03880 REM  FORCE USE OF GET/PUT NOT FLOPPY TK0 R/W FOR 3300
03910 IF DS > 3 THEN POKE TRACK,1
03940 DA = Y*3584: REM   DISC ADDRESS
03970 GOSUB 4810: REM SETUP DA
04000 POKE CB+5,0: POKE CB+6,14: REM  # BYTES = 3584 ($E00)
04030 POKE CB+7,0: POKE CB+8,0: REM   RAM ADR = 0 TO USE DISC BFR
04060 REM  READ 3300 DATA (& TKS 0) INTO FLOPPY BUFFER
04090 IF DS>3 OR Y=0 THEN GOSUB 5800:POKE CB+7,F1:POKE CB+8,F2
04120 IF DS>3 OR Y=0 THEN POKE FB-2,0: REM  SET FLPY BFR NOT IN USE
04150 RW=0: ER=USR(RW):IF ER<>0 GOTO 5380
04180 REM  
04210 REM   WRITE "TO UNIT"
04240 DEV TU$: DV$=TU$
04270 REM  
04300 DA = (Y+SO)*3584
04330 GOSUB 4810
04360 IF DE<4 GOTO 4570: REM SKP 3300 LOGIC IF FLOPPY
04390 REM  FORCE USE OF GET/PUT NOT FLOPPY TK0 R/W FOR 3300
04420 POKE TRACK,1 
04450 F1 = PEEK(CB+7): F2=PEEK(CB+8): REM  SAVE BFR ADR
04480 POKE CB+7,24: POKE CB+8,224: REM  3300 BFR $E018
04510 RW=0:ER=USR(RW): IF ER<>0 GOTO 5380: REM SEEK
04540 POKE CB+7,F1: POKE CB+8,F2: REM  RESTORE BFR ADR
04570 RW=1:ER=USR(RW): IF ER<>0 GOTO 5380
04600 REM  FORCE WRITE TO PREVENT FLOPPY BFR LOSS BY DWRITE NEXT LOOP
04630 CLOSE
04660 IF Y=EN-1 THEN POKE 16647,32: REM  UNLOAD HEAD AFTER LAST TRACK
04690 REM  
04720 NEXT Y
04750 GOTO 5530
04780 REM  
04810 REM  SETUP DISK ADDR SUBR
04840 DH = INT(DA/16777216): BO = DA-DH*16777216
04870 DM = INT(BO/65536):   BO = BO-DM*65536
04900 DL = INT(BO/256):     BO = BO-DL*256
04930 DB = BO
04960 POKE CB+1,DB: POKE CB+2,DL: POKE CB+3,DM: POKE CB+4,DH
04990 RETURN
05020 REM  
05050 REM  COMMON EXIT PATH
05080 POKE 16647,32: POKE 16946,32: REM  PERMIT UNLOAD BY FGET,FPUT
05090 JV=8778: XV=9467: REM JV==USR VECTOR / XV==BASIC-DOS INTERFACE 2
05110 POKE JV,235: POKE JV+1,36: REM  UNLOAD HEAD
05140 POKE XV,160: POKE XV+1,46
05170 ER = USR(Y)
05200 REM   RESTORE ORIGINAL DEVICE SELECTION
05230 IF TMPU>127 THEN TMPU = TMPU-128+4: REM  FOR E,F,G,H
05260 DEV CHR$(65+TMPU)
05290 RUN"DBMSYS","PASS"
05320 REM  
05350 REM  PRINT ERROR MESSAGE
05380 RW$ = "READ": IF RW=1 THEN RW$ = "WRITE"
05410 PRINT
05420 PRINT:PRINT
05421 PRINT"          ***** KOPIERINGSFEJL *****"
05422 PRINT
05423 PRINT"          PR\V AT KOPIER IGEN MED EN"
05424 PRINT"          ANDEN BLANK DISKETTE"
05425 PRINT:PRINT:PRINT
05440 PRINT "*** STATION ";DV$;" "; RW$; " FEJL"; ER; "P] ADRESSE"; DA
05470 REM
05480 PRINT:PRINT
05485 REM
05486 FOR I=1 TO 10:PRINTCHR$(7);:FOR J=1 TO 100:NEXT J:NEXT I
05500 GOTO 50040
05530 REM  
05560 POKE 16647,32: POKE 16946,32: REM  *R2
05590 POKE JV,235: POKE JV+1,36: REM  UNLOAD HEAD
05620 POKE XV,160: POKE XV+1,46
05650 ER = USR(Y)
05710 IF QA$="I" THEN QA$="A":GOTO 400
05740 IF QA$="A" THEN JH=JH+1:GOTO 400
05770 REM  
05800 REM  CALC FLOPPY BFR ADRS SUBR
05830 FB = PEEK(16386)*2 + PEEK(16387) + PEEK(16388)*256
05860 F2 = INT(FB/256)
05890 F1 = FB - F2*256
05920 RETURN
50000 DE=PEEK(10226):DL=PEEK(11774)+PEEK(11775)*256:PRINT
50020 N=N+1:IFN<2GOTO50030
50025 PRINT"** SE EFTER OM DISKETTEN ER I DEN RIGTIGE STATION **" 
50030 PRINT:PRINT"** FEJL ";DE;" I LINIE ";DL;" **":PRINT
50040 INPUT"TAST RETURN FOR FORTS[TTELSE ";QS$:GOTO 5080