|
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: 2976 (0xba0)
Types: TextFile
Notes: Mikados_K
Names: »UDFØR.K«
└─⟦5630b2e42⟧ Bits:30009005 START APRIL 1985 aft april 1985 (PASCAL kildetekster)
└─⟦this⟧ »UDFØR.K«
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
└─⟦this⟧ »UDFØR.K«
(*$P*)
PROCEDURE UDFØR(PROCTYPE:MESSAGETYPE;VAR REC:AR);
VAR I,MSTATUS:INTEGER;
BEGIN
BESKED.KOMMANDO:=PROCTYPE;
IF PROCTYPE IN (.LÆSPOST..INDSÆT,RETURNHEAD,RETURNSTAT.) THEN
BEGIN
RESERV(SEMAFOR,TRUE,TRUE,MSTATUS);
IF MSTATUS<>0 THEN BEGIN WRITELN('1:',MSTATUS);READLN END;
REPEAT
ALLOCA(COMREC,2*(REC(-4)+1),MSTATUS);
(*$XT*)IF MSTATUS<>0 THEN BEGIN WRITELN('2:',MSTATUS);READLN END;(*$X-*)
UNTIL MSTATUS=0;
(*$R-*)
BESKED.INFO:=SNYD(-2);(*COMREC'S ADRESSE*)
(*$R+*)
IF PROCTYPE=RETURNSTAT THEN
COMREC^(0):=STATUSER
ELSE
BEGIN (*$R-*)
COMREC^(0):=REC(-3);(*FILNR*)
IF PROCTYPE<>RETURNHEAD THEN (*EVT. KUN NØGLER*)
MOVELEFT(REC(1),COMREC^(1),2*REC(-4));
(*FOR I:=1 TO REC(-4) DO COMREC^(I):=REC(I)*) (*$R+*)
END
END
ELSE
IF PROCTYPE IN (.ÅBEN,LUK,INITIER.) THEN
BEGIN (*$R-*)
BESKED.INFO:=REC(-3); (*$R+*)
IF PROCTYPE=ÅBEN THEN
BESKED.IREC:=MODE
ELSE
IF PROCTYPE=INITIER THEN
BESKED.IREC:=IREC
END
ELSE
IF PROCTYPE=PTILMELD THEN BESKED.INFO:=PROGRAMNR;
REPEAT
IF PROCTYPE IN (.ÅBEN,INITIER.) THEN
SENDM(CPPCB,BESKED,6,MSTATUS)
ELSE
SENDM(CPPCB,BESKED,4,MSTATUS);
IF MSTATUS<>0 THEN BEGIN WRITELN('3:',MSTATUS);READLN END;
UNTIL MSTATUS=0;
IF PROCTYPE IN (.LÆSPOST..INDSÆT,RETURNHEAD,RETURNSTAT.) THEN
BEGIN
RELEAS(SEMAFOR,MSTATUS);
IF MSTATUS<>0 THEN BEGIN WRITELN('4:',MSTATUS);READLN END
END
END;
(*$P*)
PROCEDURE UDFØRT(PROCTYPE:MESSAGETYPE;VAR REC:AR);
VAR I,MSTATUS:INTEGER;
BEGIN
(*MODTAG BESKED, CHECK TYPEOVERENSSTEMMELSE OG EVT. FILNR,
OVERFØR COMREC TIL REC, FRIGIV COMREC*)
RECEIV(CPPCB,BESKED,I);
IF BESKED.KOMMANDO<>PROCTYPE THEN
BEGIN WRITELN('KOMUOV',ORD(PROCTYPE):6,ORD(BESKED.KOMMANDO):6);READLN END;
IF PROCTYPE IN (.LÆSPOST..INDSÆT,RETURNHEAD,RETURNSTAT.) THEN
BEGIN
(*$R-*)
IF (PROCTYPE<>NÆSTEX) OR (BESKED.INFO<>-31) THEN (*DIRTY*)
MOVELEFT(COMREC^(1),REC(1),2*REC(-4));
(*FOR I:=1 TO REC(-4) DO REC(I):=COMREC^(I);*)
(*$R+*)
DEALLO(COMREC,MSTATUS);
IF MSTATUS<>0 THEN BEGIN WRITELN('5:',MSTATUS);READLN END
END;
IF PROCTYPE=STOPSYS THEN
REMUSERS:=BESKED.INFO
ELSE
BEGIN
IER:=BESKED.INFO;
IF PROCTYPE=ÅBEN THEN
BEGIN
REC(-4):=BESKED.IREC;(*POSTSTØRRELSE*)
IF IER=-12 THEN
BEGIN
IER:=0;
FILEINIT:=FALSE
END ELSE FILEINIT:=TRUE
END
END
END;
▶06◀(*$P*)▶06◀1PROCEDURE UDFØR(PROCTYPE:MESSAGETYPE;VAR REC:AR);1▶16◀VAR I,MSTATUS:INTEGER;▶16◀▶05◀BEGIN▶05◀▶1c◀ BESKED.KOMMANDO:=PROCTYPE;▶1c◀? IF PROCTYPE IN (.LÆSPOST..INDSÆT,RETURNHEAD,RETURNSTAT.) THEN?▶07◀ BEGIN▶07◀> RESERV(SEMAFOR,TRUE,TRUE,MSTATUS); >> IF MSTATUS<>0 THEN BEGIN WRITELN('1:',MSTATUS);READLN END;>
REPEAT
+ ALLOCA(COMREC,2*(REC(-4)+1),MSTATUS);+M (*$XT*)IF MSTATUS<>0 THEN BEGIN WRITELN('2:',MSTATUS);READLN END;(*$X-*)M▶14◀ UNTIL MSTATUS=0;▶14◀M (*$R-*)M1 BESKED.INFO:=SNYD(-2);(*COMREC'S ADRESSE*) 1M (*$R+*)M▶1f◀ IF PROCTYPE=RETURNSTAT THEN▶1f◀▶1a◀ COMREC^(0):=STATUSER▶1a◀▶08◀ ELSE▶08◀N BEGIN (*$R-*)N@ COMREC^(0):=REC(-3);(*FILNR*) @@ IF PROCTYPE<>RETURNHEAD THEN (*EVT. KUN NØGLER*) @, MOVELEFT(REC(1),COMREC^(1),2*REC(-4));,N (*FOR I:=1 TO REC(-4) DO COMREC^(I):=REC(I)*) (*$R+*)N▶07◀ END▶07◀▶06◀ END ▶06◀▶06◀ ELSE▶06◀* IF PROCTYPE IN (.ÅBEN,LUK,INITIER.) THEN*N BEGIN (*$R-*)NN BESKED.INFO:=REC(-3); (*$R+*)N▶19◀ IF PROCTYPE=ÅBEN THEN▶19◀▶17◀ BESKED.IREC:=MODE▶17◀▶08◀ ELSE▶08◀▶1c◀ IF PROCTYPE=INITIER THEN▶1c◀▶18◀ BESKED.IREC:=IREC ▶18◀▶05◀ END▶05◀▶07◀ ELSE ▶07◀3 IF PROCTYPE=PTILMELD THEN BESKED.INFO:=PROGRAMNR;3▶08◀ REPEAT▶08◀& IF PROCTYPE IN (.ÅBEN,INITIER.) THEN&! SENDM(CPPCB,BESKED,6,MSTATUS)!▶06◀ ELSE▶06◀" SENDM(CPPCB,BESKED,4,MSTATUS);"< IF MSTATUS<>0 THEN BEGIN WRITELN('3:',MSTATUS);READLN END;<▶12◀ UNTIL MSTATUS=0;▶12◀? IF PROCTYPE IN (.LÆSPOST..INDSÆT,RETURNHEAD,RETURNSTAT.) THEN?▶07◀ BEGIN▶07◀▶1c◀ RELEAS(SEMAFOR,MSTATUS);▶1c◀> IF MSTATUS<>0 THEN BEGIN WRITELN('4:',MSTATUS);READLN END >▶05◀ END▶05◀▶04◀END;▶04◀▶06◀(*$P*)▶06◀2PROCEDURE UDFØRT(PROCTYPE:MESSAGETYPE;VAR REC:AR);2▶16◀VAR I,MSTATUS:INTEGER;▶16◀▶05◀BEGIN▶05◀< (*MODTAG BESKED, CHECK TYPEOVERENSSTEMMELSE OG EVT. FILNR,<+ OVERFØR COMREC TIL REC, FRIGIV COMREC*)+▶19◀ RECEIV(CPPCB,BESKED,I);▶19◀# IF BESKED.KOMMANDO<>PROCTYPE THEN#L BEGIN WRITELN('KOMUOV',ORD(PROCTYPE):6,ORD(BESKED.KOMMANDO):6);READLN END;L@ IF PROCTYPE IN (.LÆSPOST..INDSÆT,RETURNHEAD,RETURNSTAT.) THEN @▶07◀ BEGIN▶07◀▶07◀(*$R-*)▶07◀@ IF (PROCTYPE<>NÆSTEX) OR (BESKED.INFO<>-31) THEN (*DIRTY*)@, MOVELEFT(COMREC^(1),REC(1),2*REC(-4));,3 (*FOR I:=1 TO REC(-4) DO REC(I):=COMREC^(I);*) 3▶07◀(*$R+*)▶07◀▶1b◀ DEALLO(COMREC,MSTATUS);▶1b◀> IF MSTATUS<>0 THEN BEGIN WRITELN('5:',MSTATUS);READLN END >▶06◀ END;▶06◀▶1a◀ IF PROCTYPE=STOPSYS THEN▶1a◀▶19◀ REMUSERS:=BESKED.INFO▶19◀▶06◀ ELSE▶06◀▶07◀ BEGIN▶07◀▶15◀ IER:=BESKED.INFO;▶15◀▶19◀ IF PROCTYPE=ÅBEN THEN▶19◀ BEGIN , REC(-4):=BESKED.IREC;(*POSTSTØRRELSE*),▶15◀ IF IER=-12 THEN▶15◀▶0b◀ BEGIN▶0b◀▶0f◀ IER:=0;▶0f◀▶17◀ FILEINIT:=FALSE▶17◀▶1d◀ END ELSE FILEINIT:=TRUE▶1d◀▶07◀ END▶07◀▶05◀ END▶05◀▶04◀END;▶04◀▶00◀▶00◀ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc