Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.sys.apple2.programmer > #5570

Re: 2GS clock from UCSD Pascal 1.1

Show all headers | View raw

On 2020-05-17, wade kemp <wadeakemp@gmail.com> wrote:
> Hello all,
>
>   Can anyone point me to a routine or documentation on how to read the clock for the Apple 2GS  from Pascal ?
>
> Wade

This was what I used. The original routine came from David Empson:

        .MACRO  POP
        PLA
        STA     %1
        PLA
        STA     %1+1
        .ENDM
  
        .MACRO  PUSH
        LDA     %1+1
        PHA
        LDA     %1
        PHA
        .ENDM
  
        .MACRO  XCE     ; 65816: exchange carry and emulation flags
        .BYTE   0FB
        .ENDM
  
        .MACRO  REP     ; 65816: reset processor flag bits
        ; Note: normal syntax is REP #value
        .BYTE   0C2,%1
        .ENDM
  
        .MACRO  SEP     ; 65816: set processor flag bits
        ; Note: normal syntax is SEP #value
        .BYTE   0E2,%1
        .ENDM
  
        .MACRO  JSL     ; 65816: jump to subroutine long
        ; Note: normal syntax is JSL address
        ; where 'address' is a 24-bit expression.
        .BYTE   22      ; Opcode
        .WORD   %2      ; Address within bank
        .BYTE   %1      ; Bank byte
        .ENDM
  
        .MACRO  LDXL    ; 65816: 16-bit immediate load X
        ; Note: normal syntax is just LDX #value
        ; The assembler tracks (or is told) the register size.
        .BYTE   0A2     ; Opcode - normal LDX immediate
        .WORD   %1      ; 16-bit immediate value
        .ENDM
  
        .MACRO  LDYL    ; 65816: 16-bit immediate load Y
        ; Note: normal syntax is just LDY #value
        ; The assembler tracks (or is told) the register size.
        .BYTE   0A0     ; Opcode - normal LDY immediate
        .WORD   %1      ; 16-bit immediate value
        .ENDM
  
; Procedure to get the time from the IIgs, using the Miscellaneous
; Toolset call ReadTimeHex.  Pascal declaration is:
;
; PROCEDURE Read_Time(VAR t: timeRec);
  
        .PROC   Read_Time,1     ;one word of parameters
Return  .EQU    0               ;temp store return address
TimePtr .EQU    2               ;address of the timeRec
  
        POP     Return          ;save Pascal return address
        POP     TimePtr         ;get the address of the record
; Now set up for the IIgs toolbox call.  Get into native mode first.
; CLC followed by XCE enters native mode by clearing the E flag
; (emulation mode).
        CLC
        XCE                     ;we are now in native mode
; Set up 16-bit processor A, X and Y registers.
        REP     30              ;clear flag M and X bits
; Push result space for the toolbox call: eight bytes (A is 16 bits).
        PHA
        PHA
        PHA
        PHA
; Now make the toolbox call.
        LDXL    0D03            ;Toolbox call number
        JSL     0E1,0000        ;Entry point for all toolbox calls
; Pull the result structure off the stack and store it in our record.
        LDYL    0               ;Offset into structure
        PLA
        STA     @TimePtr,Y      ;Store seconds/minutes
        INY
        INY
        PLA
        STA     @TimePtr,Y      ;Store year/hour
        INY
        INY
        PLA
        STA     @TimePtr,Y      ;Store month/day
        INY
        INY
        PLA
        STA     @TimePtr,Y      ;Store weekDay/extra
; Return to emulation mode
        SEC
        XCE
; Return to Pascal
        PUSH    Return
        RTS
  
        .END


To actually use the above routine, I wrote this unit and stuck them both in SYSTEM.LIBRARY:

{$S+}
unit gs_clock; intrinsic code 24;

interface

const
  dt_str_lim = 18;
type
  time_rec = Packed Record
    second: 0..255;
    minute: 0..255;
    hour: 0..255;
    year: 0..255;
    day: 0..255;
    month: 0..255;
    extra: 0..255;
    dofw: 0..255;
  End;
  dt_string = string[dt_str_lim];
  string9 = string[9];

procedure read_time(var t : time_rec);

procedure get_time(var tim : time_rec);
procedure cnv_time(var tim : time_rec;
                   var asctim : dt_string);
procedure bin_time(asctim : dt_string;
                   var tim : time_rec);
procedure cnv_dofw(var tim : time_rec;
                   var dow_str : string9);

implementation

const
  century = 1900;

procedure read_time(*var t : time_rec*); external;
procedure get_time(*var tim : time_rec*);
begin
  read_time(tim);
  with tim do begin
    day := day + 1;
    month := month + 1;
  end;
end;

procedure cnv_time(*var tim : time_rec;
                   var asctim : dt_string*);
var
  tmp : integer;
  s : string[3];
  
  function itoc(i : integer) : char;
  begin
    itoc := chr(i + ord('0'));
  end;
  
begin
  asctim := '           ';  { 11 blanks }
  with tim do begin
    asctim[11] := itoc(second mod 10);
    asctim[10] := itoc(second div 10);
    asctim[9] := ':';
    asctim[8] := itoc(minute mod 10);
    asctim[7] := itoc(minute div 10);
    asctim[6] := ':';
    asctim[5] := itoc(hour mod 10);
    asctim[4] := itoc(hour div 10);
    asctim[2] := itoc(year mod 10);
    asctim[1] := itoc(year div 10);
    s := copy('xxJanFebMarAprMayJunJulAugSepOctNovDec', month * 3, 3);
    asctim := concat('-', s, '-', asctim);
    s := '  ';
    s[2] := itoc(day mod 10);
    if day > 9 then
      s[1] := itoc(day div 10);
    asctim := concat(s, asctim)
  end;
end;

procedure bin_time(*asctim : dt_string;
                   var tim : time_rec*);
var
  s : string[3];
  l, tmp : integer;
  
  function ctoi(ch : char) : integer;
  const
    zero = 48;
  begin
    if ch = ' ' then ctoi := 0 else ctoi := ord(ch) - zero
  end;

{$V-}
  procedure upcase(var s : string);
  var
    diff, i : integer;
  begin
    diff := ord('a') - ord('A');
    for i := 1 to length(s) do if s[i] in ['a'..'z'] then
      s[i] := chr(ord(s[i]) - diff)
  end;

begin
  l := length(asctim);
  with tim do begin
    second := ctoi(asctim[l]) + 10 * ctoi(asctim[l - 1]);
    minute := ctoi(asctim[l - 3]) + 10 * ctoi(asctim[l - 4]);
    hour := ctoi(asctim[l - 6]) + 10 * ctoi(asctim[l - 7]);
    year := ctoi(asctim[l - 9]) + 10 * ctoi(asctim[l - 10]);
    s := copy(asctim, l - 14, 3);
    upcase(s);
{$V+}
    month := pos(s, 'xxJANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC') div 3;
    day := ctoi(asctim[l - 16]);
    if l = dt_str_lim then day := day + 10 * ctoi(asctim[l - 17])
  end;
end;

procedure cnv_dofw(*var tim : time_rec;
                   var dow_str : string9*);
begin
  case tim.dofw of
    0 : dow_str := 'Sunday';
    1 : dow_str := 'Monday';
    2 : dow_str := 'Tuesday';
    3 : dow_str := 'Wednesday';
    4 : dow_str := 'Thursday';
    5 : dow_str := 'Friday';
    6 : dow_str := 'Saturday'
  end  { case }
end;

begin  { dummy main } end.

Back to comp.sys.apple2.programmer | Previous | Next — Previous in thread | Find similar | Unroll thread

Thread

2GS clock from UCSD Pascal 1.1 wade kemp <wadeakemp@gmail.com> - 2020-05-17 10:50 -0700
  Re: 2GS clock from UCSD Pascal 1.1 Fred Smith <fred@thejanitor.corp> - 2020-05-17 23:45 +0000

csiph-web