|
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: 4064 (0xfe0)
Types: TextFile
Notes: Mikados_K
Names: »REDBAK.K«
└─⟦33b8385fd⟧ Bits:30009009 PSAP1
└─⟦this⟧ »REDBAK.K«
;*************************************************************
;* 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
>;*************************************************************>>;* PASCAL STANDARD ASSEMBLER PACKAGE. *>>;* *>>;* (C) 1980 DANSK DATA ELEKTRONIK APS. *>>;*************************************************************>▶01◀;▶01◀>;*************************************************************>>;* PROCEDURE NAME: REDBAK *>>;*************************************************************>▶01◀;▶01◀▶10◀; CT 07-MAY-1980▶10◀▶01◀;▶01◀>;=============================================================>▶0e◀; DESCRIPTION:▶0e◀:; THIS PURCEDURE IS USED TO READ A SEQUENTIAL MIKADOS FILE:\f
; BACKWARDS.\f
>; PLEASE REFER TO THE PASCAL STANDARD ASSEMBLER PACKAGE MANUAL>▶1a◀; SECTION 8.2 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◀▶07◀ ▶07◀=OFFSET:EQU 8C ;THIS IS THE OFFSET FROM FILEID TO THE=1 ; DATA CONTROL BLOCK1▶01◀ ▶01◀▶08◀REDBAK::▶08◀▶01◀ ▶01◀▶01◀;▶01◀;;'SHUFFLE' THE STACK SO THAT IT MEETS THE NEED OF THE READB;▶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◀' INX D ;DE->CONTENTS(1)'▶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(1) I88 ; I---------------I88 ; I ->CONTENTS(0) 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◀▶11◀;READ THE RECORD!▶11◀▶01◀;▶01◀▶14◀ CALL READB▶14◀▶01◀ ▶01◀▶01◀;▶01◀*;REG. A NOW CONTAINS A POSSIBLE ERROR CODE*:;REG. B CONTAINS THE LENGTH OF THE RECORD, WHICH SHOULD BE:▶1d◀; STORED IN CONTENTS(0)▶1d◀▶01◀;▶01◀$ STA IORSLT ;SET IORESULT$▶01◀ ▶01◀' POP D ;DE->CONTENTS(0)'+ MOV A,B ;A:=LENGTH OF RECORD+5 STAX D ;CONTENTS(0):=LENGTH OF RECORD5▶01◀ ▶01◀
RET
▶01◀ ▶01◀
END
▶00◀▶00◀cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc