|
|
DataMuseum.dkPresents historical artifacts from the history of: MIKADOS |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about MIKADOS Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 2528 (0x9e0)
Types: TextFile
Notes: Mikados_K
Names: »FCOPY80.K«
└─⟦670c0171b⟧ Bits:30005246 COMAL-80 version 1.3 (MIKADOS)
└─⟦this⟧ »FCOPY80.K«
0100 // 05.09.1980 PNM, COMAL80 VERSION 24.04.1982 0110 DIM DREVFRA$ OF 2,DREVTIL$ OF 2,TYPE$ OF 1,NAVNFRA$ OF 9 0120 DIM NAVN$ OF 18,SIDSTECHAR$ OF 1,NAVNTIL$ OF 9 0130 INTEGER INDEX,FLAG,FOREVER,Y 0140 PRINT "FCOPY80 - KOPIER FIL." 0150 PRINT 0160 REPEAT 0170 INPUT "DREVNR (P1, P2, .. ), DER KOPIERES FRA: ":DREVFRA$ 0180 UNTIL DREVFRA$>"P0" AND DREVFRA$<="P9" 0190 PRINT 0200 REPEAT 0210 INPUT "DREVNR (P1, P2, .. ), DER KOPIERES TIL: ":DREVTIL$ 0220 UNTIL DREVTIL$>"P0" AND DREVTIL$<="P9" 0230 REPEAT 0240 PRINT 0250 REPEAT 0260 NAVNFRA$:="";NAVN$:="";FLAG,FOREVER:=0 0270 INPUT "INDTAST FILNAVN: ":NAVN$ 0280 EXEC KONVERTOGMOVE(NAVN$,1,NAVNFRA$,SIDSTECHAR$,FLAG) 0290 IF LEN(NAVNFRA$)>8 OR LEN(NAVNFRA$)<1 OR NAVN$(9)<>"" THEN FLAG:=1 0300 IF SIDSTECHAR$=":" THEN FLAG:=1 0310 UNTIL FLAG=0 0320 TYPE$:="K" 0330 EDIT "B FOR BINÆR FIL: ":TYPE$ 0340 REPEAT 0350 NAVN$:="";NAVNTIL$:="";FLAG:=0 0360 INPUT "EVT NYT FILNAVN: ":NAVN$ 0370 IF LEN(NAVN$)=0 THEN 0380 NAVNTIL$:=NAVNFRA$ 0390 ELSE 0400 EXEC KONVERTOGMOVE(NAVN$,1,NAVNTIL$,SIDSTECHAR$,FLAG) 0410 IF LEN(NAVNTIL$)>8 OR LEN(NAVNTIL$)<1 OR NAVN$(9)<>"" THEN FLAG:=1 0420 ENDIF 0430 UNTIL FLAG=0 0440 EXEC COPY 0450 UNTIL FOREVER 0460 PROC COPY 0470 CALL "SYSPROG:CFCOPY" 0480 IF FLAG THEN 0490 PRINT "FCOPY MISLYKKEDES. FEJLKODE ";FLAG 0500 STOP 0510 ELSE 0520 PRINT NAVNFRA$;" ER KOPIERET FRA ";DREVFRA$;" TIL ";DREVTIL$; 0530 PRINT " UNDER NAVNET ";NAVNTIL$ 0540 ENDIF 0550 ENDPROC COPY 0560 PROC KONVERTOGMOVE(NFRA$,I,REF NTIL$,REF CH$,REF F) 0570 Y:=1 0580 REPEAT 0590 CH$:=NFRA$(I) 0600 IF CH$=>"a" AND CH$<="å" THEN CH$:=CHR$(ORD(CH$)-32) 0610 IF CH$<>":" THEN 0620 IF (CH$=>"0" AND CH$<="9") OR (CH$=>"A" AND CH$<="Å") OR CH$="_" THEN 0630 NTIL$(Y):=CH$;Y:=Y+1;I:=I+1 0640 ELSE 0650 IF CH$<>"" THEN 0660 F:=1 0670 EXIT // ULOVLIGT TEGN 0680 ENDIF 0690 ENDIF 0700 ENDIF 0710 UNTIL Y=LEN(NFRA$)+1 OR CH$=":" OR CH$="" OR LEN(NTIL$)=>9 OR I=>18 0720 ENDPROC KONVERTOGMOVE
0x000…034 Line {l1=0x32, l2=»0100 // 05.09.1980 PNM, COMAL80 VERSION 24.04.1982«, l3=0x32}
0x034…073 Line {l1=0x3d, l2=»0110 DIM DREVFRA$ OF 2,DREVTIL$ OF 2,TYPE$ OF 1,NAVNFRA$ OF 9«, l3=0x3d}
0x073…0a8 Line {l1=0x33, l2=»0120 DIM NAVN$ OF 18,SIDSTECHAR$ OF 1,NAVNTIL$ OF 9«, l3=0x33}
0x0a8…0cb Line {l1=0x21, l2=»0130 INTEGER INDEX,FLAG,FOREVER,Y«, l3=0x21}
0x0cb…0ef Line {l1=0x22, l2=»0140 PRINT "FCOPY80 - KOPIER FIL."«, l3=0x22}
0x0ef…0fc Line {l1=0x0b, l2=»0150 PRINT «, l3=0x0b}
0x0fc…10a Line {l1=0x0c, l2=»0160 REPEAT «, l3=0x0c}
0x10a…14a Line {l1=0x3e, l2=»0170 INPUT "DREVNR (P1, P2, .. ), DER KOPIERES FRA: ":DREVFRA$«, l3=0x3e}
0x14a…177 Line {l1=0x2b, l2=»0180 UNTIL DREVFRA$>"P0" AND DREVFRA$<="P9"«, l3=0x2b}
0x177…184 Line {l1=0x0b, l2=»0190 PRINT «, l3=0x0b}
0x184…192 Line {l1=0x0c, l2=»0200 REPEAT «, l3=0x0c}
0x192…1d2 Line {l1=0x3e, l2=»0210 INPUT "DREVNR (P1, P2, .. ), DER KOPIERES TIL: ":DREVTIL$«, l3=0x3e}
0x1d2…1ff Line {l1=0x2b, l2=»0220 UNTIL DREVTIL$>"P0" AND DREVTIL$<="P9"«, l3=0x2b}
0x1ff…20d Line {l1=0x0c, l2=»0230 REPEAT «, l3=0x0c}
0x20d…21a Line {l1=0x0b, l2=»0240 PRINT «, l3=0x0b}
0x21a…228 Line {l1=0x0c, l2=»0250 REPEAT «, l3=0x0c}
0x228…255 Line {l1=0x2b, l2=»0260 NAVNFRA$:="";NAVN$:="";FLAG,FOREVER:=0«, l3=0x2b}
0x255…27b Line {l1=0x24, l2=»0270 INPUT "INDTAST FILNAVN: ":NAVN$«, l3=0x24}
0x27b…2b7 Line {l1=0x3a, l2=»0280 EXEC KONVERTOGMOVE(NAVN$,1,NAVNFRA$,SIDSTECHAR$,FLAG)«, l3=0x3a}
0x2b7…300 Line {l1=0x47, l2=»0290 IF LEN(NAVNFRA$)>8 OR LEN(NAVNFRA$)<1 OR NAVN$(9)<>"" THEN FLAG:=1«, l3=0x47}
0x300…326 Line {l1=0x24, l2=»0300 IF SIDSTECHAR$=":" THEN FLAG:=1«, l3=0x24}
0x326…339 Line {l1=0x11, l2=»0310 UNTIL FLAG=0«, l3=0x11}
0x339…34a Line {l1=0x0f, l2=»0320 TYPE$:="K"«, l3=0x0f}
0x34a…36f Line {l1=0x23, l2=»0330 EDIT "B FOR BINÆR FIL: ":TYPE$«, l3=0x23}
0x36f…37d Line {l1=0x0c, l2=»0340 REPEAT «, l3=0x0c}
0x37d…3a2 Line {l1=0x23, l2=»0350 NAVN$:="";NAVNTIL$:="";FLAG:=0«, l3=0x23}
0x3a2…3c8 Line {l1=0x24, l2=»0360 INPUT "EVT NYT FILNAVN: ":NAVN$«, l3=0x24}
0x3c8…3e4 Line {l1=0x1a, l2=»0370 IF LEN(NAVN$)=0 THEN «, l3=0x1a}
0x3e4…3fd Line {l1=0x17, l2=»0380 NAVNTIL$:=NAVNFRA$«, l3=0x17}
0x3fd…409 Line {l1=0x0a, l2=»0390 ELSE «, l3=0x0a}
0x409…445 Line {l1=0x3a, l2=»0400 EXEC KONVERTOGMOVE(NAVN$,1,NAVNTIL$,SIDSTECHAR$,FLAG)«, l3=0x3a}
0x445…48e Line {l1=0x47, l2=»0410 IF LEN(NAVNTIL$)>8 OR LEN(NAVNTIL$)<1 OR NAVN$(9)<>"" THEN FLAG:=1«, l3=0x47}
0x48e…49b Line {l1=0x0b, l2=»0420 ENDIF «, l3=0x0b}
0x49b…4ae Line {l1=0x11, l2=»0430 UNTIL FLAG=0«, l3=0x11}
0x4ae…4be Line {l1=0x0e, l2=»0440 EXEC COPY«, l3=0x0e}
0x4be…4d2 Line {l1=0x12, l2=»0450 UNTIL FOREVER«, l3=0x12}
0x4d2…4e2 Line {l1=0x0e, l2=»0460 PROC COPY«, l3=0x0e}
0x4e2…4fe Line {l1=0x1a, l2=»0470 CALL "SYSPROG:CFCOPY"«, l3=0x1a}
0x4fe…512 Line {l1=0x12, l2=»0480 IF FLAG THEN «, l3=0x12}
0x512…542 Line {l1=0x2e, l2=»0490 PRINT "FCOPY MISLYKKEDES. FEJLKODE ";FLAG«, l3=0x2e}
0x542…54e Line {l1=0x0a, l2=»0500 STOP «, l3=0x0a}
0x54e…55a Line {l1=0x0a, l2=»0510 ELSE «, l3=0x0a}
0x55a…59e Line {l1=0x42, l2=»0520 PRINT NAVNFRA$;" ER KOPIERET FRA ";DREVFRA$;" TIL ";DREVTIL$;«, l3=0x42}
0x59e…5c4 Line {l1=0x24, l2=»0530 PRINT " UNDER NAVNET ";NAVNTIL$«, l3=0x24}
0x5c4…5d1 Line {l1=0x0b, l2=»0540 ENDIF «, l3=0x0b}
0x5d1…5e4 Line {l1=0x11, l2=»0550 ENDPROC COPY«, l3=0x11}
0x5e4…61e Line {l1=0x38, l2=»0560 PROC KONVERTOGMOVE(NFRA$,I,REF NTIL$,REF CH$,REF F)«, l3=0x38}
0x61e…629 Line {l1=0x09, l2=»0570 Y:=1«, l3=0x09}
0x629…637 Line {l1=0x0c, l2=»0580 REPEAT «, l3=0x0c}
0x637…64b Line {l1=0x12, l2=»0590 CH$:=NFRA$(I)«, l3=0x12}
0x64b…686 Line {l1=0x39, l2=»0600 IF CH$=>"a" AND CH$<="å" THEN CH$:=CHR$(ORD(CH$)-32)«, l3=0x39}
0x686…69e Line {l1=0x16, l2=»0610 IF CH$<>":" THEN «, l3=0x16}
0x69e…6eb Line {l1=0x4b, l2=»0620 IF (CH$=>"0" AND CH$<="9") OR (CH$=>"A" AND CH$<="Å") OR CH$="_" THEN «, l3=0x4b}
0x6eb…70d Line {l1=0x20, l2=»0630 NTIL$(Y):=CH$;Y:=Y+1;I:=I+1«, l3=0x20}
0x70d…719 Line {l1=0x0a, l2=»0640 ELSE «, l3=0x0a}
0x719…730 Line {l1=0x15, l2=»0650 IF CH$<>"" THEN «, l3=0x15}
0x730…73b Line {l1=0x09, l2=»0660 F:=1«, l3=0x09}
0x73b…757 Line {l1=0x1a, l2=»0670 EXIT // ULOVLIGT TEGN«, l3=0x1a}
0x757…764 Line {l1=0x0b, l2=»0680 ENDIF «, l3=0x0b}
0x764…771 Line {l1=0x0b, l2=»0690 ENDIF «, l3=0x0b}
0x771…77e Line {l1=0x0b, l2=»0700 ENDIF «, l3=0x0b}
0x77e…7c8 Line {l1=0x48, l2=»0710 UNTIL Y=LEN(NFRA$)+1 OR CH$=":" OR CH$="" OR LEN(NTIL$)=>9 OR I=>18«, l3=0x48}
0x7c8…7e4 Line {l1=0x1a, l2=»0720 ENDPROC KONVERTOGMOVE«, l3=0x1a}
0x7e4…800 00 00 20 20 20 20 20 4b 54 4c 4b 31 20 20 20 3b 48 4f 50 20 48 56 49 53 20 4a 41 23 ┆ KTLK1 ;HOP HVIS JA#┆
0x800…820 20 20 20 20 20 20 20 20 4c 58 49 20 20 20 20 20 48 2c 4b 54 52 55 20 20 3b 48 56 41 44 20 4d 45 ┆ LXI H,KTRU ;HVAD ME┆
0x820…840 44 20 1e 20 20 20 20 20 20 20 43 41 4c 4c 20 20 20 20 48 4c 44 45 43 20 20 20 3b 22 52 55 4e 22 ┆D CALL HLDEC ;"RUN"┆
0x840…860 3f 1e 23 20 20 20 20 20 20 20 4a 5a 20 20 20 20 20 20 4b 54 4c 4b 31 20 20 20 3b 48 4f 50 20 48 ┆? # JZ KTLK1 ;HOP H┆
0x860…880 56 49 53 20 4a 41 23 1d 20 20 20 20 20 20 20 4c 58 49 20 20 20 20 20 48 2c 4b 54 43 4c 20 20 3b ┆VIS JA# LXI H,KTCL ;┆
0x880…8a0 22 4e 45 57 22 1d 19 20 20 20 20 20 20 20 43 41 4c 4c 20 20 20 20 48 4c 44 45 43 20 20 20 3b 3f ┆"NEW" CALL HLDEC ;?┆
0x8a0…8c0 19 30 20 20 20 20 20 20 20 50 4f 50 20 20 20 20 20 48 20 20 20 20 20 20 20 3b 20 48 45 4e 54 20 ┆ 0 POP H ; HENT ┆
0x8c0…8e0 46 5c 52 53 54 45 20 49 4b 4b 45 2d 42 4c 41 4e 4b 45 30 26 20 20 20 20 20 20 20 50 55 53 48 20 ┆FØRSTE IKKE-BLANKE0& PUSH ┆
0x8e0…900 20 20 20 48 20 20 20 20 20 20 20 3b 20 52 45 54 41 42 4c 45 52 20 53 54 41 4b 26 3b 20 20 20 20 ┆ H ; RETABLER STAK&; ┆
0x900…920 20 20 20 4a 4e 5a 20 20 20 20 20 46 45 33 37 20 20 20 20 3b 4b 55 4e 20 43 41 54 2c 20 4c 4f 41 ┆ JNZ FE37 ;KUN CAT, LOA┆
0x920…940 44 2c 20 4e 45 57 2c 20 52 55 4e 20 54 49 4c 4c 41 44 54 20 48 45 52 3b 06 4b 54 4c 4b 31 3a 06 ┆D, NEW, RUN TILLADT HER; KTLK1: ┆
0x940…960 1e 20 20 20 20 20 20 20 50 4f 50 20 20 20 20 20 44 20 20 20 20 20 20 20 3b 41 46 53 54 41 4b 1e ┆ POP D ;AFSTAK ┆
0x960…980 20 20 20 20 20 20 20 20 50 4f 50 20 20 20 20 20 48 20 20 20 20 20 20 20 3b 52 45 47 49 53 54 52 ┆ POP H ;REGISTR┆
0x980…9a0 45 20 35 20 20 20 20 20 20 20 52 45 54 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 45 4b 53 45 4b ┆E 5 RET ;EKSEK┆
0x9a0…9c0 56 45 52 20 4c 4f 41 44 2c 20 43 41 54 2c 20 45 4c 4c 45 52 20 52 55 4e 35 01 3b 01 18 20 20 20 ┆VER LOAD, CAT, ELLER RUN5 ; ┆
0x9c0…9e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 18 2e 4b 54 41 50 3a 20 20 20 63 ┆ ; .KTAP: c┆
20100 // 05.09.1980 PNM, COMAL80 VERSION 24.04.19822=0110 DIM DREVFRA$ OF 2,DREVTIL$ OF 2,TYPE$ OF 1,NAVNFRA$ OF 9=30120 DIM NAVN$ OF 18,SIDSTECHAR$ OF 1,NAVNTIL$ OF 93!0130 INTEGER INDEX,FLAG,FOREVER,Y!"0140 PRINT "FCOPY80 - KOPIER FIL.""▶0b◀0150 PRINT ▶0b◀\f 0160 REPEAT \f >0170 INPUT "DREVNR (P1, P2, .. ), DER KOPIERES FRA: ":DREVFRA$>+0180 UNTIL DREVFRA$>"P0" AND DREVFRA$<="P9"+▶0b◀0190 PRINT ▶0b◀\f 0200 REPEAT \f >0210 INPUT "DREVNR (P1, P2, .. ), DER KOPIERES TIL: ":DREVTIL$>+0220 UNTIL DREVTIL$>"P0" AND DREVTIL$<="P9"+\f 0230 REPEAT \f ▶0b◀0240 PRINT ▶0b◀\f 0250 REPEAT \f +0260 NAVNFRA$:="";NAVN$:="";FLAG,FOREVER:=0+$0270 INPUT "INDTAST FILNAVN: ":NAVN$$:0280 EXEC KONVERTOGMOVE(NAVN$,1,NAVNFRA$,SIDSTECHAR$,FLAG):G0290 IF LEN(NAVNFRA$)>8 OR LEN(NAVNFRA$)<1 OR NAVN$(9)<>"" THEN FLAG:=1G$0300 IF SIDSTECHAR$=":" THEN FLAG:=1$▶11◀0310 UNTIL FLAG=0▶11◀▶0f◀0320 TYPE$:="K"▶0f◀#0330 EDIT "B FOR BINÆR FIL: ":TYPE$#\f 0340 REPEAT \f #0350 NAVN$:="";NAVNTIL$:="";FLAG:=0#$0360 INPUT "EVT NYT FILNAVN: ":NAVN$$▶1a◀0370 IF LEN(NAVN$)=0 THEN ▶1a◀▶17◀0380 NAVNTIL$:=NAVNFRA$▶17◀ 0390 ELSE :0400 EXEC KONVERTOGMOVE(NAVN$,1,NAVNTIL$,SIDSTECHAR$,FLAG):G0410 IF LEN(NAVNTIL$)>8 OR LEN(NAVNTIL$)<1 OR NAVN$(9)<>"" THEN FLAG:=1G▶0b◀0420 ENDIF ▶0b◀▶11◀0430 UNTIL FLAG=0▶11◀▶0e◀0440 EXEC COPY▶0e◀▶12◀0450 UNTIL FOREVER▶12◀▶0e◀0460 PROC COPY▶0e◀▶1a◀0470 CALL "SYSPROG:CFCOPY"▶1a◀▶12◀0480 IF FLAG THEN ▶12◀.0490 PRINT "FCOPY MISLYKKEDES. FEJLKODE ";FLAG. 0500 STOP 0510 ELSE B0520 PRINT NAVNFRA$;" ER KOPIERET FRA ";DREVFRA$;" TIL ";DREVTIL$;B$0530 PRINT " UNDER NAVNET ";NAVNTIL$$▶0b◀0540 ENDIF ▶0b◀▶11◀0550 ENDPROC COPY▶11◀80560 PROC KONVERTOGMOVE(NFRA$,I,REF NTIL$,REF CH$,REF F)8 0570 Y:=1 \f 0580 REPEAT \f ▶12◀0590 CH$:=NFRA$(I)▶12◀90600 IF CH$=>"a" AND CH$<="å" THEN CH$:=CHR$(ORD(CH$)-32)9▶16◀0610 IF CH$<>":" THEN ▶16◀K0620 IF (CH$=>"0" AND CH$<="9") OR (CH$=>"A" AND CH$<="Å") OR CH$="_" THEN K 0630 NTIL$(Y):=CH$;Y:=Y+1;I:=I+1 0640 ELSE ▶15◀0650 IF CH$<>"" THEN ▶15◀ 0660 F:=1 ▶1a◀0670 EXIT // ULOVLIGT TEGN▶1a◀▶0b◀0680 ENDIF ▶0b◀▶0b◀0690 ENDIF ▶0b◀▶0b◀0700 ENDIF ▶0b◀H0710 UNTIL Y=LEN(NFRA$)+1 OR CH$=":" OR CH$="" OR LEN(NTIL$)=>9 OR I=>18H▶1a◀0720 ENDPROC KONVERTOGMOVE▶1a◀▶00◀▶00◀ KTLK1 ;HOP HVIS JA# LXI H,KTRU ;HVAD MED ▶1e◀ CALL HLDEC ;"RUN"?▶1e◀# JZ KTLK1 ;HOP HVIS JA#▶1d◀ LXI H,KTCL ;"NEW"▶1d◀▶19◀ CALL HLDEC ;?▶19◀0 POP H ; HENT FØRSTE IKKE-BLANKE0& PUSH H ; RETABLER STAK&; JNZ FE37 ;KUN CAT, LOAD, NEW, RUN TILLADT HER;▶06◀KTLK1:▶06◀▶1e◀ POP D ;AFSTAK▶1e◀ POP H ;REGISTRE 5 RET ;EKSEKVER LOAD, CAT, ELLER RUN5▶01◀;▶01◀▶18◀ ;▶18◀.KTAP: c