DataMuseum.dk

top - metrics - download

    Length: 5504 (0x1580)
    Types: TextFile
    Names: »ACSUB.PAS«, »SUB.PAS«

└─⟦11e151dc0⟧ Bits:30009789/_.ft.Ibm2.50006589.imd Mogens Pelles Zilog 80,000 / EOS projekt
    └─⟦this⟧ »SUB.PAS« 
└─⟦89ce9b901⟧ Bits:30009789/_.ft.Ibm2.50007362.imd Mogens Pelles Zilog 80,000 / EOS projekt
    └─⟦this⟧ »ACSUB.PAS« 
└─⟦cac67a5ae⟧ Bits:30009789/_.ft.Ibm2.50007338.imd Mogens Pelles Zilog 80,000 / EOS projekt
    └─⟦this⟧ »ACSUB.PAS« 

TextFile

program sub;

label 9999;

const maxAddr = 0EFFFH;

var command : string(.128.);
    inFile : text;
    line : string(.255.);

    maxLength : integer;
    submitLength : integer;

    param : array(.0..9.) of string(.128.);
    nextParam : 0..10;
    paramNo : 1..9;

    BIOS, routineAddr, CONINaddr, CONSTaddr,
      CATCHaddr, NOTITaddr,
      CNTvar, ADDRvar, target : integer;

    i, j : integer;


procedure put(byte : integer);
begin
  poke(target, byte);
  target := target+1;
end;


procedure put2(word : integer);
begin
  put(word mod 256);
  put(word div 256);
end;


procedure putSub(ch : char);
begin
  if submitLength = maxLength then begin
    writeln('Filen er for lang'); goto 9999;
  end;
  submitLength := submitLength+1;
  put(ord(ch));
end;


begin
  (* Edit the input file name : *)
  getcomm(command);
  command := concat(command, ' ');
  nextParam := 0;
  while pos(' ', command) = 1 do
    delete(command, 1, 1);
  while command <> '' do begin
    if nextParam = 10 then begin
      writeln('For mange parametre'); goto 9999;
    end;
    i := 1;
    while command(.i.) <> ' ' do i := i+1;
    param(.nextParam.) := copy(command, 1, i-1);
    nextParam := nextParam+1;
    delete(command, 1, i-1);
    while pos(' ', command) = 1 do
      delete(command, 1, 1);
  end; (* while command <> '' *)
  if nextParam = 0 then begin
    writeln('Kald : sub <filnavn> <parameter>...');
    goto 9999;
  end;
  if pos('.', param(.0.)) = 0 then
    insert('.SUB', param(.0.), length(param(.0.))+1);

  (* Open the input file : *)
  if not fstat(param(.0.)) then begin
    writeln('Filen kan ikke åbnes : ', param(.0.));
    goto 9999;
  end;
  assign(inFile, param(.0.)); reset(inFile);

  (* Make the various routines and see how much
     space is left for the submit-string : *)
  BIOS := peek(6)+peek(7)*256  (* addr. of BDOS entry pt. *)
          + 3578;             (* addr. of BIOS jump table *)
  CNTvar := maxAddr-1;        (* addr. of variable CNT *)
  ADDRvar := CNTvar-2;        (* addr. of variable ADDR *)
  routineAddr := ADDRvar-56;  (* addr. of first routine *)

  target := routineAddr;

  NOTITaddr := target;
  put(0EDH); put(057H);       (* LD  A,I       *)
  put(0F3H);                  (* DI            *)
  put(0C3H); put2(0F023H);    (* JP  0F023H    *)

  CONINaddr := target;
  put(02AH); put2(CNTvar);    (* LD  HL,(CNT)  *)
  put(07CH);                  (* LD  A,H       *)
  put(0B5H);                  (* OR  L         *)
  put(0CAH); put2(NOTITaddr); (* JP  Z,NOTIT   *)
  put(02BH);                  (* DEC HL        *)
  put(022H); put2(CNTvar);    (* LD  (CNT), HL *)
  put(02AH); put2(ADDRvar);   (* LD  HL,(ADDR) *)
  put(07EH);                  (* LD  A,(HL)    *)
  put(023H);                  (* INC HL        *)
  put(022H); put2(ADDRvar);   (* LD  (ADDR),HL *)
  put(0E1H);                  (* POP HL        *)
  put(0C9H);                  (* RET           *)

  CONSTaddr := target;
  put(02AH); put2(CNTvar);    (* LD  HL,(CNT)  *)
  put(07CH);                  (* LD  A,H       *)
  put(0B5H);                  (* OR  L         *)
  put(0CAH); put2(NOTITaddr); (* JP  Z,NOTIT   *)
  put(03EH); put(0FFH);       (* LD  A,0FFH    *)
  put(0E1H);                  (* POP HL        *)
  put(0C9H);                  (* RET           *)

  CATCHaddr := target;
  put(0E1H);                  (* POP  HL       *)
  put(0E5H);                  (* PUSH HL       *)
  put(07DH);                  (* LD   A,L      *)
  put(0FEH); put(009H);       (* CP   09H      *)
  put(0CAH); put2(CONSTaddr); (* JP   Z,CONST  *)
  put(0FEH); put(00CH);       (* CP   0CH      *)
  put(0CAH); put2(CONINaddr); (* JP   Z,CONIN  *)
  put(0C3H); put2(NOTITaddr); (* JP   NOTIT    *)

  target := CNTvar;  put2(0);  (* Just for the moment *)
  target := ADDRvar; put2(BIOS+51);
  target := 0F020H;
  put(0C3H); put2(CATCHaddr); (* JP   CATCH    *)

  maxLength := routineAddr - (BIOS+51);
    (* Amount of free space from BIOS jump table to the
       start of the routines above. Equals the max.
       submit string length. *)

  (* Read from the input file to 'submitString' : *)
  target := BIOS+51;
  submitLength := 0;
  while not eof(inFile) do begin
    readln(inFile, line);
    i := 1;
    while i <= length(line) do begin
      if line(.i.) = '$' then begin
        if i = length(line) then begin
          writeln('Fejl : $ fundet til sidst i en linie');
          goto 9999;
        end;
        i := i+1;
        if line(.i.) = '$' then
          putSub('$')
        else
        if line(.i.) in (.'1'..'9'.) then begin
          paramNo := ord(line(.i.)) - ord('0');
          if paramNo >= nextParam then begin
            writeln(
              'Der er ikke angivet tilstrækkelig mange',
              ' parametre');
            goto 9999;
          end;
          for j := 1 to length(param(.paramNo.)) do
            putSub(param(.paramNo.)(.j.));
        end else begin
          writeln(
            'Følgende $-kombination er ikke tilladt : $',
            line(.i.));
          goto 9999;
        end;
      end else
        putSub(line(.i.));
      i := i+1;
    end;
    putSub(chr(13));
  end;
  writeln('Plads til rådighed : ', maxLength:1,
          '   Udnyttet : ', submitLength:1);

  target := CNTvar; put2(submitLength);
9999:
end.
«eof»