|
DataMuseum.dkPresents historical artifacts from the history of: MIKADOS |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about MIKADOS Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 2868 (0xb34)
Notes: Mikados TextFile, Mikados_K
Names: »WRIBAK«
└─⟦38ff28550⟧ Bits:30004682 Pascal Standard Assembler til MIKADOS
└─⟦this⟧ »WRIBAK«
;*************************************************************
;* PASCAL STANDARD ASSEMBLER PACKAGE. *
;* *
;* (C) 1980 DANSK DATA ELEKTRONIK APS. *
;*************************************************************
;
;*************************************************************
;* PROCEDURE NAME: WRIBAK *
;*************************************************************
;
; CT 07-MAY-1980
;
;=============================================================
; DESCRIPTION:
; THIS PURCEDURE IS USED TO WRITE A SEQUENTIAL MIKADOS FILE
; BACKWARDS.
; PLEASE REFER TO THE PASCAL STANDARD ASSEMBLER PACKAGE MANUAL
; SECTION 8.3 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
WRIBAK::
;
;'SHUFFLE' THE STACK SO THAT IT MEETS THE NEED OF THE WRITB
;SUBROUTINE
;
POP B ;BC=RETURN ADDRESS
POP D ;DE->CONTENTS
POP H ;HL->FILEID
PUSH B
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 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
;
;WRITE THE RECORD!
;
CALL WRITB
;
;REG. A NOW CONTAINS A POSSIBLE ERROR CODE
;
STA IORSLT ;SET IORESULT
RET
END