DataMuseum.dk

Presents historical artifacts from the history of:

MIKADOS

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about MIKADOS

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦6ab0cb210⟧

    Length: 4064 (0xfe0)
    Notes: Mikados TextFile, Mikados_K
    Names: »REDBAK«

Derivation

└─⟦38ff28550⟧ Bits:30004682 Pascal Standard Assembler til MIKADOS
    └─ ⟦this⟧ »REDBAK« 

Text

;*************************************************************
;*         PASCAL STANDARD ASSEMBLER PACKAGE.                *
;*                                                           *
;* (C) 1980 DANSK DATA ELEKTRONIK APS.                       *
;*************************************************************
;
;*************************************************************
;* PROCEDURE NAME:      REDBAK                               *
;*************************************************************
;
; CT 07-MAY-1980
;
;=============================================================
; DESCRIPTION:
; THIS PURCEDURE IS USED TO READ A SEQUENTIAL MIKADOS FILE
; BACKWARDS.
; PLEASE REFER TO THE PASCAL STANDARD ASSEMBLER PACKAGE MANUAL
; SECTION 8.2 FOR DETAILS.
;
;-------------------------------------------------------------
; STACK CONTENTS ON ENTRY:     I               I
;                              I---------------I
;                              I  RETURN ADR.  I
;                              I---------------I
;                              I  -> CONTENTS  I
;                              I---------------I
;                              I  -> FILEID    I
;                              I---------------I
;                              I               I
;-------------------------------------------------------------
; STACK CONTENTS ON EXIT:      EMPTY
;=============================================================
 
       SKIP
       SYMB
       
OFFSET:EQU     8C      ;THIS IS THE OFFSET FROM FILEID TO THE
                       ;       DATA CONTROL BLOCK
 
REDBAK::
 
;
;'SHUFFLE' THE STACK SO THAT IT MEETS THE NEED OF THE READB
;SUBROUTINE
;
       POP     B       ;BC=RETURN ADDRESS
       POP     D       ;DE->CONTENTS
       POP     H       ;HL->FILEID
       PUSH    B
       PUSH    D
       INX     D       ;DE->CONTENTS(1)
       PUSH    D
       LXI     B,OFFSET;COMPUTE THE ADDRESS OF THE
       DAD     B       ;   DATA CONTROL BLOCK
       PUSH    H       ;HL->DCB
                       ;THE STACK NOW LOOKS LIKE THIS:
                       ;               I               I
                       ;               I---------------I
                       ;               I   -> DCB      I
                       ;               I---------------I
                       ;               I ->CONTENTS(1) I
                       ;               I---------------I
                       ;               I ->CONTENTS(0) I
                       ;               I---------------I
                       ;               I  RETURN ADR.  I
                       ;               I---------------I
                       ;               I               I
 
;
;CLEAR THE END-OF-FILE FLAG (BIT 2 OF THE DFLAG FIELD OF THE
;DCB). IT MAY OF COURSE NOT HAVE BEEN SET, BUT NEVER MIND
;THAT!
;
       LXI     B,DFLAG
       DAD     B       ;HL->DCB.DFLAG
       MOV     A,M     ;A:=DCB.DFLAG
       ANI     0FB     ;CLEAR BIT 2
       MOV     M,A
       
;
;READ THE RECORD!
;
       CALL    READB
 
;
;REG. A NOW CONTAINS A POSSIBLE ERROR CODE
;REG. B CONTAINS THE LENGTH OF THE RECORD, WHICH SHOULD BE
;       STORED IN CONTENTS(0)
;
       STA     IORSLT  ;SET IORESULT
 
       POP     D       ;DE->CONTENTS(0)
       MOV     A,B     ;A:=LENGTH OF RECORD
       STAX    D       ;CONTENTS(0):=LENGTH OF RECORD
 
       RET
 
       END