|
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: »RENAME80.K«
└─⟦670c0171b⟧ Bits:30005246 COMAL-80 version 1.3 (MIKADOS)
└─⟦this⟧ »RENAME80.K«
└─⟦6980b4520⟧ Bits:30003618 MIKADOS start diskette med DDE COMAL-80 version 1.5
└─⟦this⟧ »RENAME80.K«
0100 // PNM 05.09.1980, COMAL80 VERSION 24.04.1982 0110 // PURGE80 0120 DIM NAVN$ OF 18,DREVN$ OF 9,FILNAVN$ OF 9,FILTYPE$ OF 1 0130 DIM FILNA$ OF 9,SIDSTECHAR$ OF 1 0140 INTEGER FLAG,FOREVER,Y,INDEX 0150 PRINT 0160 PRINT "RENAME80 - AENDRING AF FILNAVN" 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 INPUT "INDTAST DET NUVAERENDE FILNAVN (MED ETIKETTE): ":NAVN$ 0230 EXEC KONVERTOGMOVE(NAVN$,INDEX,DREVN$,SIDSTECHAR$,FLAG) 0240 IF SIDSTECHAR$<>":" OR INDEX>9 OR INDEX=1 THEN FLAG:=1 0250 INDEX:=INDEX+1 0260 EXEC KONVERTOGMOVE(NAVN$,INDEX,FILNAVN$,SIDSTECHAR$,FLAG) 0270 IF LEN(FILNAVN$)>8 OR LEN(FILNAVN$)<1 OR NAVN$(18)<>"" THEN FLAG:=1 0280 IF SIDSTECHAR$=":" THEN FLAG:=1 0290 UNTIL FLAG=0 0300 REPEAT 0310 PRINT "INDTAST FILTYPE "; 0320 INPUT "(K FOR PROGRAM-/DATAFILER, B FOR BINAERFILER): ":FILTYPE$ 0330 UNTIL FILTYPE$="K" OR FILTYPE$="B" 0340 REPEAT 0350 FLAG:=0;NAVN$:="";FILNA$:="" 0360 INPUT "INDTAST DET NYE FILNAVN (UDEN ETIKETTE): ":NAVN$ 0370 INDEX:=1 0380 EXEC KONVERTOGMOVE(NAVN$,INDEX,FILNA$,SIDSTECHAR$,FLAG) 0390 IF LEN(FILNA$)>8 OR LEN(FILNA$)<1 THEN FLAG:=1 0400 UNTIL FLAG=0 0410 EXEC RENAME 0420 UNTIL FOREVER 0430 PROC RENAME 0440 CALL "SYSPROG:OMDØB" 0450 IF FLAG<>0 THEN 0460 PRINT "RENAME MISLYKKEDES. FEJLKODE ";FLAG 0470 STOP 0480 ELSE 0490 PRINT DREVN$;":";FILNAVN$;" ER OMDØBT TIL ";DREVN$;":";FILNA$ 0500 ENDIF 0510 ENDPROC RENAME 0520 PROC KONVERTOGMOVE(NFRA$,REF I,REF NTIL$,REF CH$,REF F) 0530 Y:=1 0540 REPEAT 0550 CH$:=NFRA$(I) 0560 IF CH$=>"a" AND CH$<="å" THEN CH$:=CHR$(ORD(CH$)-32) 0570 IF CH$<>":" THEN 0580 IF (CH$=>"0" AND CH$<="9") OR (CH$=>"A" AND CH$<="Å") OR CH$="_" THEN 0590 NTIL$(Y):=CH$;Y:=Y+1;I:=I+1 0600 ELSE 0610 IF CH$<>"" THEN 0620 F:=1 0630 // EXIT ;ULOVLIGT TEGN 0640 ENDIF 0650 ENDIF 0660 ENDIF 0670 UNTIL Y=LEN(NFRA$)+1 OR CH$=":" OR CH$="" OR LEN(NTIL$)=>9 OR I=>18 0680 ENDPROC KONVERTOGMOVE
0x000…034 Line {l1=0x32, l2=»0100 // PNM 05.09.1980, COMAL80 VERSION 24.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…0aa Line {l1=0x25, l2=»0130 DIM FILNA$ OF 9,SIDSTECHAR$ OF 1«, l3=0x25}
0x0aa…0cd Line {l1=0x21, l2=»0140 INTEGER FLAG,FOREVER,Y,INDEX«, l3=0x21}
0x0cd…0da Line {l1=0x0b, l2=»0150 PRINT «, l3=0x0b}
0x0da…107 Line {l1=0x2b, l2=»0160 PRINT "RENAME80 - AENDRING AF FILNAVN"«, l3=0x2b}
0x107…13e Line {l1=0x35, l2=»0170 PRINT "PROGRAMMET STOPPES VED AT TRYKKE PAA ESC"«, l3=0x35}
0x13e…14c Line {l1=0x0c, l2=»0180 REPEAT «, l3=0x0c}
0x14c…159 Line {l1=0x0b, l2=»0190 PRINT «, l3=0x0b}
0x159…167 Line {l1=0x0c, l2=»0200 REPEAT «, l3=0x0c}
0x167…1a8 Line {l1=0x3f, l2=»0210 NAVN$:="";FILNAVN$:="";DREVN$:="";FLAG,FOREVER:=0;INDEX:=1«, l3=0x3f}
0x1a8…1ec Line {l1=0x42, l2=»0220 INPUT "INDTAST DET NUVAERENDE FILNAVN (MED ETIKETTE): ":NAVN$«, l3=0x42}
0x1ec…22a Line {l1=0x3c, l2=»0230 EXEC KONVERTOGMOVE(NAVN$,INDEX,DREVN$,SIDSTECHAR$,FLAG)«, l3=0x3c}
0x22a…267 Line {l1=0x3b, l2=»0240 IF SIDSTECHAR$<>":" OR INDEX>9 OR INDEX=1 THEN FLAG:=1«, l3=0x3b}
0x267…27c Line {l1=0x13, l2=»0250 INDEX:=INDEX+1«, l3=0x13}
0x27c…2bc Line {l1=0x3e, l2=»0260 EXEC KONVERTOGMOVE(NAVN$,INDEX,FILNAVN$,SIDSTECHAR$,FLAG)«, l3=0x3e}
0x2bc…306 Line {l1=0x48, l2=»0270 IF LEN(FILNAVN$)>8 OR LEN(FILNAVN$)<1 OR NAVN$(18)<>"" THEN FLAG:=1«, l3=0x48}
0x306…32c Line {l1=0x24, l2=»0280 IF SIDSTECHAR$=":" THEN FLAG:=1«, l3=0x24}
0x32c…33f Line {l1=0x11, l2=»0290 UNTIL FLAG=0«, l3=0x11}
0x33f…34d Line {l1=0x0c, l2=»0300 REPEAT «, l3=0x0c}
0x34d…36d Line {l1=0x1e, l2=»0310 PRINT "INDTAST FILTYPE ";«, l3=0x1e}
0x36d…3b4 Line {l1=0x45, l2=»0320 INPUT "(K FOR PROGRAM-/DATAFILER, B FOR BINAERFILER): ":FILTYPE$«, l3=0x45}
0x3b4…3dd Line {l1=0x27, l2=»0330 UNTIL FILTYPE$="K" OR FILTYPE$="B"«, l3=0x27}
0x3dd…3eb Line {l1=0x0c, l2=»0340 REPEAT «, l3=0x0c}
0x3eb…40e Line {l1=0x21, l2=»0350 FLAG:=0;NAVN$:="";FILNA$:=""«, l3=0x21}
0x40e…44c Line {l1=0x3c, l2=»0360 INPUT "INDTAST DET NYE FILNAVN (UDEN ETIKETTE): ":NAVN$«, l3=0x3c}
0x44c…45b Line {l1=0x0d, l2=»0370 INDEX:=1«, l3=0x0d}
0x45b…499 Line {l1=0x3c, l2=»0380 EXEC KONVERTOGMOVE(NAVN$,INDEX,FILNA$,SIDSTECHAR$,FLAG)«, l3=0x3c}
0x499…4ce Line {l1=0x33, l2=»0390 IF LEN(FILNA$)>8 OR LEN(FILNA$)<1 THEN FLAG:=1«, l3=0x33}
0x4ce…4e1 Line {l1=0x11, l2=»0400 UNTIL FLAG=0«, l3=0x11}
0x4e1…4f3 Line {l1=0x10, l2=»0410 EXEC RENAME«, l3=0x10}
0x4f3…507 Line {l1=0x12, l2=»0420 UNTIL FOREVER«, l3=0x12}
0x507…519 Line {l1=0x10, l2=»0430 PROC RENAME«, l3=0x10}
0x519…534 Line {l1=0x19, l2=»0440 CALL "SYSPROG:OMDØB"«, l3=0x19}
0x534…54b Line {l1=0x15, l2=»0450 IF FLAG<>0 THEN «, l3=0x15}
0x54b…57c Line {l1=0x2f, l2=»0460 PRINT "RENAME MISLYKKEDES. FEJLKODE ";FLAG«, l3=0x2f}
0x57c…588 Line {l1=0x0a, l2=»0470 STOP «, l3=0x0a}
0x588…594 Line {l1=0x0a, l2=»0480 ELSE «, l3=0x0a}
0x594…5d8 Line {l1=0x42, l2=»0490 PRINT DREVN$;":";FILNAVN$;" ER OMDØBT TIL ";DREVN$;":";FILNA$«, l3=0x42}
0x5d8…5e5 Line {l1=0x0b, l2=»0500 ENDIF «, l3=0x0b}
0x5e5…5fa Line {l1=0x13, l2=»0510 ENDPROC RENAME«, l3=0x13}
0x5fa…638 Line {l1=0x3c, l2=»0520 PROC KONVERTOGMOVE(NFRA$,REF I,REF NTIL$,REF CH$,REF F)«, l3=0x3c}
0x638…643 Line {l1=0x09, l2=»0530 Y:=1«, l3=0x09}
0x643…651 Line {l1=0x0c, l2=»0540 REPEAT «, l3=0x0c}
0x651…665 Line {l1=0x12, l2=»0550 CH$:=NFRA$(I)«, l3=0x12}
0x665…6a0 Line {l1=0x39, l2=»0560 IF CH$=>"a" AND CH$<="å" THEN CH$:=CHR$(ORD(CH$)-32)«, l3=0x39}
0x6a0…6b8 Line {l1=0x16, l2=»0570 IF CH$<>":" THEN «, l3=0x16}
0x6b8…705 Line {l1=0x4b, l2=»0580 IF (CH$=>"0" AND CH$<="9") OR (CH$=>"A" AND CH$<="Å") OR CH$="_" THEN «, l3=0x4b}
0x705…727 Line {l1=0x20, l2=»0590 NTIL$(Y):=CH$;Y:=Y+1;I:=I+1«, l3=0x20}
0x727…733 Line {l1=0x0a, l2=»0600 ELSE «, l3=0x0a}
0x733…74a Line {l1=0x15, l2=»0610 IF CH$<>"" THEN «, l3=0x15}
0x74a…755 Line {l1=0x09, l2=»0620 F:=1«, l3=0x09}
0x755…772 Line {l1=0x1b, l2=»0630 // EXIT ;ULOVLIGT TEGN«, l3=0x1b}
0x772…77f Line {l1=0x0b, l2=»0640 ENDIF «, l3=0x0b}
0x77f…78c Line {l1=0x0b, l2=»0650 ENDIF «, l3=0x0b}
0x78c…799 Line {l1=0x0b, l2=»0660 ENDIF «, l3=0x0b}
0x799…7e3 Line {l1=0x48, l2=»0670 UNTIL Y=LEN(NFRA$)+1 OR CH$=":" OR CH$="" OR LEN(NTIL$)=>9 OR I=>18«, l3=0x48}
0x7e3…7ff Line {l1=0x1a, l2=»0680 ENDPROC KONVERTOGMOVE«, l3=0x1a}
0x7ff…800 00 ┆ ┆
0x800…820 00 20 20 20 20 20 20 20 20 20 20 20 42 45 20 49 4e 56 4f 4b 45 44 2e 17 43 3b 2a 2a 2a 2a 2a 2a ┆ BE INVOKED. C;******┆
0x820…840 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a ┆********************************┆
0x840…860 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 43 01 3b 01 ┆****************************C ; ┆
0x860…880 01 3b 01 0b 20 20 20 20 20 20 20 43 4f 4e 44 0b 41 20 20 20 20 20 20 20 43 4f 4e 53 4d 3a 50 33 ┆ ; COND A CONSM:P3┆
0x880…8a0 20 20 20 20 20 20 20 20 3b 44 45 46 49 4e 49 54 49 4f 4e 20 4f 46 20 52 45 4c 41 54 49 56 45 20 ┆ ;DEFINITION OF RELATIVE ┆
0x8a0…8c0 41 44 44 52 2e 20 49 4e 20 57 4f 52 4b 20 41 52 45 41 41 01 3b 01 01 3b 01 0b 20 20 20 20 20 20 ┆ADDR. IN WORK AREAA ; ; ┆
0x8c0…8e0 20 52 4f 4f 54 0b 07 43 4f 4e 53 42 3a 3a 07 01 3b 01 01 3b 01 07 4e 49 56 35 30 3a 3a 07 07 4e ┆ ROOT CONSB:: ; ; NIV50:: N┆
0x8e0…900 49 56 36 35 3a 3a 07 36 20 20 20 20 20 20 20 50 55 53 48 20 20 20 20 50 53 57 20 20 20 20 20 3b ┆IV65:: 6 PUSH PSW ;┆
0x900…920 53 41 56 45 20 52 45 47 49 53 54 45 52 53 20 41 46 54 45 52 20 49 4e 54 45 52 52 55 50 54 36 10 ┆SAVE REGISTERS AFTER INTERRUPT6 ┆
0x920…940 20 20 20 20 20 20 20 50 55 53 48 20 20 20 20 42 10 10 20 20 20 20 20 20 20 50 55 53 48 20 20 20 ┆ PUSH B PUSH ┆
0x940…960 20 44 10 10 20 20 20 20 20 20 20 50 55 53 48 20 20 20 20 48 10 01 3b 01 2d 20 20 20 20 20 20 20 ┆ D PUSH H ; - ┆
0x960…980 4d 56 49 20 20 20 20 20 44 2c 33 20 20 20 20 20 3b 49 4e 54 45 52 52 55 50 54 20 53 54 41 54 55 ┆MVI D,3 ;INTERRUPT STATU┆
0x980…9a0 53 20 4d 41 53 4b 2d 01 3b 01 3d 20 20 20 20 20 20 20 4c 58 49 20 20 20 20 20 48 2c 43 4e 31 42 ┆S MASK- ; = LXI H,CN1B┆
0x9a0…9c0 46 20 3b 44 45 54 45 52 4d 49 4e 45 20 49 4e 54 45 52 52 55 50 54 49 4e 47 20 49 4e 54 45 52 46 ┆F ;DETERMINE INTERRUPTING INTERF┆
0x9c0…9e0 41 43 45 20 50 4f 52 54 3d 16 20 20 20 20 20 20 20 4d 56 49 20 20 20 20 20 45 2c 43 31 44 41 63 ┆ACE PORT= MVI E,C1DAc┆
20100 // PNM 05.09.1980, COMAL80 VERSION 24.04.19822▶0f◀0110 // PURGE80▶0f◀<0120 DIM NAVN$ OF 18,DREVN$ OF 9,FILNAVN$ OF 9,FILTYPE$ OF 1<%0130 DIM FILNA$ OF 9,SIDSTECHAR$ OF 1%!0140 INTEGER FLAG,FOREVER,Y,INDEX!▶0b◀0150 PRINT ▶0b◀+0160 PRINT "RENAME80 - AENDRING AF FILNAVN"+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?B0220 INPUT "INDTAST DET NUVAERENDE FILNAVN (MED ETIKETTE): ":NAVN$B<0230 EXEC KONVERTOGMOVE(NAVN$,INDEX,DREVN$,SIDSTECHAR$,FLAG)<;0240 IF SIDSTECHAR$<>":" OR INDEX>9 OR INDEX=1 THEN FLAG:=1;▶13◀0250 INDEX:=INDEX+1▶13◀>0260 EXEC KONVERTOGMOVE(NAVN$,INDEX,FILNAVN$,SIDSTECHAR$,FLAG)>H0270 IF LEN(FILNAVN$)>8 OR LEN(FILNAVN$)<1 OR NAVN$(18)<>"" THEN FLAG:=1H$0280 IF SIDSTECHAR$=":" THEN FLAG:=1$▶11◀0290 UNTIL FLAG=0▶11◀\f 0300 REPEAT \f ▶1e◀0310 PRINT "INDTAST FILTYPE ";▶1e◀E0320 INPUT "(K FOR PROGRAM-/DATAFILER, B FOR BINAERFILER): ":FILTYPE$E'0330 UNTIL FILTYPE$="K" OR FILTYPE$="B"'\f 0340 REPEAT \f !0350 FLAG:=0;NAVN$:="";FILNA$:=""!<0360 INPUT "INDTAST DET NYE FILNAVN (UDEN ETIKETTE): ":NAVN$<\r0370 INDEX:=1\r<0380 EXEC KONVERTOGMOVE(NAVN$,INDEX,FILNA$,SIDSTECHAR$,FLAG)<30390 IF LEN(FILNA$)>8 OR LEN(FILNA$)<1 THEN FLAG:=13▶11◀0400 UNTIL FLAG=0▶11◀▶10◀0410 EXEC RENAME▶10◀▶12◀0420 UNTIL FOREVER▶12◀▶10◀0430 PROC RENAME▶10◀▶19◀0440 CALL "SYSPROG:OMDØB"▶19◀▶15◀0450 IF FLAG<>0 THEN ▶15◀/0460 PRINT "RENAME MISLYKKEDES. FEJLKODE ";FLAG/ 0470 STOP 0480 ELSE B0490 PRINT DREVN$;":";FILNAVN$;" ER OMDØBT TIL ";DREVN$;":";FILNA$B▶0b◀0500 ENDIF ▶0b◀▶13◀0510 ENDPROC RENAME▶13◀<0520 PROC KONVERTOGMOVE(NFRA$,REF I,REF NTIL$,REF CH$,REF F)< 0530 Y:=1 \f 0540 REPEAT \f ▶12◀0550 CH$:=NFRA$(I)▶12◀90560 IF CH$=>"a" AND CH$<="å" THEN CH$:=CHR$(ORD(CH$)-32)9▶16◀0570 IF CH$<>":" THEN ▶16◀K0580 IF (CH$=>"0" AND CH$<="9") OR (CH$=>"A" AND CH$<="Å") OR CH$="_" THEN K 0590 NTIL$(Y):=CH$;Y:=Y+1;I:=I+1 0600 ELSE ▶15◀0610 IF CH$<>"" THEN ▶15◀ 0620 F:=1 ▶1b◀0630 // EXIT ;ULOVLIGT TEGN▶1b◀▶0b◀0640 ENDIF ▶0b◀▶0b◀0650 ENDIF ▶0b◀▶0b◀0660 ENDIF ▶0b◀H0670 UNTIL Y=LEN(NFRA$)+1 OR CH$=":" OR CH$="" OR LEN(NTIL$)=>9 OR I=>18H▶1a◀0680 ENDPROC KONVERTOGMOVE▶1a◀▶00◀▶00◀ BE INVOKED.▶17◀C;******************************************************************C▶01◀;▶01◀▶01◀;▶01◀▶0b◀ COND▶0b◀A CONSM:P3 ;DEFINITION OF RELATIVE ADDR. IN WORK AREAA▶01◀;▶01◀▶01◀;▶01◀▶0b◀ ROOT▶0b◀▶07◀CONSB::▶07◀▶01◀;▶01◀▶01◀;▶01◀▶07◀NIV50::▶07◀▶07◀NIV65::▶07◀6 PUSH PSW ;SAVE REGISTERS AFTER INTERRUPT6▶10◀ PUSH B▶10◀▶10◀ PUSH D▶10◀▶10◀ PUSH H▶10◀▶01◀;▶01◀- MVI D,3 ;INTERRUPT STATUS MASK-▶01◀;▶01◀= LXI H,CN1BF ;DETERMINE INTERRUPTING INTERFACE PORT=▶16◀ MVI E,C1DAc