|
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: »PURGE80.K«
└─⟦670c0171b⟧ Bits:30005246 COMAL-80 version 1.3 (MIKADOS)
└─⟦this⟧ »PURGE80.K«
└─⟦6980b4520⟧ Bits:30003618 MIKADOS start diskette med DDE COMAL-80 version 1.5
└─⟦this⟧ »PURGE80.K«
0100 // PNM 05.09.1980, COMAL80 VERSION 27.04.1982 0110 // PURGE80 0120 DIM NAVN$ OF 18,DREVN$ OF 9,FILNAVN$ OF 9,FILTYPE$ OF 1 0130 DIM SIDSTECHAR$ OF 1 0140 INTEGER FLAG,FOREVER,INDEX,Y 0150 PRINT 0160 PRINT "PURGE80 - SLET EN FIL" 0170 PRINT "PROGRAMMET STOPPES VED AT TRYKKE PAA ESC" 0180 REPEAT 0190 PRINT 0200 REPEAT 0210 NAVN$:="";FILNAVN$:="";DREVN$:="";FLAG,FOREVER:=0;INDEX:=1 0220 PRINT "INDTAST "; 0230 INPUT "'ETIKETTE:FILNAVN' FOR DEN FIL, DER 0NSKES SLETTET: ":NAVN$ 0240 EXEC KONVERTOGMOVE(NAVN$,INDEX,DREVN$,SIDSTECHAR$,FLAG) 0250 IF SIDSTECHAR$<>":" OR INDEX>9 OR INDEX=1 THEN FLAG:=1 0260 INDEX:=INDEX+1 0270 EXEC KONVERTOGMOVE(NAVN$,INDEX,FILNAVN$,SIDSTECHAR$,FLAG) 0280 IF LEN(FILNAVN$)>8 OR LEN(FILNAVN$)<1 OR NAVN$(18)<>"" THEN FLAG:=1 0290 IF SIDSTECHAR$=":" THEN FLAG:=1 0300 UNTIL FLAG=0 0310 REPEAT 0320 PRINT "INDTAST FILTYPE "; 0330 INPUT "(K FOR PROGRAM-/DATAFILER, B FOR BINAERFILER): ":FILTYPE$ 0340 UNTIL FILTYPE$="K" OR FILTYPE$="B" 0350 EXEC PURGE 0360 UNTIL FOREVER 0370 PROC PURGE 0380 CALL "SYSPROG:PERGE" 0390 IF FLAG<>0 THEN 0400 PRINT "PURGE MISLYKKEDES. FEJLKODE ";FLAG 0410 STOP 0420 ELSE 0430 PRINT DREVN$;":";FILNAVN$;" ER NU SLETTET" 0440 ENDIF 0450 ENDPROC PURGE 0460 PROC KONVERTOGMOVE(NFRA$,REF I,REF NTIL$,REF CH$,REF F) 0470 Y:=1 0480 REPEAT 0490 CH$:=NFRA$(I) 0500 IF CH$=>"a" AND CH$<="å" THEN CH$:=CHR$(ORD(CH$)-32) 0510 IF CH$<>":" THEN 0520 IF (CH$=>"0" AND CH$<="9") OR (CH$=>"A" AND CH$<="Å") OR CH$="_" THEN 0530 NTIL$(Y):=CH$;Y:=Y+1;I:=I+1 0540 ELSE 0550 IF CH$<>"" THEN 0560 F:=1 0570 EXIT // ULOVLIGT TEGN 0580 ENDIF 0590 ENDIF 0600 ENDIF 0610 UNTIL Y=LEN(NFRA$)+1 OR CH$=":" OR CH$="" OR LEN(NTIL$)=>9 OR I=>18 0620 ENDPROC KONVERTOGMOVE
0x000…034 Line {l1=0x32, l2=»0100 // PNM 05.09.1980, COMAL80 VERSION 27.04.1982«, l3=0x32}
0x034…045 Line {l1=0x0f, l2=»0110 // PURGE80«, l3=0x0f}
0x045…083 Line {l1=0x3c, l2=»0120 DIM NAVN$ OF 18,DREVN$ OF 9,FILNAVN$ OF 9,FILTYPE$ OF 1«, l3=0x3c}
0x083…09e Line {l1=0x19, l2=»0130 DIM SIDSTECHAR$ OF 1«, l3=0x19}
0x09e…0c1 Line {l1=0x21, l2=»0140 INTEGER FLAG,FOREVER,INDEX,Y«, l3=0x21}
0x0c1…0ce Line {l1=0x0b, l2=»0150 PRINT «, l3=0x0b}
0x0ce…0f2 Line {l1=0x22, l2=»0160 PRINT "PURGE80 - SLET EN FIL"«, l3=0x22}
0x0f2…129 Line {l1=0x35, l2=»0170 PRINT "PROGRAMMET STOPPES VED AT TRYKKE PAA ESC"«, l3=0x35}
0x129…137 Line {l1=0x0c, l2=»0180 REPEAT «, l3=0x0c}
0x137…144 Line {l1=0x0b, l2=»0190 PRINT «, l3=0x0b}
0x144…152 Line {l1=0x0c, l2=»0200 REPEAT «, l3=0x0c}
0x152…193 Line {l1=0x3f, l2=»0210 NAVN$:="";FILNAVN$:="";DREVN$:="";FLAG,FOREVER:=0;INDEX:=1«, l3=0x3f}
0x193…1ab Line {l1=0x16, l2=»0220 PRINT "INDTAST ";«, l3=0x16}
0x1ab…1f4 Line {l1=0x47, l2=»0230 INPUT "'ETIKETTE:FILNAVN' FOR DEN FIL, DER 0NSKES SLETTET: ":NAVN$«, l3=0x47}
0x1f4…232 Line {l1=0x3c, l2=»0240 EXEC KONVERTOGMOVE(NAVN$,INDEX,DREVN$,SIDSTECHAR$,FLAG)«, l3=0x3c}
0x232…26f Line {l1=0x3b, l2=»0250 IF SIDSTECHAR$<>":" OR INDEX>9 OR INDEX=1 THEN FLAG:=1«, l3=0x3b}
0x26f…284 Line {l1=0x13, l2=»0260 INDEX:=INDEX+1«, l3=0x13}
0x284…2c4 Line {l1=0x3e, l2=»0270 EXEC KONVERTOGMOVE(NAVN$,INDEX,FILNAVN$,SIDSTECHAR$,FLAG)«, l3=0x3e}
0x2c4…30e Line {l1=0x48, l2=»0280 IF LEN(FILNAVN$)>8 OR LEN(FILNAVN$)<1 OR NAVN$(18)<>"" THEN FLAG:=1«, l3=0x48}
0x30e…334 Line {l1=0x24, l2=»0290 IF SIDSTECHAR$=":" THEN FLAG:=1«, l3=0x24}
0x334…347 Line {l1=0x11, l2=»0300 UNTIL FLAG=0«, l3=0x11}
0x347…355 Line {l1=0x0c, l2=»0310 REPEAT «, l3=0x0c}
0x355…375 Line {l1=0x1e, l2=»0320 PRINT "INDTAST FILTYPE ";«, l3=0x1e}
0x375…3bc Line {l1=0x45, l2=»0330 INPUT "(K FOR PROGRAM-/DATAFILER, B FOR BINAERFILER): ":FILTYPE$«, l3=0x45}
0x3bc…3e5 Line {l1=0x27, l2=»0340 UNTIL FILTYPE$="K" OR FILTYPE$="B"«, l3=0x27}
0x3e5…3f6 Line {l1=0x0f, l2=»0350 EXEC PURGE«, l3=0x0f}
0x3f6…40a Line {l1=0x12, l2=»0360 UNTIL FOREVER«, l3=0x12}
0x40a…41b Line {l1=0x0f, l2=»0370 PROC PURGE«, l3=0x0f}
0x41b…436 Line {l1=0x19, l2=»0380 CALL "SYSPROG:PERGE"«, l3=0x19}
0x436…44d Line {l1=0x15, l2=»0390 IF FLAG<>0 THEN «, l3=0x15}
0x44d…47d Line {l1=0x2e, l2=»0400 PRINT "PURGE MISLYKKEDES. FEJLKODE ";FLAG«, l3=0x2e}
0x47d…489 Line {l1=0x0a, l2=»0410 STOP «, l3=0x0a}
0x489…495 Line {l1=0x0a, l2=»0420 ELSE «, l3=0x0a}
0x495…4c6 Line {l1=0x2f, l2=»0430 PRINT DREVN$;":";FILNAVN$;" ER NU SLETTET"«, l3=0x2f}
0x4c6…4d3 Line {l1=0x0b, l2=»0440 ENDIF «, l3=0x0b}
0x4d3…4e7 Line {l1=0x12, l2=»0450 ENDPROC PURGE«, l3=0x12}
0x4e7…525 Line {l1=0x3c, l2=»0460 PROC KONVERTOGMOVE(NFRA$,REF I,REF NTIL$,REF CH$,REF F)«, l3=0x3c}
0x525…530 Line {l1=0x09, l2=»0470 Y:=1«, l3=0x09}
0x530…53e Line {l1=0x0c, l2=»0480 REPEAT «, l3=0x0c}
0x53e…552 Line {l1=0x12, l2=»0490 CH$:=NFRA$(I)«, l3=0x12}
0x552…58d Line {l1=0x39, l2=»0500 IF CH$=>"a" AND CH$<="å" THEN CH$:=CHR$(ORD(CH$)-32)«, l3=0x39}
0x58d…5a5 Line {l1=0x16, l2=»0510 IF CH$<>":" THEN «, l3=0x16}
0x5a5…5f2 Line {l1=0x4b, l2=»0520 IF (CH$=>"0" AND CH$<="9") OR (CH$=>"A" AND CH$<="Å") OR CH$="_" THEN «, l3=0x4b}
0x5f2…614 Line {l1=0x20, l2=»0530 NTIL$(Y):=CH$;Y:=Y+1;I:=I+1«, l3=0x20}
0x614…620 Line {l1=0x0a, l2=»0540 ELSE «, l3=0x0a}
0x620…637 Line {l1=0x15, l2=»0550 IF CH$<>"" THEN «, l3=0x15}
0x637…642 Line {l1=0x09, l2=»0560 F:=1«, l3=0x09}
0x642…65e Line {l1=0x1a, l2=»0570 EXIT // ULOVLIGT TEGN«, l3=0x1a}
0x65e…66b Line {l1=0x0b, l2=»0580 ENDIF «, l3=0x0b}
0x66b…678 Line {l1=0x0b, l2=»0590 ENDIF «, l3=0x0b}
0x678…685 Line {l1=0x0b, l2=»0600 ENDIF «, l3=0x0b}
0x685…6cf Line {l1=0x48, l2=»0610 UNTIL Y=LEN(NFRA$)+1 OR CH$=":" OR CH$="" OR LEN(NTIL$)=>9 OR I=>18«, l3=0x48}
0x6cf…6eb Line {l1=0x1a, l2=»0620 ENDPROC KONVERTOGMOVE«, l3=0x1a}
0x6eb…700 00 00 00 00 00 1a 01 2b 1b 01 23 41 66 01 20 00 00 00 00 00 00 ┆ + #Af ┆
0x700…720 54 45 3a 3d 43 44 22 10 20 20 20 20 20 20 20 49 4e 58 20 20 20 20 20 42 10 12 20 20 20 20 20 20 ┆TE:=CD" INX B ┆
0x720…740 20 4d 4f 56 20 20 20 20 20 41 2c 45 12 10 20 20 20 20 20 20 20 53 54 41 58 20 20 20 20 42 10 10 ┆ MOV A,E STAX B ┆
0x740…760 20 20 20 20 20 20 20 49 4e 58 20 20 20 20 20 42 10 12 20 20 20 20 20 20 20 4d 4f 56 20 20 20 20 ┆ INX B MOV ┆
0x760…780 20 41 2c 44 12 22 20 20 20 20 20 20 20 53 54 41 58 20 20 20 20 42 20 20 20 20 20 20 20 3b 53 49 ┆ A,D " STAX B ;SI┆
0x780…7a0 44 53 54 45 3a 3d 43 44 22 12 20 20 20 20 20 20 20 50 4f 50 20 20 20 20 20 50 53 57 12 0a 20 20 ┆DSTE:=CD" POP PSW ┆
0x7a0…7c0 20 20 20 20 20 52 45 54 0a 01 20 01 28 46 49 52 53 54 3a 20 4c 44 41 58 20 20 20 20 42 20 20 20 ┆ RET (FIRST: LDAX B ┆
0x7c0…7e0 20 20 20 20 3b 41 3a 3d 4b 5b 44 45 4e 53 20 4c 5b 4e 47 44 45 28 1e 20 20 20 20 20 20 20 41 4e ┆ ;A:=KÆDENS LÆNGDE( AN┆
0x7e0…800 41 20 20 20 20 20 41 20 20 20 20 20 20 20 3b 54 45 53 54 20 41 1e 29 20 20 20 20 20 20 20 4a 5a ┆A A ;TEST A ) JZ┆
0x800…820 20 20 20 20 20 20 46 45 4d 50 54 20 20 20 3b 4a 4d 50 20 48 56 49 53 20 54 4f 4d 20 4b 5b 44 45 ┆ FEMPT ;JMP HVIS TOM KÆDE┆
0x820…840 29 10 20 20 20 20 20 20 20 44 43 52 20 20 20 20 20 41 10 2a 20 20 20 20 20 20 20 53 54 41 58 20 ┆) DCR A * STAX ┆
0x840…860 20 20 20 42 20 20 20 20 20 20 20 3b 4c 5b 4e 47 44 45 3a 3d 4c 5b 4e 47 44 45 20 2d 20 31 2a 21 ┆ B ;LÆNGDE:=LÆNGDE - 1*!┆
0x860…880 20 20 20 20 20 20 20 49 4e 58 20 20 20 20 20 42 20 20 20 20 20 20 20 3b 42 43 2d 3e 46 49 52 53 ┆ INX B ;BC->FIRS┆
0x880…8a0 54 21 0d 20 20 20 20 20 20 20 4c 44 41 58 20 42 0d 21 20 20 20 20 20 20 20 4d 4f 56 20 20 20 20 ┆T! LDAX B ! MOV ┆
0x8a0…8c0 20 45 2c 41 20 20 20 20 20 3b 44 45 3a 3d 46 49 52 53 54 21 10 20 20 20 20 20 20 20 49 4e 58 20 ┆ E,A ;DE:=FIRST! INX ┆
0x8c0…8e0 20 20 20 20 42 10 10 20 20 20 20 20 20 20 4c 44 41 58 20 20 20 20 42 10 12 20 20 20 20 20 20 20 ┆ B LDAX B ┆
0x8e0…900 4d 4f 56 20 20 20 20 20 44 2c 41 12 27 20 20 20 20 20 20 20 44 43 58 20 20 20 20 20 42 20 20 20 ┆MOV D,A ' DCX B ┆
0x900…920 20 20 20 20 3b 42 43 2d 3e 46 49 52 53 54 28 49 47 45 4e 29 27 26 20 20 20 20 20 20 20 4c 44 41 ┆ ;BC->FIRST(IGEN)'& LDA┆
0x920…940 58 20 20 20 20 44 20 20 20 20 20 20 20 3b 46 49 52 53 54 3a 3d 43 44 2e 4c 49 4e 4b 26 10 20 20 ┆X D ;FIRST:=CD.LINK& ┆
0x940…960 20 20 20 20 20 53 54 41 58 20 20 20 20 42 10 10 20 20 20 20 20 20 20 49 4e 58 20 20 20 20 20 42 ┆ STAX B INX B┆
0x960…980 10 10 20 20 20 20 20 20 20 49 4e 58 20 20 20 20 20 44 10 10 20 20 20 20 20 20 20 4c 44 41 58 20 ┆ INX D LDAX ┆
0x980…9a0 20 20 20 44 10 2e 20 20 20 20 20 20 20 53 54 41 58 20 20 20 20 42 20 20 20 20 20 20 20 3b 46 5c ┆ D . STAX B ;FØ┆
0x9a0…9c0 52 53 54 45 28 32 29 3a 3d 43 44 2e 4c 49 4e 4b 28 32 31 29 2e 24 20 20 20 20 20 20 20 44 43 58 ┆RSTE(2):=CD.LINK(21).$ DCX┆
0x9c0…9e0 20 20 20 20 20 44 20 20 20 20 20 20 20 3b 44 45 3a 3d 20 43 44 20 49 47 45 4e 24 1c 20 20 20 63 ┆ D ;DE:= CD IGEN$ c┆
20100 // PNM 05.09.1980, COMAL80 VERSION 27.04.19822▶0f◀0110 // PURGE80▶0f◀<0120 DIM NAVN$ OF 18,DREVN$ OF 9,FILNAVN$ OF 9,FILTYPE$ OF 1<▶19◀0130 DIM SIDSTECHAR$ OF 1▶19◀!0140 INTEGER FLAG,FOREVER,INDEX,Y!▶0b◀0150 PRINT ▶0b◀"0160 PRINT "PURGE80 - SLET EN FIL""50170 PRINT "PROGRAMMET STOPPES VED AT TRYKKE PAA ESC"5\f
0180 REPEAT \f
▶0b◀0190 PRINT ▶0b◀\f
0200 REPEAT \f
?0210 NAVN$:="";FILNAVN$:="";DREVN$:="";FLAG,FOREVER:=0;INDEX:=1?▶16◀0220 PRINT "INDTAST ";▶16◀G0230 INPUT "'ETIKETTE:FILNAVN' FOR DEN FIL, DER 0NSKES SLETTET: ":NAVN$G<0240 EXEC KONVERTOGMOVE(NAVN$,INDEX,DREVN$,SIDSTECHAR$,FLAG)<;0250 IF SIDSTECHAR$<>":" OR INDEX>9 OR INDEX=1 THEN FLAG:=1;▶13◀0260 INDEX:=INDEX+1▶13◀>0270 EXEC KONVERTOGMOVE(NAVN$,INDEX,FILNAVN$,SIDSTECHAR$,FLAG)>H0280 IF LEN(FILNAVN$)>8 OR LEN(FILNAVN$)<1 OR NAVN$(18)<>"" THEN FLAG:=1H$0290 IF SIDSTECHAR$=":" THEN FLAG:=1$▶11◀0300 UNTIL FLAG=0▶11◀\f
0310 REPEAT \f
▶1e◀0320 PRINT "INDTAST FILTYPE ";▶1e◀E0330 INPUT "(K FOR PROGRAM-/DATAFILER, B FOR BINAERFILER): ":FILTYPE$E'0340 UNTIL FILTYPE$="K" OR FILTYPE$="B"'▶0f◀0350 EXEC PURGE▶0f◀▶12◀0360 UNTIL FOREVER▶12◀▶0f◀0370 PROC PURGE▶0f◀▶19◀0380 CALL "SYSPROG:PERGE"▶19◀▶15◀0390 IF FLAG<>0 THEN ▶15◀.0400 PRINT "PURGE MISLYKKEDES. FEJLKODE ";FLAG.
0410 STOP
0420 ELSE
/0430 PRINT DREVN$;":";FILNAVN$;" ER NU SLETTET"/▶0b◀0440 ENDIF ▶0b◀▶12◀0450 ENDPROC PURGE▶12◀<0460 PROC KONVERTOGMOVE(NFRA$,REF I,REF NTIL$,REF CH$,REF F)< 0470 Y:=1 \f
0480 REPEAT \f
▶12◀0490 CH$:=NFRA$(I)▶12◀90500 IF CH$=>"a" AND CH$<="å" THEN CH$:=CHR$(ORD(CH$)-32)9▶16◀0510 IF CH$<>":" THEN ▶16◀K0520 IF (CH$=>"0" AND CH$<="9") OR (CH$=>"A" AND CH$<="Å") OR CH$="_" THEN K 0530 NTIL$(Y):=CH$;Y:=Y+1;I:=I+1
0540 ELSE
▶15◀0550 IF CH$<>"" THEN ▶15◀ 0560 F:=1 ▶1a◀0570 EXIT // ULOVLIGT TEGN▶1a◀▶0b◀0580 ENDIF ▶0b◀▶0b◀0590 ENDIF ▶0b◀▶0b◀0600 ENDIF ▶0b◀H0610 UNTIL Y=LEN(NFRA$)+1 OR CH$=":" OR CH$="" OR LEN(NTIL$)=>9 OR I=>18H▶1a◀0620 ENDPROC KONVERTOGMOVE▶1a◀▶00◀▶00◀▶00◀▶00◀▶00◀▶1a◀▶01◀+▶1b◀▶01◀#Af▶01◀ ▶00◀▶00◀▶00◀▶00◀▶00◀▶00◀TE:=CD"▶10◀ INX B▶10◀▶12◀ MOV A,E▶12◀▶10◀ STAX B▶10◀▶10◀ INX B▶10◀▶12◀ MOV A,D▶12◀" STAX B ;SIDSTE:=CD"▶12◀ POP PSW▶12◀
RET
▶01◀ ▶01◀(FIRST: LDAX B ;A:=KÆDENS LÆNGDE(▶1e◀ ANA A ;TEST A▶1e◀) JZ FEMPT ;JMP HVIS TOM KÆDE)▶10◀ DCR A▶10◀* STAX B ;LÆNGDE:=LÆNGDE - 1*! INX B ;BC->FIRST!\r LDAX B\r! MOV E,A ;DE:=FIRST!▶10◀ INX B▶10◀▶10◀ LDAX B▶10◀▶12◀ MOV D,A▶12◀' DCX B ;BC->FIRST(IGEN)'& LDAX D ;FIRST:=CD.LINK&▶10◀ STAX B▶10◀▶10◀ INX B▶10◀▶10◀ INX D▶10◀▶10◀ LDAX D▶10◀. STAX B ;FØRSTE(2):=CD.LINK(21).$ DCX D ;DE:= CD IGEN$▶1c◀ c