|
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 - download
Length: 3552 (0xde0)
Types: TextFile
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
>;*************************************************************>>;* PASCAL STANDARD ASSEMBLER PACKAGE. *>>;* *>>;* (C) 1980 DANSK DATA ELEKTRONIK APS. *>>;*************************************************************>▶01◀;▶01◀>;*************************************************************>>;* PROCEDURE NAME: WRIBAK *>>;*************************************************************>▶01◀;▶01◀▶10◀; CT 07-MAY-1980▶10◀▶01◀;▶01◀>;=============================================================>▶0e◀; DESCRIPTION:▶0e◀;; THIS PURCEDURE IS USED TO WRITE A SEQUENTIAL MIKADOS FILE;\f
; BACKWARDS.\f
>; PLEASE REFER TO THE PASCAL STANDARD ASSEMBLER PACKAGE MANUAL>▶1a◀; SECTION 8.3 FOR DETAILS.▶1a◀▶01◀;▶01◀>;------------------------------------------------------------->0; STACK CONTENTS ON ENTRY: I I00; I---------------I00; I RETURN ADR. I00; I---------------I00; I -> CONTENTS I00; I---------------I00; I -> FILEID I00; I---------------I00; I I0>;------------------------------------------------------------->$; STACK CONTENTS ON EXIT: EMPTY$>;=============================================================>▶01◀ ▶01◀▶0b◀ SKIP▶0b◀▶0b◀ SYMB▶0b◀▶01◀ ▶01◀9OFFSET:EQU 8C ;THIS IS THE OFFSET FROM FILEID TO91 ; THE DATA CONTROL BLOCK1▶01◀ ▶01◀▶08◀WRIBAK::▶08◀▶01◀ ▶01◀▶01◀;▶01◀;;'SHUFFLE' THE STACK SO THAT IT MEETS THE NEED OF THE WRITB;▶0b◀;SUBROUTINE▶0b◀▶01◀;▶01◀) POP B ;BC=RETURN ADDRESS)$ POP D ;DE->CONTENTS$" POP H ;HL->FILEID"▶10◀ PUSH B▶10◀▶10◀ PUSH D▶10◀2 LXI B,OFFSET;COMPUTE THE ADDRESS OF THE2- DAD B ; DATA CONTROL BLOCK-▶1f◀ PUSH H ;HL->DCB▶1f◀6 ;THE STACK NOW LOOKS LIKE THIS:68 ; I I88 ; I---------------I88 ; I -> DCB I88 ; I---------------I88 ; I -> CONTENTS I88 ; I---------------I88 ; I RETURN ADR. I88 ; I---------------I88 ; I I8▶01◀ ▶01◀▶01◀;▶01◀<;CLEAR THE END-OF-FILE FLAG (BIT 2 OF THE DFLAG FIELD OF THE<9;DCB). IT MAY OF COURSE NOT HAVE BEEN SET, BUT NEVER MIND9▶06◀;THAT!▶06◀▶01◀;▶01◀▶16◀ LXI B,DFLAG▶16◀% DAD B ;HL->DCB.DFLAG%$ MOV A,M ;A:=DCB.DFLAG$# ANI 0FB ;CLEAR BIT 2#▶12◀ MOV M,A▶12◀▶07◀ ▶07◀▶01◀;▶01◀▶12◀;WRITE THE RECORD!▶12◀▶01◀;▶01◀▶14◀ CALL WRITB▶14◀▶01◀ ▶01◀▶01◀;▶01◀*;REG. A NOW CONTAINS A POSSIBLE ERROR CODE*▶01◀;▶01◀$ STA IORSLT ;SET IORESULT$▶01◀ ▶01◀
RET
▶01◀ ▶01◀
END
▶00◀▶00◀cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc