|
DataMuseum.dkPresents historical artifacts from the history of: Philips Data Systems |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Philips Data Systems Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 36772 (0x8fa4)
Notes: pts_type(SC)
Names: »RKONV.SC«
└─⟦26dca8ec8⟧ Bits:30009711 Philips computer tape "RÅKON-DIVFMT"
└─⟦this⟧ »REMIT2/RKONV.SC«
IDENT RKONV 830215 NJ OPTNS LINES=46 DDUM KMD08 PDIV ENTRY RKGO ENTRY ATTHD1 ENTRY DKIO ENTRY DKREAD ENTRY ASG ENTRY DKWRIT ENTRY RKASSG EXT SPCLRA EXT SPERR EXT SPCLRN EXT MASK EXT RKIO EXT RAEXIT EXT KBTEST EXT RKTEST EXT SPORG EXT PASS EXT COPYDK EXT LOD1 EXT GENWRF EXT INIT * * * * INCLUDE EQUATE EJECT RKGO SET SPPROMPT MOVE SPKEY,CBIN4 INDICATE KEYTABLES TO BE USED PERF PASS CHECK PASSWORD BNOK RAEXIT ERROR, RETURN CBNE TTASKNR,CBIN1,RA100 RB, RC, .... ? SET GTRKMFLG RA020 MOVE GTSTRFMT,=C'DIV. INFO ' ATTFMT HEAD PERF SPCLRN IB SPBINW2,RA020,RA020,RA030 B RAEXIT RA030 MOVE CDSNAME,=' ' RA100 CHOOSE NEW FUNCTION RA105 MOVE GTSTRFMT,=C'RUTINEVALG ' ATTFMT HEAD2 MOVE GSWBCD3,=D'0' FREE RECORDS PERF SPCLRA CBE SPBINW2,=W'23',RA110 ONLINE ? CBNE SPBINW2,CBIN3,RA105 -, SLUT * MOVE GSWBIN1,BCDWK B RA150 RA110 B RAEXIT EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * 01%- R]KONVERTERING/FORSKUDSREGISTRERING * 02 - [NDRING * 03 - LOCAL INQUIRIES * 04 - COPY FLOPPY DISCS * 05 - LIST REG. CPRNR * 06 - CHANGE CONSTANTS * 07 - LIST FD01 * * %-CAN BE SELECTED BY NON-MASTER TERMINAL * * * * * * * * * * * * * * * * * * * * * * * * * * RA150 TBT GTRKMFLG,RA200 MASTER ? CBE GSWBIN1,CBIN1,REG000 REG. ONLY B ERR140 * RA200 IB GSWBIN1,REG000,AND000,FOR000,COP000, C LST000,RA020,PRT000 B RA105 EJECT REG000 * TYPE 1, R]KONVERTERING / FORSKUDSREGISTRERING TBF GTRKMFLG,REG700 NON-MASTER ? PERF LOD1 B NYVALG B ERR60U READ/WRITE ERROR B ERR41 ASSIGN ERROR CLEAR CHFLAG CLEAR FULL INDICATE ROOM ON FD01 TBT FORSKUD,REG100 TBT LONOPL,REG120 MOVE GTSTRFMT,=C'SLUTLIGNING ' B REG200 REG100 MOVE GTSTRFMT,=C'FORSKUDSREG. ' B REG200 REG120 MOVE GTSTRFMT,=C'LONOPL. ' B REG200 REG200 SET CRKKLAR PERF KONREG B REG200 REPEAT B REG300 NYVALG B REG400 WRITE ERROR B REG500 NO ROOM REG300 MOVE RECFREE,MAXREC MOVE RECUSE,CBIN0 CLEAR CRKKLAR MOVE GSWBIN5,CBIN3 PERF DKIO BNOK ERR50 UNLOADERROR B NYVALG REG400 CLEAR CRKKLAR MOVE GSWBIN5,CBIN3 PERF DKIO BNOK ERR50 B ERR70 REG500 CLEAR CRKKLAR MOVE GSWBIN5,CBIN3 PERF DKIO BNOK ERR50 B ERR110 * THIS PORTION ONLY FOR NON-MASTER TASK REG700 TBT CRKKLAR,REG800 MOVE GSWSTR80,=C'11IKKE STARTET OP P] HOVEDSK[RM ' WRITE SCREEN,GSWSTR80 DELAY CBIN20 B NYVALG REG800 PERF KONREG B RA100 REPEAT B NYVALG NEW SELECT B ERR70 WRITE ERROR B ERR110 NO ROOM EJECT AND000 *** NOT TESTED YET *** * TYPE 2, AENDRING B NYVALG MOVE GSWBIN5,CBIN2 PERF DKIO BNOK ERR60U R/W ERROR B ERR41 ALREADY LOADED PERF LOD1 B ERR41 B ERR41 B ERR41 SET CHFLAG CLEAR CPRFLAG SET CRKKLAR INDICATE READY FOR REG MOVE GTSTRFMT,=C'[NDRING ' AND100 PERF SPORG RETRIEVE CPR/INFO FROM FD02 B ERR90U RECORD DELIMITER WRONG B AND200 NORMAL B ERR90U READ ERROR B ERR130U NO INDEXREG AND200 SET CPRFLAG PERF KONREG AND CHANGE IT B AND100 REPEAT B AND300 EXIT FOR NEW SELECT B AND500 WRITE ERROR B AND600 NO MORE ROOM AND300 MOVE RECFREE,MAXREC MOVE RECUSE,CBIN0 CLEAR CRKKLAR AND400 MOVE RECFREE,MAXREC MOVE RECUSE,CBIN0 CLEAR CRKKLAR MOVE GSWBIN5,CBIN3 PERF DKIO BNOK ERR50 MOVE GSWBIN5,CBIN4 PERF DKIO BNOK ERR50 B NYVALG AND500 MOVE GSWBIN5,CBIN4 PERF DKIO BNOK ERR50 B ERR70U AND600 MOVE GSWBIN5,CBIN4 PERF DKIO BNOK ERR50 B ERR110U EJECT FOR000 * TYPE 3, LOCAL INQUIRIES PERF ASG,CBIN1 LOAD FD1 BNOK ERR41 CLEAR CHFLAG MOVE GTSTRFMT,=X'464F524553505C524720' FORESPOERG PERF SPORG RETRIEVE CPRINFO FROM FD01 B ERR60U SLUTTEGN B FOR100 NORMAL B ERR60U READ ERROR B FOR100 FINISHED B ERR130U NO INDEXREG FOR100 MOVE GSWBIN5,CBIN3 PERF DKIO BNOK ERR50 B NYVALG EJECT COP000 * TYPE 4, COPY FLOPPY DISCS SET COPYFLG MOVE GTSTRFMT,=C'DISKKOPIERING ' PERF ASG,CBIN1 BNOK ERR41 IGNORE IF DISK LOADED MOVE GSWBIN5,CBIN12 REWIND FD01 PERF DKIO BNOK COP550 PERF COPYDK B COP400 MAK B COP500 READ ERROR B COP600 WRITE ERROR COP400 MOVE GSWBIN1,CBIN1 B COP800 COP500 MOVE GSWBIN1,CBIN2 B COP800 COP550 MOVE GSWBIN1,CBIN4 B COP800 COP600 MOVE GSWBIN1,CBIN3 B COP800 COP800 MOVE GSWBIN5,CBIN3 PERF DKIO BNOK ERR50 IB GSWBIN1,NYVALG,ERR90U,ERR70U,ERR100U COP900 B NYVALG EJECT LST000 * TYPE 05, LIST REG. CPRNR MOVE GSWBCD1,=D'0' MOVE GSWSTR80,=C'INDSTIL PRINTER ' ATTFMT LISTFRM2 PERF SPCLRA ADJUST GTP CBE SPBINW2,CBIN2,COP900 PERF ASG,CBIN1 LOAD FD1 BNOK ERR41 MOVE GTRECNR,CBIN6 MOVE GSWBIN5,CBIN5 PERF DKREAD READ VOL1 BNOK ERR60U MOVE GSWSTR80,TEDBUF PERF GENWRF,GTHCDEV,LISTFRM1 PERF DKREAD BNOK ERR60U MOVE GSWSTR80,TEDBUF PERF GENWRF,GTHCDEV,LISTFRM1 MOVE GTRECNR,=W'26' PERF DKREAD BNOK ERR60U MOVE GSWSTR80,TEDBUF PERF GENWRF,GTHCDEV,LISTFRM1 MOVE GSWSTR80,=C' ' PERF GENWRF,GTHCDEV,LISTFRM1 MOVE WORK14,=C'0' MOVE GSWBIN1,CBIN0 MOVE GSWBIN2,CBIN4 LST100 PERF DKREAD BNOK ERR60U MOVE GSWSTR2,TEDBUF CBE GSWSTR2,=C'**',LST200 MOVE GSWSTR2,=C'&' MOVE GSWBIN8,CBIN0 MATCH TEDBUF,GSWBIN8,CBIN10,GSWSTR2,CBIN0,CBIN1 BOK LST100 FORTS[TTELSESRECORD MOVE WORK13,TEDBUF CBE WORK13,WORK14,LST100 EQUAL CPRNR MOVE WORK14,WORK13 ADD GSWBIN1,CBIN1 MOVE WORK0(GSWBIN1),WORK14 SAVE CPRNR CBNE GSWBIN1,CBIN4,LST100 PERF GENWRF,GTHCDEV,LISTFRMT ADD GSWBIN2,CBIN1 MOVE GSWBIN1,CBIN0 RE-INITIATE MOVE WORK0(CBIN1),=D'0' MOVE WORK0(CBIN2),=D'0' MOVE WORK0(CBIN3),=D'0' MOVE WORK0(CBIN4),=D'0' * MAK WILL TERMINATE CPRNRLIST PERF KBTEST BOK LST300 CBL GSWBIN2,=W'45',LST100 MOVE GSWSTR80,=C' ' PERF GENWR,LISTFRM1,CBIN6 MOVE GSWBIN2,CBIN0 B LST100 LST200 PERF GENWRF,GTHCDEV,LISTFRMT MOVE GSWSTR80,TEDBUF PERF GENWRF,GTHCDEV,LISTFRM1 MOVE GSWSTR80,=C' ' PERF GENWR,LISTFRM1,CBIN3 LST300 MOVE GSWBIN5,CBIN3 PERF DKIO BNOK ERR50 B NYVALG EJECT * TYPE 7 * PRINT FD01 PRT000 MOVE GSWBCD1,=D'0' MOVE GSWSTR80,=C'INDSTIL PRINTER ' ATTFMT LISTFRM2 PERF SPCLRA ADJUST GTP CBE SPBINW2,CBIN2,NYVALG PERF ASG,CBIN1 BNOK ERR41 MOVE GSWSTR80,=' ' PERF GENWRF,GTHCDEV,LISTFRM1 MOVE GTRECNR,CBIN6 PRT100 PERF DKREAD BNOK PRT200 MOVE GSWBCD1,GTRECNR MOVE GSWSTR80,TEDBUF MOVE GSWSTR2,TEDBUF MOVE GSWBIN2,=W'80' MOVE GSWBIN1,CBIN0 MOVE GSWSTR1,=C'!' MATCH GSWSTR80,GSWBIN1,GSWBIN2,STR7F,CBIN0,CBIN1 BNOK PRT150 XCOPY GSWSTR80,GSWBIN1,CBIN1,GSWSTR1,CBIN0 PRT150 PERF GENWRF,GTHCDEV,LISTFRM1 PERF KBTEST BOK PRT400 CBNE GSWSTR2,=C'**',PRT100 B PRT400 PRT200 CBE GTRECNR,CBIN7,PRT100 CBE GTRECNR,CBIN8,PRT300 B PRT100 PRT300 MOVE GTRECNR,=W'26' B PRT100 PRT400 MOVE GSWBIN5,CBIN3 PERF DKIO BNOK ERR50 B NYVALG EJECT * * * ERROR ROUTINES * ERR41 MOVE GSWSTR80,=C'ASSIGNFEJL ' B ERRDISP ERR50 MOVE GSWSTR80,=C'UNLOADFEJL ' B ERRDISP ERR60U MOVE GSWBIN5,CBIN3 PERF DKIO BNOK ERR50 ERR60 MOVE GSWSTR80,=C'L[SEFEJL ' B ERRDISP ERR70U MOVE GSWBIN5,CBIN4 PERF DKIO BNOK ERR70 ERR70 MOVE GSWSTR80,=C'SKRIVEFEJL ' B ERRDISP ERR90U MOVE GSWBIN5,CBIN4 PERF DKIO BNOK ERR100U B ERR60 ERR100U MOVE GSWBIN5,CBIN3 PERF DKIO BNOK ERR100 ERR100 MOVE GSWSTR80,=C'REWINDFEJL ' B ERRDISP ERR110U MOVE GSWBIN3,CBIN3 PERF DKIO BNOK ERR110 ERR110 MOVE GSWSTR80,=C'DISKETTE FYLDT OP ' B ERRDISP ERR130U MOVE GSWBIN5,CBIN3 PERF DKIO BNOK ERR130 ERR130 MOVE GSWSTR80,=C'INTET INDEXREGISTER, HUSK KOPIERING ' B ERRDISP ERR140 MOVE GSWSTR80,=C'RUTINE IKKE TILLADT P] DENNE TERMINAL ' B ERRDISP ERRDISP ATTFMT LISTFRM2 PERF SPCLRA ************************************************ NYVALG NEW FUNCTION ? B RA105 EJECT ATTHD1 PROC ATTFMT HEAD1 RET PEND KONREG PROC ***************************************** * * KONREG - R]KONVERTERING * * EXIT UPON COMPLETION: * 0 - REPEAT ROUTINE * 2 - EXIT FOR NEW SELECT * 4 - WRITE ERROR * 6 - NO MORE ROOM ON FD01 * ***************************************** ST0200 CLEAR SPCHANGE CLEAR INQ1 CLEAR INQ2 CLEAR INQ3 ST0210 PERF ATTHD1 CLEAR SLUTFLAG TBT CHFLAG,ST0215 PERF CLRTST ST0215 * WHEN RUNNING [NDRING, FIELDS * 91/92/93 ARE TO BE RENAMED TO 26/27/28 MOVE GSWBCD3,RECFREE SUB GSWBCD3,=D'400' MOVE WORK5,RECUSE TBT OBS,ST0218 TABLES FILLED AFTER INQUIRY? PERF SPCLRA B ST0220 ST0218 CLEAR SPPROMPT PERF SPCLRN ST0220 IB SPBINW2,ST40,ST40,ST03 B ST0200 ST03 SET SPPROMPT CLEAR OBS CLEAR COPYFLG TBF CRKKLAR,ST030 PERF UPD B ST0218 B ST35 ST030 RET 4 ST35 TBT FULL,ST45 TBT CHFLAG,ST50 B ST0210 ST40 TBT SPCHANGE,ST0200 SET SPPROMPT RET 2 ST45 RET 6 NO MORE ROOM ST50 NORMAL RETURN, NEW CPRNR RET PEND EJECT ************************************************************ * * CLRTST - CLEARING OF TESTSTRG * ************************************************************* CLRTST PROC MOVE GSWBIN1,CBIN12 MOVE GSWBIN2,CBIN4 CLRT10 MOVE FIELD(GSWBIN1,GSWBIN2),=D'0' MOVE SAVEF(GSWBIN1,GSWBIN2),=C' ' SUB GSWBIN2,CBIN1 BNZ CLRT10 MOVE GSWBIN2,CBIN4 SUB GSWBIN1,CBIN1 BNZ CLRT10 RET PEND * * * MASKDK PROC DK **************************************** * * MASKDK - INSPECT MASK FROM EXTENDED STATUSWORD * * CALL: PERF MASKDK,<DISK> * * EXIT UPON COMPLETION: * 0 - ERROR * 2 - NORMAL * **************************************** XSTAT DK,SPBINW4 CALL MASK,SPBINW4,GSWBIN5 BZ MASKR2 MOVE GSWBIN1,CBIN15 MOVE GSWBIN2,CBIN1 MASK01 CALL MASK,SPBINW4,GSWBIN2 BNZ MASKRET SUB GSWBIN1,CBIN1 CBNE GSWBIN1,CBIN2,MASK02 MOVE SPBINW4,CBIN0 B MASKRET MASK02 MOVE GSWBCD5,GSWBIN2 ADD GSWBIN2,GSWBIN2 BOFL MASKRET SHOULD NOT HAPPEN B MASK01 MOVE SPBINW4,CBIN1 MOVE GSWBCD4,GSWBIN1 MASKRET CMP CBIN0,CBIN1 RET MASKR2 CMP CBIN0,CBIN0 RET PEND GENWR PROC FORMAT,LOOP MOVE GSWBIN1,LOOP GEN10 PERF GENWRF,GTHCDEV,FORMAT SUB GSWBIN1,CBIN1 BP GEN10 RET PEND EJECT DKREAD PROC **************************************** * * DKREAD - DISK READ PROCEDURE * * IF ERROR, A LINE IS DISPLAYED ON VDU, * IF OK, THE RECORD IS DELIVERED IN TEDBUF, * * CALL: PERF DKREAD * EXIT UPON COMPLETION: * 0 - ERROR * 2 - NORMAL * ***************************************** MOVE GSWBIN5,CBIN5 PERF DKIO BNOK READ10 B READRET READ10 MOVE GSWBCD4,SPBINW4 ADD GSWBCD4,=D'70' MOVE SPBINW4,CBIN1 CMP CBIN0,CBIN1 RET READRET ADD GTRECNR,CBIN1 CMP CBIN0,CBIN0 RET PEND DKWRIT PROC ***************************************** * * DKWRIT - DISK WRITE PROCEDURE * * IF ERROR, A LINE IS DISPLAYED ON VDU, * * CALL: PERF DKWRIT * * EXIT UPON COMPLETION: * 0 - EROR * 2 - NORMAL * ****************************************** MOVE GTRECNR,LASTREC SUB GTRECNR,RECFREE CBE RECFREE,CBIN0,WRITERR NO MORE SPACE MOVE GSWBIN5,CBIN7 PERF DKIO BNOK WRITERR TBT COPYFLG,WRITRET DONT PROPAGATE SLUTRECORD ADD GTRECNR,CBIN1 EDIT TEDBUF,ENDCARD MOVE GSWBIN5,CBIN7 PERF DKIO BNOK WRITERR WRITRET ADD ENDREC,CBIN1 MOVE RECUSE,ENDREC SUB RECFREE,CBIN1 CMP CBIN0,CBIN0 RET WRITERR MOVE GSWBCD4,SPBINW4 ADD GSWBCD4,=D'90' MOVE SPBINW4,CBIN1 CMP CBIN0,CBIN1 RET PEND EJECT DKIO PROC ********************************************* * * DKIO - THE PROCEDURES TAKES CARE OF ALL I/O * ON DISK. THE FUNCTION IS SPECIFIED IN GSWBIN5. * AFTER HAVING CALLED RKIO, THE RETURNWORD * IS INSPECTED IN MASKDK. AND AN EVENTUAL * ERRORCODE IS RETURNED IN GSWBCD4, FOR * DISPLAYING PURPOSES VIA A SPERR-CALL * * RETURN UPON COMPLETION: * 0 - ERROR * 2 - NORMAL ********************************************** IB GSWBIN5,TOSS1,TOSS2,TOSS3,TOSS4,TOSS5,TOSS6,TOSS7, C TOSS8,TOSS9,TOSS10,TOSS11,TOSS12,TOSS13,TOSS14, C TOSS15 CMP CBIN0,CBIN1 RET TOSS1 * LOAD FD01 MOVE GTRECNR,CBIN7 MOVE LENGTH,=W'80' CALL RKIO,FDRK01,HEXB7,TEDBUF,LENGTH,GTRECNR MOVE GSWBIN5,=X'FFDF' B TOSS50 TOSS2 * LOAD FD02 MOVE GTTRKEY,CBIN7 MOVE LENGTH,=W'80' CALL RKIO,FDRK02,HEXB7,TEDBUF,LENGTH,GTTRKEY MOVE GSWBIN5,=X'FFDF' B TOSS60 TOSS3 * UNLOAD FD01 MOVE LENGTH,=W'128' CALL RKIO,FDRK01,HEXB8,TEDBUF,LENGTH,GTRECNR MOVE GSWBIN5,=X'FFFF' B TOSS50 TOSS4 * UNLOAD FD02 MOVE LENGTH,=W'128' CALL RKIO,FDRK02,HEXB8,TEDBUF,LENGTH,GTTRKEY MOVE GSWBIN5,=X'FFFF' B TOSS60 TOSS5 * PHYSICAL READ FD01 MOVE LENGTH,=W'128' CALL RKIO,FDRK01,HEX91,TEDBUF,LENGTH,GTRECNR MOVE GSWBIN5,=X'FFFF' B TOSS50 TOSS6 * PHYSICAL READ FD02 MOVE LENGTH,=W'128' CALL RKIO,FDRK02,HEX91,TEDBUF,LENGTH,GTTRKEY MOVE GSWBIN5,=X'FFFF' B TOSS60 TOSS7 * PHYSICAL WRITE FD01 MOVE COPYBUF,TEDBUF MOVE TEDBUF,BINULL MOVE LENGTH,=W'80' COPY TEDBUF,CBIN0,LENGTH,COPYBUF,CBIN0 TOSS7A MOVE LENGTH,=W'128' CALL RKIO,FDRK01,HEX95,TEDBUF,LENGTH,GTRECNR MOVE GSWBIN5,=X'FFFF' B TOSS50 TOSS8 * SEQUENTIAL READ, FD01 MOVE LENGTH,=W'128' CALL RKIO,FDRK01,HEX82,TEDBUF,LENGTH,GTRECNR MOVE GSWBIN5,=X'FFFF' B TOSS50 TOSS9 * SEQUENTIAL READ, FD02 MOVE LENGTH,=W'80' CALL RKIO,FDRK02,HEX82,TEDBUF,LENGTH,GTTRKEY MOVE GSWBIN5,=X'FFFF' B TOSS60 TOSS10 * SEQUENTIAL WRITE,FD01 MOVE LENGTH,=W'80' MOVE COPYBUF,TEDBUF MOVE TEDBUF,BINULL COPY TEDBUF,CBIN0,LENGTH,COPYBUF,CBIN0 MOVE LENGTH,=W'80' CALL RKIO,FDRK01,HEX86,TEDBUF,LENGTH,GTRECNR MOVE GSWBIN5,=X'FFFF' B TOSS50 TOSS11 * SEQUENTIAL WRITE,FD02 MOVE LENGTH,=W'128' CALL RKIO,FDRK02,HEX86,TEDBUF,LENGTH,GTTRKEY MOVE GSWBIN5,=X'FFFF' B TOSS60 TOSS12 * REWIND FD01 MOVE LENGTH,=W'128' CALL RKIO,FDRK01,HEX31,TEDBUF,LENGTH,GTRECNR MOVE GSWBIN5,=X'FFFF' B TOSS50 TOSS13 * REWIND FD02 MOVE LENGTH,=W'128' CALL RKIO,FDRK02,HEX31,TEDBUF,LENGTH,GTTRKEY MOVE GSWBIN5,=X'FFFF' B TOSS60 TOSS14 * PHYSICAL WRITE FD02 MOVE LENGTH,=W'128' CALL RKIO,FDRK02,HEX95,TEDBUF,LENGTH,GTTRKEY MOVE GSWBIN5,=X'FFFF' B TOSS60 * TOSS15 * PHYSICAL WRITE FD01, LENGTH 128 B TOSS7A * TOSS50 PERF MASKDK,FDRK01 RET TOSS60 PERF MASKDK,FDRK02 RET PEND EJECT UPD PROC ********************************************* * * UPD - THE PROCEDURE CREATES DETAILRECORD(S) ON FD01 * AFTER TESTING THE FIELDS * * EXIT UPON COMPLETION: * 0 - ERROR IN SLUTEST-CALL * 2 - NORMAL * 4 - DISK WRITE ERROR * ********************************************** PERF RKTEST BOK UPD01 SET SLUTFLAG PERF SPERR CLEAR SLUTFLAG B UPDER UPD01 * ONLY ONE TASK IS ALLOWED TO WRITE TO FD01 AT A TIME. * HENCE FDBUSY WILL BE SET ON ENTERING THIS PROCEDURE, * AND IT WILL BE CLEARED AGAIN UPON LEAVING IT. UPD00 TBF FDBUSY,UPD05 DELAY CBIN2 B UPD00 AND TRY AGAIN UPD05 SET FDBUSY CLEAR SLUTFLAG MOVE TEDBUF,BINULL MOVE GSWBIN6,CBIN1 MOVE GSWBIN7,CBIN1 MOVE GTANTAL,=D'1' MOVE CARDPT,CBIN0 MOVE CARDBUF,=C' ' B UPD25 UPD20 ADD GSWBIN7,CBIN1 CBNG GSWBIN7,CBIN4,UPD25 MOVE GSWBIN7,CBIN1 ADD GSWBIN6,CBIN1 CBG GSWBIN6,CBIN12,UPDRET UPD25 CBE FIELD(GSWBIN6,GSWBIN7),=D'0',UPD20 MOVE GSWSTR20,BINULL MOVE BCDWK,FIELD(GSWBIN6,GSWBIN7) EDIT GSWSTR20,FLTFRMT MOVE GSWBIN1,CBIN4 MATCH GSWSTR20,GSWBIN1,CBIN12,BINULL,CBIN0,CBIN1 ADD CARDPT,GSWBIN1 CBG CARDPT,=W'66',UPD30 SUB CARDPT,GSWBIN1 COPY CARDBUF,CARDPT,GSWBIN1,GSWSTR20,CBIN0 ADD CARDPT,GSWBIN1 B UPD20 UPD30 SUB CARDPT,GSWBIN1 MOVE GSWSTR20,STR25 COPY CARDBUF,CARDPT,CBIN1,GSWSTR20,CBIN0 CBE GTANTAL,=D'1',UPD40 MOVE GSWSTR20,GTANTAL INSRT CARDBUF,CBIN0,CBIN1,GSWSTR20,CBIN1 MOVE TEDBUF,CARDBUF B UPD45 UPD40 EDIT TEDBUF,DETCARD UPD45 PERF DKWRIT BNOK UPDER4 ADD GTANTAL,=D'1' MOVE CARDPT,CBIN0 MOVE CARDBUF,=C' ' B UPD25 UPDRET MOVE GSWSTR20,STR7F COPY CARDBUF,CARDPT,CBIN1,GSWSTR20,CBIN0 CBE GTANTAL,=D'1',UPD50 MOVE GSWSTR20,GTANTAL INSRT CARDBUF,CBIN0,CBIN1,GSWSTR20,CBIN1 MOVE TEDBUF,CARDBUF B UPD52 UPD50 EDIT TEDBUF,DETCARD UPD52 PERF DKWRIT BNOK UPDER4 CBG RECFREE,CBIN20,UPD55 CHECK FOR MORE ROOM SET FULL UPD55 CLEAR FDBUSY RET 2 UPDER4 CLEAR FDBUSY RET 4 UPDER RET PEND EJECT ASG PROC PAR ********************************************** * * ASG - LOAD FLOPPY DISC AT FIRST RECORD * FD01 ::= $PAR = 1 * FD02 ::= $PAR = 2 * * EXIT UPON COMPLETION: * 0 - ERROR * 2 - NORMAL * ********************************************** MOVE GSWBIN5,PAR CBNE GSWBIN5,CBIN1,ASG10 MOVE RECFREE,MAXREC MOVE ENDREC,CBIN0 ASG10 PERF DKIO RET PEND EJECT RKASSG PROC * * LOAD FD01 AND SEARCH END OF DATA * PERF ASG,CBIN1 BNOK AS90 ASSIGNERROR MOVE GTRECNR,=W'26' AS10 PERF DKREAD BNOK AS90 MOVE GSWSTR2,TEDBUF CBNE GSWSTR2,=C'**',AS10 CBNE GTRECNR,=W'26',AS16 PERF INIT B AS90 B AS90 B AS20 AS16 MOVE TEDBUF,=C' ' SUB GTRECNR,CBIN1 1 TOO FAR (DKREAD ADDS 1) MOVE ENDREC,GTRECNR SUB ENDREC,=W'26' MOVE RECUSE,ENDREC SUB RECFREE,RECUSE AS20 CMP CBIN0,CBIN0 RET AS90 CMP CBIN0,CBIN1 RET PEND EJECT ************************************************************* * * FORMATS * ************************************************************* * * HEAD FRMT FSL FCOPY GTSTRFMT FCOPY =' DATO' FILLR ' ',2 FKI 28,MINL=6,MAXL=6,SCHK=2,ME,REWRT,NCLR FMEL '99E-99E-99',DATE FNL FCOPY =C'SKATTE]R' FILLR ' ',2 FKI 14,MINL=2,MAXL=2,ME,REWRT,NCLR FMEL '99',YEAR FNL FTEXT 'INDTAST GR[NSE FOR MEDHJ.HUSTRU ' FKI 34,MINL=5,MAXL=6,ME,REWRT,NCLR FMEL 'ZZZVZZZ',MEDHJ FTAB 49 FTEXT 'OG FORMUE ' FKI 60,MINL=6,MAXL=7,ME,REWRT,NCLR FMEL 'ZVZZZVZZZ',FORMUE FMEND * HEAD1 FRMT FSL FCOPY GTSTRFMT FCOPY =' DATO' FTAB 28 FHIGH FMEL '99E-99E-99',DATE FLOW FCOPY =' DATAS[T' FTAB 42 FCOPY CDSNAME FILLR ' ',8 FCOPY =' RECORDS FRI' FTAB 73 FHIGH FMEL '9999',GSWBCD3 FLOW FNL FTEXT 'CPR-NR' FILLR ' ',52 FTEXT 'RECORD NR' FTAB 73 FHIGH FMEL '9999',WORK5 FLOW FNL FBT CPRFLAG,HEAD101 FKI 1,MINL=10,MAXL=10,ME,REWRT,SCHK=1 HEAD101 FMEL '999999E-9999',CPRNR FBF INQ1,HEAD102 FEXIT HEAD102 FNL FCOPY ='FNR FELTINDHOLD' FILLR ' ',6 FCOPY ='FNR FELTINDHOLD' FILLR ' ',6 FCOPY ='FNR FELTINDHOLD' FILLR ' ',6 FCOPY ='FNR FELTINDHOLD' FNL FKI 1,APPL=6,MINL=2,MAXL=3,NUM FMEL 'ZZZ',FIELD(CBIN1,CBIN1) FKI 5,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN1,CBIN1) FKI 22,MINL=1,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN1,CBIN2) FKI 26,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN1,CBIN2) FKI 43,MINL=1,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN1,CBIN3) FKI 47,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN1,CBIN3) FKI 64,MINL=1,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN1,CBIN4) FKI 68,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN1,CBIN4) FNL FKI 1,APPL=6,MINL=2,MAXL=3,NUM FMEL 'ZZZ',FIELD(CBIN2,CBIN1) FKI 5,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN2,CBIN1) FKI 22,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN2,CBIN2) FKI 26,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN2,CBIN2) FKI 43,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN2,CBIN3) FKI 47,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN2,CBIN3) FKI 64,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN2,CBIN4) FKI 68,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN2,CBIN4) FNL FKI 1,APPL=6,MINL=2,MAXL=3,NUM FMEL 'ZZZ',FIELD(CBIN3,CBIN1) FKI 5,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN3,CBIN1) FKI 22,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN3,CBIN2) FKI 26,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN3,CBIN2) FKI 43,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN3,CBIN3) FKI 47,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN3,CBIN3) FKI 64,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN3,CBIN4) FKI 68,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN3,CBIN4) FNL FKI 1,APPL=6,MINL=2,MAXL=3,NUM FMEL 'ZZZ',FIELD(CBIN4,CBIN1) FKI 5,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN4,CBIN1) FKI 22,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN4,CBIN2) FKI 26,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN4,CBIN2) FKI 43,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN4,CBIN3) FKI 47,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN4,CBIN3) FKI 64,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN4,CBIN4) FKI 68,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN4,CBIN4) FNL FKI 1,APPL=6,MINL=2,MAXL=3,NUM FMEL 'ZZZ',FIELD(CBIN5,CBIN1) FKI 5,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN5,CBIN1) FKI 22,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN5,CBIN2) FKI 26,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN5,CBIN2) FKI 43,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN5,CBIN3) FKI 47,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN5,CBIN3) FKI 64,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN5,CBIN4) FKI 68,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN5,CBIN4) FNL FKI 1,APPL=6,MINL=2,MAXL=3,NUM FMEL 'ZZZ',FIELD(CBIN6,CBIN1) FKI 5,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN6,CBIN1) FKI 22,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN6,CBIN2) FKI 26,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN6,CBIN2) FKI 43,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN6,CBIN3) FKI 47,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN6,CBIN3) FKI 64,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN6,CBIN4) FKI 68,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN6,CBIN4) FNL FKI 1,APPL=6,MINL=2,MAXL=3,NUM FMEL 'ZZZ',FIELD(CBIN7,CBIN1) FKI 5,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN7,CBIN1) FKI 22,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN7,CBIN2) FKI 26,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN7,CBIN2) FKI 43,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN7,CBIN3) FKI 47,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN7,CBIN3) FKI 64,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN7,CBIN4) FKI 68,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN7,CBIN4) FNL FKI 1,APPL=6,MINL=2,MAXL=3,NUM FMEL 'ZZZ',FIELD(CBIN8,CBIN1) FKI 5,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN8,CBIN1) FKI 22,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN8,CBIN2) FKI 26,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN8,CBIN2) FKI 43,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN8,CBIN3) FKI 47,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN8,CBIN3) FKI 64,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN8,CBIN4) FKI 68,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN8,CBIN4) FNL FKI 1,APPL=6,MINL=2,MAXL=3,NUM FMEL 'ZZZ',FIELD(CBIN9,CBIN1) FKI 5,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN9,CBIN1) FKI 22,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN9,CBIN2) FKI 26,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN9,CBIN2) FKI 43,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN9,CBIN3) FKI 47,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN9,CBIN3) FKI 64,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN9,CBIN4) FKI 68,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN9,CBIN4) FNL FKI 1,APPL=6,MINL=2,MAXL=3,NUM FMEL 'ZZZ',FIELD(CBIN10,CBIN1) FKI 5,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN10,CBIN1) FKI 22,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN10,CBIN2) FKI 26,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN10,CBIN2) FKI 43,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN10,CBIN3) FKI 47,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN10,CBIN3) FKI 64,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN10,CBIN4) FKI 68,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN10,CBIN4) FNL FKI 1,APPL=6,MINL=2,MAXL=3,NUM FMEL 'ZZZ',FIELD(CBIN11,CBIN1) FKI 5,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN11,CBIN1) FKI 22,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN11,CBIN2) FKI 26,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN11,CBIN2) FKI 43,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN11,CBIN3) FKI 47,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN11,CBIN3) FKI 64,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN11,CBIN4) FKI 68,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN11,CBIN4) FNL FKI 1,APPL=6,MINL=2,MAXL=3,NUM FMEL 'ZZZ',FIELD(CBIN12,CBIN1) FKI 5,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN12,CBIN1) FKI 22,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN12,CBIN2) FKI 26,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN12,CBIN2) FKI 43,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN12,CBIN3) FKI 47,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN12,CBIN3) FKI 64,MINL=2,MAXL=3,APPL=6,NUM FMEL 'ZZZ',FIELD(CBIN12,CBIN4) FKI 68,MINL=1,MAXL=12,APPL=3,ALPHA FCOPY SAVEF(CBIN12,CBIN4) FNL FMEND * HEAD2 FRMT FSL FCOPY GTSTRFMT FCOPY =' DATO' FILLR ' ',1 FMEL 'Z99E-99E-99',DATE FCOPY =' DATAS[T' FILLR ' ',1 FCOPY CDSNAME FILLR ' ',10 FCOPY =' RECORDS FRI' FTAB 73 FMEL '99999',GSWBCD3 FNL FCOPY =C'SKATTE]R' FMEL 'Z99',YEAR FNL FTEXT '01*- SLUTLIGNING/FORSKUDSREG./LONOPL.' FNL FTEXT '02 - [NDRINGER' FNL FTEXT X'3033202D20464F524553505C5247' FNL FTEXT '04 - DISKKOPIERING' FNL FTEXT '05 - LIST CPRNR' FNL FTEXT '06 - [NDRING AF KONSTANTER' FNL FTEXT '07 - UDSKRIVNING AF DISKETTE ' FNL FKI 01,MINL=1,MAXL=2,ME FMEL 'ZZZ',BCDWK FMEND * LISTFRM1 FRMT FILLR '+',2 FMEL 'ZZZZ',GSWBCD1 FILLR ' ',4 FCOPY GSWSTR80 FEOR FILLR ' ',2 FMEND * LISTFRM2 FRMT FSL FCOPY GSWSTR80 FNL FKI 1,MINL=0,MAXL=1 FMEL 'Z',BCDWK FMEND * LISTFRMT FRMT FILLR '+',2 FILLR ' ',8 FMEL '99E-99E-99E-9999',WORK0(CBIN1) FILLR ' ',10 FMEL '99E-99E-99E-9999',WORK0(CBIN2) FILLR ' ',10 FMEL '99E-99E-99E-9999',WORK0(CBIN3) FILLR ' ',10 FMEL '99E-99E-99E-9999',WORK0(CBIN4) FEOR FILLR ' ',2 FMEND * ENDCARD FRMT FILLR '*',2 FMEL '999',RKKMNR FILLR ' ',60 FILLR ' ',15 FMEND * DETCARD FRMT FMEL '9999999999',CPRNR FCOPY CARDBUF FMEND * FLTFRMT FRMT FILLR C'&',1 FMEL 'T99',BCDWK FCOPY SAVEF(GSWBIN6,GSWBIN7) FMEND END