m-code-64/Instruction.mod

IMPLEMENTATION MODULE Instruction ;

FROM Memory IMPORT ReadByte, ReadWord, ReadSlot, WriteSlot ;
FROM Local IMPORT GetIP, SetIP, GetSP, SetSP, GetFP, SetFP, GetGP, SetGP,
  GetOFP, SetOFP ;
FROM Stack IMPORT Push, Pop, Reserve ;
FROM Global IMPORT GetModuleProcs, GetCurrentModule, SetCurrentModule,
  FindModuleByBase, GetModuleBase ;

PROCEDURE Fetch () : CARDINAL ;
VAR b: CARDINAL ;
BEGIN
  b := ReadByte (GetIP ()) ;
  SetIP (GetIP () + 1) ;
  RETURN b ;
END Fetch ;

PROCEDURE FetchSignedByte () : INTEGER ;
VAR b: CARDINAL ;
BEGIN
  b := Fetch () ;
  IF b >= 128 THEN
    RETURN VAL (INTEGER, b) - 256 ;
  ELSE
    RETURN VAL (INTEGER, b) ;
  END ;
END FetchSignedByte ;

PROCEDURE FetchWord () : CARDINAL ;
VAR v: CARDINAL ;
BEGIN
  v := ReadWord (GetIP ()) ;
  SetIP (GetIP () + 4) ;
  RETURN v ;
END FetchWord ;

PROCEDURE FetchSignedWord () : INTEGER ;
BEGIN
  RETURN VAL (INTEGER, FetchWord ()) ;
END FetchSignedWord ;

PROCEDURE FetchQuad () : LONGCARD ;
VAR v: LONGCARD ;
BEGIN
  v := ReadSlot (GetIP ()) ;
  SetIP (GetIP () + 8) ;
  RETURN v ;
END FetchQuad ;

PROCEDURE LoadString (n: CARDINAL) ;
BEGIN
  Push (GetIP ()) ;
  SetIP (GetIP () + VAL (LONGCARD, n)) ;
END LoadString ;

PROCEDURE ProcedureAddress (mod, obj: CARDINAL) : LONGCARD ;
VAR slot, rel: LONGCARD ;
BEGIN
  slot := GetModuleProcs (mod) + VAL (LONGCARD, obj) * 8 ;
  rel := ReadSlot (slot) ;
  RETURN slot + VAL (LONGCARD, VAL (LONGINT, rel)) ;
END ProcedureAddress ;

PROCEDURE CallProcedure (mod, obj: CARDINAL) ;
BEGIN
  Push (ProcedureAddress (mod, obj)) ;
END CallProcedure ;

PROCEDURE Enter (k: CARDINAL) ;
BEGIN
  Push (GetFP ()) ;
  Push (GetOFP ()) ;
  SetFP (GetSP ()) ;
  Push (GetIP ()) ;
  SetSP (GetSP () - VAL (LONGCARD, 255 - k) * 8) ;
END Enter ;

PROCEDURE Leave (n: CARDINAL) ;
BEGIN
  SetSP (GetFP ()) ;
  SetOFP (Pop ()) ;
  SetFP (Pop ()) ;
  SetIP (Pop ()) ;
  IF (n MOD 128) # 0 THEN
    SetSP (GetSP () + VAL (LONGCARD, n MOD 128) * 8) ;
  END ;
  IF n >= 128 THEN
    SetGP (GetOFP ()) ;
    SetCurrentModule (FindModuleByBase (GetGP ())) ;
    SetGP (GetModuleBase (GetCurrentModule ())) ;
  END ;
END Leave ;

END Instruction.