|
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: 17238 (0x4356)
Notes: pts_type(SC)
Names: »RKSUBS.SC«
└─⟦26dca8ec8⟧ Bits:30009711 Philips computer tape "RÅKON-DIVFMT"
└─⟦this⟧ »REMIT2/RKSUBS.SC«
IDENT RKSUBS R]KONVERTERING 9.2 810218 NJ OPTNS LINES=46 DDUM KMD08 PDIV ENTRY SPORG ENTRY PASS ENTRY COPYDK ENTRY IXWRIT ENTRY LOD1 ENTRY INIT EXT ATTHD1 EXT RKASSG EXT SPCLRA EXT DKIO EXT ASG EXT DKWRIT EXT DKREAD EXT SPERR EXT SPCLRN EJECT SPORG PROC ***************************************** * * SPORG - INQUIRIES ON REGISTRATED TRANSACTIONS * * EXIT UPON COMPLETION: * 0 - RECORD DELIMITER WRONG * 2 - NORMAL * 4 - READ ERROR * 6 - NYVALG * 8 - NO INDEXREG. BUILT * *************************************** SP00 CLEAR OBS PERF ATTHD1 MOVE GSWBCD3,=D'0' MOVE WORK5,=D'0' SET INQ1 PERF CLRTST PERF SPCLRA ASK FOR CPRNR IB SPBINW2,SPER6,SPER6 MOVE GSWBIN4,CBIN0 MOVE SPINPUT,CPRNR MOVE SPBINW4,CBIN0 MOVE SPBINW1,CBIN10 MOVE GTRECNR,STARTIX MOVE GSWBIN5,CBIN5 PERF DKIO READ FIRST RECORD OF INDEX BNOK SPER4 MOVE GSWSTR2,TEDBUF CBE GSWSTR2,=C'IX',SP05B INDEX BUILT, OK RET 8 SP05A MOVE GSWBIN5,CBIN5 PERF DKIO READ INDEX RECORD BNOK SPER4 SP05B MOVE GSWSTR20,=C' ' MOVE GSWBIN1,CBIN1 9 INDEXES PER RECORD MOVE GSWSTR2,TEDBUF SP06 MOVE GSWBIN2,GSWBIN1 SUB GSWBIN2,CBIN1 COMPUTE DISPL. FOR COPY MUL GSWBIN2,CBIN14 ADD GSWBIN2,CBIN2 COPY GSWSTR20,CBIN0,CBIN10,TEDBUF,GSWBIN2 ADD GSWBIN2,CBIN10 DISPL. FOR INDEX MOVE GSWBCD1,GSWSTR20 MOVE GSWSTR20,=C' ' COPY GSWSTR20,CBIN0,CBIN4,TEDBUF,GSWBIN2 MOVE GSWBCD3,GSWSTR20 CBE GSWBCD1,=D'0',SP07 CBE GSWBCD1,CPRNR,SP08 ADD GSWBIN1,CBIN1 TRY NEXT CBNE GSWBIN1,CBIN10,SP06 UNTIL LAST SUB GTRECNR,CBIN1 TRY NEXT RECORD B SP05A SP07 MOVE GSWSTR80,=C'CPRNR IKKE I INDEX ' ATTFMT LISTFRM2 PERF SPCLRA CBE SPBINW2,CBIN2,SP00 MAK ? B SPER6 SP08 MOVE GSWBIN7,CBIN1 MOVE GSWBIN8,CBIN1 MOVE GTRECNR,GSWBCD3 MOVE INITIALVALUE TO GTRECNR MOVE WORK5,GSWBCD3 DISPLAY FMEL SP10 PERF DKREAD BNOK SPER4 MOVE GSWSTR2,=C'&' MOVE GSWBIN4,CBIN0 MATCH TEDBUF,GSWBIN4,CBIN10,GSWSTR2,CBIN0,CBIN1 BOK SP20 FORTS[TTELSESRECORD MOVE GSWSTR20,=' ' XCOPY GSWSTR20,CBIN0,CBIN10,TEDBUF,CBIN0 MOVE WORK7,GSWSTR20 CBNE WORK7,CPRNR,SP70 FINISHED AFTER BREAK SP20 MOVE GSWBIN4,CBIN12 MOVE GSWSTR20,=C'&' MOVE GSWBIN1,CBIN0 MATCH TEDBUF,GSWBIN1,CBIN15,GSWSTR20,CBIN0,CBIN1 FIND 1. & ADD GSWBIN1,CBIN1 SP30 COPY GSWSTR3,CBIN0,CBIN3,TEDBUF,GSWBIN1 EXTRACT FIELDNR ADD GSWBIN1,CBIN3 MOVE GSWSTR20,=C'&' MOVE GSWBIN2,GSWBIN1 MATCH TEDBUF,GSWBIN2,CBIN15,GSWSTR20,CBIN0,CBIN1 SEARCH FOR & BE SP50 FOUND MOVE GSWSTR20,STR25 MOVE GSWBIN2,GSWBIN1 MATCH TEDBUF,GSWBIN2,CBIN15,GSWSTR20,CBIN0,CBIN1 SEARCH FOR % BE SP50 MOVE GSWSTR20,STR7F MOVE GSWBIN2,GSWBIN1 MATCH TEDBUF,GSWBIN2,CBIN15,GSWSTR20,CBIN0,CBIN1 SEARCH EOR BE SP50 MOVE SPBINW4,CBIN1 MOVE GSWBCD4,=D'98' PERF SPERR B SPER NOT FOUND, OVERFLOW/LENGTH SP50 MOVE GSWSTR2,GSWSTR20 SAVE DELIMITER MOVE GSWBIN3,GSWBIN2 POINT AT POS WHERE MATCH SUB GSWBIN3,GSWBIN1 - STARTPOS GIVES LENGTH MOVE SAVEF(GSWBIN7,GSWBIN8),BINULL MOVE GSWSTR20,BINULL XCOPY GSWSTR20,CBIN0,GSWBIN3,TEDBUF,GSWBIN1 MOVE SAVEF(GSWBIN7,GSWBIN8),GSWSTR20 MOVE FIELD(GSWBIN7,GSWBIN8),GSWSTR3 MOVE GSWBIN1,GSWBIN2 SAVE FOR NEW DISPLACEMENT ADD GSWBIN1,CBIN1 BYPASS DELIMITER CBE GSWSTR2,STR7F,SP70 ADD GSWBIN8,CBIN1 NEXT ENTRY CBL GSWBIN8,CBIN5,SP60 NEW LINE? MOVE GSWBIN8,CBIN1 FIRST ON LINE ADD GSWBIN7,CBIN1 NEW LINE SP60 CBE GSWSTR2,STR25,SP10 CBE GSWSTR2,='&&',SP30 SP70 CLEAR INQ1 SET CPRFLAG PERF ATTHD1 PERF SPCLRN MOVE CPRNR,=D'0' PERF CLRINQ TBT CHFLAG,SPRET B SP00 SPER6 CLEAR OBS PERF CLRINQ RET 6 SPER4 PERF CLRINQ RET 4 SPRET SET OBS RET 2 SPER PERF CLRINQ RET PEND EJECT CLRINQ PROC CLEAR INQ1 CLEAR INQ2 CLEAR INQ3 CLEAR CPRFLAG RET PEND * * * ************************************************************ * * CLRTST - CLEARING OF TESTSTRG * ************************************************************* CLRTST PROC MOVE GSWBIN1,CBIN12 MOVE GSWBIN2,CBIN4 CLRT10 MOVE FIELD(GSWBIN1,GSWBIN2),=D'0' MOVE SAVEF(GSWBIN1,GSWBIN2),BINULL SUB GSWBIN2,CBIN1 BNZ CLRT10 MOVE GSWBIN2,CBIN4 SUB GSWBIN1,CBIN1 BNZ CLRT10 RET PEND EJECT PASS PROC ********************************** * * THE PROCEDURE CHECKS THE USERS AUTHORIZATION * ********************************** MOVE GSWBIN1,CBIN10 10 CHARS + EOI-KEY EDWRT SCREEN,PASSHEAD KI .NE,KEYB,GSWSTR20,SPKTAB2,GSWBIN1,GSWBIN2 MOVE GSWBIN1,CBIN6 PASS10 MOVE GSWBIN2,CBIN0 MATCH KEYTAB(GSWBIN1),GSWBIN2,CBIN10,GSWSTR20,CBIN0,CBIN10 BOK PASS90 SUB GSWBIN1,CBIN1 BNZ PASS10 CMP CBIN0,CBIN1 RET PASS90 CMP CBIN0,CBIN0 RET PEND * PASSHEAD FRMT FSL FTEXT 'INDTAST IDENTIFIKATION' FMEND EJECT COPYDK PROC ************************************************ * * COPYDK - THE PROCEDURE COPIES FD01 TO FD02 * UNTIL A SPECIAL EOF-RECORD IS MET. * THE EOF-MARK IS <**> * * EXIT UPON COMPLETION: * 0 - RECORD DELIMITER NOT FOUND * 2 - READ ERROR * 4 - WRITE ERROR * 6 - NORMAL * ************************************************ ATTFMT COPYFRM1 MOVE CPRNR,=C'0' PERF SPCLRA CBE SPBINW2,CBIN3,COPY01C B COPY98A COPY01C MOVE SPLITBIN,BCDWK CLEAR FULL IB SPLITBIN,COPY01B,COPY02,COPY01B MOVE SPLITBIN,CBIN1 COPY01B TBF CRKCOPY,COPY98A CLEAR CRKCOPY PERF ASG,CBIN2 BNOK COPY98BA MOVE GSWBIN5,CBIN13 PERF DKIO BNOK COPY98B COPY02 MOVE RECIX,STARTIX MOVE GSWBIN3,CBIN9 COPY03 MOVE CPRKEY(GSWBIN3),=C'0' MOVE CPRIX(GSWBIN3),=D'0' SUB GSWBIN3,CBIN1 CBNE GSWBIN3,CBIN0,COPY03 MOVE CPRNR,=D'0' MOVE WORK5,=D'0' MOVE GTRECNR,=W'26' COPY06 PERF DKREAD BNOK COPY98B MOVE GSWSTR2,TEDBUF * FURTHER ACTION DEPENDS ON VALUE IN SPLITBIN * 1 - STANDARD, EVERYTHING COPIED, INDEXFILE BUILT * 2 - BUILD INDEXFILE ONLY * 3 - EVERYTHING COPIED, NO INDEXFILE CBL GSWSTR2,=C'00',COPY08 COPY HEADER/END-RECORD CBG GSWSTR2,=C'99',COPY08 CBE SPLITBIN,CBIN3,COPY08 MOVE GSWSTR2,=C'&' MOVE GSWBIN1,CBIN0 MATCH TEDBUF,GSWBIN1,CBIN10,GSWSTR2,CBIN0,CBIN1 BOK COPY08 SAME CPRNR, NO ACTION ADD GSWBIN3,CBIN1 MOVE GSWSTR20,=' ' COPY GSWSTR20,CBIN0,CBIN10,TEDBUF,CBIN0 MOVE CPRKEY(GSWBIN3),GSWSTR20 MOVE GSWBCD3,GTRECNR SUB GSWBCD3,=D'1' MOVE CPRIX(GSWBIN3),GSWBCD3 COPY08 CBE SPLITBIN,CBIN2,COPY15 MOVE GSWBIN5,CBIN11 SEQ. WRITE FD02 PERF DKIO BNOK COPY98C ADD WORK5,=D'1' COPY15 CBL GSWBIN3,CBIN9,COPY17 IB SPLITBIN,COPY16,COPY16,COPY17 COPY16 * WRITE INDEX ON FD01 PERF IXWRIT B COPY98C WRITE ERROR B COPY98B READ ERROR COPY07 MOVE CPRKEY(GSWBIN3),=C'0' MOVE CPRIX(GSWBIN3),=D'0' SUB GSWBIN3,CBIN1 CBNE GSWBIN3,CBIN0,COPY07 COPY17 CBNE GSWSTR2,=C'**',COPY06 * CBE SPLITBIN,CBIN3,COPY98 PERF IXWRIT B COPY98C WRITE ERROR B COPY98B READ ERROR MOVE CPRKEY(CBIN1),=C'0' MOVE CPRIX(CBIN1),=D'0' PERF IXWRIT B COPY98C B COPY98B * LAST INDEX RECORD WRITTEN COPY98 ATTFMT COPYFRM2 PERF SPCLRA CBE SPLITBIN,CBIN2,COPY98A MOVE GSWBIN5,CBIN4 UNLOAD FD02 PERF DKIO BNOK COPY98B SET CRKCOPY COPY98A RET 6 COPY98B CBE SPLITBIN,CBIN2,COPY98BA MOVE GSWBIN5,CBIN4 UNLOAD FD02 PERF DKIO SET CRKCOPY REL FD02 COPY98BA RET 2 COPY98C CBE SPLITBIN,CBIN2,COPY98CA MOVE GSWBIN5,CBIN4 UNLOAD FD02 PERF DKIO SET CRKCOPY COPY98CA RET 4 PEND EJECT IXWRIT PROC *************************************************** * IXWRIT - WRITE INDEXRECORD * RETURN UPON COMPLETION: * 0 - WRITE ERROR * 2 - READ ERROR * 4 - NORMAL **************************************************** IX00 * CHECK AND SEE IF **<KMNR> WAS WRITTEN IN THIS RECORD MOVE GSWBIN7,GTRECNR SAVE GTRECNR EDWRT .NW,SCREEN,COPYFRM4 MOVE GSWBIN4,CBIN1 MOVE GSWBIN5,CBIN2 MOVE TEDBUF,=C'IX ' IX10 EDSUB TEDBUF,GSWBIN5,IXFRMT ADD GSWBIN4,CBIN1 CBNG GSWBIN4,CBIN9,IX10 MOVE GTRECNR,RECIX MOVE GSWBIN5,CBIN15 WAIT SCREEN PERF DKIO BNOK IX50 SUB RECFREE,CBIN1 ADJUST FOR WRITTEN INDEX SUB RECIX,CBIN1 COUNT DOWN MOVE GTRECNR,GSWBIN7 RESTORE POINTER RET 4 NORMAL, + NO INDEX WRITING IX40 RET 2 IX50 RET PEND EJECT LOD1 PROC ************************************ * ASK FOR NORMAL OR CONT. REG. * IF NORMAL, THEN WRITE HDR1,KMDINF AFTER * CHECK FOR EMPTY DISK * ELSE * DELETE INDEXFILE * RETURNPOINTS: * 0 - MAK * 2 - READ/WRITE ERROR * 4 - ASSIGN ERROR * 6 - NORMAL ************************************ LOD110 MOVE GTANTAL,=D'0' MOVE BCDWK,=D'0' ATTFMT HEAD3 PERF SPCLRA IB SPBINW2,LOD110,LOD111,LOD115 B LOD110 LOD115 CBE BCDWK,=D'1',NORM CBE BCDWK,=D'2',CONT B LOD110 NORM * INIT OF FNAME FOR FORSKUDSREGISTRERING MOVE WORK12,YEAR MOVE GSWBIN1,GTANTAL SLUT/FORSKUD/LON IB GSWBIN1,LAB10,LAB20,LAB30 B LOD110 LAB10 SLUTLIGNING MOVE CDSNAME,FRAAK CLEAR FORSKUD CLEAR LONOPL B LAB40 LAB20 TBF OPTION1,LOD111 SET FORSKUD CLEAR SLUTL CLEAR LONOPL MOVE CDSNAME,FFORSK B LAB40 LAB30 TBF OPTION2,LOD111 SET LONOPL CLEAR FORSKUD CLEAR SLUTL MOVE CDSNAME,FLONOPL LAB40 PERF ASG,CBIN1 BNOK LOD113 PERF INIT B LOD113 READ/WRITE ERROR B LOD114 MAK B LODOK CONT PERF RKASSG BNOK LOD112 ERROR B LODOK LOD112 RET 2 LOD113 RET 4 LOD114 MOVE GSWBIN5,CBIN3 PERF DKIO UNLOAD BNOK LOD112 LOD111 RET LODOK SET CRKKLAR RET 6 PEND EJECT INIT PROC ************************************ * * INIT - PREPARE FOR OUTPUT ON FD01. * CALL - PERF INIT * * THE DISC IS POSITIONED TO TRACK 1 * AND VARIOUS WORKFIELDS ARE INITIATED * THE FIRST INDEXRECORD IS DELETED * 0 - READ/WRITE ERROR * 2 - MAK * 4 - OK * ************************************* MOVE GSWBIN5,CBIN5 READ KMDHEADER MOVE GTRECNR,=W'26' PERF DKIO BNOK INI50 MOVE GTSTRFMT,=C' ' COPY GTSTRFMT,CBIN0,CBIN6,TEDBUF,CBIN7 ATTFMT KMDHDR PERF SPCLRA CBE SPBINW2,CBIN2,INI95 INI40 MOVE ENDREC,CBIN0 MOVE RECFREE,MAXREC MOVE RECUSE,ENDREC MOVE TEDBUF,BINULL EDIT TEDBUF,MASTCARD PERF DKWRIT BNOK INI50 ADD GTRECNR,CBIN1 EDIT TEDBUF,ENDCARD MOVE GSWBIN5,CBIN7 PERF DKIO BNOK INI50 EDIT TEDBUF,HDR1REC MOVE GTRECNR,CBIN7 MOVE GSWBIN5,CBIN7 WRITE HDR1 LABEL PERF DKIO BNOK INI50 * DELETE INDEXRECORD MOVE GTRECNR,STARTIX MOVE GSWBIN5,CBIN5 PERF DKIO READ FIRST RECORD OF INDEX BNOK INI50 MOVE TEDBUF,=C' ' MOVE GSWBIN5,CBIN15 PERF DKIO BNOK INI50 RET 4 INI50 RET INI95 RET 2 PEND EJECT * ************************************************************* * * KTABS AND FORMATS * ************************************************************* * SPKTAB2 KTAB X'D1' * HEAD3 FRMT FSL FTEXT 'SLUTLIGNING = 1' FNL FTEXT 'FORSKUDSREG = 2' FNL FTEXT 'LONOPLYSING = 3' FKI 20,ME,NUM,MINL=1,MAXL=1 FMEL 'Z',GTANTAL FNL FNL FTEXT 'ALM.REG. (INCL. SLETNING AF INDEXREG) = 1' FNL FTEXT 'FORTSAT REGISTRERING = 2' FKI 44,ME,NUM,MINL=1,MAXL=1 FMEL 'Z',BCDWK FMEND * * MASTCARD FRMT FORMAT FOR HEADERCARD FILLR '<',2 FMEL '999',RKKMNR FMEL '99',YEAR FMEL '999999',DATE FBF FORSKUD,MAST10 FTEXT C'0050' FB MAST20 MAST10 FTEXT C'0070' MAST20 FILLR X'7F',1 FILLR ' ',62 FMEND * FRMINP FRMT FNL FKI 1,MAXL=2 FMEL 'ZZ',BCDWK FMEND * KMDHDR FRMT FSL FTEXT 'DISKETTEN ER SIDST BRUGT DEN ' FCOPY GTSTRFMT FLINK FRMINP FMEND * HDR1REC FRMT FTEXT C'HDR1 ' FCOPY CDSNAME FILLR ' ',11 FTEXT '080 01001 73026' FILLR ' ',33 FTEXT 'V 01001 ' FMEND * LISTFRM2 FRMT FSL FCOPY GSWSTR80 FLINK FRMINP FMEND * COPYFRM1 FRMT FSL FTEXT '1 - ALM. KOPIERING' FNL FTEXT '2 - OPBYG INDEXREG. (- KOPI)' FNL FTEXT '3 - KOPI UDEN OPBYGNING INDEXREG.' FLINK FRMINP FMEND * COPYFRM4 FRMT FILLR '1',2 FMEL '9999',WORK5 FMEND * ENDCARD FRMT FILLR '*',2 FMEL '999',RKKMNR FILLR ' ',60 FILLR ' ',15 FMEND * COPYFRM2 FRMT FSL FCOPY ='ANTAL RECORDS KOPIERET:' FMEL '9999',WORK5 FLINK FRMINP FMEND * IXFRMT FRMT FCOPY CPRKEY(GSWBIN4) FMEL '9999',CPRIX(GSWBIN4) FMEND END