From afd4c3c448381f6eb706090911a15c162fdaf8af Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Sun, 9 Oct 2016 11:28:19 +0200 Subject: Decompress source files MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit EUMEL’s TEXT dataspaces wastes a lot of storage space. Some files were therefore “compressed” by storing them as a single line, reducing overhead significantly. --- ...0: mit Kartenleser an MUFI als Endger\303\244t" | 197 +++++++++++++++++++-- 1 file changed, 186 insertions(+), 11 deletions(-) (limited to 'warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI als Endgerät') diff --git "a/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI als Endger\303\244t" "b/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI als Endger\303\244t" index f108f7b..0098901 100644 --- "a/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI als Endger\303\244t" +++ "b/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI als Endger\303\244t" @@ -22,15 +22,190 @@ *) PACKET ls warenhaus 0 DEFINES - interface anpassung,{} oeffne interface,{} schliesse interface,{} wert von interface,{} pressed key,{}(* --------------------------- *){} kanalkoppler,{} interfacechannel,{} init interfacechannel:{}TEXT CONST interface anpassung :: "mit Kartenleser an MUFI als Endgerät";{}LET mufikennung = ""27""27"",{} max channel = 24,{} initcode = 26,{} endcode = 27,{} read code = 28;{}INT CONST nicht initialisiert code :: -3,{} interface error code :: -4,{} - kanal besetzt code :: -5;{}INT VAR interfacekanal :: 2;{}TEXT VAR puffer :: "";{}TASK VAR hardwaremanager :: niltask,{} interface task :: niltask,{} absender;{}DATASPACE VAR ds :: nilspace;{}INT PROC interfacechannel:{} interfacekanal{}END PROC interfacechannel;{}PROC oeffne interface (INT VAR status):{} puffer := "";{} forget (ds); ds := nilspace;{} pingpong (interfacetask, init code, ds, status);{} IF status > 0 THEN status DECR maxint FI;{} - forget (ds); ds := nilspace{}END PROC oeffne interface;{}INT PROC wert von interface:{} INT VAR wert;{} puffer CAT incharety (1);{} call (interface task, read code, ds, wert);{} wert.{}END PROC wert von interface;{}PROC schliesse interface:{} forget (ds); ds := nilspace;{} send (interface task, end code, ds);{} forget (ds); ds := nilspace{}END PROC schliesse interface;{}TEXT PROC pressed key:{} IF puffer = ""{} THEN incharety{} ELSE erstes pufferzeichen{} FI.{} erstes pufferzeichen:{} - TEXT VAR zeichen :: puffer SUB 1;{} puffer := subtext (puffer, 2);{} zeichen.{}END PROC pressed key;{}TEXT PROC pressed key (INT CONST warten):{} IF puffer = ""{} THEN incharety (warten){} ELSE erstes pufferzeichen{} FI.{} erstes pufferzeichen:{} TEXT VAR zeichen :: puffer SUB 1;{} puffer := subtext (puffer, 2);{} zeichen.{}END PROC pressed key;{}(*************************************************************************){}PROC kanalkoppler:{} enable stop;{} IF name (myself) <> "-"{} - THEN errorstop ("Unzulässiges Kommando!"){} ELSE warte auf anrufe{} FI.{} warte auf anrufe:{} INT VAR codenummer, antwort;{} disable stop;{} REP wait (ds, codenummer, absender);{} reagiere auf anruf;{} loesche ggf fehlerzustand{} PER.{} reagiere auf anruf:{} IF codenummer = initcode{} THEN kopple an interface;{} IF interface ist betriebsbereit{} THEN bearbeite weitere auftraege{} ELSE gib negative rueckmeldung{} - FI;{} gib kanal frei{} ELSE send (absender, nicht initialisiert code, ds){} FI.{} loesche ggf fehlerzustand:{} IF is error{} THEN clear error{} FI.{} kopple an interface:{} IF task (interfacekanal) <> niltask AND task (interfacekanal) <> myself{} THEN antwort := kanal besetzt code;{} ELSE continue (interfacekanal);{} teste interface{} FI.{} teste interface:{} leere puffer;{} out (mufikennung + "10");{} fange status;{} IF status = mufikennung + "00"{} - THEN antwort := 0;{} out (mufikennung + "1A18"22""){} ELSE antwort := interface error code{} FI.{} leere puffer:{} REP UNTIL incharety = "" PER.{} fange status:{} INT VAR zaehler;{} TEXT VAR status :: "";{} FOR zaehler FROM 1 UPTO 4 REP{} status CAT incharety (1){} PER.{} interface ist betriebsbereit: antwort = 0.{} gib negative rueckmeldung: send (absender, antwort, ds).{} gib kanal frei: break (quiet).{} ende: out (""25"").{} - bearbeite weitere auftraege:{} REP pingpong (absender, antwort, ds, codenummer);{} IF codenummer = read code{} THEN hole wert von interface{} ELIF codenummer < 0{} THEN send (absender, codenummer, ds);{} codenummer := endcode{} ELSE antwort := 0{} FI{} UNTIL codenummer = endcode PER;{} ende.{} hole wert von interface:{} out (""76"");{} antwort := code (incharety (1)).{}END PROC kanalkoppler;{}PROC init interfacechannel:{} - teste auf zulaessigkeit;{} loesche interfacetask;{} erfrage interface kanal;{} generiere ggf neue interfacetask.{} teste auf zulaessigkeit:{} enable stop;{} IF hardwaremanager <> niltask AND hardwaremanager <> myself{} THEN errorstop ("Dieses Kommando kann nur von der Task '" +{} name (hardwaremanager) + "' aus gegeben werden!"){} FI.{} loesche interfacetask:{} disable stop;{} end (interfacetask);{} IF is error THEN clear error FI;{} enable stop.{} generiere ggf neue interfacetask:{} - IF interface kanal = 0{} THEN interface task := niltask;{} hardwaremanager := niltask{} ELSE begin (PROC kanalkoppler, interface task);{} hardwaremanager := myself{} FI.{} erfrage interfacekanal:{} INT VAR kanalnummer;{} put ("Gib Interface - Kanal:");{} get (kanalnummer);{} set interfacechannel (kanalnummer).{}END PROC init interfacechannel;{}PROC set interface channel (INT CONST channel number):{} IF channel number < 0 OR channel number > max channel{} THEN errorstop ("Unzulässige Kanalnummer!"){} - ELSE interface kanal := channel number{} FI{}END PROC set interface channel;{}BOOL OP <> (TASK CONST t1, t2):{} NOT (t1 = t2){}END OP <>;{}init interfacechannel{}END PACKET ls warenhaus 0{} + interface anpassung, + oeffne interface, + schliesse interface, + wert von interface, + pressed key, +(* --------------------------- *) + kanalkoppler, + interfacechannel, + init interfacechannel: +TEXT CONST interface anpassung :: "mit Kartenleser an MUFI als Endgerät"; +LET mufikennung = ""27""27"", + max channel = 24, + initcode = 26, + endcode = 27, + read code = 28; +INT CONST nicht initialisiert code :: -3, + interface error code :: -4, + + kanal besetzt code :: -5; +INT VAR interfacekanal :: 2; +TEXT VAR puffer :: ""; +TASK VAR hardwaremanager :: niltask, + interface task :: niltask, + absender; +DATASPACE VAR ds :: nilspace; +INT PROC interfacechannel: + interfacekanal +END PROC interfacechannel; +PROC oeffne interface (INT VAR status): + puffer := ""; + forget (ds); ds := nilspace; + pingpong (interfacetask, init code, ds, status); + IF status > 0 THEN status DECR maxint FI; + + forget (ds); ds := nilspace +END PROC oeffne interface; +INT PROC wert von interface: + INT VAR wert; + puffer CAT incharety (1); + call (interface task, read code, ds, wert); + wert. +END PROC wert von interface; +PROC schliesse interface: + forget (ds); ds := nilspace; + send (interface task, end code, ds); + forget (ds); ds := nilspace +END PROC schliesse interface; +TEXT PROC pressed key: + IF puffer = "" + THEN incharety + ELSE erstes pufferzeichen + FI. + erstes pufferzeichen: + + TEXT VAR zeichen :: puffer SUB 1; + puffer := subtext (puffer, 2); + zeichen. +END PROC pressed key; +TEXT PROC pressed key (INT CONST warten): + IF puffer = "" + THEN incharety (warten) + ELSE erstes pufferzeichen + FI. + erstes pufferzeichen: + TEXT VAR zeichen :: puffer SUB 1; + puffer := subtext (puffer, 2); + zeichen. +END PROC pressed key; +(*************************************************************************) +PROC kanalkoppler: + enable stop; + IF name (myself) <> "-" + + THEN errorstop ("Unzulässiges Kommando!") + ELSE warte auf anrufe + FI. + warte auf anrufe: + INT VAR codenummer, antwort; + disable stop; + REP wait (ds, codenummer, absender); + reagiere auf anruf; + loesche ggf fehlerzustand + PER. + reagiere auf anruf: + IF codenummer = initcode + THEN kopple an interface; + IF interface ist betriebsbereit + THEN bearbeite weitere auftraege + ELSE gib negative rueckmeldung + + FI; + gib kanal frei + ELSE send (absender, nicht initialisiert code, ds) + FI. + loesche ggf fehlerzustand: + IF is error + THEN clear error + FI. + kopple an interface: + IF task (interfacekanal) <> niltask AND task (interfacekanal) <> myself + THEN antwort := kanal besetzt code; + ELSE continue (interfacekanal); + teste interface + FI. + teste interface: + leere puffer; + out (mufikennung + "10"); + fange status; + IF status = mufikennung + "00" + + THEN antwort := 0; + out (mufikennung + "1A18"22"") + ELSE antwort := interface error code + FI. + leere puffer: + REP UNTIL incharety = "" PER. + fange status: + INT VAR zaehler; + TEXT VAR status :: ""; + FOR zaehler FROM 1 UPTO 4 REP + status CAT incharety (1) + PER. + interface ist betriebsbereit: antwort = 0. + gib negative rueckmeldung: send (absender, antwort, ds). + gib kanal frei: break (quiet). + ende: out (""25""). + + bearbeite weitere auftraege: + REP pingpong (absender, antwort, ds, codenummer); + IF codenummer = read code + THEN hole wert von interface + ELIF codenummer < 0 + THEN send (absender, codenummer, ds); + codenummer := endcode + ELSE antwort := 0 + FI + UNTIL codenummer = endcode PER; + ende. + hole wert von interface: + out (""76""); + antwort := code (incharety (1)). +END PROC kanalkoppler; +PROC init interfacechannel: + + teste auf zulaessigkeit; + loesche interfacetask; + erfrage interface kanal; + generiere ggf neue interfacetask. + teste auf zulaessigkeit: + enable stop; + IF hardwaremanager <> niltask AND hardwaremanager <> myself + THEN errorstop ("Dieses Kommando kann nur von der Task '" + + name (hardwaremanager) + "' aus gegeben werden!") + FI. + loesche interfacetask: + disable stop; + end (interfacetask); + IF is error THEN clear error FI; + enable stop. + generiere ggf neue interfacetask: + + IF interface kanal = 0 + THEN interface task := niltask; + hardwaremanager := niltask + ELSE begin (PROC kanalkoppler, interface task); + hardwaremanager := myself + FI. + erfrage interfacekanal: + INT VAR kanalnummer; + put ("Gib Interface - Kanal:"); + get (kanalnummer); + set interfacechannel (kanalnummer). +END PROC init interfacechannel; +PROC set interface channel (INT CONST channel number): + IF channel number < 0 OR channel number > max channel + THEN errorstop ("Unzulässige Kanalnummer!") + + ELSE interface kanal := channel number + FI +END PROC set interface channel; +BOOL OP <> (TASK CONST t1, t2): + NOT (t1 = t2) +END OP <>; +init interfacechannel +END PACKET ls warenhaus 0 + -- cgit v1.2.3