DataMuseum.dk

top - download

    Length: 4096 (0x1000)
    Types: TextFile
    Names: »SPBP2«

└─⟦a59f0a452⟧ Bits:30000472 DOMUS disk image
    └─⟦this⟧ 

TextFile

CONST

HELPTXT= "<10>***READY TYPE NL<10>",
LPTXT=   '<7><10>LP ERROR    ',
START=   'START',
B10=     32,
ENDLINE= '<13><0>',
SP2A=    '<17>',
FIRSTOFFLINE= 8'040000,


LPTABLE=#

32 32 32 32 32 32 32 32
32 32 32 32 32 32 32 32
32 32 32 32 32 32 32 32
32 32 32 32 32 32 32 32
32 32 32 32 32 32 32 32
32 32 32 32 32 32 32 32
32 32 32 32 32 32 32 32
32 32 32 32 32 32 32 32
32 32 32 32 32 32 32 32
32 32 32 46 60 40 43 85
38 32 32 32 32 32 32 32
32 32 33 93 42 41 59 32
45 47 32 32 32 32 32 32
32 32 32 44 37 95 62 63
32 32 32 32 32 32 32 32
32 32 58 91 92 39 61 34
32 65 66 67 68 69 70 71
72 73 32 32 32 32 32 32
32 74 75 76 77 78 79 80
81 82 32 32 32 32 32 32
32 32 83 84 85 86 87 88
89 90 32 32 32 32 32 32
32 32 32 32 32 32 32 32
32 32 32 32 32 32 32 32
32 65 66 67 68 69 70 71
72 73 32 32 32 32 32 32
32 74 75 76 77 78 79 80
81 82 32 32 32 32 32 32
32 32 83 84 85 86 87 88
89 90 32 32 32 32 32 32
48 49 50 51 52 53 54 55
56 57 94 32 32 32 32 32
#;
«ff»

VAR

OPSTRING:     STRING(80);
OPTEXT:       STRING(80);
OPLENGTH:     INTEGER;
MESS1:        INTEGER;
MESS2:        INTEGER;
SIDES:        INTEGER;
COUNT:        INTEGER;
MAXDSN:       INTEGER;
SIZE:         INTEGER;
NEXTLP:       INTEGER;
BLOCKNO:       INTEGER;
ERRORNO:      INTEGER;
MASK:         INTEGER;


IN:           FILE
              'FD0',
              14,
              2,
              128,
              U;
              GIVEUP FDERROR,
              2'0100000000000000
              OF STRING(128);


OUT:          FILE
              'LPT',
              2,
              2,
              129,
              U;
              GIVEUP LPERROR,
              2'1100001011110010
              OF RECORD
              CCW:  STRING(1);
              DATA: STRING(128)
              END;


PROCEDURE OPERATOR;
BEGIN
  OPWAIT(OPLENGTH);
  OPTEXT:=OPSTRING;
  OPIN(OPSTRING);
END;


PROCEDURE SENCE;
BEGIN
  IF MESS2 SHIFT 10 SHIFT(-15) = 0 THEN SIDES:=1
                                   ELSE SIDES:=2;
  MESS1:=(MESS2 SHIFT 6 SHIFT (-11) +32) SHIFT 5 + 26;
  TRANSFER(IN,MESS1,-1);
  WAITTRANSFER(IN);
END;

PROCEDURE FDERROR;
BEGIN
    IF IN.ZMASK = FIRSTOFFLINE THEN
    REPEATSHARE(IN);
END;

PROCEDURE SHOWERROR;
BEGIN
  ERRORNO:=20;
  WHILE MASK>0 DO
  BEGIN
    MASK:=MASK SHIFT 1;
    ERRORNO:=ERRORNO+1;
  END;
  BINDEC(ERRORNO,OPTEXT);
  OPMESS(OPTEXT);
  OPMESS(ENDLINE);
END;

«ff»

PROCEDURE LPERROR;
BEGIN
  NEXTLP:=OUT.Z0 AND 8'000020;
  OUT.Z0:=OUT.Z0 - NEXTLP;
  IF OUT.Z0 SHIFT 1 < 0 THEN
  OUT.Z0:=OUT.Z0 AND 8'041342;
  IF OUT.Z0 = 8'040000 THEN IF NEXTLP <> 0 THEN
  OUT.Z0:=NEXTLP;
  IF OUT.Z0 AND 8'001342 <> 0 THEN
  OUT.Z0:=OUT.Z0 AND 8'001342;
  IF OUT.Z0 <> 0 THEN
  BEGIN
    OPMESS(LPTXT);
    BLOCKNO:=IN.ZBLOCK;
    MASK:=OUT.Z0;
    SHOWERROR;
    NEXTLP:=0;
    REPEAT OPERATOR UNTIL OPTEXT=START;
    IF OUT.Z0 AND 8'141362 <> 0 THEN
    REPEATSHARE(OUT);
  END;
END;
«ff»

BEGIN
    OPIN(OPSTRING);
1:  OPMESS(HELPTXT);
    OPERATOR;
    OPEN(OUT,7);
    OPEN(IN,17+B10);
    MESS2:=IN.ZFILE;
    SENCE;
    SETPOSITION(IN,0,5);
    GETREC(IN,SIZE);
    PUTREC(OUT,81);
    OUT^.CCW:=SP2A;
    CONVERT(IN^,OUT^.DATA,LPTABLE,80);
    IF SIDES = 1 THEN MAXDSN:=19
                 ELSE MAXDSN:=45;
    SETPOSITION(IN,0,7);
    COUNT:=0;
    REPEAT
      BEGIN
        GETREC(IN,SIZE);
        PUTREC(OUT,81);
        OUT^.CCW:=SP2A;
        CONVERT(IN^,OUT^.DATA,LPTABLE,80);
        COUNT:=COUNT+1;
      END
    UNTIL COUNT > MAXDSN;
    WAITZONE(OUT);
    CLOSE(OUT,1);
    CLOSE(IN,1);
    GOTO 1;
END;
«ff»
«nul»