|
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;
0x000…008 Line {l1=0x06, l2=»(*$P*)«, l3=0x06}
0x008…03b Line {l1=0x31, l2=»PROCEDURE UDFØR(PROCTYPE:MESSAGETYPE;VAR REC:AR);«, l3=0x31}
0x03b…053 Line {l1=0x16, l2=»VAR I,MSTATUS:INTEGER;«, l3=0x16}
0x053…05a Line {l1=0x05, l2=»BEGIN«, l3=0x05}
0x05a…078 Line {l1=0x1c, l2=» BESKED.KOMMANDO:=PROCTYPE;«, l3=0x1c}
0x078…0b9 Line {l1=0x3f, l2=» IF PROCTYPE IN (.LÆSPOST..INDSÆT,RETURNHEAD,RETURNSTAT.) THEN«, l3=0x3f}
0x0b9…0c2 Line {l1=0x07, l2=» BEGIN«, l3=0x07}
0x0c2…102 Line {l1=0x3e, l2=» RESERV(SEMAFOR,TRUE,TRUE,MSTATUS); «, l3=0x3e}
0x102…142 Line {l1=0x3e, l2=» IF MSTATUS<>0 THEN BEGIN WRITELN('1:',MSTATUS);READLN END;«, l3=0x3e}
0x142…14e Line {l1=0x0a, l2=» REPEAT«, l3=0x0a}
0x14e…17b Line {l1=0x2b, l2=» ALLOCA(COMREC,2*(REC(-4)+1),MSTATUS);«, l3=0x2b}
0x17b…1ca Line {l1=0x4d, l2=» (*$XT*)IF MSTATUS<>0 THEN BEGIN WRITELN('2:',MSTATUS);READLN END;(*$X-*)«, l3=0x4d}
0x1ca…1e0 Line {l1=0x14, l2=» UNTIL MSTATUS=0;«, l3=0x14}
0x1e0…22f Line {l1=0x4d, l2=» (*$R-*)«, l3=0x4d}
0x22f…262 Line {l1=0x31, l2=» BESKED.INFO:=SNYD(-2);(*COMREC'S ADRESSE*) «, l3=0x31}
0x262…2b1 Line {l1=0x4d, l2=» (*$R+*)«, l3=0x4d}
0x2b1…2d2 Line {l1=0x1f, l2=» IF PROCTYPE=RETURNSTAT THEN«, l3=0x1f}
0x2d2…2ee Line {l1=0x1a, l2=» COMREC^(0):=STATUSER«, l3=0x1a}
0x2ee…2f8 Line {l1=0x08, l2=» ELSE«, l3=0x08}
0x2f8…348 Line {l1=0x4e, l2=» BEGIN (*$R-*)«, l3=0x4e}
0x348…38a Line {l1=0x40, l2=» COMREC^(0):=REC(-3);(*FILNR*) «, l3=0x40}
0x38a…3cc Line {l1=0x40, l2=» IF PROCTYPE<>RETURNHEAD THEN (*EVT. KUN NØGLER*) «, l3=0x40}
0x3cc…3fa Line {l1=0x2c, l2=» MOVELEFT(REC(1),COMREC^(1),2*REC(-4));«, l3=0x2c}
0x3fa…44a Line {l1=0x4e, l2=» (*FOR I:=1 TO REC(-4) DO COMREC^(I):=REC(I)*) (*$R+*)«, l3=0x4e}
0x44a…453 Line {l1=0x07, l2=» END«, l3=0x07}
0x453…45b Line {l1=0x06, l2=» END «, l3=0x06}
0x45b…463 Line {l1=0x06, l2=» ELSE«, l3=0x06}
0x463…48f Line {l1=0x2a, l2=» IF PROCTYPE IN (.ÅBEN,LUK,INITIER.) THEN«, l3=0x2a}
0x48f…4df Line {l1=0x4e, l2=» BEGIN (*$R-*)«, l3=0x4e}
0x4df…52f Line {l1=0x4e, l2=» BESKED.INFO:=REC(-3); (*$R+*)«, l3=0x4e}
0x52f…54a Line {l1=0x19, l2=» IF PROCTYPE=ÅBEN THEN«, l3=0x19}
0x54a…563 Line {l1=0x17, l2=» BESKED.IREC:=MODE«, l3=0x17}
0x563…56d Line {l1=0x08, l2=» ELSE«, l3=0x08}
0x56d…58b Line {l1=0x1c, l2=» IF PROCTYPE=INITIER THEN«, l3=0x1c}
0x58b…5a5 Line {l1=0x18, l2=» BESKED.IREC:=IREC «, l3=0x18}
0x5a5…5ac Line {l1=0x05, l2=» END«, l3=0x05}
0x5ac…5b5 Line {l1=0x07, l2=» ELSE «, l3=0x07}
0x5b5…5ea Line {l1=0x33, l2=» IF PROCTYPE=PTILMELD THEN BESKED.INFO:=PROGRAMNR;«, l3=0x33}
0x5ea…5f4 Line {l1=0x08, l2=» REPEAT«, l3=0x08}
0x5f4…61c Line {l1=0x26, l2=» IF PROCTYPE IN (.ÅBEN,INITIER.) THEN«, l3=0x26}
0x61c…63f Line {l1=0x21, l2=» SENDM(CPPCB,BESKED,6,MSTATUS)«, l3=0x21}
0x63f…647 Line {l1=0x06, l2=» ELSE«, l3=0x06}
0x647…66b Line {l1=0x22, l2=» SENDM(CPPCB,BESKED,4,MSTATUS);«, l3=0x22}
0x66b…6a9 Line {l1=0x3c, l2=» IF MSTATUS<>0 THEN BEGIN WRITELN('3:',MSTATUS);READLN END;«, l3=0x3c}
0x6a9…6bd Line {l1=0x12, l2=» UNTIL MSTATUS=0;«, l3=0x12}
0x6bd…6fe Line {l1=0x3f, l2=» IF PROCTYPE IN (.LÆSPOST..INDSÆT,RETURNHEAD,RETURNSTAT.) THEN«, l3=0x3f}
0x6fe…707 Line {l1=0x07, l2=» BEGIN«, l3=0x07}
0x707…725 Line {l1=0x1c, l2=» RELEAS(SEMAFOR,MSTATUS);«, l3=0x1c}
0x725…765 Line {l1=0x3e, l2=» IF MSTATUS<>0 THEN BEGIN WRITELN('4:',MSTATUS);READLN END «, l3=0x3e}
0x765…76c Line {l1=0x05, l2=» END«, l3=0x05}
0x76c…772 Line {l1=0x04, l2=»END;«, l3=0x04}
0x772…77a Line {l1=0x06, l2=»(*$P*)«, l3=0x06}
0x77a…7ae Line {l1=0x32, l2=»PROCEDURE UDFØRT(PROCTYPE:MESSAGETYPE;VAR REC:AR);«, l3=0x32}
0x7ae…7c6 Line {l1=0x16, l2=»VAR I,MSTATUS:INTEGER;«, l3=0x16}
0x7c6…7cd Line {l1=0x05, l2=»BEGIN«, l3=0x05}
0x7cd…80b Line {l1=0x3c, l2=» (*MODTAG BESKED, CHECK TYPEOVERENSSTEMMELSE OG EVT. FILNR,«, l3=0x3c}
0x80b…838 Line {l1=0x2b, l2=» OVERFØR COMREC TIL REC, FRIGIV COMREC*)«, l3=0x2b}
0x838…853 Line {l1=0x19, l2=» RECEIV(CPPCB,BESKED,I);«, l3=0x19}
0x853…878 Line {l1=0x23, l2=» IF BESKED.KOMMANDO<>PROCTYPE THEN«, l3=0x23}
0x878…8c6 Line {l1=0x4c, l2=» BEGIN WRITELN('KOMUOV',ORD(PROCTYPE):6,ORD(BESKED.KOMMANDO):6);READLN END;«, l3=0x4c}
0x8c6…908 Line {l1=0x40, l2=» IF PROCTYPE IN (.LÆSPOST..INDSÆT,RETURNHEAD,RETURNSTAT.) THEN «, l3=0x40}
0x908…911 Line {l1=0x07, l2=» BEGIN«, l3=0x07}
0x911…91a Line {l1=0x07, l2=»(*$R-*)«, l3=0x07}
0x91a…95c Line {l1=0x40, l2=» IF (PROCTYPE<>NÆSTEX) OR (BESKED.INFO<>-31) THEN (*DIRTY*)«, l3=0x40}
0x95c…98a Line {l1=0x2c, l2=» MOVELEFT(COMREC^(1),REC(1),2*REC(-4));«, l3=0x2c}
0x98a…9bf Line {l1=0x33, l2=» (*FOR I:=1 TO REC(-4) DO REC(I):=COMREC^(I);*) «, l3=0x33}
0x9bf…9c8 Line {l1=0x07, l2=»(*$R+*)«, l3=0x07}
0x9c8…9e5 Line {l1=0x1b, l2=» DEALLO(COMREC,MSTATUS);«, l3=0x1b}
0x9e5…a25 Line {l1=0x3e, l2=» IF MSTATUS<>0 THEN BEGIN WRITELN('5:',MSTATUS);READLN END «, l3=0x3e}
0xa25…a2d Line {l1=0x06, l2=» END;«, l3=0x06}
0xa2d…a49 Line {l1=0x1a, l2=» IF PROCTYPE=STOPSYS THEN«, l3=0x1a}
0xa49…a64 Line {l1=0x19, l2=» REMUSERS:=BESKED.INFO«, l3=0x19}
0xa64…a6c Line {l1=0x06, l2=» ELSE«, l3=0x06}
0xa6c…a75 Line {l1=0x07, l2=» BEGIN«, l3=0x07}
0xa75…a8c Line {l1=0x15, l2=» IER:=BESKED.INFO;«, l3=0x15}
0xa8c…aa7 Line {l1=0x19, l2=» IF PROCTYPE=ÅBEN THEN«, l3=0x19}
0xaa7…ab2 Line {l1=0x09, l2=» BEGIN«, l3=0x09}
0xab2…ae0 Line {l1=0x2c, l2=» REC(-4):=BESKED.IREC;(*POSTSTØRRELSE*)«, l3=0x2c}
0xae0…af7 Line {l1=0x15, l2=» IF IER=-12 THEN«, l3=0x15}
0xaf7…b04 Line {l1=0x0b, l2=» BEGIN«, l3=0x0b}
0xb04…b15 Line {l1=0x0f, l2=» IER:=0;«, l3=0x0f}
0xb15…b2e Line {l1=0x17, l2=» FILEINIT:=FALSE«, l3=0x17}
0xb2e…b4d Line {l1=0x1d, l2=» END ELSE FILEINIT:=TRUE«, l3=0x1d}
0xb4d…b56 Line {l1=0x07, l2=» END«, l3=0x07}
0xb56…b5d Line {l1=0x05, l2=» END«, l3=0x05}
0xb5d…b63 Line {l1=0x04, l2=»END;«, l3=0x04}
0xb63…b80 00 00 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 ┆ ccccccccccccccccccccccccccc┆
0xb80…ba0 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 ┆cccccccccccccccccccccccccccccccc┆
▶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