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. --- ...arenhaus 0: mit Kartenleser an AKTRONIC-Adapter | 190 +++++++++++++++++++-- 1 file changed, 179 insertions(+), 11 deletions(-) (limited to 'warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter') diff --git a/warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter b/warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter index 36de5ef..0ac3237 100644 --- a/warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter +++ b/warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter @@ -22,15 +22,183 @@ *) 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 AKTRONIC-Adapter";{}LET 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 :: 0;{}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 (""240"");{} IF incharety (1) <> ""{} THEN antwort := 0;{} - out (""176""){} ELSE antwort := interface error code{} FI.{} leere puffer:{} REP UNTIL incharety = "" PER.{} interface ist betriebsbereit: antwort = 0.{} gib negative rueckmeldung: send (absender, antwort, ds).{} gib kanal frei: break (quiet).{} ende: out (""176"").{} 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 (""211"");{} 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!"){} ELSE hardwaremanager := myself{} 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 interfacekanal := 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 AKTRONIC-Adapter"; +LET 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 :: 0; +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 (""240""); + IF incharety (1) <> "" + THEN antwort := 0; + + out (""176"") + ELSE antwort := interface error code + FI. + leere puffer: + REP UNTIL incharety = "" PER. + interface ist betriebsbereit: antwort = 0. + gib negative rueckmeldung: send (absender, antwort, ds). + gib kanal frei: break (quiet). + ende: out (""176""). + 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 (""211""); + 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!") + ELSE hardwaremanager := myself + 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 interfacekanal := 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